take snapshots from MPEG2-TS using Linux::DVB::DVBT::TS

capture_from_ts.pl

#!/usr/bin/perl
use strict;
use warnings;

use Linux::DVB::DVBT::TS;
use Proc::ProcessTable;

use constant {
    TIMEOUT => 10
};

my $filename = shift;
my $outdir = shift;
die 'give me a filename and a directory name' unless ($filename && $outdir);

my $num_images = shift || 10;
$num_images += 2;
#warn "timeout is ".TIMEOUT;

my $pid = fork();

if (!$pid) {
    my %info = info($filename);

    if ($info{'error'}) {
        die "Error: $info{error}";
    }

#my $length = 3600 * $info{duration}{hh} + 60 * $info{duration}{mm} + $info{duration}{ss};

    my $total_packets = $info{total_pkts};
    my $unit_pkts = $total_packets / $num_images;

    my @target_pktss = map {$_ * $unit_pkts} (1..$num_images-2);
#warn Dump \@target_pktss;

    my $i = 1;
    for my $target_pkts (@target_pktss) {
        my $settings_href = {
            user_data     => {
                frame_count => $i++,
                outname => "$outdir/%d.ppm",
            },
            mpeg2_rgb_callback => \&colour_callback,
            skip_pkts => int($target_pkts),
            origin => 1,
        };
        
        parse($filename, $settings_href);
    }
}
else {
    my $start = time;
    while (1) {
        if (time - $start > TIMEOUT && is_ps_alive($pid)) {
            kill 9, $pid;
            die 'timeout: '.$pid;
        }
        
        if (!is_ps_alive($pid)) {
            warn 'done';
            exit;
        }
    }
}

exit;

sub colour_callback
{
    my ($tsreader, $info_href, $width, $height, $data, $usr) = @_ ;
    
    if ($info_href->{framenum} >= 1) {
        write_ppm($usr->{'outname'}, $usr->{'frame_count'},
            $width, $height, 
            $data, 
        ) ;

        Linux::DVB::DVBT::TS::parse_stop($tsreader) ;
    }
}

# write_ppm() is stolen from http://cpansearch.perl.org/src/SDPRICE/Linux-DVB-DVBT-TS-0.08/script/dvbt-ts-pics
sub write_ppm
{
    my ($name, $frame, $width, $height, $data) = @_ ;

    my $fname = sprintf(${name}, $frame) ;
    print "Saving $fname...\n" ;

    open(my $ppmfile, ">", $fname) or die "Error: Unable to write $fname : $!" ;
    binmode $ppmfile ;

    printf $ppmfile "P6\n%d %d\n255\n", $width, $height ;
    print $ppmfile $data ;

    close ($ppmfile);
}


sub is_ps_alive {
    my $pid = shift;

    my $t = Proc::ProcessTable->new;

    my ($r) = grep {
        ($_->pid eq $pid)
        && ($_->cmndline !~ m|/proc/\d+/cmdline|)
    } @{$t->table};

    if (defined $r) {
#        warn $r->cmndline;
        return $r;
    }
    else {
        return;
    }
}