The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
######################################################################
#
# makeallt.pl - make all t-skeleton/dist/*.t scripts
#
# Copyright (c) 2010, 2011, 2012, 2013, 2015 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
}

for my $dist (
    'Sjis',
    'HP15',
    'INFORMIXV6ALS',
    'GB18030',
    'GBK',
    'UHC',
    'KPS9566',
    'Big5HKSCS',
    'Big5Plus',

    'EUCJP',
    'EUCTW',

    'OldUTF8',
    'UTF2',

    'Cyrillic',
    'Greek',
    'KOI8R',
    'KOI8U',
    'Latin1',
    'Latin10',
    'Latin2',
    'Latin3',
    'Latin4',
    'Latin5',
    'Latin6',
    'Latin7',
    'Latin8',
    'Latin9',
    'Windows1252',
    'Windows1258',

    'Arabic',
    'Hebrew',
    'JIS8',
    'TIS620',
    'USASCII',
){
    opendir(DIR,qq{t/$dist}) || die "Can't open dir: t/$dist\n";
    my @test = grep(/\.t$/i, readdir(DIR));
    closedir(DIR);
    my($lasttest) = (sort @test)[-1];

    open(TEST,"t/$dist/$lasttest") || die "Can't open file: t/$dist/$lasttest\n";
    @_ = <TEST>;
    close(TEST);
    my @head = @_[0,1,2];

    mkdir($dist, 0777);
    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/$dist},0777);
print STDERR "$test --> t-skeleton/$dist/$test\n";
        open(TEST,qq{>t-skeleton/$dist/$test}) || die "Can't open file: t-skeleton/$dist/$test\n";
        binmode TEST;
        print TEST @head;
        print TEST @_[3..$#_];
        close(TEST);
    }
}

__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