DB-Handy
view release on metacpan or search on metacpan
change are better.
Good e-mail, patches, improvements, new features - are a fantastic help.
They should remain focused in scope and avoid containing unrelated commits.
**Please ask first** before embarking on any significant e-mail (e.g.
implementing features, refactoring code, porting to a different language),
otherwise you risk spending a lot of time working on something that the
project's developers might not want to merge into the project.
Please adhere to the coding conventions used throughout a project
(indentation, accurate comments, etc.) and any other requirements (such
as test coverage).
**IMPORTANT**: By submitting a patch, you agree to allow the project owner
to license your work under the same license as that used by the project.
TO_CONTRIBUTE
close FH_CONTRIBUTING;
check_usascii('CONTRIBUTING');
# write SECURITY.md
open(FH_SECURITY,'>SECURITY.md') || die "Can't open file: SECURITY.md\n";
binmode FH_SECURITY;
print FH_SECURITY <<'TO_SECURITY';
# Security Policy
## Reporting a Vulnerability
If you discover a security vulnerability in this distribution, please report
it by e-mail to the author at ina@cpan.org.
Do NOT open a public GitHub issue for security vulnerabilities. Please use
private e-mail so that a fix can be prepared before public disclosure.
You can expect an acknowledgement within a few days. If you do not receive
a response within one week, please follow up.
## Supported Versions
Only the most recent release on CPAN is actively maintained. Please
upgrade to the latest version before reporting security issues.
TO_SECURITY
close FH_SECURITY;
check_usascii('SECURITY.md');
# make work directory
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);
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';
}
}
# unzip and untar *.tar.gz
elsif ($target =~ /^xzvf$/) {
for my $gzfile (grep m/\.tar\.gz$/xmsi, @ARGV) {
if ($^O =~ /(?:solaris|linux)/i) {
system(qq{gzip -cd $gzfile | tar -xvf -});
}
else {
eval q{
use Compress::Zlib;
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;
}
}
last;
}
# make pwget
elsif ($target =~ /^pwget(?:\.bat)?$/) {
my $pwget = <<'PWGET_END';
######################################################################
#
# pwget - wget of Perl Poor Tools
#
# Copyright (c) 2011, 2018, 2019, 2020, 2021 INABA Hitoshi <ina@cpan.org> in a CPAN
######################################################################
use Socket;
unless (@ARGV) {
die <<END;
usage: pwget http://www.foo.com/bar/baz.tar.gz
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 (exists $ENV{'CYGWIN'}) {
if ($ENV{'CYGWIN'} !~ /\b nodosfilewarning \b/x) {
$ENV{'CYGWIN'} = join(' ', $ENV{'CYGWIN'}, 'nodosfilewarning');
}
}
my $scriptno = 0;
for my $script (@script) {
next if not -e $script;
my $testno = 1;
my $ok = 0;
my $not_ok = 0;
if (my @result = qx{$^X $script}) {
if (my($tests) = shift(@result) =~ /^1..([0-9]+)/) {
for my $result (@result) {
if ($result =~ /^ok /) {
$ok++;
}
elsif ($result =~ /^not ok /) {
push @{$fail_testno[$scriptno]}, $testno;
$not_ok++;
}
( run in 0.510 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )