Myth archive job.pl
Note: The correct title of this article is myth_archive_job.pl. It appears incorrectly here due to technical restrictions.
Warning: This script will cause orphaned recordings if you set it to archive to a directory that's not specified in any of your storage groups.
| Author | Chris Pinkham |
| Description | Script to move recordings to archive directories |
| Supports |
myth_archive_job.pl is a perl script for moving recording files to "archival" storage directories.
To use the script, first edit the list of directories in @ArchiveDirEntries inside the script. The format to use is DIRECTORY:FREESPACE, where recordings will not be archived to the directory unless it has at least FREESPACE MiB free.
Usage
$ ./myth_archive_job.pl
USAGE: myth_archive_job.pl --directory RECORDINGDIR --file VIDEOFILE <OPTIONS>
OPTIONS:
--archivedir ARCHIVEDIR Force archive to go to ARCHIVEDIR
Configuring as a User Job
myth_archive_job.pl -d %DIR% -f %FILE%"
Or, to force the recording to be moved to a specific directory (in this case, a subdirectory under /video/groups/ whose name is the recording's recording group:
myth_archive_job.pl -d %DIR% -f %FILE% -a /video/groups/%RECGROUP%/
The Script
#!/usr/bin/perl -w
my $verbose = 1;
my $directory;
my $file;
my $title = ""; # for display purposes only
my $archiveDir;
use Getopt::Long;
GetOptions( "verbose!" => \$verbose,
"directory=s" => \$directory,
"file=s" => \$file,
"title=s" => \$title,
"archivedir=s" => \$archiveDir
);
#
# Values are: "DIRECTORY:FREESPACE"
#
# Free Space is in Megabytes
#
my( @ArchiveDirEntries ) = (
"/usr2/video/archive/1/:3072",
"/usr2/video/archive/2/:3072",
"/usr2/video/archive/3/:3072",
);
if ( ! $directory || ! $file ) {
printf( "USAGE: myth_archive_job.pl --directory RECORDINGDIR --file " .
"VIDEOFILE <OPTIONS>\n" );
printf( "\n" );
printf( " OPTIONS:\n" );
printf( " --archivedir ARCHIVEDIR Force archive to go to " .
"ARCHIVEDIR\n" );
exit(-1);
}
if ( ! -r "$directory/$file" ) {
die( "ERROR: $directory/$file is not readable or does not exist: $!" );
}
my( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = stat("$directory/$file");
$size = $size * 1.0 / 1024 / 1024;
if ( $verbose ) {
printf( "+-----------------------+\n" );
printf( "| Myth 'Archive' Script |\n" );
printf( "+-----------------------+\n" );
printf( "Title : %s\n", $title ) if ($title ne "");
printf( "Source Dir: %s\n", $directory );
printf( "Filename : %s\n", $file );
printf( "Filesize : %d MB\n", $size );
printf( "\n" );
}
if ( $archiveDir ) {
if (MoveFileToArchiveDir( $file, $directory, $archiveDir )) {
exit(0);
}
} else {
my( $dirEntry);
foreach $dirEntry ( @ArchiveDirEntries ) {
my( $archiveDir, $keepFree ) = split( ':', $dirEntry );
my( $freeSpace ) = GetFreeSpace( $archiveDir );
if ( $verbose ) {
printf( "Trying Dir: %s\n", $archiveDir );
printf( " Keep Free: %6d MB\n", $keepFree );
printf( " Curr Free: %6d MB\n", $freeSpace );
}
if (( $freeSpace - $size) > $keepFree ) {
printf( "Attempting archive to %s\nStatus: ", $archiveDir );
if (MoveFileToArchiveDir( $file, $directory, $archiveDir )) {
printf( "Success.\n" );
exit(0);
}
printf( "ERROR!\n" );
}
}
}
if ( $verbose ) {
printf( "ERROR: Unable to find a directory with enough free space!!\n" );
}
exit(-1);
# Don't like doing this, but it was easier than requiring Filesys::Statfs
sub GetFreeSpace {
my( $dir ) = shift;
if ( ! -r $dir ) {
return 0;
} else {
my( $freeSpace ) = `df -Pm $dir | grep -v Available | awk '{print \$4}'`;
return $freeSpace;
}
}
sub MoveFileToArchiveDir {
my( $file, $oldDir, $newDir ) = @_;
$oldDir =~ s/\/$//;
$newDir =~ s/\/$//;
my( $old ) = "$oldDir/$file";
my( $new ) = "$newDir/$file";
if ( -l $old ) {
printf( "ERROR: The original '$file' is already a link, will not archive to '$new'!\n" );
return(1);
}
# don't like doing this this way, but this is an example script that
# people can enhance if they want
my( $cmd ) = sprintf( "mv %s %s", $old, $new );
#printf( "Archiving by running '%s'\n", $cmd );
return (system( $cmd ) == 0);
}