Difference between revisions of "Transcoding Preserving Captions"

From MythTV Official Wiki
Jump to: navigation, search
m
Line 2: Line 2:
 
|author=Christopher Neufeld
 
|author=Christopher Neufeld
 
|short=Transcode to remove commercials, but retaining closed caption data
 
|short=Transcode to remove commercials, but retaining closed caption data
|long=This framework supplies the means for a user job to do a lossless cut on an MPEG4 recording, while still retaining the ability of MythTV to display closed captions.  It also provides methods for transcoding the video to H.264 format, with a valid seek table, while preserving captions.
+
|long=This framework supplies the means for a user job to do a cut on a MythTV recording, while still retaining the ability of MythTV to display closed captions.  It also provides methods for transcoding the video to H.264 format, with a valid seek table, while preserving captions.
 
|category=User Job Scripts
 
|category=User Job Scripts
 
|file=MythXCode.pm
 
|file=MythXCode.pm
 
|file=xcode_to_h264.pl
 
|file=xcode_to_h264.pl
 
}}
 
}}
A common request is to perform a lossless transcode without losing the closed caption data in the ivtv data stream.  For technical reasons, this is a difficult problem.  The technique outlined here allows the preservation of captions during a lossless transcode.  This is done not by preserving the caption data in the transcoded stream, but by extracting it into a .srt file, which is a file that MythTV automatically detects and makes available if caption displaying is enabled.  Once the .srt file is produced, it can be used with the stream however it is transcoded, so converting it to H.264 format is also supported, and still preserves the captions.
+
A common request is to perform a transcode without losing the closed caption data in the ivtv data stream.  For technical reasons, this is a difficult problem.  The technique outlined here allows the preservation of captions during a transcode.  This is done not by preserving the caption data in the transcoded stream, but by extracting it into a .srt file, which is a file that MythTV automatically detects and makes available if caption displaying is enabled.  Once the .srt file is produced, it can be used with the stream however it is transcoded, so converting it to H.264 format is also supported, and still preserves the captions.
 +
 
 +
This script honours the cutlist, doing exact cuts even when the cuts are not located on keyframes.  It does this by forcing extra keyframes at the edges of the cuts during the transcode, then cutting between these new keyframes.
  
 
This technique makes use of the pull-captions.pl script shown at [[Closed_captioning]], which in turn depends on the ccextractor project (see that page for details).
 
This technique makes use of the pull-captions.pl script shown at [[Closed_captioning]], which in turn depends on the ccextractor project (see that page for details).
Line 15: Line 17:
 
pod2man MythXCode.pm | groff -man -Tascii | less
 
pod2man MythXCode.pm | groff -man -Tascii | less
 
</pre>
 
</pre>
 +
 +
== Changes ==
 +
 +
2013-01-03:
 +
*Updated for compatibility with MythTV 0.25.2.  Added the ability to use .srt files that exist at the time of the invocation, for instance if produced by an HD-PVR recording using the technique at [[Captions_With_HD_PVR]].  There have been some API changes since the original version.  One now calls $worker->prepare_captions() in the place of $worker->cut_and_caption().  The latter function no longer exists.
 +
 +
*We now use -qmax instead of forced bitrate values when generating the H.264 transcode.
 +
 +
*We now use the default (High) profile, rather than Baseline.
 +
 +
*We no longer support generating a ''lossless'' transcode preserving captions by omitting the transcode_to_h264() function call.  That behaviour can be easily obtained by running the pull_captions.pl script then transcoding through the usual interfaces, this script isn't needed for that.
 +
 +
*Tested on PVR-500 (ivtv capture), HDHomerun3 OTA (ATSC captions), and HD-PVR.
  
 
== Library Module ==
 
== Library Module ==
Line 41: Line 56:
 
     $worker->set_program_identifier($chanid, $starttime, $jobid);
 
     $worker->set_program_identifier($chanid, $starttime, $jobid);
 
     $worker->init();
 
     $worker->init();
     $worker->cut_and_caption();
+
     $worker->prepare_captions();
 
     $worker->transcode_to_h264();
 
     $worker->transcode_to_h264();
 
     undef $worker;
 
     undef $worker;
Line 53: Line 68:
 
manipulated, for instance when cutting to remove commercials, or when
 
manipulated, for instance when cutting to remove commercials, or when
 
creating DVDs.  It has been tested on NTSC recordings with ivtv
 
creating DVDs.  It has been tested on NTSC recordings with ivtv
captions, and on North American ATSC digital OTA captions.
+
captions (Hauppauge PVR-500), on North American ATSC digital OTA
 +
captions (HDHomerun3), and on (Hauppauge) HD-PVR recordings.
  
This package allows the user to convert MPEG recordings to H.264.  The
+
This package allows the user to convert recordings to H.264 with the
resulting transcoded recordings will have valid seek tables and their
+
cut pieces removed.  The resulting transcoded recordings will have
closed captioning data will be intact.
+
valid seek tables and their closed captioning data will be intact.
 
 
The settings for H.264 transcodes are hard-coded in the file, and must
 
be edited if they're not deemed appropriate for the circumstances.
 
Standard definition recordings are transcoded to 2000 kbits/s.  720p/i
 
recordings are transcoded to 4000 kbits/s, and 1080p/i recordings are
 
transcoded to 6000 kbits/s.  Edit the method
 
C<perform_transcoding_to_h264()> if you want to adjust these.
 
  
 
The MythXCode objects have only been tested while working on a single
 
The MythXCode objects have only been tested while working on a single
Line 93: Line 102:
 
# This script pokes around in the database.  Things might go really
 
# This script pokes around in the database.  Things might go really
 
# wrong if the database innards are changed.  So, we sanity check
 
# wrong if the database innards are changed.  So, we sanity check
# against that.  This script has been tested on schema 1264.
+
# against that.  This script has been tested on schema 1299.
 
my $schema_var = "DBSchemaVer";
 
my $schema_var = "DBSchemaVer";
my $verified_schema = 1264;
+
my $verified_schema = 1299;
 +
 
 +
my $pts_time_offset = 1.00;  # have to add 1 second to keyframe times
 +
      # for HD-PVR recordings, because ffmpeg
 +
      # makes up PTS values in that context,
 +
      # and they start at 1 second, rather
 +
      # than at zero!  To be safe, we insert
 +
      # two keyframes, one for PTS offset 0,
 +
      # and another for offset 1.
  
 
my $pull_captions_pathname = "/home/mythtv/pull-captions.pl";
 
my $pull_captions_pathname = "/home/mythtv/pull-captions.pl";
Line 101: Line 118:
 
my $ffprobe_pathname = "/usr/bin/ffprobe";
 
my $ffprobe_pathname = "/usr/bin/ffprobe";
 
my $mplayer_pathname = "/usr/bin/mplayer";
 
my $mplayer_pathname = "/usr/bin/mplayer";
 +
my $mkvmerge_pathname = "/usr/bin/mkvmerge";
  
 
my $ffmpeg_containeropts = "-f matroska";
 
my $ffmpeg_containeropts = "-f matroska";
 +
 +
my $default_ffmpeg_qfactor = 26;
 +
my $default_system_fps = 29.97;
  
 
# you must have "recordedprogram" here, other parts of the code use
 
# you must have "recordedprogram" here, other parts of the code use
Line 115: Line 136:
 
     bless $self, $class;
 
     bless $self, $class;
 
     $self->check_dependent_executables();
 
     $self->check_dependent_executables();
 +
 +
    $self->{ ffmpeg_qfactor } = $default_ffmpeg_qfactor;
 +
    $self->{ system_fps } = $default_system_fps;
 +
 
     return $self;
 
     return $self;
 
}
 
}
Line 206: Line 231:
 
     $self->disconnect_db();
 
     $self->disconnect_db();
  
     die "Unverified database schema.  This script must be carefully inspected for the new version." if $onerow[0] != $verified_schema;
+
     die "Unverified database schema $onerow[0].  This script must be carefully inspected for the new version." if $onerow[0] != $verified_schema;
 
}
 
}
  
Line 276: Line 301:
 
     my $localcopy = $self->{ orig_pathname };
 
     my $localcopy = $self->{ orig_pathname };
 
     $localcopy =~ s/\.[^.]+$/.srt/;
 
     $localcopy =~ s/\.[^.]+$/.srt/;
 +
 +
    return $localcopy;
 +
}
 +
 +
sub generate_new_caption_filename {
 +
    my $self = shift;
 +
   
 +
    my $localcopy = $self->{ orig_pathname };
 +
    $localcopy =~ s/\.[^.]+$/.srt.NEW/;
  
 
     return $localcopy;
 
     return $localcopy;
Line 305: Line 339:
  
  
sub clear_cutlist {
+
sub seconds_to_hms {
 
     my $self = shift;
 
     my $self = shift;
 +
    my $timestamp = shift;
  
     $self->connect_to_db();
+
     my $hours = int($timestamp / 3600);
 +
    $timestamp -= $hours * 3600;
 +
    my $minutes = int($timestamp / 60);
 +
    $timestamp -= $minutes * 60;
 +
    my $whole_seconds = int($timestamp);
 +
    my $milliseconds = 1000 * ($timestamp - $whole_seconds);
 +
 
 +
    return sprintf("%02d:%02d:%02d.%03d", $hours, $minutes, $whole_seconds, $milliseconds);
 +
}
  
    my $query;
 
    my $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=0";
 
  
     if ( $self->get_debug_level() > 0 ) {
+
sub get_cutlist {
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
+
     my $self = shift;
     } else {
+
 
$query = $self->{ dbhandle }->prepare($qstr);
+
     if ( $self->{ cutlist } ) {
$query->execute($self->{ chanid }, $self->{ starttime });
+
return $self->{ cutlist };
 
     }
 
     }
  
     $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=1";
+
     my $command = "mythutil -q -q --getcutlist --chanid=$self->{ chanid} --starttime='$self->{ starttime }'";
 +
    print "EXECUTE:  $command\n";
  
     if ( $self->get_debug_level() > 0 ) {
+
    my $fh;
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
+
     if ( ! open ($fh, "$command |") ) {
    } else {
+
$self->set_job_status("Failed to extract cutlist");
$query = $self->{ dbhandle }->prepare($qstr);
+
die "Cutlist extraction failed.";
$query->execute($self->{ chanid }, $self->{ starttime });
 
 
     }
 
     }
  
     $qstr = "UPDATE recorded SET cutlist=0 WHERE chanid=? AND starttime=?";
+
     while (<$fh>) {
    if ( $self->get_debug_level() > 0 ) {
+
if ( m/^Cutlist: (.*)$/ ) {
print "DBExecute: $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
+
    $self->{ cutlist } = $1;
    } else {
+
}
$query = $self->{ dbhandle }->prepare($qstr);
 
$query->execute($self->{ chanid }, $self->{ starttime });
 
 
     }
 
     }
  
     $qstr = "UPDATE recorded SET commflagged=0 WHERE chanid=? AND starttime=?";
+
     print "cutlist= $self->{ cutlist }\n";
     if ( $self->get_debug_level() > 0 ) {
+
 
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
+
     if ( $self->{ cutlist } ) {
    } else {
+
# build the times for the new keyframes, and the cut times
$query = $self->{ dbhandle }->prepare($qstr);
+
 
$query->execute($self->{ chanid }, $self->{ starttime });
+
my $inverse_cutlist;
    }
+
my $inv_prev = 0;
 +
 
 +
my $fkf = "-force_key_frames ";
  
    if ( $self->get_debug_level() > 0 ) {
+
my $ctr = 0;
print "COMMIT !!!\n";
+
my @intervals = split(",", $self->{ cutlist });
    } else {
+
foreach (@intervals) {
$self->{ dbhandle }->commit || die "Database update failed clearing cutlist.\n";
+
    my $start = (split("-", $_))[0];
    }
+
    my $end = (split("-", $_))[1];
  
    $self->disconnect_db();
+
    if ( $ctr != 0 ) {
}
+
$fkf .= ",";
 +
    }
  
 +
    if ( $start > $inv_prev ) {
 +
my $decr = $start - 1;
 +
$inverse_cutlist .= "$inv_prev-$decr,";
 +
    }
 +
    $inv_prev = $end + 1;
  
sub get_recordedprogram_table_data {
 
    my $self = shift;
 
  
    my $names = $self->{ backups }->{ "recordedprogram" }[0];
+
    my $start2 = $start / $self->{ system_fps };
    my $res = $self->{ backups }->{ "recordedprogram" }[1];
+
    my $end2 = ( $end + 1 ) / $self->{ system_fps };
   
 
    my %hashret;
 
  
    for (0 .. $#$res) {
+
    # Make sure the order of new keyframes is correct. For
$hashret{$$names[$_]} = $$res[$_];
+
    # very short cuts, we have to reorder them because of the
    }
+
    # pts_time_offset silliness.
 +
    if ( $pts_time_offset != 0) {
 +
if ( $end2 - $start2 < $pts_time_offset ) {
  
    return %hashret;
+
    $fkf .= sprintf("%.2f,%.2f,%.2f,%.2f", $start2 - 0.005, $end2 - 0.005, $start2 + $pts_time_offset - 0.005, $end2 + $pts_time_offset - 0.005 );  
}
 
  
 +
} else {
  
sub safe_to_cut_before_captions {
+
    $fkf .= sprintf("%.2f,%.2f,%.2f,%.2f", $start2 - 0.005, $start2 + $pts_time_offset - 0.005, $end2 - 0.005, $end2 + $pts_time_offset - 0.005 );
    my $self = shift;
+
 
 +
}
 +
    } else {
 +
$fkf .= sprintf("%.2f,%.2f", $start2 - 0.005, $end2 - 0.005);
 +
    }
 +
 
 +
    $ctr++;
 +
}
  
    my %alldat = $self->get_recordedprogram_table_data();
+
$inverse_cutlist .= "$inv_prev-1300000";   # a nice 12-hour range
    return $alldat{ "videoprop" } =~ "HDTV,(720|1080)";
 
}
 
  
sub program_may_need_cropping {
+
my $ctr2 = 0;
    my $self = shift;
+
my $spl = "--split parts:";
   
+
@intervals = split(",", $inverse_cutlist);
    my %alldat = $self->get_recordedprogram_table_data();
+
foreach (@intervals) {
    return $alldat{ "videoprop" } !~ "HDTV,(720|1080)";
+
    my $start = (split("-", $_))[0];
}
+
    my $end = (split("-", $_))[1];
  
sub high_definition {
+
    if ( $ctr2 != 0 ) {
    my $self = shift;
+
$spl .= ",+";
   
+
    }
    my %alldat = $self->get_recordedprogram_table_data();
 
    return $alldat{ "videoprop" } =~ "HDTV,(720|1080)";
 
}
 
  
 +
    # Subtract 2 from start and from end+1, so that
 +
    # floating-point roundoff doesn't make us fall through to
 +
    # the next keyframe.  ffmpeg doesn't make consecutive
 +
    # keyframes without explicit directions to do so, so this
 +
    # should always work.
 +
    my $start2 = ( $start - 2) / $self->{ system_fps };
 +
    my $end2 = ( $end - 1 ) / $self->{ system_fps };
  
sub extract_captions {
+
    if ( $start2 < 0.005 ) {
    my $self = shift;
+
$start2 = 0.005;
 +
    }
 +
    if ( $end2 < 0.005 ) {
 +
$end2 = 0.005;
 +
    }
  
    my $command = "$pull_captions_pathname $self->{ chanid } '" . $self->{ starttime } . "' " . $self->generate_caption_filename() . " >/dev/null 2>&1";
+
    $spl .= sprintf("%s-%s", $self->seconds_to_hms($start2 - 0.005), $self->seconds_to_hms($end2 - 0.005));
  
    print "EXECUTE:  $command\n";
+
    $ctr2++;
    if ( $self->get_debug_level() < 2 ) {
 
$self->set_job_status("Extracting captions");
 
if ( system($command) != 0) {
 
    $self->set_job_status("Failed while extracting captions");
 
    die "Failed to pull the captions from the recording.";
 
 
}
 
}
$self->set_job_status("Finished extracting captions");
 
    }
 
}
 
  
 +
if ( $ctr > 0 ) {
 +
    $self->{ forced_key_frames } = $fkf;
 +
    $self->{ split_arg } = $spl;
 +
    $self->{ inverse_cutlist } = $inverse_cutlist;
 +
}
  
sub apply_cutlist_to_recording
+
     }
{
 
     my $self = shift;
 
  
     my $tmpname = $self->{ orig_pathname } . ".tmp";
+
     return $self->{ cutlist };
   
+
}
    my $command = "mythtranscode -m -c $self->{ chanid } -s '$self->{ starttime }' -l -o $tmpname >/dev/null 2>&1";
 
    print "EXECUTE:  $command\n";
 
  
    if ( $self->get_debug_level() == 0 ) {
 
$self->set_job_status("Performing lossless cut on the recording.");
 
if ( system($command) != 0 ) {
 
    $self->set_job_status("Failed while applying cutlist");
 
    die "Failed to apply cutlist to the recording.";
 
}
 
  
if ( ! -s $tmpname ) {
 
    $self->set_job_status("Failed while applying cutlist");
 
    die "Failed to apply cutlist to the recording.";
 
}
 
  
my $newlen = -s $tmpname;
+
sub clear_cutlist {
if ( $newlen <= 0 ) {
+
    my $self = shift;
    $self->set_job_status("Failed while applying cutlist");
 
    die "Failed to apply cutlist to the recording.";
 
}
 
  
$self->set_job_status("Finished applying cutlist to recording.");
+
    $self->connect_to_db();
  
$self->connect_to_db();
+
    my $query;
 +
    my $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=0";
  
my $qstr = "DELETE FROM recordedseek WHERE chanid=? AND starttime=?";
+
    if ( $self->get_debug_level() > 0 ) {
my $query = $self->{ dbhandle }->prepare($qstr);
+
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
 +
    } else {
 +
$query = $self->{ dbhandle }->prepare($qstr);
 
$query->execute($self->{ chanid }, $self->{ starttime });
 
$query->execute($self->{ chanid }, $self->{ starttime });
 +
    }
  
$qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=?";
+
    $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=1";
 +
 
 +
    if ( $self->get_debug_level() > 0 ) {
 +
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
 +
    } else {
 
$query = $self->{ dbhandle }->prepare($qstr);
 
$query = $self->{ dbhandle }->prepare($qstr);
 
$query->execute($self->{ chanid }, $self->{ starttime });
 
$query->execute($self->{ chanid }, $self->{ starttime });
 +
    }
  
$qstr = "UPDATE recorded SET filesize=? WHERE chanid=? AND starttime=?";
+
    $qstr = "UPDATE recorded SET cutlist=0 WHERE chanid=? AND starttime=?";
 +
    if ( $self->get_debug_level() > 0 ) {
 +
print "DBExecute:  $qstr;  args= '$self->{ chanid }','$self->{ starttime }'\n";
 +
    } else {
 
$query = $self->{ dbhandle }->prepare($qstr);
 
$query = $self->{ dbhandle }->prepare($qstr);
$query->execute($newlen, $self->{ chanid }, $self->{ starttime });
+
$query->execute($self->{ chanid }, $self->{ starttime });
 +
    }
  
my $deletename = $self->{ orig_pathname } . ".DELETEME";
+
    $qstr = "UPDATE recorded SET commflagged=0 WHERE chanid=? AND starttime=?";
if ( ! rename $self->{ orig_pathname }, $deletename ) {
+
    if ( $self->get_debug_level() > 0 ) {
    $self->{ dbhandle }->rollback();
+
print "DBExecute:  $qstr;   args= '$self->{ chanid }','$self->{ starttime }'\n";
    unlink $tmpname;
+
    } else {
    die "Failed to move aside the original recording.";
+
$query = $self->{ dbhandle }->prepare($qstr);
}
+
$query->execute($self->{ chanid }, $self->{ starttime });
 +
    }
  
if ( ! rename $tmpname, $self->{ orig_pathname } ) {
+
    if ( $self->get_debug_level() > 0 ) {
    rename $deletename, $self->{ orig_pathname };
+
print "COMMIT !!!\n";
    $self->{ dbhandle }->rollback();
+
    } else {
    die "Failed to move the recording after cutting.";
+
$self->{ dbhandle }->commit || die "Database update failed clearing cutlist.\n";
}
+
    }
 
if ( ! $self->{ dbhandle }->commit() ) {
 
    unlink $self->{ orig_pathname };
 
    rename $deletename, $self->{ orig_pathname };
 
    die "Database update failed after cutlist";
 
}
 
  
$self->disconnect_db();
+
    $self->disconnect_db();
unlink $deletename;
+
}
unlink $tmpname . ".map";
 
  
$command = "mythtranscode --buildindex -c $self->{ chanid } -s '$self->{ starttime }' >/dev/null 2>&1";
 
  
$self->set_job_status("Rebuilding keyframe index");
+
sub get_recordedprogram_table_data {
if ( system($command) != 0 ) {
+
    my $self = shift;
    print "Failed to rebuild keyframe index.\n";
 
}
 
  
$self->set_job_status("Finished lossless cut on the recording.");
+
    my $names = $self->{ backups }->{ "recordedprogram" }[0];
 +
    my $res = $self->{ backups }->{ "recordedprogram" }[1];
 +
   
 +
    my %hashret;
  
$self->clear_cutlist();
+
    for (0 .. $#$res) {
 +
$hashret{$$names[$_]} = $$res[$_];
 
     }
 
     }
 +
 +
    return %hashret;
 
}
 
}
  
  
sub examine_source_media {
+
sub safe_to_cut_before_captions {
 
     my $self = shift;
 
     my $self = shift;
  
 +
    return 0;
 +
}
  
     print "EXECUTE:  $ffprobe_pathname $self->{ orig_pathname } 2>&1\n";
+
sub program_may_need_cropping {
 +
     my $self = shift;
  
     my $fh;
+
     return $self->{ video_res } == 480;
    open ($fh, "$ffprobe_pathname $self->{ orig_pathname } 2>&1 |")
+
}
|| die "Unable to run ffprobe on $self->{ orig_pathname }";
 
  
 +
sub high_definition {
 +
    my $self = shift;
 +
   
 +
    return ! ( $self->{ video_res } == 480 );
 +
}
  
    my $saw_5_1;
 
    while (<$fh>) {
 
if ( /Duration: ([0-9]+):([0-9]+):([0-9]+\.[0-9][0-9]), start: / ) {
 
    $self->{ duration_secs } = $1 * 3600 + $2 * 60 + $3;
 
    print "Media duration is $self->{ duration_secs } seconds.\n";
 
}
 
if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Video:.*(1920x1080|1280x720|720x480)/ ) {
 
    $self->{ video_map } = "-map $1:$2";
 
    if ( $self->{ map_dot } ) {
 
$self->{ video_map } =~ s/:/./g;
 
    }
 
  
    if ( $3 =~ "1920x1080" ) {
+
sub extract_captions {
$self->{ video_res } = 1080;
+
    my $self = shift;
  
    } elsif ( $3 =~ "1280x720" ) {
+
    my $command = "$pull_captions_pathname $self->{ chanid } '" . $self->{ starttime } . "' " . $self->generate_caption_filename() . " >/dev/null 2>&1";
  
$self->{ video_res } = 720;
+
    print "EXECUTE:  $command\n";
+
    if ( $self->get_debug_level() < 2 ) {
    } elsif ( $3 =~ "720x480" ) {
+
$self->set_job_status("Extracting captions");
$self->{ video_res } = 480;
+
if ( system($command) != 0) {
    } else {
+
    $self->set_job_status("Failed while extracting captions");
die "Unable to determine video resolution";
+
    die "Failed to pull the captions from the recording.";
    }
 
 
}
 
}
 +
$self->set_job_status("Finished extracting captions");
 +
    }
 +
}
  
if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Audio: / ) {
 
  
    my $mcopy = "-map $1:$2";
 
    if ( $self->{ map_dot } ) {
 
$mcopy =~ s/:/./g;
 
    }
 
  
    if ( ! $saw_5_1 ) {
+
sub seconds_to_srt_ts {
 +
    my $self = shift;
 +
    my $timestamp_seconds = shift;
 +
    my $rvstr;
  
if ( /, 5\.1, / ) {
+
    my $hours;
    $saw_5_1 = 1;
+
    my $minutes;
    $self->{ audio_map } = $mcopy;
+
    my $whole_seconds;
}
+
    my $milliseconds;
  
if ( m/, stereo, / ||  m/, 2 channels, / ) {
+
    $hours = int($timestamp_seconds / 3600);
 +
    $timestamp_seconds -= $hours * 3600;
 +
    $minutes = int($timestamp_seconds / 60);
 +
    $timestamp_seconds -= $minutes * 60;
 +
    $whole_seconds = int($timestamp_seconds);
 +
    $milliseconds = ( $timestamp_seconds - $whole_seconds ) * 1000;
  
    $self->{ audio_map } = $mcopy;
 
}
 
    }
 
}
 
    }
 
    close $fh;
 
  
     die "Can't find video information" if ! $self->{ video_map } || ! $self->{ video_res };
+
     return sprintf("%02d:%02d:%02d,%03d", $hours, $minutes, $whole_seconds, $milliseconds);
    die "Can't find audio information" if ! $self->{ audio_map };
 
 
}
 
}
  
  
sub get_cropping_argument {
+
sub generate_cut_captions
 +
{
 
     my $self = shift;
 
     my $self = shift;
  
     $self->set_job_status("Determining cropping values");
+
     print "Applying cutlist to captions.\n";
 +
    if ( $self->get_debug_level() > 1 ) {
 +
if ( $self->has_cutlist() ) {
 +
    print "Cut captions.\n";
 +
}
 +
return;
 +
    }
  
     # We'll go 5 minutes into the recording, to avoid any issues with
+
     my $overlap_buffer = 0.002;  # minimum seconds between captions
    # opening credits being in a strange shape.  Then, draw 10 samples
+
     my $min_caption_duration = 0.3; # minimum residence time of caption
     # at 15 second intervalsWe choose the most commonly reported
 
    # answer.
 
  
     my %votehash;
+
     my $inputfile = $self->generate_caption_filename();
 +
    my $outputfile = $self->generate_new_caption_filename();
 +
    my $cutlist = $self->get_cutlist();
 +
 
 +
    my @intervals = split(",", $cutlist);
 +
 
 +
    my $cumulative_frames_dropped = 0;
 +
 
 +
    my $position = 0;
 +
    my $marker = 0;
 +
    my @ranges;
 +
    my $start;
 +
    my $end;
 +
 
 +
    foreach (@intervals) {
 +
$start = (split("-", $_))[0];
 +
$end = (split("-", $_))[1];
  
    for (0 .. 10) {
+
$position = $start;
my $time_delay = 300 + $_ * 15;
+
my @oneshot = $self->probe_cropping_data($self->{ orig_pathname }, $time_delay);
+
if ( $position - $marker > 0) {
for (@oneshot) {
+
    push @ranges, [ ( $marker, $position - 1, $cumulative_frames_dropped ) ];
    if ( ! $votehash{$_} ) {
 
$votehash{$_} = 1;
 
    } else {
 
$votehash{$_}++;
 
    }
 
 
}
 
}
 +
$cumulative_frames_dropped += ( $end - $start + 1 );
 +
$marker = $end + 1;
 
     }
 
     }
 +
    push @ranges, [ ( $marker, 100000000, $cumulative_frames_dropped ) ];
  
    my $beststring = "";
 
    my $bestcount = -1;
 
    foreach my $key (keys %votehash) {
 
if ( $votehash{$key} > $bestcount ) {
 
    $beststring = $key;
 
    $bestcount = $votehash{$key};
 
}
 
    }
 
    return $beststring;
 
}
 
  
 +
    my $range_start;
 +
    my $range_end;
 +
    my $range_delay;
  
 +
    my $ifile;
 +
    my $outfile = <STDOUT>;
  
sub probe_cropping_data {
+
    open $ifile, "<$inputfile";
     my $self = shift;
+
     open $outfile, ">$outputfile" || die "Failed to open new .srt to hold cut captions.";
     my $filename = shift;
+
 
     my $delay = shift;
+
     my $holdslash = $/;
 +
     $/ = "\r\n\r\n";
  
     my $fh;
+
     my $recnum = 1;
     open ($fh, "$mplayer_pathname $filename -ss $delay -identify -frames 10 -vo md5sum:outfile=/dev/null -ao null -nocache -vf pp=lb,cropdetect=20:16 2>/dev/null |") || die "Unable to probe for cropping settings.";
+
     my $caption_time_1;
 +
    my $caption_time_2;
 +
    my $prev_caption_end = -1000;
 +
    my $caption_frame_1;
 +
    my $caption_frame_2;
 +
    my $caption_text;
  
    my @result;
+
     while (<$ifile>) {
     while (<$fh>) {
 
if ( /CROP.*X:.*Y:.*\((-vf crop=[0-9]+:[0-9]+:[0-9]+:[0-9]+)\)/ ) {
 
    push @result, $1;
 
}
 
    }
 
    close $fh;
 
    return @result;
 
}
 
  
 +
next if ! m/\d+\r\n(\d+):(\d+):(\d+),(\d+) --> (\d+):(\d+):(\d+),(\d+)\r\n(.*)/s;
 +
 +
$caption_time_1 = $1 * 3600 + $2 * 60 + $3 + $4 * 0.001;
 +
$caption_time_2 = $5 * 3600 + $6 * 60 + $7 + $8 * 0.001;
 +
$caption_frame_1 = $caption_time_1 * $self->{ system_fps };
 +
$caption_frame_2 = $caption_time_2 * $self->{ system_fps };
  
sub set_job_status {
+
$caption_text = $9;
    my $self = shift;
 
    my $text = shift;
 
  
    die "Job status string too long" if length($text) > 127;
+
for my $i ( 0 .. $#ranges ) {
 +
    $range_start = $ranges[$i][0];
 +
    $range_end = $ranges[$i][1];
 +
    $range_delay = $ranges[$i][2];
  
    if ( $self->get_debug_level() == 0 && $self->{ jobid } ) {
+
    if ( $caption_frame_2 >= $range_start && $caption_frame_1 <= $range_end ) {
$self->connect_to_db();
+
if ( $caption_frame_1 < $range_start ) {
 +
    $caption_frame_1 = $range_start;
 +
}
 +
if ( $caption_frame_2 > $range_end ) {
 +
    $caption_frame_2 = $range_end;
 +
}
  
my $qstr = "UPDATE jobqueue SET comment=? WHERE id=?";
+
$caption_time_1 = ( $caption_frame_1 - $range_delay ) / $self->{ system_fps };
my $query = $self->{ dbhandle }->prepare($qstr);
+
$caption_time_2 = ( $caption_frame_2 - $range_delay ) / $self->{ system_fps };
$query->execute($text, $self->{ jobid });
+
if ( $caption_time_1 < $prev_caption_end + $overlap_buffer ) {
$self->{ dbhandle }->commit();
+
    $caption_time_1 = $prev_caption_end + $overlap_buffer;
+
 
$self->disconnect_db();
+
    if ( $caption_time_2 < $caption_time_1 + $min_caption_duration ) {
    } else {
+
$caption_time_2 = $caption_time_1 + $min_caption_duration;
print "STATUS:  $text\n";
+
    }
 +
}
 +
 
 +
printf $outfile "%d\r\n%s --> %s\r\n%s\r\n", $recnum, $self->seconds_to_srt_ts($caption_time_1), $self->seconds_to_srt_ts($caption_time_2), $caption_text;
 +
 
 +
$recnum++;
 +
$prev_caption_end = $caption_time_2;
 +
last;
 +
    }
 +
}
 
     }
 
     }
 +
 +
    $/ = $holdslash;
 
}
 
}
  
  
# This resubmits the job as another job with a later time.  Then it
+
 
# erases its own entry, which will make noise in the error log for the
+
sub examine_source_media {
# backend, but otherwise is safe.
 
sub resubmit_self_and_exit {
 
 
     my $self = shift;
 
     my $self = shift;
   
 
    my $jobtype = $self->my_job_type();
 
  
    $self->connect_to_db();
 
  
# This copies my entry into the job queue, but submitted for "now".
+
    print "EXECUTE:  $ffprobe_pathname $self->{ orig_pathname } 2>&1\n";
    my $qstr = "INSERT INTO jobqueue (chanid,starttime,inserttime,type,cmds,flags,status,hostname,args,schedruntime) SELECT chanid,starttime,current_timestamp(),type,cmds,flags,1,hostname,args,current_timestamp() FROM jobqueue WHERE id=?";
 
  
     my $query = $self->{ dbhandle }->prepare($qstr);
+
     my $fh;
    $query->execute($self->{ jobid });
+
    open ($fh, "$ffprobe_pathname $self->{ orig_pathname } 2>&1 |")  
 +
|| die "Unable to run ffprobe on $self->{ orig_pathname }";
  
    $qstr = "DELETE FROM jobqueue WHERE id=?";
 
    $query = $self->{ dbhandle }->prepare($qstr);
 
    $query->execute($self->{ jobid });
 
  
     # and this rewrites all the other queued MythXCode jobs, so they don't
+
     my $saw_5_1;
    # have to do that on their own.
+
    while (<$fh>) {
 +
if ( /Duration: ([0-9]+):([0-9]+):([0-9]+\.[0-9][0-9]), start: / ) {
 +
    $self->{ duration_secs } = $1 * 3600 + $2 * 60 + $3;
 +
    print "Media duration is $self->{ duration_secs } seconds.\n";
 +
}
 +
if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Video:.*(1920x1080|1280x720|720x480)/ ) {
 +
    $self->{ video_map } = "-map $1:$2";
 +
    if ( $self->{ map_dot } ) {
 +
$self->{ video_map } =~ s/:/./g;
 +
    }
  
    $qstr = "UPDATE jobqueue SET inserttime=current_timestamp() WHERE type=? AND status=1";
+
    if ( $3 =~ "1920x1080" ) {
    $query = $self->{ dbhandle }->prepare($qstr);
+
$self->{ video_res } = 1080;
    $query->execute($jobtype);
 
  
    $self->{ dbhandle }->commit();
+
    } elsif ( $3 =~ "1280x720" ) {
  
    $self->disconnect_db();
+
$self->{ video_res } = 720;
 +
 +
    } elsif ( $3 =~ "720x480" ) {
 +
$self->{ video_res } = 480;
 +
    } else {
 +
die "Unable to determine video resolution";
 +
    }
 +
}
  
    exit 0;
+
if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Audio: / ) {
}
 
  
 +
    my $mcopy = "-map $1:$2";
 +
    if ( $self->{ map_dot } ) {
 +
$mcopy =~ s/:/./g;
 +
    }
  
sub my_job_type {
+
    if ( ! $saw_5_1 ) {
    my $self = shift;
 
  
    $self->connect_to_db( { readonly => 1 } );
+
if ( /, 5\.1, / ) {
    my $jobtype;
+
    $saw_5_1 = 1;
 +
    $self->{ audio_map } = $mcopy;
 +
}
  
    my $qstr = "SELECT type FROM jobqueue WHERE id=?";
+
if ( m/, stereo, / ||  m/, 2 channels, / ) {
    my $query = $self->{ dbhandle }->prepare($qstr);
+
 
    $query->execute($self->{ jobid });
+
    $self->{ audio_map } = $mcopy;
    my @onerow = $query->fetchrow_array;
+
}
   
+
    }
    if ( @onerow ) {
+
}
$jobtype = $onerow[0];
 
 
     }
 
     }
 +
    close $fh;
  
     $query->finish();
+
     die "Can't find video information" if ! $self->{ video_map } || ! $self->{ video_res };
    $self->disconnect_db();
+
     die "Can't find audio information" if ! $self->{ audio_map };
     return $jobtype;
 
 
}
 
}
  
  
# We might want to let other jobs go first, if we're blocking waiting
+
sub get_cropping_argument {
# for another MythXCode process to complete.  This determines if there are
 
# any others waiting.
 
sub other_jobs_queued {
 
 
     my $self = shift;
 
     my $self = shift;
    my $rv = undef;
 
  
     my $jobtype = $self->my_job_type;
+
     $self->set_job_status("Determining cropping values");
  
     if ( $jobtype ) {
+
     # We'll go 5 minutes into the recording, to avoid any issues with
 +
    # opening credits being in a strange shape.  Then, draw 10 samples
 +
    # at 15 second intervals.  We choose the most commonly reported
 +
    # answer.
  
$self->connect_to_db( { readonly => 1 } );
+
     my %votehash;
      
 
# Now, find other queued jobs, not of the same type
 
my $qstr = "SELECT COUNT(id) FROM jobqueue WHERE type != ? AND status=1";
 
my $query = $self->{ dbhandle }->prepare($qstr);
 
$query->execute($jobtype);
 
my @onerow = $query->fetchrow_array;
 
 
if ( $onerow[0] != 0 ) {
 
    $rv = 1;
 
}
 
 
 
$query->finish();
 
$self->disconnect_db();
 
    }
 
  
 +
    for (0 .. 10) {
 +
my $time_delay = 300 + $_ * 15;
 +
my @oneshot = $self->probe_cropping_data($self->{ orig_pathname }, $time_delay);
 +
for (@oneshot) {
 +
    if ( ! $votehash{$_} ) {
 +
$votehash{$_} = 1;
 +
    } else {
 +
$votehash{$_}++;
 +
    }
 +
}
 +
    }
  
     return $rv;
+
    my $beststring = "";
 +
    my $bestcount = -1;
 +
    foreach my $key (keys %votehash) {
 +
if ( $votehash{$key} > $bestcount ) {
 +
    $beststring = $key;
 +
    $bestcount = $votehash{$key};
 +
}
 +
    }
 +
     return $beststring;
 
}
 
}
  
  
sub wait_on_lock {
+
 
 +
sub probe_cropping_data {
 
     my $self = shift;
 
     my $self = shift;
 +
    my $filename = shift;
 +
    my $delay = shift;
  
     if ( $self->{ lockfile } ) {
+
     my $fh;
 +
    open ($fh, "$mplayer_pathname $filename -ss $delay -identify -frames 10 -vo md5sum:outfile=/dev/null -ao null -nocache -vf pp=lb,cropdetect=20:16 2>/dev/null |") || die "Unable to probe for cropping settings.";
  
if ( ! $self->{ jobid } ) {
+
    my @result;
    die "Asked for locking, but without a job ID.";
+
    while (<$fh>) {
}
+
if ( /CROP.*X:.*Y:.*\((-vf crop=[0-9]+:[0-9]+:[0-9]+:[0-9]+)\)/ ) {
 
+
    push @result, $1;
# We'll auto-close this on exit, releasing the lock.
 
open $self->{ lockhandle }, '>', $self->{ lockfile } || die "Failed to create lockfile.";
 
 
 
# Try a non-blocking, exclusive lock
 
while ( ! flock $self->{ lockhandle}, LOCK_EX | LOCK_NB ) {
 
 
 
    if ( $self->other_jobs_queued() ) {
 
$self->resubmit_self_and_exit();
 
    }
 
 
 
    # wait for 5 minutes and check again.
 
    sleep 301;
 
 
}
 
}
 
     }
 
     }
 +
    close $fh;
 +
    return @result;
 
}
 
}
  
  
sub perform_transcoding_to_h264 {
+
sub set_job_status {
 
     my $self = shift;
 
     my $self = shift;
 +
    my $text = shift;
  
     $self->examine_source_media();
+
     die "Job status string too long" if length($text) > 127;
  
     my $cropping_arg;
+
     if ( $self->get_debug_level() == 0 && $self->{ jobid } ) {
 +
$self->connect_to_db();
  
    if ( ! $self->{ cannot_crop } && $self->program_may_need_cropping() ) {
+
my $qstr = "UPDATE jobqueue SET comment=? WHERE id=?";
$cropping_arg = $self->get_cropping_argument();
+
my $query = $self->{ dbhandle }->prepare($qstr);
    }
+
$query->execute($text, $self->{ jobid });
 
+
$self->{ dbhandle }->commit();
    my $bitrate;
+
    if ( $self->{ video_res } == 1080 ) {
+
$self->disconnect_db();
$bitrate = "6000k";
 
    } elsif ( $self->{ video_res } == 720 ) {
 
$bitrate = "4000k";
 
    } elsif ( $self->{ video_res } == 480 ) {
 
$bitrate = "2000k";
 
 
     } else {
 
     } else {
die "Unable to determine bitrate for h.264 transcoding";
+
print "STATUS:  $text\n";
 
     }
 
     }
 +
}
  
    my $xcoded_name = $self->{ orig_pathname };
 
    $xcoded_name =~ s/\.[^.]+$/.mkv/;
 
  
    # Don't re-transcode the same file
+
# This resubmits the job as another job with a later time.  Then it
     if ( $self->{ orig_pathname } eq $xcoded_name ) {
+
# erases its own entry, which will make noise in the error log for the
return;
+
# backend, but otherwise is safe.
    }
+
sub resubmit_self_and_exit {
 +
    my $self = shift;
 +
   
 +
     my $jobtype = $self->my_job_type();
  
     # Before we get to .mkv we'll pass through a .tmp file and a .ts file
+
     $self->connect_to_db();
    my $tmpname1 = $xcoded_name . ".tmp";
 
    my $tmpname2 = $xcoded_name . ".ts";
 
  
     if ( -e $tmpname1 ) {
+
# This copies my entry into the job queue, but submitted for "now".
unlink $tmpname1;
+
     my $qstr = "INSERT INTO jobqueue (chanid,starttime,inserttime,type,cmds,flags,status,hostname,args,schedruntime) SELECT chanid,starttime,current_timestamp(),type,cmds,flags,1,hostname,args,current_timestamp() FROM jobqueue WHERE id=?";
    }
 
    if ( -e $tmpname2 ) {
 
unlink $tmpname2;
 
    }
 
  
     # we use the h264_mp4toannexb filter so that we can rebuild the
+
     my $query = $self->{ dbhandle }->prepare($qstr);
     # seek table.  That's convenient.
+
     $query->execute($self->{ jobid });
  
     my $command;
+
     $qstr = "DELETE FROM jobqueue WHERE id=?";
     my $localname1;
+
     $query = $self->{ dbhandle }->prepare($qstr);
     my $localname2;
+
     $query->execute($self->{ jobid });
  
     my $audioopts;
+
     # and this rewrites all the other queued MythXCode jobs, so they don't
     if ( ! $self->high_definition() ) {
+
     # have to do that on their own.
$audioopts = "-acodec libfaac -ab 256k -ac 2";
 
    } else {
 
$audioopts = "-acodec copy";
 
    }
 
  
     if ( $self->{ ssh_string } ) {
+
     $qstr = "UPDATE jobqueue SET inserttime=current_timestamp() WHERE type=? AND status=1";
$localname1 = basename($tmpname1);
+
     $query = $self->{ dbhandle }->prepare($qstr);
$localname2 = basename($tmpname2);
+
    $query->execute($jobtype);
$command = "$self->{ ssh_string } $ffmpeg_pathname -y -i - -threads $self->{ ssh_threads } -b $bitrate $cropping_arg -vcodec libx264 -vpre fast -vpre baseline -vf yadif $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $localname1 2\\>\\&1 < $self->{ orig_pathname }";
 
     } else {
 
$command = "$ffmpeg_pathname -i $self->{ orig_pathname } -b $bitrate $cropping_arg -vcodec libx264 -vpre fast -vpre baseline -vf yadif $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $tmpname1 2>&1 </dev/null";
 
    }
 
  
     print "EXECUTE:  $command\n";
+
     $self->{ dbhandle }->commit();
    if ( $self->get_debug_level() > 1 ) {
 
  
print "Convert h264 to TS.\n";
+
    $self->disconnect_db();
print "Rebuild keyframe index.\n";
 
print "rename $tmpname2 $xcoded_name\n";
 
print "unlink $self->{ orig_pathname }\n";
 
print "Update database to reflect change\n";
 
  
     } else {
+
     exit 0;
 +
}
  
$self->set_job_status("Beginning h.264 transcode");
 
  
my $oldIRS = $/;
+
sub my_job_type {
$/ = "\r";
+
    my $self = shift;
 +
 
 +
    $self->connect_to_db( { readonly => 1 } );
 +
    my $jobtype;
  
my $fh;
+
    my $qstr = "SELECT type FROM jobqueue WHERE id=?";
+
    my $query = $self->{ dbhandle }->prepare($qstr);
open ( $fh, "$command |") || die "Failed to execute ffmpeg for transcoding";
+
    $query->execute($self->{ jobid });
 +
    my @onerow = $query->fetchrow_array;
 +
   
 +
    if ( @onerow ) {
 +
$jobtype = $onerow[0];
 +
    }
  
my $last_percent = 0;
+
    $query->finish();
while (<$fh>) {
+
    $self->disconnect_db();
 +
    return $jobtype;
 +
}
  
    my $timesecs;
 
    my $fps;
 
  
    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+\.[0-9]+) / ) {
+
# We might want to let other jobs go first, if we're blocking waiting
$fps = $1;
+
# for another MythXCode process to complete. This determines if there are
$timesecs = $2;
+
# any others waiting.
    }
+
sub other_jobs_queued {
 +
    my $self = shift;
 +
    my $rv = undef;
  
    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+):([0-9]+):([0-9]+\.[0-9]+) / ) {
+
    my $jobtype = $self->my_job_type;
$fps = $1;
 
$timesecs = $2 * 3600 + $3 * 60 + $4;
 
    }
 
  
    if ( $timesecs ) {
+
    if ( $jobtype ) {
   
 
my $frac_done = $timesecs / $self->{ duration_secs };
 
my $this_percent = int( $frac_done * 100 );
 
  
if ($this_percent > $last_percent) {
+
$self->connect_to_db( { readonly => 1 } );
    $self->set_job_status("H.264 transcode $this_percent\% done.  $1 FPS");
+
   
    $last_percent = $this_percent;
+
# Now, find other queued jobs, not of the same type
}
+
my $qstr = "SELECT COUNT(id) FROM jobqueue WHERE type != ? AND status=1";
    }
+
my $query = $self->{ dbhandle }->prepare($qstr);
 +
$query->execute($jobtype);
 +
my @onerow = $query->fetchrow_array;
 +
 +
if ( $onerow[0] != 0 ) {
 +
    $rv = 1;
 
}
 
}
  
close $fh;
+
$query->finish();
$/ = $oldIRS;
+
$self->disconnect_db();
 +
    }
 +
 
  
if ( $? != 0 ) {
+
    return $rv;
    $self->set_job_status("H.264 transcode failed");
+
}
    die "Transcoding to h.264 failed.";
 
}
 
  
$self->set_job_status("Running through mp4toannexb to allow rebuilding the keyframe index");
 
  
if ( $self->{ ssh_string } ) {
+
sub wait_on_lock {
    $command = "$self->{ ssh_string} $ffmpeg_pathname -y -i $localname1 -vcodec copy -vbsf h264_mp4toannexb -acodec copy $localname2 >/dev/null 2>&1";
+
    my $self = shift;
} else {
 
    $command = "$ffmpeg_pathname -i $tmpname1 -vcodec copy -vbsf h264_mp4toannexb -acodec copy $tmpname2 >/dev/null 2>&1";
 
}
 
print "EXECUTE:  $command\n";
 
if ( system($command) != 0 ) {
 
    $self->set_job_status("H.264 transcode failed");
 
    die "Transcoding to h.264 failed.";
 
}
 
  
 +
    if ( $self->{ lockfile } ) {
  
if ( $self->{ ssh_string } ) {
+
if ( ! $self->{ jobid } ) {
    $command = "$self->{ ssh_string } cat $localname2 > $tmpname2";
+
    die "Asked for locking, but without a job ID.";
    if ( system($command) != 0 ) {
 
$self->set_job_status("H.264 transcode failed");
 
die "Copying file back from remote engine failed.";
 
    }
 
    $command = "$self->{ ssh_string} /bin/rm -f $localname1 $localname2";
 
    if ( system($command) != 0 ) {
 
print "Filed to unlink file on remote engine.";
 
    }
 
} else {
 
    unlink $tmpname1;
 
 
}
 
}
  
 +
# We'll auto-close this on exit, releasing the lock.
 +
open $self->{ lockhandle }, '>', $self->{ lockfile } || die "Failed to create lockfile.";
  
$self->set_job_status("Finished h.264 transcode");
+
# Try a non-blocking, exclusive lock
 +
while ( ! flock $self->{ lockhandle}, LOCK_EX | LOCK_NB ) {
  
rename $tmpname2, $xcoded_name;
+
    if ( $self->other_jobs_queued() ) {
my $newlen = -s $xcoded_name;
+
$self->resubmit_self_and_exit();
 +
    }
  
$self->connect_to_db();
+
    # wait for 5 minutes and check again.
 
+
    sleep 301;
my $qstr = "DELETE FROM recordedseek WHERE chanid=? AND starttime=?";
 
if ( $self->get_debug_level() == 0 ) {
 
    my $query = $self->{ dbhandle }->prepare($qstr);
 
    $query->execute($self->{ chanid }, $self->{ starttime });
 
} else {
 
    print "$qstr\n";
 
 
}
 
}
 +
    }
 +
}
  
$qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=?";
 
if ( $self->get_debug_level() == 0 ) {
 
    my $query = $self->{ dbhandle }->prepare($qstr);
 
    $query->execute($self->{ chanid }, $self->{ starttime });
 
} else {
 
    print "$qstr\n";
 
}
 
  
$qstr = "UPDATE recorded SET basename=?,filesize=?,transcoded='1' WHERE chanid=? AND starttime=?";
+
sub perform_transcoding_to_h264 {
if ( $self->get_debug_level() == 0 ) {
+
    my $self = shift;
    my $query = $self->{ dbhandle }->prepare($qstr);
 
    $query->execute($xcoded_name, $newlen, $self->{ chanid }, $self->{ starttime });
 
} else {
 
    print "$qstr\n";
 
}
 
  
if ( $self->get_debug_level() == 0 ) {
+
    $self->examine_source_media();
    if ( ! $self->{ dbhandle }->commit() ) {
+
    $self->get_cutlist();
unlink $xcoded_name;
 
die "Failed to move transcoded file into database.";
 
    }
 
  
    unlink $self->{ orig_pathname };
+
    my $cropping_arg;
 +
    my @keyframes;
  
    $self->disconnect_db();
+
    if ( ! $self->{ cannot_crop } && $self->program_may_need_cropping() ) {
}
+
$cropping_arg = $self->get_cropping_argument();
 
 
# Rebuild the seek table, but don't worry if it fails.
 
$self->set_job_status("Rebuilding seek table after transcode");
 
my $command = "mythcommflag --rebuild -c $self->{ chanid } -s '$self->{ starttime }'";
 
print "EXECUTE:  $command\n";
 
if ( $self->get_debug_level() == 0 ) {
 
    system($command);
 
}
 
$self->set_job_status("Finished rebuilding seek table");
 
 
     }
 
     }
}
 
  
sub set_queue_status {
+
     my $xcoded_name = $self->{ orig_pathname };
     my $self = shift;
+
     $xcoded_name =~ s/\.[^.]+$/.mkv/;
     my $code = shift;
 
  
     $self->connect_to_db();
+
     # Don't re-transcode the same file
 +
    if ( $self->{ orig_pathname } eq $xcoded_name ) {
 +
return;
 +
    }
  
     my $qstr = "UPDATE jobqueue SET status=? WHERE id=?";
+
    # Before we get to .mkv we'll pass through a .tmp file and a .ts file
     my $query = $self->{ dbhandle }->prepare($qstr);
+
     my $tmpname1 = $xcoded_name . ".tmp";
     $query->execute($code, $self->{ jobid } );
+
     my $tmpname2 = $xcoded_name . ".ts";
 +
     my $tmpname3 = $xcoded_name . ".tmp.2";
  
     $self->{ dbhandle }->commit();
+
     if ( -e $tmpname1 ) {
     $self->disconnect_db();
+
unlink $tmpname1;
}
+
    }
 +
    if ( -e $tmpname2 ) {
 +
unlink $tmpname2;
 +
     }
 +
    if ( -e $tmpname3 ) {
 +
unlink $tmpname3;
 +
    }
  
 +
    # we use the h264_mp4toannexb filter so that we can rebuild the
 +
    # seek table.  That's convenient.
  
#########################################################################
+
    my $command;
#
+
    my $localname1;
# The following methods are expected to be used by the consumer.  The
+
    my $localname2;
# methods above this line are internal, consider them 'private'.
+
    my $localname3;
#
 
#########################################################################
 
  
=head2 C<set_db_parms(DBNAME, DBUSER, DBPASSWD [, DBHOST [, DBPORT ] ])>
+
    my $audioopts;
 +
    if ( ! $self->high_definition() ) {
 +
$audioopts = "-acodec libfaac -ab 256k -ac 2";
 +
    } else {
 +
$audioopts = "-acodec copy";
 +
    }
  
This method is required and must be called before C<init()>
+
    if ( $self->{ ssh_string } ) {
 +
$localname1 = basename($tmpname1);
 +
$localname2 = basename($tmpname2);
 +
$localname3 = basename($tmpname3);
 +
$command = "$self->{ ssh_string } $ffmpeg_pathname -y -i - -r $self->{ system_fps } -threads $self->{ ssh_threads } -c:v libx264 -qmax $self->{ ffmpeg_qfactor } $self->{ forced_key_frames } $cropping_arg $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $localname1 2\\>\\&1 < $self->{ orig_pathname }";
 +
    } else {
 +
$command = "$ffmpeg_pathname -y -i $self->{ orig_pathname } -r $self->{ system_fps } -c:v libx264 -qmax $self->{ ffmpeg_qfactor } $self->{ forced_key_frames} $cropping_arg $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $tmpname1 2>&1 </dev/null";
 +
    }
  
This method informs the MythXCode object of the parameters needed to
+
    print "EXECUTE: $command\n";
access the MythTV database. At least I<DBNAME>, I<DBUSER>, and
+
    if ( $self->get_debug_level() > 1 ) {
I<DBPASSWD> are required parameters.  I<DBHOST> is optional, and
 
declares that the database is running on a remote host, which can be
 
either a resolvable hostname or an IP number.  I<DBPORT> is the
 
non-standard port number on the remote host.  To use a non-standard
 
port number on the local host, set I<DBHOST> to the IP number of an
 
interface on the local machine that is listening for connections.
 
  
This method ABENDs if the three required parameters are not supplied.
+
print "Transcode, introducing new keyframes.\n";
Otherwise, it will always succeed. It does not validate the
+
print "Split out the cut parts.\n";
connection parameters.
+
print "Copy cut .srt file into position.\n";
 +
print "Rebuild keyframe index.\n";
 +
print "rename $tmpname2 $xcoded_name\n";
 +
print "unlink $self->{ orig_pathname }\n";
 +
print "Update database to reflect change\n";
  
=cut
+
    } else {
  
sub set_db_parms {
+
$self->set_job_status("Beginning h.264 transcode");
    my $self = shift;
 
    my $dbname = shift;
 
    my $dbuser = shift;
 
    my $dbpasswd = shift;
 
    my $dbhost = shift;
 
    my $dbport = shift;
 
  
    die "Required database name not supplied." if ! $dbname;
+
my $oldIRS = $/;
    die "Required database user not supplied." if ! $dbuser;
+
$/ = "\r";
    die "Required database password not supplied." if ! $dbpasswd;
 
  
    $self->{ dbname } = $dbname;
+
my $fh;
    $self->{ dbuser } = $dbuser;
+
    $self->{ dbpasswd } = $dbpasswd;
+
open ( $fh, "$command |") || die "Failed to execute ffmpeg for transcoding";
    $self->{ dbhost } = $dbhost;
 
    $self->{ dbport } = $dbport;
 
    $self->{ parms_set } = 1;
 
}
 
  
=head2 C<set_backup_directory(DIRNAME)>
+
my $last_percent = 0;
 +
while (<$fh>) {
  
This method is optional, and must be run before C<init()>.
+
    my $timesecs;
 +
    my $fps;
  
This method informs the MythXCode object that we want a backup made of
+
    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+\.[0-9]+) / ) {
the working files before processing begins. A new directory will be
+
$fps = $1;
created, with filename F<DIRNAME/transcode_PID> where PID is the
+
$timesecs = $2;
process ID of the process running MythXCode.  If that directory
+
    }
already exists, it is an error, and execution terminates.
 
  
The directory must have sufficient free space to hold the recording
+
    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+):([0-9]+):([0-9]+\.[0-9]+) / ) {
file, plus a relatively small amount of database information.
+
$fps = $1;
 +
$timesecs = $2 * 3600 + $3 * 60 + $4;
 +
    }
  
=cut
+
    if ( $timesecs ) {
 +
   
 +
my $frac_done = $timesecs / $self->{ duration_secs };
 +
my $this_percent = int( $frac_done * 100 );
  
sub set_backup_directory {
+
if ($this_percent > $last_percent) {
    my $self = shift;
+
    $self->set_job_status("H.264 transcode $this_percent\% done.  $1 FPS");
    my $backup_dir = shift;
+
    $last_percent = $this_percent;
 +
}
 +
    }
 +
}
  
    $self->{ backup_dir } = $backup_dir;
+
close $fh;
}
+
$/ = $oldIRS;
  
=head2 C<set_debug_level(NUM)>
+
if ( $? != 0 ) {
 +
    $self->set_job_status("H.264 transcode failed");
 +
    die "Transcoding to h.264 failed.";
 +
}
 +
 
 +
if ( $self->has_cutlist() ) {
  
This method is optional, and must be run before C<init()>.
+
    $self->set_job_status("Using mkvmerge to apply cutlist");
  
MythTV systems are not all alike.  The operations that this package
+
    if ( $self->{ ssh_string } ) {
performs are potentially destructive.  While every attempt has been
+
$command = "$self->{ ssh_string} $mkvmerge_pathname $self->{ split_arg } -o $localname3 --compression 0:none $localname1 && $self->{ ssh_string } mv $localname3 $localname1";
made to detect and gracefully handle error conditions, it is
+
    } else {
recommended that the user test the procedure first.  The debug level
+
$command = "$mkvmerge_pathname $self->{ split_arg } -o $tmpname3 --compression 0:none $tmpname1 && mv $tmpname3 $tmpname1";
should be set first to 2, the script executed, and the log examined
+
    }
for unexpected or undesirable behaviour.  In debug level 2, no
 
database writes are performed, and no files are created or modified.
 
  
If everything looks safe at debug level 2, the debug level should be
+
    print "EXECUTE: $command\n";
reduced to 1 and the procedure repeated. At debug level 1, no
 
database writes are performed, but transcoded/cut files are produced
 
and a .srt file with captions information is created.  These files
 
will occupy space on disk and will not be deleted by MythTV, which has
 
no knowledge of them, so they should be manually deleted after
 
debugging is complete.  Again, the log should be examined for any
 
unexpected or undesirable behaviour.
 
  
Finally, the debug level should be set to 0.  Files are created,
+
    if ( system($command) != 0 ) {
original recording files are deleted and replaced by the new files,
+
$self->set_job_status("mkvmerge cutting failed");
and database entries are changed to reflect this. This is the normal
+
die "Transcoding to h.264 failed.";
operation mode.
+
    }
 +
   
 +
}
  
=cut
+
$self->set_job_status("Running through mp4toannexb to allow rebuilding the keyframe index");
  
sub set_debug_level {
+
if ( $self->{ ssh_string } ) {
    my $self = shift;
+
    $command = "$self->{ ssh_string} $ffmpeg_pathname -y -threads 1 -i $localname1 -vcodec copy -bsf:v h264_mp4toannexb -acodec copy -f mpegts $localname2 >/dev/null 2>&1";
    my $debug_level = shift;
+
} else {
 +
    $command = "$ffmpeg_pathname -i $tmpname1 -threads 1 -vcodec copy -bsf:v h264_mp4toannexb -acodec copy -f mpegts $tmpname2 >/dev/null 2>&1";
 +
}
 +
print "EXECUTE:  $command\n";
 +
if ( system($command) != 0 ) {
 +
    $self->set_job_status("H.264 transcode failed");
 +
    die "Transcoding to h.264 failed.";
 +
}
  
    $self->{ debug_level } = $debug_level;
+
if ( $self->{ ssh_string } ) {
}
 
  
 +
    if ( $self->{ ffmpeg_rebuild } ) {
 +
@keyframes = $self->parse_keyframes_from_ffmpeg($localname2);
 +
    }
  
=head2 C<set_lock_file(FILENAME)>
 
  
This method is optional, and must be run before C<init()>.
+
    $self->set_job_status("Copying file back from remote ffmpeg engine.");
 +
    $command = "$self->{ ssh_string } cat $localname2 > $tmpname2";
 +
    if ( system($command) != 0 ) {
 +
$self->set_job_status("H.264 transcode failed");
 +
die "Copying file back from remote engine failed.";
 +
    }
 +
    $command = "$self->{ ssh_string} /bin/rm -f $localname1 $localname2";
 +
    if ( system($command) != 0 ) {
 +
print "Filed to unlink file on remote engine.";
 +
    }
 +
} else {
 +
 
 +
    if ( $self->{ ffmpeg_rebuild } ) {
 +
@keyframes = $self->parse_keyframes_from_ffmpeg($tmpname2);
 +
    }
  
A transcode job can run for a long time.  It is not hard to queue up
+
    unlink $tmpname1;
days of transcodes.  The user may want to allow other jobs, such as
+
}
commercial flagging runs, to execute as new recordings are created,
 
without waiting days for the queue of transcode jobs to empty.
 
  
To do this, supply a common absolute pathname, F<FILENAME>, to all
 
MythXCode objects using this method.  The MythTV job execution queue
 
must be set to allow at least two concurrent jobs.  Also, the
 
C<set_program_identifier()> method must supply the I<JOBID> argument
 
because the locking method must interact with the MythTV job
 
scheduler.
 
  
Implementation is via an advisory lock on the supplied filename.  When
+
$self->set_job_status("Finished h.264 transcode");
the C<init()> method is called, an attempt is made to acquire the
 
lock. If it succeeds, the C<init()> method returns.  If it fails, it
 
sleeps for 5 minutes and tries again.  Before sleeping, it checks the
 
job queue to see if there are any user jobs of a different type
 
waiting in the queue.  If there are, it finds all queued jobs of the
 
same type and resets their submission times to now.  It then resubmits
 
itself, and exits, freeing up the job queue entry.
 
  
The net effect, if MythTV is configured to allow two concurrent jobs
+
rename $tmpname2, $xcoded_name;
to run, is that There will initially be two running MythXCode jobs,
+
my $newlen = -s $xcoded_name;
but one will not be making progress and will not be consuming CPU.
 
If, later, another job of a different type, such as commercial
 
flagging, appears on the queue, then the blocked MythXCode job will,
 
within 5 minutes, detect it, and reorder the queue so that the
 
commercial flagging job moves to the front of the line.  This allows
 
the commercial flagging job to run concurrently with the MythXCode, so
 
it can be done in a timely manner.
 
  
=cut
+
$self->connect_to_db();
  
sub set_lock_file {
+
my $qstr = "DELETE FROM recordedseek WHERE chanid=? AND starttime=?";
    my $self = shift;
+
if ( $self->get_debug_level() == 0 ) {
    $self->{ lockfile } = shift;
+
    my $query = $self->{ dbhandle }->prepare($qstr);
}
+
    $query->execute($self->{ chanid }, $self->{ starttime });
 +
} else {
 +
    print "$qstr\n";
 +
}
  
 +
$qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=?";
 +
if ( $self->get_debug_level() == 0 ) {
 +
    my $query = $self->{ dbhandle }->prepare($qstr);
 +
    $query->execute($self->{ chanid }, $self->{ starttime });
 +
} else {
 +
    print "$qstr\n";
 +
}
  
=head2 C<set_remote_ffmpeg_engine(SSH_INVOCATION_STRING [, NUMTHREADS])>
+
$qstr = "UPDATE recorded SET basename=?,filesize=?,transcoded='1' WHERE chanid=? AND starttime=?";
 +
if ( $self->get_debug_level() == 0 ) {
 +
    my $query = $self->{ dbhandle }->prepare($qstr);
 +
    $query->execute(basename($xcoded_name), $newlen, $self->{ chanid }, $self->{ starttime });
 +
} else {
 +
    print "$qstr\n";
 +
}
  
This method is required and must be called before C<init()>.
+
if ( $self->get_debug_level() == 0 ) {
 +
    if ( ! $self->{ dbhandle }->commit() ) {
 +
unlink $xcoded_name;
 +
die "Failed to move transcoded file into database.";
 +
    }
  
The MythTV backend may not have the most computing resources available
+
    unlink $self->{ orig_pathname };
on your network.  It may, therefore, be desirable to offload the
+
 
transcoding to H.264 to another computer.  In that case, this method
+
    $self->disconnect_db();
can be used.
+
}
  
The I<SSH_INVOCATION_STRING> must be a string that allows
+
# Clear the cut information, we've now finished modifying the file
password-free access to an account on the remote machine.  An example
+
$self->clear_cutlist();
might be C<S<ssh -l guest -i /home/mythtv/.ssh/key bigbox>>.  The second
 
argument is optional, and should be the integer number of threads to
 
use, passed to the C<-threads> option of F<ffmpeg>.  The default
 
number of threads is 1.
 
  
There must be enough space in the home directory of the remote machine
+
# Move the new .srt into position
to hold the transcoded file, but the original file will not be copied
+
if ( -s $self->generate_new_caption_filename() ) {
over, it is streamed to the C<stdin> of F<ffmpeg>.  Once the file has
+
    my $cut_name = $self->generate_new_caption_filename();
been copied back, it will be deleted from the remote machine,
+
    my $final_path = $self->generate_caption_filename();
releasing the disk space.
+
    if ( $self->get_debug_level() == 0) {
 +
rename $cut_name, $final_path;
 +
    } else {
 +
print "Renaming to move $cut_name to $final_path\n";
 +
    }
 +
}
  
=cut
+
# Rebuild the seek table, but don't worry if it fails.
 +
$self->set_job_status("Rebuilding seek table after transcode");
  
sub set_remote_ffmpeg_engine {
+
if ( $self->{ ffmpeg_rebuild } ) {
    my $self = shift;
 
    my $ssh_string = shift;
 
    my $num_threads = shift;
 
  
    if ( ! $num_threads ) {
+
    $self->db_commit_keyframes_manually(\@keyframes);
$num_threads = 1;
 
    }
 
  
    die "Bad thread number" if $num_threads < 1;
+
} else {
  
    $self->{ ssh_string } = $ssh_string;
+
    my $command = "mythcommflag --rebuild --chanid=$self->{ chanid } --starttime='$self->{ starttime }'";
    $self->{ ssh_threads } = $num_threads;
+
    print "EXECUTE:  $command\n";
 +
    if ( $self->get_debug_level() == 0 ) {
 +
system($command);
 +
    }
 +
    $self->set_job_status("Finished rebuilding seek table");
 +
}
 +
    }
 
}
 
}
  
=head2 C<ffmpeg_map_uses_colon()>
 
  
This method is optional, and must be called before C<init()>.
+
sub parse_keyframes_from_ffmpeg {
 +
    my $self = shift;
 +
    my $transport_stream_file = shift;
  
The command-line invocation for stream mapping in F<ffmpeg> has
+
    $self->set_job_status("Using ffmpeg to extract keyframe positions");
changed recently.  Older versions use a syntax like C<-map 0.1>, while
 
newer ones use C<-map 0:1>.  This method asks that the colon separator
 
be used in F<ffmpeg> invocations.  This is also the default, so this
 
method need not be used, but is recommended in case the F<ffmpeg>
 
invocation changes again in the future.
 
  
=cut
+
    my @rv;  # a vector of (n, pos) for all keyframes
  
sub ffmpeg_map_uses_colon {
+
     my $command = "$ffmpeg_pathname -y -nostats -i $transport_stream_file -vf showinfo -f null -";
     my $self = shift;
+
      
     undef $self->{ map_dot };
+
    if ( $self->{ ssh_string } ) {
}
+
$command = "$self->{ ssh_string } " . $command . " 2\\>\\&1";
 +
    } else {
 +
$command = $command . " 2>&1";
 +
    }
  
=head2 C<ffmpeg_map_uses_colon()>
+
    my $prevpos = -1;
 +
    my $fh;
 +
    open ( $fh, "$command |") || return;
 +
    while (<$fh>) {
 +
if ( /.* n:(\d+) .* pos:(\d+) .* iskey:1 .*/ ) {
  
This method is optional, and must be called before C<init()>.
+
    if ( $2 == $prevpos ) {
 +
die "Obtained bad data trying to locate keyframes.";
 +
    }
 +
    $prevpos = $2;
 +
    push @rv, [$1, $2];
 +
}
 +
    }
  
The command-line invocation for stream mapping in F<ffmpeg> has
+
    close $fh;
changed recently.  Older versions use a syntax like C<-map 0.1>, while
+
    return @rv;
newer ones use C<-map 0:1>.  This method asks that the dot separator
+
}
be used in F<ffmpeg> invocations.  Use this method if your F<ffmpeg>
 
does not recognize the newer format.
 
  
=cut
 
  
sub ffmpeg_map_uses_dot {
+
sub db_commit_keyframes_manually {
     my $self;
+
     my $self = shift;
     $self->{ map_dot } = 1;
+
     my @kf_array = @{$_[0]};
}
+
    shift;
  
 +
    if ( $self->get_debug_level() == 0 ) {
  
=head2 C<set_program_identifier(CHANID, STARTTIME [, JOBID])>
+
$self->connect_to_db();
 +
my $query = $self->{ dbhandle }->prepare("DELETE FROM recordedseek WHERE chanid=? AND starttime=?");
 +
$query->execute( $self->{ chanid }, $self->{ starttime } );
 +
 
 +
my $i;
 +
my $j;
 +
for $i ( 0 .. $#kf_array ) {
 +
    $query = $self->{ dbhandle }->prepare("INSERT INTO recordedseek VALUES(?,?,?,?,?)");
 +
    $query->execute( $self->{ chanid }, $self->{ starttime }, $kf_array[$i][0], $kf_array[$i][1], 9);
 +
}
  
This method is required, and must be called before C<init()>.
+
$self->{ dbhandle }->commit();
 +
$self->disconnect_db();
  
It is used to set the channel ID and starting time of the recording to
+
    } else {
be processed.  The optional third parameter holds the job ID, and must
 
be supplied if locking is being used (see C<set_lock_file>).
 
  
The expected formats for these three parameters are simply the strings
+
printf "DELETE FROM recordedseek WHERE chanid='%d' AND starttime='%s'\n", $self->{ chanid }, $self->{ starttime };
that MythTV supplies to user jobs when the pseudo-parameters
 
B<%CHANID%>, B<%STARTTIMEISO%>, and B<%JOBID%> are used in the command
 
line invocation.
 
  
=cut
+
my $i;
 +
my $j;
 +
for $i ( 0 .. $#kf_array ) {
 +
    printf "INSERT INTO recordedseek VALUES(%d,%s,%d,%d,%d)\n", $self->{ chanid }, $self->{ starttime }, $kf_array[$i][0], $kf_array[$i][1], 9;
 +
}
 +
    }
 +
}
  
sub set_program_identifier {
 
    my $self = shift;
 
    my $chanid = shift;
 
    my $starttime = shift;
 
    my $jobid = shift;
 
  
    die "It is not legal to call set_program_identifier more than once on a MythXCode object" if $self->{ chanid };
 
  
     die "Failed to supply a channel ID" if ! $chanid;
+
sub set_queue_status {
     die "Failed to supply a starttime" if ! $starttime;
+
     my $self = shift;
   
+
     my $code = shift;
     $self->{ chanid } = $chanid;
+
 
     $self->{ starttime } = $starttime;
+
     $self->connect_to_db();
     $self->{ jobid } = $jobid;
+
 
 +
    my $qstr = "UPDATE jobqueue SET status=? WHERE id=?";
 +
     my $query = $self->{ dbhandle }->prepare($qstr);
 +
     $query->execute($code, $self->{ jobid } );
  
 +
    $self->{ dbhandle }->commit();
 +
    $self->disconnect_db();
 
}
 
}
  
  
 +
#########################################################################
 +
#
 +
# The following methods are expected to be used by the consumer.  The
 +
# methods above this line are internal, consider them 'private'.
 +
#
 +
#########################################################################
  
=head2 C<init()>
+
=head2 C<set_db_parms(DBNAME, DBUSER, DBPASSWD [, DBHOST [, DBPORT ] ])>
  
This method is required.  It validates some of the configurations set
+
This method is required and must be called before C<init()>.   
up by the previously-described methodsIt verifies that the database
+
 
schema is one that has been tested and is known to workIf locking
+
This method informs the MythXCode object of the parameters needed to
is enabled, it acquires the lock.
+
access the MythTV database.  At least I<DBNAME>, I<DBUSER>, and
 +
I<DBPASSWD> are required parametersI<DBHOST> is optional, and
 +
declares that the database is running on a remote host, which can be
 +
either a resolvable hostname or an IP number.  I<DBPORT> is the
 +
non-standard port number on the remote hostTo use a non-standard
 +
port number on the local host, set I<DBHOST> to the IP number of an
 +
interface on the local machine that is listening for connections.
  
This method will never return an error, but it may not return. If the
+
This method ABENDs if the three required parameters are not supplied.
configuration settings supplied earlier are wrong, it may ABEND at
+
Otherwise, it will always succeedIt does not validate the
this timeIf the process has to move out of the way to allow a
+
connection parameters.
commercial flagging job to move up in the queue, it will do a quiet
 
exit and not return.
 
  
 
=cut
 
=cut
  
sub init {
+
sub set_db_parms {
 
     my $self = shift;
 
     my $self = shift;
 +
    my $dbname = shift;
 +
    my $dbuser = shift;
 +
    my $dbpasswd = shift;
 +
    my $dbhost = shift;
 +
    my $dbport = shift;
  
     $self->check_database_schema();
+
    die "Required database name not supplied." if ! $dbname;
     $self->wait_on_lock();
+
    die "Required database user not supplied." if ! $dbuser;
     $self->{ initialized } = 1;
+
    die "Required database password not supplied." if ! $dbpasswd;
     $self->read_recording_data();
+
 
 +
     $self->{ dbname } = $dbname;
 +
     $self->{ dbuser } = $dbuser;
 +
     $self->{ dbpasswd } = $dbpasswd;
 +
    $self->{ dbhost } = $dbhost;
 +
    $self->{ dbport } = $dbport;
 +
     $self->{ parms_set } = 1;
 
}
 
}
  
 +
=head2 C<set_backup_directory(DIRNAME)>
  
=head2 C<perform_backup()>
+
This method is optional, and must be run before C<init()>.
  
This method is optional, and must be called after C<init()>.   
+
This method informs the MythXCode object that we want a backup made of
 +
the working files before processing begins.  A new directory will be
 +
created, with filename F<DIRNAME/transcode_PID> where PID is the
 +
process ID of the process running MythXCodeIf that directory
 +
already exists, it is an error, and execution terminates.
  
If a backup directory was set with C<set_backup_dir()>, the backup is
+
The directory must have sufficient free space to hold the recording
performed at this time.  See C<set_backup_dir()> for details of the
+
file, plus a relatively small amount of database information.
location of the backups.  The backup holds the original MPEG recording
 
file, a file named F<recovery> that shows how to copy this file back
 
to its original location, and several MySQL command files suitable for
 
streaming directly into F<mysql> to restore the relevant database
 
entries for the recording.
 
  
B<NOTE>: no backups will be performed unless this method is explicitly
+
Note that merely calling C<set_backup_directory()> is not sufficient
called.
+
to perform the backup.  The C<perform_backup()> function must be
 +
invoked.
  
 
=cut
 
=cut
  
sub perform_backup {
+
sub set_backup_directory {
 
     my $self = shift;
 
     my $self = shift;
     my $newdir = $self->{ backup_dir };
+
     my $backup_dir = shift;
  
     die "Failed to call init()" if ! $self->{ initialized };
+
     $self->{ backup_dir } = $backup_dir;
 +
}
  
    if ( ! $newdir ) {
+
=head2 C<set_debug_level(NUM)>
return;
 
    }
 
  
    $newdir = $newdir . "/transcode_$$";
+
This method is optional, and must be run before C<init()>.
    die "Backup directory already exists" if -d $newdir;
 
    mkdir $newdir,0700 || die "Failed to create backup directory.";
 
  
    if ( $self->get_debug_level() > 0 ) {
+
MythTV systems are not all alike.  The operations that this package
print "cp $self->{ orig_pathname } $newdir\n";
+
performs are potentially destructive.  While every attempt has been
 +
made to detect and gracefully handle error conditions, it is
 +
recommended that the user test the procedure first.  The debug level
 +
should be set first to 2, the script executed, and the log examined
 +
for unexpected or undesirable behaviour.  In debug level 2, no
 +
database writes are performed, and no files are created or modified.
  
    } else {
+
If everything looks safe at debug level 2, the debug level should be
$self->set_job_status("Backing up original file.");
+
reduced to 1 and the procedure repeated. At debug level 1, no
if (system( "cp", $self->{ orig_pathname }, $newdir ) != 0 ) {
+
database writes are performed, but transcoded/cut files are produced
    die "Failed to make the backup copy.";
+
and a .srt file with captions information is created.  These files
}
+
will occupy space on disk and will not be deleted by MythTV, which has
my $hints;
+
no knowledge of them, so they should be manually deleted after
open $hints, ">$newdir/recovery";
+
debugging is complete.  Again, the log should be examined for any
print $hints "cp $newdir/$self->{ orig_basename} $self->{ orig_pathname }\n";
+
unexpected or undesirable behaviour.
close $hints;
 
    }
 
  
    for ( @tables_to_backup ) {
+
Finally, the debug level should be set to 0.  Files are created,
+
original recording files are deleted and replaced by the new files,
my $tablename = $_;
+
and database entries are changed to reflect this.  This is the normal
 +
operation mode.  If anything goes wrong, the backup (if produced),
 +
allows you to reset the recording to the state it was in before the
 +
script executed.  Otherwise, you can delete the backup.
  
my $hints;
+
=cut
open $hints, ">$newdir/$tablename";
 
print $hints "DELETE FROM $_ WHERE chanid='$self->{ chanid }' AND starttime='$self->{ starttime }';\n";
 
my @onetable = @{$self->{ backups }->{ $tablename }};
 
for ( my $i = 1; $i <= $#onetable; $i++ ) {
 
  
    print $hints "INSERT INTO $_ (", join(',', @{$onetable[0]}), " ) VALUES ('", join ("','", map { my $t = $_; $t =~ s|'|\\'|g; $t; } @{$onetable[$i]}), "');\n";
+
sub set_debug_level {
}
+
    my $self = shift;
if ( ! close $hints ) {
+
    my $debug_level = shift;
    die "Failed to write backup data file $tablename";
 
}
 
    }
 
  
     if ( $self->get_debug_level() == 0 ) {
+
     $self->{ debug_level } = $debug_level;
$self->set_job_status("");
 
    }
 
 
}
 
}
  
  
=head2 C<cut_and_caption()>
+
=head2 C<set_qmax(NUM)>
  
This method is optional, and must be called after C<init()>.
+
This method is optional, and must be run before C<init()>.
  
This method extracts the captions from the recording and applies the
+
The ffmpeg transcoding requires a target quality factorThe lower
cutlist (if any)Unless running in debugging mode (see
+
this number, the higher the quality, but the higher the bitrate. The
C<set_debug_level()>), this operation makes permanent changes to the
+
default is 26, but can be changed by calling this function.
recording on disk and to the database entries related to it.
 
 
 
This method should be called before C<transcode_to_h264()>, as
 
otherwise captions and cutlist data will be lost.
 
  
 
=cut
 
=cut
  
sub cut_and_caption {
+
sub set_qmax {
 
     my $self = shift;
 
     my $self = shift;
 +
    my $qmax = shift;
  
     die "Failed to call init()" if ! $self->{ initialized };
+
     $self->{ ffmpeg_qfactor } = $qmax;
 +
}
  
    if ( $self->safe_to_cut_before_captions() ) {
 
  
if ( $self->has_cutlist() ) {
+
=head2 C<set_fps(NUM)>
  
    $self->apply_cutlist_to_recording();
+
This method is optional, and must be run before C<init()>.
  
}
+
The conversion between frame counts and times requires, at present, a
 +
knowledge of a fixed frame rate.  The default is 29.97, for North
 +
American broadcasts.  If this is incorrect in your region, you may
 +
modify the frame rate here.
  
if ( ! $self->captions_already_extracted() ) {
+
=cut
  
    $self->extract_captions();
+
sub set_fps {
 +
    my $self = shift;
 +
    my $fps = shift;
  
}
+
     $self->{ system_fps } = $fps;
 
+
}
     } else {
 
 
if ( ! $self->captions_already_extracted() ) {
 
  
    $self->extract_captions();
 
  
}
+
=head2 C<set_lock_file(FILENAME)>
  
if ( $self->has_cutlist() ) {
+
This method is optional, and must be run before C<init()>.
  
    $self->apply_cutlist_to_recording();
+
A transcode job can run for a long time.  It is not hard to queue up
 +
days of transcodes.  The user may want to allow other jobs, such as
 +
commercial flagging runs, to execute as new recordings are created,
 +
without waiting days for the queue of transcode jobs to empty.
  
}
+
To do this, supply a common absolute pathname, F<FILENAME>, to all
    }
+
MythXCode objects using this method.  The MythTV job execution queue
}
+
must be set to allow at least two concurrent jobs.  Also, the
 +
C<set_program_identifier()> method must supply the I<JOBID> argument
 +
because the locking method must interact with the MythTV job
 +
scheduler.
  
 +
Implementation is via an advisory lock on the supplied filename.  When
 +
the C<init()> method is called, an attempt is made to acquire the
 +
lock.  If it succeeds, the C<init()> method returns.  If it fails, it
 +
sleeps for 5 minutes and tries again.  Before sleeping, it checks the
 +
job queue to see if there are any user jobs of a different type
 +
waiting in the queue.  If there are, it finds all queued jobs of the
 +
same type and resets their submission times to now.  It then resubmits
 +
itself, and exits, freeing up the job queue entry.
  
 +
The net effect, if MythTV is configured to allow two concurrent jobs
 +
to run, is that There will initially be two running MythXCode jobs,
 +
but one will not be making progress and will not be consuming CPU.
 +
If, later, another job of a different type, such as commercial
 +
flagging, appears on the queue, then the blocked MythXCode job will,
 +
within 5 minutes, detect it, and reorder the queue so that the
 +
commercial flagging job moves to the front of the line.  This allows
 +
the commercial flagging job to run concurrently with the MythXCode, so
 +
it can be done in a timely manner.
  
=head2 C<transcode_to_h264()>
+
=cut
  
This method is optional, and must be called after C<init()>.
+
sub set_lock_file {
 +
    my $self = shift;
 +
    $self->{ lockfile } = shift;
 +
}
 +
 
 +
 
 +
=head2 C<set_remote_ffmpeg_engine(SSH_INVOCATION_STRING [, NUMTHREADS])>
  
If a cutlist exists, or if captions are to be preserved,
+
This method is optional and must be called before C<init()>.
C<cut_and_caption()> should be called before this method.
 
  
This method converts an MPEG recording to an H.264 recordingIt will
+
The MythTV backend may not have the most computing resources available
use the remote F<ffmpeg> host, if requested (see
+
on your network.  It may, therefore, be desirable to offload the
C<set_remote_ffmpeg_engine()>).
+
transcoding to H.264 to another computerIn that case, this method
 +
can be used.
  
The resulting recording will have a valid seek table.
+
The I<SSH_INVOCATION_STRING> must be a string that allows
 +
password-free access to an account on the remote machine.  An example
 +
might be C<S<ssh -l guest -i /home/mythtv/.ssh/key bigbox>>.  The second
 +
argument is optional, and should be the integer number of threads to
 +
use, passed to the C<-threads> option of F<ffmpeg>.  The default
 +
number of threads is 1.
  
Unless running in debugging mode (see C<set_debug_level()>), this
+
There must be enough space in the home directory of the remote machine
operation makes permanent changes to the recording on disk and to the
+
to hold the transcoded file, but the original file will not be copied
database entries related to it.
+
over, it is streamed to the C<stdin> of F<ffmpeg>.  Once the file has
 +
been copied back, it will be deleted from the remote machine,
 +
releasing the disk space.
  
 
=cut
 
=cut
  
sub transcode_to_h264 {
+
sub set_remote_ffmpeg_engine {
     my $self = shift;
+
    my $self = shift;
 
+
    my $ssh_string = shift;
     die "Failed to call init()" if ! $self->{ initialized };
+
    my $num_threads = shift;
 
+
 
     $self->perform_transcoding_to_h264();
+
    if ( ! $num_threads ) {
}
+
$num_threads = 1;
 
+
    }
 
+
 
=head1 AUTHOR
+
    die "Bad thread number" if $num_threads < 1;
 
+
 
Christopher Neufeld.  Copyright 2012, released under the GPL version 3.
+
    $self->{ ssh_string } = $ssh_string;
 
+
    $self->{ ssh_threads } = $num_threads;
=cut
+
}
 
+
 
</pre>
+
 
 +
=head2 C<set_ffmpeg_rebuild()>
 +
 
 +
This method is optional and must be called before C<init()>. 
 +
 
 +
Some versions of mythcommflag incorrectly mark some non-keyframes as
 +
keyframes, leading to visible artefacting immediately after a seek.
 +
In that case, if a fairly recent version of ffmpeg is available (1.0
 +
works, 0.8.4 does not), the script can use ffmpeg to obtain the true
 +
keyframe locations and update the seektable appropriately.  Call this
 +
function to activate that mode of operation.
 +
 
 +
=cut
 +
 
 +
sub set_ffmpeg_rebuild {
 +
    my $self = shift;
 +
 
 +
    $self->{ ffmpeg_rebuild } = 1;
 +
}
 +
 
 +
=head2 C<ffmpeg_map_uses_colon()>
 +
 
 +
This method is optional, and must be called before C<init()>.
 +
 
 +
The command-line invocation for stream mapping in F<ffmpeg> has
 +
changed over time.  Older versions use a syntax like C<-map 0.1>, while
 +
newer ones use C<-map 0:1>.  This method asks that the colon separator
 +
be used in F<ffmpeg> invocations.  This is also the default, so this
 +
method need not be used, but is recommended in case the F<ffmpeg>
 +
invocation changes again in the future.
 +
 
 +
=cut
 +
 
 +
sub ffmpeg_map_uses_colon {
 +
    my $self = shift;
 +
    undef $self->{ map_dot };
 +
}
 +
 
 +
=head2 C<ffmpeg_map_uses_dot()>
 +
 
 +
This method is optional, and must be called before C<init()>.
 +
 
 +
The command-line invocation for stream mapping in F<ffmpeg> has
 +
changed recently.  Older versions use a syntax like C<-map 0.1>, while
 +
newer ones use C<-map 0:1>.  This method asks that the dot separator
 +
be used in F<ffmpeg> invocations.  Use this method if your F<ffmpeg>
 +
does not recognize the newer format.
 +
 
 +
=cut
 +
 
 +
sub ffmpeg_map_uses_dot {
 +
    my $self;
 +
    $self->{ map_dot } = 1;
 +
}
 +
 
 +
 
 +
=head2 C<set_program_identifier(CHANID, STARTTIME [, JOBID])>
 +
 
 +
This method is required, and must be called before C<init()>.
 +
 
 +
It is used to set the channel ID and starting time of the recording to
 +
be processed.  The optional third parameter holds the job ID, and must
 +
be supplied if locking is being used (see C<set_lock_file>).
 +
 
 +
The expected formats for these three parameters are simply the strings
 +
that MythTV supplies to user jobs when the pseudo-parameters
 +
B<%CHANID%>, B<%STARTTIMEISO%>, and B<%JOBID%> are used in the command
 +
line invocation.
 +
 
 +
=cut
 +
 
 +
sub set_program_identifier {
 +
    my $self = shift;
 +
    my $chanid = shift;
 +
    my $starttime = shift;
 +
    my $jobid = shift;
 +
 
 +
    die "It is not legal to call set_program_identifier more than once on a MythXCode object" if $self->{ chanid };
 +
 
 +
    die "Failed to supply a channel ID" if ! $chanid;
 +
    die "Failed to supply a starttime" if ! $starttime;
 +
   
 +
    $self->{ chanid } = $chanid;
 +
    $self->{ starttime } = $starttime;
 +
    $self->{ jobid } = $jobid;
 +
 
 +
}
 +
 
 +
 
 +
 
 +
=head2 C<init()>
 +
 
 +
This method is required.  It validates some of the configurations set
 +
up by the previously-described methods.  It verifies that the database
 +
schema is one that has been tested and is known to work.  If locking
 +
is enabled, it acquires the lock.
 +
 
 +
This method will never return an error, but it may not return.  If the
 +
configuration settings supplied earlier are wrong, it may ABEND at
 +
this time.  If the process has to move out of the way to allow a
 +
commercial flagging job to move up in the queue, it will do a quiet
 +
exit and not return.
 +
 
 +
=cut
 +
 
 +
sub init {
 +
    my $self = shift;
 +
 
 +
    $self->check_database_schema();
 +
    $self->wait_on_lock();
 +
    $self->{ initialized } = 1;
 +
    $self->read_recording_data();
 +
}
 +
 
 +
 
 +
=head2 C<perform_backup()>
 +
 
 +
This method is optional, and must be called after C<init()>. 
 +
 
 +
If a backup directory was set with C<set_backup_dir()>, the backup is
 +
performed at this time.  See C<set_backup_dir()> for details of the
 +
location of the backups.  The backup holds the original MPEG recording
 +
file, a file named F<recovery> that shows how to copy this file back
 +
to its original location, and several MySQL command files suitable for
 +
streaming directly into F<mysql> to restore the relevant database
 +
entries for the recording.
 +
 
 +
B<NOTE>: no backups will be performed unless this method is explicitly
 +
called.
 +
 
 +
=cut
 +
 
 +
sub perform_backup {
 +
    my $self = shift;
 +
    my $newdir = $self->{ backup_dir };
 +
 
 +
    die "Failed to call init()" if ! $self->{ initialized };
 +
 
 +
    if ( ! $newdir ) {
 +
return;
 +
    }
 +
 
 +
    $newdir = $newdir . "/transcode_$$";
 +
    die "Backup directory already exists" if -d $newdir;
 +
    mkdir $newdir,0700 || die "Failed to create backup directory.";
 +
    my $caption_filename = $self->generate_caption_filename();
 +
 
 +
    if ( $self->get_debug_level() > 0 ) {
 +
print "cp $self->{ orig_pathname } $newdir\n";
 +
if ( -s $caption_filename) {
 +
    print "cp $caption_filename $newdir\n";
 +
}
 +
 
 +
    } else {
 +
$self->set_job_status("Backing up original file.");
 +
if (system( "cp", $self->{ orig_pathname }, $newdir ) != 0 ) {
 +
    die "Failed to make the backup copy.";
 +
}
 +
if ( -s $caption_filename ) {
 +
    if (system( "cp", $caption_filename, $newdir ) != 0 ) {
 +
die "Failed to make the backup copy of .srt file.";
 +
    }
 +
}
 +
my $hints;
 +
open $hints, ">$newdir/recovery";
 +
print $hints "cp $newdir/$self->{ orig_basename} $self->{ orig_pathname }\n";
 +
if ( -s $caption_filename ) {
 +
    my $caption_basename = basename($caption_filename);
 +
    my $caption_dirname = dirname($caption_filename);
 +
    print $hints "cp $newdir/$caption_basename $caption_dirname\n";
 +
}
 +
 
 +
for ( @tables_to_backup ) {
 +
    print $hints "mysql $self->{ dbname } < $newdir/$_\n";
 +
}
 +
 
 +
close $hints;
 +
    }
 +
 
 +
    for ( @tables_to_backup ) {
 +
 +
my $tablename = $_;
 +
 
 +
my $hints;
 +
open $hints, ">$newdir/$tablename";
 +
print $hints "DELETE FROM $_ WHERE chanid='$self->{ chanid }' AND starttime='$self->{ starttime }';\n";
 +
my @onetable = @{$self->{ backups }->{ $tablename }};
 +
for ( my $i = 1; $i <= $#onetable; $i++ ) {
 +
 
 +
    print $hints "INSERT INTO $_ (", join(',', @{$onetable[0]}), " ) VALUES ('", join ("','", map { my $t = $_; $t =~ s|'|\\'|g; $t; } @{$onetable[$i]}), "');\n";
 +
}
 +
if ( ! close $hints ) {
 +
    die "Failed to write backup data file $tablename";
 +
}
 +
    }
 +
 
 +
    if ( $self->get_debug_level() == 0 ) {
 +
$self->set_job_status("");
 +
    }
 +
}
 +
 
 +
 
 +
=head2 C<prepare_captions()>
 +
 
 +
This method is optional, and must be called after C<init()>.
 +
 
 +
This method extracts the captions from the recording and applies the
 +
cutlist (if any) to the resulting .srt file.
 +
 
 +
This method should be called before C<transcode_to_h264()>, as
 +
otherwise captions and cutlist data will be lost.
 +
 
 +
=cut
 +
 
 +
sub prepare_captions {
 +
    my $self = shift;
 +
 
 +
    die "Failed to call init()" if ! $self->{ initialized };
 +
 
 +
    if ( ! $self->captions_already_extracted() ) {
 +
$self->extract_captions();
 +
    } else {
 +
print "Captions already present in a .srt file.\n";
 +
# Note that extract_captions applies the cutlist as it works
 +
if ( $self->has_cutlist() ) {
 +
    $self->generate_cut_captions();
 +
}
 +
    }
 +
}
 +
 
 +
 
 +
 
 +
=head2 C<transcode_to_h264()>
 +
 
 +
This method is optional, and must be called after C<init()>.
 +
 
 +
If a cutlist exists, or if captions are to be preserved,
 +
C<prepare_captions()> should be called before this method.
 +
 
 +
This method transcodes a recording to H.264 while added extra
 +
keyframes at the cut points.  It then cuts the recording cleanly at
 +
those positions, and converts the file to a transport stream so that
 +
the seek table rebuild code will work on it.  It will use the remote
 +
F<ffmpeg> host, if requested (see C<set_remote_ffmpeg_engine()>).
 +
 
 +
Unless running in debugging mode (see C<set_debug_level()>), this
 +
operation makes permanent changes to the recording on disk and to the
 +
database entries related to it.
 +
 
 +
=cut
 +
 
 +
sub transcode_to_h264 {
 +
     my $self = shift;
 +
 
 +
     die "Failed to call init()" if ! $self->{ initialized };
 +
 
 +
     $self->perform_transcoding_to_h264();
 +
}
 +
 
 +
 
 +
=head1 AUTHOR
 +
 
 +
Christopher Neufeld.  Copyright 2013, released under the GPL version 3.
 +
 
 +
=cut
 +
 
 +
 
 +
</pre>
 +
 
 +
== Invocation Script ==
 +
 
 +
The .pm file describes a class.  A separate script is needed to invoke the methods defined in the class.  Here is the one I use, xcode_to_h264.pl
 +
 
 +
<pre>
 +
 
 +
#! /usr/bin/perl
 +
#
 +
# Invoke as a user job with:
 +
# /home/mythtv/xcode_to_h264.pl %CHANID% %STARTTIMEISO% %JOBID%
  
== Invocation Script ==
+
# New code to transcode.
  
The .pm file describes a class.  A separate script is needed to invoke the methods defined in the class.  Here is the one I use, xcode_to_h264.pl
+
use lib '/home/mythtv';
 
 
<pre>
 
#! /usr/bin/perl
 
 
 
# xcode_to_h264.pl is a user job.  It should be given the three parameters  %CHANID% "%STARTTIMEISO% %JOBID%
 
 
 
use lib '/home/mythtv';     # My MythXCode.pm is located here
 
  
 
use MythXCode;
 
use MythXCode;
Line 1,415: Line 1,823:
  
 
my $dbname = "mythconverg";
 
my $dbname = "mythconverg";
my $dbuser = "USER";
+
my $dbuser = "mythtv";
my $dbpasswd = "PASSWORD";
+
my $dbpasswd = "password";
  
 
# my $backup_dir = "/myth/tmp";
 
# my $backup_dir = "/myth/tmp";
Line 1,438: Line 1,846:
  
 
$worker->set_db_parms($dbname, $dbuser, $dbpasswd);
 
$worker->set_db_parms($dbname, $dbuser, $dbpasswd);
 
 
# $worker->set_backup_directory($backup_dir);
 
# $worker->set_backup_directory($backup_dir);
 
 
$worker->set_debug_level($dbglevel);
 
$worker->set_debug_level($dbglevel);
 
 
# $worker->set_lock_file($lock_file);
 
# $worker->set_lock_file($lock_file);
 
# $worker->set_remote_ffmpeg_engine("ssh -i /home/mythtv/.ssh/bigboxkey bigbox", 3);
 
# $worker->set_remote_ffmpeg_engine("ssh -i /home/mythtv/.ssh/bigboxkey bigbox", 3);
 +
# $worker->set_ffmpeg_rebuild();
  
 
$worker->set_program_identifier($chanid, $starttime, $jobid);
 
$worker->set_program_identifier($chanid, $starttime, $jobid);
Line 1,451: Line 1,857:
  
 
# $worker->perform_backup();
 
# $worker->perform_backup();
 
+
$worker->prepare_captions();
$worker->cut_and_caption();
 
 
$worker->transcode_to_h264();
 
$worker->transcode_to_h264();
  

Revision as of 21:05, 3 January 2013


Author Christopher Neufeld
Description This framework supplies the means for a user job to do a cut on a MythTV recording, while still retaining the ability of MythTV to display closed captions. It also provides methods for transcoding the video to H.264 format, with a valid seek table, while preserving captions.
Supports


A common request is to perform a transcode without losing the closed caption data in the ivtv data stream. For technical reasons, this is a difficult problem. The technique outlined here allows the preservation of captions during a transcode. This is done not by preserving the caption data in the transcoded stream, but by extracting it into a .srt file, which is a file that MythTV automatically detects and makes available if caption displaying is enabled. Once the .srt file is produced, it can be used with the stream however it is transcoded, so converting it to H.264 format is also supported, and still preserves the captions.

This script honours the cutlist, doing exact cuts even when the cuts are not located on keyframes. It does this by forcing extra keyframes at the edges of the cuts during the transcode, then cutting between these new keyframes.

This technique makes use of the pull-captions.pl script shown at Closed_captioning, which in turn depends on the ccextractor project (see that page for details).

To use this script, first put the following .pm file into your Perl library path. The name I've used is MythXCode.pm, but you can rename that with a global search/replace if it collides with something in your namespace. To view the documentation for MythXCode.pm, simply run:

pod2man MythXCode.pm | groff -man -Tascii | less

Changes

2013-01-03:

  • Updated for compatibility with MythTV 0.25.2. Added the ability to use .srt files that exist at the time of the invocation, for instance if produced by an HD-PVR recording using the technique at Captions_With_HD_PVR. There have been some API changes since the original version. One now calls $worker->prepare_captions() in the place of $worker->cut_and_caption(). The latter function no longer exists.
  • We now use -qmax instead of forced bitrate values when generating the H.264 transcode.
  • We now use the default (High) profile, rather than Baseline.
  • We no longer support generating a lossless transcode preserving captions by omitting the transcode_to_h264() function call. That behaviour can be easily obtained by running the pull_captions.pl script then transcoding through the usual interfaces, this script isn't needed for that.
  • Tested on PVR-500 (ivtv capture), HDHomerun3 OTA (ATSC captions), and HD-PVR.

Library Module

Now, here is MythXCode.pm:

#! /usr/bin/perl

# A class to handle transcoding, for people with unusual requirements.
#

package MythXCode;

=pod

=head1 NAME

MythXCode Perl package - Support for transcoding and preserving captions

=head1 SYNOPSIS

    use MythXCode;
    my $worker = MythXCode->new();
    $worker->set_db_parms("mythconverg", "mythtv", "myth-db-password");
    $worker->set_program_identifier($chanid, $starttime, $jobid);
    $worker->init();
    $worker->prepare_captions();
    $worker->transcode_to_h264();
    undef $worker;


=head1 DESCRIPTION

The C<MythXCode> package provides configurable support for certain
operations connected to transcoding files in MythTV.  Its primary
function is to preserve closed-caption data as recordings are
manipulated, for instance when cutting to remove commercials, or when
creating DVDs.  It has been tested on NTSC recordings with ivtv
captions (Hauppauge PVR-500), on North American ATSC digital OTA
captions (HDHomerun3), and on (Hauppauge) HD-PVR recordings.

This package allows the user to convert recordings to H.264 with the
cut pieces removed.  The resulting transcoded recordings will have
valid seek tables and their closed captioning data will be intact.

The MythXCode objects have only been tested while working on a single
recording.  If multiple recordings are to be processed, each must be
done in its own MythXCode object, rather than reusing the object.

This package depends on the F<pull-captions.pl> script to extract
captions from recordings with cutlists.  That script can be found at
L<http://www.mythtv.org/wiki/Closed_captioning>, and it depends, in
turn, on the ccextractor binary found at
L<http://ccextractor.sourceforge.net/>.

The following methods should be considered public methods.  Methods
not documented here are intended for internal use within MythXCode,
and should not be called by users of the package.  The user should
call these methods in order, though not all applications will have to
use all methods.

=cut



use strict;
use DBI;
use File::Basename;
use Fcntl qw(:flock);

# This script pokes around in the database.  Things might go really
# wrong if the database innards are changed.  So, we sanity check
# against that.  This script has been tested on schema 1299.
my $schema_var = "DBSchemaVer";
my $verified_schema = 1299;

my $pts_time_offset = 1.00;   # have to add 1 second to keyframe times
			      # for HD-PVR recordings, because ffmpeg
			      # makes up PTS values in that context,
			      # and they start at 1 second, rather
			      # than at zero!  To be safe, we insert
			      # two keyframes, one for PTS offset 0,
			      # and another for offset 1.

my $pull_captions_pathname = "/home/mythtv/pull-captions.pl";
my $ffmpeg_pathname = "/usr/bin/ffmpeg";
my $ffprobe_pathname = "/usr/bin/ffprobe";
my $mplayer_pathname = "/usr/bin/mplayer";
my $mkvmerge_pathname = "/usr/bin/mkvmerge";

my $ffmpeg_containeropts = "-f matroska";

my $default_ffmpeg_qfactor = 26;
my $default_system_fps = 29.97;

# you must have "recordedprogram" here, other parts of the code use
# it.
my @tables_to_backup = ( "recorded", "recordedprogram", "recordedseek",
			 "recordedmarkup" );


sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->check_dependent_executables();

    $self->{ ffmpeg_qfactor } = $default_ffmpeg_qfactor;
    $self->{ system_fps } = $default_system_fps;

    return $self;
}


sub check_dependent_executables {
    my $self = shift;

    die "Unable to locate pull-captions.pl" if ! -x "$pull_captions_pathname";
    die "Unable to locate ffmpeg" if ! -x "$ffmpeg_pathname";
    die "Unable to locate ffprobe" if ! -x "$ffprobe_pathname";

    if ( ! -x "$mplayer_pathname" ) {
	print "NOTICE:  unable to locate mplayer, no cropping will be done.\n";
	$self->{ cannot_crop } = 1;
    }
}



sub get_debug_level {

    my $self = shift;
    if ( $self->{ debug_level } ) {
	return $self->{ debug_level };
    } else {
	return 0;
    }
}



sub connect_to_db {

    my $self = shift;

    die "Failed to set database parameters" if ! $self->{ parms_set };

    my $dsn;

    if ( $self->{ dbhost } ) {
	if ( $self->{ dbportnum } ) {
	    $dsn = "DBI:mysql:database=$self->{dbname};host-$self->{dbhost};port=$self->{dbport}";
	} else {
	    $dsn = "DBI:mysql:database=$self->{dbname};host-$self->{dbhost}";
	}
    } else {
	$dsn = "DBI:mysql:database=$self->{dbname}";
    }

    if ( @_ && @_[0]->{ readonly } ) {

	if ( $self->get_debug_level() > 0) {
	    print "Opening read-only connection to database.\n";
	}

	$self->{ dbhandle } = DBI->connect($dsn, $self->{ dbuser }, $self->{ dbpasswd }, { RaiseError => 1, AutoCommit => 0, ReadOnly => 1 });
    } else {

	if ( $self->get_debug_level() > 0) {
	    print "Opening read-write connection to database.\n";
	}

	$self->{ dbhandle } = DBI->connect($dsn, $self->{ dbuser }, $self->{ dbpasswd }, { RaiseError => 1, AutoCommit => 0, ReadOnly => 0 });
    }

    die "Failed to connect to the database: $DBI::errstr" if ! $self->{ dbhandle };
}

sub disconnect_db {
    my $self = shift;

    if ( $self->get_debug_level() > 0) {
	print "Disconnecting from database\n";
    }

    $self->{ dbhandle }->disconnect;
    $self->{ dbhandle } = undef();
}

sub check_database_schema {
    my $self = shift;

    $self->connect_to_db( { readonly => 1 } );
    my $qstr = "SELECT data FROM settings WHERE value=?";
    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($schema_var);

    my @onerow = $query->fetchrow_array();
    $query->finish();
    $self->disconnect_db();

    die "Unverified database schema $onerow[0].  This script must be carefully inspected for the new version." if $onerow[0] != $verified_schema;
}


sub read_recording_data {
    my $self = shift;
    $self->connect_to_db( { readonly => 1 } );

    my @dirs;
    my @onerow;
    
    my $query = $self->{ dbhandle }->prepare("SELECT dirname FROM storagegroup");
    $query->execute();
    while ( @onerow = $query->fetchrow_array ) {
	push @dirs, $onerow[0];
    }

    die "No storage group directories located" if $#dirs == -1;

    $query = $self->{ dbhandle }->prepare("SELECT basename FROM recorded WHERE chanid=? AND starttime=?");
    $query->execute( $self->{ chanid }, $self->{ starttime } );
    @onerow = $query->fetchrow_array;
    die "Failed to locate recording basename" if $#onerow != 0;
    $self->{ orig_basename } = $onerow[0];

    @onerow = $query->fetchrow_array;
    die "Corrupted database, found multiple recordings at chanid and starttime" if $#onerow != -1;

    for ( @dirs ) {
	my $candidate = $_ . "$self->{ orig_basename }";
	if ( -e "$candidate" ) {
	    $self->{ orig_pathname } = $candidate;
	    last;
	}
    }
    
    $self->{ backups } = {};
    for ( @tables_to_backup ) {
	@{$self->{ backups }->{ $_ }} = $self->retrieve_table ( $_ );
    }

    $self->disconnect_db();
}


sub retrieve_table {
    my $self = shift;
    my $tablename = shift;

    my $qstr = "SELECT * from $tablename WHERE chanid=? AND starttime=?";
    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($self->{ chanid }, $self->{ starttime });
    my $names = $query->{NAME};

    my @retval;
    push @retval, $names;

    while ( my @res = $query->fetchrow_array ) {
	push @retval, \@res;
    }

    return @retval;
}


sub generate_caption_filename {
    my $self = shift;
    
    my $localcopy = $self->{ orig_pathname };
    $localcopy =~ s/\.[^.]+$/.srt/;

    return $localcopy;
}

sub generate_new_caption_filename {
    my $self = shift;
    
    my $localcopy = $self->{ orig_pathname };
    $localcopy =~ s/\.[^.]+$/.srt.NEW/;

    return $localcopy;
}


sub captions_already_extracted {
    my $self = shift;

    return -s $self->generate_caption_filename();
}


sub has_cutlist {
    my $self = shift;

    $self->connect_to_db( { readonly => 1 } );

    my $qstr = "SELECT * FROM recordedmarkup WHERE chanid=? AND starttime=? AND ( type=0 OR type=1 )";

    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($self->{ chanid }, $self->{ starttime });
    my @onerow = $query->fetchrow_array;
    $query->finish();
    $self->disconnect_db();

    return $#onerow != -1;
}


sub seconds_to_hms {
    my $self = shift;
    my $timestamp = shift;

    my $hours = int($timestamp / 3600);
    $timestamp -= $hours * 3600;
    my $minutes = int($timestamp / 60);
    $timestamp -= $minutes * 60;
    my $whole_seconds = int($timestamp);
    my $milliseconds = 1000 * ($timestamp - $whole_seconds);

    return sprintf("%02d:%02d:%02d.%03d", $hours, $minutes, $whole_seconds, $milliseconds);
}


sub get_cutlist {
    my $self = shift;

    if ( $self->{ cutlist } ) {
	return $self->{ cutlist };
    }

    my $command = "mythutil -q -q --getcutlist --chanid=$self->{ chanid} --starttime='$self->{ starttime }'";
    print "EXECUTE:  $command\n";

    my $fh;
    if ( ! open ($fh, "$command |") ) {
	$self->set_job_status("Failed to extract cutlist");
	die "Cutlist extraction failed.";
    }

    while (<$fh>) {
	if ( m/^Cutlist: (.*)$/ ) {
	    $self->{ cutlist } = $1;
	}
    }

    print "cutlist= $self->{ cutlist }\n";

    if ( $self->{ cutlist } ) {
	# build the times for the new keyframes, and the cut times

	my $inverse_cutlist;
	my $inv_prev = 0;

	my $fkf = "-force_key_frames ";

	my $ctr = 0;
	my @intervals = split(",", $self->{ cutlist });
	foreach (@intervals) {
	    my $start = (split("-", $_))[0];
	    my $end = (split("-", $_))[1];

	    if ( $ctr != 0 ) {
		$fkf .= ",";
	    }

	    if ( $start > $inv_prev ) {
		my $decr = $start - 1;
		$inverse_cutlist .= "$inv_prev-$decr,";
	    }
	    $inv_prev = $end + 1;


	    my $start2 = $start / $self->{ system_fps };
	    my $end2 = ( $end + 1 ) / $self->{ system_fps };

	    # Make sure the order of new keyframes is correct.  For
	    # very short cuts, we have to reorder them because of the
	    # pts_time_offset silliness.
	    if ( $pts_time_offset != 0) {
		if ( $end2 - $start2 < $pts_time_offset ) {

		    $fkf .= sprintf("%.2f,%.2f,%.2f,%.2f", $start2 - 0.005, $end2 - 0.005, $start2 + $pts_time_offset - 0.005, $end2 + $pts_time_offset - 0.005 ); 

		} else {

		    $fkf .= sprintf("%.2f,%.2f,%.2f,%.2f", $start2 - 0.005, $start2 + $pts_time_offset - 0.005, $end2 - 0.005, $end2 + $pts_time_offset - 0.005 ); 

		}
	    } else {
		$fkf .= sprintf("%.2f,%.2f", $start2 - 0.005, $end2 - 0.005);
	    }

	    $ctr++;
	}

	$inverse_cutlist .= "$inv_prev-1300000";   # a nice 12-hour range

	my $ctr2 = 0;
	my $spl = "--split parts:";
	@intervals = split(",", $inverse_cutlist);
	foreach (@intervals) {
	    my $start = (split("-", $_))[0];
	    my $end = (split("-", $_))[1];

	    if ( $ctr2 != 0 ) {
		$spl .= ",+";
	    }

	    # Subtract 2 from start and from end+1, so that
	    # floating-point roundoff doesn't make us fall through to
	    # the next keyframe.  ffmpeg doesn't make consecutive
	    # keyframes without explicit directions to do so, so this
	    # should always work.
	    my $start2 = ( $start - 2) / $self->{ system_fps };
	    my $end2 = ( $end - 1 ) / $self->{ system_fps };

	    if ( $start2 < 0.005 ) {
		$start2 = 0.005;
	    }
	    if ( $end2 < 0.005 ) {
		$end2 = 0.005;
	    }

	    $spl .= sprintf("%s-%s", $self->seconds_to_hms($start2 - 0.005), $self->seconds_to_hms($end2 - 0.005));

	    $ctr2++;
	}

	if ( $ctr > 0 ) {
	    $self->{ forced_key_frames } = $fkf;
	    $self->{ split_arg } = $spl;
	    $self->{ inverse_cutlist } = $inverse_cutlist;
	}

    }

    return $self->{ cutlist };
}



sub clear_cutlist {
    my $self = shift;

    $self->connect_to_db();

    my $query;
    my $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=0";

    if ( $self->get_debug_level() > 0 ) {
	print "DBExecute:  $qstr;   args= '$self->{ chanid }','$self->{ starttime }'\n";
    } else {
	$query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($self->{ chanid }, $self->{ starttime });
    }

    $qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=? AND type=1";

    if ( $self->get_debug_level() > 0 ) {
	print "DBExecute:  $qstr;   args= '$self->{ chanid }','$self->{ starttime }'\n";
    } else {
	$query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($self->{ chanid }, $self->{ starttime });
    }

    $qstr = "UPDATE recorded SET cutlist=0 WHERE chanid=? AND starttime=?";
    if ( $self->get_debug_level() > 0 ) {
	print "DBExecute:  $qstr;   args= '$self->{ chanid }','$self->{ starttime }'\n";
    } else {
	$query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($self->{ chanid }, $self->{ starttime });
    }

    $qstr = "UPDATE recorded SET commflagged=0 WHERE chanid=? AND starttime=?";
    if ( $self->get_debug_level() > 0 ) {
	print "DBExecute:  $qstr;   args= '$self->{ chanid }','$self->{ starttime }'\n";
    } else {
	$query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($self->{ chanid }, $self->{ starttime });
    }

    if ( $self->get_debug_level() > 0 ) {
	print "COMMIT !!!\n";
    } else {
	$self->{ dbhandle }->commit || die "Database update failed clearing cutlist.\n";
    }

    $self->disconnect_db();
}


sub get_recordedprogram_table_data {
    my $self = shift;

    my $names = $self->{ backups }->{ "recordedprogram" }[0];
    my $res = $self->{ backups }->{ "recordedprogram" }[1];
    
    my %hashret;

    for (0 .. $#$res) {
	$hashret{$$names[$_]} = $$res[$_];
    }

    return %hashret;
}


sub safe_to_cut_before_captions {
    my $self = shift;

    return 0;
}

sub program_may_need_cropping {
    my $self = shift;

    return $self->{ video_res } == 480;
}

sub high_definition {
    my $self = shift;
    
    return ! ( $self->{ video_res } == 480 );
}


sub extract_captions {
    my $self = shift;

    my $command = "$pull_captions_pathname $self->{ chanid } '" . $self->{ starttime } . "' " . $self->generate_caption_filename() . " >/dev/null 2>&1";

    print "EXECUTE:  $command\n";
    if ( $self->get_debug_level() < 2 ) {
	$self->set_job_status("Extracting captions");
	if ( system($command) != 0) {
	    $self->set_job_status("Failed while extracting captions");
	    die "Failed to pull the captions from the recording.";
	}
	$self->set_job_status("Finished extracting captions");
    }
}



sub seconds_to_srt_ts {
    my $self = shift;
    my $timestamp_seconds = shift;
    my $rvstr;

    my $hours;
    my $minutes;
    my $whole_seconds;
    my $milliseconds;

    $hours = int($timestamp_seconds / 3600);
    $timestamp_seconds -= $hours * 3600;
    $minutes = int($timestamp_seconds / 60);
    $timestamp_seconds -= $minutes * 60;
    $whole_seconds = int($timestamp_seconds);
    $milliseconds = ( $timestamp_seconds - $whole_seconds ) * 1000;


    return sprintf("%02d:%02d:%02d,%03d", $hours, $minutes, $whole_seconds, $milliseconds);
}


sub generate_cut_captions
{
    my $self = shift;

    print "Applying cutlist to captions.\n";
    if ( $self->get_debug_level() > 1 ) {
	if ( $self->has_cutlist() ) {
	    print "Cut captions.\n";
	}
	return;
    }

    my $overlap_buffer = 0.002;   # minimum seconds between captions
    my $min_caption_duration = 0.3;  # minimum residence time of caption

    my $inputfile = $self->generate_caption_filename();
    my $outputfile = $self->generate_new_caption_filename();
    my $cutlist = $self->get_cutlist();

    my @intervals = split(",", $cutlist);

    my $cumulative_frames_dropped = 0;

    my $position = 0;
    my $marker = 0;
    my @ranges;
    my $start;
    my $end;

    foreach (@intervals) {
	$start = (split("-", $_))[0];
	$end = (split("-", $_))[1];

	$position = $start;
	
	if ( $position - $marker > 0) {
	    push @ranges, [ ( $marker, $position - 1, $cumulative_frames_dropped ) ];
	}
	$cumulative_frames_dropped += ( $end - $start + 1 );
	$marker = $end + 1;
    }
    push @ranges, [ ( $marker, 100000000, $cumulative_frames_dropped ) ];


    my $range_start;
    my $range_end;
    my $range_delay;

    my $ifile;
    my $outfile = <STDOUT>;

    open $ifile, "<$inputfile";
    open $outfile, ">$outputfile" || die "Failed to open new .srt to hold cut captions.";

    my $holdslash = $/;
    $/ = "\r\n\r\n";

    my $recnum = 1;
    my $caption_time_1;
    my $caption_time_2;
    my $prev_caption_end = -1000;
    my $caption_frame_1;
    my $caption_frame_2;
    my $caption_text;

    while (<$ifile>) {

	next if ! m/\d+\r\n(\d+):(\d+):(\d+),(\d+) --> (\d+):(\d+):(\d+),(\d+)\r\n(.*)/s;
	
	$caption_time_1 = $1 * 3600 + $2 * 60 + $3 + $4 * 0.001;
	$caption_time_2 = $5 * 3600 + $6 * 60 + $7 + $8 * 0.001;
	$caption_frame_1 = $caption_time_1 * $self->{ system_fps };
	$caption_frame_2 = $caption_time_2 * $self->{ system_fps };

	$caption_text = $9;

	for my $i ( 0 .. $#ranges ) {
	    $range_start = $ranges[$i][0];
	    $range_end = $ranges[$i][1];
	    $range_delay = $ranges[$i][2];

	    if ( $caption_frame_2 >= $range_start && $caption_frame_1 <= $range_end ) {
		if ( $caption_frame_1 < $range_start ) {
		    $caption_frame_1 = $range_start;
		}
		if ( $caption_frame_2 > $range_end ) {
		    $caption_frame_2 = $range_end;
		}

		$caption_time_1 = ( $caption_frame_1 - $range_delay ) / $self->{ system_fps };
		$caption_time_2 = ( $caption_frame_2 - $range_delay ) / $self->{ system_fps };
		if ( $caption_time_1 < $prev_caption_end + $overlap_buffer ) {
		    $caption_time_1 = $prev_caption_end + $overlap_buffer;

		    if ( $caption_time_2 < $caption_time_1 + $min_caption_duration ) {
			$caption_time_2 = $caption_time_1 + $min_caption_duration;
		    }
		}

		printf $outfile "%d\r\n%s --> %s\r\n%s\r\n", $recnum, $self->seconds_to_srt_ts($caption_time_1), $self->seconds_to_srt_ts($caption_time_2), $caption_text;

		$recnum++;
		$prev_caption_end = $caption_time_2;
		last;
	    }
	}
    }

    $/ = $holdslash;
}



sub examine_source_media {
    my $self = shift;


    print "EXECUTE:  $ffprobe_pathname $self->{ orig_pathname } 2>&1\n";

    my $fh;
    open ($fh, "$ffprobe_pathname $self->{ orig_pathname } 2>&1 |") 
	|| die "Unable to run ffprobe on $self->{ orig_pathname }";


    my $saw_5_1;
    while (<$fh>) {
	if ( /Duration: ([0-9]+):([0-9]+):([0-9]+\.[0-9][0-9]), start: / ) {
	    $self->{ duration_secs } = $1 * 3600 + $2 * 60 + $3;
	    print "Media duration is $self->{ duration_secs } seconds.\n";
	}
	if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Video:.*(1920x1080|1280x720|720x480)/ ) {
	    $self->{ video_map } = "-map $1:$2";
	    if ( $self->{ map_dot } ) {
		$self->{ video_map } =~ s/:/./g;
	    }

	    if ( $3 =~ "1920x1080" ) {
		$self->{ video_res } = 1080;

	    } elsif ( $3 =~ "1280x720" ) {

		$self->{ video_res } = 720;
		
	    } elsif ( $3 =~ "720x480" ) {
		$self->{ video_res } = 480;
	    } else {
		die "Unable to determine video resolution";
	    }
	}

	if ( /Stream #([0-9]+)[.:]([0-9]+)\[.* Audio: / ) {

	    my $mcopy = "-map $1:$2";
	    if ( $self->{ map_dot } ) {
		$mcopy =~ s/:/./g;
	    }

	    if ( ! $saw_5_1 ) {

		if ( /, 5\.1, / ) {
		    $saw_5_1 = 1;
		    $self->{ audio_map } = $mcopy;
		}

		if ( m/, stereo, / ||  m/, 2 channels, / ) {

		    $self->{ audio_map } = $mcopy;
		}
	    }
	}
    }
    close $fh;

    die "Can't find video information" if ! $self->{ video_map } || ! $self->{ video_res };
    die "Can't find audio information" if ! $self->{ audio_map };
}


sub get_cropping_argument {
    my $self = shift;

    $self->set_job_status("Determining cropping values");

    # We'll go 5 minutes into the recording, to avoid any issues with
    # opening credits being in a strange shape.  Then, draw 10 samples
    # at 15 second intervals.  We choose the most commonly reported
    # answer.

    my %votehash;

    for (0 .. 10) {
	my $time_delay = 300 + $_ * 15;
	my @oneshot = $self->probe_cropping_data($self->{ orig_pathname }, $time_delay);
	for (@oneshot) {
	    if ( ! $votehash{$_} ) {
		$votehash{$_} = 1;
	    } else {
		$votehash{$_}++;
	    }
	}
    }

    my $beststring = "";
    my $bestcount = -1;
    foreach my $key (keys %votehash) {
	if ( $votehash{$key} > $bestcount ) {
	    $beststring = $key;
	    $bestcount = $votehash{$key};
	}
    }
    return $beststring;
}



sub probe_cropping_data {
    my $self = shift;
    my $filename = shift;
    my $delay = shift;

    my $fh;
    open ($fh, "$mplayer_pathname $filename -ss $delay -identify -frames 10 -vo md5sum:outfile=/dev/null -ao null -nocache -vf pp=lb,cropdetect=20:16 2>/dev/null |") || die "Unable to probe for cropping settings.";

    my @result;
    while (<$fh>) {
	if ( /CROP.*X:.*Y:.*\((-vf crop=[0-9]+:[0-9]+:[0-9]+:[0-9]+)\)/ ) {
	    push @result, $1;
	}
    }
    close $fh;
    return @result;
}


sub set_job_status {
    my $self = shift;
    my $text = shift;

    die "Job status string too long" if length($text) > 127;

    if ( $self->get_debug_level() == 0 && $self->{ jobid } ) {
	$self->connect_to_db();

	my $qstr = "UPDATE jobqueue SET comment=? WHERE id=?";
	my $query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($text, $self->{ jobid });
	$self->{ dbhandle }->commit();
	
	$self->disconnect_db();
    } else {
	print "STATUS:  $text\n";
    }
}


# This resubmits the job as another job with a later time.  Then it
# erases its own entry, which will make noise in the error log for the
# backend, but otherwise is safe.
sub resubmit_self_and_exit {
    my $self = shift;
    
    my $jobtype = $self->my_job_type();

    $self->connect_to_db();

# This copies my entry into the job queue, but submitted for "now".
    my $qstr = "INSERT INTO jobqueue (chanid,starttime,inserttime,type,cmds,flags,status,hostname,args,schedruntime) SELECT chanid,starttime,current_timestamp(),type,cmds,flags,1,hostname,args,current_timestamp() FROM jobqueue WHERE id=?";

    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($self->{ jobid });

    $qstr = "DELETE FROM jobqueue WHERE id=?";
    $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($self->{ jobid });

    # and this rewrites all the other queued MythXCode jobs, so they don't
    # have to do that on their own.

    $qstr = "UPDATE jobqueue SET inserttime=current_timestamp() WHERE type=? AND status=1";
    $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($jobtype);

    $self->{ dbhandle }->commit();

    $self->disconnect_db();

    exit 0;
}


sub my_job_type {
    my $self = shift;

    $self->connect_to_db( { readonly => 1 } );
    my $jobtype;

    my $qstr = "SELECT type FROM jobqueue WHERE id=?";
    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($self->{ jobid });
    my @onerow = $query->fetchrow_array;
    
    if ( @onerow ) {
	$jobtype = $onerow[0];
    }

    $query->finish();
    $self->disconnect_db();
    return $jobtype;
}


# We might want to let other jobs go first, if we're blocking waiting
# for another MythXCode process to complete.  This determines if there are
# any others waiting.
sub other_jobs_queued {
    my $self = shift;
    my $rv = undef;

    my $jobtype = $self->my_job_type;

    if ( $jobtype ) {

	$self->connect_to_db( { readonly => 1 } );
    
	# Now, find other queued jobs, not of the same type
	my $qstr = "SELECT COUNT(id) FROM jobqueue WHERE type != ? AND status=1";
	my $query = $self->{ dbhandle }->prepare($qstr);
	$query->execute($jobtype);
	my @onerow = $query->fetchrow_array;
	
	if ( $onerow[0] != 0 ) {
	    $rv = 1;
	}

	$query->finish();
	$self->disconnect_db();
    }


    return $rv;
}


sub wait_on_lock {
    my $self = shift;

    if ( $self->{ lockfile } ) {

	if ( ! $self->{ jobid } ) {
	    die "Asked for locking, but without a job ID.";
	}

	# We'll auto-close this on exit, releasing the lock.
	open $self->{ lockhandle }, '>', $self->{ lockfile } || die "Failed to create lockfile.";

	# Try a non-blocking, exclusive lock
	while ( ! flock $self->{ lockhandle}, LOCK_EX | LOCK_NB ) {

	    if ( $self->other_jobs_queued() ) {
		$self->resubmit_self_and_exit();
	    }

	    # wait for 5 minutes and check again.
	    sleep 301;
	}
    }
}


sub perform_transcoding_to_h264 {
    my $self = shift;

    $self->examine_source_media();
    $self->get_cutlist();

    my $cropping_arg;
    my @keyframes;

    if ( ! $self->{ cannot_crop } && $self->program_may_need_cropping() ) {
	$cropping_arg = $self->get_cropping_argument();
    }

    my $xcoded_name = $self->{ orig_pathname };
    $xcoded_name =~ s/\.[^.]+$/.mkv/;

    # Don't re-transcode the same file
    if ( $self->{ orig_pathname } eq $xcoded_name ) {
	return;
    }

    # Before we get to .mkv we'll pass through a .tmp file and a .ts file
    my $tmpname1 = $xcoded_name . ".tmp";
    my $tmpname2 = $xcoded_name . ".ts";
    my $tmpname3 = $xcoded_name . ".tmp.2";

    if ( -e $tmpname1 ) {
	unlink $tmpname1;
    }
    if ( -e $tmpname2 ) {
	unlink $tmpname2;
    }
    if ( -e $tmpname3 ) {
	unlink $tmpname3;
    }

    # we use the h264_mp4toannexb filter so that we can rebuild the
    # seek table.  That's convenient.

    my $command;
    my $localname1;
    my $localname2;
    my $localname3;

    my $audioopts;
    if ( ! $self->high_definition() ) {
	$audioopts = "-acodec libfaac -ab 256k -ac 2";
    } else {
	$audioopts = "-acodec copy";
    }

    if ( $self->{ ssh_string } ) {
	$localname1 = basename($tmpname1);
	$localname2 = basename($tmpname2);
	$localname3 = basename($tmpname3);
	$command = "$self->{ ssh_string } $ffmpeg_pathname -y -i - -r $self->{ system_fps } -threads $self->{ ssh_threads } -c:v libx264 -qmax $self->{ ffmpeg_qfactor } $self->{ forced_key_frames } $cropping_arg $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $localname1 2\\>\\&1 < $self->{ orig_pathname }";
    } else {
	$command = "$ffmpeg_pathname -y -i $self->{ orig_pathname } -r $self->{ system_fps } -c:v libx264 -qmax $self->{ ffmpeg_qfactor } $self->{ forced_key_frames} $cropping_arg $self->{ video_map } $audioopts $self->{ audio_map } $ffmpeg_containeropts $tmpname1 2>&1 </dev/null";
    }

    print "EXECUTE:  $command\n";
    if ( $self->get_debug_level() > 1 ) {

	print "Transcode, introducing new keyframes.\n";
	print "Split out the cut parts.\n";
	print "Copy cut .srt file into position.\n";
	print "Rebuild keyframe index.\n";
	print "rename $tmpname2 $xcoded_name\n";
	print "unlink $self->{ orig_pathname }\n";
	print "Update database to reflect change\n";

    } else {

	$self->set_job_status("Beginning h.264 transcode");

	my $oldIRS = $/;
	$/ = "\r";

	my $fh;
	
	open ( $fh, "$command |") || die "Failed to execute ffmpeg for transcoding";

	my $last_percent = 0;
	while (<$fh>) {

	    my $timesecs;
	    my $fps;

	    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+\.[0-9]+) / ) {
		$fps = $1;
		$timesecs = $2;
	    }

	    if ( /^frame= *[0-9]+ +fps= *([0-9]+) +q=.*time= *([0-9]+):([0-9]+):([0-9]+\.[0-9]+) / ) {
		$fps = $1;
		$timesecs = $2 * 3600 + $3 * 60 + $4;
	    }

	    if ( $timesecs ) {
	    
		my $frac_done = $timesecs / $self->{ duration_secs };
		my $this_percent = int( $frac_done * 100 );

		if ($this_percent > $last_percent) {
		    $self->set_job_status("H.264 transcode $this_percent\% done.  $1 FPS");
		    $last_percent = $this_percent;
		}
	    }
	}

	close $fh;
	$/ = $oldIRS;

	if ( $? != 0 ) {
	    $self->set_job_status("H.264 transcode failed");
	    die "Transcoding to h.264 failed.";
	}

	if ( $self->has_cutlist() ) {

	    $self->set_job_status("Using mkvmerge to apply cutlist");

	    if ( $self->{ ssh_string } ) {
		$command = "$self->{ ssh_string} $mkvmerge_pathname $self->{ split_arg } -o $localname3 --compression 0:none $localname1 && $self->{ ssh_string } mv $localname3 $localname1";
	    } else {
		$command = "$mkvmerge_pathname $self->{ split_arg } -o $tmpname3 --compression 0:none $tmpname1 && mv $tmpname3 $tmpname1";
	    }

	    print "EXECUTE:  $command\n";

	    if ( system($command) != 0 ) {
		$self->set_job_status("mkvmerge cutting failed");
		die "Transcoding to h.264 failed.";
	    }
	    
	}

	$self->set_job_status("Running through mp4toannexb to allow rebuilding the keyframe index");

	if ( $self->{ ssh_string } ) {
	    $command = "$self->{ ssh_string} $ffmpeg_pathname -y -threads 1 -i $localname1 -vcodec copy -bsf:v h264_mp4toannexb -acodec copy -f mpegts $localname2 >/dev/null 2>&1";
	} else {
	    $command = "$ffmpeg_pathname -i $tmpname1 -threads 1 -vcodec copy -bsf:v h264_mp4toannexb -acodec copy -f mpegts $tmpname2 >/dev/null 2>&1";
	}
	print "EXECUTE:  $command\n";
	if ( system($command) != 0 ) {
	    $self->set_job_status("H.264 transcode failed");
	    die "Transcoding to h.264 failed.";
	}

	if ( $self->{ ssh_string } ) {

	    if ( $self->{ ffmpeg_rebuild } ) {
		@keyframes = $self->parse_keyframes_from_ffmpeg($localname2);
	    }


	    $self->set_job_status("Copying file back from remote ffmpeg engine.");
	    $command = "$self->{ ssh_string } cat $localname2 > $tmpname2";
	    if ( system($command) != 0 ) {
		$self->set_job_status("H.264 transcode failed");
		die "Copying file back from remote engine failed.";
	    }
	    $command = "$self->{ ssh_string} /bin/rm -f $localname1 $localname2";
	    if ( system($command) != 0 ) {
		print "Filed to unlink file on remote engine.";
	    }
	} else {

	    if ( $self->{ ffmpeg_rebuild } ) {
		@keyframes = $self->parse_keyframes_from_ffmpeg($tmpname2);
	    }

	    unlink $tmpname1;
	}


	$self->set_job_status("Finished h.264 transcode");

	rename $tmpname2, $xcoded_name;
	my $newlen = -s $xcoded_name;

	$self->connect_to_db();

	my $qstr = "DELETE FROM recordedseek WHERE chanid=? AND starttime=?";
	if ( $self->get_debug_level() == 0 ) {
	    my $query = $self->{ dbhandle }->prepare($qstr);
	    $query->execute($self->{ chanid }, $self->{ starttime });
	} else {
	    print "$qstr\n";
	}

	$qstr = "DELETE FROM recordedmarkup WHERE chanid=? AND starttime=?";
	if ( $self->get_debug_level() == 0 ) {
	    my $query = $self->{ dbhandle }->prepare($qstr);
	    $query->execute($self->{ chanid }, $self->{ starttime });
	} else {
	    print "$qstr\n";
	}

	$qstr = "UPDATE recorded SET basename=?,filesize=?,transcoded='1' WHERE chanid=? AND starttime=?";
	if ( $self->get_debug_level() == 0 ) {
	    my $query = $self->{ dbhandle }->prepare($qstr);
	    $query->execute(basename($xcoded_name), $newlen, $self->{ chanid }, $self->{ starttime });
	} else {
	    print "$qstr\n";
	}

	if ( $self->get_debug_level() == 0 ) {
	    if ( ! $self->{ dbhandle }->commit() ) {
		unlink $xcoded_name;
		die "Failed to move transcoded file into database.";
	    }

	    unlink $self->{ orig_pathname };

	    $self->disconnect_db();
	}

	# Clear the cut information, we've now finished modifying the file
	$self->clear_cutlist();

	# Move the new .srt into position
	if ( -s $self->generate_new_caption_filename() ) {
	    my $cut_name = $self->generate_new_caption_filename();
	    my $final_path = $self->generate_caption_filename();
	    if ( $self->get_debug_level() == 0) {
		rename $cut_name, $final_path;
	    } else {
		print "Renaming to move $cut_name to $final_path\n";
	    }
	}

	# Rebuild the seek table, but don't worry if it fails.
	$self->set_job_status("Rebuilding seek table after transcode");

	if ( $self->{ ffmpeg_rebuild } ) {

	    $self->db_commit_keyframes_manually(\@keyframes);

	} else {

	    my $command = "mythcommflag --rebuild --chanid=$self->{ chanid } --starttime='$self->{ starttime }'";
	    print "EXECUTE:  $command\n";
	    if ( $self->get_debug_level() == 0 ) {
		system($command);
	    }
	    $self->set_job_status("Finished rebuilding seek table");
	}
    }
}


sub parse_keyframes_from_ffmpeg {
    my $self = shift;
    my $transport_stream_file = shift;

    $self->set_job_status("Using ffmpeg to extract keyframe positions");

    my @rv;  # a vector of (n, pos) for all keyframes

    my $command = "$ffmpeg_pathname -y -nostats -i $transport_stream_file -vf showinfo -f null -";
    
    if ( $self->{ ssh_string } ) {
	$command = "$self->{ ssh_string } " . $command . " 2\\>\\&1";
    } else {
	$command = $command . " 2>&1";
    }

    my $prevpos = -1;
    my $fh;
    open ( $fh, "$command |") || return;
    while (<$fh>) {
	if ( /.* n:(\d+) .* pos:(\d+) .* iskey:1 .*/ ) {

	    if ( $2 == $prevpos ) {
		die "Obtained bad data trying to locate keyframes.";
	    }
	    $prevpos = $2;
	    push @rv, [$1, $2];
	}
    }

    close $fh;
    return @rv;
}


sub db_commit_keyframes_manually {
    my $self = shift;
    my @kf_array = @{$_[0]};
    shift;

    if ( $self->get_debug_level() == 0 ) {

	$self->connect_to_db();
	my $query = $self->{ dbhandle }->prepare("DELETE FROM recordedseek WHERE chanid=? AND starttime=?");
	$query->execute( $self->{ chanid }, $self->{ starttime } );

	my $i;
	my $j;
	for $i ( 0 .. $#kf_array ) {
	    $query = $self->{ dbhandle }->prepare("INSERT INTO recordedseek VALUES(?,?,?,?,?)");
	    $query->execute( $self->{ chanid }, $self->{ starttime }, $kf_array[$i][0], $kf_array[$i][1], 9);
	}

	$self->{ dbhandle }->commit();
	$self->disconnect_db();

    } else {

	printf "DELETE FROM recordedseek WHERE chanid='%d' AND starttime='%s'\n", $self->{ chanid }, $self->{ starttime };

	my $i;
	my $j;
	for $i ( 0 .. $#kf_array ) {
	    printf "INSERT INTO recordedseek VALUES(%d,%s,%d,%d,%d)\n", $self->{ chanid }, $self->{ starttime }, $kf_array[$i][0], $kf_array[$i][1], 9;
	}
    }
}



sub set_queue_status {
    my $self = shift;
    my $code = shift;

    $self->connect_to_db();

    my $qstr = "UPDATE jobqueue SET status=? WHERE id=?";
    my $query = $self->{ dbhandle }->prepare($qstr);
    $query->execute($code, $self->{ jobid } );

    $self->{ dbhandle }->commit();
    $self->disconnect_db();
}


#########################################################################
#
# The following methods are expected to be used by the consumer.  The
# methods above this line are internal, consider them 'private'.
#
#########################################################################

=head2 C<set_db_parms(DBNAME, DBUSER, DBPASSWD [, DBHOST [, DBPORT ] ])>

This method is required and must be called before C<init()>.  

This method informs the MythXCode object of the parameters needed to
access the MythTV database.  At least I<DBNAME>, I<DBUSER>, and
I<DBPASSWD> are required parameters.  I<DBHOST> is optional, and
declares that the database is running on a remote host, which can be
either a resolvable hostname or an IP number.  I<DBPORT> is the
non-standard port number on the remote host.  To use a non-standard
port number on the local host, set I<DBHOST> to the IP number of an
interface on the local machine that is listening for connections.

This method ABENDs if the three required parameters are not supplied.
Otherwise, it will always succeed.  It does not validate the
connection parameters.

=cut

sub set_db_parms {
    my $self = shift;
    my $dbname = shift;
    my $dbuser = shift;
    my $dbpasswd = shift;
    my $dbhost = shift;
    my $dbport = shift;

    die "Required database name not supplied." if ! $dbname;
    die "Required database user not supplied." if ! $dbuser;
    die "Required database password not supplied." if ! $dbpasswd;

    $self->{ dbname } = $dbname;
    $self->{ dbuser } = $dbuser;
    $self->{ dbpasswd } = $dbpasswd;
    $self->{ dbhost } = $dbhost;
    $self->{ dbport } = $dbport;
    $self->{ parms_set } = 1;
}

=head2 C<set_backup_directory(DIRNAME)>

This method is optional, and must be run before C<init()>.

This method informs the MythXCode object that we want a backup made of
the working files before processing begins.  A new directory will be
created, with filename F<DIRNAME/transcode_PID> where PID is the
process ID of the process running MythXCode.  If that directory
already exists, it is an error, and execution terminates.

The directory must have sufficient free space to hold the recording
file, plus a relatively small amount of database information.

Note that merely calling C<set_backup_directory()> is not sufficient
to perform the backup.  The C<perform_backup()> function must be
invoked.

=cut

sub set_backup_directory {
    my $self = shift;
    my $backup_dir = shift;

    $self->{ backup_dir } = $backup_dir;
}

=head2 C<set_debug_level(NUM)>

This method is optional, and must be run before C<init()>.

MythTV systems are not all alike.  The operations that this package
performs are potentially destructive.  While every attempt has been
made to detect and gracefully handle error conditions, it is
recommended that the user test the procedure first.  The debug level
should be set first to 2, the script executed, and the log examined
for unexpected or undesirable behaviour.  In debug level 2, no
database writes are performed, and no files are created or modified.

If everything looks safe at debug level 2, the debug level should be
reduced to 1 and the procedure repeated.  At debug level 1, no
database writes are performed, but transcoded/cut files are produced
and a .srt file with captions information is created.  These files
will occupy space on disk and will not be deleted by MythTV, which has
no knowledge of them, so they should be manually deleted after
debugging is complete.  Again, the log should be examined for any
unexpected or undesirable behaviour.

Finally, the debug level should be set to 0.  Files are created,
original recording files are deleted and replaced by the new files,
and database entries are changed to reflect this.  This is the normal
operation mode.  If anything goes wrong, the backup (if produced),
allows you to reset the recording to the state it was in before the
script executed.  Otherwise, you can delete the backup.

=cut

sub set_debug_level {
    my $self = shift;
    my $debug_level = shift;

    $self->{ debug_level } = $debug_level;
}


=head2 C<set_qmax(NUM)>

This method is optional, and must be run before C<init()>.

The ffmpeg transcoding requires a target quality factor.  The lower
this number, the higher the quality, but the higher the bitrate.  The
default is 26, but can be changed by calling this function.

=cut

sub set_qmax {
    my $self = shift;
    my $qmax = shift;

    $self->{ ffmpeg_qfactor } = $qmax;
}


=head2 C<set_fps(NUM)>

This method is optional, and must be run before C<init()>.

The conversion between frame counts and times requires, at present, a
knowledge of a fixed frame rate.  The default is 29.97, for North
American broadcasts.  If this is incorrect in your region, you may
modify the frame rate here.

=cut

sub set_fps {
    my $self = shift;
    my $fps = shift;

    $self->{ system_fps } = $fps;
}


=head2 C<set_lock_file(FILENAME)>

This method is optional, and must be run before C<init()>.

A transcode job can run for a long time.  It is not hard to queue up
days of transcodes.  The user may want to allow other jobs, such as
commercial flagging runs, to execute as new recordings are created,
without waiting days for the queue of transcode jobs to empty.

To do this, supply a common absolute pathname, F<FILENAME>, to all
MythXCode objects using this method.  The MythTV job execution queue
must be set to allow at least two concurrent jobs.  Also, the
C<set_program_identifier()> method must supply the I<JOBID> argument
because the locking method must interact with the MythTV job
scheduler.

Implementation is via an advisory lock on the supplied filename.  When
the C<init()> method is called, an attempt is made to acquire the
lock.  If it succeeds, the C<init()> method returns.  If it fails, it
sleeps for 5 minutes and tries again.  Before sleeping, it checks the
job queue to see if there are any user jobs of a different type
waiting in the queue.  If there are, it finds all queued jobs of the
same type and resets their submission times to now.  It then resubmits
itself, and exits, freeing up the job queue entry.

The net effect, if MythTV is configured to allow two concurrent jobs
to run, is that There will initially be two running MythXCode jobs,
but one will not be making progress and will not be consuming CPU.
If, later, another job of a different type, such as commercial
flagging, appears on the queue, then the blocked MythXCode job will,
within 5 minutes, detect it, and reorder the queue so that the
commercial flagging job moves to the front of the line.  This allows
the commercial flagging job to run concurrently with the MythXCode, so
it can be done in a timely manner.

=cut

sub set_lock_file {
    my $self = shift;
    $self->{ lockfile } = shift;
}


=head2 C<set_remote_ffmpeg_engine(SSH_INVOCATION_STRING [, NUMTHREADS])>

This method is optional and must be called before C<init()>.  

The MythTV backend may not have the most computing resources available
on your network.  It may, therefore, be desirable to offload the
transcoding to H.264 to another computer.  In that case, this method
can be used.

The I<SSH_INVOCATION_STRING> must be a string that allows
password-free access to an account on the remote machine.  An example
might be C<S<ssh -l guest -i /home/mythtv/.ssh/key bigbox>>.  The second
argument is optional, and should be the integer number of threads to
use, passed to the C<-threads> option of F<ffmpeg>.  The default
number of threads is 1.

There must be enough space in the home directory of the remote machine
to hold the transcoded file, but the original file will not be copied
over, it is streamed to the C<stdin> of F<ffmpeg>.  Once the file has
been copied back, it will be deleted from the remote machine,
releasing the disk space.

=cut

sub set_remote_ffmpeg_engine {
    my $self = shift;
    my $ssh_string = shift;
    my $num_threads = shift;

    if ( ! $num_threads ) {
	$num_threads = 1;
    }

    die "Bad thread number" if $num_threads < 1;

    $self->{ ssh_string } = $ssh_string;
    $self->{ ssh_threads } = $num_threads;
}


=head2 C<set_ffmpeg_rebuild()>

This method is optional and must be called before C<init()>.  

Some versions of mythcommflag incorrectly mark some non-keyframes as
keyframes, leading to visible artefacting immediately after a seek.
In that case, if a fairly recent version of ffmpeg is available (1.0
works, 0.8.4 does not), the script can use ffmpeg to obtain the true
keyframe locations and update the seektable appropriately.  Call this
function to activate that mode of operation.

=cut

sub set_ffmpeg_rebuild {
    my $self = shift;

    $self->{ ffmpeg_rebuild } = 1;
}

=head2 C<ffmpeg_map_uses_colon()>

This method is optional, and must be called before C<init()>.

The command-line invocation for stream mapping in F<ffmpeg> has
changed over time.  Older versions use a syntax like C<-map 0.1>, while
newer ones use C<-map 0:1>.  This method asks that the colon separator
be used in F<ffmpeg> invocations.  This is also the default, so this
method need not be used, but is recommended in case the F<ffmpeg>
invocation changes again in the future.

=cut

sub ffmpeg_map_uses_colon {
    my $self = shift;
    undef $self->{ map_dot };
}

=head2 C<ffmpeg_map_uses_dot()>

This method is optional, and must be called before C<init()>.

The command-line invocation for stream mapping in F<ffmpeg> has
changed recently.  Older versions use a syntax like C<-map 0.1>, while
newer ones use C<-map 0:1>.  This method asks that the dot separator
be used in F<ffmpeg> invocations.  Use this method if your F<ffmpeg>
does not recognize the newer format.

=cut

sub ffmpeg_map_uses_dot {
    my $self;
    $self->{ map_dot } = 1;
}


=head2 C<set_program_identifier(CHANID, STARTTIME [, JOBID])>

This method is required, and must be called before C<init()>.

It is used to set the channel ID and starting time of the recording to
be processed.  The optional third parameter holds the job ID, and must
be supplied if locking is being used (see C<set_lock_file>).

The expected formats for these three parameters are simply the strings
that MythTV supplies to user jobs when the pseudo-parameters
B<%CHANID%>, B<%STARTTIMEISO%>, and B<%JOBID%> are used in the command
line invocation.

=cut

sub set_program_identifier {
    my $self = shift;
    my $chanid = shift;
    my $starttime = shift;
    my $jobid = shift;

    die "It is not legal to call set_program_identifier more than once on a MythXCode object" if $self->{ chanid };

    die "Failed to supply a channel ID" if ! $chanid;
    die "Failed to supply a starttime" if ! $starttime;
    
    $self->{ chanid } = $chanid;
    $self->{ starttime } = $starttime;
    $self->{ jobid } = $jobid;

}



=head2 C<init()>

This method is required.  It validates some of the configurations set
up by the previously-described methods.  It verifies that the database
schema is one that has been tested and is known to work.  If locking
is enabled, it acquires the lock.

This method will never return an error, but it may not return.  If the
configuration settings supplied earlier are wrong, it may ABEND at
this time.  If the process has to move out of the way to allow a
commercial flagging job to move up in the queue, it will do a quiet
exit and not return.

=cut

sub init {
    my $self = shift;

    $self->check_database_schema();
    $self->wait_on_lock();
    $self->{ initialized } = 1;
    $self->read_recording_data();
}


=head2 C<perform_backup()>

This method is optional, and must be called after C<init()>.  

If a backup directory was set with C<set_backup_dir()>, the backup is
performed at this time.  See C<set_backup_dir()> for details of the
location of the backups.  The backup holds the original MPEG recording
file, a file named F<recovery> that shows how to copy this file back
to its original location, and several MySQL command files suitable for
streaming directly into F<mysql> to restore the relevant database
entries for the recording.

B<NOTE>: no backups will be performed unless this method is explicitly
called.

=cut

sub perform_backup {
    my $self = shift;
    my $newdir = $self->{ backup_dir };

    die "Failed to call init()" if ! $self->{ initialized };

    if ( ! $newdir ) {
	return;
    }

    $newdir = $newdir . "/transcode_$$";
    die "Backup directory already exists" if -d $newdir;
    mkdir $newdir,0700 || die "Failed to create backup directory.";
    my $caption_filename = $self->generate_caption_filename();

    if ( $self->get_debug_level() > 0 ) {
	print "cp $self->{ orig_pathname } $newdir\n";
	if ( -s $caption_filename) {
	    print "cp $caption_filename $newdir\n";
	}

    } else {
	$self->set_job_status("Backing up original file.");
	if (system( "cp", $self->{ orig_pathname }, $newdir ) != 0 ) {
	    die "Failed to make the backup copy.";
	}
	if ( -s $caption_filename ) {
	    if (system( "cp", $caption_filename, $newdir ) != 0 ) {
		die "Failed to make the backup copy of .srt file.";
	    }
	}
	my $hints;
	open $hints, ">$newdir/recovery";
	print $hints "cp $newdir/$self->{ orig_basename} $self->{ orig_pathname }\n";
	if ( -s $caption_filename ) {
	    my $caption_basename = basename($caption_filename);
	    my $caption_dirname = dirname($caption_filename);
	    print $hints "cp $newdir/$caption_basename $caption_dirname\n";
	}

	for ( @tables_to_backup ) {
	    print $hints "mysql $self->{ dbname } < $newdir/$_\n";
	}

	close $hints;
    }

    for ( @tables_to_backup ) {
	
	my $tablename = $_;

	my $hints;
	open $hints, ">$newdir/$tablename";
	print $hints "DELETE FROM $_ WHERE chanid='$self->{ chanid }' AND starttime='$self->{ starttime }';\n";
	my @onetable = @{$self->{ backups }->{ $tablename }};
	for ( my $i = 1; $i <= $#onetable; $i++ ) {

	    print $hints "INSERT INTO $_ (", join(',', @{$onetable[0]}), " ) VALUES ('", join ("','", map { my $t = $_; $t =~ s|'|\\'|g; $t; } @{$onetable[$i]}), "');\n";
	}
	if ( ! close $hints ) {
	    die "Failed to write backup data file $tablename";
	}
    }

    if ( $self->get_debug_level() == 0 ) {
	$self->set_job_status("");
    }
}


=head2 C<prepare_captions()>

This method is optional, and must be called after C<init()>.

This method extracts the captions from the recording and applies the
cutlist (if any) to the resulting .srt file.

This method should be called before C<transcode_to_h264()>, as
otherwise captions and cutlist data will be lost.

=cut

sub prepare_captions {
    my $self = shift;

    die "Failed to call init()" if ! $self->{ initialized };

    if ( ! $self->captions_already_extracted() ) {
	$self->extract_captions();
    } else {
	print "Captions already present in a .srt file.\n";
	# Note that extract_captions applies the cutlist as it works
	if ( $self->has_cutlist() ) {
	    $self->generate_cut_captions();
	}
    }
}



=head2 C<transcode_to_h264()>

This method is optional, and must be called after C<init()>.

If a cutlist exists, or if captions are to be preserved,
C<prepare_captions()> should be called before this method.

This method transcodes a recording to H.264 while added extra
keyframes at the cut points.  It then cuts the recording cleanly at
those positions, and converts the file to a transport stream so that
the seek table rebuild code will work on it.  It will use the remote
F<ffmpeg> host, if requested (see C<set_remote_ffmpeg_engine()>).

Unless running in debugging mode (see C<set_debug_level()>), this
operation makes permanent changes to the recording on disk and to the
database entries related to it.

=cut

sub transcode_to_h264 {
    my $self = shift;

    die "Failed to call init()" if ! $self->{ initialized };

    $self->perform_transcoding_to_h264();
}


=head1 AUTHOR

Christopher Neufeld.  Copyright 2013, released under the GPL version 3.

=cut


Invocation Script

The .pm file describes a class. A separate script is needed to invoke the methods defined in the class. Here is the one I use, xcode_to_h264.pl


#! /usr/bin/perl
#
# Invoke as a user job with:
# /home/mythtv/xcode_to_h264.pl %CHANID% %STARTTIMEISO% %JOBID%

# New code to transcode.

use lib '/home/mythtv';

use MythXCode;
use strict;

umask 0022;

my $dbname = "mythconverg";
my $dbuser = "mythtv";
my $dbpasswd = "password";

# my $backup_dir = "/myth/tmp";
# my $lock_file = $backup_dir . "/transcode_lock";

my $dbglevel = 0;



my $chanid = $ARGV[0];
my $starttime = $ARGV[1];
my $jobid = $ARGV[2];

die "Bad channel ID" if ! $chanid;
die "Bad start time" if ! $starttime;

$starttime =~ tr/T/ /;


my $worker = MythXCode->new();

$worker->set_db_parms($dbname, $dbuser, $dbpasswd);
# $worker->set_backup_directory($backup_dir);
$worker->set_debug_level($dbglevel);
# $worker->set_lock_file($lock_file);
# $worker->set_remote_ffmpeg_engine("ssh -i /home/mythtv/.ssh/bigboxkey bigbox", 3);
# $worker->set_ffmpeg_rebuild();

$worker->set_program_identifier($chanid, $starttime, $jobid);

$worker->init();

# $worker->perform_backup();
$worker->prepare_captions();
$worker->transcode_to_h264();

Read the documentation for MythXCode.pm for more details. You can set up a locking scheme that allows transcode jobs to move out of the way of commercial flagging jobs, in the event that your transcoding runs take a very long time. You can (and probably should) use the backup facility to produce files capable of exactly restoring the state of the recording in case something goes wrong. You can use a remote ffmpeg offload engine (I do, as a 64-bit box is much faster than my 32-bit backend on transcodes).