mythtranscodeによるnuv->AVIの変換(完成)

#! /usr/bin/perl

#NAME: mythexport.pl

use strict;
use Encode;
use DBI;
use String::Format;

my $filename_format = '%T_%y%m%h.%e';
my $char_encoding = "euc-jp";

BEGIN {
    my $db;

    sub get_db {
        if (!$db) {
            $db=DBI->connect("DBI:mysql:mythconverg:localhost","mythtv","mythtv")
                || die "Can't connect DB";
        }
        return $db;
    }

    sub release_db {
        if ($db) {
            $db->disconnect;
            undef $db;
        }
    }
}

END {
    &release_db;
}

sub code_conv {
    my $str = shift @_;
    Encode::from_to($str, "utf8", $char_encoding) if $char_encoding;
    return $str;
}

sub get_filename {
    my($chanid, $starttime, $w, $h, $fps, $arate) = @_;

    my $db=&get_db;
    my $query="select * from recorded where chanid='$chanid' and starttime='$starttime'";
    my $sth=$db->prepare($query);
    $sth->execute;
    my $row=$sth->fetchrow_hashref;

    my ($prepared, $date, $time, $year, $month, $day, $hour, $min, $sec);
    my $prepare_time = sub {
        return if $prepared;
        for ($row->{'starttime'}) {
            ($date, $year, $month, $day, $time, $hour, $min, $sec) =
                /^((\d{4})-(\d{2})-(\d{2})) ((\d{2}):(\d{2}):(\d{2}))$/;
        }
        $prepared = 1;
    };

    my %format = (
          'T' => sub { &code_conv($row->{'title'}) },
          't' => sub { &code_conv($row->{'subtitle'}) },
          'D' => sub { &code_conv($row->{'description'}) },
          'c' => sub { &code_conv($row->{'category'}) },
          'g' => sub { &code_conv($row->{'recgroup'}) },
          'C' => sub { $row->{'chanid'} },
          'S' => sub { $row->{'starttime'} },
          'E' => sub { $row->{'endtime'} },

          'x' => sub { $prepare_time->(); $date },
          'X' => sub { $prepare_time->(); $time },
          'y' => sub { $prepare_time->(); $year },
          'm' => sub { $prepare_time->(); $month },
          'd' => sub { $prepare_time->(); $day },
          'h' => sub { $prepare_time->(); $hour },
          'M' => sub { $prepare_time->(); $min },
          's' => sub { $prepare_time->(); $sec },

          'e' => 'avi',

          'W' => $w,
          'H' => $h,
          'F' => $fps,
          'B' => $arate,
    );

    my $filename = stringf($filename_format, %format);

    $sth->finish;

    return $filename;
}

sub encode_video {
    my($w,$h,$fps,$vidin,$arate,$audin,$outfile) = @_;

    open(ENCODER, "mencoder -audiofile $audin -audio-demuxer 20 -rawaudio rate=$arate -rawvideo on:w=$w:h=$h:fps=$fps -ovc lavc -vf pp=de/lb/tn -oac mp3lame -o \"$outfile\" $vidin > /dev/null 2>&1 |");
    while (<ENCODER>) {
        print "mencoder: $_";
    }
    close(ENCODER);

    print STDERR "mencoder finished.\n";
}

sub transcode {
    my($chanid, $starttime) = @_;

    my $tmp="/tmp/fifodir_$$";
    my $newdir = 0;
    if (! -d $tmp) {
        $newdir = 1;
        mkdir $tmp;
    }
    unlink("$tmp/audout") if -e "$tmp/audout";
    unlink("$tmp/vidout") if -e "$tmp/vidout";

    my $continue;

    open(PIPE , "mythtranscode --showprogress --fifodir $tmp -c $chanid --starttime \"$starttime\" |");
    while (<PIPE>) {
        print;

        if (/Video (\d+)x(\d+)@(\d+(?:\.\d+))fps Audio rate: (\d+)$/) {
            my($w,$h,$fps,$arate)=($1,$2,$3,$4);

            my $outfile = &get_filename($chanid, $starttime, $w, $h, $fps, $arate);

            my $pid = fork();
            if ($pid < 0) {
                # error
                die $!;
            }

            if ($pid == 0) {
                # child
                &encode_video($w,$h,$fps,"$tmp/vidout",$arate,"$tmp/audout",$outfile);
                exit 0;
            }

            $continue = 1;
            last;
        } elsif (/Created fifos/) {
            print STDERR "Missing video format...\n";
            last;
        }
    }

    if ($continue) {
        while (<PIPE>) {
            print "mythtranscode: $_";
        }
        wait;
    }

    close(PIPE);
    print STDERR "mythtranscode finished.\n";

    unlink($tmp) if $newdir;
}

sub main {
    foreach (@ARGV) {
        if (/^(?:.*\/)?(\d+)_(\d{14})_\d{14}/) {
            my($chanid,$starttime)=($1,$2);
            $starttime=~s/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/$1-$2-$3 $4:$5:$6/;
            &transcode($chanid,$starttime);
        }
    }
}
&main;

ついにできた。

プログラムの技術的には、子プロセスをforkする部分とか、クロージャを使ってデータが必要とされるまで生成を遅延させる部分は多少面白いんじゃないかと。特にデザインパターンとかを意識していたわけではないんだけど、データの遅延生成はProxyパターンっぽい(ついでに言うとBEGIN-ENDブロックの部分はTemplate Methodパターンっぽい)。まあ、クロージャを使えばオブジェクト指向でなくてもProxyパターンぐらいは実装できますよという例にはなっているかな。