######################################################################
#
# makeallt.pl - make all t-skeleton/t/dist/*.t scripts
#
# Copyright (c) 2010, 2011, 2012, 2013, 2015, 2018 INABA Hitoshi <ina@cpan.org>
#
######################################################################

use strict;
require 'jacode.pl';

unless (@ARGV) {
    die <<END;
usage: perl $0 nnn_sjistest.t ... [Enter]

makes test scripts of all dists from Sjis test script.
END
}

my %scriptdir = (
    'Arabic'        => 'xt',
    'Big5HKSCS'     => 'xt',
    'Big5Plus'      => 'xt',
    'Cyrillic'      => 'xt',
    'EUCJP'         =>  't',
    'EUCTW'         => 'xt',
    'GB18030'       => 'xt',
    'GBK'           => 'xt',
    'Greek'         => 'xt',
    'HP15'          => 'xt',
    'Hebrew'        => 'xt',
    'INFORMIXV6ALS' => 'xt',
    'JIS8'          => 'xt',
    'KOI8R'         => 'xt',
    'KOI8U'         => 'xt',
    'KPS9566'       => 'xt',
    'Latin1'        =>  't',
    'Latin10'       => 'xt',
    'Latin2'        => 'xt',
    'Latin3'        => 'xt',
    'Latin4'        => 'xt',
    'Latin5'        => 'xt',
    'Latin6'        => 'xt',
    'Latin7'        => 'xt',
    'Latin8'        => 'xt',
    'Latin9'        => 'xt',
    'OldUTF8'       => 'xt',
    'Sjis'          =>  't',
    'TIS620'        => 'xt',
    'UHC'           => 'xt',
    'USASCII'       => 'xt',
    'UTF2'          =>  't',
    'Windows1252'   => 'xt',
    'Windows1258'   => 'xt',
);

open(MANIFEST,">MANIFEST.add") || die "Can't open file: MANIFEST.add\n";
binmode MANIFEST;

for my $dist (sort keys %scriptdir) {
    my @test = ();
    if (opendir(DIR,qq{t/$dist})) {
        push @test, map {"t/$dist/$_"} grep(/\.t$/i, readdir(DIR));
        closedir(DIR);
    }
    if (opendir(DIR,qq{xt/$dist})) {
        push @test, map {"xt/$dist/$_"} grep(/\.t$/i, readdir(DIR));
        closedir(DIR);
    }

    my @head = ();
    for my $test (reverse sort @test) {
        open(TEST,$test) || die "Can't open file: $test\n";
        @_ = <TEST>;
        close(TEST);
        @head = @_[0,1,2];
        if (($head[0] =~ /^# encoding: .+$/) and
            ($head[1] =~ /^# This file is encoded in .+$/) and
            ($head[2] =~ /^die "This file is not encoded in .+$/)
        ) {
            last;
        }
    }
    if (($head[0] =~ /^# encoding: .+$/) and
        ($head[1] =~ /^# This file is encoded in .+$/) and
        ($head[2] =~ /^die "This file is not encoded in .+$/)
    ) {
    }
    else {
        die "$dist head broken.\n";
    }

    for my $test (@ARGV) {
        open(TEST,$test) || die "Can't open file: $test\n";
        binmode TEST;
        @_ = <TEST>;
        close(TEST);

        if (0) {
        }
        elsif ($dist =~ /^(EUCJP)$/) {
            @head = join "\n", split(/\n/,<<'END',3);
# encoding: EUCJP
# This file is encoded in EUC-JP.
die "This file is not encoded in EUC-JP.\n" if q{‚ } ne "\xa4\xa2";
END
            for my $line (@head, @_) {
                jcode::convert(\$line,'euc','sjis');
            }
        }
        elsif ($dist =~ /^(EUCTW)$/) {
            @head = join "\n", split(/\n/,<<'END',3);
# encoding: EUCTW
# This file is encoded in EUC-TW.
die "This file is not encoded in EUC-TW.\n" if q{‚ } ne "\xa4\xa2";
END
            for my $line (@head, @_) {
                jcode::convert(\$line,'euc','sjis');
            }
        }
        elsif ($dist =~ /^(OldUTF8)$/) {
            @head = join "\n", split(/\n/,<<'END',3);
# encoding: OldUTF8
# This file is encoded in old UTF-8.
die "This file is not encoded in old UTF-8.\n" if q{‚ } ne "\xe3\x81\x82";
END
            for my $line (@head, @_) {
                jcode::convert(\$line,'utf8','sjis');
            }
        }
        elsif ($dist =~ /^(UTF2)$/) {
            @head = join "\n", split(/\n/,<<'END',3);
# encoding: UTF2
# This file is encoded in UTF-2.
die "This file is not encoded in UTF-2.\n" if q{‚ } ne "\xe3\x81\x82";
END
            for my $line (@head, @_) {
                jcode::convert(\$line,'utf8','sjis');
            }
        }

        mkdir(qq{t-skeleton},0777);
        mkdir(qq{t-skeleton/$scriptdir{$dist}},0777);
        mkdir(qq{t-skeleton/$scriptdir{$dist}/$dist},0777);

        (my $test_basename = $test) =~ s{.*[\\/]}{};
        open(TEST,qq{>t-skeleton/$scriptdir{$dist}/$dist/$test_basename}) || die "Can't open file: t-skeleton/$scriptdir{$dist}/$dist/$test_basename\n";
        binmode TEST;
        print TEST @head;
        print TEST @_[3..$#_];
        close(TEST);

        print MANIFEST "$scriptdir{$dist}/$dist/$test_basename\n";
    }
}

close(MANIFEST);

__END__

=pod

=head1 NAME

makeallt.pl - make all t-skeleton/dist/*.t scripts

=head1 SYNOPSIS

  perl makeallt.pl nnn_sjistest.t

  outputs skeleton test scripts as t-skeleton/dist/*.t

=head1 DEPENDENCIES

This software requires perl5.00503 or later.

=head1 AUTHOR

INABA Hitoshi E<lt>ina@cpan.orgE<gt>

This project was originated by INABA Hitoshi.

=head1 LICENSE AND COPYRIGHT

This software is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

This software is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=head1 SEE ALSO

 CPAN Directory INABA Hitoshi
 http://search.cpan.org/~ina/

 BackPAN
 http://backpan.perl.org/authors/id/I/IN/INA/

 Recent Perl packages by "INABA Hitoshi"
 http://code.activestate.com/ppm/author:INABA-Hitoshi/

=cut

