This commit adds a tool that removes all recordings that have been played out in the past. The tool scans the database for recordings that have a play time in the past and removes them from the system to free up storage space and prevent outdated recordings from being played again. This helps to ensure that only current and relevant recordings are available for playback.
43 lines
1014 B
Perl
43 lines
1014 B
Perl
#! /usr/bin/perl
|
|
|
|
use warnings;
|
|
use strict;
|
|
use Data::Dumper;
|
|
use List::Util qw();
|
|
|
|
use FindBin qw($Bin);
|
|
use lib "$Bin/../lib/calcms";
|
|
use config;
|
|
use time;
|
|
use db;
|
|
use File::Basename qw(basename);
|
|
my $config = config::get(pop @ARGV);
|
|
my $delete = grep {$_ eq "--delete"} @ARGV;
|
|
|
|
my $dbh = db::connect($config);
|
|
my $query = qq{
|
|
select start, path
|
|
from calcms_events e, calcms_audio_recordings r
|
|
where e.id = r.event_id
|
|
and e.start > date_add(now(), INTERVAL -14 DAY)
|
|
};
|
|
my $entries = db::get($dbh, $query);
|
|
my %paths = map {normalize($_->{path}) => $_->{start}} @$entries;
|
|
|
|
my $dir = $config->{locations}->{local_audio_recordings_dir};
|
|
for my $file (sort glob("$dir/*m4a")) {
|
|
next if -M $file < 14;
|
|
my $filename = normalize($file);
|
|
unless (exists $paths{$filename}) {
|
|
print " --- $filename\n";
|
|
unlink $file or die $! if $delete;
|
|
}
|
|
}
|
|
|
|
sub normalize {
|
|
my $s = shift;
|
|
$s = basename $s;
|
|
$s =~ s/\.master(\.\w+)$/$1/;
|
|
return $s;
|
|
}
|