動画ファイル名により振り分け

http://d.hatena.ne.jp/ore_de_work/20130303#1362255372
のやつを少し換えた

#京
#!/bin/perl

use strict;
use warnings;
use File::Path;
use Cwd 'getcwd';
use Fcntl;
use File::Find;
use File::Copy;

my $dir = getcwd;
my %matchs = (
# match => dst floder

'あいうら'                                                                      =>'',
'あいまいみー'                                                                  =>'',
#'八犬伝―東方八犬異聞―'                                                       =>'',
'浩鉄天使くるみ'                                                                =>'鋼鉄天使くるみ',
'ささみさん@がんばらない'                                                       =>'ささみさん＠がんばらない',
'ささみさん＠がんばらない'                                                      =>'',
'問題児たちが異世界から来るそうですよH'                                         =>'問題児たちが異世界から来るそうですよ？',
'やはり俺の青春ラブコメはまちがっている。'                                      =>'',
'AKB0048 next stage'                                                            =>'',
'AKB0048 next stage'                                                            =>'AKB0048 next stage' ,
'D.C.III〜ダ・カーダIII〜'                                                      =>'D.C.III〜ダ・カーポIII〜',
'D.C.III〜ダ・カーポIII〜'                                                      =>'',
'D.C.III〜ダ・カーポIII〜'                                                      =>'D.C.III〜ダ・カーポIII〜',
'D.C.Ⅲ〜ダ・カーダⅢ〜'                                                        =>'D.C.III〜ダ・カーポIII〜',
'D.C.Ⅲ〜ダ・カーポⅢ〜'                                                        =>'D.C.III〜ダ・カーポIII〜',
'ガールズ&パンツァー'                                                           =>'',
'ガールズ＆パンツァー'                                                          =>'',
'ガールズ＆パンツァー'                                                          =>'ガールズ＆パンツァー' ,
'キューティクル探偵因幡'                                                        =>'',
'僕は友達が少ないNEXT'                                                          =>'',
'LINE OFFLINE〜サラリーマン〜'                                                  =>'',
'MANPA「ラブライブちはやふる2MANPAちゃんHUNTER×HUNTER」'                       =>'ちはやふる2',
'ラブライブちはやふる2MANPAちゃんHUNTER×HUNTER'                                =>'ちはやふる2',
'ラブライブ！ School idol project'                                              =>'',
'まんがーる!'                                                                   =>'',
'まんがーる!'                                                                   =>'まんがーる!',
'まんがーる！'                                                                  =>'',
'まんがーる！'                                                                  =>'まんがーる!',
'みなみけ ただいま'                                                             =>'',
);

find( {  wanted => \&d, nochdir => 1 }, '.' );

sub max{
  my @nums = @_;
  
  my $max_num;
  for my $num (@nums) {
    if (!defined $max_num) {
      $max_num = $num;
    }
    else{
      if ($num > $max_num) {
        $max_num = $num;
      }
    }
  }
  return $max_num;
}

sub regist
{
    my ($idx, $pat, $ref, $reg) = @_;
    
    return unless($pat);
    return if($pat =~ /^$/);
    return if($reg->{$pat});
#print "  $idx 「$pat」\n";

    push @$ref, $pat;
    $reg->{$pat} = 1;
}

sub d{
    return if($_ eq '.');
    return if($_ eq '..');
    my $file = $_;
    my $tmp = $_;
    return unless(-f);
    return unless(/\.mp4|\.avi$/);
    my $ts = $_;
    $ts =~ s/.mp4|\.avi$/.ts/;
    if(-f $ts)
    {
        print "found $ts\n";
        return;
    }
    $ts =~ s/_\d+\.ts/.ts/;
    if(-f $ts)
    {
        print "found $ts\n";
        return;
    }    

    my $tmp = $file;
    
    $tmp =~ s/_\d\....$//;
    $tmp =~ s/\....$//;
    $tmp =~ s/\#\d+//;
    $tmp =~ s/\(第\d+話\)//;
    $tmp =~ s/\(\d+\)//;
    $tmp =~ s/\(\)//;
    $tmp =~ s/第\d+話//;
#    print "$file ";

    my @pat = ();
    my @pat1 = ();
    my @pat2 = ();
    my @pat3 = ();
    my @pat4 = ();
    my @pat5 = ();
    my @pat6  = ();
    my @pat7  = ();
    my @pat8  = ();
    my @pat9  = ();
    my @pat10 = ();

    push @pat6 , split( / /, $tmp);
    push @pat7 , split( /　/, $tmp );
    push @pat8 , split( /「/, $tmp );
    push @pat8 , split( /(「|」)/, $tmp );
    push @pat9 , split( /_/, $tmp );
    push @pat10 , split( /\(/, $tmp );
    push @pat10 , split( /\)/, $tmp );
    push @pat10 , split( /[0-9]+/, $tmp );


    my @temp11 = ();
    for my $e(1..$#pat6)
    {
        my $temp = '';
        for my $s(0..$e)
        {
            next unless($pat6[$s]);
            $temp .= $pat6[$s];
            $temp .= ' ' if($s != $e);
        }
        push @temp11, $temp;
    }
    my @pat11 = reverse @temp11;
    
    
    my @temp12 = ();
    for my $e(1..$#pat6)
    {
        my $temp = '';
        for my $s(0..$e)
        {
            next unless($pat7[$s]);
            $temp .= $pat7[$s];
            $temp .= '　' if($s != $e);
        }
        push @temp12, $temp;
    }
    my @pat12 = reverse @temp12;


    push @pat1 , split( / /, $tmp);
    push @pat2 , split( /　/, $tmp );
    push @pat3 , split( /「/, $tmp );
    push @pat4 , split( /_/, $tmp );
    push @pat5 , split( /\(/, $tmp );
    grep { s/　$//; } @pat1;
    grep { s/　$//; } @pat2;
    grep { s/　$//; } @pat3;
    grep { s/　$//; } @pat4;
    grep { s/　$//; } @pat5;
    grep { s/ +$//; } @pat1;
    grep { s/ +$//; } @pat2;
    grep { s/ +$//; } @pat3;
    grep { s/ +$//; } @pat4;
    grep { s/ +$//; } @pat5;
    
    my %pat = ();
    for(0.. max($#pat1, $#pat2, $#pat3, $#pat4, $#pat5,
        $#pat6, $#pat7, $#pat8, $#pat9, $#pat10) )
    {
        &regist($_, $pat11[$_] || '', \@pat, \%pat );
        &regist($_, $pat12[$_] || '', \@pat, \%pat );
        &regist($_, $pat6[$_]  || '', \@pat, \%pat );
        &regist($_, $pat7[$_]  || '', \@pat, \%pat );
        &regist($_, $pat8[$_]  || '', \@pat, \%pat );
        &regist($_, $pat9[$_]  || '', \@pat, \%pat );
        &regist($_, $pat10[$_] || '', \@pat, \%pat );
        &regist($_, $pat1[$_]  || '', \@pat, \%pat );
        &regist($_, $pat2[$_]  || '', \@pat, \%pat );
        &regist($_, $pat3[$_]  || '', \@pat, \%pat );
        &regist($_, $pat4[$_]  || '', \@pat, \%pat );
        &regist($_, $pat5[$_]  || '', \@pat, \%pat );
    }

    my $select = '';
    my $hit = -1;
    foreach(@pat)
    {
        my $ok = 0;
        if( exists($matchs{$_}) and $hit < length($_) )
        {
            $select = $_;
            $hit = length($_);
            $ok = 1;
        }
#        printf "   %s「%s」\n", $ok?"-->":"-  ", $_;
    }
    
    if($hit > 0)
    {
#        printf "%32s   ==>「%s」\n", $file, $select;
        $matchs{$select} = $select if( $matchs{$select} eq '' ) ;
        my $dst = $dir . $matchs{$select};
#        print "  > $dst\n";
        mkdir $dst;

        return if($File::Find::dir eq  './' . $matchs{$select} );
        move  $file, $dst . '\\' . $file || print $!;
        
    }else {
        printf "%32s   << not found entry. >>\n", $file;
        foreach(@pat)
        {
#            printf "%32s   - 「%s」\n", '', $_;
        }
    }
}

print "\n";

さらにMediaCoderに自動キューイングするようにしかけた

sub d{
    return if($_ eq '.');
    return if($_ eq '..');
    my $file = $_;
    my $tmp = $_;
    return unless(-f);
    if(/\.ts$/)
    {
        my $mp4 = $_;
        $mp4 =~ s/.ts$/.mp4/;
        return if(-f $mp4);
        push @noyetencode, $_;
        return;
    }

skipskip

    my $MediaCoder = '"C:\\pathtopath\\MediaCoder\\MediaCoder.exe" ' ;
    $MediaCoder .= ' "' . $dir . $_ . '"' foreach(@noyetencode);
    $MediaCoder .= ' -preset "C:\\pathtopath\\MediaCoder\\ts_to_mp4.xml" ';
    $MediaCoder .= ' -start ';
    $MediaCoder .= ' -exit  ';
    $MediaCoder .= ' -ui 0  ';
    $MediaCoder .= ' -assume=cancel ';

    system( $MediaCoder );