#!/usr/bin/perl # # pdatranscode.pl # # script to run as a MythTV user job to transcode a recording # for display on a PDA (PalmOS, Windows Mobile, etc.) # # For PDA playback, TCPMP is recommended # http://tcpmp.corecodec.org/ # # shell version created by Jeff Volckaert (inspired by Zach White) # Perl version by Peter Watkins # # Copyright (c) 2006 Peter Watkins, all rights reserved # licensed under the GNU General Public License, version 2 # http://www.gnu.org/copyleft/gpl.html # # $Revision: 1.21 $ # INSTALLATION to User Job #1 # # Simplest/fastest: # - install this file on your backend server as /usr/local/bin/pdatranscode.pl # - make it executable with # chmod 0755 /usr/local/bin/pdatranscode.pl # - run the script with a "--install-job-number" argument for the UserJob to use, e.g. # /usr/local/bin/pdatranscode.pl --install-job-number 1 # and enter the MySQL password when prompted # # manual SQL queries(from Jeff V) # # $ mysql -u mysqluser -p mysqlpasswd # mysql> use mythconverg; # mysql> UPDATE settings SET data='/usr/local/bin/pdatranscode.pl --file %FILE% --title "%TITLE%" --subtitle "%SUBTITLE%" --description "%DESCRIPTION%"' WHERE value='UserJob1'; # mysql> UPDATE settings SET data='PDA Transcode' WHERE value='UserJobDesc1'; # mysql> UPDATE settings SET data='1' WHERE value='JobAllowUserJob1'; # mysql> exit; # # After updating MySQL, you may need to restart mythbackend # (wait until it's not recording anything!) # ----------------- BEGIN CONFIGURATION --------------------- # default settings: you can edit these if you don't want to pass # command-line arguments. # # Run the script with no arguments to get usage information my %configDefaults = ( # must be passed on the command line: 'file' => undef, # you probably want to pass these on the command line 'title' => '', 'subtitle' => '', 'description' => '', # you probably want to customize these 'dir' => '/video/recordings', 'pda-dir' => '/video/recordings/pda', 'filename-format' => '{title:20}-{month}-{day}-{subtitle:20}-{hour}{minute}.avi', 'transcoder' => 'lavc', 'scale' => '320:240', 'umask' => '0002', 'max-episodes' => '', 'max-size-all' => '', # install "options", only used when installing this script 'install-job-name' => 'PDA Transcode', 'install-db-host' => '127.0.0.1', 'install-db-name' => 'mythconverg', 'install-db-user' => 'mythtv', # other User Jobs data elements: un-comment to enable using these # (you might want to use some in the filename) # 'hostname' => '', # 'category' => '', # 'recgroup' => '', # 'playgroup' => '', # 'chanid' => '', # 'starttime' => '', # normally derived from the recording file name # 'endtime' => '', # 'starttime-iso' => '', # 'endtime-iso' => '', # 'progstart' => '', # 'progend' => '', # 'progstart-iso' => '', # 'progend-iso' => '', # 'verboselevel' => '', # options you should not change! 'install-job-number' => '', # do NOT change this value 'help' => '', # do NOT change this value ); my %transcoderCommands = ( # uses the same variable expansion as 'filename-format'; # use "{infile}" for the original recording (full path) # and "{outfile}" for the PDA file (full path) # 'low-quality' => 'mythtranscode -i {infile} -o {outfile} -l -p 29', # Xvid: works fine on Palm TCPMP 0.72RC1 'Xvid' => 'mencoder -vf scale={scale} -oac mp3lame -lameopts mode=0:cbr:br=96 -af volnorm -srate 32000 -ovc xvid -xvidencopts bitrate=300 -o {outfile} {infile} -quiet', # lavc: requires a TCPMP plugin to play sound 'lavc' => 'mencoder -ofps 30 -ovc lavc -lavcopts vcodec=mpeg4:vbitrate=300:vhq:vpass=1 -vf scale={scale} -oac lavc -lavcopts acodec=ac3:abitrate=128 -ffourcc DX50 -o {outfile} {infile} -quiet', # psp is used for the Sony PSP (from David Fishburn) 'psp' => 'mencoder -aid 0 -oac lavc -ovc lavc -of lavf -lavcopts aglobal=1:vglobal=1:vcodec=mpeg4:vbitrate=300:acodec=aac -af lavcresample=24000:volume=10.1:0 -vf harddup -lavfopts format=psp:i_certify_that_my_video_stream_does_not_use_b_frames -vf scale=368:208 -o {outfile} {infile} -quiet', ); # regular expression that 'dir' and 'pda-dir' must match; # this is to ensure the transcode command line is safe my $safeDirRegexp = '^/[a-zA-Z0-9\_\-\/\.]*$'; # regular expression for characters that can safely appear # in a filename; edit this if you need some character to # appear that is being filtered out currently, for instance # a letter with a diacritical mark my $safeFileCharRegexp = '[a-zA-Z0-9\_\-\.]'; # you an probably comment out the previous line and # uncomment the following to support most Euro languages: #my $safeFileCharRegexp = '[a-zA-Z0-9ñÑéÉúÚóÓáÁíÍçÇßëËüÜöÖäÄåÅæÆøØáäàî\_\.\-]'; # subroutine for transforming the config variables before # any action is taken; add more logic if you want sub transformConfig($) { my $conf = shift; # the TV show "Monk" has episode (subtitle) names # like "Mr. Monk Goes to Jail" -- remove the "Mr. Monk" part if ( $conf->{title} eq 'Monk' ) { $conf->{subtitle} =~ s/^Mr\.\s*Monk\s*//; } # if no subtitle and title and subtitle fields both constrained, # expand the max length for the title field if ( $conf->{subtitle} =~ m/^\s*$/ ) { $conf->{subtitle} = ''; if ( $conf->{'filename-format'} =~ m/\{subtitle:(\d{1,})\}/ ) { my $subtitlelen = $1; if ( $conf->{'filename-format'} =~ m/^(.*?)\{title:(\d{1,})\}(.*)$/ ) { my ($pre, $titlelen, $post) = ($1, $2, $3); my $newlen = $subtitlelen + $titlelen; $conf->{'filename-format'} = "${pre}\{title:${newlen}\}${post}"; } } } # if for the psp, use a .mp4 filename if ( $conf->{transcoder} eq 'psp' ) { $conf->{'filename-format'} =~ s/\.avi$/\.mp4/; } } # ----------------- END CONFIGURATION --------------------- # descriptions of config options my %hints = ( 'dir' => 'where MythTV stores recordings (use User Job argument %DIR%)', 'pda-dir', => 'where to store the final PDA files', 'filename-format' => 'format string for final PDA file names', 'transcoder' => 'which transcoder command ("lavc", "Xvid", "low-quality", or "psp")', 'scale' => 'width:height pixel size for PDA files (lavc or Xvid)', 'file' => 'name of specific recording file (use User Job argument %FILE%)', 'title' => 'title of recording (use User Job argument "%TITLE%")', 'subtitle' => 'subtitle of recording (use User Job argument "%SUBTITLE%")', 'description' => 'description of recording (use User Job argument "%DESCRIPTION%")', 'umask' => 'governs permissions of files and directories this creates', 'max-episodes' => 'how many files can exist in same directory as this PDA file -- set to empty string for no limit (will remove oldest)', 'max-size-all' => 'how much space can be used in pda-dir & its subdirectories, in MB -- set to empty string for no limit (will remove oldest)', 'install-job-number' => '(install only) if set to 1, 2, 3, or 4, attempt to install as a User Job with current command-line arguments', 'install-job-name' => '(install only) name to give the MythTV User Job for this script', 'install-db-name' => '(install only) name of the MySQL database used by MythTV', 'install-db-user' => '(install only) username for connecting to MySQL', 'install-db-host' => '(install only) hostname/IP for connecting to MySQL', 'help' => '(help only) display help about specified topic ("install" or "filename-format")', ); use POSIX qw(sprintf strftime); use Time::Local; use Cwd; # set initial config to default values my %config = %configDefaults; # parse command line args my $numargs = scalar(@ARGV); my $argsParsed = 0; # compatibility mode with Jeff Volckaert's shell script, e.g. # usr/local/bin/pdatranscode %DIR% %FILE% "%TITLE%" %STARTTIME% if ( $numargs == 4 ) { my $hasDashedArgs = 0; for (my $i = 0; $i < $numargs; ++$i ) { if ( (($i % 2) == 0 ) & ($ARGV[$i] =~ m/^\-\-([a-z\-]*)$/) ) { $hasDashedArgs = 1; } } if ( $hasDashedArgs == 0 ) { # use Jeff's argument order $config{dir} = $ARGV[0]; $config{file} = $ARGV[1]; $config{title} = $ARGV[2]; # we can parse the starttime from the filename, so you could # comment out the next line $config{starttime} = $ARGV[3]; # note that we've parse the args already $argsParsed = 1; } } # normal command-line argument processing my @installArgs = qw(--file %FILE% --title "%TITLE%" --subtitle "%SUBTITLE%" --description "%DESCRIPTION%"); for (my $i = 0; ($argsParsed == 0) && ($i < $numargs); ++$i ) { if ( $ARGV[$i] =~ m/^\-\-([a-z\-]*)$/ ) { # normal-looking argument name my $argname = $1; # complain if an unkown arg if ( ($argname ne 'file') && (! defined($configDefaults{$argname}) ) ) { die "argument \"--${argname}\" not recognized\n"; } # currently all args require a name and a value if ( $i == ($numargs - 1) ) { # last arg! usage("Need argument for \"--$argname\""); } # help? if ( $argname eq 'help' ) { my $topic = $ARGV[($i + 1)]; if ( $topic eq 'install' ) { &installInfo(); &transcodeExit(0,\%config); } if ( $topic eq 'filename-format' ) { &filenameFormatInfo(); &transcodeExit(0,\%config); } usage("Help topic \"$topic\" unknown"); } # set the config value $config{$argname} = $ARGV[($i + 1)]; if ( $argname !~ m/^(file|title|subtitle|description|install.*)$/ ) { push @installArgs, "--${argname}", "\"".&mysqlQuote($ARGV[($i + 1)])."\""; } # increment $i one to jump passed the value ++$i; } else { # we expected a --argname argument but got something else print STDERR "unexpected input \"$ARGV[$i]\"\n"; } } # the recording directory must exist if (! -d $config{dir} ) { usage("recording directory \"$config{dir}\" does not exist"); } # and have a safe name if ($config{dir} !~ m/$safeDirRegexp/ ) { usage("recording directory \"$config{dir}\" seems to have unsafe characters in its name"); } # the PDA directory must exist if (! -d $config{'pda-dir'} ) { usage("PDA directory \"".$config{'pda-dir'}."\" does not exist"); } # and be writable if (! -w $config{'pda-dir'} ) { usage("cannot write to PDA directory \"".$config{'pda-dir'}."\""); } # and have a safe name if ($config{'pda-dir'} !~ m/$safeDirRegexp/ ) { usage("PDA directory \"".$config{'pda-dir'}."\" seems to have unsafe characters in its name"); } # install-job usage my $number = $config{'install-job-number'}; if ( defined($number) && ($number ne '') ) { &installAsJob(\%config); exit; } # set umask to make output files/dirs have proper permissions umask($config{umask}); # must have a file name! if (! defined($config{file}) ) { usage("must specify a --file argument"); } # the recording file must exist $config{infile} = $config{dir}.'/'.$config{file}; if (! -e $config{infile} ) { usage("recording \"$config{infile}\" does not exist"); } # and be readable if (! -r $config{infile} ) { usage("recording \"$config{infile}\" is not readable"); } # derive the starttime if needed if ( $config{starttime} !~ m/^\d{14}$/ ) { if ( $config{file} =~ m/_(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)[^\_]*$/ ) { $config{starttime} = "$1$2$3$4$5$6"; } else { die "Unexpected filename -- does not seem to have starttime information\n"; } } # parse starttime if ( $config{starttime} =~ m/^(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ ) { $config{year} = $1; $config{month} = $2; $config{day} = $3; $config{hour} = $4; $config{minute} = $5; $config{second} = $6; my $startMoment = timelocal($6,$5,$4,$3,($2 - 1),($1 - 1900)); $config{weekday} = strftime("%A",localtime($startMoment)); } # find the basename $config{basename} = $config{file}; $config{basename} =~ s/^(\d*?\_\d*?)\..*$/$1/; # make any changes to the config &transformConfig(\%config); # must have a valid transcoder option $config{rawcmd} = $transcoderCommands{ $config{transcoder} }; if (! defined($config{rawcmd}) ) { usage("transcoder \"$config{transcoder}\" is not known"); } # decide on the final filename $config{outfile} = &expandVariables(\%config,'filename-format',1); # make any needed subdirectories my @dirs = split(/\//,$config{outfile}); my $dircount = scalar(@dirs) - 1; my $mkdir = $config{'pda-dir'}; for (my $i = 0; $i < $dircount; ++$i) { $mkdir .= '/'.$dirs[$i]; if (! -d $mkdir) { # calculate the proper permissions for the directory mkdir $mkdir, ($config{umask} ^ 0777); } } $config{outfile} = $config{'pda-dir'}.'/'.$config{outfile}; # expand infile/outfile/scale etc. $config{cmd} = &expandVariables(\%config,'rawcmd',0); # make a working directory and chdir there (for things like # divx2pass.log, etc.) &makeWorkingDir(\%config); # now run the encoder command my $returnCode = system($config{cmd}); # print a message if there was an error if ( $returnCode != 0 ) { print STDERR "Transcoding failed for $config{infile} with error $returnCode\n"; # show the config, might help troubleshoot &showConfig(); } # 'max-episodes' -- remove older files if too many # only look in the same directory as this recording if ( $config{'max-episodes'} =~ m/^\d{1,}$/ ) { &removeExtraFiles($mkdir,$config{'max-episodes'}); } # 'max-size-all' -- remove older files if too much space used if ( $config{'max-size-all'} =~ m/^\d{1,}$/ ) { &trimDir($config{'pda-dir'},$config{'max-size-all'}); } # and exit &transcodeExit($returnCode,\%config); # ------------------------- subroutines -------------------------- # exit routine that knows when to clean up working directories sub transcodeExit($$) { my ($rc,$config) = @_; # clean up the working directory if no errors if ( ($rc == 0) && (defined($config->{tmpdir})) ) { my $tmpdir = $config->{tmpdir}; if ( -d $tmpdir ) { if (opendir(DIR,$tmpdir)) { while (my $item = readdir(DIR)) { if ( -f $item ) { unlink "${tmpdir}/$item"; } } } closedir(DIR); chdir("/"); rmdir($tmpdir); } } exit $rc; } # some tasks require a working directory; this creates # a safe working directory and chdir()s there sub makeWorkingDir($) { my $config = shift; while (! defined($config->{tmpdir}) ) { my $dir = "/tmp/pdatranscode-".int(rand(9999999)); if ( -d $dir ) { next; } if ( mkdir($dir, 0755) ) { $config->{tmpdir} = $dir; chdir $config->{tmpdir}; } } } # MySQL install routine sub installAsJob($) { my $config = shift; my $number = $config->{'install-job-number'}; if ( $number !~ m/^[1234]{1}$/ ) { die '"--install-job" must be set to "1", "2", "3", or "4"'."\n"; } # make a working dir my $appPath = $0; if ( $appPath =~ m:^(/.*)$: ) { # nothing to do; $appPath is fine } elsif ( $appPath =~ m:^\./(.*)$: ) { my $base = $1; $appPath = getcwd()."/$base"; } elsif ( $appPath =~ m:^\../(.*)$: ) { die "cannot calculate path for $0 -- please run with a full path (starting with a \"/\")\n"; } else { $appPath = &findApp($0); if (! defined($appPath) ) { die "cannot find path for $0 -- please run with a full path (starting with a \"/\")\n"; } } &makeWorkingDir(\%{$config}); my $tmpdir = $config->{'tmpdir'}; my $cmd = "$appPath ".join(" ",@installArgs); my $name = &mysqlQuote($config->{'install-job-name'}); my $db = $config->{'install-db-name'}; my $user = $config->{'install-db-user'}; my $host = $config->{'install-db-host'}; # find mysql command-line my $mysqlApp = &findApp('mysql'); if (! defined($mysqlApp) ) { die "cannot find \"mysql\" app!\n"; } my $sql = qq| use $db; # First, we retrieve what's currently in the database, # just in case something goes awry. SELECT * FROM settings WHERE value='UserJob${number}'; SELECT * FROM settings WHERE value='UserJobDesc${number}'; SELECT * FROM settings WHERE value='JobAllowUserJob${number}'; UPDATE settings SET data='${cmd}' WHERE value='UserJob${number}'; UPDATE settings SET data='${name}' WHERE value='UserJobDesc${number}'; UPDATE settings SET data='1' WHERE value='JobAllowUserJob${number}'; # Now see what's in the database after the UPDATE statements SELECT * FROM settings WHERE value='UserJob${number}'; SELECT * FROM settings WHERE value='UserJobDesc${number}'; SELECT * FROM settings WHERE value='JobAllowUserJob${number}';|; print "\nwill install as UserJob number $number, \"".$config->{'install-job-name'}."\" the following command:\n $cmd\n"; print "\nby issuing the following SQL query to \"$mysqlApp -h $host -u $user -p >$tmpdir/mysql.out\":\n$sql\n"; print "\nInterrupt (press Control-C) to abort, or press Return to continue and provide the password for MySQL user $user."; my $foo = ; if (! open(MYSQL,"|$mysqlApp -h $host -u $user -p >$tmpdir/mysql.out 2>$tmpdir/mysql.err") ) { die "unable to run mysql ($mysqlApp)!\n"; } print MYSQL $sql; close MYSQL; if ( (! -f "$tmpdir/mysql.out") || (! -f "$tmpdir/mysql.err") || (-s "$tmpdir/mysql.err") ) { print STDERR "WARNING: it looks like the installation failed.\n"; if ( (-s "$tmpdir/mysql.err") ) { print STDERR "MySQL output:\n"; print STDERR `cat $tmpdir/mysql.err`; } exit 2; } print "It appears that the database update was successful.\n"; print "See $tmpdir/mysql.out for MySQL output.\n"; print "\nPlease note: you likely need to restart mythbackend to effect any changes.\n"; } # trimDir: remove as many files from pda-dir as needed to fit max file space sub trimDir($$) { my ($topdir,$maxMB) = @_; my %mtimeFiles; my %infohash; my %filesizeMB; my $filesInThisDir = 0; my $totalMB = 0; my %removeHash; # find all files in pda-dir, calculate total size &getFileInfo($topdir,\%mtimeFiles,\%infohash,\$filesInThisDir,1); foreach my $mtime (sort {$a cmp $b} keys %mtimeFiles) { # get list of files with this mtime my @files = @{$mtimeFiles{$mtime}}; foreach my $file (@files) { my @finfo = @{$infohash{$file}}; my $sizeMB = int(1 + ($finfo[7]/1024/1024)); $filesizeMB{$file} = $sizeMB; $totalMB += $sizeMB; } } # while total size too big, consider files starting # with oldest, figure how many need to be removed PRUNE: foreach my $mtime (sort {$a cmp $b} keys %mtimeFiles) { # get list of files with this mtime my @files = @{$mtimeFiles{$mtime}}; foreach my $file (@files) { if ( $totalMB > $maxMB ) { $removeHash{$file} = 1; $totalMB -= $filesizeMB{$file}; } else { # no point continuing last PRUNE; } } } # if any to be removed, loop through remove list # from newest, see if any can be left in place # and meet the size limit; if so, remove from remove list foreach my $mtime (sort {$b cmp $a} keys %mtimeFiles) { my @files = @{$mtimeFiles{$mtime}}; foreach my $file (@files) { if ( defined($removeHash{$file}) && ($removeHash{$file} == 1) ) { # if we can fit the max space with this file still here, keep it if ( ($totalMB + $filesizeMB{$file}) <= $maxMB ) { $removeHash{$file} = 0; $totalMB += $filesizeMB{$file}; } } } } # loop through remove list, unlink foreach my $file (keys %removeHash) { if ( $removeHash{$file} == 1 ) { if (! unlink($file) ) { print STDERR "Error: unable to remove \"$file\"\n"; } } } } # remove oldest files if too many in directory sub removeExtraFiles($$) { my ($topdir,$maxFiles) = @_; my %mtimeFiles; my %infohash; my $filesInThisDir = 0; &getFileInfo($topdir,\%mtimeFiles,\%infohash,\$filesInThisDir,0); foreach my $mtime (sort {$a cmp $b} keys %mtimeFiles) { # get list of files with this mtime my @files = @{$mtimeFiles{$mtime}}; foreach my $file (@files) { # if we need to remove files, remove this one if ( $filesInThisDir > $maxFiles ) { # try to remove the file if ( unlink($file) ) { --$filesInThisDir; } else { print STDERR "Error: unable to remove \"$file\"\n"; } } } } } # general function for retrieving info about files sub getFileInfo($$$$$) { my ($topdir,$mtimehash,$infohash,$filesInThisDir,$recurse) = @_; my @otherdirs; if (!opendir(THISDIR,$topdir)) { #die "Error: cannot open directory $topdir\n"; return; } # look at the items in this directory READ: while (my $item = readdir(THISDIR) ) { if ( $item =~ m/^\.{1,2}$/ ) { next READ; } # calculate full path my $path = "${topdir}/$item"; # if it's a file, take a look if ( -f $path ) { my @finfo = stat($path); my $mtime = $finfo[9]; ++${$filesInThisDir}; push @{$mtimehash->{$mtime}}, $path; $infohash->{$path} = \@finfo; } elsif ( -d $path ) { # directory: queue this up push @otherdirs, $path; } } closedir(THISDIR); if ( $recurse ) { # look at each of the subdirs we found foreach my $dir ( @otherdirs ) { &getFileInfo($dir,$mtimehash,$infohash,\$filesInThisDir,$recurse); } } } # function to expand {variable-name} strings, and scrub characters if needed sub expandVariables($$$) { my ($conf,$varname,$scrub) = @_; my $template = $conf->{$varname}; while ( $template =~ m/^(.*?)\{([a-z\-]*)(|\:\d*)\}(.*?)$/ ) { my $pre = $1; my $varname = $2; my $limit = $3; my $post = $4; my $subst = $conf->{$varname}; # scrub the data? if ( $scrub ) { # space to _ $subst =~ s/\ /\_/g; # reduce multiple _ $subst =~ s/[\_]{1,}/\_/g; # discard unknown chars (build new string with safe chars) my $new = ''; for (my $i = 0; $i < length($subst); ++$i) { my $c = substr($subst,$i,1); if ($c =~ m/$safeFileCharRegexp/) { $new .= $c; } } $subst = $new; } if ( $limit =~ m/^\:(\d*)$/ ) { my $maxlen = $1; $subst = substr($subst,0,$maxlen); } $template = "${pre}${subst}${post}"; } return $template; } # print information about the install options sub installInfo() { print STDERR <