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