######################################################################
#
# 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