Char-UTF2
view release on metacpan or search on metacpan
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
PURPOSE.
The End
LICENSING
close FH_LICENSE;
}
elsif ($target eq 'dist') {
# make work directory
my($changes) = grep(/^Changes$/i,@file);
open(FH_CHANGES, $changes) || die "Can't open file: $changes\n";
my $version = 0;
while (<FH_CHANGES>) {
if (/^(\d+\.\d+(\.\d+\.\d+)*)/) {
if ($1 > $version) {
$version = $1;
}
}
}
close FH_CHANGES;
my $dirname = (dirname($file[0]) eq 'bin') ? 'App' : dirname($file[0]);
$dirname =~ tr#/#-#;
my $basename = basename($file[0], '.pm','.pl','.bat');
my $tardir = "$dirname-$basename-$version";
$tardir =~ s#^lib-##;
rmtree($tardir,0,0);
# rewrite META.yml file
if (my($metayml) = grep(/^META\.yml$/i,@file)) {
if (open(FH_METAYML, $metayml)) {
$_ = join('',<FH_METAYML>);
close FH_METAYML;
if (open(FH_METAYML, ">$metayml")) {
s/^(version:\s*)\d+\.\d+(\.\d+\.\d+)*/$1$version/m;
binmode FH_METAYML;
print FH_METAYML $_;
close FH_METAYML;
}
}
}
if ($^O =~ /(?:solaris|linux)/i) {
for my $file (@file) {
if (-e $file) {
mkpath(dirname("$tardir/$file"), 0, 0777);
print STDERR "copy $file $tardir/$file\n";
copy($file, "$tardir/$file");
if ($file =~ m/ (?: Build\.PL | Makefile\.PL ) \z/oxmsi) {
chmod(0664, "$tardir/$file");
}
elsif ($file =~ m/\. (?: pl | bat | exe | com ) \z/oxmsi) {
chmod(0775, "$tardir/$file");
}
elsif ($file =~ m{^bin/}oxmsi) {
chmod(0775, "$tardir/$file");
}
else {
chmod(0664, "$tardir/$file");
}
}
}
system(qq{tar -cvf $tardir.tar $tardir});
system(qq{gzip $tardir.tar});
}
else {
#-----------------------------------------------------------------------------
# https://metacpan.org/search?q=Archive%3A%3ATar%3A%3AConstant
# https://metacpan.org/release/Archive-Tar-Streamed
#-----------------------------------------------------------------------------
eval q{
use Compress::Zlib;
use Archive::Tar;
};
my $BLOCK_SIZE = 512;
my $ZERO_BLOCK = "\0" x $BLOCK_SIZE;
# make *.tar file
open(FH_TAR, ">$tardir.tar") || die "Can't open file: $tardir.tar\n";
binmode FH_TAR;
for my $file (@file) {
if (-e $file) {
mkpath(dirname("$tardir/$file"), 0, 0777);
print STDERR "copy $file $tardir/$file\n";
copy($file, "$tardir/$file");
#-----------------------------------------------------------------------------
# Sunday December 21, 2008 07:38 PM
# Fixing world writable files in tarball before upload to CPAN [ #38127 ]
# http://use.perl.org/~bart/journal/38127 (dead link)
# Fix CPAN uploads for world writable files
# http://perlmonks.org/index.pl?node_id=731935
#-----------------------------------------------------------------------------
# $tar->add_files("$tardir/$file");
#-----------------------------------------------------------------------------
open(FH, $file) || die "Can't open file: $file\n";
binmode FH;
local $/ = undef; # slurp mode
my $data = <FH>;
close FH;
#-----------------------------------------------------------------------------
# Kwalitee Indicator: buildtool_not_executable core
# The build tool (Build.PL/Makefile.PL) is executable. This is bad because
# you should specify which perl you want to use while installing.
#
# How to fix
# Change the permissions of Build.PL/Makefile.PL to not-executable.
#-----------------------------------------------------------------------------
my $tar = Archive::Tar->new;
if ($file =~ m/ (?: Build\.PL | Makefile\.PL ) \z/oxmsi) {
$tar->add_data("$tardir/$file", $data, {'mode' => 0664});
}
elsif ($file =~ m/\. (?: pl | bat | exe | com ) \z/oxmsi) {
$tar->add_data("$tardir/$file", $data, {'mode' => 0775});
}
else {
use Archive::Tar;
};
my $gz = gzopen($gzfile, 'rb');
(my $tarfile = $gzfile) =~ s/\.gz$//xmsi;
open(FH_TAR, ">$tarfile") || die "Can't open file: $tarfile\n";
binmode FH_TAR;
while ($gz->gzreadline(my $line)) {
print FH_TAR $line;
}
$gz->gzclose;
close FH_TAR;
my $tar = Archive::Tar->new($tarfile,1);
for my $file ($tar->list_files){
if (-e $file) {
print STDERR "skip $file is already exists.\n";
}
else {
print STDERR "x $file\n";
$tar->extract($file);
}
}
unlink $tarfile;
}
}
__END__
PTAR_END
# make ptar.bat
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
open(FH_TARBAT, '>ptar.bat') || die "Can't open file: ptar.bat\n";
print FH_TARBAT <<'END';
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
@rem ';
#!perl
#line 14
undef @rem;
END
print FH_TARBAT $ptar;
print FH_TARBAT ":endofperl\n";
close FH_TARBAT;
}
# make ptar
else {
open(FH_TARBAT, '>ptar') || die "Can't open file: ptar\n";
print FH_TARBAT '#!', &which($^X), "\n";
print FH_TARBAT $ptar;
close FH_TARBAT;
chmod 0755, 'ptar';
}
}
elsif ($target =~ /^pwget(?:\.bat)?$/) {
my $pwget = <<'PWGET_END';
######################################################################
#
# pwget - wget of Perl Poor Tools
#
# Copyright (c) 2011, 2018, 2019 INABA Hitoshi <ina@cpan.org> in a CPAN
######################################################################
use Socket;
unless (@ARGV) {
die <<END;
usage: pwget http://www.foo.com/bar/baz.tar.gz
END
}
my $url = $ARGV[0];
my $forward = 3;
while ($forward-- > 0) {
my($hostname) = $url =~ m#http://([^/]+)/#;
my $port = ($hostname =~ s/:([0-9]+)//) ? $1 : 80;
socket(SOCKET,PF_INET,SOCK_STREAM,getprotobyname('tcp')) || die "Can't open TCP/IP socket.\n";
connect(SOCKET,sockaddr_in($port,inet_aton($hostname))) || die "Can't connect to $hostname:$port.\n";
select SOCKET;
$| = 1;
select STDOUT;
my $request = <<END;
GET $url HTTP/1.0
Accept: */*
User-Agent: $0
END
$request =~ s/\n/\r\n/g;
print SOCKET $request;
my($head,$body) = split(/\r\n\r\n/,join('',<SOCKET>),2);
close SOCKET;
if ($head =~ m#^Location: (\S+)#ms) {
$url = $1;
print STDERR "Location: $url\n";
next;
}
my($file) = $ARGV[0] =~ m#([^/]+)$#;
open(FILE,">$file") || die "Can't open file: $file\n";
binmode FILE;
print FILE $body;
close FILE;
if ($head =~ m#Content-Length: ([0-9]+)#ms) {
if (-s $file == $1) {
print STDERR "ok - $file\n";
}
else {
print STDERR "not ok - $file\n";
unlink $file;
}
}
last;
}
__END__
PWGET_END
# make pwget.bat
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
open(FH_WGETBAT, '>pwget.bat') || die "Can't open file: pwget.bat\n";
print FH_WGETBAT <<'END';
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
@rem ';
#!perl
#line 14
undef @rem;
END
print FH_WGETBAT $pwget;
print FH_WGETBAT ":endofperl\n";
close FH_WGETBAT;
}
# make pwget
else {
open(FH_WGETBAT, '>pwget') || die "Can't open file: pwget\n";
print FH_WGETBAT '#!', &which($^X), "\n";
print FH_WGETBAT $pwget;
close FH_WGETBAT;
chmod 0755, 'pwget';
}
}
else {
warn "unknown target: $target.\n";
}
}
sub which {
if ($_[0] =~ m#\A / #oxms) {
return $_[0];
}
else {
for my $path (split(/:/,$ENV{'PATH'})) {
if (-e qq{$path/$_[0]}) {
return qq{$path/$_[0]};
}
}
return $_[0];
}
}
# Test::Harness::runtests cannot work heavy load.
sub _runtests {
my @script = @_;
my @fail_testno = ();
my $ok_script = 0;
my $not_ok_script = 0;
my $total_ok = 0;
my $total_not_ok = 0;
# cygwin warning:
# MS-DOS style path detected: C:/cpan/Char-X.XX
# Preferred POSIX equivalent is: /cygdrive/c/cpan/Char-X.XX
# CYGWIN environment variable option "nodosfilewarning" turns off this warning.
# Consult the user's guide for more details about POSIX paths:
# http://cygwin.com/cygwin-ug-net/using.html#using-pathnames
if ($ENV{'CYGWIN'} !~ /\b nodosfilewarning \b/x) {
$ENV{'CYGWIN'} = join(' ', $ENV{'CYGWIN'}, 'nodosfilewarning');
}
my $scriptno = 0;
for my $script (@script) {
my @result = qx{$^X $script};
my($tests) = $result[0] =~ /^1..([0-9]+)/;
my $testno = 1;
my $ok = 0;
my $not_ok = 0;
for my $result (@result) {
if ($result =~ /^ok /) {
$ok++;
}
elsif ($result =~ /^not ok /) {
push @{$fail_testno[$scriptno]}, $testno;
$not_ok++;
}
$testno++;
}
( run in 0.579 second using v1.01-cache-2.11-cpan-39bf76dae61 )