ftp ls -al command proxy for IIS6

ftpc_proxy.pl

# -*- mode: CPerl ; coding: utf-8 -*-
use strict;
use warnings;
use utf8;

use Data::Dumper;
# for convert unit test
# perl -e "require 'ftpc_proxy.pl';"
use IPC::Open2;
use Time::Local;
use POSIX 'strftime';

use constant MON_NAME => do {
    +{ map {
      sprintf('%02d', $_ + 1) =>
        (split(/\s/, scalar localtime
              timelocal(0, 0, 0, 1, $_, strftime('%Y', localtime))
              ))[1]
      } 0 .. 11
    };
};

use constant {
    FTP_EXE => q(h:/s/ftp.exe),
    DIR_TEMPLATE  => 'drwxrwxrwx   1 owner    group  %10d %s %02d %5s %s',
    FILE_TEMPLATE => '-rw-rw-rw-   1 owner    group  %10d %s %02d %5s %s',
    DEBUG => 0
};


sub dir2ls {
    return map {
        my ($year, $mon, $day, $time, $type, $name) =
          ($_ =~ m!^(\d{4})/(\d{2})/(\d{2})\s+
                   (\d{2}:\d{2})\s+((?:<DIR>)|(?:\S+))\s+(.+)$!x);
        print Dumper [($year, $mon, $day, $time, $type, $name)]
            if (DEBUG);

        my $ls_time = ($year eq strftime('%Y', localtime))?
            $time: $year;
        if ($type eq '<DIR>') {
            sprintf(DIR_TEMPLATE,
                    0, MON_NAME->{$mon}, $day, $ls_time, $name)
        } else {
            (my $size = $type) =~ s/,//g;
            sprintf(FILE_TEMPLATE,
                    $size, MON_NAME->{$mon}, $day, $ls_time, $name)
        }
    } grep {$_ =~ m!^(\d{4})/(\d{2})/(\d{2})!} @_;
}

my $pid = -1;
local $SIG{INT} = sub {
    kill(9, $pid);
};

if (!caller) {
    $pid = open2(my $child_out, my $child_in,
                 FTP_EXE, qw(-i -n -g -v));
    while (my ($command) = (<STDIN> =~ /^(.*)$/)) {
        next unless (defined($command));
        print {$child_in} $command, "\n";
        print scalar <$child_out> if (DEBUG);

        # example. ls -al h:/tmp/ange-ftp2780cF0
        my $list_file = (split(/\s/, $command))[2]
            if ($command =~ /^ls -al/);
        if ($list_file && -f $list_file) {
            open my $rfh, '<', $list_file or die $!;
            my @tmp = dir2ls(<$rfh>);
            close $rfh;
            open my $wfh, '>', $list_file;
            print {$wfh} join("\n", @tmp);
            close $wfh;
        }
        last if ($command eq 'bye');
    }
    waitpid( $pid, 0 );
    exit($? >> 8);
} else {
    eval "use Test::More tests => 1";
    my @input = split(/\n/, q{
2012/03/17  11:26               305 a.markdown
2011/01/02  06:17                82 a.pl
2010/11/13  13:10    <DIR>          perl5
2011/08/17  11:31    <DIR>          テスト
});

    my @output = grep {length($_) > 0} split(/\n/, q{
-rw-rw-rw-   1 owner    group         305 Mar 17 11:26 a.markdown
-rw-rw-rw-   1 owner    group          82 Jan 02  2011 a.pl
drwxrwxrwx   1 owner    group           0 Nov 13  2010 perl5
drwxrwxrwx   1 owner    group           0 Aug 17  2011 テスト
});
    if (strftime('%Y', localtime) == 2012) {
        my @ret = dir2ls(@input);
        Test::More::is_deeply(\@ret, \@output,
                              'dir2ls') or
                                diag(explain(\@ret, \@output));
    }
}

1;