BATsh

 view release on metacpan or  search on metacpan

pmake.bat  view on Meta::CPAN

            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 {
                        $tar->add_data("$tardir/$file", $data, {'mode' => 0664});
                    }
                    my $format_tar_file = $tar->write;
                    syswrite FH_TAR, $format_tar_file, length($format_tar_file) - length($ZERO_BLOCK . $ZERO_BLOCK);
                    undef $tar;

#-----------------------------------------------------------------------------
                }
                else {
                    die "file: $file is not exists.\n";
                }
            }

            # syswrite FH_TAR, $ZERO_BLOCK; makes "tar: A lone zero block at %s"
            syswrite FH_TAR, ($ZERO_BLOCK . $ZERO_BLOCK);

            close FH_TAR;
            rmtree($tardir,0,0);

            # make *.tar.gz file
            my $gz = gzopen("$tardir.tar.gz", 'wb');
            open(FH_TAR, "$tardir.tar") || die "Can't open file: $tardir.tar\n";
            binmode FH_TAR;
            while (sysread(FH_TAR, $_, 1024*1024)) {
                $gz->gzwrite($_);
            }
            close FH_TAR;
            $gz->gzclose;
            unlink "$tardir.tar";
        }

        # P.565 Cleaning Up Your Environment
        # in Chapter 23: Security
        # of ISBN 0-596-00027-8 Programming Perl Third Edition.

        # local $ENV{'PATH'} = '.';
        local @ENV{qw(IFS CDPATH ENV BASH_ENV)};

        # untar test
        if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
            system(qq{pmake.bat ptar.bat});
            system(qq{ptar.bat xzvf $tardir.tar.gz});
        }
        else {
            system(qq{./pmake.bat ptar});

pmake.bat  view on Meta::CPAN

__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++;
                    }
                    $testno++;
                }
                if ($ok == $tests) {
                    printf("$script ok\n");
                    $ok_script++;
                }
                else {
                    printf("$script Failed %d/%d subtests\n", $not_ok, $ok+$not_ok);
                    $not_ok_script++;
                }
            }
        }
        $total_ok += $ok;
        $total_not_ok += $not_ok;
        $scriptno++;
    }

    if (scalar(@script) == $ok_script) {
        printf <<'END', scalar(@script), $total_ok + $total_not_ok;
All tests successful.
Files=%d, Tests=%d
Result: PASS
END
    }
    else {
        print <<'END';

Test Summary Report
-------------------
END
        my $scriptno = 0;
        for my $fail_testno (@fail_testno) {
            if (defined $fail_testno) {
                print $script[$scriptno], "\n";
                print '  Failed test:  ', join(', ', @{$fail_testno[$scriptno]}), "\n";
            }
            $scriptno++;
        }
        printf("Files=%d, Tests=%d\n", scalar(@script), $total_ok + $total_not_ok);
        printf("Result: FAIL\n");
        printf("Failed %d/%d test programs. %d/%d subtests failed.\n", $not_ok_script, scalar(@script), $total_not_ok, $total_ok + $total_not_ok);
    }
}

sub check_usascii {
    my($file) = @_;
    if (open(FILE,$file)) {
        while (<FILE>) {
            if (not /^[\x0A\x20-\x7E]+$/) {
                die "error not US-ASCII: $file, q(;_;)bad!!";
            }
        }
        close(FILE);
    }
    else {
        die "error open: $file, q(;_;)bad!!";
    }
}

__END__

=pod

=head1 NAME

pmake - make of Perl Poor Tools

=head1 SYNOPSIS

  pmake.bat
  pmake.bat test
  pmake.bat xtest
  pmake.bat install
  pmake.bat dist
  pmake.bat ptar
  pmake.bat xzvf
  pmake.bat pwget

=head1 DEPENDENCIES

This software requires perl5.00503 or later.

=head1 AUTHOR

INABA Hitoshi E<lt>ina@cpan.orgE<gt> in a CPAN

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.

=cut

:endofperl



( run in 2.514 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )