Added perl 5.24.0

This commit is contained in:
Gator96100 2018-01-18 18:44:01 +01:00
parent 3f28c24484
commit f8199b068f
2396 changed files with 1406637 additions and 0 deletions

1383
msys/mingw/bin/c2ph.bat Normal file

File diff suppressed because it is too large Load diff

249
msys/mingw/bin/config_data Normal file
View file

@ -0,0 +1,249 @@
#!C:\perl-5.24.0\bin\perl.exe
use strict;
use Module::Build 0.25;
use Getopt::Long;
my %opt_defs = (
module => {type => '=s',
desc => 'The name of the module to configure (required)'},
feature => {type => ':s',
desc => 'Print the value of a feature or all features'},
config => {type => ':s',
desc => 'Print the value of a config option'},
set_feature => {type => '=s%',
desc => "Set a feature to 'true' or 'false'"},
set_config => {type => '=s%',
desc => 'Set a config option to the given value'},
eval => {type => '',
desc => 'eval() config values before setting'},
help => {type => '',
desc => 'Print a help message and exit'},
);
my %opts;
GetOptions( \%opts, map "$_$opt_defs{$_}{type}", keys %opt_defs ) or die usage(%opt_defs);
print usage(%opt_defs) and exit(0)
if $opts{help};
my @exclusive = qw(feature config set_feature set_config);
die "Exactly one of the options '" . join("', '", @exclusive) . "' must be specified\n" . usage(%opt_defs)
unless grep(exists $opts{$_}, @exclusive) == 1;
die "Option --module is required\n" . usage(%opt_defs)
unless $opts{module};
my $cf = load_config($opts{module});
if (exists $opts{feature}) {
if (length $opts{feature}) {
print $cf->feature($opts{feature});
} else {
my %auto;
# note: need to support older ConfigData.pm's
@auto{$cf->auto_feature_names} = () if $cf->can("auto_feature_names");
print " Features defined in $cf:\n";
foreach my $name (sort $cf->feature_names) {
print " $name => ", $cf->feature($name), (exists $auto{$name} ? " (dynamic)" : ""), "\n";
}
}
} elsif (exists $opts{config}) {
require Data::Dumper;
local $Data::Dumper::Terse = 1;
if (length $opts{config}) {
print Data::Dumper::Dumper($cf->config($opts{config})), "\n";
} else {
print " Configuration defined in $cf:\n";
foreach my $name (sort $cf->config_names) {
print " $name => ", Data::Dumper::Dumper($cf->config($name)), "\n";
}
}
} elsif (exists $opts{set_feature}) {
my %to_set = %{$opts{set_feature}};
while (my ($k, $v) = each %to_set) {
die "Feature value must be 0 or 1\n" unless $v =~ /^[01]$/;
$cf->set_feature($k, 0+$v); # Cast to a number, not a string
}
$cf->write;
print "Feature" . 's'x(keys(%to_set)>1) . " saved\n";
} elsif (exists $opts{set_config}) {
my %to_set = %{$opts{set_config}};
while (my ($k, $v) = each %to_set) {
if ($opts{eval}) {
$v = eval($v);
die $@ if $@;
}
$cf->set_config($k, $v);
}
$cf->write;
print "Config value" . 's'x(keys(%to_set)>1) . " saved\n";
}
sub load_config {
my $mod = shift;
$mod =~ /^([\w:]+)$/
or die "Invalid module name '$mod'";
my $cf = $mod . "::ConfigData";
eval "require $cf";
die $@ if $@;
return $cf;
}
sub usage {
my %defs = @_;
my $out = "\nUsage: $0 [options]\n\n Options include:\n";
foreach my $name (sort keys %defs) {
$out .= " --$name";
for ($defs{$name}{type}) {
/^=s$/ and $out .= " <string>";
/^=s%$/ and $out .= " <string>=<value>";
}
pad_line($out, 35);
$out .= "$defs{$name}{desc}\n";
}
$out .= <<EOF;
Examples:
$0 --module Foo::Bar --feature bazzable
$0 --module Foo::Bar --config magic_number
$0 --module Foo::Bar --set_feature bazzable=1
$0 --module Foo::Bar --set_config magic_number=42
EOF
return $out;
}
sub pad_line { $_[0] .= ' ' x ($_[1] - length($_[0]) + rindex($_[0], "\n")) }
__END__
=head1 NAME
config_data - Query or change configuration of Perl modules
=head1 SYNOPSIS
# Get config/feature values
config_data --module Foo::Bar --feature bazzable
config_data --module Foo::Bar --config magic_number
# Set config/feature values
config_data --module Foo::Bar --set_feature bazzable=1
config_data --module Foo::Bar --set_config magic_number=42
# Print a usage message
config_data --help
=head1 DESCRIPTION
The C<config_data> tool provides a command-line interface to the
configuration of Perl modules. By "configuration", we mean something
akin to "user preferences" or "local settings". This is a
formalization and abstraction of the systems that people like Andreas
Koenig (C<CPAN::Config>), Jon Swartz (C<HTML::Mason::Config>), Andy
Wardley (C<Template::Config>), and Larry Wall (perl's own Config.pm)
have developed independently.
The configuration system employed here was developed in the context of
C<Module::Build>. Under this system, configuration information for a
module C<Foo>, for example, is stored in a module called
C<Foo::ConfigData>) (I would have called it C<Foo::Config>, but that
was taken by all those other systems mentioned in the previous
paragraph...). These C<...::ConfigData> modules contain the
configuration data, as well as publicly accessible methods for
querying and setting (yes, actually re-writing) the configuration
data. The C<config_data> script (whose docs you are currently
reading) is merely a front-end for those methods. If you wish, you
may create alternate front-ends.
The two types of data that may be stored are called C<config> values
and C<feature> values. A C<config> value may be any perl scalar,
including references to complex data structures. It must, however, be
serializable using C<Data::Dumper>. A C<feature> is a boolean (1 or
0) value.
=head1 USAGE
This script functions as a basic getter/setter wrapper around the
configuration of a single module. On the command line, specify which
module's configuration you're interested in, and pass options to get
or set C<config> or C<feature> values. The following options are
supported:
=over 4
=item module
Specifies the name of the module to configure (required).
=item feature
When passed the name of a C<feature>, shows its value. The value will
be 1 if the feature is enabled, 0 if the feature is not enabled, or
empty if the feature is unknown. When no feature name is supplied,
the names and values of all known features will be shown.
=item config
When passed the name of a C<config> entry, shows its value. The value
will be displayed using C<Data::Dumper> (or similar) as perl code.
When no config name is supplied, the names and values of all known
config entries will be shown.
=item set_feature
Sets the given C<feature> to the given boolean value. Specify the value
as either 1 or 0.
=item set_config
Sets the given C<config> entry to the given value.
=item eval
If the C<--eval> option is used, the values in C<set_config> will be
evaluated as perl code before being stored. This allows moderately
complicated data structures to be stored. For really complicated
structures, you probably shouldn't use this command-line interface,
just use the Perl API instead.
=item help
Prints a help message, including a few examples, and exits.
=back
=head1 AUTHOR
Ken Williams, kwilliams@cpan.org
=head1 COPYRIGHT
Copyright (c) 1999, Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
Module::Build(3), perl(1).
=cut

View file

@ -0,0 +1,265 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!C:\perl-5.24.0\bin\perl.exe
#line 15
use strict;
use Module::Build 0.25;
use Getopt::Long;
my %opt_defs = (
module => {type => '=s',
desc => 'The name of the module to configure (required)'},
feature => {type => ':s',
desc => 'Print the value of a feature or all features'},
config => {type => ':s',
desc => 'Print the value of a config option'},
set_feature => {type => '=s%',
desc => "Set a feature to 'true' or 'false'"},
set_config => {type => '=s%',
desc => 'Set a config option to the given value'},
eval => {type => '',
desc => 'eval() config values before setting'},
help => {type => '',
desc => 'Print a help message and exit'},
);
my %opts;
GetOptions( \%opts, map "$_$opt_defs{$_}{type}", keys %opt_defs ) or die usage(%opt_defs);
print usage(%opt_defs) and exit(0)
if $opts{help};
my @exclusive = qw(feature config set_feature set_config);
die "Exactly one of the options '" . join("', '", @exclusive) . "' must be specified\n" . usage(%opt_defs)
unless grep(exists $opts{$_}, @exclusive) == 1;
die "Option --module is required\n" . usage(%opt_defs)
unless $opts{module};
my $cf = load_config($opts{module});
if (exists $opts{feature}) {
if (length $opts{feature}) {
print $cf->feature($opts{feature});
} else {
my %auto;
# note: need to support older ConfigData.pm's
@auto{$cf->auto_feature_names} = () if $cf->can("auto_feature_names");
print " Features defined in $cf:\n";
foreach my $name (sort $cf->feature_names) {
print " $name => ", $cf->feature($name), (exists $auto{$name} ? " (dynamic)" : ""), "\n";
}
}
} elsif (exists $opts{config}) {
require Data::Dumper;
local $Data::Dumper::Terse = 1;
if (length $opts{config}) {
print Data::Dumper::Dumper($cf->config($opts{config})), "\n";
} else {
print " Configuration defined in $cf:\n";
foreach my $name (sort $cf->config_names) {
print " $name => ", Data::Dumper::Dumper($cf->config($name)), "\n";
}
}
} elsif (exists $opts{set_feature}) {
my %to_set = %{$opts{set_feature}};
while (my ($k, $v) = each %to_set) {
die "Feature value must be 0 or 1\n" unless $v =~ /^[01]$/;
$cf->set_feature($k, 0+$v); # Cast to a number, not a string
}
$cf->write;
print "Feature" . 's'x(keys(%to_set)>1) . " saved\n";
} elsif (exists $opts{set_config}) {
my %to_set = %{$opts{set_config}};
while (my ($k, $v) = each %to_set) {
if ($opts{eval}) {
$v = eval($v);
die $@ if $@;
}
$cf->set_config($k, $v);
}
$cf->write;
print "Config value" . 's'x(keys(%to_set)>1) . " saved\n";
}
sub load_config {
my $mod = shift;
$mod =~ /^([\w:]+)$/
or die "Invalid module name '$mod'";
my $cf = $mod . "::ConfigData";
eval "require $cf";
die $@ if $@;
return $cf;
}
sub usage {
my %defs = @_;
my $out = "\nUsage: $0 [options]\n\n Options include:\n";
foreach my $name (sort keys %defs) {
$out .= " --$name";
for ($defs{$name}{type}) {
/^=s$/ and $out .= " <string>";
/^=s%$/ and $out .= " <string>=<value>";
}
pad_line($out, 35);
$out .= "$defs{$name}{desc}\n";
}
$out .= <<EOF;
Examples:
$0 --module Foo::Bar --feature bazzable
$0 --module Foo::Bar --config magic_number
$0 --module Foo::Bar --set_feature bazzable=1
$0 --module Foo::Bar --set_config magic_number=42
EOF
return $out;
}
sub pad_line { $_[0] .= ' ' x ($_[1] - length($_[0]) + rindex($_[0], "\n")) }
__END__
=head1 NAME
config_data - Query or change configuration of Perl modules
=head1 SYNOPSIS
# Get config/feature values
config_data --module Foo::Bar --feature bazzable
config_data --module Foo::Bar --config magic_number
# Set config/feature values
config_data --module Foo::Bar --set_feature bazzable=1
config_data --module Foo::Bar --set_config magic_number=42
# Print a usage message
config_data --help
=head1 DESCRIPTION
The C<config_data> tool provides a command-line interface to the
configuration of Perl modules. By "configuration", we mean something
akin to "user preferences" or "local settings". This is a
formalization and abstraction of the systems that people like Andreas
Koenig (C<CPAN::Config>), Jon Swartz (C<HTML::Mason::Config>), Andy
Wardley (C<Template::Config>), and Larry Wall (perl's own Config.pm)
have developed independently.
The configuration system employed here was developed in the context of
C<Module::Build>. Under this system, configuration information for a
module C<Foo>, for example, is stored in a module called
C<Foo::ConfigData>) (I would have called it C<Foo::Config>, but that
was taken by all those other systems mentioned in the previous
paragraph...). These C<...::ConfigData> modules contain the
configuration data, as well as publicly accessible methods for
querying and setting (yes, actually re-writing) the configuration
data. The C<config_data> script (whose docs you are currently
reading) is merely a front-end for those methods. If you wish, you
may create alternate front-ends.
The two types of data that may be stored are called C<config> values
and C<feature> values. A C<config> value may be any perl scalar,
including references to complex data structures. It must, however, be
serializable using C<Data::Dumper>. A C<feature> is a boolean (1 or
0) value.
=head1 USAGE
This script functions as a basic getter/setter wrapper around the
configuration of a single module. On the command line, specify which
module's configuration you're interested in, and pass options to get
or set C<config> or C<feature> values. The following options are
supported:
=over 4
=item module
Specifies the name of the module to configure (required).
=item feature
When passed the name of a C<feature>, shows its value. The value will
be 1 if the feature is enabled, 0 if the feature is not enabled, or
empty if the feature is unknown. When no feature name is supplied,
the names and values of all known features will be shown.
=item config
When passed the name of a C<config> entry, shows its value. The value
will be displayed using C<Data::Dumper> (or similar) as perl code.
When no config name is supplied, the names and values of all known
config entries will be shown.
=item set_feature
Sets the given C<feature> to the given boolean value. Specify the value
as either 1 or 0.
=item set_config
Sets the given C<config> entry to the given value.
=item eval
If the C<--eval> option is used, the values in C<set_config> will be
evaluated as perl code before being stored. This allows moderately
complicated data structures to be stored. For really complicated
structures, you probably shouldn't use this command-line interface,
just use the Perl API instead.
=item help
Prints a help message, including a few examples, and exits.
=back
=head1 AUTHOR
Ken Williams, kwilliams@cpan.org
=head1 COPYRIGHT
Copyright (c) 1999, Ken Williams. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
Module::Build(3), perl(1).
=cut
__END__
:endofperl

507
msys/mingw/bin/corelist.bat Normal file
View file

@ -0,0 +1,507 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
=head1 NAME
corelist - a commandline frontend to Module::CoreList
=head1 DESCRIPTION
See L<Module::CoreList> for one.
=head1 SYNOPSIS
corelist -v
corelist [-a|-d] <ModuleName> | /<ModuleRegex>/ [<ModuleVersion>] ...
corelist [-v <PerlVersion>] [ <ModuleName> | /<ModuleRegex>/ ] ...
corelist [-r <PerlVersion>] ...
corelist --feature <FeatureName> [<FeatureName>] ...
corelist --diff PerlVersion PerlVersion
corelist --upstream <ModuleName>
=head1 OPTIONS
=over
=item -a
lists all versions of the given module (or the matching modules, in case you
used a module regexp) in the perls Module::CoreList knows about.
corelist -a Unicode
Unicode was first released with perl v5.6.2
v5.6.2 3.0.1
v5.8.0 3.2.0
v5.8.1 4.0.0
v5.8.2 4.0.0
v5.8.3 4.0.0
v5.8.4 4.0.1
v5.8.5 4.0.1
v5.8.6 4.0.1
v5.8.7 4.1.0
v5.8.8 4.1.0
v5.8.9 5.1.0
v5.9.0 4.0.0
v5.9.1 4.0.0
v5.9.2 4.0.1
v5.9.3 4.1.0
v5.9.4 4.1.0
v5.9.5 5.0.0
v5.10.0 5.0.0
v5.10.1 5.1.0
v5.11.0 5.1.0
v5.11.1 5.1.0
v5.11.2 5.1.0
v5.11.3 5.2.0
v5.11.4 5.2.0
v5.11.5 5.2.0
v5.12.0 5.2.0
v5.12.1 5.2.0
v5.12.2 5.2.0
v5.12.3 5.2.0
v5.12.4 5.2.0
v5.13.0 5.2.0
v5.13.1 5.2.0
v5.13.2 5.2.0
v5.13.3 5.2.0
v5.13.4 5.2.0
v5.13.5 5.2.0
v5.13.6 5.2.0
v5.13.7 6.0.0
v5.13.8 6.0.0
v5.13.9 6.0.0
v5.13.10 6.0.0
v5.13.11 6.0.0
v5.14.0 6.0.0
v5.14.1 6.0.0
v5.15.0 6.0.0
=item -d
finds the first perl version where a module has been released by
date, and not by version number (as is the default).
=item --diff
Given two versions of perl, this prints a human-readable table of all module
changes between the two. The output format may change in the future, and is
meant for I<humans>, not programs. For programs, use the L<Module::CoreList>
API.
=item -? or -help
help! help! help! to see more help, try --man.
=item -man
all of the help
=item -v
lists all of the perl release versions we got the CoreList for.
If you pass a version argument (value of C<$]>, like C<5.00503> or C<5.008008>),
you get a list of all the modules and their respective versions.
(If you have the C<version> module, you can also use new-style version numbers,
like C<5.8.8>.)
In module filtering context, it can be used as Perl version filter.
=item -r
lists all of the perl releases and when they were released
If you pass a perl version you get the release date for that version only.
=item --feature, -f
lists the first version bundle of each named feature given
=item --upstream, -u
Shows if the given module is primarily maintained in perl core or on CPAN
and bug tracker URL.
=back
As a special case, if you specify the module name C<Unicode>, you'll get
the version number of the Unicode Character Database bundled with the
requested perl versions.
=cut
use Module::CoreList;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use strict;
use warnings;
use List::Util qw/maxstr/;
my %Opts;
GetOptions(
\%Opts,
qw[ help|?! man! r|release:s v|version:s a! d diff|D feature|f u|upstream ]
);
pod2usage(1) if $Opts{help};
pod2usage(-verbose=>2) if $Opts{man};
if(exists $Opts{r} ){
if ( !$Opts{r} ) {
print "\nModule::CoreList has release info for the following perl versions:\n";
my $versions = { };
my $max_ver_len = max_mod_len(\%Module::CoreList::released);
for my $ver ( grep !/0[01]0$/, sort keys %Module::CoreList::released ) {
printf "%-${max_ver_len}s %s\n", format_perl_version($ver), $Module::CoreList::released{$ver};
}
print "\n";
exit 0;
}
my $num_r = numify_version( $Opts{r} );
my $version_hash = Module::CoreList->find_version($num_r);
if( !$version_hash ) {
print "\nModule::CoreList has no info on perl $Opts{r}\n\n";
exit 1;
}
printf "Perl %s was released on %s\n\n", format_perl_version($num_r), $Module::CoreList::released{$num_r};
exit 0;
}
if(exists $Opts{v} ){
if( !$Opts{v} ) {
print "\nModule::CoreList has info on the following perl versions:\n";
print format_perl_version($_)."\n" for grep !/0[01]0$/, sort keys %Module::CoreList::version;
print "\n";
exit 0;
}
my $num_v = numify_version( $Opts{v} );
my $version_hash = Module::CoreList->find_version($num_v);
if( !$version_hash ) {
print "\nModule::CoreList has no info on perl $Opts{v}\n\n";
exit 1;
}
if ( !@ARGV ) {
print "\nThe following modules were in perl $Opts{v} CORE\n";
my $max_mod_len = max_mod_len($version_hash);
for my $mod ( sort keys %$version_hash ) {
printf "%-${max_mod_len}s %s\n", $mod, $version_hash->{$mod} || "";
}
print "\n";
exit 0;
}
}
if ($Opts{diff}) {
if(@ARGV != 2) {
die "\nprovide exactly two perl core versions to diff with --diff\n";
}
my ($old_ver, $new_ver) = @ARGV;
my $old = numify_version($old_ver);
my $new = numify_version($new_ver);
my %diff = Module::CoreList::changes_between($old, $new);
for my $lib (sort keys %diff) {
my $diff = $diff{$lib};
my $was = ! exists $diff->{left} ? '(absent)'
: ! defined $diff->{left} ? '(undef)'
: $diff->{left};
my $now = ! exists $diff->{right} ? '(absent)'
: ! defined $diff->{right} ? '(undef)'
: $diff->{right};
printf "%-35s %10s %10s\n", $lib, $was, $now;
}
exit(0);
}
if ($Opts{feature}) {
die "\n--feature is only available with perl v5.16.0 or greater\n"
if $] < 5.016;
die "\nprovide at least one feature name to --feature\n"
unless @ARGV;
no warnings 'once';
require feature;
my %feature2version;
my @bundles = map { $_->[0] }
sort { $b->[1] <=> $a->[1] }
map { [$_, numify_version($_)] }
grep { not /[^0-9.]/ }
keys %feature::feature_bundle;
for my $version (@bundles) {
$feature2version{$_} = $version =~ /^\d\.\d+$/ ? "$version.0" : $version
for @{ $feature::feature_bundle{$version} };
}
# allow internal feature names, just in case someone gives us __SUB__
# instead of current_sub.
while (my ($name, $internal) = each %feature::feature) {
$internal =~ s/^feature_//;
$feature2version{$internal} = $feature2version{$name}
if $feature2version{$name};
}
my $when = maxstr(values %Module::CoreList::released);
print "\n","Data for $when\n";
for my $feature (@ARGV) {
print "feature \"$feature\" ",
exists $feature2version{$feature}
? "was first released with the perl "
. format_perl_version(numify_version($feature2version{$feature}))
. " feature bundle\n"
: "doesn't exist (or so I think)\n";
}
exit(0);
}
if ( !@ARGV ) {
pod2usage(0);
}
while (@ARGV) {
my ($mod, $ver);
if ($ARGV[0] =~ /=/) {
($mod, $ver) = split /=/, shift @ARGV;
} else {
$mod = shift @ARGV;
$ver = (@ARGV && $ARGV[0] =~ /^\d/) ? shift @ARGV : "";
}
if ($mod !~ m|^/(.*)/([imosx]*)$|) { # not a regex
module_version($mod,$ver);
} else {
my $re;
eval { $re = $2 ? qr/(?$2)($1)/ : qr/$1/; }; # trap exceptions while building regex
if ($@) {
# regex errors are usually like 'Quantifier follow nothing in regex; marked by ...'
# then we drop text after ';' to shorten message
my $errmsg = $@ =~ /(.*);/ ? $1 : $@;
warn "\n$mod is a bad regex: $errmsg\n";
next;
}
my @mod = Module::CoreList->find_modules($re);
if (@mod) {
module_version($_, $ver) for @mod;
} else {
$ver |= '';
print "\n$mod $ver has no match in CORE (or so I think)\n";
}
}
}
exit();
sub module_version {
my($mod,$ver) = @_;
if ( $Opts{v} ) {
my $numeric_v = numify_version($Opts{v});
my $version_hash = Module::CoreList->find_version($numeric_v);
if ($version_hash) {
print $mod, " ", $version_hash->{$mod} || 'undef', "\n";
return;
}
else { die "Shouldn't happen" }
}
my $ret = $Opts{d}
? Module::CoreList->first_release_by_date(@_)
: Module::CoreList->first_release(@_);
my $msg = $mod;
$msg .= " $ver" if $ver;
my $rem = $Opts{d}
? Module::CoreList->removed_from_by_date($mod)
: Module::CoreList->removed_from($mod);
my $when = maxstr(values %Module::CoreList::released);
print "\n","Data for $when\n";
if( defined $ret ) {
my $deprecated = Module::CoreList->deprecated_in($mod);
$msg .= " was ";
$msg .= "first " unless $ver;
$msg .= "released with perl " . format_perl_version($ret);
$msg .= ( $rem ? ',' : ' and' ) . " deprecated (will be CPAN-only) in " . format_perl_version($deprecated) if $deprecated;
$msg .= " and removed from " . format_perl_version($rem) if $rem;
} else {
$msg .= " was not in CORE (or so I think)";
}
print $msg,"\n";
if( defined $ret and exists $Opts{u} ) {
my $upsream = $Module::CoreList::upstream{$mod};
$upsream = 'undef' unless $upsream;
print "upstream: $upsream\n";
if ( $upsream ne 'blead' ) {
my $bugtracker = $Module::CoreList::bug_tracker{$mod};
$bugtracker = 'unknown' unless $bugtracker;
print "bug tracker: $bugtracker\n";
}
}
if(defined $ret and exists $Opts{a} and $Opts{a}){
display_a($mod);
}
}
sub max_mod_len {
my $versions = shift;
my $max = 0;
for my $mod (keys %$versions) {
$max = max($max, length $mod);
}
return $max;
}
sub max {
my($this, $that) = @_;
return $this if $this > $that;
return $that;
}
sub display_a {
my $mod = shift;
for my $v (grep !/0[01]0$/, sort keys %Module::CoreList::version ) {
next unless exists $Module::CoreList::version{$v}{$mod};
my $mod_v = $Module::CoreList::version{$v}{$mod} || 'undef';
printf " %-10s %-10s\n", format_perl_version($v), $mod_v;
}
print "\n";
}
{
my $have_version_pm;
sub have_version_pm {
return $have_version_pm if defined $have_version_pm;
return $have_version_pm = eval { require version; 1 };
}
}
sub format_perl_version {
my $v = shift;
return $v if $v < 5.006 or !have_version_pm;
return version->new($v)->normal;
}
sub numify_version {
my $ver = shift;
if ($ver =~ /\..+\./) {
have_version_pm()
or die "You need to install version.pm to use dotted version numbers\n";
$ver = version->new($ver)->numify;
}
$ver += 0;
return $ver;
}
=head1 EXAMPLES
$ corelist File::Spec
File::Spec was first released with perl 5.005
$ corelist File::Spec 0.83
File::Spec 0.83 was released with perl 5.007003
$ corelist File::Spec 0.89
File::Spec 0.89 was not in CORE (or so I think)
$ corelist File::Spec::Aliens
File::Spec::Aliens was not in CORE (or so I think)
$ corelist /IPC::Open/
IPC::Open2 was first released with perl 5
IPC::Open3 was first released with perl 5
$ corelist /MANIFEST/i
ExtUtils::Manifest was first released with perl 5.001
$ corelist /Template/
/Template/ has no match in CORE (or so I think)
$ corelist -v 5.8.8 B
B 1.09_01
$ corelist -v 5.8.8 /^B::/
B::Asmdata 1.01
B::Assembler 0.07
B::Bblock 1.02_01
B::Bytecode 1.01_01
B::C 1.04_01
B::CC 1.00_01
B::Concise 0.66
B::Debug 1.02_01
B::Deparse 0.71
B::Disassembler 1.05
B::Lint 1.03
B::O 1.00
B::Showlex 1.02
B::Stackobj 1.00
B::Stash 1.00
B::Terse 1.03_01
B::Xref 1.01
=head1 COPYRIGHT
Copyright (c) 2002-2007 by D.H. aka PodMaster
Currently maintained by the perl 5 porters E<lt>perl5-porters@perl.orgE<gt>.
This program is distributed under the same terms as perl itself.
See http://perl.org/ or http://cpan.org/ for more info on that.
=cut
__END__
:endofperl

340
msys/mingw/bin/cpan.bat Normal file
View file

@ -0,0 +1,340 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/local/bin/perl
use strict;
use vars qw($VERSION);
use App::Cpan '1.60_02';
$VERSION = '1.61';
my $rc = App::Cpan->run( @ARGV );
# will this work under Strawberry Perl?
exit( $rc || 0 );
=head1 NAME
cpan - easily interact with CPAN from the command line
=head1 SYNOPSIS
# with arguments and no switches, installs specified modules
cpan module_name [ module_name ... ]
# with switches, installs modules with extra behavior
cpan [-cfgimtTw] module_name [ module_name ... ]
# with just the dot, install from the distribution in the
# current directory
cpan .
# without arguments, starts CPAN.pm shell
cpan
# force install modules (usually those that fail tests)
cpan -f module_name [ module_name ... ]
# install modules but without testing them
cpan -T module_name [ module_name ... ]
# dump the configuration
cpan -J
# load a different configuration to install Module::Foo
cpan -j some/other/file Module::Foo
# without arguments, but some switches
cpan [-ahrvACDlLO]
=head1 DESCRIPTION
This script provides a command interface (not a shell) to CPAN. At the
moment it uses CPAN.pm to do the work, but it is not a one-shot command
runner for CPAN.pm.
=head2 Options
=over 4
=item -a
Creates a CPAN.pm autobundle with CPAN::Shell->autobundle.
=item -A module [ module ... ]
Shows the primary maintainers for the specified modules.
=item -c module
Runs a `make clean` in the specified module's directories.
=item -C module [ module ... ]
Show the F<Changes> files for the specified modules
=item -D module [ module ... ]
Show the module details.
=item -f
Force the specified action, when it normally would have failed. Use this
to install a module even if its tests fail. When you use this option,
-i is not optional for installing a module when you need to force it:
% cpan -f -i Module::Foo
=item -F
Turn off CPAN.pm's attempts to lock anything. You should be careful with
this since you might end up with multiple scripts trying to muck in the
same directory. This isn't so much of a concern if you're loading a special
config with C<-j>, and that config sets up its own work directories.
=item -g module [ module ... ]
Downloads to the current directory the latest distribution of the module.
=item -G module [ module ... ]
UNIMPLEMENTED
Download to the current directory the latest distribution of the
modules, unpack each distribution, and create a git repository for each
distribution.
If you want this feature, check out Yanick Champoux's C<Git::CPAN::Patch>
distribution.
=item -h
Print a help message and exit. When you specify C<-h>, it ignores all
of the other options and arguments.
=item -i
Install the specified modules.
=item -I
Load C<local::lib> (think like C<-I> for loading lib paths).
=item -j Config.pm
Load the file that has the CPAN configuration data. This should have the
same format as the standard F<CPAN/Config.pm> file, which defines
C<$CPAN::Config> as an anonymous hash.
=item -J
Dump the configuration in the same format that CPAN.pm uses. This is useful
for checking the configuration as well as using the dump as a starting point
for a new, custom configuration.
=item -l
List all installed modules with their versions
=item -L author [ author ... ]
List the modules by the specified authors.
=item -m
Make the specified modules.
=item -O
Show the out-of-date modules.
=item -p
Ping the configured mirrors
=item -P
Find the best mirrors you could be using (but doesn't configure them just yet)
=item -r
Recompiles dynamically loaded modules with CPAN::Shell->recompile.
=item -t
Run a `make test` on the specified modules.
=item -T
Do not test modules. Simply install them.
=item -u
Upgrade all installed modules. Blindly doing this can really break things,
so keep a backup.
=item -v
Print the script version and CPAN.pm version then exit.
=item -V
Print detailed information about the cpan client.
=item -w
UNIMPLEMENTED
Turn on cpan warnings. This checks various things, like directory permissions,
and tells you about problems you might have.
=back
=head2 Examples
# print a help message
cpan -h
# print the version numbers
cpan -v
# create an autobundle
cpan -a
# recompile modules
cpan -r
# upgrade all installed modules
cpan -u
# install modules ( sole -i is optional )
cpan -i Netscape::Booksmarks Business::ISBN
# force install modules ( must use -i )
cpan -fi CGI::Minimal URI
=head1 ENVIRONMENT VARIABLES
=over 4
There are several components in CPAN.pm that use environment variables.
The build tools, L<ExtUtils::MakeMaker> and L<Module::Build> use some,
while others matter to the levels above them. Some of these are specified
by the Perl Toolchain Gang:
Lancaster Concensus: L<https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>
Oslo Concensus: L<https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/oslo-consensus.md>
=over 4
=item CPAN_OPTS
C<cpan> splits this variable on whitespace and prepends that list to C<@ARGV>
before it processes the command-line arguments. For instance, if you always
want to use C<local:lib>, you can set C<CPAN_OPTS> to C<-I>.
=item CPANSCRIPT_LOGLEVEL
The log level to use, with either the embedded, minimal logger or
L<Log::Log4perl> if it is installed. Possible values are the same as
the C<Log::Log4perl> levels: C<TRACE>, C<DEBUG>, C<INFO>, C<WARN>,
C<ERROR>, and C<FATAL>. The default is C<INFO>.
=item GIT_COMMAND
The path to the C<git> binary to use for the Git features. The default
is C</usr/local/bin/git>.
=item NONINTERACTIVE_TESTING
Assume no one is paying attention and skips prompts for distributions
that do that correctly. C<cpan(1)> sets this to C<1> unless it already
has a value (even if that value is false).
=item PERL_MM_USE_DEFAULT
Use the default answer for a prompted questions. C<cpan(1)> sets this
to C<1> unless it already has a value (even if that value is false).
=back
=back
=head1 EXIT VALUES
The script exits with zero if it thinks that everything worked, or a
positive number if it thinks that something failed. Note, however, that
in some cases it has to divine a failure by the output of things it does
not control. For now, the exit codes are vague:
1 An unknown error
2 The was an external problem
4 There was an internal problem with the script
8 A module failed to install
=head1 TO DO
* one shot configuration values from the command line
=head1 BUGS
* none noted
=head1 SEE ALSO
Most behaviour, including environment variables and configuration,
comes directly from CPAN.pm.
=head1 SOURCE AVAILABILITY
This code is in Github in the CPAN.pm repository:
https://github.com/andk/cpanpm
The source used to be tracked separately in another GitHub repo,
but the canonical source is now in the above repo.
=head1 CREDITS
Japheth Cleaver added the bits to allow a forced install (-f).
Jim Brandt suggest and provided the initial implementation for the
up-to-date and Changes features.
Adam Kennedy pointed out that exit() causes problems on Windows
where this script ends up with a .bat extension
=head1 AUTHOR
brian d foy, C<< <bdfoy@cpan.org> >>
=head1 COPYRIGHT
Copyright (c) 2001-2014, brian d foy, All Rights Reserved.
You may redistribute this under the same terms as Perl itself.
=cut
1;
__END__
:endofperl

48
msys/mingw/bin/crc32 Normal file
View file

@ -0,0 +1,48 @@
#!/usr/bin/perl
# Computes and prints to stdout the CRC-32 values of the given files
use 5.006;
use strict;
use lib qw( blib/lib lib );
use Archive::Zip;
use FileHandle;
use vars qw( $VERSION );
BEGIN {
$VERSION = '1.51';
}
my $totalFiles = scalar(@ARGV);
foreach my $file (@ARGV) {
if ( -d $file ) {
warn "$0: ${file}: Is a directory\n";
next;
}
my $fh = FileHandle->new();
if ( !$fh->open( $file, 'r' ) ) {
warn "$0: $!\n";
next;
}
binmode($fh);
my $buffer;
my $bytesRead;
my $crc = 0;
while ( $bytesRead = $fh->read( $buffer, 32768 ) ) {
$crc = Archive::Zip::computeCRC32( $buffer, $crc );
}
my $fileCrc = sprintf("%08x", $crc);
printf("$fileCrc");
print("\t$file") if ( $totalFiles > 1 );
if ( $file =~ /[^[:xdigit:]]([[:xdigit:]]{8})[^[:xdigit:]]/ ) {
my $filenameCrc = $1;
if ( lc($filenameCrc) eq lc($fileCrc) ) {
print("\tOK")
} else {
print("\tBAD $fileCrc != $filenameCrc");
}
}
print("\n");
}

64
msys/mingw/bin/crc32.bat Normal file
View file

@ -0,0 +1,64 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl
#line 15
# Computes and prints to stdout the CRC-32 values of the given files
use 5.006;
use strict;
use lib qw( blib/lib lib );
use Archive::Zip;
use FileHandle;
use vars qw( $VERSION );
BEGIN {
$VERSION = '1.51';
}
my $totalFiles = scalar(@ARGV);
foreach my $file (@ARGV) {
if ( -d $file ) {
warn "$0: ${file}: Is a directory\n";
next;
}
my $fh = FileHandle->new();
if ( !$fh->open( $file, 'r' ) ) {
warn "$0: $!\n";
next;
}
binmode($fh);
my $buffer;
my $bytesRead;
my $crc = 0;
while ( $bytesRead = $fh->read( $buffer, 32768 ) ) {
$crc = Archive::Zip::computeCRC32( $buffer, $crc );
}
my $fileCrc = sprintf("%08x", $crc);
printf("$fileCrc");
print("\t$file") if ( $totalFiles > 1 );
if ( $file =~ /[^[:xdigit:]]([[:xdigit:]]{8})[^[:xdigit:]]/ ) {
my $filenameCrc = $1;
if ( lc($filenameCrc) eq lc($fileCrc) ) {
print("\tOK")
} else {
print("\tBAD $fileCrc != $filenameCrc");
}
}
print("\n");
}
__END__
:endofperl

View file

@ -0,0 +1,50 @@
#!perl
=head1 NAME
dbilogstrip - filter to normalize DBI trace logs for diff'ing
=head1 SYNOPSIS
Read DBI trace file C<dbitrace.log> and write out a stripped version to C<dbitrace_stripped.log>
dbilogstrip dbitrace.log > dbitrace_stripped.log
Run C<yourscript.pl> twice, each with different sets of arguments, with
DBI_TRACE enabled. Filter the output and trace through C<dbilogstrip> into a
separate file for each run. Then compare using diff. (This example assumes
you're using a standard shell.)
DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
diff -u dbitrace1.log dbitrace2.log
=head1 DESCRIPTION
Replaces any hex addresses, e.g, C<0x128f72ce> with C<0xN>.
Replaces any references to process id or thread id, like C<pid#6254> with C<pidN>.
So a DBI trace line like this:
-> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 'f_params' ARRAY(0x1922018)) thr#1800400
will look like this:
-> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN 'f_params' ARRAY(0xN)) thrN
=cut
use strict;
while (<>) {
# normalize hex addresses: 0xDEADHEAD => 0xN
s/ \b 0x [0-9a-f]+ /0xN/gx;
# normalize process and thread id number
s/ \b (pid|tid|thr) \W? \d+ /${1}N/gx;
} continue {
print or die "-p destination: $!\n";
}

View file

@ -0,0 +1,66 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
=head1 NAME
dbilogstrip - filter to normalize DBI trace logs for diff'ing
=head1 SYNOPSIS
Read DBI trace file C<dbitrace.log> and write out a stripped version to C<dbitrace_stripped.log>
dbilogstrip dbitrace.log > dbitrace_stripped.log
Run C<yourscript.pl> twice, each with different sets of arguments, with
DBI_TRACE enabled. Filter the output and trace through C<dbilogstrip> into a
separate file for each run. Then compare using diff. (This example assumes
you're using a standard shell.)
DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
diff -u dbitrace1.log dbitrace2.log
=head1 DESCRIPTION
Replaces any hex addresses, e.g, C<0x128f72ce> with C<0xN>.
Replaces any references to process id or thread id, like C<pid#6254> with C<pidN>.
So a DBI trace line like this:
-> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 'f_params' ARRAY(0x1922018)) thr#1800400
will look like this:
-> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN 'f_params' ARRAY(0xN)) thrN
=cut
use strict;
while (<>) {
# normalize hex addresses: 0xDEADHEAD => 0xN
s/ \b 0x [0-9a-f]+ /0xN/gx;
# normalize process and thread id number
s/ \b (pid|tid|thr) \W? \d+ /${1}N/gx;
} continue {
print or die "-p destination: $!\n";
}
__END__
:endofperl

263
msys/mingw/bin/dbiprof Normal file
View file

@ -0,0 +1,263 @@
#!perl
use strict;
my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
use Data::Dumper;
use DBI::ProfileData;
use Getopt::Long;
# default options
my $number = 10;
my $sort = 'total';
my $filename = 'dbi.prof';
my $reverse = 0;
my $case_sensitive = 0;
my (%match, %exclude);
# get options from command line
GetOptions(
'version' => sub { die "dbiprof $VERSION\n" },
'help' => sub { exit usage() },
'number=i' => \$number,
'sort=s' => \$sort,
'dumpnodes!' => \my $dumpnodes,
'reverse' => \$reverse,
'match=s' => \%match,
'exclude=s' => \%exclude,
'case-sensitive' => \$case_sensitive,
'delete!' => \my $opt_delete,
) or exit usage();
sub usage {
print <<EOS;
dbiprof [options] [files]
Reads and merges DBI profile data from files and prints a summary.
files: defaults to $filename
options:
-number=N show top N, defaults to $number
-sort=S sort by S, defaults to $sort
-reverse reverse the sort
-match=K=V for filtering, see docs
-exclude=K=V for filtering, see docs
-case_sensitive for -match and -exclude
-delete rename files before reading then delete afterwards
-version print version number and exit
-help print this help
EOS
return 1;
}
# list of files defaults to dbi.prof
my @files = @ARGV ? @ARGV : ('dbi.prof');
# instantiate ProfileData object
my $prof = eval {
DBI::ProfileData->new(
Files => \@files,
DeleteFiles => $opt_delete,
);
};
die "Unable to load profile data: $@\n" if $@;
if (%match) { # handle matches
while (my ($key, $val) = each %match) {
if ($val =~ m!^/(.+)/$!) {
$val = $case_sensitive ? qr/$1/ : qr/$1/i;
}
$prof->match($key, $val, case_sensitive => $case_sensitive);
}
}
if (%exclude) { # handle excludes
while (my ($key, $val) = each %exclude) {
if ($val =~ m!^/(.+)/$!) {
$val = $case_sensitive ? qr/$1/ : qr/$1/i;
}
$prof->exclude($key, $val, case_sensitive => $case_sensitive);
}
}
# sort the data
$prof->sort(field => $sort, reverse => $reverse);
# all done, print it out
if ($dumpnodes) {
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Useqq = 1;
$Data::Dumper::Deparse = 0;
print Dumper($prof->nodes);
}
else {
print $prof->report(number => $number);
}
exit 0;
__END__
=head1 NAME
dbiprof - command-line client for DBI::ProfileData
=head1 SYNOPSIS
See a report of the ten queries with the longest total runtime in the
profile dump file F<prof1.out>:
dbiprof prof1.out
See the top 10 most frequently run queries in the profile file
F<dbi.prof> (the default):
dbiprof --sort count
See the same report with 15 entries:
dbiprof --sort count --number 15
=head1 DESCRIPTION
This tool is a command-line client for the DBI::ProfileData. It
allows you to analyze the profile data file produced by
DBI::ProfileDumper and produce various useful reports.
=head1 OPTIONS
This program accepts the following options:
=over 4
=item --number N
Produce this many items in the report. Defaults to 10. If set to
"all" then all results are shown.
=item --sort field
Sort results by the given field. Sorting by multiple fields isn't currently
supported (patches welcome). The available sort fields are:
=over 4
=item total
Sorts by total time run time across all runs. This is the default
sort.
=item longest
Sorts by the longest single run.
=item count
Sorts by total number of runs.
=item first
Sorts by the time taken in the first run.
=item shortest
Sorts by the shortest single run.
=item key1
Sorts by the value of the first element in the Path, which should be numeric.
You can also sort by C<key2> and C<key3>.
=back
=item --reverse
Reverses the selected sort. For example, to see a report of the
shortest overall time:
dbiprof --sort total --reverse
=item --match keyN=value
Consider only items where the specified key matches the given value.
Keys are numbered from 1. For example, let's say you used a
DBI::Profile Path of:
[ DBIprofile_Statement, DBIprofile_Methodname ]
And called dbiprof as in:
dbiprof --match key2=execute
Your report would only show execute queries, leaving out prepares,
fetches, etc.
If the value given starts and ends with slashes (C</>) then it will be
treated as a regular expression. For example, to only include SELECT
queries where key1 is the statement:
dbiprof --match key1=/^SELECT/
By default the match expression is matched case-insensitively, but
this can be changed with the --case-sensitive option.
=item --exclude keyN=value
Remove items for where the specified key matches the given value. For
example, to exclude all prepare entries where key2 is the method name:
dbiprof --exclude key2=prepare
Like C<--match>, If the value given starts and ends with slashes
(C</>) then it will be treated as a regular expression. For example,
to exclude UPDATE queries where key1 is the statement:
dbiprof --match key1=/^UPDATE/
By default the exclude expression is matched case-insensitively, but
this can be changed with the --case-sensitive option.
=item --case-sensitive
Using this option causes --match and --exclude to work
case-sensitively. Defaults to off.
=item --delete
Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
files to be deleted after reading. See L<DBI::ProfileData> for more details.
=item --dumpnodes
Print the list of nodes in the form of a perl data structure.
Use the C<-sort> option if you want the list sorted.
=item --version
Print the dbiprof version number and exit.
=back
=head1 AUTHOR
Sam Tregar <sam@tregar.com>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2002 Sam Tregar
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.
=head1 SEE ALSO
L<DBI::ProfileDumper|DBI::ProfileDumper>,
L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
=cut

279
msys/mingw/bin/dbiprof.bat Normal file
View file

@ -0,0 +1,279 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
use strict;
my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
use Data::Dumper;
use DBI::ProfileData;
use Getopt::Long;
# default options
my $number = 10;
my $sort = 'total';
my $filename = 'dbi.prof';
my $reverse = 0;
my $case_sensitive = 0;
my (%match, %exclude);
# get options from command line
GetOptions(
'version' => sub { die "dbiprof $VERSION\n" },
'help' => sub { exit usage() },
'number=i' => \$number,
'sort=s' => \$sort,
'dumpnodes!' => \my $dumpnodes,
'reverse' => \$reverse,
'match=s' => \%match,
'exclude=s' => \%exclude,
'case-sensitive' => \$case_sensitive,
'delete!' => \my $opt_delete,
) or exit usage();
sub usage {
print <<EOS;
dbiprof [options] [files]
Reads and merges DBI profile data from files and prints a summary.
files: defaults to $filename
options:
-number=N show top N, defaults to $number
-sort=S sort by S, defaults to $sort
-reverse reverse the sort
-match=K=V for filtering, see docs
-exclude=K=V for filtering, see docs
-case_sensitive for -match and -exclude
-delete rename files before reading then delete afterwards
-version print version number and exit
-help print this help
EOS
return 1;
}
# list of files defaults to dbi.prof
my @files = @ARGV ? @ARGV : ('dbi.prof');
# instantiate ProfileData object
my $prof = eval {
DBI::ProfileData->new(
Files => \@files,
DeleteFiles => $opt_delete,
);
};
die "Unable to load profile data: $@\n" if $@;
if (%match) { # handle matches
while (my ($key, $val) = each %match) {
if ($val =~ m!^/(.+)/$!) {
$val = $case_sensitive ? qr/$1/ : qr/$1/i;
}
$prof->match($key, $val, case_sensitive => $case_sensitive);
}
}
if (%exclude) { # handle excludes
while (my ($key, $val) = each %exclude) {
if ($val =~ m!^/(.+)/$!) {
$val = $case_sensitive ? qr/$1/ : qr/$1/i;
}
$prof->exclude($key, $val, case_sensitive => $case_sensitive);
}
}
# sort the data
$prof->sort(field => $sort, reverse => $reverse);
# all done, print it out
if ($dumpnodes) {
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Useqq = 1;
$Data::Dumper::Deparse = 0;
print Dumper($prof->nodes);
}
else {
print $prof->report(number => $number);
}
exit 0;
__END__
=head1 NAME
dbiprof - command-line client for DBI::ProfileData
=head1 SYNOPSIS
See a report of the ten queries with the longest total runtime in the
profile dump file F<prof1.out>:
dbiprof prof1.out
See the top 10 most frequently run queries in the profile file
F<dbi.prof> (the default):
dbiprof --sort count
See the same report with 15 entries:
dbiprof --sort count --number 15
=head1 DESCRIPTION
This tool is a command-line client for the DBI::ProfileData. It
allows you to analyze the profile data file produced by
DBI::ProfileDumper and produce various useful reports.
=head1 OPTIONS
This program accepts the following options:
=over 4
=item --number N
Produce this many items in the report. Defaults to 10. If set to
"all" then all results are shown.
=item --sort field
Sort results by the given field. Sorting by multiple fields isn't currently
supported (patches welcome). The available sort fields are:
=over 4
=item total
Sorts by total time run time across all runs. This is the default
sort.
=item longest
Sorts by the longest single run.
=item count
Sorts by total number of runs.
=item first
Sorts by the time taken in the first run.
=item shortest
Sorts by the shortest single run.
=item key1
Sorts by the value of the first element in the Path, which should be numeric.
You can also sort by C<key2> and C<key3>.
=back
=item --reverse
Reverses the selected sort. For example, to see a report of the
shortest overall time:
dbiprof --sort total --reverse
=item --match keyN=value
Consider only items where the specified key matches the given value.
Keys are numbered from 1. For example, let's say you used a
DBI::Profile Path of:
[ DBIprofile_Statement, DBIprofile_Methodname ]
And called dbiprof as in:
dbiprof --match key2=execute
Your report would only show execute queries, leaving out prepares,
fetches, etc.
If the value given starts and ends with slashes (C</>) then it will be
treated as a regular expression. For example, to only include SELECT
queries where key1 is the statement:
dbiprof --match key1=/^SELECT/
By default the match expression is matched case-insensitively, but
this can be changed with the --case-sensitive option.
=item --exclude keyN=value
Remove items for where the specified key matches the given value. For
example, to exclude all prepare entries where key2 is the method name:
dbiprof --exclude key2=prepare
Like C<--match>, If the value given starts and ends with slashes
(C</>) then it will be treated as a regular expression. For example,
to exclude UPDATE queries where key1 is the statement:
dbiprof --match key1=/^UPDATE/
By default the exclude expression is matched case-insensitively, but
this can be changed with the --case-sensitive option.
=item --case-sensitive
Using this option causes --match and --exclude to work
case-sensitively. Defaults to off.
=item --delete
Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
files to be deleted after reading. See L<DBI::ProfileData> for more details.
=item --dumpnodes
Print the list of nodes in the form of a perl data structure.
Use the C<-sort> option if you want the list sorted.
=item --version
Print the dbiprof version number and exit.
=back
=head1 AUTHOR
Sam Tregar <sam@tregar.com>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2002 Sam Tregar
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.
=head1 SEE ALSO
L<DBI::ProfileDumper|DBI::ProfileDumper>,
L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
=cut
__END__
:endofperl

184
msys/mingw/bin/dbiproxy Normal file
View file

@ -0,0 +1,184 @@
#!perl
use strict;
my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
require DBI::ProxyServer;
# XXX these should probably be moved into DBI::ProxyServer
delete $ENV{IFS};
delete $ENV{CDPATH};
delete $ENV{ENV};
delete $ENV{BASH_ENV};
if ($arg_test) {
require RPC::PlServer::Test;
@DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
}
DBI::ProxyServer::main(@ARGV);
exit(0);
__END__
=head1 NAME
dbiproxy - A proxy server for the DBD::Proxy driver
=head1 SYNOPSIS
dbiproxy <options> --localport=<port>
=head1 DESCRIPTION
This tool is just a front end for the DBI::ProxyServer package. All it
does is picking options from the command line and calling
DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
Available options include:
=over 4
=item B<--chroot=dir>
(UNIX only) After doing a bind(), change root directory to the given
directory by doing a chroot(). This is useful for security, but it
restricts the environment a lot. For example, you need to load DBI
drivers in the config file or you have to create hard links to Unix
sockets, if your drivers are using them. For example, with MySQL, a
config file might contain the following lines:
my $rootdir = '/var/dbiproxy';
my $unixsockdir = '/tmp';
my $unixsockfile = 'mysql.sock';
foreach $dir ($rootdir, "$rootdir$unixsockdir") {
mkdir 0755, $dir;
}
link("$unixsockdir/$unixsockfile",
"$rootdir$unixsockdir/$unixsockfile");
require DBD::mysql;
{
'chroot' => $rootdir,
...
}
If you don't know chroot(), think of an FTP server where you can see a
certain directory tree only after logging in. See also the --group and
--user options.
=item B<--configfile=file>
Config files are assumed to return a single hash ref that overrides the
arguments of the new method. However, command line arguments in turn take
precedence over the config file. See the "CONFIGURATION FILE" section
in the L<DBI::ProxyServer> documentation for details on the config file.
=item B<--debug>
Turn debugging mode on. Mainly this asserts that logging messages of
level "debug" are created.
=item B<--facility=mode>
(UNIX only) Facility to use for L<Sys::Syslog>. The default is
B<daemon>.
=item B<--group=gid>
After doing a bind(), change the real and effective GID to the given.
This is useful, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --user option.
GID's can be passed as group names or numeric values.
=item B<--localaddr=ip>
By default a daemon is listening to any IP number that a machine
has. This attribute allows one to restrict the server to the given
IP number.
=item B<--localport=port>
This attribute sets the port on which the daemon is listening. It
must be given somehow, as there's no default.
=item B<--logfile=file>
Be default logging messages will be written to the syslog (Unix) or
to the event log (Windows NT). On other operating systems you need to
specify a log file. The special value "STDERR" forces logging to
stderr. See L<Net::Daemon::Log> for details.
=item B<--mode=modename>
The server can run in three different modes, depending on the environment.
If you are running Perl 5.005 and did compile it for threads, then the
server will create a new thread for each connection. The thread will
execute the server's Run() method and then terminate. This mode is the
default, you can force it with "--mode=threads".
If threads are not available, but you have a working fork(), then the
server will behave similar by creating a new process for each connection.
This mode will be used automatically in the absence of threads or if
you use the "--mode=fork" option.
Finally there's a single-connection mode: If the server has accepted a
connection, he will enter the Run() method. No other connections are
accepted until the Run() method returns (if the client disconnects).
This operation mode is useful if you have neither threads nor fork(),
for example on the Macintosh. For debugging purposes you can force this
mode with "--mode=single".
=item B<--pidfile=file>
(UNIX only) If this option is present, a PID file will be created at the
given location. Default is to not create a pidfile.
=item B<--user=uid>
After doing a bind(), change the real and effective UID to the given.
This is useful, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --group and the --chroot options.
UID's can be passed as group names or numeric values.
=item B<--version>
Suppresses startup of the server; instead the version string will
be printed and the program exits immediately.
=back
=head1 AUTHOR
Copyright (c) 1997 Jochen Wiedmann
Am Eisteich 9
72555 Metzingen
Germany
Email: joe@ispsoft.de
Phone: +49 7123 14881
The DBI::ProxyServer module is free software; you can redistribute it
and/or modify it under the same terms as Perl itself. In particular
permission is granted to Tim Bunce for distributing this as a part of
the DBI.
=head1 SEE ALSO
L<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
=cut

200
msys/mingw/bin/dbiproxy.bat Normal file
View file

@ -0,0 +1,200 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
use strict;
my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
require DBI::ProxyServer;
# XXX these should probably be moved into DBI::ProxyServer
delete $ENV{IFS};
delete $ENV{CDPATH};
delete $ENV{ENV};
delete $ENV{BASH_ENV};
if ($arg_test) {
require RPC::PlServer::Test;
@DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
}
DBI::ProxyServer::main(@ARGV);
exit(0);
__END__
=head1 NAME
dbiproxy - A proxy server for the DBD::Proxy driver
=head1 SYNOPSIS
dbiproxy <options> --localport=<port>
=head1 DESCRIPTION
This tool is just a front end for the DBI::ProxyServer package. All it
does is picking options from the command line and calling
DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
Available options include:
=over 4
=item B<--chroot=dir>
(UNIX only) After doing a bind(), change root directory to the given
directory by doing a chroot(). This is useful for security, but it
restricts the environment a lot. For example, you need to load DBI
drivers in the config file or you have to create hard links to Unix
sockets, if your drivers are using them. For example, with MySQL, a
config file might contain the following lines:
my $rootdir = '/var/dbiproxy';
my $unixsockdir = '/tmp';
my $unixsockfile = 'mysql.sock';
foreach $dir ($rootdir, "$rootdir$unixsockdir") {
mkdir 0755, $dir;
}
link("$unixsockdir/$unixsockfile",
"$rootdir$unixsockdir/$unixsockfile");
require DBD::mysql;
{
'chroot' => $rootdir,
...
}
If you don't know chroot(), think of an FTP server where you can see a
certain directory tree only after logging in. See also the --group and
--user options.
=item B<--configfile=file>
Config files are assumed to return a single hash ref that overrides the
arguments of the new method. However, command line arguments in turn take
precedence over the config file. See the "CONFIGURATION FILE" section
in the L<DBI::ProxyServer> documentation for details on the config file.
=item B<--debug>
Turn debugging mode on. Mainly this asserts that logging messages of
level "debug" are created.
=item B<--facility=mode>
(UNIX only) Facility to use for L<Sys::Syslog>. The default is
B<daemon>.
=item B<--group=gid>
After doing a bind(), change the real and effective GID to the given.
This is useful, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --user option.
GID's can be passed as group names or numeric values.
=item B<--localaddr=ip>
By default a daemon is listening to any IP number that a machine
has. This attribute allows one to restrict the server to the given
IP number.
=item B<--localport=port>
This attribute sets the port on which the daemon is listening. It
must be given somehow, as there's no default.
=item B<--logfile=file>
Be default logging messages will be written to the syslog (Unix) or
to the event log (Windows NT). On other operating systems you need to
specify a log file. The special value "STDERR" forces logging to
stderr. See L<Net::Daemon::Log> for details.
=item B<--mode=modename>
The server can run in three different modes, depending on the environment.
If you are running Perl 5.005 and did compile it for threads, then the
server will create a new thread for each connection. The thread will
execute the server's Run() method and then terminate. This mode is the
default, you can force it with "--mode=threads".
If threads are not available, but you have a working fork(), then the
server will behave similar by creating a new process for each connection.
This mode will be used automatically in the absence of threads or if
you use the "--mode=fork" option.
Finally there's a single-connection mode: If the server has accepted a
connection, he will enter the Run() method. No other connections are
accepted until the Run() method returns (if the client disconnects).
This operation mode is useful if you have neither threads nor fork(),
for example on the Macintosh. For debugging purposes you can force this
mode with "--mode=single".
=item B<--pidfile=file>
(UNIX only) If this option is present, a PID file will be created at the
given location. Default is to not create a pidfile.
=item B<--user=uid>
After doing a bind(), change the real and effective UID to the given.
This is useful, if you want your server to bind to a privileged port
(<1024), but don't want the server to execute as root. See also
the --group and the --chroot options.
UID's can be passed as group names or numeric values.
=item B<--version>
Suppresses startup of the server; instead the version string will
be printed and the program exits immediately.
=back
=head1 AUTHOR
Copyright (c) 1997 Jochen Wiedmann
Am Eisteich 9
72555 Metzingen
Germany
Email: joe@ispsoft.de
Phone: +49 7123 14881
The DBI::ProxyServer module is free software; you can redistribute it
and/or modify it under the same terms as Perl itself. In particular
permission is granted to Tim Bunce for distributing this as a part of
the DBI.
=head1 SEE ALSO
L<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
=cut
__END__
:endofperl

BIN
msys/mingw/bin/dmake.exe Normal file

Binary file not shown.

1486
msys/mingw/bin/enc2xs.bat Normal file

File diff suppressed because it is too large Load diff

164
msys/mingw/bin/encguess.bat Normal file
View file

@ -0,0 +1,164 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!./perl
use 5.008001;
use strict;
use warnings;
use Encode;
use Getopt::Std;
use Carp;
use Encode::Guess;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my %opt;
getopts( "huSs:", \%opt );
my @suspect_list;
list_valid_suspects() and exit if $opt{S};
@suspect_list = split /:,/, $opt{s} if $opt{s};
HELP_MESSAGE() if $opt{h};
HELP_MESSAGE() unless @ARGV;
do_guess($_) for @ARGV;
sub read_file {
my $filename = shift;
local $/;
open my $fh, '<:raw', $filename or croak "$filename:$!";
my $content = <$fh>;
close $fh;
return $content;
}
sub do_guess {
my $filename = shift;
my $data = read_file($filename);
my $enc = guess_encoding( $data, @suspect_list );
if ( !ref($enc) && $opt{u} ) {
return 1;
}
print "$filename\t";
if ( ref($enc) ) {
print $enc->mime_name();
}
else {
print "unknown";
}
print "\n";
return 1;
}
sub list_valid_suspects {
print join( "\n", Encode->encodings(":all") );
print "\n";
return 1;
}
sub HELP_MESSAGE {
exec 'pod2usage', $0 or die "pod2usage: $!"
}
__END__
=head1 NAME
encguess - guess character encodings of files
=head1 VERSION
$Id: encguess,v 0.1 2015/02/05 10:34:19 dankogai Exp $
=head1 SYNOPSIS
encguess [switches] filename...
=head2 SWITCHES
=over 2
=item -h
show this message and exit.
=item -s
specify a list of "suspect encoding types" to test,
seperated by either C<:> or C<,>
=item -S
output a list of all acceptable encoding types that can be used with
the -s param
=item -u
suppress display of unidentified types
=back
=head2 EXAMPLES:
=over 2
=item *
Guess encoding of a file named C<test.txt>, using only the default
suspect types.
encguess test.txt
=item *
Guess the encoding type of a file named C<test.txt>, using the suspect
types C<euc-jp,shiftjis,7bit-jis>.
encguess -s euc-jp,shiftjis,7bit-jis test.txt
encguess -s euc-jp:shiftjis:7bit-jis test.txt
=item *
Guess the encoding type of several files, do not display results for
unidentified files.
encguess -us euc-jp,shiftjis,7bit-jis test*.txt
=back
=head1 DESCRIPTION
The encoding identification is done by checking one encoding type at a
time until all but the right type are eliminated. The set of encoding
types to try is defined by the -s parameter and defaults to ascii,
utf8 and UTF-16/32 with BOM. This can be overridden by passing one or
more encoding types via the -s parameter. If you need to pass in
multiple suspect encoding types, use a quoted string with the a space
separating each value.
=head1 SEE ALSO
L<Encode::Guess>, L<Encode::Detect>
=head1 LICENSE AND COPYRIGHT
Copyright 2015 Michael LaGrasta and Dan Kogai.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:
L<http://www.perlfoundation.org/artistic_license_2_0>
=cut
__END__
:endofperl

124
msys/mingw/bin/exetype.bat Normal file
View file

@ -0,0 +1,124 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl -w
#line 15
use strict;
# All the IMAGE_* structures are defined in the WINNT.H file
# of the Microsoft Platform SDK.
my %subsys = (NATIVE => 1,
WINDOWS => 2,
CONSOLE => 3,
POSIX => 7,
WINDOWSCE => 9);
unless (0 < @ARGV && @ARGV < 3) {
printf "Usage: $0 exefile [%s]\n", join '|', sort keys %subsys;
exit;
}
$ARGV[1] = uc $ARGV[1] if $ARGV[1];
unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) {
(my $subsys = join(', ', sort keys %subsys)) =~ s/, (\w+)$/ or $1/;
print "Invalid subsystem $ARGV[1], please use $subsys\n";
exit;
}
my ($record,$magic,$signature,$offset,$size);
open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n";
binmode EXE;
# read IMAGE_DOS_HEADER structure
read EXE, $record, 64;
($magic,$offset) = unpack "Sx58L", $record;
die "$ARGV[0] is not an MSDOS executable file.\n"
unless $magic == 0x5a4d; # "MZ"
# read signature, IMAGE_FILE_HEADER and first WORD of IMAGE_OPTIONAL_HEADER
seek EXE, $offset, 0;
read EXE, $record, 4+20+2;
($signature,$size,$magic) = unpack "Lx16Sx2S", $record;
die "PE header not found" unless $signature == 0x4550; # "PE\0\0"
die "Optional header is neither in NT32 nor in NT64 format"
unless ($size == 224 && $magic == 0x10b) || # IMAGE_NT_OPTIONAL_HDR32_MAGIC
($size == 240 && $magic == 0x20b); # IMAGE_NT_OPTIONAL_HDR64_MAGIC
# Offset 68 in the IMAGE_OPTIONAL_HEADER(32|64) is the 16 bit subsystem code
seek EXE, $offset+4+20+68, 0;
if (@ARGV == 1) {
read EXE, $record, 2;
my ($subsys) = unpack "S", $record;
$subsys = {reverse %subsys}->{$subsys} || "UNKNOWN($subsys)";
print "$ARGV[0] uses the $subsys subsystem.\n";
}
else {
print EXE pack "S", $subsys{$ARGV[1]};
}
close EXE;
__END__
=head1 NAME
exetype - Change executable subsystem type between "Console" and "Windows"
=head1 SYNOPSIS
C:\perl\bin> copy perl.exe guiperl.exe
C:\perl\bin> exetype guiperl.exe windows
=head1 DESCRIPTION
This program edits an executable file to indicate which subsystem the
operating system must invoke for execution.
You can specify any of the following subsystems:
=over
=item CONSOLE
The CONSOLE subsystem handles a Win32 character-mode application that
use a console supplied by the operating system.
=item WINDOWS
The WINDOWS subsystem handles an application that does not require a
console and creates its own windows, if required.
=item NATIVE
The NATIVE subsystem handles a Windows NT device driver.
=item WINDOWSCE
The WINDOWSCE subsystem handles Windows CE consumer electronics
applications.
=item POSIX
The POSIX subsystem handles a POSIX application in Windows NT.
=back
=head1 AUTHOR
Jan Dubois <jand@activestate.com>
=cut
__END__
:endofperl

138
msys/mingw/bin/findrule Normal file
View file

@ -0,0 +1,138 @@
#!perl -w
use strict;
use File::Find::Rule;
use File::Spec::Functions qw(catdir);
# bootstrap extensions
for (@INC) {
my $dir = catdir($_, qw( File Find Rule ) );
next unless -d $dir;
my @pm = find( name => '*.pm', maxdepth => 1,
exec => sub { (my $name = $_) =~ s/\.pm$//;
eval "require File::Find::Rule::$name"; },
in => $dir );
}
# what directories are we searching in?
my @where;
while (@ARGV) {
local $_ = shift @ARGV;
if (/^-/) {
unshift @ARGV, $_;
last;
}
push @where, $_;
}
# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {
my $clause = shift @ARGV;
unless ( $clause =~ s/^-// && $rule->can( $clause ) ) {
# not a known rule - complain about this
die "unknown option '$clause'\n"
}
# it was the last switch
unless (@ARGV) {
$rule->$clause();
next;
}
# consume the parameters
my $param = shift @ARGV;
if ($param =~ /^-/) {
# it's the next switch - put it back, and add one with no params
unshift @ARGV, $param;
$rule->$clause();
next;
}
if ($param eq '(') {
# multiple values - just look for the closing parenthesis
my @p;
while (@ARGV) {
my $val = shift @ARGV;
last if $val eq ')';
push @p, $val;
}
$rule->$clause( @p );
next;
}
# a single argument
$rule->$clause( $param );
}
# add a print rule so things happen faster
$rule->exec( sub { print "$_[2]\n"; return; } );
# profit
$rule->in( @where ? @where : '.' );
exit 0;
__END__
=head1 NAME
findrule - command line wrapper to File::Find::Rule
=head1 USAGE
findrule [path...] [expression]
=head1 DESCRIPTION
C<findrule> mostly borrows the interface from GNU find(1) to provide a
command-line interface onto the File::Find::Rule heirarchy of modules.
The syntax for expressions is the rule name, preceded by a dash,
followed by an optional argument. If the argument is an opening
parenthesis it is taken as a list of arguments, terminated by a
closing parenthesis.
Some examples:
find -file -name ( foo bar )
files named C<foo> or C<bar>, below the current directory.
find -file -name foo -bar
files named C<foo>, that have pubs (for this is what our ficticious
C<bar> clause specifies), below the current directory.
find -file -name ( -bar )
files named C<-bar>, below the current directory. In this case if
we'd have omitted the parenthesis it would have parsed as a call to
name with no arguments, followed by a call to -bar.
=head2 Supported switches
I'm very slack. Please consult the File::Find::Rule manpage for now,
and prepend - to the commands that you want.
=head2 Extra bonus switches
findrule automatically loads all of your installed File::Find::Rule::*
extension modules, so check the documentation to see what those would be.
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net> from a suggestion by Tatsuhiko Miyagawa
=head1 COPYRIGHT
Copyright (C) 2002 Richard Clamp. All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find::Rule>
=cut

154
msys/mingw/bin/findrule.bat Normal file
View file

@ -0,0 +1,154 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl -w
#line 15
use strict;
use File::Find::Rule;
use File::Spec::Functions qw(catdir);
# bootstrap extensions
for (@INC) {
my $dir = catdir($_, qw( File Find Rule ) );
next unless -d $dir;
my @pm = find( name => '*.pm', maxdepth => 1,
exec => sub { (my $name = $_) =~ s/\.pm$//;
eval "require File::Find::Rule::$name"; },
in => $dir );
}
# what directories are we searching in?
my @where;
while (@ARGV) {
local $_ = shift @ARGV;
if (/^-/) {
unshift @ARGV, $_;
last;
}
push @where, $_;
}
# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {
my $clause = shift @ARGV;
unless ( $clause =~ s/^-// && $rule->can( $clause ) ) {
# not a known rule - complain about this
die "unknown option '$clause'\n"
}
# it was the last switch
unless (@ARGV) {
$rule->$clause();
next;
}
# consume the parameters
my $param = shift @ARGV;
if ($param =~ /^-/) {
# it's the next switch - put it back, and add one with no params
unshift @ARGV, $param;
$rule->$clause();
next;
}
if ($param eq '(') {
# multiple values - just look for the closing parenthesis
my @p;
while (@ARGV) {
my $val = shift @ARGV;
last if $val eq ')';
push @p, $val;
}
$rule->$clause( @p );
next;
}
# a single argument
$rule->$clause( $param );
}
# add a print rule so things happen faster
$rule->exec( sub { print "$_[2]\n"; return; } );
# profit
$rule->in( @where ? @where : '.' );
exit 0;
__END__
=head1 NAME
findrule - command line wrapper to File::Find::Rule
=head1 USAGE
findrule [path...] [expression]
=head1 DESCRIPTION
C<findrule> mostly borrows the interface from GNU find(1) to provide a
command-line interface onto the File::Find::Rule heirarchy of modules.
The syntax for expressions is the rule name, preceded by a dash,
followed by an optional argument. If the argument is an opening
parenthesis it is taken as a list of arguments, terminated by a
closing parenthesis.
Some examples:
find -file -name ( foo bar )
files named C<foo> or C<bar>, below the current directory.
find -file -name foo -bar
files named C<foo>, that have pubs (for this is what our ficticious
C<bar> clause specifies), below the current directory.
find -file -name ( -bar )
files named C<-bar>, below the current directory. In this case if
we'd have omitted the parenthesis it would have parsed as a call to
name with no arguments, followed by a call to -bar.
=head2 Supported switches
I'm very slack. Please consult the File::Find::Rule manpage for now,
and prepend - to the commands that you want.
=head2 Extra bonus switches
findrule automatically loads all of your installed File::Find::Rule::*
extension modules, so check the documentation to see what those would be.
=head1 AUTHOR
Richard Clamp <richardc@unixbeard.net> from a suggestion by Tatsuhiko Miyagawa
=head1 COPYRIGHT
Copyright (C) 2002 Richard Clamp. All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 SEE ALSO
L<File::Find::Rule>
=cut
__END__
:endofperl

1002
msys/mingw/bin/h2ph.bat Normal file

File diff suppressed because it is too large Load diff

2221
msys/mingw/bin/h2xs.bat Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,211 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl -w
use strict;
use IO::File;
use ExtUtils::Packlist;
use ExtUtils::Installed;
use vars qw($Inst @Modules);
=head1 NAME
instmodsh - A shell to examine installed modules
=head1 SYNOPSIS
instmodsh
=head1 DESCRIPTION
A little interface to ExtUtils::Installed to examine installed modules,
validate your packlists and even create a tarball from an installed module.
=head1 SEE ALSO
ExtUtils::Installed
=cut
my $Module_Help = <<EOF;
Available commands are:
f [all|prog|doc] - List installed files of a given type
d [all|prog|doc] - List the directories used by a module
v - Validate the .packlist - check for missing files
t <tarfile> - Create a tar archive of the module
h - Display module help
q - Quit the module
EOF
my %Module_Commands = (
f => \&list_installed,
d => \&list_directories,
v => \&validate_packlist,
t => \&create_archive,
h => \&module_help,
);
sub do_module($) {
my ($module) = @_;
print($Module_Help);
MODULE_CMD: while (1) {
print("$module cmd? ");
my $reply = <STDIN>; chomp($reply);
my($cmd) = $reply =~ /^(\w)\b/;
last if $cmd eq 'q';
if( $Module_Commands{$cmd} ) {
$Module_Commands{$cmd}->($reply, $module);
}
elsif( $cmd eq 'q' ) {
last MODULE_CMD;
}
else {
module_help();
}
}
}
sub list_installed {
my($reply, $module) = @_;
my $class = (split(' ', $reply))[1];
$class = 'all' unless $class;
my @files;
if (eval { @files = $Inst->files($module, $class); }) {
print("$class files in $module are:\n ",
join("\n ", @files), "\n");
}
else {
print($@);
}
};
sub list_directories {
my($reply, $module) = @_;
my $class = (split(' ', $reply))[1];
$class = 'all' unless $class;
my @dirs;
if (eval { @dirs = $Inst->directories($module, $class); }) {
print("$class directories in $module are:\n ",
join("\n ", @dirs), "\n");
}
else {
print($@);
}
}
sub create_archive {
my($reply, $module) = @_;
my $file = (split(' ', $reply))[1];
if( !(defined $file and length $file) ) {
print "No tar file specified\n";
}
elsif( eval { require Archive::Tar } ) {
Archive::Tar->create_archive($file, 0, $Inst->files($module));
}
else {
my($first, @rest) = $Inst->files($module);
system('tar', 'cvf', $file, $first);
for my $f (@rest) {
system('tar', 'rvf', $file, $f);
}
print "Can't use tar\n" if $?;
}
}
sub validate_packlist {
my($reply, $module) = @_;
if (my @missing = $Inst->validate($module)) {
print("Files missing from $module are:\n ",
join("\n ", @missing), "\n");
}
else {
print("$module has no missing files\n");
}
}
sub module_help {
print $Module_Help;
}
##############################################################################
sub toplevel()
{
my $help = <<EOF;
Available commands are:
l - List all installed modules
m <module> - Select a module
q - Quit the program
EOF
print($help);
while (1)
{
print("cmd? ");
my $reply = <STDIN>; chomp($reply);
CASE:
{
$reply eq 'l' and do
{
print("Installed modules are:\n ", join("\n ", @Modules), "\n");
last CASE;
};
$reply =~ /^m\s+/ and do
{
do_module((split(' ', $reply))[1]);
last CASE;
};
$reply eq 'q' and do
{
exit(0);
};
# Default
print($help);
}
}
}
###############################################################################
$Inst = ExtUtils::Installed->new();
@Modules = $Inst->modules();
toplevel();
###############################################################################
__END__
:endofperl

224
msys/mingw/bin/json_pp.bat Normal file
View file

@ -0,0 +1,224 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
use strict;
use Getopt::Long;
use JSON::PP ();
my $VERSION = '1.00';
# imported from JSON-XS/bin/json_xs
my %allow_json_opt = map { $_ => 1 } qw(
ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref
allow_singlequote allow_barekey allow_bignum loose escape_slash
);
GetOptions(
'v' => \( my $opt_verbose ),
'f=s' => \( my $opt_from = 'json' ),
't=s' => \( my $opt_to = 'json' ),
'json_opt=s' => \( my $json_opt = 'pretty' ),
'V' => \( my $version ),
) or die "Usage: $0 [-v] -f from_format [-t to_format]\n";
if ( $version ) {
print "$VERSION\n";
exit;
}
$json_opt = '' if $json_opt eq '-';
my @json_opt = grep { $allow_json_opt{ $_ } or die "'$_' is invalid json opttion" } split/,/, $json_opt;
my %F = (
'json' => sub {
my $json = JSON::PP->new;
$json->$_() for @json_opt;
$json->decode( $_ );
},
'eval' => sub {
my $v = eval "no strict;\n#line 1 \"input\"\n$_";
die "$@" if $@;
return $v;
},
);
my %T = (
'null' => sub { "" },
'json' => sub {
my $json = JSON::PP->new;
$json->$_() for @json_opt;
$json->encode( $_ );
},
'dumper' => sub {
require Data::Dumper;
Data::Dumper::Dumper($_)
},
);
$F{$opt_from}
or die "$opt_from: not a valid fromformat\n";
$T{$opt_to}
or die "$opt_from: not a valid toformat\n";
local $/;
$_ = <STDIN>;
$_ = $F{$opt_from}->();
$_ = $T{$opt_to}->();
print $_;
__END__
=pod
=encoding utf8
=head1 NAME
json_pp - JSON::PP command utility
=head1 SYNOPSIS
json_pp [-v] [-f from_format] [-t to_format] [-json_opt options_to_json]
=head1 DESCRIPTION
json_pp converts between some input and output formats (one of them is JSON).
This program was copied from L<json_xs> and modified.
The default input format is json and the default output format is json with pretty option.
=head1 OPTIONS
=head2 -f
-f from_format
Reads a data in the given format from STDIN.
Format types:
=over
=item json
as JSON
=item eval
as Perl code
=back
=head2 -t
Writes a data in the given format to STDOUT.
=over
=item null
no action.
=item json
as JSON
=item dumper
as Data::Dumper
=back
=head2 -json_opt
options to JSON::PP
Acceptable options are:
ascii latin1 utf8 pretty indent space_before space_after relaxed canonical allow_nonref
allow_singlequote allow_barekey allow_bignum loose escape_slash
=head2 -v
Verbose option, but currently no action in fact.
=head2 -V
Prints version and exits.
=head1 EXAMPLES
$ perl -e'print q|{"foo":"あい","bar":1234567890000000000000000}|' |\
json_pp -f json -t dumper -json_opt pretty,utf8,allow_bignum
$VAR1 = {
'bar' => bless( {
'value' => [
'0000000',
'0000000',
'5678900',
'1234'
],
'sign' => '+'
}, 'Math::BigInt' ),
'foo' => "\x{3042}\x{3044}"
};
$ perl -e'print q|{"foo":"あい","bar":1234567890000000000000000}|' |\
json_pp -f json -t dumper -json_opt pretty
$VAR1 = {
'bar' => '1234567890000000000000000',
'foo' => "\x{e3}\x{81}\x{82}\x{e3}\x{81}\x{84}"
};
=head1 SEE ALSO
L<JSON::PP>, L<json_xs>
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2010 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__END__
:endofperl

View file

@ -0,0 +1,737 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
=head1 NAME
libnetcfg - configure libnet
=head1 DESCRIPTION
The libnetcfg utility can be used to configure the libnet.
Starting from perl 5.8 libnet is part of the standard Perl
distribution, but the libnetcfg can be used for any libnet
installation.
=head1 USAGE
Without arguments libnetcfg displays the current configuration.
$ libnetcfg
# old config ./libnet.cfg
daytime_hosts ntp1.none.such
ftp_int_passive 0
ftp_testhost ftp.funet.fi
inet_domain none.such
nntp_hosts nntp.none.such
ph_hosts
pop3_hosts pop.none.such
smtp_hosts smtp.none.such
snpp_hosts
test_exist 1
test_hosts 1
time_hosts ntp.none.such
# libnetcfg -h for help
$
It tells where the old configuration file was found (if found).
The C<-h> option will show a usage message.
To change the configuration you will need to use either the C<-c> or
the C<-d> options.
The default name of the old configuration file is by default
"libnet.cfg", unless otherwise specified using the -i option,
C<-i oldfile>, and it is searched first from the current directory,
and then from your module path.
The default name of the new configuration file is "libnet.cfg", and by
default it is written to the current directory, unless otherwise
specified using the -o option, C<-o newfile>.
=head1 SEE ALSO
L<Net::Config>, L<libnetFAQ>
=head1 AUTHORS
Graham Barr, the original Configure script of libnet.
Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.
=cut
# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
use strict;
use IO::File;
use Getopt::Std;
use ExtUtils::MakeMaker qw(prompt);
use File::Spec;
use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);
##
##
##
my %cfg = ();
my @cfg = ();
my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);
##
##
##
sub valid_host
{
my $h = shift;
defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
}
##
##
##
sub test_hostnames (\@)
{
my $hlist = shift;
my @h = ();
my $host;
my $err = 0;
foreach $host (@$hlist)
{
if(valid_host($host))
{
push(@h, $host);
next;
}
warn "Bad hostname: '$host'\n";
$err++;
}
@$hlist = @h;
$err ? join(" ",@h) : undef;
}
##
##
##
sub Prompt
{
my($prompt,$def) = @_;
$def = "" unless defined $def;
chomp($prompt);
if($opt_d)
{
print $prompt,," [",$def,"]\n";
return $def;
}
prompt($prompt,$def);
}
##
##
##
sub get_host_list
{
my($prompt,$def) = @_;
$def = join(" ",@$def) if ref($def);
my @hosts;
do
{
my $ans = Prompt($prompt,$def);
$ans =~ s/(\A\s+|\s+\Z)//g;
@hosts = split(/\s+/, $ans);
}
while(@hosts && defined($def = test_hostnames(@hosts)));
\@hosts;
}
##
##
##
sub get_hostname
{
my($prompt,$def) = @_;
my $host;
while(1)
{
my $ans = Prompt($prompt,$def);
$host = ($ans =~ /(\S*)/)[0];
last
if(!length($host) || valid_host($host));
$def =""
if $def eq $host;
print <<"EDQ";
*** ERROR:
Hostname '$host' does not seem to exist, please enter again
or a single space to clear any default
EDQ
}
length $host
? $host
: undef;
}
##
##
##
sub get_bool ($$)
{
my($prompt,$def) = @_;
chomp($prompt);
my $val = Prompt($prompt,$def ? "yes" : "no");
$val =~ /^y/i ? 1 : 0;
}
##
##
##
sub get_netmask ($$)
{
my($prompt,$def) = @_;
chomp($prompt);
my %list;
@list{@$def} = ();
MASK:
while(1) {
my $bad = 0;
my $ans = Prompt($prompt) or last;
if($ans eq '*') {
%list = ();
next;
}
if($ans eq '=') {
print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
next;
}
unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
warn "Bad netmask '$ans'\n";
next;
}
my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
warn "Bad netmask '$ans'\n";
next MASK;
}
foreach my $byte (@ip) {
if ( $byte > 255 ) {
warn "Bad netmask '$ans'\n";
next MASK;
}
}
my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits);
if ($remove) {
delete $list{$mask};
}
else {
$list{$mask} = 1;
}
}
[ keys %list ];
}
##
##
##
sub default_hostname
{
my $host;
my @host;
foreach $host (@_)
{
if(defined($host) && valid_host($host))
{
return $host
unless wantarray;
push(@host,$host);
}
}
return wantarray ? @host : undef;
}
##
##
##
getopts('dcho:i:');
$libnet_cfg_in = "libnet.cfg"
unless(defined($libnet_cfg_in = $opt_i));
$libnet_cfg_out = "libnet.cfg"
unless(defined($libnet_cfg_out = $opt_o));
my %oldcfg = ();
$Net::Config::CONFIGURE = 1; # Suppress load of user overrides
if( -f $libnet_cfg_in )
{
%oldcfg = ( %{ do $libnet_cfg_in } );
}
elsif (eval { require Net::Config })
{
$have_old = 1;
%oldcfg = %Net::Config::NetConfig;
}
map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
#---------------------------------------------------------------------------
if ($opt_h) {
print <<EOU;
$0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h]
Without options, the old configuration is shown.
-c change the configuration
-d use defaults from the old config (implies -c, non-interactive)
-i use a specific file as the old config file
-o use a specific file as the new config file
-h show this help
The default name of the old configuration file is by default
"libnet.cfg", unless otherwise specified using the -i option,
C<-i oldfile>, and it is searched first from the current directory,
and then from your module path.
The default name of the new configuration file is "libnet.cfg", and by
default it is written to the current directory, unless otherwise
specified using the -o option.
EOU
exit(0);
}
#---------------------------------------------------------------------------
{
my $oldcfgfile;
my @inc;
push @inc, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
push @inc, $ENV{PERLLIB} if exists $ENV{PERLLIB};
push @inc, @INC;
for (@inc) {
my $trycfgfile = File::Spec->catfile($_, $libnet_cfg_in);
if (-f $trycfgfile && -r $trycfgfile) {
$oldcfgfile = $trycfgfile;
last;
}
}
print "# old config $oldcfgfile\n" if defined $oldcfgfile;
for (sort keys %oldcfg) {
printf "%-20s %s\n", $_,
ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
}
unless ($opt_c || $opt_d) {
print "# $0 -h for help\n";
exit(0);
}
}
#---------------------------------------------------------------------------
$oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
$oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
#---------------------------------------------------------------------------
if($have_old && !$opt_d)
{
$msg = <<EDQ;
Ah, I see you already have installed libnet before.
Do you want to modify/update your configuration (y|n) ?
EDQ
$opt_d = 1
unless get_bool($msg,0);
}
#---------------------------------------------------------------------------
$msg = <<EDQ;
This script will prompt you to enter hostnames that can be used as
defaults for some of the modules in the libnet distribution.
To ensure that you do not enter an invalid hostname, I can perform a
lookup on each hostname you enter. If your internet connection is via
a dialup line then you may not want me to perform these lookups, as
it will require you to be on-line.
Do you want me to perform hostname lookups (y|n) ?
EDQ
$cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
print <<EDQ unless $cfg{'test_exist'};
*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
OK I will not check if the hostnames you give are valid
so be very cafeful
*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
EDQ
#---------------------------------------------------------------------------
print <<EDQ;
The following questions all require a list of host names, separated
with spaces. If you do not have a host available for any of the
services, then enter a single space, followed by <CR>. To accept the
default, hit <CR>
EDQ
$msg = 'Enter a list of available NNTP hosts :';
$def = $oldcfg{'nntp_hosts'} ||
[ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
$cfg{'nntp_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available SMTP hosts :';
$def = $oldcfg{'smtp_hosts'} ||
[ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
$cfg{'smtp_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available POP3 hosts :';
$def = $oldcfg{'pop3_hosts'} || [];
$cfg{'pop3_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available SNPP hosts :';
$def = $oldcfg{'snpp_hosts'} || [];
$cfg{'snpp_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available PH Hosts :' ;
$def = $oldcfg{'ph_hosts'} ||
[ default_hostname('dirserv') ];
$cfg{'ph_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available TIME Hosts :' ;
$def = $oldcfg{'time_hosts'} || [];
$cfg{'time_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = 'Enter a list of available DAYTIME Hosts :' ;
$def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
$cfg{'daytime_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
$msg = <<EDQ;
Do you have a firewall/ftp proxy between your machine and the internet
If you use a SOCKS firewall answer no
(y|n) ?
EDQ
if(get_bool($msg,0)) {
$msg = <<'EDQ';
What series of FTP commands do you need to send to your
firewall to connect to an external host.
user/pass => external user & password
fwuser/fwpass => firewall user & password
0) None
1) -----------------------
USER user@remote.host
PASS pass
2) -----------------------
USER fwuser
PASS fwpass
USER user@remote.host
PASS pass
3) -----------------------
USER fwuser
PASS fwpass
SITE remote.site
USER user
PASS pass
4) -----------------------
USER fwuser
PASS fwpass
OPEN remote.site
USER user
PASS pass
5) -----------------------
USER user@fwuser@remote.site
PASS pass@fwpass
6) -----------------------
USER fwuser@remote.site
PASS fwpass
USER user
PASS pass
7) -----------------------
USER user@remote.host
PASS pass
AUTH fwuser
RESP fwpass
Choice:
EDQ
$def = exists $oldcfg{'ftp_firewall_type'} ? $oldcfg{'ftp_firewall_type'} : 1;
$ans = Prompt($msg,$def);
$cfg{'ftp_firewall_type'} = 0+$ans;
$def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
$cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
}
else {
delete $cfg{'ftp_firewall'};
}
#---------------------------------------------------------------------------
if (defined $cfg{'ftp_firewall'})
{
print <<EDQ;
By default Net::FTP assumes that it only needs to use a firewall if it
cannot resolve the name of the host given. This only works if your DNS
system is setup to only resolve internal hostnames. If this is not the
case and your DNS will resolve external hostnames, then another method
is needed. Net::Config can do this if you provide the netmasks that
describe your internal network. Each netmask should be entered in the
form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
EDQ
$def = [];
if(ref($oldcfg{'local_netmask'}))
{
$def = $oldcfg{'local_netmask'};
print "Your current netmasks are :\n\n\t",
join("\n\t",@{$def}),"\n\n";
}
print "
Enter one netmask at each prompt, prefix with a - to remove a netmask
from the list, enter a '*' to clear the whole list, an '=' to show the
current list and an empty line to continue with Configure.
";
my $mask = get_netmask("netmask :",$def);
$cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
}
#---------------------------------------------------------------------------
###$msg =<<EDQ;
###
###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
###then enter a list of hostames
###
###Enter a list of available SOCKS hosts :
###EDQ
###
###$def = $cfg{'socks_hosts'} ||
### [ default_hostname($ENV{SOCKS5_SERVER},
### $ENV{SOCKS_SERVER},
### $ENV{SOCKS4_SERVER}) ];
###
###$cfg{'socks_hosts'} = get_host_list($msg,$def);
#---------------------------------------------------------------------------
print <<EDQ;
Normally when FTP needs a data connection the client tells the server
a port to connect to, and the server initiates a connection to the client.
Some setups, in particular firewall setups, can/do not work using this
protocol. In these situations the client must make the connection to the
server, this is called a passive transfer.
EDQ
if (defined $cfg{'ftp_firewall'}) {
$msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
$def = $oldcfg{'ftp_ext_passive'} || 0;
$cfg{'ftp_ext_passive'} = get_bool($msg,$def);
$msg = "\nShould all other FTP connections be passive (y|n) ?";
}
else {
$msg = "\nShould all FTP connections be passive (y|n) ?";
}
$def = $oldcfg{'ftp_int_passive'} || 0;
$cfg{'ftp_int_passive'} = get_bool($msg,$def);
#---------------------------------------------------------------------------
$def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
$ans = Prompt("\nWhat is your local internet domain name :",$def);
$cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
#---------------------------------------------------------------------------
$msg = <<EDQ;
If you specified some default hosts above, it is possible for me to
do some basic tests when you run 'make test'
This will cause 'make test' to be quite a bit slower and, if your
internet connection is via dialup, will require you to be on-line
unless the hosts are local.
Do you want me to run these tests (y|n) ?
EDQ
$cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
#---------------------------------------------------------------------------
$msg = <<EDQ;
To allow Net::FTP to be tested I will need a hostname. This host
should allow anonymous access and have a /pub directory
What host can I use :
EDQ
$cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
if $cfg{'test_hosts'};
print "\n";
#---------------------------------------------------------------------------
my $fh = IO::File->new($libnet_cfg_out, "w") or
die "Cannot create '$libnet_cfg_out': $!";
print "Writing $libnet_cfg_out\n";
print $fh "{\n";
my $key;
foreach $key (keys %cfg) {
my $val = $cfg{$key};
if(!defined($val)) {
$val = "undef";
}
elsif(ref($val)) {
$val = '[' . join(",",
map {
my $v = "undef";
if(defined $_) {
($v = $_) =~ s/'/\'/sog;
$v = "'" . $v . "'";
}
$v;
} @$val ) . ']';
}
else {
$val =~ s/'/\'/sog;
$val = "'" . $val . "'" if $val =~ /\D/;
}
print $fh "\t'",$key,"' => ",$val,",\n";
}
print $fh "}\n";
$fh->close;
############################################################################
############################################################################
exit 0;
__END__
:endofperl

330
msys/mingw/bin/lwp-download Normal file
View file

@ -0,0 +1,330 @@
#!/usr/bin/perl -w
=head1 NAME
lwp-download - Fetch large files from the web
=head1 SYNOPSIS
B<lwp-download> [B<-a>] [B<-s>] <I<url>> [<I<local path>>]
=head1 DESCRIPTION
The B<lwp-download> program will save the file at I<url> to a local
file.
If I<local path> is not specified, then the current directory is
assumed.
If I<local path> is a directory, then the last segment of the path of the
I<url> is appended to form a local filename. If the I<url> path ends with
slash the name "index" is used. With the B<-s> option pick up the last segment
of the filename from server provided sources like the Content-Disposition
header or any redirect URLs. A file extension to match the server reported
Content-Type might also be appended. If a file with the produced filename
already exists, then B<lwp-download> will prompt before it overwrites and will
fail if its standard input is not a terminal. This form of invocation will
also fail is no acceptable filename can be derived from the sources mentioned
above.
If I<local path> is not a directory, then it is simply used as the
path to save into. If the file already exists it's overwritten.
The I<lwp-download> program is implemented using the I<libwww-perl>
library. It is better suited to down load big files than the
I<lwp-request> program because it does not store the file in memory.
Another benefit is that it will keep you updated about its progress
and that you don't have much options to worry about.
Use the C<-a> option to save the file in text (ascii) mode. Might
make a difference on DOSish systems.
=head1 EXAMPLE
Fetch the newest and greatest perl version:
$ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
Saving to 'latest.tar.gz'...
11.4 MB received in 8 seconds (1.43 MB/sec)
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
#' get emacs out of quote mode
use strict;
use LWP::UserAgent ();
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();
use Encode;
use Encode::Locale;
my $progname = $0;
$progname =~ s,.*/,,; # only basename left in progname
$progname =~ s,.*\\,, if $^O eq "MSWin32";
$progname =~ s/\.\w*$//; # strip extension if any
#parse option
use Getopt::Std;
my %opt;
unless (getopts('as', \%opt)) {
usage();
}
my $url = URI->new(decode(locale => shift) || usage());
my $argfile = encode(locale_fs => decode(locale => shift));
usage() if defined($argfile) && !length($argfile);
my $VERSION = "6.15";
my $ua = LWP::UserAgent->new(
agent => "lwp-download/$VERSION ",
keep_alive => 1,
env_proxy => 1,
);
my $file; # name of file we download into
my $length; # total number of bytes to download
my $flength; # formatted length
my $size = 0; # number of bytes received
my $start_t; # start time of download
my $last_dur; # time of last callback
my $shown = 0; # have we called the show() function yet
$SIG{INT} = sub { die "Interrupted\n"; };
$| = 1; # autoflush
my $res = $ua->request(HTTP::Request->new(GET => $url),
sub {
unless(defined $file) {
my $res = $_[1];
my $directory;
if (defined $argfile && -d $argfile) {
($directory, $argfile) = ($argfile, undef);
}
unless (defined $argfile) {
# find a suitable name to use
$file = $opt{s} && $res->filename;
# if this fails we try to make something from the URL
unless ($file) {
$file = ($url->path_segments)[-1];
if (!defined($file) || !length($file)) {
$file = "index";
my $suffix = media_suffix($res->content_type);
$file .= ".$suffix" if $suffix;
}
elsif ($url->scheme eq 'ftp' ||
$file =~ /\.t[bg]z$/ ||
$file =~ /\.tar(\.(Z|gz|bz2?))?$/
) {
# leave the filename as it was
}
else {
my $ct = guess_media_type($file);
unless ($ct eq $res->content_type) {
# need a better suffix for this type
my $suffix = media_suffix($res->content_type);
$file .= ".$suffix" if $suffix;
}
}
}
# validate that we don't have a harmful filename now. The server
# might try to trick us into doing something bad.
if (!length($file) ||
$file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge ||
$file =~ /^\./
)
{
die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
}
if (defined $directory) {
require File::Spec;
$file = File::Spec->catfile($directory, $file);
}
# Check if the file is already present
if (-l $file) {
die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
}
elsif (-f _) {
die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
unless -t;
$shown = 1;
print "Overwrite $file? [y] ";
my $ans = <STDIN>;
unless (defined($ans) && $ans =~ /^y?\n/) {
if (defined $ans) {
print "Ok, aborting.\n";
}
else {
print "\nAborting.\n";
}
exit 1;
}
$shown = 0;
}
elsif (-e _) {
die "Will not save <$url> as \"$file\". Path exists.\n";
}
else {
print "Saving to '$file'...\n";
use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
sysopen(FILE, $file, O_WRONLY|O_EXCL|O_CREAT) ||
die "Can't open $file: $!";
}
}
else {
$file = $argfile;
}
unless (fileno(FILE)) {
open(FILE, ">", $file) || die "Can't open $file: $!\n";
}
binmode FILE unless $opt{a};
$length = $res->content_length;
$flength = fbytes($length) if defined $length;
$start_t = time;
$last_dur = 0;
}
print FILE $_[0] or die "Can't write to $file: $!\n";
$size += length($_[0]);
if (defined $length) {
my $dur = time - $start_t;
if ($dur != $last_dur) { # don't update too often
$last_dur = $dur;
my $perc = $size / $length;
my $speed;
$speed = fbytes($size/$dur) . "/sec" if $dur > 3;
my $secs_left = fduration($dur/$perc - $dur);
$perc = int($perc*100);
my $show = "$perc% of $flength";
$show .= " (at $speed, $secs_left remaining)" if $speed;
show($show, 1);
}
}
else {
show( fbytes($size) . " received");
}
}
);
if (fileno(FILE)) {
close(FILE) || die "Can't write to $file: $!\n";
show(""); # clear text
print "\r";
print fbytes($size);
print " of ", fbytes($length) if defined($length) && $length != $size;
print " received";
my $dur = time - $start_t;
if ($dur) {
my $speed = fbytes($size/$dur) . "/sec";
print " in ", fduration($dur), " ($speed)";
}
print "\n";
if (my $mtime = $res->last_modified) {
utime time, $mtime, $file;
}
if ($res->header("X-Died") || !$res->is_success) {
if (my $died = $res->header("X-Died")) {
print "$died\n";
}
if (-t) {
print "Transfer aborted. Delete $file? [n] ";
my $ans = <STDIN>;
if (defined($ans) && $ans =~ /^y\n/) {
unlink($file) && print "Deleted.\n";
}
elsif ($length > $size) {
print "Truncated file kept: ", fbytes($length - $size), " missing\n";
}
else {
print "File kept.\n";
}
exit 1;
}
else {
print "Transfer aborted, $file kept\n";
}
}
exit 0;
}
# Did not manage to create any file
print "\n" if $shown;
if (my $xdied = $res->header("X-Died")) {
print "$progname: Aborted\n$xdied\n";
}
else {
print "$progname: ", $res->status_line, "\n";
}
exit 1;
sub fbytes
{
my $n = int(shift);
if ($n >= 1024 * 1024) {
return sprintf "%.3g MB", $n / (1024.0 * 1024);
}
elsif ($n >= 1024) {
return sprintf "%.3g KB", $n / 1024.0;
}
else {
return "$n bytes";
}
}
sub fduration
{
use integer;
my $secs = int(shift);
my $hours = $secs / (60*60);
$secs -= $hours * 60*60;
my $mins = $secs / 60;
$secs %= 60;
if ($hours) {
return "$hours hours $mins minutes";
}
elsif ($mins >= 2) {
return "$mins minutes";
}
else {
$secs += $mins * 60;
return "$secs seconds";
}
}
BEGIN {
my @ani = qw(- \ | /);
my $ani = 0;
sub show
{
my($mess, $show_ani) = @_;
print "\r$mess" . (" " x (75 - length $mess));
print $show_ani ? "$ani[$ani++]\b" : " ";
$ani %= @ani;
$shown++;
}
}
sub usage
{
die "Usage: $progname [-a] <url> [<lpath>]\n";
}

View file

@ -0,0 +1,346 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
=head1 NAME
lwp-download - Fetch large files from the web
=head1 SYNOPSIS
B<lwp-download> [B<-a>] [B<-s>] <I<url>> [<I<local path>>]
=head1 DESCRIPTION
The B<lwp-download> program will save the file at I<url> to a local
file.
If I<local path> is not specified, then the current directory is
assumed.
If I<local path> is a directory, then the last segment of the path of the
I<url> is appended to form a local filename. If the I<url> path ends with
slash the name "index" is used. With the B<-s> option pick up the last segment
of the filename from server provided sources like the Content-Disposition
header or any redirect URLs. A file extension to match the server reported
Content-Type might also be appended. If a file with the produced filename
already exists, then B<lwp-download> will prompt before it overwrites and will
fail if its standard input is not a terminal. This form of invocation will
also fail is no acceptable filename can be derived from the sources mentioned
above.
If I<local path> is not a directory, then it is simply used as the
path to save into. If the file already exists it's overwritten.
The I<lwp-download> program is implemented using the I<libwww-perl>
library. It is better suited to down load big files than the
I<lwp-request> program because it does not store the file in memory.
Another benefit is that it will keep you updated about its progress
and that you don't have much options to worry about.
Use the C<-a> option to save the file in text (ascii) mode. Might
make a difference on DOSish systems.
=head1 EXAMPLE
Fetch the newest and greatest perl version:
$ lwp-download http://www.perl.com/CPAN/src/latest.tar.gz
Saving to 'latest.tar.gz'...
11.4 MB received in 8 seconds (1.43 MB/sec)
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
#' get emacs out of quote mode
use strict;
use LWP::UserAgent ();
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();
use Encode;
use Encode::Locale;
my $progname = $0;
$progname =~ s,.*/,,; # only basename left in progname
$progname =~ s,.*\\,, if $^O eq "MSWin32";
$progname =~ s/\.\w*$//; # strip extension if any
#parse option
use Getopt::Std;
my %opt;
unless (getopts('as', \%opt)) {
usage();
}
my $url = URI->new(decode(locale => shift) || usage());
my $argfile = encode(locale_fs => decode(locale => shift));
usage() if defined($argfile) && !length($argfile);
my $VERSION = "6.15";
my $ua = LWP::UserAgent->new(
agent => "lwp-download/$VERSION ",
keep_alive => 1,
env_proxy => 1,
);
my $file; # name of file we download into
my $length; # total number of bytes to download
my $flength; # formatted length
my $size = 0; # number of bytes received
my $start_t; # start time of download
my $last_dur; # time of last callback
my $shown = 0; # have we called the show() function yet
$SIG{INT} = sub { die "Interrupted\n"; };
$| = 1; # autoflush
my $res = $ua->request(HTTP::Request->new(GET => $url),
sub {
unless(defined $file) {
my $res = $_[1];
my $directory;
if (defined $argfile && -d $argfile) {
($directory, $argfile) = ($argfile, undef);
}
unless (defined $argfile) {
# find a suitable name to use
$file = $opt{s} && $res->filename;
# if this fails we try to make something from the URL
unless ($file) {
$file = ($url->path_segments)[-1];
if (!defined($file) || !length($file)) {
$file = "index";
my $suffix = media_suffix($res->content_type);
$file .= ".$suffix" if $suffix;
}
elsif ($url->scheme eq 'ftp' ||
$file =~ /\.t[bg]z$/ ||
$file =~ /\.tar(\.(Z|gz|bz2?))?$/
) {
# leave the filename as it was
}
else {
my $ct = guess_media_type($file);
unless ($ct eq $res->content_type) {
# need a better suffix for this type
my $suffix = media_suffix($res->content_type);
$file .= ".$suffix" if $suffix;
}
}
}
# validate that we don't have a harmful filename now. The server
# might try to trick us into doing something bad.
if (!length($file) ||
$file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprintf "\\x%02x", ord($1)/ge ||
$file =~ /^\./
)
{
die "Will not save <$url> as \"$file\".\nPlease override file name on the command line.\n";
}
if (defined $directory) {
require File::Spec;
$file = File::Spec->catfile($directory, $file);
}
# Check if the file is already present
if (-l $file) {
die "Will not save <$url> to link \"$file\".\nPlease override file name on the command line.\n";
}
elsif (-f _) {
die "Will not save <$url> as \"$file\" without verification.\nEither run from terminal or override file name on the command line.\n"
unless -t;
$shown = 1;
print "Overwrite $file? [y] ";
my $ans = <STDIN>;
unless (defined($ans) && $ans =~ /^y?\n/) {
if (defined $ans) {
print "Ok, aborting.\n";
}
else {
print "\nAborting.\n";
}
exit 1;
}
$shown = 0;
}
elsif (-e _) {
die "Will not save <$url> as \"$file\". Path exists.\n";
}
else {
print "Saving to '$file'...\n";
use Fcntl qw(O_WRONLY O_EXCL O_CREAT);
sysopen(FILE, $file, O_WRONLY|O_EXCL|O_CREAT) ||
die "Can't open $file: $!";
}
}
else {
$file = $argfile;
}
unless (fileno(FILE)) {
open(FILE, ">", $file) || die "Can't open $file: $!\n";
}
binmode FILE unless $opt{a};
$length = $res->content_length;
$flength = fbytes($length) if defined $length;
$start_t = time;
$last_dur = 0;
}
print FILE $_[0] or die "Can't write to $file: $!\n";
$size += length($_[0]);
if (defined $length) {
my $dur = time - $start_t;
if ($dur != $last_dur) { # don't update too often
$last_dur = $dur;
my $perc = $size / $length;
my $speed;
$speed = fbytes($size/$dur) . "/sec" if $dur > 3;
my $secs_left = fduration($dur/$perc - $dur);
$perc = int($perc*100);
my $show = "$perc% of $flength";
$show .= " (at $speed, $secs_left remaining)" if $speed;
show($show, 1);
}
}
else {
show( fbytes($size) . " received");
}
}
);
if (fileno(FILE)) {
close(FILE) || die "Can't write to $file: $!\n";
show(""); # clear text
print "\r";
print fbytes($size);
print " of ", fbytes($length) if defined($length) && $length != $size;
print " received";
my $dur = time - $start_t;
if ($dur) {
my $speed = fbytes($size/$dur) . "/sec";
print " in ", fduration($dur), " ($speed)";
}
print "\n";
if (my $mtime = $res->last_modified) {
utime time, $mtime, $file;
}
if ($res->header("X-Died") || !$res->is_success) {
if (my $died = $res->header("X-Died")) {
print "$died\n";
}
if (-t) {
print "Transfer aborted. Delete $file? [n] ";
my $ans = <STDIN>;
if (defined($ans) && $ans =~ /^y\n/) {
unlink($file) && print "Deleted.\n";
}
elsif ($length > $size) {
print "Truncated file kept: ", fbytes($length - $size), " missing\n";
}
else {
print "File kept.\n";
}
exit 1;
}
else {
print "Transfer aborted, $file kept\n";
}
}
exit 0;
}
# Did not manage to create any file
print "\n" if $shown;
if (my $xdied = $res->header("X-Died")) {
print "$progname: Aborted\n$xdied\n";
}
else {
print "$progname: ", $res->status_line, "\n";
}
exit 1;
sub fbytes
{
my $n = int(shift);
if ($n >= 1024 * 1024) {
return sprintf "%.3g MB", $n / (1024.0 * 1024);
}
elsif ($n >= 1024) {
return sprintf "%.3g KB", $n / 1024.0;
}
else {
return "$n bytes";
}
}
sub fduration
{
use integer;
my $secs = int(shift);
my $hours = $secs / (60*60);
$secs -= $hours * 60*60;
my $mins = $secs / 60;
$secs %= 60;
if ($hours) {
return "$hours hours $mins minutes";
}
elsif ($mins >= 2) {
return "$mins minutes";
}
else {
$secs += $mins * 60;
return "$secs seconds";
}
}
BEGIN {
my @ani = qw(- \ | /);
my $ani = 0;
sub show
{
my($mess, $show_ani) = @_;
print "\r$mess" . (" " x (75 - length $mess));
print $show_ani ? "$ani[$ani++]\b" : " ";
$ani %= @ani;
$shown++;
}
}
sub usage
{
die "Usage: $progname [-a] <url> [<lpath>]\n";
}
__END__
:endofperl

120
msys/mingw/bin/lwp-dump Normal file
View file

@ -0,0 +1,120 @@
#!/usr/bin/perl -w
use strict;
use LWP::UserAgent ();
use Getopt::Long qw(GetOptions);
use Encode;
use Encode::Locale;
my $VERSION = "6.15";
GetOptions(\my %opt,
'parse-head',
'max-length=n',
'keep-client-headers',
'method=s',
'agent=s',
'request',
) || usage();
my $url = shift || usage();
@ARGV && usage();
sub usage {
(my $progname = $0) =~ s,.*/,,;
die <<"EOT";
Usage: $progname [options] <url>
Recognized options are:
--agent <str>
--keep-client-headers
--max-length <n>
--method <str>
--parse-head
--request
EOT
}
my $ua = LWP::UserAgent->new(
parse_head => $opt{'parse-head'} || 0,
keep_alive => 1,
env_proxy => 1,
agent => $opt{agent} || "lwp-dump/$VERSION ",
);
my $req = HTTP::Request->new($opt{method} || 'GET' => decode(locale => $url));
my $res = $ua->simple_request($req);
$res->remove_header(grep /^Client-/, $res->header_field_names)
unless $opt{'keep-client-headers'} or
($res->header("Client-Warning") || "") eq "Internal response";
if ($opt{request}) {
$res->request->dump;
print "\n";
}
$res->dump(maxlength => $opt{'max-length'});
__END__
=head1 NAME
lwp-dump - See what headers and content is returned for a URL
=head1 SYNOPSIS
B<lwp-dump> [ I<options> ] I<URL>
=head1 DESCRIPTION
The B<lwp-dump> program will get the resource identified by the URL and then
dump the response object to STDOUT. This will display the headers returned and
the initial part of the content, escaped so that it's safe to display even
binary content. The escapes syntax used is the same as for Perl's double
quoted strings. If there is no content the string "(no content)" is shown in
its place.
The following options are recognized:
=over
=item B<--agent> I<str>
Override the user agent string passed to the server.
=item B<--keep-client-headers>
LWP internally generate various C<Client-*> headers that are stripped by
B<lwp-dump> in order to show the headers exactly as the server provided them.
This option will suppress this.
=item B<--max-length> I<n>
How much of the content to show. The default is 512. Set this
to 0 for unlimited.
If the content is longer then the string is chopped at the
limit and the string "...\n(### more bytes not shown)"
appended.
=item B<--method> I<str>
Use the given method for the request instead of the default "GET".
=item B<--parse-head>
By default B<lwp-dump> will not try to initialize headers by looking at the
head section of HTML documents. This option enables this. This corresponds to
L<LWP::UserAgent/"parse_head">.
=item B<--request>
Also dump the request sent.
=back
=head1 SEE ALSO
L<lwp-request>, L<LWP>, L<HTTP::Message/"dump">

136
msys/mingw/bin/lwp-dump.bat Normal file
View file

@ -0,0 +1,136 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
use strict;
use LWP::UserAgent ();
use Getopt::Long qw(GetOptions);
use Encode;
use Encode::Locale;
my $VERSION = "6.15";
GetOptions(\my %opt,
'parse-head',
'max-length=n',
'keep-client-headers',
'method=s',
'agent=s',
'request',
) || usage();
my $url = shift || usage();
@ARGV && usage();
sub usage {
(my $progname = $0) =~ s,.*/,,;
die <<"EOT";
Usage: $progname [options] <url>
Recognized options are:
--agent <str>
--keep-client-headers
--max-length <n>
--method <str>
--parse-head
--request
EOT
}
my $ua = LWP::UserAgent->new(
parse_head => $opt{'parse-head'} || 0,
keep_alive => 1,
env_proxy => 1,
agent => $opt{agent} || "lwp-dump/$VERSION ",
);
my $req = HTTP::Request->new($opt{method} || 'GET' => decode(locale => $url));
my $res = $ua->simple_request($req);
$res->remove_header(grep /^Client-/, $res->header_field_names)
unless $opt{'keep-client-headers'} or
($res->header("Client-Warning") || "") eq "Internal response";
if ($opt{request}) {
$res->request->dump;
print "\n";
}
$res->dump(maxlength => $opt{'max-length'});
__END__
=head1 NAME
lwp-dump - See what headers and content is returned for a URL
=head1 SYNOPSIS
B<lwp-dump> [ I<options> ] I<URL>
=head1 DESCRIPTION
The B<lwp-dump> program will get the resource identified by the URL and then
dump the response object to STDOUT. This will display the headers returned and
the initial part of the content, escaped so that it's safe to display even
binary content. The escapes syntax used is the same as for Perl's double
quoted strings. If there is no content the string "(no content)" is shown in
its place.
The following options are recognized:
=over
=item B<--agent> I<str>
Override the user agent string passed to the server.
=item B<--keep-client-headers>
LWP internally generate various C<Client-*> headers that are stripped by
B<lwp-dump> in order to show the headers exactly as the server provided them.
This option will suppress this.
=item B<--max-length> I<n>
How much of the content to show. The default is 512. Set this
to 0 for unlimited.
If the content is longer then the string is chopped at the
limit and the string "...\n(### more bytes not shown)"
appended.
=item B<--method> I<str>
Use the given method for the request instead of the default "GET".
=item B<--parse-head>
By default B<lwp-dump> will not try to initialize headers by looking at the
head section of HTML documents. This option enables this. This corresponds to
L<LWP::UserAgent/"parse_head">.
=item B<--request>
Also dump the request sent.
=back
=head1 SEE ALSO
L<lwp-request>, L<LWP>, L<HTTP::Message/"dump">
__END__
:endofperl

105
msys/mingw/bin/lwp-mirror Normal file
View file

@ -0,0 +1,105 @@
#!/usr/bin/perl -w
# Simple mirror utility using LWP
=head1 NAME
lwp-mirror - Simple mirror utility
=head1 SYNOPSIS
lwp-mirror [-v] [-t timeout] <url> <local file>
=head1 DESCRIPTION
This program can be used to mirror a document from a WWW server. The
document is only transferred if the remote copy is newer than the local
copy. If the local copy is newer nothing happens.
Use the C<-v> option to print the version number of this program.
The timeout value specified with the C<-t> option. The timeout value
is the time that the program will wait for response from the remote
server before it fails. The default unit for the timeout value is
seconds. You might append "m" or "h" to the timeout value to make it
minutes or hours, respectively.
Because this program is implemented using the LWP library, it only
supports the protocols that LWP supports.
=head1 SEE ALSO
L<lwp-request>, L<LWP>
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
use LWP::Simple qw(mirror is_success status_message $ua);
use Getopt::Std;
use Encode;
use Encode::Locale;
$progname = $0;
$progname =~ s,.*/,,; # use basename only
$progname =~ s/\.\w*$//; #strip extension if any
$VERSION = "6.15";
$opt_h = undef; # print usage
$opt_v = undef; # print version
$opt_t = undef; # timeout
unless (getopts("hvt:")) {
usage();
}
if ($opt_v) {
require LWP;
my $DISTNAME = 'libwww-perl-' . LWP::Version();
die <<"EOT";
This is lwp-mirror version $VERSION ($DISTNAME)
Copyright 1995-1999, Gisle Aas.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
EOT
}
$url = decode(locale => shift) or usage();
$file = encode(locale_fs => decode(locale => shift)) or usage();
usage() if $opt_h or @ARGV;
if (defined $opt_t) {
$opt_t =~ /^(\d+)([smh])?/;
die "$progname: Illegal timeout value!\n" unless defined $1;
$timeout = $1;
$timeout *= 60 if ($2 eq "m");
$timeout *= 3600 if ($2 eq "h");
$ua->timeout($timeout);
}
$rc = mirror($url, $file);
if ($rc == 304) {
print STDERR "$progname: $file is up to date\n"
}
elsif (!is_success($rc)) {
print STDERR "$progname: $rc ", status_message($rc), " ($url)\n";
exit 1;
}
exit;
sub usage
{
die <<"EOT";
Usage: $progname [-options] <url> <file>
-v print version number of program
-t <timeout> Set timeout value
EOT
}

View file

@ -0,0 +1,121 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
# Simple mirror utility using LWP
=head1 NAME
lwp-mirror - Simple mirror utility
=head1 SYNOPSIS
lwp-mirror [-v] [-t timeout] <url> <local file>
=head1 DESCRIPTION
This program can be used to mirror a document from a WWW server. The
document is only transferred if the remote copy is newer than the local
copy. If the local copy is newer nothing happens.
Use the C<-v> option to print the version number of this program.
The timeout value specified with the C<-t> option. The timeout value
is the time that the program will wait for response from the remote
server before it fails. The default unit for the timeout value is
seconds. You might append "m" or "h" to the timeout value to make it
minutes or hours, respectively.
Because this program is implemented using the LWP library, it only
supports the protocols that LWP supports.
=head1 SEE ALSO
L<lwp-request>, L<LWP>
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
use LWP::Simple qw(mirror is_success status_message $ua);
use Getopt::Std;
use Encode;
use Encode::Locale;
$progname = $0;
$progname =~ s,.*/,,; # use basename only
$progname =~ s/\.\w*$//; #strip extension if any
$VERSION = "6.15";
$opt_h = undef; # print usage
$opt_v = undef; # print version
$opt_t = undef; # timeout
unless (getopts("hvt:")) {
usage();
}
if ($opt_v) {
require LWP;
my $DISTNAME = 'libwww-perl-' . LWP::Version();
die <<"EOT";
This is lwp-mirror version $VERSION ($DISTNAME)
Copyright 1995-1999, Gisle Aas.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
EOT
}
$url = decode(locale => shift) or usage();
$file = encode(locale_fs => decode(locale => shift)) or usage();
usage() if $opt_h or @ARGV;
if (defined $opt_t) {
$opt_t =~ /^(\d+)([smh])?/;
die "$progname: Illegal timeout value!\n" unless defined $1;
$timeout = $1;
$timeout *= 60 if ($2 eq "m");
$timeout *= 3600 if ($2 eq "h");
$ua->timeout($timeout);
}
$rc = mirror($url, $file);
if ($rc == 304) {
print STDERR "$progname: $file is up to date\n"
}
elsif (!is_success($rc)) {
print STDERR "$progname: $rc ", status_message($rc), " ($url)\n";
exit 1;
}
exit;
sub usage
{
die <<"EOT";
Usage: $progname [-options] <url> <file>
-v print version number of program
-t <timeout> Set timeout value
EOT
}
__END__
:endofperl

552
msys/mingw/bin/lwp-request Normal file
View file

@ -0,0 +1,552 @@
#!/usr/bin/perl -w
# Simple user agent using LWP library.
=head1 NAME
lwp-request, GET, POST, HEAD - Simple command line user agent
=head1 SYNOPSIS
B<lwp-request> [B<-afPuUsSedvhx>] [B<-m> I<method>] [B<-b> I<base URL>] [B<-t> I<timeout>]
[B<-i> I<if-modified-since>] [B<-c> I<content-type>]
[B<-C> I<credentials>] [B<-p> I<proxy-url>] [B<-o> I<format>] I<url>...
=head1 DESCRIPTION
This program can be used to send requests to WWW servers and your
local file system. The request content for POST and PUT
methods is read from stdin. The content of the response is printed on
stdout. Error messages are printed on stderr. The program returns a
status value indicating the number of URLs that failed.
The options are:
=over 4
=item -m <method>
Set which method to use for the request. If this option is not used,
then the method is derived from the name of the program.
=item -f
Force request through, even if the program believes that the method is
illegal. The server might reject the request eventually.
=item -b <uri>
This URI will be used as the base URI for resolving all relative URIs
given as argument.
=item -t <timeout>
Set the timeout value for the requests. The timeout is the amount of
time that the program will wait for a response from the remote server
before it fails. The default unit for the timeout value is seconds.
You might append "m" or "h" to the timeout value to make it minutes or
hours, respectively. The default timeout is '3m', i.e. 3 minutes.
=item -i <time>
Set the If-Modified-Since header in the request. If I<time> is the
name of a file, use the modification timestamp for this file. If
I<time> is not a file, it is parsed as a literal date. Take a look at
L<HTTP::Date> for recognized formats.
=item -c <content-type>
Set the Content-Type for the request. This option is only allowed for
requests that take a content, i.e. POST and PUT. You can
force methods to take content by using the C<-f> option together with
C<-c>. The default Content-Type for POST is
C<application/x-www-form-urlencoded>. The default Content-type for
the others is C<text/plain>.
=item -p <proxy-url>
Set the proxy to be used for the requests. The program also loads
proxy settings from the environment. You can disable this with the
C<-P> option.
=item -P
Don't load proxy settings from environment.
=item -H <header>
Send this HTTP header with each request. You can specify several, e.g.:
lwp-request \
-H 'Referer: http://other.url/' \
-H 'Host: somehost' \
http://this.url/
=item -C <username>:<password>
Provide credentials for documents that are protected by Basic
Authentication. If the document is protected and you did not specify
the username and password with this option, then you will be prompted
to provide these values.
=back
The following options controls what is displayed by the program:
=over 4
=item -u
Print request method and absolute URL as requests are made.
=item -U
Print request headers in addition to request method and absolute URL.
=item -s
Print response status code. This option is always on for HEAD requests.
=item -S
Print response status chain. This shows redirect and authorization
requests that are handled by the library.
=item -e
Print response headers. This option is always on for HEAD requests.
=item -E
Print response status chain with full response headers.
=item -d
Do B<not> print the content of the response.
=item -o <format>
Process HTML content in various ways before printing it. If the
content type of the response is not HTML, then this option has no
effect. The legal format values are; I<text>, I<ps>, I<links>,
I<html> and I<dump>.
If you specify the I<text> format then the HTML will be formatted as
plain latin1 text. If you specify the I<ps> format then it will be
formatted as Postscript.
The I<links> format will output all links found in the HTML document.
Relative links will be expanded to absolute ones.
The I<html> format will reformat the HTML code and the I<dump> format
will just dump the HTML syntax tree.
Note that the C<HTML-Tree> distribution needs to be installed for this
option to work. In addition the C<HTML-Format> distribution needs to
be installed for I<-o text> or I<-o ps> to work.
=item -v
Print the version number of the program and quit.
=item -h
Print usage message and quit.
=item -a
Set text(ascii) mode for content input and output. If this option is not
used, content input and output is done in binary mode.
=back
Because this program is implemented using the LWP library, it will
only support the protocols that LWP supports.
=head1 SEE ALSO
L<lwp-mirror>, L<LWP>
=head1 COPYRIGHT
Copyright 1995-1999 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
$progname = $0;
$progname =~ s,.*[\\/],,; # use basename only
$progname =~ s/\.\w*$//; # strip extension, if any
$VERSION = "6.15";
require LWP;
use URI;
use URI::Heuristic qw(uf_uri);
use Encode;
use Encode::Locale;
use HTTP::Status qw(status_message);
use HTTP::Date qw(time2str str2time);
# This table lists the methods that are allowed. It should really be
# a superset for all methods supported for every scheme that may be
# supported by the library. Currently it might be a bit too HTTP
# specific. You might use the -f option to force a method through.
#
# "" = No content in request, "C" = Needs content in request
#
%allowed_methods = (
GET => "",
HEAD => "",
POST => "C",
PUT => "C",
DELETE => "",
TRACE => "",
OPTIONS => "",
);
# We make our own specialization of LWP::UserAgent that asks for
# user/password if document is protected.
{
package RequestAgent;
@ISA = qw(LWP::UserAgent);
sub new
{
my $self = LWP::UserAgent::new(@_);
$self->agent("lwp-request/$main::VERSION ");
$self;
}
sub get_basic_credentials
{
my($self, $realm, $uri) = @_;
if ($main::options{'C'}) {
return split(':', $main::options{'C'}, 2);
}
elsif (-t) {
my $netloc = $uri->host_port;
print STDERR "Enter username for $realm at $netloc: ";
my $user = <STDIN>;
chomp($user);
return (undef, undef) unless length $user;
print STDERR "Password: ";
system("stty -echo");
my $password = <STDIN>;
system("stty echo");
print STDERR "\n"; # because we disabled echo
chomp($password);
return ($user, $password);
}
else {
return (undef, undef)
}
}
}
$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);
# Parse command line
use Getopt::Long;
my @getopt_args = (
'a', # content i/o in text(ascii) mode
'm=s', # set method
'f', # make request even if method is not in %allowed_methods
'b=s', # base url
't=s', # timeout
'i=s', # if-modified-since
'c=s', # content type for POST
'C=s', # credentials for basic authorization
'H=s@', # extra headers, form "Header: value string"
#
'u', # display method and URL of request
'U', # display request headers also
's', # display status code
'S', # display whole chain of status codes
'e', # display response headers (default for HEAD)
'E', # display whole chain of headers
'd', # don't display content
#
'h', # print usage
'v', # print version
#
'p=s', # proxy URL
'P', # don't load proxy setting from environment
#
'o=s', # output format
);
Getopt::Long::config("noignorecase", "bundling");
unless (GetOptions(\%options, @getopt_args)) {
usage();
}
if ($options{'v'}) {
require LWP;
my $DISTNAME = 'libwww-perl-' . LWP::Version();
die <<"EOT";
This is lwp-request version $VERSION ($DISTNAME)
Copyright 1995-1999, Gisle Aas.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
EOT
}
usage() if $options{'h'} || !@ARGV;
# Create the user agent object
$ua = RequestAgent->new;
# Load proxy settings from *_proxy environment variables.
$ua->env_proxy unless $options{'P'};
$method = uc($options{'m'}) if defined $options{'m'};
if ($options{'f'}) {
if ($options{'c'}) {
$allowed_methods{$method} = "C"; # force content
}
else {
$allowed_methods{$method} = "";
}
}
elsif (!defined $allowed_methods{$method}) {
die "$progname: $method is not an allowed method\n";
}
if ($options{'S'} || $options{'E'}) {
$options{'U'} = 1 if $options{'E'};
$options{'E'} = 1 if $options{'e'};
$options{'S'} = 1;
$options{'s'} = 1;
$options{'u'} = 1;
}
if ($method eq "HEAD") {
$options{'s'} = 1;
$options{'e'} = 1 unless $options{'d'};
$options{'d'} = 1;
}
$options{'u'} = 1 if $options{'U'};
$options{'s'} = 1 if $options{'e'};
if (defined $options{'t'}) {
$options{'t'} =~ /^(\d+)([smh])?/;
die "$progname: Illegal timeout value!\n" unless defined $1;
$timeout = $1;
if (defined $2) {
$timeout *= 60 if $2 eq "m";
$timeout *= 3600 if $2 eq "h";
}
$ua->timeout($timeout);
}
if (defined $options{'i'}) {
if (-e $options{'i'}) {
$time = (stat _)[9];
}
else {
$time = str2time($options{'i'});
die "$progname: Illegal time syntax for -i option\n"
unless defined $time;
}
$options{'i'} = time2str($time);
}
$content = undef;
$user_ct = undef;
if ($allowed_methods{$method} eq "C") {
# This request needs some content
unless (defined $options{'c'}) {
# set default content type
$options{'c'} = ($method eq "POST") ?
"application/x-www-form-urlencoded"
: "text/plain";
}
else {
die "$progname: Illegal Content-type format\n"
unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s*;.*)?$,;
$user_ct++;
}
print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n"
if -t;
binmode STDIN unless -t or $options{'a'};
$content = join("", <STDIN>);
}
else {
die "$progname: Can't set Content-type for $method requests\n"
if defined $options{'c'};
}
# Set up a request. We will use the same request object for all URLs.
$request = HTTP::Request->new($method);
$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
for my $user_header (@{ $options{'H'} || [] }) {
my ($header_name, $header_value) = split /\s*:\s*/, $user_header, 2;
$header_name =~ s/^\s+//;
if (lc($header_name) eq "user-agent") {
$header_value .= $ua->agent if $header_value =~ /\s\z/;
$ua->agent($header_value);
}
else {
$request->push_header($header_name, $header_value);
}
}
#$request->header('Accept', '*/*');
if ($options{'c'}) { # will always be set for request that wants content
my $header = ($user_ct ? 'header' : 'init_header');
$request->$header('Content-Type', $options{'c'});
$request->header('Content-Length', length $content); # Not really needed
$request->content($content);
}
$errors = 0;
sub show {
my $r = shift;
my $last = shift;
print $method, " ", $r->request->uri->as_string, "\n" if $options{'u'};
print $r->request->headers_as_string, "\n" if $options{'U'};
print $r->status_line, "\n" if $options{'s'};
print $r->headers_as_string, "\n" if $options{'E'} or $last;
}
# Ok, now we perform the requests, one URL at a time
while ($url = shift) {
# Create the URL object, but protect us against bad URLs
eval {
if ($url =~ /^\w+:/ || $options{'b'}) { # is there any scheme specification
$url = URI->new(decode(locale => $url), decode(locale => $options{'b'}));
$url = $url->abs(decode(locale => $options{'b'})) if $options{'b'};
}
else {
$url = uf_uri($url);
}
};
if ($@) {
$@ =~ s/ at .* line \d+.*//;
print STDERR $@;
$errors++;
next;
}
$ua->proxy($url->scheme, decode(locale => $options{'p'})) if $options{'p'};
# Send the request and get a response back from the server
$request->uri($url);
$response = $ua->request($request);
if ($options{'S'}) {
for my $r ($response->redirects) {
show($r);
}
}
show($response, $options{'e'});
unless ($options{'d'}) {
if ($options{'o'} &&
$response->content_type eq 'text/html') {
eval {
require HTML::Parse;
};
if ($@) {
if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
}
else {
die $@;
}
}
my $html = HTML::Parse::parse_html($response->content);
{
$options{'o'} eq 'ps' && do {
require HTML::FormatPS;
my $f = HTML::FormatPS->new;
print $f->format($html);
last;
};
$options{'o'} eq 'text' && do {
require HTML::FormatText;
my $f = HTML::FormatText->new;
print $f->format($html);
last;
};
$options{'o'} eq 'html' && do {
print $html->as_HTML;
last;
};
$options{'o'} eq 'links' && do {
my $base = $response->base;
$base = $options{'b'} if $options{'b'};
for ( @{ $html->extract_links } ) {
my($link, $elem) = @$_;
my $tag = uc $elem->tag;
$link = URI->new($link)->abs($base)->as_string;
print "$tag\t$link\n";
}
last;
};
$options{'o'} eq 'dump' && do {
$html->dump;
last;
};
# It is bad to not notice this before now :-(
die "Illegal -o option value ($options{'o'})\n";
}
}
else {
binmode STDOUT unless $options{'a'};
print $response->content;
}
}
$errors++ unless $response->is_success;
}
exit $errors;
sub usage
{
die <<"EOT";
Usage: $progname [-options] <url>...
-m <method> use method for the request (default is '$method')
-f make request even if $progname believes method is illegal
-b <base> Use the specified URL as base
-t <timeout> Set timeout value
-i <time> Set the If-Modified-Since header on the request
-c <conttype> use this content-type for POST, PUT, CHECKIN
-a Use text mode for content I/O
-p <proxyurl> use this as a proxy
-P don't load proxy settings from environment
-H <header> send this HTTP header (you can specify several)
-C <username>:<password>
provide credentials for basic authentication
-u Display method and URL before any response
-U Display request headers (implies -u)
-s Display response status code
-S Display response status chain (implies -u)
-e Display response headers (implies -s)
-E Display whole chain of headers (implies -S and -U)
-d Do not display content
-o <format> Process HTML content in various ways
-v Show program version
-h Print this message
EOT
}

View file

@ -0,0 +1,568 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
# Simple user agent using LWP library.
=head1 NAME
lwp-request, GET, POST, HEAD - Simple command line user agent
=head1 SYNOPSIS
B<lwp-request> [B<-afPuUsSedvhx>] [B<-m> I<method>] [B<-b> I<base URL>] [B<-t> I<timeout>]
[B<-i> I<if-modified-since>] [B<-c> I<content-type>]
[B<-C> I<credentials>] [B<-p> I<proxy-url>] [B<-o> I<format>] I<url>...
=head1 DESCRIPTION
This program can be used to send requests to WWW servers and your
local file system. The request content for POST and PUT
methods is read from stdin. The content of the response is printed on
stdout. Error messages are printed on stderr. The program returns a
status value indicating the number of URLs that failed.
The options are:
=over 4
=item -m <method>
Set which method to use for the request. If this option is not used,
then the method is derived from the name of the program.
=item -f
Force request through, even if the program believes that the method is
illegal. The server might reject the request eventually.
=item -b <uri>
This URI will be used as the base URI for resolving all relative URIs
given as argument.
=item -t <timeout>
Set the timeout value for the requests. The timeout is the amount of
time that the program will wait for a response from the remote server
before it fails. The default unit for the timeout value is seconds.
You might append "m" or "h" to the timeout value to make it minutes or
hours, respectively. The default timeout is '3m', i.e. 3 minutes.
=item -i <time>
Set the If-Modified-Since header in the request. If I<time> is the
name of a file, use the modification timestamp for this file. If
I<time> is not a file, it is parsed as a literal date. Take a look at
L<HTTP::Date> for recognized formats.
=item -c <content-type>
Set the Content-Type for the request. This option is only allowed for
requests that take a content, i.e. POST and PUT. You can
force methods to take content by using the C<-f> option together with
C<-c>. The default Content-Type for POST is
C<application/x-www-form-urlencoded>. The default Content-type for
the others is C<text/plain>.
=item -p <proxy-url>
Set the proxy to be used for the requests. The program also loads
proxy settings from the environment. You can disable this with the
C<-P> option.
=item -P
Don't load proxy settings from environment.
=item -H <header>
Send this HTTP header with each request. You can specify several, e.g.:
lwp-request \
-H 'Referer: http://other.url/' \
-H 'Host: somehost' \
http://this.url/
=item -C <username>:<password>
Provide credentials for documents that are protected by Basic
Authentication. If the document is protected and you did not specify
the username and password with this option, then you will be prompted
to provide these values.
=back
The following options controls what is displayed by the program:
=over 4
=item -u
Print request method and absolute URL as requests are made.
=item -U
Print request headers in addition to request method and absolute URL.
=item -s
Print response status code. This option is always on for HEAD requests.
=item -S
Print response status chain. This shows redirect and authorization
requests that are handled by the library.
=item -e
Print response headers. This option is always on for HEAD requests.
=item -E
Print response status chain with full response headers.
=item -d
Do B<not> print the content of the response.
=item -o <format>
Process HTML content in various ways before printing it. If the
content type of the response is not HTML, then this option has no
effect. The legal format values are; I<text>, I<ps>, I<links>,
I<html> and I<dump>.
If you specify the I<text> format then the HTML will be formatted as
plain latin1 text. If you specify the I<ps> format then it will be
formatted as Postscript.
The I<links> format will output all links found in the HTML document.
Relative links will be expanded to absolute ones.
The I<html> format will reformat the HTML code and the I<dump> format
will just dump the HTML syntax tree.
Note that the C<HTML-Tree> distribution needs to be installed for this
option to work. In addition the C<HTML-Format> distribution needs to
be installed for I<-o text> or I<-o ps> to work.
=item -v
Print the version number of the program and quit.
=item -h
Print usage message and quit.
=item -a
Set text(ascii) mode for content input and output. If this option is not
used, content input and output is done in binary mode.
=back
Because this program is implemented using the LWP library, it will
only support the protocols that LWP supports.
=head1 SEE ALSO
L<lwp-mirror>, L<LWP>
=head1 COPYRIGHT
Copyright 1995-1999 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 AUTHOR
Gisle Aas <gisle@aas.no>
=cut
$progname = $0;
$progname =~ s,.*[\\/],,; # use basename only
$progname =~ s/\.\w*$//; # strip extension, if any
$VERSION = "6.15";
require LWP;
use URI;
use URI::Heuristic qw(uf_uri);
use Encode;
use Encode::Locale;
use HTTP::Status qw(status_message);
use HTTP::Date qw(time2str str2time);
# This table lists the methods that are allowed. It should really be
# a superset for all methods supported for every scheme that may be
# supported by the library. Currently it might be a bit too HTTP
# specific. You might use the -f option to force a method through.
#
# "" = No content in request, "C" = Needs content in request
#
%allowed_methods = (
GET => "",
HEAD => "",
POST => "C",
PUT => "C",
DELETE => "",
TRACE => "",
OPTIONS => "",
);
# We make our own specialization of LWP::UserAgent that asks for
# user/password if document is protected.
{
package RequestAgent;
@ISA = qw(LWP::UserAgent);
sub new
{
my $self = LWP::UserAgent::new(@_);
$self->agent("lwp-request/$main::VERSION ");
$self;
}
sub get_basic_credentials
{
my($self, $realm, $uri) = @_;
if ($main::options{'C'}) {
return split(':', $main::options{'C'}, 2);
}
elsif (-t) {
my $netloc = $uri->host_port;
print STDERR "Enter username for $realm at $netloc: ";
my $user = <STDIN>;
chomp($user);
return (undef, undef) unless length $user;
print STDERR "Password: ";
system("stty -echo");
my $password = <STDIN>;
system("stty echo");
print STDERR "\n"; # because we disabled echo
chomp($password);
return ($user, $password);
}
else {
return (undef, undef)
}
}
}
$method = uc(lc($progname) eq "lwp-request" ? "GET" : $progname);
# Parse command line
use Getopt::Long;
my @getopt_args = (
'a', # content i/o in text(ascii) mode
'm=s', # set method
'f', # make request even if method is not in %allowed_methods
'b=s', # base url
't=s', # timeout
'i=s', # if-modified-since
'c=s', # content type for POST
'C=s', # credentials for basic authorization
'H=s@', # extra headers, form "Header: value string"
#
'u', # display method and URL of request
'U', # display request headers also
's', # display status code
'S', # display whole chain of status codes
'e', # display response headers (default for HEAD)
'E', # display whole chain of headers
'd', # don't display content
#
'h', # print usage
'v', # print version
#
'p=s', # proxy URL
'P', # don't load proxy setting from environment
#
'o=s', # output format
);
Getopt::Long::config("noignorecase", "bundling");
unless (GetOptions(\%options, @getopt_args)) {
usage();
}
if ($options{'v'}) {
require LWP;
my $DISTNAME = 'libwww-perl-' . LWP::Version();
die <<"EOT";
This is lwp-request version $VERSION ($DISTNAME)
Copyright 1995-1999, Gisle Aas.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
EOT
}
usage() if $options{'h'} || !@ARGV;
# Create the user agent object
$ua = RequestAgent->new;
# Load proxy settings from *_proxy environment variables.
$ua->env_proxy unless $options{'P'};
$method = uc($options{'m'}) if defined $options{'m'};
if ($options{'f'}) {
if ($options{'c'}) {
$allowed_methods{$method} = "C"; # force content
}
else {
$allowed_methods{$method} = "";
}
}
elsif (!defined $allowed_methods{$method}) {
die "$progname: $method is not an allowed method\n";
}
if ($options{'S'} || $options{'E'}) {
$options{'U'} = 1 if $options{'E'};
$options{'E'} = 1 if $options{'e'};
$options{'S'} = 1;
$options{'s'} = 1;
$options{'u'} = 1;
}
if ($method eq "HEAD") {
$options{'s'} = 1;
$options{'e'} = 1 unless $options{'d'};
$options{'d'} = 1;
}
$options{'u'} = 1 if $options{'U'};
$options{'s'} = 1 if $options{'e'};
if (defined $options{'t'}) {
$options{'t'} =~ /^(\d+)([smh])?/;
die "$progname: Illegal timeout value!\n" unless defined $1;
$timeout = $1;
if (defined $2) {
$timeout *= 60 if $2 eq "m";
$timeout *= 3600 if $2 eq "h";
}
$ua->timeout($timeout);
}
if (defined $options{'i'}) {
if (-e $options{'i'}) {
$time = (stat _)[9];
}
else {
$time = str2time($options{'i'});
die "$progname: Illegal time syntax for -i option\n"
unless defined $time;
}
$options{'i'} = time2str($time);
}
$content = undef;
$user_ct = undef;
if ($allowed_methods{$method} eq "C") {
# This request needs some content
unless (defined $options{'c'}) {
# set default content type
$options{'c'} = ($method eq "POST") ?
"application/x-www-form-urlencoded"
: "text/plain";
}
else {
die "$progname: Illegal Content-type format\n"
unless $options{'c'} =~ m,^[\w\-]+/[\w\-.+]+(?:\s*;.*)?$,;
$user_ct++;
}
print STDERR "Please enter content ($options{'c'}) to be ${method}ed:\n"
if -t;
binmode STDIN unless -t or $options{'a'};
$content = join("", <STDIN>);
}
else {
die "$progname: Can't set Content-type for $method requests\n"
if defined $options{'c'};
}
# Set up a request. We will use the same request object for all URLs.
$request = HTTP::Request->new($method);
$request->header('If-Modified-Since', $options{'i'}) if defined $options{'i'};
for my $user_header (@{ $options{'H'} || [] }) {
my ($header_name, $header_value) = split /\s*:\s*/, $user_header, 2;
$header_name =~ s/^\s+//;
if (lc($header_name) eq "user-agent") {
$header_value .= $ua->agent if $header_value =~ /\s\z/;
$ua->agent($header_value);
}
else {
$request->push_header($header_name, $header_value);
}
}
#$request->header('Accept', '*/*');
if ($options{'c'}) { # will always be set for request that wants content
my $header = ($user_ct ? 'header' : 'init_header');
$request->$header('Content-Type', $options{'c'});
$request->header('Content-Length', length $content); # Not really needed
$request->content($content);
}
$errors = 0;
sub show {
my $r = shift;
my $last = shift;
print $method, " ", $r->request->uri->as_string, "\n" if $options{'u'};
print $r->request->headers_as_string, "\n" if $options{'U'};
print $r->status_line, "\n" if $options{'s'};
print $r->headers_as_string, "\n" if $options{'E'} or $last;
}
# Ok, now we perform the requests, one URL at a time
while ($url = shift) {
# Create the URL object, but protect us against bad URLs
eval {
if ($url =~ /^\w+:/ || $options{'b'}) { # is there any scheme specification
$url = URI->new(decode(locale => $url), decode(locale => $options{'b'}));
$url = $url->abs(decode(locale => $options{'b'})) if $options{'b'};
}
else {
$url = uf_uri($url);
}
};
if ($@) {
$@ =~ s/ at .* line \d+.*//;
print STDERR $@;
$errors++;
next;
}
$ua->proxy($url->scheme, decode(locale => $options{'p'})) if $options{'p'};
# Send the request and get a response back from the server
$request->uri($url);
$response = $ua->request($request);
if ($options{'S'}) {
for my $r ($response->redirects) {
show($r);
}
}
show($response, $options{'e'});
unless ($options{'d'}) {
if ($options{'o'} &&
$response->content_type eq 'text/html') {
eval {
require HTML::Parse;
};
if ($@) {
if ($@ =~ m,^Can't locate HTML/Parse.pm in \@INC,) {
die "The HTML-Tree distribution need to be installed for the -o option to be used.\n";
}
else {
die $@;
}
}
my $html = HTML::Parse::parse_html($response->content);
{
$options{'o'} eq 'ps' && do {
require HTML::FormatPS;
my $f = HTML::FormatPS->new;
print $f->format($html);
last;
};
$options{'o'} eq 'text' && do {
require HTML::FormatText;
my $f = HTML::FormatText->new;
print $f->format($html);
last;
};
$options{'o'} eq 'html' && do {
print $html->as_HTML;
last;
};
$options{'o'} eq 'links' && do {
my $base = $response->base;
$base = $options{'b'} if $options{'b'};
for ( @{ $html->extract_links } ) {
my($link, $elem) = @$_;
my $tag = uc $elem->tag;
$link = URI->new($link)->abs($base)->as_string;
print "$tag\t$link\n";
}
last;
};
$options{'o'} eq 'dump' && do {
$html->dump;
last;
};
# It is bad to not notice this before now :-(
die "Illegal -o option value ($options{'o'})\n";
}
}
else {
binmode STDOUT unless $options{'a'};
print $response->content;
}
}
$errors++ unless $response->is_success;
}
exit $errors;
sub usage
{
die <<"EOT";
Usage: $progname [-options] <url>...
-m <method> use method for the request (default is '$method')
-f make request even if $progname believes method is illegal
-b <base> Use the specified URL as base
-t <timeout> Set timeout value
-i <time> Set the If-Modified-Since header on the request
-c <conttype> use this content-type for POST, PUT, CHECKIN
-a Use text mode for content I/O
-p <proxyurl> use this as a proxy
-P don't load proxy settings from environment
-H <header> send this HTTP header (you can specify several)
-C <username>:<password>
provide credentials for basic authentication
-u Display method and URL before any response
-U Display request headers (implies -u)
-s Display response status code
-S Display response status chain (implies -u)
-e Display response headers (implies -s)
-E Display whole chain of headers (implies -S and -U)
-d Do not display content
-o <format> Process HTML content in various ways
-v Show program version
-h Print this message
EOT
}
__END__
:endofperl

BIN
msys/mingw/bin/perl.exe Normal file

Binary file not shown.

Binary file not shown.

BIN
msys/mingw/bin/perl524.dll Normal file

Binary file not shown.

1530
msys/mingw/bin/perlbug.bat Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,27 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if 0;
# This "perldoc" file was generated by "perldoc.PL"
require 5;
BEGIN { $^W = 1 if $ENV{'PERLDOCDEBUG'} }
use Pod::Perldoc;
exit( Pod::Perldoc->run() );
__END__
:endofperl

View file

@ -0,0 +1,69 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl -w
#line 15
use File::DosGlob;
$| = 1;
while (@ARGV) {
my $arg = shift;
my @m = File::DosGlob::doglob(1,$arg);
print (@m ? join("\0", sort @m) : $arg);
print "\0" if @ARGV;
}
__END__
=head1 NAME
perlglob.bat - a more capable perlglob.exe replacement
=head1 SYNOPSIS
@perlfiles = glob "..\\pe?l/*.p?";
print <..\\pe?l/*.p?>;
# more efficient version
> perl -MFile::DosGlob=glob -e "print <../pe?l/*.p?>"
=head1 DESCRIPTION
This file is a portable replacement for perlglob.exe. It
is largely compatible with perlglob.exe (the Microsoft setargv.obj
version) in all but one respect--it understands wildcards in
directory components.
It prints null-separated filenames to standard output.
For details of the globbing features implemented, see
L<File::DosGlob>.
While one may replace perlglob.exe with this, usage by overriding
CORE::glob with File::DosGlob::glob should be much more efficient,
because it avoids launching a separate process, and is therefore
strongly recommended. See L<perlsub> for details of overriding
builtins.
=head1 AUTHOR
Gurusamy Sarathy <gsar@activestate.com>
=head1 SEE ALSO
perl
File::DosGlob
=cut
__END__
:endofperl

BIN
msys/mingw/bin/perlglob.exe Normal file

Binary file not shown.

406
msys/mingw/bin/perlivp.bat Normal file
View file

@ -0,0 +1,406 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
# perlivp v5.24.0
sub usage {
warn "@_\n" if @_;
print << " EOUSAGE";
Usage:
$0 [-p] [-v] | [-h]
-p Print a preface before each test telling what it will test.
-v Verbose mode in which extra information about test results
is printed. Test failures always print out some extra information
regardless of whether or not this switch is set.
-h Prints this help message.
EOUSAGE
exit;
}
use vars qw(%opt); # allow testing with older versions (do not use our)
@opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
while ($ARGV[0] =~ /^-/) {
$ARGV[0] =~ s/^-//;
for my $flag (split(//,$ARGV[0])) {
usage() if '?' =~ /\Q$flag/;
usage() if 'h' =~ /\Q$flag/;
usage() if 'H' =~ /\Q$flag/;
usage("unknown flag: '$flag'") unless 'HhPpVv' =~ /\Q$flag/;
warn "$0: '$flag' flag already set\n" if $opt{$flag}++;
}
shift;
}
$opt{p}++ if $opt{P};
$opt{v}++ if $opt{V};
my $pass__total = 0;
my $error_total = 0;
my $tests_total = 0;
my $perlpath = 'C:\perl-5.24.0\bin\perl.exe';
my $useithreads = 'define';
print "## Checking Perl binary via variable '\$perlpath' = $perlpath.\n" if $opt{'p'};
my $label = 'Executable perl binary';
if (-x $perlpath) {
print "## Perl binary '$perlpath' appears executable.\n" if $opt{'v'};
print "ok 1 $label\n";
$pass__total++;
}
else {
print "# Perl binary '$perlpath' does not appear executable.\n";
print "not ok 1 $label\n";
$error_total++;
}
$tests_total++;
print "## Checking Perl version via variable '\$]'.\n" if $opt{'p'};
my $ivp_VERSION = "5.024000";
$label = 'Perl version correct';
if ($ivp_VERSION eq $]) {
print "## Perl version '$]' appears installed as expected.\n" if $opt{'v'};
print "ok 2 $label\n";
$pass__total++;
}
else {
print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
print "not ok 2 $label\n";
$error_total++;
}
$tests_total++;
# We have the right perl and version, so now reset @INC so we ignore
# PERL5LIB and '.'
{
local $ENV{PERL5LIB};
my $perl_V = qx($perlpath -V);
$perl_V =~ s{.*\@INC:\n}{}ms;
@INC = grep { length && $_ ne '.' } split ' ', $perl_V;
}
print "## Checking roots of the Perl library directory tree via variable '\@INC'.\n" if $opt{'p'};
my $INC_total = 0;
my $INC_there = 0;
foreach (@INC) {
next if $_ eq '.'; # skip -d test here
if (-d $_) {
print "## Perl \@INC directory '$_' exists.\n" if $opt{'v'};
$INC_there++;
}
else {
print "# Perl \@INC directory '$_' does not appear to exist.\n";
}
$INC_total++;
}
$label = '@INC directoreis exist';
if ($INC_total == $INC_there) {
print "ok 3 $label\n";
$pass__total++;
}
else {
print "not ok 3 $label\n";
$error_total++;
}
$tests_total++;
print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
my $needed_total = 0;
my $needed_there = 0;
foreach (qw(Config.pm ExtUtils/Installed.pm)) {
$@ = undef;
$needed_total++;
eval "require \"$_\";";
if (!$@) {
print "## Module '$_' appears to be installed.\n" if $opt{'v'};
$needed_there++;
}
else {
print "# Needed module '$_' does not appear to be properly installed.\n";
}
$@ = undef;
}
$label = 'Modules needed for rest of perlivp exist';
if ($needed_total == $needed_there) {
print "ok 4 $label\n";
$pass__total++;
}
else {
print "not ok 4 $label\n";
$error_total++;
}
$tests_total++;
print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
use Config;
my $extensions_total = 0;
my $extensions_there = 0;
if (defined($Config{'extensions'})) {
my @extensions = split(/\s+/,$Config{'extensions'});
foreach (@extensions) {
next if ($_ eq '');
if ( $useithreads !~ /define/i ) {
next if ($_ eq 'threads');
next if ($_ eq 'threads/shared');
}
# that's a distribution name, not a module name
next if $_ eq 'IO/Compress';
next if $_ eq 'Devel/DProf';
next if $_ eq 'libnet';
next if $_ eq 'Locale/Codes';
next if $_ eq 'podlators';
next if $_ eq 'perlfaq';
# test modules
next if $_ eq 'XS/APItest';
next if $_ eq 'XS/Typemap';
# VMS$ perl -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
# \NT> perl -e "eval \"require 'Devel/DProf.pm'\"; print $@"
# DProf: run perl with -d to use DProf.
# Compilation failed in require at (eval 1) line 1.
eval " require \"$_.pm\"; ";
if (!$@) {
print "## Module '$_' appears to be installed.\n" if $opt{'v'};
$extensions_there++;
}
else {
print "# Required module '$_' does not appear to be properly installed.\n";
$@ = undef;
}
$extensions_total++;
}
# A silly name for a module (that hopefully won't ever exist).
# Note that this test serves more as a check of the validity of the
# actual required module tests above.
my $unnecessary = 'bLuRfle';
if (!grep(/$unnecessary/, @extensions)) {
$@ = undef;
eval " require \"$unnecessary.pm\"; ";
if ($@) {
print "## Unnecessary module '$unnecessary' does not appear to be installed.\n" if $opt{'v'};
}
else {
print "# Unnecessary module '$unnecessary' appears to be installed.\n";
$extensions_there++;
}
}
$@ = undef;
}
$label = 'All (and only) expected extensions installed';
if ($extensions_total == $extensions_there) {
print "ok 5 $label\n";
$pass__total++;
}
else {
print "not ok 5 $label\n";
$error_total++;
}
$tests_total++;
print "## Checking installations of later additional extensions.\n" if $opt{'p'};
use ExtUtils::Installed;
my $installed_total = 0;
my $installed_there = 0;
my $version_check = 0;
my $installed = ExtUtils::Installed -> new();
my @modules = $installed -> modules();
my @missing = ();
my $version = undef;
for (@modules) {
$installed_total++;
# Consider it there if it contains one or more files,
# and has zero missing files,
# and has a defined version
$version = undef;
$version = $installed -> version($_);
if ($version) {
print "## $_; $version\n" if $opt{'v'};
$version_check++;
}
else {
print "# $_; NO VERSION\n" if $opt{'v'};
}
$version = undef;
@missing = ();
@missing = $installed -> validate($_);
# .bs files are optional
@missing = grep { ! /\.bs$/ } @missing;
# man files are often compressed
@missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
if ($#missing >= 0) {
print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
print '# ',join(' ',@missing),"\n";
}
elsif ($#missing == -1) {
$installed_there++;
}
@missing = ();
}
$label = 'Module files correctly installed';
if (($installed_total == $installed_there) &&
($installed_total == $version_check)) {
print "ok 6 $label\n";
$pass__total++;
}
else {
print "not ok 6 $label\n";
$error_total++;
}
$tests_total++;
# Final report (rather than feed ousrselves to Test::Harness::runtests()
# we simply format some output on our own to keep things simple and
# easier to "fix" - at least for now.
if ($error_total == 0 && $tests_total) {
print "All tests successful.\n";
} elsif ($tests_total==0){
die "FAILED--no tests were run for some reason.\n";
} else {
my $rate = 0.0;
if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
printf " %d/%d subtests failed, %.2f%% okay.\n",
$error_total, $tests_total, $rate;
}
=head1 NAME
perlivp - Perl Installation Verification Procedure
=head1 SYNOPSIS
B<perlivp> [B<-p>] [B<-v>] [B<-h>]
=head1 DESCRIPTION
The B<perlivp> program is set up at Perl source code build time to test the
Perl version it was built under. It can be used after running:
make install
(or your platform's equivalent procedure) to verify that B<perl> and its
libraries have been installed correctly. A correct installation is verified
by output that looks like:
ok 1
ok 2
etc.
=head1 OPTIONS
=over 5
=item B<-h> help
Prints out a brief help message.
=item B<-p> print preface
Gives a description of each test prior to performing it.
=item B<-v> verbose
Gives more detailed information about each test, after it has been performed.
Note that any failed tests ought to print out some extra information whether
or not -v is thrown.
=back
=head1 DIAGNOSTICS
=over 4
=item * print "# Perl binary '$perlpath' does not appear executable.\n";
Likely to occur for a perl binary that was not properly installed.
Correct by conducting a proper installation.
=item * print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
Likely to occur for a perl that was not properly installed.
Correct by conducting a proper installation.
=item * print "# Perl \@INC directory '$_' does not appear to exist.\n";
Likely to occur for a perl library tree that was not properly installed.
Correct by conducting a proper installation.
=item * print "# Needed module '$_' does not appear to be properly installed.\n";
One of the two modules that is used by perlivp was not present in the
installation. This is a serious error since it adversely affects perlivp's
ability to function. You may be able to correct this by performing a
proper perl installation.
=item * print "# Required module '$_' does not appear to be properly installed.\n";
An attempt to C<eval "require $module"> failed, even though the list of
extensions indicated that it should succeed. Correct by conducting a proper
installation.
=item * print "# Unnecessary module 'bLuRfle' appears to be installed.\n";
This test not coming out ok could indicate that you have in fact installed
a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
test may give misleading results with your installation of perl. If yours
is the latter case then please let the author know.
=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
One or more files turned up missing according to a run of
C<ExtUtils::Installed -E<gt> validate()> over your installation.
Correct by conducting a proper installation.
=back
For further information on how to conduct a proper installation consult the
INSTALL file that comes with the perl source and the README file for your
platform.
=head1 AUTHOR
Peter Prymmer
=cut
__END__
:endofperl

File diff suppressed because it is too large Load diff

337
msys/mingw/bin/piconv.bat Normal file
View file

@ -0,0 +1,337 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!./perl
# $Id: piconv,v 2.7 2014/05/31 09:48:48 dankogai Exp $
#
use 5.8.0;
use strict;
use Encode ;
use Encode::Alias;
my %Scheme = map {$_ => 1} qw(from_to decode_encode perlio);
use File::Basename;
my $name = basename($0);
use Getopt::Long qw(:config no_ignore_case);
my %Opt;
help()
unless
GetOptions(\%Opt,
'from|f=s',
'to|t=s',
'list|l',
'string|s=s',
'check|C=i',
'c',
'perlqq|p',
'htmlcref',
'xmlcref',
'debug|D',
'scheme|S=s',
'resolve|r=s',
'help',
);
$Opt{help} and help();
$Opt{list} and list_encodings();
my $locale = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG};
defined $Opt{resolve} and resolve_encoding($Opt{resolve});
$Opt{from} || $Opt{to} || help();
my $from = $Opt{from} || $locale or help("from_encoding unspecified");
my $to = $Opt{to} || $locale or help("to_encoding unspecified");
$Opt{string} and Encode::from_to($Opt{string}, $from, $to) and print $Opt{string} and exit;
my $scheme = do {
if (defined $Opt{scheme}) {
if (!exists $Scheme{$Opt{scheme}}) {
warn "Unknown scheme '$Opt{scheme}', fallback to 'from_to'.\n";
'from_to';
} else {
$Opt{scheme};
}
} else {
'from_to';
}
};
$Opt{check} ||= $Opt{c};
$Opt{perlqq} and $Opt{check} = Encode::PERLQQ;
$Opt{htmlcref} and $Opt{check} = Encode::HTMLCREF;
$Opt{xmlcref} and $Opt{check} = Encode::XMLCREF;
my $efrom = Encode->getEncoding($from) || die "Unknown encoding '$from'";
my $eto = Encode->getEncoding($to) || die "Unknown encoding '$to'";
my $cfrom = $efrom->name;
my $cto = $eto->name;
if ($Opt{debug}){
print <<"EOT";
Scheme: $scheme
From: $from => $cfrom
To: $to => $cto
EOT
}
my %use_bom =
map { $_ => 1 } qw/UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE/;
# we do not use <> (or ARGV) for the sake of binmode()
@ARGV or push @ARGV, \*STDIN;
unless ( $scheme eq 'perlio' ) {
binmode STDOUT;
my $need2slurp = $use_bom{ $eto } || $use_bom{ $efrom };
for my $argv (@ARGV) {
my $ifh = ref $argv ? $argv : undef;
$ifh or open $ifh, "<", $argv or warn "Can't open $argv: $!" and next;
$ifh or open $ifh, "<", $argv or next;
binmode $ifh;
if ( $scheme eq 'from_to' ) { # default
if ($need2slurp){
local $/;
$_ = <$ifh>;
Encode::from_to( $_, $from, $to, $Opt{check} );
print;
}else{
while (<$ifh>) {
Encode::from_to( $_, $from, $to, $Opt{check} );
print;
}
}
}
elsif ( $scheme eq 'decode_encode' ) { # step-by-step
if ($need2slurp){
local $/;
$_ = <$ifh>;
my $decoded = decode( $from, $_, $Opt{check} );
my $encoded = encode( $to, $decoded );
print $encoded;
}else{
while (<$ifh>) {
my $decoded = decode( $from, $_, $Opt{check} );
my $encoded = encode( $to, $decoded );
print $encoded;
}
}
}
else { # won't reach
die "$name: unknown scheme: $scheme";
}
}
}
else {
# NI-S favorite
binmode STDOUT => "raw:encoding($to)";
for my $argv (@ARGV) {
my $ifh = ref $argv ? $argv : undef;
$ifh or open $ifh, "<", $argv or warn "Can't open $argv: $!" and next;
$ifh or open $ifh, "<", $argv or next;
binmode $ifh => "raw:encoding($from)";
print while (<$ifh>);
}
}
sub list_encodings {
print join( "\n", Encode->encodings(":all") ), "\n";
exit 0;
}
sub resolve_encoding {
if ( my $alias = Encode::resolve_alias( $_[0] ) ) {
print $alias, "\n";
exit 0;
}
else {
warn "$name: $_[0] is not known to Encode\n";
exit 1;
}
}
sub help {
my $message = shift;
$message and print STDERR "$name error: $message\n";
print STDERR <<"EOT";
$name [-f from_encoding] [-t to_encoding]
[-p|--perlqq|--htmlcref|--xmlcref] [-C N|-c] [-D] [-S scheme]
[-s string|file...]
$name -l
$name -r encoding_alias
$name -h
Common options:
-l,--list
lists all available encodings
-r,--resolve encoding_alias
resolve encoding to its (Encode) canonical name
-f,--from from_encoding
when omitted, the current locale will be used
-t,--to to_encoding
when omitted, the current locale will be used
-s,--string string
"string" will be the input instead of STDIN or files
The following are mainly of interest to Encode hackers:
-C N | -c check the validity of the input
-D,--debug show debug information
-S,--scheme scheme use the scheme for conversion
Those are handy when you can only see ASCII characters:
-p,--perlqq transliterate characters missing in encoding to \\x{HHHH}
where HHHH is the hexadecimal Unicode code point
--htmlcref transliterate characters missing in encoding to &#NNN;
where NNN is the decimal Unicode code point
--xmlcref transliterate characters missing in encoding to &#xHHHH;
where HHHH is the hexadecimal Unicode code point
EOT
exit;
}
__END__
=head1 NAME
piconv -- iconv(1), reinvented in perl
=head1 SYNOPSIS
piconv [-f from_encoding] [-t to_encoding]
[-p|--perlqq|--htmlcref|--xmlcref] [-C N|-c] [-D] [-S scheme]
[-s string|file...]
piconv -l
piconv -r encoding_alias
piconv -h
=head1 DESCRIPTION
B<piconv> is perl version of B<iconv>, a character encoding converter
widely available for various Unixen today. This script was primarily
a technology demonstrator for Perl 5.8.0, but you can use piconv in the
place of iconv for virtually any case.
piconv converts the character encoding of either STDIN or files
specified in the argument and prints out to STDOUT.
Here is the list of options. Some options can be in short format (-f)
or long (--from) one.
=over 4
=item -f,--from I<from_encoding>
Specifies the encoding you are converting from. Unlike B<iconv>,
this option can be omitted. In such cases, the current locale is used.
=item -t,--to I<to_encoding>
Specifies the encoding you are converting to. Unlike B<iconv>,
this option can be omitted. In such cases, the current locale is used.
Therefore, when both -f and -t are omitted, B<piconv> just acts
like B<cat>.
=item -s,--string I<string>
uses I<string> instead of file for the source of text.
=item -l,--list
Lists all available encodings, one per line, in case-insensitive
order. Note that only the canonical names are listed; many aliases
exist. For example, the names are case-insensitive, and many standard
and common aliases work, such as "latin1" for "ISO-8859-1", or "ibm850"
instead of "cp850", or "winlatin1" for "cp1252". See L<Encode::Supported>
for a full discussion.
=item -r,--resolve I<encoding_alias>
Resolve I<encoding_alias> to Encode canonical encoding name.
=item -C,--check I<N>
Check the validity of the stream if I<N> = 1. When I<N> = -1, something
interesting happens when it encounters an invalid character.
=item -c
Same as C<-C 1>.
=item -p,--perlqq
Transliterate characters missing in encoding to \x{HHHH} where HHHH is the
hexadecimal Unicode code point.
=item --htmlcref
Transliterate characters missing in encoding to &#NNN; where NNN is the
decimal Unicode code point.
=item --xmlcref
Transliterate characters missing in encoding to &#xHHHH; where HHHH is the
hexadecimal Unicode code point.
=item -h,--help
Show usage.
=item -D,--debug
Invokes debugging mode. Primarily for Encode hackers.
=item -S,--scheme I<scheme>
Selects which scheme is to be used for conversion. Available schemes
are as follows:
=over 4
=item from_to
Uses Encode::from_to for conversion. This is the default.
=item decode_encode
Input strings are decode()d then encode()d. A straight two-step
implementation.
=item perlio
The new perlIO layer is used. NI-S' favorite.
You should use this option if you are using UTF-16 and others which
linefeed is not $/.
=back
Like the I<-D> option, this is also for Encode hackers.
=back
=head1 SEE ALSO
L<iconv(1)>
L<locale(3)>
L<Encode>
L<Encode::Supported>
L<Encode::Alias>
L<PerlIO>
=cut
__END__
:endofperl

428
msys/mingw/bin/pl2bat.bat Normal file
View file

@ -0,0 +1,428 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl -w
#line 15
require 5;
use Getopt::Std;
use Config;
$0 =~ s|.*[/\\]||;
my $usage = <<EOT;
Usage: $0 [-h]
or: $0 [-w] [-u] [-a argstring] [-s stripsuffix] [files]
or: $0 [-w] [-u] [-n ntargs] [-o otherargs] [-s stripsuffix] [files]
-n ntargs arguments to invoke perl with in generated file
when run from Windows NT. Defaults to
'-x -S %0 %*'.
-o otherargs arguments to invoke perl with in generated file
other than when run from Windows NT. Defaults
to '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'.
-a argstring arguments to invoke perl with in generated file
ignoring operating system (for compatibility
with previous pl2bat versions).
-u update files that may have already been processed
by (some version of) pl2bat.
-w include "-w" on the /^#!.*perl/ line (unless
a /^#!.*perl/ line was already present).
-s stripsuffix strip this suffix from file before appending ".bat"
Not case-sensitive
Can be a regex if it begins with '/'
Defaults to "/\.plx?/"
-h show this help
EOT
my %OPT = ();
warn($usage), exit(0) if !getopts('whun:o:a:s:',\%OPT) or $OPT{'h'};
# NOTE: %0 is already enclosed in double quotes by cmd.exe, as appropriate
$OPT{'n'} = '-x -S %0 %*' unless exists $OPT{'n'};
$OPT{'o'} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $OPT{'o'};
$OPT{'s'} = '/\\.plx?/' unless exists $OPT{'s'};
$OPT{'s'} = ($OPT{'s'} =~ m#^/([^/]*[^/\$]|)\$?/?$# ? $1 : "\Q$OPT{'s'}\E");
my $head;
if( defined( $OPT{'a'} ) ) {
$head = <<EOT;
\@rem = '--*-Perl-*--
\@echo off
perl $OPT{'a'}
goto endofperl
\@rem ';
EOT
} else {
$head = <<EOT;
\@rem = '--*-Perl-*--
\@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl $OPT{'o'}
goto endofperl
:WinNT
perl $OPT{'n'}
if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
\@rem ';
EOT
}
$head =~ s/^\t//gm;
my $headlines = 2 + ($head =~ tr/\n/\n/);
my $tail = "\n__END__\n:endofperl\n";
@ARGV = ('-') unless @ARGV;
foreach ( @ARGV ) {
process($_);
}
sub process {
my( $file )= @_;
my $myhead = $head;
my $linedone = 0;
my $taildone = 0;
my $linenum = 0;
my $skiplines = 0;
my $line;
my $start= $Config{startperl};
$start= "#!perl" unless $start =~ /^#!.*perl/;
open( FILE, $file ) or die "$0: Can't open $file: $!";
@file = <FILE>;
foreach $line ( @file ) {
$linenum++;
if ( $line =~ /^:endofperl\b/ ) {
if( ! exists $OPT{'u'} ) {
warn "$0: $file has already been converted to a batch file!\n";
return;
}
$taildone++;
}
if ( not $linedone and $line =~ /^#!.*perl/ ) {
if( exists $OPT{'u'} ) {
$skiplines = $linenum - 1;
$line .= "#line ".(1+$headlines)."\n";
} else {
$line .= "#line ".($linenum+$headlines)."\n";
}
$linedone++;
}
if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
$line = "";
}
}
close( FILE );
$file =~ s/$OPT{'s'}$//oi;
$file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
open( FILE, ">$file" ) or die "Can't open $file: $!";
print FILE $myhead;
print FILE $start, ( $OPT{'w'} ? " -w" : "" ),
"\n#line ", ($headlines+1), "\n" unless $linedone;
print FILE @file[$skiplines..$#file];
print FILE $tail unless $taildone;
close( FILE );
}
__END__
=head1 NAME
pl2bat - wrap perl code into a batch file
=head1 SYNOPSIS
B<pl2bat> B<-h>
B<pl2bat> [B<-w>] S<[B<-a> I<argstring>]> S<[B<-s> I<stripsuffix>]> [files]
B<pl2bat> [B<-w>] S<[B<-n> I<ntargs>]> S<[B<-o> I<otherargs>]> S<[B<-s> I<stripsuffix>]> [files]
=head1 DESCRIPTION
This utility converts a perl script into a batch file that can be
executed on DOS-like operating systems. This is intended to allow
you to use a Perl script like regular programs and batch files where
you just enter the name of the script [probably minus the extension]
plus any command-line arguments and the script is found in your B<PATH>
and run.
=head2 ADVANTAGES
There are several alternatives to this method of running a Perl script.
They each have disadvantages that help you understand the motivation
for using B<pl2bat>.
=over
=item 1
C:> perl x:/path/to/script.pl [args]
=item 2
C:> perl -S script.pl [args]
=item 3
C:> perl -S script [args]
=item 4
C:> ftype Perl=perl.exe "%1" %*
C:> assoc .pl=Perl
then
C:> script.pl [args]
=item 5
C:> ftype Perl=perl.exe "%1" %*
C:> assoc .pl=Perl
C:> set PathExt=%PathExt%;.PL
then
C:> script [args]
=back
B<1> and B<2> are the most basic invocation methods that should work on
any system [DOS-like or not]. They require extra typing and require
that the script user know that the script is written in Perl. This
is a pain when you have lots of scripts, some written in Perl and some
not. It can be quite difficult to keep track of which scripts need to
be run through Perl and which do not. Even worse, scripts often get
rewritten from simple batch files into more powerful Perl scripts in
which case these methods would require all existing users of the scripts
be updated.
B<3> works on modern Win32 versions of Perl. It allows the user to
omit the ".pl" or ".bat" file extension, which is a minor improvement.
B<4> and B<5> work on some Win32 operating systems with some command
shells. One major disadvantage with both is that you can't use them
in pipelines nor with file redirection. For example, none of the
following will work properly if you used method B<4> or B<5>:
C:> script.pl <infile
C:> script.pl >outfile
C:> echo y | script.pl
C:> script.pl | more
This is due to a Win32 bug which Perl has no control over. This bug
is the major motivation for B<pl2bat> [which was originally written
for DOS] being used on Win32 systems.
Note also that B<5> works on a smaller range of combinations of Win32
systems and command shells while B<4> requires that the user know
that the script is a Perl script [because the ".pl" extension must
be entered]. This makes it hard to standardize on either of these
methods.
=head2 DISADVANTAGES
There are several potential traps you should be aware of when you
use B<pl2bat>.
The generated batch file is initially processed as a batch file each
time it is run. This means that, to use it from within another batch
file you should precede it with C<call> or else the calling batch
file will not run any commands after the script:
call script [args]
Except under Windows NT, if you specify more than 9 arguments to
the generated batch file then the 10th and subsequent arguments
are silently ignored.
Except when using F<CMD.EXE> under Windows NT, if F<perl.exe> is not
in your B<PATH>, then trying to run the script will give you a generic
"Command not found"-type of error message that will probably make you
think that the script itself is not in your B<PATH>. When using
F<CMD.EXE> under Windows NT, the generic error message is followed by
"You do not have Perl in your PATH", to make this clearer.
On most DOS-like operating systems, the only way to exit a batch file
is to "fall off the end" of the file. B<pl2bat> implements this by
doing C<goto :endofperl> and adding C<__END__> and C<:endofperl> as
the last two lines of the generated batch file. This means:
=over
=item No line of your script should start with a colon.
In particular, for this version of B<pl2bat>, C<:endofperl>,
C<:WinNT>, and C<:script_failed_so_exit_with_non_zero_val> should not
be used.
=item Care must be taken when using C<__END__> and the C<DATA> file handle.
One approach is:
. #!perl
. while( <DATA> ) {
. last if /^__END__$/;
. [...]
. }
. __END__
. lines of data
. to be processed
. __END__
. :endofperl
The dots in the first column are only there to prevent F<cmd.exe> to interpret
the C<:endofperl> line in this documentation. Otherwise F<pl2bat.bat> itself
wouldn't work. See the previous item. :-)
=item The batch file always "succeeds"
The following commands illustrate the problem:
C:> echo exit(99); >fail.pl
C:> pl2bat fail.pl
C:> perl -e "print system('perl fail.pl')"
99
C:> perl -e "print system('fail.bat')"
0
So F<fail.bat> always reports that it completed successfully. Actually,
under Windows NT, we have:
C:> perl -e "print system('fail.bat')"
1
So, for Windows NT, F<fail.bat> fails when the Perl script fails, but
the return code is always C<1>, not the return code from the Perl script.
=back
=head2 FUNCTION
By default, the ".pl" suffix will be stripped before adding a ".bat" suffix
to the supplied file names. This can be controlled with the C<-s> option.
The default behavior is to have the batch file compare the C<OS>
environment variable against C<"Windows_NT">. If they match, it
uses the C<%*> construct to refer to all the command line arguments
that were given to it, so you'll need to make sure that works on your
variant of the command shell. It is known to work in the F<CMD.EXE> shell
under Windows NT. 4DOS/NT users will want to put a C<ParameterChar = *>
line in their initialization file, or execute C<setdos /p*> in
the shell startup file.
On Windows95 and other platforms a nine-argument limit is imposed
on command-line arguments given to the generated batch file, since
they may not support C<%*> in batch files.
These can be overridden using the C<-n> and C<-o> options or the
deprecated C<-a> option.
=head1 OPTIONS
=over 8
=item B<-n> I<ntargs>
Arguments to invoke perl with in generated batch file when run from
Windows NT (or Windows 98, probably). Defaults to S<'-x -S %0 %*'>.
=item B<-o> I<otherargs>
Arguments to invoke perl with in generated batch file except when
run from Windows NT (ie. when run from DOS, Windows 3.1, or Windows 95).
Defaults to S<'-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9'>.
=item B<-a> I<argstring>
Arguments to invoke perl with in generated batch file. Specifying
B<-a> prevents the batch file from checking the C<OS> environment
variable to determine which operating system it is being run from.
=item B<-s> I<stripsuffix>
Strip a suffix string from file name before appending a ".bat"
suffix. The suffix is not case-sensitive. It can be a regex if
it begins with '/' (the trailing '/' is optional and a trailing
C<$> is always assumed). Defaults to C</.plx?/>.
=item B<-w>
If no line matching C</^#!.*perl/> is found in the script, then such
a line is inserted just after the new preamble. The exact line
depends on C<$Config{startperl}> [see L<Config>]. With the B<-w>
option, C<" -w"> is added after the value of C<$Config{startperl}>.
If a line matching C</^#!.*perl/> already exists in the script,
then it is not changed and the B<-w> option is ignored.
=item B<-u>
If the script appears to have already been processed by B<pl2bat>,
then the script is skipped and not processed unless B<-u> was
specified. If B<-u> is specified, the existing preamble is replaced.
=item B<-h>
Show command line usage.
=back
=head1 EXAMPLES
C:\> pl2bat foo.pl bar.PM
[..creates foo.bat, bar.PM.bat..]
C:\> pl2bat -s "/\.pl|\.pm/" foo.pl bar.PM
[..creates foo.bat, bar.bat..]
C:\> pl2bat < somefile > another.bat
C:\> pl2bat > another.bat
print scalar reverse "rekcah lrep rehtona tsuj\n";
^Z
[..another.bat is now a certified japh application..]
C:\> ren *.bat *.pl
C:\> pl2bat -u *.pl
[..updates the wrapping of some previously wrapped scripts..]
C:\> pl2bat -u -s .bat *.bat
[..same as previous example except more dangerous..]
=head1 BUGS
C<$0> will contain the full name, including the ".bat" suffix
when the generated batch file runs. If you don't like this,
see runperl.bat for an alternative way to invoke perl scripts.
Default behavior is to invoke Perl with the B<-S> flag, so Perl will
search the B<PATH> to find the script. This may have undesirable
effects.
On really old versions of Win32 Perl, you can't run the script
via
C:> script.bat [args]
and must use
C:> script [args]
A loop should be used to build up the argument list when not on
Windows NT so more than 9 arguments can be processed.
See also L</DISADVANTAGES>.
=head1 SEE ALSO
perl, perlwin32, runperl.bat
=cut
__END__
:endofperl

394
msys/mingw/bin/pl2pm.bat Normal file
View file

@ -0,0 +1,394 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
=head1 NAME
pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules.
=head1 SYNOPSIS
B<pl2pm> F<files>
=head1 DESCRIPTION
B<pl2pm> is a tool to aid in the conversion of Perl4-style .pl
library files to Perl5-style library modules. Usually, your old .pl
file will still work fine and you should only use this tool if you
plan to update your library to use some of the newer Perl 5 features,
such as AutoLoading.
=head1 LIMITATIONS
It's just a first step, but it's usually a good first step.
=head1 AUTHOR
Larry Wall <larry@wall.org>
=cut
use strict;
use warnings;
my %keyword = ();
while (<DATA>) {
chomp;
$keyword{$_} = 1;
}
local $/;
while (<>) {
my $newname = $ARGV;
$newname =~ s/\.pl$/.pm/ || next;
$newname =~ s#(.*/)?(\w+)#$1\u$2#;
if (-f $newname) {
warn "Won't overwrite existing $newname\n";
next;
}
my $oldpack = $2;
my $newpack = "\u$2";
my @export = ();
s/\bstd(in|out|err)\b/\U$&/g;
s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
if (/sub\s+\w+'/) {
@export = m/sub\s+\w+'(\w+)/g;
s/(sub\s+)main'(\w+)/$1$2/g;
}
else {
@export = m/sub\s+([A-Za-z]\w*)/g;
}
my @export_ok = grep($keyword{$_}, @export);
@export = grep(!$keyword{$_}, @export);
my %export = ();
@export{@export} = (1) x @export;
s/(^\s*);#/$1#/g;
s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
s/([\$\@%&*])'(\w+)/&xlate($1,"",$2,$newpack,$oldpack,\%export)/eg;
s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3,$newpack,$oldpack,\%export)/eg;
if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
s/\$\[\s*\+\s*//g;
s/\s*\+\s*\$\[//g;
s/\$\[/0/g;
}
s/open\s+(\w+)/open($1)/g;
my $export_ok = '';
my $carp ='';
if (s/\bdie\b/croak/g) {
$carp = "use Carp;\n";
s/croak "([^"]*)\\n"/croak "$1"/g;
}
if (@export_ok) {
$export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
}
if ( open(PM, ">$newname") ) {
print PM <<"END";
package $newpack;
use 5.006;
require Exporter;
$carp
\@ISA = qw(Exporter);
\@EXPORT = qw(@export);
$export_ok
$_
END
}
else {
warn "Can't create $newname: $!\n";
}
}
sub xlate {
my ($prefix, $pack, $ident,$newpack,$oldpack,$export) = @_;
my $xlated ;
if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
$xlated = "${pack}'$ident";
}
elsif ($pack eq '' || $pack eq 'main') {
if ($export->{$ident}) {
$xlated = "$prefix$ident";
}
else {
$xlated = "$prefix${pack}::$ident";
}
}
elsif ($pack eq $oldpack) {
$xlated = "$prefix${newpack}::$ident";
}
else {
$xlated = "$prefix${pack}::$ident";
}
return $xlated;
}
__END__
AUTOLOAD
BEGIN
CHECK
CORE
DESTROY
END
INIT
UNITCHECK
abs
accept
alarm
and
atan2
bind
binmode
bless
caller
chdir
chmod
chomp
chop
chown
chr
chroot
close
closedir
cmp
connect
continue
cos
crypt
dbmclose
dbmopen
defined
delete
die
do
dump
each
else
elsif
endgrent
endhostent
endnetent
endprotoent
endpwent
endservent
eof
eq
eval
exec
exists
exit
exp
fcntl
fileno
flock
for
foreach
fork
format
formline
ge
getc
getgrent
getgrgid
getgrnam
gethostbyaddr
gethostbyname
gethostent
getlogin
getnetbyaddr
getnetbyname
getnetent
getpeername
getpgrp
getppid
getpriority
getprotobyname
getprotobynumber
getprotoent
getpwent
getpwnam
getpwuid
getservbyname
getservbyport
getservent
getsockname
getsockopt
glob
gmtime
goto
grep
gt
hex
if
index
int
ioctl
join
keys
kill
last
lc
lcfirst
le
length
link
listen
local
localtime
lock
log
lstat
lt
m
map
mkdir
msgctl
msgget
msgrcv
msgsnd
my
ne
next
no
not
oct
open
opendir
or
ord
our
pack
package
pipe
pop
pos
print
printf
prototype
push
q
qq
qr
quotemeta
qw
qx
rand
read
readdir
readline
readlink
readpipe
recv
redo
ref
rename
require
reset
return
reverse
rewinddir
rindex
rmdir
s
scalar
seek
seekdir
select
semctl
semget
semop
send
setgrent
sethostent
setnetent
setpgrp
setpriority
setprotoent
setpwent
setservent
setsockopt
shift
shmctl
shmget
shmread
shmwrite
shutdown
sin
sleep
socket
socketpair
sort
splice
split
sprintf
sqrt
srand
stat
study
sub
substr
symlink
syscall
sysopen
sysread
sysseek
system
syswrite
tell
telldir
tie
tied
time
times
tr
truncate
uc
ucfirst
umask
undef
unless
unlink
unpack
unshift
untie
until
use
utime
values
vec
wait
waitpid
wantarray
warn
while
write
x
xor
y
__END__
:endofperl

240
msys/mingw/bin/pod2html.bat Normal file
View file

@ -0,0 +1,240 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
=pod
=head1 NAME
pod2html - convert .pod files to .html files
=head1 SYNOPSIS
pod2html --help --htmldir=<name> --htmlroot=<URL>
--infile=<name> --outfile=<name>
--podpath=<name>:...:<name> --podroot=<name>
--cachedir=<name> --flush --recurse --norecurse
--quiet --noquiet --verbose --noverbose
--index --noindex --backlink --nobacklink
--header --noheader --poderrors --nopoderrors
--css=<URL> --title=<name>
=head1 DESCRIPTION
Converts files from pod format (see L<perlpod>) to HTML format.
=head1 ARGUMENTS
pod2html takes the following arguments:
=over 4
=item help
--help
Displays the usage message.
=item htmldir
--htmldir=name
Sets the directory to which all cross references in the resulting HTML file
will be relative. Not passing this causes all links to be absolute since this
is the value that tells Pod::Html the root of the documentation tree.
Do not use this and --htmlroot in the same call to pod2html; they are mutually
exclusive.
=item htmlroot
--htmlroot=URL
Sets the base URL for the HTML files. When cross-references are made, the
HTML root is prepended to the URL.
Do not use this if relative links are desired: use --htmldir instead.
Do not pass both this and --htmldir to pod2html; they are mutually exclusive.
=item infile
--infile=name
Specify the pod file to convert. Input is taken from STDIN if no
infile is specified.
=item outfile
--outfile=name
Specify the HTML file to create. Output goes to STDOUT if no outfile
is specified.
=item podroot
--podroot=name
Specify the base directory for finding library pods.
=item podpath
--podpath=name:...:name
Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked-to in cross-references.
=item cachedir
--cachedir=name
Specify which directory is used for storing cache. Default directory is the
current working directory.
=item flush
--flush
Flush the cache.
=item backlink
--backlink
Turn =head1 directives into links pointing to the top of the HTML file.
=item nobacklink
--nobacklink
Do not turn =head1 directives into links pointing to the top of the HTML file
(default behaviour).
=item header
--header
Create header and footer blocks containing the text of the "NAME" section.
=item noheader
--noheader
Do not create header and footer blocks containing the text of the "NAME"
section (default behaviour).
=item poderrors
--poderrors
Include a "POD ERRORS" section in the outfile if there were any POD errors in
the infile (default behaviour).
=item nopoderrors
--nopoderrors
Do not include a "POD ERRORS" section in the outfile if there were any POD
errors in the infile.
=item index
--index
Generate an index at the top of the HTML file (default behaviour).
=item noindex
--noindex
Do not generate an index at the top of the HTML file.
=item recurse
--recurse
Recurse into subdirectories specified in podpath (default behaviour).
=item norecurse
--norecurse
Do not recurse into subdirectories specified in podpath.
=item css
--css=URL
Specify the URL of cascading style sheet to link from resulting HTML file.
Default is none style sheet.
=item title
--title=title
Specify the title of the resulting HTML file.
=item quiet
--quiet
Don't display mostly harmless warning messages.
=item noquiet
--noquiet
Display mostly harmless warning messages (default behaviour). But this is not
the same as "verbose" mode.
=item verbose
--verbose
Display progress messages.
=item noverbose
--noverbose
Do not display progress messages (default behaviour).
=back
=head1 AUTHOR
Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
=head1 BUGS
See L<Pod::Html> for a list of known bugs in the translator.
=head1 SEE ALSO
L<perlpod>, L<Pod::Html>
=head1 COPYRIGHT
This program is distributed under the Artistic License.
=cut
use Pod::Html;
pod2html @ARGV;
__END__
:endofperl

391
msys/mingw/bin/pod2man.bat Normal file
View file

@ -0,0 +1,391 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
# pod2man -- Convert POD data to formatted *roff input.
#
# Copyright 1999, 2000, 2001, 2004, 2006, 2008, 2010, 2012, 2013, 2014, 2015,
# 2016 Russ Allbery <rra@cpan.org>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
use 5.006;
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use Pod::Man ();
use Pod::Usage qw(pod2usage);
use strict;
# Clean up $0 for error reporting.
$0 =~ s%.*/%%;
# Insert -- into @ARGV before any single dash argument to hide it from
# Getopt::Long; we want to interpret it as meaning stdin.
my $stdin;
@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
# Parse our options, trying to retain backward compatibility with pod2man but
# allowing short forms as well. --lax is currently ignored.
my %options;
Getopt::Long::config ('bundling_override');
GetOptions (\%options, 'center|c=s', 'date|d=s', 'errors=s', 'fixed=s',
'fixedbold=s', 'fixeditalic=s', 'fixedbolditalic=s', 'help|h',
'lax|l', 'name|n=s', 'nourls', 'official|o', 'quotes|q=s',
'release|r=s', 'section|s=s', 'stderr', 'verbose|v', 'utf8|u')
or exit 1;
pod2usage (0) if $options{help};
# Official sets --center, but don't override things explicitly set.
if ($options{official} && !defined $options{center}) {
$options{center} = 'Perl Programmers Reference Guide';
}
# Verbose is only our flag, not a Pod::Man flag.
my $verbose = $options{verbose};
delete $options{verbose};
# This isn't a valid Pod::Man option and is only accepted for backward
# compatibility.
delete $options{lax};
# If neither stderr nor errors is set, default to errors = die.
if (!defined $options{stderr} && !defined $options{errors}) {
$options{errors} = 'die';
}
# Initialize and run the formatter, pulling a pair of input and output off at
# a time. For each file, we check whether the document was completely empty
# and, if so, will remove the created file and exit with a non-zero exit
# status.
my $parser = Pod::Man->new (%options);
my $status = 0;
my @files;
do {
@files = splice (@ARGV, 0, 2);
print " $files[1]\n" if $verbose;
$parser->parse_from_file (@files);
if ($parser->{CONTENTLESS}) {
$status = 1;
warn "$0: unable to format $files[0]\n";
if (defined ($files[1]) and $files[1] ne '-') {
unlink $files[1] unless (-s $files[1]);
}
}
} while (@ARGV);
exit $status;
__END__
=for stopwords
en em --stderr stderr --utf8 UTF-8 overdo markup MT-LEVEL Allbery Solaris
URL troff troff-specific formatters uppercased Christiansen --nourls UTC
prepend
=head1 NAME
pod2man - Convert POD data to formatted *roff input
=head1 SYNOPSIS
pod2man [B<--center>=I<string>] [B<--date>=I<string>] [B<--errors>=I<style>]
[B<--fixed>=I<font>] [B<--fixedbold>=I<font>] [B<--fixeditalic>=I<font>]
[B<--fixedbolditalic>=I<font>] [B<--name>=I<name>] [B<--nourls>]
[B<--official>] [B<--quotes>=I<quotes>] [B<--release>=I<version>]
[B<--section>=I<manext>] [B<--stderr>] [B<--utf8>] [B<--verbose>]
[I<input> [I<output>] ...]
pod2man B<--help>
=head1 DESCRIPTION
B<pod2man> is a front-end for Pod::Man, using it to generate *roff input
from POD source. The resulting *roff code is suitable for display on a
terminal using nroff(1), normally via man(1), or printing using troff(1).
I<input> is the file to read for POD source (the POD can be embedded in
code). If I<input> isn't given, it defaults to C<STDIN>. I<output>, if
given, is the file to which to write the formatted output. If I<output>
isn't given, the formatted output is written to C<STDOUT>. Several POD
files can be processed in the same B<pod2man> invocation (saving module
load and compile times) by providing multiple pairs of I<input> and
I<output> files on the command line.
B<--section>, B<--release>, B<--center>, B<--date>, and B<--official> can
be used to set the headers and footers to use; if not given, Pod::Man will
assume various defaults. See below or L<Pod::Man> for details.
B<pod2man> assumes that your *roff formatters have a fixed-width font
named C<CW>. If yours is called something else (like C<CR>), use
B<--fixed> to specify it. This generally only matters for troff output
for printing. Similarly, you can set the fonts used for bold, italic, and
bold italic fixed-width output.
Besides the obvious pod conversions, Pod::Man, and therefore pod2man also
takes care of formatting func(), func(n), and simple variable references
like $foo or @bar so you don't have to use code escapes for them; complex
expressions like C<$fred{'stuff'}> will still need to be escaped, though.
It also translates dashes that aren't used as hyphens into en dashes, makes
long dashes--like this--into proper em dashes, fixes "paired quotes," and
takes care of several other troff-specific tweaks. See L<Pod::Man> for
complete information.
=head1 OPTIONS
=over 4
=item B<-c> I<string>, B<--center>=I<string>
Sets the centered page header for the C<.TH> macro to I<string>. The
default is "User Contributed Perl Documentation", but also see
B<--official> below.
=item B<-d> I<string>, B<--date>=I<string>
Set the left-hand footer string for the C<.TH> macro to I<string>. By
default, the modification date of the input file will be used, or the
current date if input comes from C<STDIN>, and will be based on UTC (so
that the output will be reproducible regardless of local time zone).
=item B<--errors>=I<style>
Set the error handling style. C<die> says to throw an exception on any
POD formatting error. C<stderr> says to report errors on standard error,
but not to throw an exception. C<pod> says to include a POD ERRORS
section in the resulting documentation summarizing the errors. C<none>
ignores POD errors entirely, as much as possible.
The default is C<die>.
=item B<--fixed>=I<font>
The fixed-width font to use for verbatim text and code. Defaults to
C<CW>. Some systems may want C<CR> instead. Only matters for troff(1)
output.
=item B<--fixedbold>=I<font>
Bold version of the fixed-width font. Defaults to C<CB>. Only matters
for troff(1) output.
=item B<--fixeditalic>=I<font>
Italic version of the fixed-width font (actually, something of a misnomer,
since most fixed-width fonts only have an oblique version, not an italic
version). Defaults to C<CI>. Only matters for troff(1) output.
=item B<--fixedbolditalic>=I<font>
Bold italic (probably actually oblique) version of the fixed-width font.
Pod::Man doesn't assume you have this, and defaults to C<CB>. Some
systems (such as Solaris) have this font available as C<CX>. Only matters
for troff(1) output.
=item B<-h>, B<--help>
Print out usage information.
=item B<-l>, B<--lax>
No longer used. B<pod2man> used to check its input for validity as a
manual page, but this should now be done by L<podchecker(1)> instead.
Accepted for backward compatibility; this option no longer does anything.
=item B<-n> I<name>, B<--name>=I<name>
Set the name of the manual page for the C<.TH> macro to I<name>. Without
this option, the manual name is set to the uppercased base name of the
file being converted unless the manual section is 3, in which case the
path is parsed to see if it is a Perl module path. If it is, a path like
C<.../lib/Pod/Man.pm> is converted into a name like C<Pod::Man>. This
option, if given, overrides any automatic determination of the name.
Although one does not have to follow this convention, be aware that the
convention for UNIX man pages for commands is for the man page title to be
in all-uppercase, even if the command isn't.
This option is probably not useful when converting multiple POD files at
once.
When converting POD source from standard input, this option is required,
since there's otherwise no way to know what to use as the name of the
manual page.
=item B<--nourls>
Normally, LZ<><> formatting codes with a URL but anchor text are formatted
to show both the anchor text and the URL. In other words:
L<foo|http://example.com/>
is formatted as:
foo <http://example.com/>
This flag, if given, suppresses the URL when anchor text is given, so this
example would be formatted as just C<foo>. This can produce less
cluttered output in cases where the URLs are not particularly important.
=item B<-o>, B<--official>
Set the default header to indicate that this page is part of the standard
Perl release, if B<--center> is not also given.
=item B<-q> I<quotes>, B<--quotes>=I<quotes>
Sets the quote marks used to surround CE<lt>> text to I<quotes>. If
I<quotes> is a single character, it is used as both the left and right
quote. Otherwise, it is split in half, and the first half of the string
is used as the left quote and the second is used as the right quote.
I<quotes> may also be set to the special value C<none>, in which case no
quote marks are added around CE<lt>> text (but the font is still changed for
troff output).
=item B<-r> I<version>, B<--release>=I<version>
Set the centered footer for the C<.TH> macro to I<version>. By default,
this is set to the version of Perl you run B<pod2man> under. Setting this
to the empty string will cause some *roff implementations to use the
system default value.
Note that some system C<an> macro sets assume that the centered footer
will be a modification date and will prepend something like "Last
modified: ". If this is the case for your target system, you may want to
set B<--release> to the last modified date and B<--date> to the version
number.
=item B<-s> I<string>, B<--section>=I<string>
Set the section for the C<.TH> macro. The standard section numbering
convention is to use 1 for user commands, 2 for system calls, 3 for
functions, 4 for devices, 5 for file formats, 6 for games, 7 for
miscellaneous information, and 8 for administrator commands. There is a lot
of variation here, however; some systems (like Solaris) use 4 for file
formats, 5 for miscellaneous information, and 7 for devices. Still others
use 1m instead of 8, or some mix of both. About the only section numbers
that are reliably consistent are 1, 2, and 3.
By default, section 1 will be used unless the file ends in C<.pm>, in
which case section 3 will be selected.
=item B<--stderr>
By default, B<pod2man> dies if any errors are detected in the POD input.
If B<--stderr> is given and no B<--errors> flag is present, errors are
sent to standard error, but B<pod2man> does not abort. This is equivalent
to C<--errors=stderr> and is supported for backward compatibility.
=item B<-u>, B<--utf8>
By default, B<pod2man> produces the most conservative possible *roff
output to try to ensure that it will work with as many different *roff
implementations as possible. Many *roff implementations cannot handle
non-ASCII characters, so this means all non-ASCII characters are converted
either to a *roff escape sequence that tries to create a properly accented
character (at least for troff output) or to C<X>.
This option says to instead output literal UTF-8 characters. If your
*roff implementation can handle it, this is the best output format to use
and avoids corruption of documents containing non-ASCII characters.
However, be warned that *roff source with literal UTF-8 characters is not
supported by many implementations and may even result in segfaults and
other bad behavior.
Be aware that, when using this option, the input encoding of your POD
source should be properly declared unless it's US-ASCII. Pod::Simple will
attempt to guess the encoding and may be successful if it's Latin-1 or
UTF-8, but it will warn, which by default results in a B<pod2man> failure.
Use the C<=encoding> command to declare the encoding. See L<perlpod(1)>
for more information.
=item B<-v>, B<--verbose>
Print out the name of each output file as it is being generated.
=back
=head1 EXIT STATUS
As long as all documents processed result in some output, even if that
output includes errata (a C<POD ERRORS> section generated with
C<--errors=pod>), B<pod2man> will exit with status 0. If any of the
documents being processed do not result in an output document, B<pod2man>
will exit with status 1. If there are syntax errors in a POD document
being processed and the error handling style is set to the default of
C<die>, B<pod2man> will abort immediately with exit status 255.
=head1 DIAGNOSTICS
If B<pod2man> fails with errors, see L<Pod::Man> and L<Pod::Simple> for
information about what those errors might mean.
=head1 EXAMPLES
pod2man program > program.1
pod2man SomeModule.pm /usr/perl/man/man3/SomeModule.3
pod2man --section=7 note.pod > note.7
If you would like to print out a lot of man page continuously, you probably
want to set the C and D registers to set contiguous page numbering and
even/odd paging, at least on some versions of man(7).
troff -man -rC1 -rD1 perl.1 perldata.1 perlsyn.1 ...
To get index entries on C<STDERR>, turn on the F register, as in:
troff -man -rF1 perl.1
The indexing merely outputs messages via C<.tm> for each major page,
section, subsection, item, and any C<XE<lt>E<gt>> directives. See
L<Pod::Man> for more details.
=head1 BUGS
Lots of this documentation is duplicated from L<Pod::Man>.
=head1 SEE ALSO
L<Pod::Man>, L<Pod::Simple>, L<man(1)>, L<nroff(1)>, L<perlpod(1)>,
L<podchecker(1)>, L<perlpodstyle(1)>, L<troff(1)>, L<man(7)>
The man page documenting the an macro set may be L<man(5)> instead of
L<man(7)> on your system.
The current version of this script is always available from its web site at
L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=head1 AUTHOR
Russ Allbery <rra@cpan.org>, based I<very> heavily on the original
B<pod2man> by Larry Wall and Tom Christiansen.
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2000, 2001, 2004, 2006, 2008, 2010, 2012, 2013, 2014,
2015, 2016 Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
__END__
:endofperl

340
msys/mingw/bin/pod2text.bat Normal file
View file

@ -0,0 +1,340 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
# pod2text -- Convert POD data to formatted ASCII text.
#
# Copyright 1999, 2000, 2001, 2004, 2006, 2008, 2010, 2012, 2013, 2014, 2015,
# 2016 Russ Allbery <rra@cpan.org>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# The driver script for Pod::Text, Pod::Text::Termcap, and Pod::Text::Color,
# invoked by perldoc -t among other things.
use 5.006;
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use Pod::Text ();
use Pod::Usage qw(pod2usage);
# Clean up $0 for error reporting.
$0 =~ s%.*/%%;
# Take an initial pass through our options, looking for one of the form
# -<number>. We turn that into -w <number> for compatibility with the
# original pod2text script.
for (my $i = 0; $i < @ARGV; $i++) {
last if $ARGV[$i] =~ /^--$/;
if ($ARGV[$i] =~ /^-(\d+)$/) {
splice (@ARGV, $i++, 1, '-w', $1);
}
}
# Insert -- into @ARGV before any single dash argument to hide it from
# Getopt::Long; we want to interpret it as meaning stdin (which Pod::Simple
# does correctly).
my $stdin;
@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
# Parse our options. Use the same names as Pod::Text for simplicity, and
# default to sentence boundaries turned off for compatibility.
my %options;
$options{sentence} = 0;
Getopt::Long::config ('bundling');
GetOptions (\%options, 'alt|a', 'code', 'color|c', 'errors=s', 'help|h',
'indent|i=i', 'loose|l', 'margin|left-margin|m=i', 'nourls',
'overstrike|o', 'quotes|q=s', 'sentence|s', 'stderr', 'termcap|t',
'utf8|u', 'width|w=i')
or exit 1;
pod2usage (1) if $options{help};
# Figure out what formatter we're going to use. -c overrides -t.
my $formatter = 'Pod::Text';
if ($options{color}) {
$formatter = 'Pod::Text::Color';
eval { require Term::ANSIColor };
if ($@) { die "-c (--color) requires Term::ANSIColor be installed\n" }
require Pod::Text::Color;
} elsif ($options{termcap}) {
$formatter = 'Pod::Text::Termcap';
require Pod::Text::Termcap;
} elsif ($options{overstrike}) {
$formatter = 'Pod::Text::Overstrike';
require Pod::Text::Overstrike;
}
delete @options{'color', 'termcap', 'overstrike'};
# If neither stderr nor errors is set, default to errors = die.
if (!defined $options{stderr} && !defined $options{errors}) {
$options{errors} = 'die';
}
# Initialize and run the formatter.
my $parser = $formatter->new (%options);
my $status = 0;
do {
my ($input, $output) = splice (@ARGV, 0, 2);
$parser->parse_from_file ($input, $output);
if ($parser->{CONTENTLESS}) {
$status = 1;
warn "$0: unable to format $input\n";
if (defined ($output) and $output ne '-') {
unlink $output unless (-s $output);
}
}
} while (@ARGV);
exit $status;
__END__
=for stopwords
-aclostu --alt --stderr Allbery --overstrike overstrike --termcap --utf8
UTF-8 subclasses --nourls
=head1 NAME
pod2text - Convert POD data to formatted ASCII text
=head1 SYNOPSIS
pod2text [B<-aclostu>] [B<--code>] [B<--errors>=I<style>] [B<-i> I<indent>]
S<[B<-q> I<quotes>]> [B<--nourls>] [B<--stderr>] S<[B<-w> I<width>]>
[I<input> [I<output> ...]]
pod2text B<-h>
=head1 DESCRIPTION
B<pod2text> is a front-end for Pod::Text and its subclasses. It uses them
to generate formatted ASCII text from POD source. It can optionally use
either termcap sequences or ANSI color escape sequences to format the text.
I<input> is the file to read for POD source (the POD can be embedded in
code). If I<input> isn't given, it defaults to C<STDIN>. I<output>, if
given, is the file to which to write the formatted output. If I<output>
isn't given, the formatted output is written to C<STDOUT>. Several POD
files can be processed in the same B<pod2text> invocation (saving module
load and compile times) by providing multiple pairs of I<input> and
I<output> files on the command line.
=head1 OPTIONS
=over 4
=item B<-a>, B<--alt>
Use an alternate output format that, among other things, uses a different
heading style and marks C<=item> entries with a colon in the left margin.
=item B<--code>
Include any non-POD text from the input file in the output as well. Useful
for viewing code documented with POD blocks with the POD rendered and the
code left intact.
=item B<-c>, B<--color>
Format the output with ANSI color escape sequences. Using this option
requires that Term::ANSIColor be installed on your system.
=item B<--errors>=I<style>
Set the error handling style. C<die> says to throw an exception on any
POD formatting error. C<stderr> says to report errors on standard error,
but not to throw an exception. C<pod> says to include a POD ERRORS
section in the resulting documentation summarizing the errors. C<none>
ignores POD errors entirely, as much as possible.
The default is C<die>.
=item B<-i> I<indent>, B<--indent=>I<indent>
Set the number of spaces to indent regular text, and the default indentation
for C<=over> blocks. Defaults to 4 spaces if this option isn't given.
=item B<-h>, B<--help>
Print out usage information and exit.
=item B<-l>, B<--loose>
Print a blank line after a C<=head1> heading. Normally, no blank line is
printed after C<=head1>, although one is still printed after C<=head2>,
because this is the expected formatting for manual pages; if you're
formatting arbitrary text documents, using this option is recommended.
=item B<-m> I<width>, B<--left-margin>=I<width>, B<--margin>=I<width>
The width of the left margin in spaces. Defaults to 0. This is the margin
for all text, including headings, not the amount by which regular text is
indented; for the latter, see B<-i> option.
=item B<--nourls>
Normally, LZ<><> formatting codes with a URL but anchor text are formatted
to show both the anchor text and the URL. In other words:
L<foo|http://example.com/>
is formatted as:
foo <http://example.com/>
This flag, if given, suppresses the URL when anchor text is given, so this
example would be formatted as just C<foo>. This can produce less
cluttered output in cases where the URLs are not particularly important.
=item B<-o>, B<--overstrike>
Format the output with overstrike printing. Bold text is rendered as
character, backspace, character. Italics and file names are rendered as
underscore, backspace, character. Many pagers, such as B<less>, know how
to convert this to bold or underlined text.
=item B<-q> I<quotes>, B<--quotes>=I<quotes>
Sets the quote marks used to surround CE<lt>> text to I<quotes>. If
I<quotes> is a single character, it is used as both the left and right
quote. Otherwise, it is split in half, and the first half of the string
is used as the left quote and the second is used as the right quote.
I<quotes> may also be set to the special value C<none>, in which case no
quote marks are added around CE<lt>> text.
=item B<-s>, B<--sentence>
Assume each sentence ends with two spaces and try to preserve that spacing.
Without this option, all consecutive whitespace in non-verbatim paragraphs
is compressed into a single space.
=item B<--stderr>
By default, B<pod2text> dies if any errors are detected in the POD input.
If B<--stderr> is given and no B<--errors> flag is present, errors are
sent to standard error, but B<pod2text> does not abort. This is
equivalent to C<--errors=stderr> and is supported for backward
compatibility.
=item B<-t>, B<--termcap>
Try to determine the width of the screen and the bold and underline
sequences for the terminal from termcap, and use that information in
formatting the output. Output will be wrapped at two columns less than the
width of your terminal device. Using this option requires that your system
have a termcap file somewhere where Term::Cap can find it and requires that
your system support termios. With this option, the output of B<pod2text>
will contain terminal control sequences for your current terminal type.
=item B<-u>, B<--utf8>
By default, B<pod2text> tries to use the same output encoding as its input
encoding (to be backward-compatible with older versions). This option
says to instead force the output encoding to UTF-8.
Be aware that, when using this option, the input encoding of your POD
source should be properly declared unless it's US-ASCII. Pod::Simple
will attempt to guess the encoding and may be successful if it's
Latin-1 or UTF-8, but it will warn, which by default results in a
B<pod2text> failure. Use the C<=encoding> command to declare the
encoding. See L<perlpod(1)> for more information.
=item B<-w>, B<--width=>I<width>, B<->I<width>
The column at which to wrap text on the right-hand side. Defaults to 76,
unless B<-t> is given, in which case it's two columns less than the width of
your terminal device.
=back
=head1 EXIT STATUS
As long as all documents processed result in some output, even if that
output includes errata (a C<POD ERRORS> section generated with
C<--errors=pod>), B<pod2text> will exit with status 0. If any of the
documents being processed do not result in an output document, B<pod2text>
will exit with status 1. If there are syntax errors in a POD document
being processed and the error handling style is set to the default of
C<die>, B<pod2text> will abort immediately with exit status 255.
=head1 DIAGNOSTICS
If B<pod2text> fails with errors, see L<Pod::Text> and L<Pod::Simple> for
information about what those errors might mean. Internally, it can also
produce the following diagnostics:
=over 4
=item -c (--color) requires Term::ANSIColor be installed
(F) B<-c> or B<--color> were given, but Term::ANSIColor could not be
loaded.
=item Unknown option: %s
(F) An unknown command line option was given.
=back
In addition, other L<Getopt::Long> error messages may result from invalid
command-line options.
=head1 ENVIRONMENT
=over 4
=item COLUMNS
If B<-t> is given, B<pod2text> will take the current width of your screen
from this environment variable, if available. It overrides terminal width
information in TERMCAP.
=item TERMCAP
If B<-t> is given, B<pod2text> will use the contents of this environment
variable if available to determine the correct formatting sequences for your
current terminal device.
=back
=head1 SEE ALSO
L<Pod::Text>, L<Pod::Text::Color>, L<Pod::Text::Overstrike>,
L<Pod::Text::Termcap>, L<Pod::Simple>, L<perlpod(1)>
The current version of this script is always available from its web site at
L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the
Perl core distribution as of 5.6.0.
=head1 AUTHOR
Russ Allbery <rra@cpan.org>.
=head1 COPYRIGHT AND LICENSE
Copyright 1999, 2000, 2001, 2004, 2006, 2008, 2010, 2012, 2013, 2014, 2015,
2016 Russ Allbery <rra@cpan.org>
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
=cut
__END__
:endofperl

View file

@ -0,0 +1,176 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec perl -S $0 "$@"'
if 0;
#############################################################################
# pod2usage -- command to print usage messages from embedded pod docs
#
# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
# Copyright (c) 2001-2016 by Marek Rouchal.
# This file is part of "Pod-Usage". Pod-Usage is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
use strict;
#use diagnostics;
=head1 NAME
pod2usage - print usage messages from embedded pod docs in files
=head1 SYNOPSIS
=over 12
=item B<pod2usage>
[B<-help>]
[B<-man>]
[B<-exit>S< >I<exitval>]
[B<-output>S< >I<outfile>]
[B<-verbose> I<level>]
[B<-pathlist> I<dirlist>]
[B<-formatter> I<module>]
[B<-utf8>]
I<file>
=back
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-help>
Print a brief help message and exit.
=item B<-man>
Print this command's manual page and exit.
=item B<-exit> I<exitval>
The exit status value to return.
=item B<-output> I<outfile>
The output file to print to. If the special names "-" or ">&1" or ">&STDOUT"
are used then standard output is used. If ">&2" or ">&STDERR" is used then
standard error is used.
=item B<-verbose> I<level>
The desired level of verbosity to use:
1 : print SYNOPSIS only
2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections
3 : print the entire manpage (similar to running pod2text)
=item B<-pathlist> I<dirlist>
Specifies one or more directories to search for the input file if it
was not supplied with an absolute path. Each directory path in the given
list should be separated by a ':' on Unix (';' on MSWin32 and DOS).
=item B<-formatter> I<module>
Which text formatter to use. Default is L<Pod::Text>, or for very old
Perl versions L<Pod::PlainText>. An alternative would be e.g.
L<Pod::Text::Termcap>.
=item B<-utf8>
This option assumes that the formatter (see above) understands the option
"utf8". It turns on generation of utf8 output.
=item I<file>
The pathname of a file containing pod documentation to be output in
usage message format (defaults to standard input).
=back
=head1 DESCRIPTION
B<pod2usage> will read the given input file looking for pod
documentation and will print the corresponding usage message.
If no input file is specified then standard input is read.
B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage>
module. Please see L<Pod::Usage/pod2usage()>.
=head1 SEE ALSO
L<Pod::Usage>, L<pod2text(1)>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp@enteract.comE<gt>
Based on code for B<pod2text(1)> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
=cut
use Getopt::Long;
## Define options
my %options = ();
my @opt_specs = (
'help',
'man',
'exit=i',
'output=s',
'pathlist=s',
'formatter=s',
'verbose=i',
'utf8!'
);
## Parse options
GetOptions(\%options, @opt_specs) || pod2usage(2);
$Pod::Usage::Formatter = $options{formatter} if $options{formatter};
require Pod::Usage;
Pod::Usage->import();
pod2usage(1) if ($options{help});
pod2usage(VERBOSE => 2) if ($options{man});
## Dont default to STDIN if connected to a terminal
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
@ARGV = ('-') unless (@ARGV);
if (@ARGV > 1) {
print STDERR "pod2usage: Too many filenames given\n\n";
pod2usage(2);
}
my %usage = ();
$usage{-input} = shift(@ARGV);
$usage{-exitval} = $options{'exit'} if (defined $options{'exit'});
$usage{-output} = $options{'output'} if (defined $options{'output'});
$usage{-verbose} = $options{'verbose'} if (defined $options{'verbose'});
$usage{-pathlist} = $options{'pathlist'} if (defined $options{'pathlist'});
$usage{-utf8} = $options{'utf8'} if (defined $options{'utf8'});
pod2usage(\%usage);
__END__
:endofperl

49
msys/mingw/bin/pod_cover Normal file
View file

@ -0,0 +1,49 @@
#!/usr/bin/perl -w
# Run this to get a coverage analysis of the embedded documentation
use Pod::Coverage;
use lib 'lib'; # to test distribution inside './lib'
use strict;
print "Pod coverage analysis v1.00 (C) by Tels 2001.\n";
print "Using Pod::Coverage v$Pod::Coverage::VERSION\n\n";
print scalar localtime()," Starting analysis:\n\n";
my $covered = 0; my $uncovered; my $count = 0; my $c;
open FILE, 'MANIFEST' or die "Can't read MANIFEST: $!";
while (<FILE>)
{
chomp;
my ($file) = split /[\s\t]/,$_;
next unless $file =~ /^lib.*\.pm$/;
$file =~ s/^lib\///; # remove lib and .pm
$file =~ s/\.pm$//;
$file =~ s/\//::/g; # / => ::
my $rc = Pod::Coverage->new( package => $file );
$covered += $rc->covered();
$uncovered += $rc->uncovered();
$count ++;
$c = $rc->coverage() || 0;
$c = int($c * 10000)/100;
print "$file has a doc coverage of $c%.\n";
my @naked = $rc->naked();
if (@naked > 0)
{
print "Uncovered routines are:\n";
print " ",join("\n ",sort @naked),"\n"; # sort by name
# could sort by line_num
}
print "\n";
}
my $total = $covered+$uncovered;
my $average = 'unknown';
$average = int(10000*$covered/$total)/100 if $total > 0;
print "Summary:\n";
print " sub routines total : $total\n";
print " sub routines covered : $covered\n";
print " sub routines uncovered: $uncovered\n";
print " total coverage : $average%\n\n";

View file

@ -0,0 +1,65 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 15
# Run this to get a coverage analysis of the embedded documentation
use Pod::Coverage;
use lib 'lib'; # to test distribution inside './lib'
use strict;
print "Pod coverage analysis v1.00 (C) by Tels 2001.\n";
print "Using Pod::Coverage v$Pod::Coverage::VERSION\n\n";
print scalar localtime()," Starting analysis:\n\n";
my $covered = 0; my $uncovered; my $count = 0; my $c;
open FILE, 'MANIFEST' or die "Can't read MANIFEST: $!";
while (<FILE>)
{
chomp;
my ($file) = split /[\s\t]/,$_;
next unless $file =~ /^lib.*\.pm$/;
$file =~ s/^lib\///; # remove lib and .pm
$file =~ s/\.pm$//;
$file =~ s/\//::/g; # / => ::
my $rc = Pod::Coverage->new( package => $file );
$covered += $rc->covered();
$uncovered += $rc->uncovered();
$count ++;
$c = $rc->coverage() || 0;
$c = int($c * 10000)/100;
print "$file has a doc coverage of $c%.\n";
my @naked = $rc->naked();
if (@naked > 0)
{
print "Uncovered routines are:\n";
print " ",join("\n ",sort @naked),"\n"; # sort by name
# could sort by line_num
}
print "\n";
}
my $total = $covered+$uncovered;
my $average = 'unknown';
$average = int(10000*$covered/$total)/100 if $total > 0;
print "Summary:\n";
print " sub routines total : $total\n";
print " sub routines covered : $covered\n";
print " sub routines uncovered: $uncovered\n";
print " total coverage : $average%\n\n";
__END__
:endofperl

View file

@ -0,0 +1,161 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec perl -S $0 "$@"'
if 0;
#############################################################################
# podchecker -- command to invoke the podchecker function in Pod::Checker
#
# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
use strict;
#use diagnostics;
=head1 NAME
podchecker - check the syntax of POD format documentation files
=head1 SYNOPSIS
B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-help>
Print a brief help message and exit.
=item B<-man>
Print the manual page and exit.
=item B<-warnings> B<-nowarnings>
Turn on/off printing of warnings. Repeating B<-warnings> increases the
warning level, i.e. more warnings are printed. Currently increasing to
level two causes flagging of unescaped "E<lt>,E<gt>" characters.
=item I<file>
The pathname of a POD file to syntax-check (defaults to standard input).
=back
=head1 DESCRIPTION
B<podchecker> will read the given input files looking for POD
syntax errors in the POD documentation and will print any errors
it find to STDERR. At the end, it will print a status message
indicating the number of errors found.
Directories are ignored, an appropriate warning message is printed.
B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
Please see L<Pod::Checker/podchecker()> for more details.
=head1 RETURN VALUE
B<podchecker> returns a 0 (zero) exit status if all specified
POD files are ok.
=head1 ERRORS
B<podchecker> returns the exit status 1 if at least one of
the given POD files has syntax errors.
The status 2 indicates that at least one of the specified
files does not contain I<any> POD commands.
Status 1 overrides status 2. If you want unambiguous
results, call B<podchecker> with one single argument only.
=head1 SEE ALSO
L<Pod::Parser> and L<Pod::Checker>
=head1 AUTHORS
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp@enteract.comE<gt>,
Marek Rouchal E<lt>marekr@cpan.orgE<gt>
Based on code for B<Pod::Text::pod2text(1)> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
=cut
use Pod::Checker;
use Pod::Usage;
use Getopt::Long;
## Define options
my %options;
## Parse options
GetOptions(\%options, qw(help man warnings+ nowarnings)) || pod2usage(2);
pod2usage(1) if ($options{help});
pod2usage(-verbose => 2) if ($options{man});
if($options{nowarnings}) {
$options{warnings} = 0;
}
elsif(!defined $options{warnings}) {
$options{warnings} = 1; # default is warnings on
}
## Dont default to STDIN if connected to a terminal
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
## Invoke podchecker()
my $status = 0;
@ARGV = qw(-) unless(@ARGV);
for my $podfile (@ARGV) {
if($podfile eq '-') {
$podfile = '<&STDIN';
}
elsif(-d $podfile) {
warn "podchecker: Warning: Ignoring directory '$podfile'\n";
next;
}
my $errors =
podchecker($podfile, undef, '-warnings' => $options{warnings});
if($errors > 0) {
# errors occurred
$status = 1;
printf STDERR ("%s has %d pod syntax %s.\n",
$podfile, $errors,
($errors == 1) ? 'error' : 'errors');
}
elsif($errors < 0) {
# no pod found
$status = 2 unless($status);
print STDERR "$podfile does not contain any pod commands.\n";
}
else {
print STDERR "$podfile pod syntax OK.\n";
}
}
exit $status;
__END__
:endofperl

View file

@ -0,0 +1,120 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec perl -S $0 "$@"'
if 0;
#############################################################################
# podselect -- command to invoke the podselect function in Pod::Select
#
# Copyright (c) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
use strict;
#use diagnostics;
=head1 NAME
podselect - print selected sections of pod documentation on standard output
=head1 SYNOPSIS
B<podselect> [B<-help>] [B<-man>] [B<-section>S< >I<section-spec>]
[I<file>S< >...]
=head1 OPTIONS AND ARGUMENTS
=over 8
=item B<-help>
Print a brief help message and exit.
=item B<-man>
Print the manual page and exit.
=item B<-section>S< >I<section-spec>
Specify a section to include in the output.
See L<Pod::Parser/"SECTION SPECIFICATIONS">
for the format to use for I<section-spec>.
This option may be given multiple times on the command line.
=item I<file>
The pathname of a file from which to select sections of pod
documentation (defaults to standard input).
=back
=head1 DESCRIPTION
B<podselect> will read the given input files looking for pod
documentation and will print out (in raw pod format) all sections that
match one ore more of the given section specifications. If no section
specifications are given than all pod sections encountered are output.
B<podselect> invokes the B<podselect()> function exported by B<Pod::Select>
Please see L<Pod::Select/podselect()> for more details.
=head1 SEE ALSO
L<Pod::Parser> and L<Pod::Select>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp@enteract.comE<gt>
Based on code for B<Pod::Text::pod2text(1)> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
=cut
use Pod::Select;
use Pod::Usage;
use Getopt::Long;
## Define options
my %options = (
'help' => 0,
'man' => 0,
'sections' => [],
);
## Parse options
GetOptions(\%options, 'help', 'man', 'sections|select=s@') || pod2usage(2);
pod2usage(1) if ($options{help});
pod2usage(-verbose => 2) if ($options{man});
## Dont default to STDIN if connected to a terminal
pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
## Invoke podselect().
if (@{ $options{'sections'} } > 0) {
podselect({ -sections => $options{'sections'} }, @ARGV);
}
else {
podselect(@ARGV);
}
__END__
:endofperl

424
msys/mingw/bin/prove.bat Normal file
View file

@ -0,0 +1,424 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl -w
use strict;
use warnings;
use App::Prove;
my $app = App::Prove->new;
$app->process_args(@ARGV);
exit( $app->run ? 0 : 1 );
__END__
=head1 NAME
prove - Run tests through a TAP harness.
=head1 USAGE
prove [options] [files or directories]
=head1 OPTIONS
Boolean options:
-v, --verbose Print all test lines.
-l, --lib Add 'lib' to the path for your tests (-Ilib).
-b, --blib Add 'blib/lib' and 'blib/arch' to the path for
your tests
-s, --shuffle Run the tests in random order.
-c, --color Colored test output (default).
--nocolor Do not color test output.
--count Show the X/Y test count when not verbose
(default)
--nocount Disable the X/Y test count.
-D --dry Dry run. Show test that would have run.
-f, --failures Show failed tests.
-o, --comments Show comments.
--ignore-exit Ignore exit status from test scripts.
-m, --merge Merge test scripts' STDERR with their STDOUT.
-r, --recurse Recursively descend into directories.
--reverse Run the tests in reverse order.
-q, --quiet Suppress some test output while running tests.
-Q, --QUIET Only print summary results.
-p, --parse Show full list of TAP parse errors, if any.
--directives Only show results with TODO or SKIP directives.
--timer Print elapsed time after each test.
--trap Trap Ctrl-C and print summary on interrupt.
--normalize Normalize TAP output in verbose output
-T Enable tainting checks.
-t Enable tainting warnings.
-W Enable fatal warnings.
-w Enable warnings.
-h, --help Display this help
-?, Display this help
-V, --version Display the version
-H, --man Longer manpage for prove
--norc Don't process default .proverc
Options that take arguments:
-I Library paths to include.
-P Load plugin (searches App::Prove::Plugin::*.)
-M Load a module.
-e, --exec Interpreter to run the tests ('' for compiled
tests.)
--ext Set the extension for tests (default '.t')
--harness Define test harness to use. See TAP::Harness.
--formatter Result formatter to use. See FORMATTERS.
--source Load and/or configure a SourceHandler. See
SOURCE HANDLERS.
-a, --archive out.tgz Store the resulting TAP in an archive file.
-j, --jobs N Run N test jobs in parallel (try 9.)
--state=opts Control prove's persistent state.
--rc=rcfile Process options from rcfile
--rules Rules for parallel vs sequential processing.
=head1 NOTES
=head2 .proverc
If F<~/.proverc> or F<./.proverc> exist they will be read and any
options they contain processed before the command line options. Options
in F<.proverc> are specified in the same way as command line options:
# .proverc
--state=hot,fast,save
-j9
Additional option files may be specified with the C<--rc> option.
Default option file processing is disabled by the C<--norc> option.
Under Windows and VMS the option file is named F<_proverc> rather than
F<.proverc> and is sought only in the current directory.
=head2 Reading from C<STDIN>
If you have a list of tests (or URLs, or anything else you want to test) in a
file, you can add them to your tests by using a '-':
prove - < my_list_of_things_to_test.txt
See the C<README> in the C<examples> directory of this distribution.
=head2 Default Test Directory
If no files or directories are supplied, C<prove> looks for all files
matching the pattern C<t/*.t>.
=head2 Colored Test Output
Colored test output using L<TAP::Formatter::Color> is the default, but
if output is not to a terminal, color is disabled. You can override this by
adding the C<--color> switch.
Color support requires L<Term::ANSIColor> on Unix-like platforms and
L<Win32::Console> on windows. If the necessary module is not installed
colored output will not be available.
=head2 Exit Code
If the tests fail C<prove> will exit with non-zero status.
=head2 Arguments to Tests
It is possible to supply arguments to tests. To do so separate them from
prove's own arguments with the arisdottle, '::'. For example
prove -v t/mytest.t :: --url http://example.com
would run F<t/mytest.t> with the options '--url http://example.com'.
When running multiple tests they will each receive the same arguments.
=head2 C<--exec>
Normally you can just pass a list of Perl tests and the harness will know how
to execute them. However, if your tests are not written in Perl or if you
want all tests invoked exactly the same way, use the C<-e>, or C<--exec>
switch:
prove --exec '/usr/bin/ruby -w' t/
prove --exec '/usr/bin/perl -Tw -mstrict -Ilib' t/
prove --exec '/path/to/my/customer/exec'
=head2 C<--merge>
If you need to make sure your diagnostics are displayed in the correct
order relative to test results you can use the C<--merge> option to
merge the test scripts' STDERR into their STDOUT.
This guarantees that STDOUT (where the test results appear) and STDERR
(where the diagnostics appear) will stay in sync. The harness will
display any diagnostics your tests emit on STDERR.
Caveat: this is a bit of a kludge. In particular note that if anything
that appears on STDERR looks like a test result the test harness will
get confused. Use this option only if you understand the consequences
and can live with the risk.
=head2 C<--trap>
The C<--trap> option will attempt to trap SIGINT (Ctrl-C) during a test
run and display the test summary even if the run is interrupted
=head2 C<--state>
You can ask C<prove> to remember the state of previous test runs and
select and/or order the tests to be run based on that saved state.
The C<--state> switch requires an argument which must be a comma
separated list of one or more of the following options.
=over
=item C<last>
Run the same tests as the last time the state was saved. This makes it
possible, for example, to recreate the ordering of a shuffled test.
# Run all tests in random order
$ prove -b --state=save --shuffle
# Run them again in the same order
$ prove -b --state=last
=item C<failed>
Run only the tests that failed on the last run.
# Run all tests
$ prove -b --state=save
# Run failures
$ prove -b --state=failed
If you also specify the C<save> option newly passing tests will be
excluded from subsequent runs.
# Repeat until no more failures
$ prove -b --state=failed,save
=item C<passed>
Run only the passed tests from last time. Useful to make sure that no
new problems have been introduced.
=item C<all>
Run all tests in normal order. Multple options may be specified, so to
run all tests with the failures from last time first:
$ prove -b --state=failed,all,save
=item C<hot>
Run the tests that most recently failed first. The last failure time of
each test is stored. The C<hot> option causes tests to be run in most-recent-
failure order.
$ prove -b --state=hot,save
Tests that have never failed will not be selected. To run all tests with
the most recently failed first use
$ prove -b --state=hot,all,save
This combination of options may also be specified thus
$ prove -b --state=adrian
=item C<todo>
Run any tests with todos.
=item C<slow>
Run the tests in slowest to fastest order. This is useful in conjunction
with the C<-j> parallel testing switch to ensure that your slowest tests
start running first.
$ prove -b --state=slow -j9
=item C<fast>
Run test tests in fastest to slowest order.
=item C<new>
Run the tests in newest to oldest order based on the modification times
of the test scripts.
=item C<old>
Run the tests in oldest to newest order.
=item C<fresh>
Run those test scripts that have been modified since the last test run.
=item C<save>
Save the state on exit. The state is stored in a file called F<.prove>
(F<_prove> on Windows and VMS) in the current directory.
=back
The C<--state> switch may be used more than once.
$ prove -b --state=hot --state=all,save
=head2 --rules
The C<--rules> option is used to control which tests are run sequentially and
which are run in parallel, if the C<--jobs> option is specified. The option may
be specified multiple times, and the order matters.
The most practical use is likely to specify that some tests are not
"parallel-ready". Since mentioning a file with --rules doesn't cause it to
be selected to run as a test, you can "set and forget" some rules preferences in
your .proverc file. Then you'll be able to take maximum advantage of the
performance benefits of parallel testing, while some exceptions are still run
in parallel.
=head3 --rules examples
# All tests are allowed to run in parallel, except those starting with "p"
--rules='seq=t/p*.t' --rules='par=**'
# All tests must run in sequence except those starting with "p", which should be run parallel
--rules='par=t/p*.t'
=head3 --rules resolution
=over 4
=item * By default, all tests are eligible to be run in parallel. Specifying any of your own rules removes this one.
=item * "First match wins". The first rule that matches a test will be the one that applies.
=item * Any test which does not match a rule will be run in sequence at the end of the run.
=item * The existence of a rule does not imply selecting a test. You must still specify the tests to run.
=item * Specifying a rule to allow tests to run in parallel does not make them run in parallel. You still need specify the number of parallel C<jobs> in your Harness object.
=back
=head3 --rules Glob-style pattern matching
We implement our own glob-style pattern matching for --rules. Here are the
supported patterns:
** is any number of characters, including /, within a pathname
* is zero or more characters within a filename/directory name
? is exactly one character within a filename/directory name
{foo,bar,baz} is any of foo, bar or baz.
\ is an escape character
=head3 More advanced specifications for parallel vs sequence run rules
If you need more advanced management of what runs in parallel vs in sequence, see
the associated 'rules' documentation in L<TAP::Harness> and L<TAP::Parser::Scheduler>.
If what's possible directly through C<prove> is not sufficient, you can write your own
harness to access these features directly.
=head2 @INC
prove introduces a separation between "options passed to the perl which
runs prove" and "options passed to the perl which runs tests"; this
distinction is by design. Thus the perl which is running a test starts
with the default C<@INC>. Additional library directories can be added
via the C<PERL5LIB> environment variable, via -Ifoo in C<PERL5OPT> or
via the C<-Ilib> option to F<prove>.
=head2 Taint Mode
Normally when a Perl program is run in taint mode the contents of the
C<PERL5LIB> environment variable do not appear in C<@INC>.
Because C<PERL5LIB> is often used during testing to add build
directories to C<@INC> prove passes the names of any directories found
in C<PERL5LIB> as -I switches. The net effect of this is that
C<PERL5LIB> is honoured even when prove is run in taint mode.
=head1 FORMATTERS
You can load a custom L<TAP::Parser::Formatter>:
prove --formatter MyFormatter
=head1 SOURCE HANDLERS
You can load custom L<TAP::Parser::SourceHandler>s, to change the way the
parser interprets particular I<sources> of TAP.
prove --source MyHandler --source YetAnother t
If you want to provide config to the source you can use:
prove --source MyCustom \
--source Perl --perl-option 'foo=bar baz' --perl-option avg=0.278 \
--source File --file-option extensions=.txt --file-option extensions=.tmp t
--source pgTAP --pgtap-option pset=format=html --pgtap-option pset=border=2
Each C<--$source-option> option must specify a key/value pair separated by an
C<=>. If an option can take multiple values, just specify it multiple times,
as with the C<extensions=> examples above. If the option should be a hash
reference, specify the value as a second pair separated by a C<=>, as in the
C<pset=> examples above (escape C<=> with a backslash).
All C<--sources> are combined into a hash, and passed to L<TAP::Harness/new>'s
C<sources> parameter.
See L<TAP::Parser::IteratorFactory> for more details on how configuration is
passed to I<SourceHandlers>.
=head1 PLUGINS
Plugins can be loaded using the C<< -PI<plugin> >> syntax, eg:
prove -PMyPlugin
This will search for a module named C<App::Prove::Plugin::MyPlugin>, or failing
that, C<MyPlugin>. If the plugin can't be found, C<prove> will complain & exit.
You can pass arguments to your plugin by appending C<=arg1,arg2,etc> to the
plugin name:
prove -PMyPlugin=fou,du,fafa
Please check individual plugin documentation for more details.
=head2 Available Plugins
For an up-to-date list of plugins available, please check CPAN:
L<http://search.cpan.org/search?query=App%3A%3AProve+Plugin>
=head2 Writing Plugins
Please see L<App::Prove/PLUGINS>.
=cut
# vim:ts=4:sw=4:et:sta
__END__
:endofperl

1383
msys/mingw/bin/pstruct.bat Normal file

File diff suppressed because it is too large Load diff

157
msys/mingw/bin/ptar.bat Normal file
View file

@ -0,0 +1,157 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
use strict;
use File::Find;
use Getopt::Std;
use Archive::Tar;
use Data::Dumper;
# Allow historic support for dashless bundled options
# tar cvf file.tar
# is valid (GNU) tar style
@ARGV && $ARGV[0] =~ m/^[DdcvzthxIC]+[fT]?$/ and
unshift @ARGV, map { "-$_" } split m// => shift @ARGV;
my $opts = {};
getopts('Ddcvzthxf:ICT:', $opts) or die usage();
### show the help message ###
die usage() if $opts->{h};
### enable debugging (undocumented feature)
local $Archive::Tar::DEBUG = 1 if $opts->{d};
### enable insecure extracting.
local $Archive::Tar::INSECURE_EXTRACT_MODE = 1 if $opts->{I};
### sanity checks ###
unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
die "You need exactly one of 'x', 't' or 'c' options: " . usage();
}
my $compress = $opts->{z} ? 1 : 0;
my $verbose = $opts->{v} ? 1 : 0;
my $file = $opts->{f} ? $opts->{f} : 'default.tar';
my $tar = Archive::Tar->new();
if( $opts->{c} ) {
my @files;
my @src = @ARGV;
if( $opts->{T} ) {
if( $opts->{T} eq "-" ) {
chomp( @src = <STDIN> );
} elsif( open my $fh, "<", $opts->{T} ) {
chomp( @src = <$fh> );
} else {
die "$0: $opts->{T}: $!\n";
}
}
find( sub { push @files, $File::Find::name;
print $File::Find::name.$/ if $verbose }, @src );
if ($file eq '-') {
use IO::Handle;
$file = IO::Handle->new();
$file->fdopen(fileno(STDOUT),"w");
}
my $tar = Archive::Tar->new;
$tar->add_files(@files);
if( $opts->{C} ) {
for my $f ($tar->get_files) {
$f->mode($f->mode & ~022); # chmod go-w
}
}
$tar->write($file, $compress);
} else {
if ($file eq '-') {
use IO::Handle;
$file = IO::Handle->new();
$file->fdopen(fileno(STDIN),"r");
}
### print the files we're finding?
my $print = $verbose || $opts->{'t'} || 0;
my $iter = Archive::Tar->iter( $file );
while( my $f = $iter->() ) {
print $f->full_path . $/ if $print;
### data dumper output
print Dumper( $f ) if $opts->{'D'};
### extract it
$f->extract if $opts->{'x'};
}
}
### pod & usage in one
sub usage {
my $usage .= << '=cut';
=pod
=head1 NAME
ptar - a tar-like program written in perl
=head1 DESCRIPTION
ptar is a small, tar look-alike program that uses the perl module
Archive::Tar to extract, create and list tar archives.
=head1 SYNOPSIS
ptar -c [-v] [-z] [-C] [-f ARCHIVE_FILE | -] FILE FILE ...
ptar -c [-v] [-z] [-C] [-T index | -] [-f ARCHIVE_FILE | -]
ptar -x [-v] [-z] [-f ARCHIVE_FILE | -]
ptar -t [-z] [-f ARCHIVE_FILE | -]
ptar -h
=head1 OPTIONS
c Create ARCHIVE_FILE or STDOUT (-) from FILE
x Extract from ARCHIVE_FILE or STDIN (-)
t List the contents of ARCHIVE_FILE or STDIN (-)
f Name of the ARCHIVE_FILE to use. Default is './default.tar'
z Read/Write zlib compressed ARCHIVE_FILE (not always available)
v Print filenames as they are added or extracted from ARCHIVE_FILE
h Prints this help message
C CPAN mode - drop 022 from permissions
T get names to create from file
=head1 SEE ALSO
tar(1), L<Archive::Tar>.
=cut
### strip the pod directives
$usage =~ s/=pod\n//g;
$usage =~ s/=head1 //g;
### add some newlines
$usage .= $/.$/;
return $usage;
}
__END__
:endofperl

135
msys/mingw/bin/ptardiff.bat Normal file
View file

@ -0,0 +1,135 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
use strict;
use Archive::Tar;
use Getopt::Std;
my $opts = {};
getopts('h:', $opts) or die usage();
die usages() if $opts->{h};
### need Text::Diff -- give a polite error (not a standard prereq)
unless ( eval { require Text::Diff; Text::Diff->import; 1 } ) {
die "\n\t This tool requires the 'Text::Diff' module to be installed\n";
}
my $arch = shift or die usage();
my $tar = Archive::Tar->new( $arch ) or die "Couldn't read '$arch': $!";
foreach my $file ( $tar->get_files ) {
next unless $file->is_file;
my $prefix = $file->prefix;
my $name = $file->name;
if (defined $prefix) {
$name = File::Spec->catfile($prefix, $name);
}
diff( \($file->get_content), $name,
{ FILENAME_A => $name,
MTIME_A => $file->mtime,
OUTPUT => \*STDOUT
}
);
}
sub usage {
return q[
Usage: ptardiff ARCHIVE_FILE
ptardiff -h
ptardiff is a small program that diffs an extracted archive
against an unextracted one, using the perl module Archive::Tar.
This effectively lets you view changes made to an archives contents.
Provide the progam with an ARCHIVE_FILE and it will look up all
the files with in the archive, scan the current working directory
for a file with the name and diff it against the contents of the
archive.
Options:
h Prints this help message
Sample Usage:
$ tar -xzf Acme-Buffy-1.3.tar.gz
$ vi Acme-Buffy-1.3/README
[...]
$ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
See Also:
tar(1)
ptar
Archive::Tar
] . $/;
}
=head1 NAME
ptardiff - program that diffs an extracted archive against an unextracted one
=head1 DESCRIPTION
ptardiff is a small program that diffs an extracted archive
against an unextracted one, using the perl module Archive::Tar.
This effectively lets you view changes made to an archives contents.
Provide the progam with an ARCHIVE_FILE and it will look up all
the files with in the archive, scan the current working directory
for a file with the name and diff it against the contents of the
archive.
=head1 SYNOPSIS
ptardiff ARCHIVE_FILE
ptardiff -h
$ tar -xzf Acme-Buffy-1.3.tar.gz
$ vi Acme-Buffy-1.3/README
[...]
$ ptardiff Acme-Buffy-1.3.tar.gz > README.patch
=head1 OPTIONS
h Prints this help message
=head1 SEE ALSO
tar(1), L<Archive::Tar>.
=cut
__END__
:endofperl

211
msys/mingw/bin/ptargrep.bat Normal file
View file

@ -0,0 +1,211 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
##############################################################################
# Tool for using regular expressions against the contents of files in a tar
# archive. See 'ptargrep --help' for more documentation.
#
use strict;
use warnings;
use Pod::Usage qw(pod2usage);
use Getopt::Long qw(GetOptions);
use Archive::Tar qw();
use File::Path qw(mkpath);
my(%opt, $pattern);
if(!GetOptions(\%opt,
'basename|b',
'ignore-case|i',
'list-only|l',
'verbose|v',
'help|?',
)) {
pod2usage(-exitval => 1, -verbose => 0);
}
pod2usage(-exitstatus => 0, -verbose => 2) if $opt{help};
pod2usage(-exitval => 1, -verbose => 0,
-message => "No pattern specified",
) unless @ARGV;
make_pattern( shift(@ARGV) );
pod2usage(-exitval => 1, -verbose => 0,
-message => "No tar files specified",
) unless @ARGV;
process_archive($_) foreach @ARGV;
exit 0;
sub make_pattern {
my($pat) = @_;
if($opt{'ignore-case'}) {
$pattern = qr{(?im)$pat};
}
else {
$pattern = qr{(?m)$pat};
}
}
sub process_archive {
my($filename) = @_;
_log("Processing archive: $filename");
my $next = Archive::Tar->iter($filename);
while( my $f = $next->() ) {
next unless $f->is_file;
match_file($f) if $f->size > 0;
}
}
sub match_file {
my($f) = @_;
my $path = $f->name;
my $prefix = $f->prefix;
if (defined $prefix) {
$path = File::Spec->catfile($prefix, $path);
}
_log("filename: %s (%d bytes)", $path, $f->size);
my $body = $f->get_content();
if($body !~ $pattern) {
_log(" no match");
return;
}
if($opt{'list-only'}) {
print $path, "\n";
return;
}
save_file($path, $body);
}
sub save_file {
my($path, $body) = @_;
_log(" found match - extracting");
my($fh);
my($dir, $file) = $path =~ m{\A(?:(.*)/)?([^/]+)\z};
if($dir and not $opt{basename}) {
_log(" writing to $dir/$file");
$dir =~ s{\A/}{./};
mkpath($dir) unless -d $dir;
open $fh, '>', "$dir/$file" or die "open($dir/$file): $!";
}
else {
_log(" writing to ./$file");
open $fh, '>', $file or die "open($file): $!";
}
print $fh $body;
close($fh);
}
sub _log {
return unless $opt{verbose};
my($format, @args) = @_;
warn sprintf($format, @args) . "\n";
}
__END__
=head1 NAME
ptargrep - Apply pattern matching to the contents of files in a tar archive
=head1 SYNOPSIS
ptargrep [options] <pattern> <tar file> ...
Options:
--basename|-b ignore directory paths from archive
--ignore-case|-i do case-insensitive pattern matching
--list-only|-l list matching filenames rather than extracting matches
--verbose|-v write debugging message to STDERR
--help|-? detailed help message
=head1 DESCRIPTION
This utility allows you to apply pattern matching to B<the contents> of files
contained in a tar archive. You might use this to identify all files in an
archive which contain lines matching the specified pattern and either print out
the pathnames or extract the files.
The pattern will be used as a Perl regular expression (as opposed to a simple
grep regex).
Multiple tar archive filenames can be specified - they will each be processed
in turn.
=head1 OPTIONS
=over 4
=item B<--basename> (alias -b)
When matching files are extracted, ignore the directory path from the archive
and write to the current directory using the basename of the file from the
archive. Beware: if two matching files in the archive have the same basename,
the second file extracted will overwrite the first.
=item B<--ignore-case> (alias -i)
Make pattern matching case-insensitive.
=item B<--list-only> (alias -l)
Print the pathname of each matching file from the archive to STDOUT. Without
this option, the default behaviour is to extract each matching file.
=item B<--verbose> (alias -v)
Log debugging info to STDERR.
=item B<--help> (alias -?)
Display this documentation.
=back
=head1 COPYRIGHT
Copyright 2010 Grant McLean E<lt>grantm@cpan.orgE<gt>
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
__END__
:endofperl

View file

@ -0,0 +1,83 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl -w
#line 15
$0 =~ s|\.bat||i;
unless (-f $0) {
$0 =~ s|.*[/\\]||;
for (".", split ';', $ENV{PATH}) {
$_ = "." if $_ eq "";
$0 = "$_/$0" , goto doit if -f "$_/$0";
}
die "'$0' not found.\n";
}
doit: exec "perl", "-x", $0, @ARGV;
die "Failed to exec '$0': $!";
__END__
=head1 NAME
runperl.bat - "universal" batch file to run perl scripts
=head1 SYNOPSIS
C:\> copy runperl.bat foo.bat
C:\> foo
[..runs the perl script 'foo'..]
C:\> foo.bat
[..runs the perl script 'foo'..]
=head1 DESCRIPTION
This file can be copied to any file name ending in the ".bat" suffix.
When executed on a DOS-like operating system, it will invoke the perl
script of the same name, but without the ".bat" suffix. It will
look for the script in the same directory as itself, and then in
the current directory, and then search the directories in your PATH.
It relies on the C<exec()> operator, so you will need to make sure
that works in your perl.
This method of invoking perl scripts has some advantages over
batch-file wrappers like C<pl2bat.bat>: it avoids duplication
of all the code; it ensures C<$0> contains the same name as the
executing file, without any egregious ".bat" suffix; it allows
you to separate your perl scripts from the wrapper used to
run them; since the wrapper is generic, you can use symbolic
links to simply link to C<runperl.bat>, if you are serving your
files on a filesystem that supports that.
On the other hand, if the batch file is invoked with the ".bat"
suffix, it does an extra C<exec()>. This may be a performance
issue. You can avoid this by running it without specifying
the ".bat" suffix.
Perl is invoked with the -x flag, so the script must contain
a C<#!perl> line. Any flags found on that line will be honored.
=head1 BUGS
Perl is invoked with the -S flag, so it will search the PATH to find
the script. This may have undesirable effects.
=head1 SEE ALSO
perl, perlwin32, pl2bat.bat
=cut
__END__
:endofperl

1882
msys/mingw/bin/search.bat Normal file

File diff suppressed because it is too large Load diff

348
msys/mingw/bin/shasum.bat Normal file
View file

@ -0,0 +1,348 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!perl
## shasum: filter for computing SHA digests (ref. sha1sum/md5sum)
##
## Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
##
## Version: 5.95
## Sat Jan 10 12:15:36 MST 2015
## shasum SYNOPSIS adapted from GNU Coreutils sha1sum. Add
## "-a" option for algorithm selection,
## "-U" option for Universal Newlines support,
## "-0" option for reading bit strings, and
## "-p" option for portable digests (to be deprecated).
use strict;
use warnings;
use Fcntl;
use Getopt::Long;
my $POD = <<'END_OF_POD';
=head1 NAME
shasum - Print or Check SHA Checksums
=head1 SYNOPSIS
Usage: shasum [OPTION]... [FILE]...
Print or check SHA checksums.
With no FILE, or when FILE is -, read standard input.
-a, --algorithm 1 (default), 224, 256, 384, 512, 512224, 512256
-b, --binary read in binary mode
-c, --check read SHA sums from the FILEs and check them
-t, --text read in text mode (default)
-U, --UNIVERSAL read in Universal Newlines mode
produces same digest on Windows/Unix/Mac
-0, --01 read in BITS mode
ASCII '0' interpreted as 0-bit,
ASCII '1' interpreted as 1-bit,
all other characters ignored
-p, --portable read in portable mode (to be deprecated)
The following two options are useful only when verifying checksums:
-s, --status don't output anything, status code shows success
-w, --warn warn about improperly formatted checksum lines
-h, --help display this help and exit
-v, --version output version information and exit
When verifying SHA-512/224 or SHA-512/256 checksums, indicate the
algorithm explicitly using the -a option, e.g.
shasum -a 512224 -c checksumfile
The sums are computed as described in FIPS PUB 180-4. When checking,
the input should be a former output of this program. The default
mode is to print a line with checksum, a character indicating type
(`*' for binary, ` ' for text, `U' for UNIVERSAL, `^' for BITS, `?'
for portable), and name for each FILE.
Report shasum bugs to mshelor@cpan.org
=head1 DESCRIPTION
Running I<shasum> is often the quickest way to compute SHA message
digests. The user simply feeds data to the script through files or
standard input, and then collects the results from standard output.
The following command shows how to compute digests for typical inputs
such as the NIST test vector "abc":
perl -e "print qq(abc)" | shasum
Or, if you want to use SHA-256 instead of the default SHA-1, simply say:
perl -e "print qq(abc)" | shasum -a 256
Since I<shasum> mimics the behavior of the combined GNU I<sha1sum>,
I<sha224sum>, I<sha256sum>, I<sha384sum>, and I<sha512sum> programs,
you can install this script as a convenient drop-in replacement.
Unlike the GNU programs, I<shasum> encompasses the full SHA standard by
allowing partial-byte inputs. This is accomplished through the BITS
option (I<-0>). The following example computes the SHA-224 digest of
the 7-bit message I<0001100>:
perl -e "print qq(0001100)" | shasum -0 -a 224
=head1 AUTHOR
Copyright (c) 2003-2015 Mark Shelor <mshelor@cpan.org>.
=head1 SEE ALSO
I<shasum> is implemented using the Perl module L<Digest::SHA> or
L<Digest::SHA::PurePerl>.
=cut
END_OF_POD
my $VERSION = "5.95";
sub usage {
my($err, $msg) = @_;
$msg = "" unless defined $msg;
if ($err) {
warn($msg . "Type shasum -h for help\n");
exit($err);
}
my($USAGE) = $POD =~ /SYNOPSIS(.+?)^=/sm;
$USAGE =~ s/^\s*//;
$USAGE =~ s/\s*$//;
$USAGE =~ s/^ //gm;
print $USAGE, "\n";
exit($err);
}
## Sync stdout and stderr by forcing a flush after every write
select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);
## Collect options from command line
my ($alg, $binary, $check, $text, $status, $warn, $help, $version);
my ($portable, $BITS, $reverse, $UNIVERSAL, $versions);
eval { Getopt::Long::Configure ("bundling") };
GetOptions(
'b|binary' => \$binary, 'c|check' => \$check,
't|text' => \$text, 'a|algorithm=i' => \$alg,
's|status' => \$status, 'w|warn' => \$warn,
'h|help' => \$help, 'v|version' => \$version,
'p|portable' => \$portable,
'0|01' => \$BITS,
'R|REVERSE' => \$reverse,
'U|UNIVERSAL' => \$UNIVERSAL,
'V|VERSIONS' => \$versions,
) or usage(1, "");
## Deal with help requests and incorrect uses
usage(0)
if $help;
usage(1, "shasum: Ambiguous file mode\n")
if scalar(grep {defined $_}
($binary, $portable, $text, $BITS, $UNIVERSAL)) > 1;
usage(1, "shasum: --warn option used only when verifying checksums\n")
if $warn && !$check;
usage(1, "shasum: --status option used only when verifying checksums\n")
if $status && !$check;
## Try to use Digest::SHA. If not installed, use the slower
## but functionally equivalent Digest::SHA::PurePerl instead.
## If option -R is invoked, reverse the module preference,
## i.e. try Digest::SHA::PurePerl first, then Digest::SHA.
my @MODS = qw(Digest::SHA Digest::SHA::PurePerl);
@MODS[0, 1] = @MODS[1, 0] if $reverse;
my $module;
for (@MODS) {
my $mod = $_;
if (eval "require $mod") {
$module = $mod;
last;
}
}
die "shasum: Unable to find " . join(" or ", @MODS) . "\n"
unless defined $module;
## Default to SHA-1 unless overridden by command line option
$alg = 1 unless defined $alg;
grep { $_ == $alg } (1, 224, 256, 384, 512, 512224, 512256)
or usage(1, "shasum: Unrecognized algorithm\n");
## Display version information if requested
if ($version) {
print "$VERSION\n";
exit(0);
}
if ($versions) {
print "shasum $VERSION\n";
print "$module ", eval "\$${module}::VERSION", "\n";
print "perl ", defined $^V ? sprintf("%vd", $^V) : $], "\n";
exit(0);
}
## Try to figure out if the OS is DOS-like. If it is,
## default to binary mode when reading files, unless
## explicitly overridden by command line "--text" or
## "--UNIVERSAL" or "--portable" options.
my $isDOSish = ($^O =~ /^(MSWin\d\d|os2|dos|mint|cygwin)$/);
if ($isDOSish) { $binary = 1 unless $text || $UNIVERSAL || $portable }
my $modesym = $binary ? '*' : ($UNIVERSAL ? 'U' :
($BITS ? '^' : ($portable ? '?' : ' ')));
## Read from STDIN (-) if no files listed on command line
@ARGV = ("-") unless @ARGV;
## sumfile($file): computes SHA digest of $file
sub sumfile {
my $file = shift;
my $mode = $binary ? 'b' : ($UNIVERSAL ? 'U' :
($BITS ? '0' : ($portable ? 'p' : '')));
my $digest = eval { $module->new($alg)->addfile($file, $mode) };
if ($@) { warn "shasum: $file: $!\n"; return }
$digest->hexdigest;
}
## %len2alg: maps hex digest length to SHA algorithm
my %len2alg = (40 => 1, 56 => 224, 64 => 256, 96 => 384, 128 => 512);
$len2alg{56} = 512224 if $alg == 512224;
$len2alg{64} = 512256 if $alg == 512256;
## unescape: convert backslashed filename to plain filename
sub unescape {
$_ = shift;
s/\\\\/\0/g;
s/\\n/\n/g;
return if /\\/;
s/\0/\\/g;
return $_;
}
## verify: confirm the digest values in a checksum file
sub verify {
my $checkfile = shift;
my ($err, $fmt_errs, $read_errs, $match_errs) = (0, 0, 0, 0);
my ($num_lines, $num_files) = (0, 0);
my ($bslash, $sum, $fname, $rsp, $digest);
local *FH;
$checkfile eq '-' and open(FH, '< -')
and $checkfile = 'standard input'
or sysopen(FH, $checkfile, O_RDONLY)
or die "shasum: $checkfile: $!\n";
while (<FH>) {
next if /^#/; s/\n$//; s/^[ \t]+//; $num_lines++;
$bslash = s/^\\//;
($sum, $modesym, $fname) =
/^([\da-fA-F]+)[ \t]([ *?^U])([^\0]*)/;
$alg = defined $sum ? $len2alg{length($sum)} : undef;
$fname = unescape($fname) if defined $fname && $bslash;
if (grep { ! defined $_ } ($alg, $sum, $modesym, $fname)) {
$alg = 1 unless defined $alg;
warn("shasum: $checkfile: $.: improperly " .
"formatted SHA$alg checksum line\n") if $warn;
$fmt_errs++;
next;
}
$fname =~ s/\r$// unless -e $fname;
$rsp = "$fname: "; $num_files++;
($binary, $text, $UNIVERSAL, $BITS, $portable) =
map { $_ eq $modesym } ('*', ' ', 'U', '^', 'p');
unless ($digest = sumfile($fname)) {
$rsp .= "FAILED open or read\n";
$err = 1; $read_errs++;
}
else {
if (lc($sum) eq $digest) { $rsp .= "OK\n" }
else { $rsp .= "FAILED\n"; $err = 1; $match_errs++ }
}
print $rsp unless $status;
}
close(FH);
unless ($num_files) {
$alg = 1 unless defined $alg;
warn("shasum: $checkfile: no properly formatted " .
"SHA$alg checksum lines found\n");
$err = 1;
}
elsif (! $status) {
warn("shasum: WARNING: $fmt_errs line" . ($fmt_errs>1?
's are':' is') . " improperly formatted\n") if $fmt_errs;
warn("shasum: WARNING: $read_errs listed file" .
($read_errs>1?'s':'') . " could not be read\n") if $read_errs;
warn("shasum: WARNING: $match_errs computed checksum" .
($match_errs>1?'s':'') . " did NOT match\n") if $match_errs;
}
return($err == 0);
}
## Verify or compute SHA checksums of requested files
my($file, $digest);
my $STATUS = 0;
for $file (@ARGV) {
if ($check) { $STATUS = 1 unless verify($file) }
elsif ($digest = sumfile($file)) {
if ($file =~ /[\n\\]/) {
$file =~ s/\\/\\\\/g; $file =~ s/\n/\\n/g;
$digest = "\\$digest";
}
print "$digest $modesym", "$file\n";
}
else { $STATUS = 1 }
}
exit($STATUS)
__END__
:endofperl

722
msys/mingw/bin/splain.bat Normal file
View file

@ -0,0 +1,722 @@
@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.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!perl
#line 15
eval 'exec C:\perl-5.24.0\bin\perl.exe -S $0 ${1+"$@"}'
if $running_under_some_shell;
=head1 NAME
diagnostics, splain - produce verbose warning diagnostics
=head1 SYNOPSIS
Using the C<diagnostics> pragma:
use diagnostics;
use diagnostics -verbose;
enable diagnostics;
disable diagnostics;
Using the C<splain> standalone filter program:
perl program 2>diag.out
splain [-v] [-p] diag.out
Using diagnostics to get stack traces from a misbehaving script:
perl -Mdiagnostics=-traceonly my_script.pl
=head1 DESCRIPTION
=head2 The C<diagnostics> Pragma
This module extends the terse diagnostics normally emitted by both the
perl compiler and the perl interpreter (from running perl with a -w
switch or C<use warnings>), augmenting them with the more
explicative and endearing descriptions found in L<perldiag>. Like the
other pragmata, it affects the compilation phase of your program rather
than merely the execution phase.
To use in your program as a pragma, merely invoke
use diagnostics;
at the start (or near the start) of your program. (Note
that this I<does> enable perl's B<-w> flag.) Your whole
compilation will then be subject(ed :-) to the enhanced diagnostics.
These still go out B<STDERR>.
Due to the interaction between runtime and compiletime issues,
and because it's probably not a very good idea anyway,
you may not use C<no diagnostics> to turn them off at compiletime.
However, you may control their behaviour at runtime using the
disable() and enable() methods to turn them off and on respectively.
The B<-verbose> flag first prints out the L<perldiag> introduction before
any other diagnostics. The $diagnostics::PRETTY variable can generate nicer
escape sequences for pagers.
Warnings dispatched from perl itself (or more accurately, those that match
descriptions found in L<perldiag>) are only displayed once (no duplicate
descriptions). User code generated warnings a la warn() are unaffected,
allowing duplicate user messages to be displayed.
This module also adds a stack trace to the error message when perl dies.
This is useful for pinpointing what
caused the death. The B<-traceonly> (or
just B<-t>) flag turns off the explanations of warning messages leaving just
the stack traces. So if your script is dieing, run it again with
perl -Mdiagnostics=-traceonly my_bad_script
to see the call stack at the time of death. By supplying the B<-warntrace>
(or just B<-w>) flag, any warnings emitted will also come with a stack
trace.
=head2 The I<splain> Program
While apparently a whole nuther program, I<splain> is actually nothing
more than a link to the (executable) F<diagnostics.pm> module, as well as
a link to the F<diagnostics.pod> documentation. The B<-v> flag is like
the C<use diagnostics -verbose> directive.
The B<-p> flag is like the
$diagnostics::PRETTY variable. Since you're post-processing with
I<splain>, there's no sense in being able to enable() or disable() processing.
Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
=head1 EXAMPLES
The following file is certain to trigger a few errors at both
runtime and compiletime:
use diagnostics;
print NOWHERE "nothing\n";
print STDERR "\n\tThis message should be unadorned.\n";
warn "\tThis is a user warning";
print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
my $a, $b = scalar <STDIN>;
print "\n";
print $x/$y;
If you prefer to run your program first and look at its problem
afterwards, do this:
perl -w test.pl 2>test.out
./splain < test.out
Note that this is not in general possible in shells of more dubious heritage,
as the theoretical
(perl -w test.pl >/dev/tty) >& test.out
./splain < test.out
Because you just moved the existing B<stdout> to somewhere else.
If you don't want to modify your source code, but still have on-the-fly
warnings, do this:
exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&-
Nifty, eh?
If you want to control warnings on the fly, do something like this.
Make sure you do the C<use> first, or you won't be able to get
at the enable() or disable() methods.
use diagnostics; # checks entire compilation phase
print "\ntime for 1st bogus diags: SQUAWKINGS\n";
print BOGUS1 'nada';
print "done with 1st bogus\n";
disable diagnostics; # only turns off runtime warnings
print "\ntime for 2nd bogus: (squelched)\n";
print BOGUS2 'nada';
print "done with 2nd bogus\n";
enable diagnostics; # turns back on runtime warnings
print "\ntime for 3rd bogus: SQUAWKINGS\n";
print BOGUS3 'nada';
print "done with 3rd bogus\n";
disable diagnostics;
print "\ntime for 4th bogus: (squelched)\n";
print BOGUS4 'nada';
print "done with 4th bogus\n";
=head1 INTERNALS
Diagnostic messages derive from the F<perldiag.pod> file when available at
runtime. Otherwise, they may be embedded in the file itself when the
splain package is built. See the F<Makefile> for details.
If an extant $SIG{__WARN__} handler is discovered, it will continue
to be honored, but only after the diagnostics::splainthis() function
(the module's $SIG{__WARN__} interceptor) has had its way with your
warnings.
There is a $diagnostics::DEBUG variable you may set if you're desperately
curious what sorts of things are being intercepted.
BEGIN { $diagnostics::DEBUG = 1 }
=head1 BUGS
Not being able to say "no diagnostics" is annoying, but may not be
insurmountable.
The C<-pretty> directive is called too late to affect matters.
You have to do this instead, and I<before> you load the module.
BEGIN { $diagnostics::PRETTY = 1 }
I could start up faster by delaying compilation until it should be
needed, but this gets a "panic: top_level" when using the pragma form
in Perl 5.001e.
While it's true that this documentation is somewhat subserious, if you use
a program named I<splain>, you should expect a bit of whimsy.
=head1 AUTHOR
Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
=cut
use strict;
use 5.009001;
use Carp;
$Carp::Internal{__PACKAGE__.""}++;
our $VERSION = '1.34';
our $DEBUG;
our $VERBOSE;
our $PRETTY;
our $TRACEONLY = 0;
our $WARNTRACE = 0;
use Config;
use Text::Tabs 'expand';
my $privlib = $Config{privlibexp};
if ($^O eq 'VMS') {
require VMS::Filespec;
$privlib = VMS::Filespec::unixify($privlib);
}
my @trypod = (
"$privlib/pod/perldiag.pod",
"$privlib/pods/perldiag.pod",
);
# handy for development testing of new warnings etc
unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
(my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
$DEBUG ||= 0;
local $| = 1;
local $_;
local $.;
my $standalone;
my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);
CONFIG: {
our $opt_p = our $opt_d = our $opt_v = our $opt_f = '';
unless (caller) {
$standalone++;
require Getopt::Std;
Getopt::Std::getopts('pdvf:')
or die "Usage: $0 [-v] [-p] [-f splainpod]";
$PODFILE = $opt_f if $opt_f;
$DEBUG = 2 if $opt_d;
$VERBOSE = $opt_v;
$PRETTY = $opt_p;
}
if (open(POD_DIAG, $PODFILE)) {
warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
last CONFIG;
}
if (caller) {
INCPATH: {
for my $file ( (map { "$_/".__PACKAGE__.".pm" } @INC), $0) {
warn "Checking $file\n" if $DEBUG;
if (open(POD_DIAG, $file)) {
while (<POD_DIAG>) {
next unless
/^__END__\s*# wish diag dbase were more accessible/;
print STDERR "podfile is $file\n" if $DEBUG;
last INCPATH;
}
}
}
}
} else {
print STDERR "podfile is <DATA>\n" if $DEBUG;
*POD_DIAG = *main::DATA;
}
}
if (eof(POD_DIAG)) {
die "couldn't find diagnostic data in $PODFILE @INC $0";
}
%HTML_2_Troff = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
"Aacute" => "A\\*'", # capital A, acute accent
# etc
);
%HTML_2_Latin_1 = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
"Aacute" => "\xC1" # capital A, acute accent
# etc
);
%HTML_2_ASCII_7 = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
"Aacute" => "A" # capital A, acute accent
# etc
);
our %HTML_Escapes;
*HTML_Escapes = do {
if ($standalone) {
$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7;
} else {
\%HTML_2_Latin_1;
}
};
*THITHER = $standalone ? *STDOUT : *STDERR;
my %transfmt = ();
my $transmo = <<EOFUNC;
sub transmo {
#local \$^W = 0; # recursive warnings we do NOT need!
EOFUNC
my %msg;
{
print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
local $/ = '';
local $_;
my $header;
my @headers;
my $for_item;
my $seen_body;
while (<POD_DIAG>) {
sub _split_pod_link {
$_[0] =~ m'(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?'s;
($1,$2,$4);
}
unescape();
if ($PRETTY) {
sub noop { return $_[0] } # spensive for a noop
sub bold { my $str =$_[0]; $str =~ s/(.)/$1\b$1/g; return $str; }
sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g; return $str; }
s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/bold($+)/ges;
s/[IF]<(.*?)>/italic($1)/ges;
s/L<(.*?)>/
my($text,$page,$sect) = _split_pod_link($1);
defined $text
? $text
: defined $sect
? italic($sect) . ' in ' . italic($page)
: italic($page)
/ges;
s/S<(.*?)>/
$1
/ges;
} else {
s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/gs;
s/[IF]<(.*?)>/$1/gs;
s/L<(.*?)>/
my($text,$page,$sect) = _split_pod_link($1);
defined $text
? $text
: defined $sect
? qq '"$sect" in $page'
: $page
/ges;
s/S<(.*?)>/
$1
/ges;
}
unless (/^=/) {
if (defined $header) {
if ( $header eq 'DESCRIPTION' &&
( /Optional warnings are enabled/
|| /Some of these messages are generic./
) )
{
next;
}
$_ = expand $_;
s/^/ /gm;
$msg{$header} .= $_;
for my $h(@headers) { $msg{$h} .= $_ }
++$seen_body;
undef $for_item;
}
next;
}
# If we have not come across the body of the description yet, then
# the previous header needs to share the same description.
if ($seen_body) {
@headers = ();
}
else {
push @headers, $header if defined $header;
}
unless ( s/=item (.*?)\s*\z//s) {
if ( s/=head1\sDESCRIPTION//) {
$msg{$header = 'DESCRIPTION'} = '';
undef $for_item;
}
elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) {
$for_item = $1;
}
elsif( /^=back/ ) { # Stop processing body here
undef $header;
undef $for_item;
$seen_body = 0;
next;
}
next;
}
if( $for_item ) { $header = $for_item; undef $for_item }
else {
$header = $1;
$header =~ s/\n/ /gs; # Allow multi-line headers
}
# strip formatting directives from =item line
$header =~ s/[A-Z]<(.*?)>/$1/g;
# Since we strip "(\.\s*)\n" when we search a warning, strip it here as well
$header =~ s/(\.\s*)?$//;
my @toks = split( /(%l?[dxX]|%[ucp]|%(?:\.\d+)?[fs])/, $header );
if (@toks > 1) {
my $conlen = 0;
for my $i (0..$#toks){
if( $i % 2 ){
if( $toks[$i] eq '%c' ){
$toks[$i] = '.';
} elsif( $toks[$i] =~ /^%(?:d|u)$/ ){
$toks[$i] = '\d+';
} elsif( $toks[$i] =~ '^%(?:s|.*f)$' ){
$toks[$i] = $i == $#toks ? '.*' : '.*?';
} elsif( $toks[$i] =~ '%.(\d+)s' ){
$toks[$i] = ".{$1}";
} elsif( $toks[$i] =~ '^%l*([pxX])$' ){
$toks[$i] = $1 eq 'X' ? '[\dA-F]+' : '[\da-f]+';
}
} elsif( length( $toks[$i] ) ){
$toks[$i] = quotemeta $toks[$i];
$conlen += length( $toks[$i] );
}
}
my $lhs = join( '', @toks );
$lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
$transfmt{$header}{pat} =
" s^\\s*$lhs\\s*\Q$header\Es\n\t&& return 1;\n";
$transfmt{$header}{len} = $conlen;
} else {
my $lhs = "\Q$header\E";
$lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
$transfmt{$header}{pat} =
" s^\\s*$lhs\\s*\Q$header\E\n\t && return 1;\n";
$transfmt{$header}{len} = length( $header );
}
print STDERR __PACKAGE__.": Duplicate entry: \"$header\"\n"
if $msg{$header};
$msg{$header} = '';
$seen_body = 0;
}
close POD_DIAG unless *main::DATA eq *POD_DIAG;
die "No diagnostics?" unless %msg;
# Apply patterns in order of decreasing sum of lengths of fixed parts
# Seems the best way of hitting the right one.
for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} }
keys %transfmt ){
$transmo .= $transfmt{$hdr}{pat};
}
$transmo .= " return 0;\n}\n";
print STDERR $transmo if $DEBUG;
eval $transmo;
die $@ if $@;
}
if ($standalone) {
if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" }
while (defined (my $error = <>)) {
splainthis($error) || print THITHER $error;
}
exit;
}
my $olddie;
my $oldwarn;
sub import {
shift;
$^W = 1; # yup, clobbered the global variable;
# tough, if you want diags, you want diags.
return if defined $SIG{__WARN__} && ($SIG{__WARN__} eq \&warn_trap);
for (@_) {
/^-d(ebug)?$/ && do {
$DEBUG++;
next;
};
/^-v(erbose)?$/ && do {
$VERBOSE++;
next;
};
/^-p(retty)?$/ && do {
print STDERR "$0: I'm afraid it's too late for prettiness.\n";
$PRETTY++;
next;
};
# matches trace and traceonly for legacy doc mixup reasons
/^-t(race(only)?)?$/ && do {
$TRACEONLY++;
next;
};
/^-w(arntrace)?$/ && do {
$WARNTRACE++;
next;
};
warn "Unknown flag: $_";
}
$oldwarn = $SIG{__WARN__};
$olddie = $SIG{__DIE__};
$SIG{__WARN__} = \&warn_trap;
$SIG{__DIE__} = \&death_trap;
}
sub enable { &import }
sub disable {
shift;
return unless $SIG{__WARN__} eq \&warn_trap;
$SIG{__WARN__} = $oldwarn || '';
$SIG{__DIE__} = $olddie || '';
}
sub warn_trap {
my $warning = $_[0];
if (caller eq __PACKAGE__ or !splainthis($warning)) {
if ($WARNTRACE) {
print STDERR Carp::longmess($warning);
} else {
print STDERR $warning;
}
}
goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
};
sub death_trap {
my $exception = $_[0];
# See if we are coming from anywhere within an eval. If so we don't
# want to explain the exception because it's going to get caught.
my $in_eval = 0;
my $i = 0;
while (my $caller = (caller($i++))[3]) {
if ($caller eq '(eval)') {
$in_eval = 1;
last;
}
}
splainthis($exception) unless $in_eval;
if (caller eq __PACKAGE__) {
print STDERR "INTERNAL EXCEPTION: $exception";
}
&$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
return if $in_eval;
# We don't want to unset these if we're coming from an eval because
# then we've turned off diagnostics.
# Switch off our die/warn handlers so we don't wind up in our own
# traps.
$SIG{__DIE__} = $SIG{__WARN__} = '';
$exception =~ s/\n(?=.)/\n\t/gas;
die Carp::longmess("__diagnostics__")
=~ s/^__diagnostics__.*?line \d+\.?\n/
"Uncaught exception from user code:\n\t$exception"
/re;
# up we go; where we stop, nobody knows, but i think we die now
# but i'm deeply afraid of the &$olddie guy reraising and us getting
# into an indirect recursion loop
};
my %exact_duplicate;
my %old_diag;
my $count;
my $wantspace;
sub splainthis {
return 0 if $TRACEONLY;
for (my $tmp = shift) {
local $\;
local $!;
### &finish_compilation unless %msg;
s/(\.\s*)?\n+$//;
my $orig = $_;
# return unless defined;
# get rid of the where-are-we-in-input part
s/, <.*?> (?:line|chunk).*$//;
# Discard 1st " at <file> line <no>" and all text beyond
# but be aware of messages containing " at this-or-that"
my $real = 0;
my @secs = split( / at / );
return unless @secs;
$_ = $secs[0];
for my $i ( 1..$#secs ){
if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){
$real = 1;
last;
} else {
$_ .= ' at ' . $secs[$i];
}
}
# remove parenthesis occurring at the end of some messages
s/^\((.*)\)$/$1/;
if ($exact_duplicate{$orig}++) {
return &transmo;
} else {
return 0 unless &transmo;
}
my $short = shorten($orig);
if ($old_diag{$_}) {
autodescribe();
print THITHER "$short (#$old_diag{$_})\n";
$wantspace = 1;
} elsif (!$msg{$_} && $orig =~ /\n./s) {
# A multiline message, like "Attempt to reload /
# Compilation failed"
my $found;
for (split /^/, $orig) {
splainthis($_) and $found = 1;
}
return $found;
} else {
autodescribe();
$old_diag{$_} = ++$count;
print THITHER "\n" if $wantspace;
$wantspace = 0;
print THITHER "$short (#$old_diag{$_})\n";
if ($msg{$_}) {
print THITHER $msg{$_};
} else {
if (0 and $standalone) {
print THITHER " **** Error #$old_diag{$_} ",
($real ? "is" : "appears to be"),
" an unknown diagnostic message.\n\n";
}
return 0;
}
}
return 1;
}
}
sub autodescribe {
if ($VERBOSE and not $count) {
print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
"\n$msg{DESCRIPTION}\n";
}
}
sub unescape {
s {
E<
( [A-Za-z]+ )
>
} {
do {
exists $HTML_Escapes{$1}
? do { $HTML_Escapes{$1} }
: do {
warn "Unknown escape: E<$1> in $_";
"E<$1>";
}
}
}egx;
}
sub shorten {
my $line = $_[0];
if (length($line) > 79 and index($line, "\n") == -1) {
my $space_place = rindex($line, ' ', 79);
if ($space_place != -1) {
substr($line, $space_place, 1) = "\n\t";
}
}
return $line;
}
1 unless $standalone; # or it'll complain about itself
__END__ # wish diag dbase were more accessible
__END__
:endofperl

View file

@ -0,0 +1,7 @@
startupdir = $(datadir)/startup
startup_DATA = startup.mk config.mk
DIST_SUBDIRS = unix winnt
SUBDIRS = @OS_TYPE@

View file

@ -0,0 +1,492 @@
# Makefile.in generated by automake 1.9.6 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
VPATH = @srcdir@
pkgdatadir = $(datadir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
top_builddir = ..
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
INSTALL = @INSTALL@
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
LIBOBJDIR =
subdir = startup
DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \
$(srcdir)/config.mk.in
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
$(top_srcdir)/configure.in
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
CONFIG_HEADER = $(top_builddir)/config.h
CONFIG_CLEAN_FILES = config.mk
SOURCES =
DIST_SOURCES =
RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \
html-recursive info-recursive install-data-recursive \
install-exec-recursive install-info-recursive \
install-recursive installcheck-recursive installdirs-recursive \
pdf-recursive ps-recursive uninstall-info-recursive \
uninstall-recursive
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = `echo $$p | sed -e 's|^.*/||'`;
am__installdirs = "$(DESTDIR)$(startupdir)"
startupDATA_INSTALL = $(INSTALL_DATA)
DATA = $(startup_DATA)
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMDEP_FALSE = @AMDEP_FALSE@
AMDEP_TRUE = @AMDEP_TRUE@
AMTAR = @AMTAR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DBUG_FALSE = @DBUG_FALSE@
DBUG_TRUE = @DBUG_TRUE@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DMAKEROOT_H_LINE1 = @DMAKEROOT_H_LINE1@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
GREP = @GREP@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAINTAINER_MODE_FALSE = @MAINTAINER_MODE_FALSE@
MAINTAINER_MODE_TRUE = @MAINTAINER_MODE_TRUE@
MAKEINFO = @MAKEINFO@
OBJEXT = @OBJEXT@
OSTYPEUNIX_FALSE = @OSTYPEUNIX_FALSE@
OSTYPEUNIX_TRUE = @OSTYPEUNIX_TRUE@
OSTYPEWIN32_FALSE = @OSTYPEWIN32_FALSE@
OSTYPEWIN32_TRUE = @OSTYPEWIN32_TRUE@
OS_TYPE = @OS_TYPE@
OS_VERSION = @OS_VERSION@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
ac_ct_CC = @ac_ct_CC@
am__fastdepCC_FALSE = @am__fastdepCC_FALSE@
am__fastdepCC_TRUE = @am__fastdepCC_TRUE@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host_alias = @host_alias@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
startupdir = $(datadir)/startup
startup_DATA = startup.mk config.mk
DIST_SUBDIRS = unix winnt
SUBDIRS = @OS_TYPE@
all: all-recursive
.SUFFIXES:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \
&& exit 0; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign startup/Makefile'; \
cd $(top_srcdir) && \
$(AUTOMAKE) --foreign startup/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
config.mk: $(top_builddir)/config.status $(srcdir)/config.mk.in
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@
uninstall-info-am:
install-startupDATA: $(startup_DATA)
@$(NORMAL_INSTALL)
test -z "$(startupdir)" || $(mkdir_p) "$(DESTDIR)$(startupdir)"
@list='$(startup_DATA)'; for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
f=$(am__strip_dir) \
echo " $(startupDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(startupdir)/$$f'"; \
$(startupDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(startupdir)/$$f"; \
done
uninstall-startupDATA:
@$(NORMAL_UNINSTALL)
@list='$(startup_DATA)'; for p in $$list; do \
f=$(am__strip_dir) \
echo " rm -f '$(DESTDIR)$(startupdir)/$$f'"; \
rm -f "$(DESTDIR)$(startupdir)/$$f"; \
done
# This directory's subdirectories are mostly independent; you can cd
# into them and run `make' without going through this Makefile.
# To change the values of `make' variables: instead of editing Makefiles,
# (1) if the variable is set in `config.status', edit `config.status'
# (which will cause the Makefiles to be regenerated when you run `make');
# (2) otherwise, pass the desired values on the `make' command line.
$(RECURSIVE_TARGETS):
@failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
*k*) failcom='fail=yes';; \
esac; \
done; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
list='$(SUBDIRS)'; for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
(cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
mostlyclean-recursive clean-recursive distclean-recursive \
maintainer-clean-recursive:
@failcom='exit 1'; \
for f in x $$MAKEFLAGS; do \
case $$f in \
*=* | --[!k]*);; \
*k*) failcom='fail=yes';; \
esac; \
done; \
dot_seen=no; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
rev=''; for subdir in $$list; do \
if test "$$subdir" = "."; then :; else \
rev="$$subdir $$rev"; \
fi; \
done; \
rev="$$rev ."; \
target=`echo $@ | sed s/-recursive//`; \
for subdir in $$rev; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
(cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done && test -z "$$fail"
tags-recursive:
list='$(SUBDIRS)'; for subdir in $$list; do \
test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
done
ctags-recursive:
list='$(SUBDIRS)'; for subdir in $$list; do \
test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) ctags); \
done
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) ' { files[$$0] = 1; } \
END { for (i in files) print i; }'`; \
mkid -fID $$unique
tags: TAGS
TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
tags=; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
tags="$$tags $$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) ' { files[$$0] = 1; } \
END { for (i in files) print i; }'`; \
if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$tags $$unique; \
fi
ctags: CTAGS
CTAGS: ctags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
$(TAGS_FILES) $(LISP)
tags=; \
here=`pwd`; \
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | \
$(AWK) ' { files[$$0] = 1; } \
END { for (i in files) print i; }'`; \
test -z "$(CTAGS_ARGS)$$tags$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$tags $$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& cd $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) $$here
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \
list='$(DISTFILES)'; for file in $$list; do \
case $$file in \
$(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \
$(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \
esac; \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \
if test "$$dir" != "$$file" && test "$$dir" != "."; then \
dir="/$$dir"; \
$(mkdir_p) "$(distdir)$$dir"; \
else \
dir=''; \
fi; \
if test -d $$d/$$file; then \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
fi; \
cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
else \
test -f $(distdir)/$$file \
|| cp -p $$d/$$file $(distdir)/$$file \
|| exit 1; \
fi; \
done
list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test -d "$(distdir)/$$subdir" \
|| $(mkdir_p) "$(distdir)/$$subdir" \
|| exit 1; \
distdir=`$(am__cd) $(distdir) && pwd`; \
top_distdir=`$(am__cd) $(top_distdir) && pwd`; \
(cd $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$top_distdir" \
distdir="$$distdir/$$subdir" \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile $(DATA)
installdirs: installdirs-recursive
installdirs-am:
for dir in "$(DESTDIR)$(startupdir)"; do \
test -z "$$dir" || $(mkdir_p) "$$dir"; \
done
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
`test -z '$(STRIP)' || \
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-generic distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
info: info-recursive
info-am:
install-data-am: install-startupDATA
install-exec-am:
install-info: install-info-recursive
install-man:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-generic
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am: uninstall-info-am uninstall-startupDATA
uninstall-info: uninstall-info-recursive
.PHONY: $(RECURSIVE_TARGETS) CTAGS GTAGS all all-am check check-am \
clean clean-generic clean-recursive ctags ctags-recursive \
distclean distclean-generic distclean-recursive distclean-tags \
distdir dvi dvi-am html html-am info info-am install \
install-am install-data install-data-am install-exec \
install-exec-am install-info install-info-am install-man \
install-startupDATA install-strip installcheck installcheck-am \
installdirs installdirs-am maintainer-clean \
maintainer-clean-generic maintainer-clean-recursive \
mostlyclean mostlyclean-generic mostlyclean-recursive pdf \
pdf-am ps ps-am tags tags-recursive uninstall uninstall-am \
uninstall-info-am uninstall-startupDATA
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

View file

@ -0,0 +1,13 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= winnt
OSRELEASE *:= mingw
# Comment out the above and uncomment the following instead for a configuration
# that works for Microsoft Visual C++:
# OS *:= win95
# OSRELEASE *:= microsft
# OSENVIRONMENT *:= vpp40

View file

@ -0,0 +1,5 @@
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
OS := @OS_TYPE@
OSRELEASE := @OS_VERSION@
#OSENVIRONMENT := ???

View file

@ -0,0 +1,41 @@
# Define MPW MAC specific macros.
# Assumes CodeWarrior for Mac 5.0 C, change as needed.
#
A *:= .lib
S *:= .s
V *:= v
TMPDIR *:= $(TempFolder)
# import library definitions
.IMPORT .IGNORE : CLibraries Libraries
# Set arguments for the SHELL. Since we can't execute sub-processes,
# these variables are not important, except for some makefiles that check
# for some values to determine the platform.
SHELL *:= "{MPW}MPW Shell"
SHELLFLAGS *:=
GROUPFLAGS *:=
SHELLMETAS *:=
# Define toolkit macros
CC *:= MWCPPC
AS *:= PPCAsm
LD *:= MWLinkPPC
AR *:=
ARFLAGS *:=
RM *:= delete
RMFLAGS *:=
MV *:= rename
YTAB *:=
LEXYY *:=
LDLIBS *= "{SharedLibraries}StdCLib" "{SharedLibraries}InterfaceLib" \
"{PPCLibraries}StdCRuntime.o" "{PPCLibraries}PPCCRuntime.o" \
"{Libraries}MathLib.o" "{PPCLibraries}PPCToolLibs.o"
# Disable the print command
PRINT *=
# Make certain to disable defining how to make executables.
__.EXECS !:=

View file

@ -0,0 +1,4 @@
# MSDOS Borland-C customization.
# Standard C-language command names and flags
CC *:= bcc # C compiler

View file

@ -0,0 +1,4 @@
# MSDOS Borland-C customization.
# Standard C-language command names and flags
CC *:= bcc # C compiler

View file

@ -0,0 +1,4 @@
# MSDOS Borland-C customization.
# Standard C-language command names and flags
CC *:= bcc # C compiler

View file

@ -0,0 +1,4 @@
# MSDOS Borland-C customization.
# Standard C-language command names and flags
CC *:= bcc # C compiler

View file

@ -0,0 +1,4 @@
# MSDOS Borland-C customization.
# Standard C-language command names and flags
CC *:= bcc # C compiler

View file

@ -0,0 +1,33 @@
# MSDOS Borland-C environment customization.
.IF $(OSENVIRONMENT)
.INCLUDE .IGNORE .NOINFER : $(INCFILENAME:d)$(OSENVIRONMENT)$/macros.mk
.ENDIF
# Standard C-language command names and flags
CPP *:= # C-preprocessor
CFLAGS *= # C compiler flags
"C++" *:= # C++ Compiler
"C++FLAGS" *= # C++ Compiler flags
AS *:= tasm # Assembler and flags
ASFLAGS *=
LD *= tlink # Loader and flags
LDFLAGS *=
LDLIBS *= # Default libraries
AR *:= tlib # archiver
ARFLAGS *= ????
# Definition of Print command for this system.
PRINT *= print
# Language and Parser generation Tools and their flags
YACC *:= yacc # standard yacc
YFLAGS *=
LEX *:= lex # standard lex
LFLAGS *=
# Other Compilers, Tools and their flags
PC *:= tpc # pascal compiler
RC *:= ??? # ratfor compiler
FC *:= ??? # fortran compiler

View file

@ -0,0 +1,4 @@
# MSDOS Turbo-C customization.
# Standard C-language command names and flags
CC *:= tcc # C compiler

View file

@ -0,0 +1,62 @@
# Define additional MSDOS specific settings.
#
# Execution environment configuration.
# Grab the current setting of COMSPEC.
#
.IMPORT .IGNORE : COMSPEC ROOTDIR
# First check if SHELL is defined to be something other than COMSPEC.
# If it is, then assume that SHELL is a Korn compatible shell like MKS's
.IF $(SHELL) == $(NULL)
.IF $(COMSPEC) == $(NULL)
SHELL *:= $(ROOTDIR)$/bin$/sh$E
.ELSE
SHELL *:= $(COMSPEC)
.END
.END
GROUPSHELL *:= $(SHELL)
# Process release-specific refinements, if any.
.INCLUDE .NOINFER .IGNORE : $(INCFILENAME:d)$(OSRELEASE)$/macros.mk
# Applicable suffix definitions
A *:= .lib # Libraries
E *:= .exe # Executables
F *:= .for # Fortran
O *:= .obj # Objects
P *:= .pas # Pascal
S *:= .asm # Assembler sources
V *:= # RCS suffix
# Now set the remaining arguments depending on which SHELL we
# are going to use. COMSPEC (assumed to be command.com) or
# MKS Korn shell.
.IF $(SHELL) == $(COMSPEC)
SHELLFLAGS *:= $(SWITCHAR)c
GROUPFLAGS *:= $(SHELLFLAGS)
SHELLMETAS *:= "<>|
GROUPSUFFIX *:= .bat
DIVFILE *= $(TMPFILE:s,/,\,)
RM *= del
RMFLAGS *=
MV *= rename
__.DIVSEP-sh-yes *:= \\
__.DIVSEP-sh-no *:= \\
.ELSE
SHELLFLAGS *:= -c
GROUPFLAGS *:=
SHELLMETAS *:= *";?<>|()&][$$\#`'
GROUPSUFFIX *:= .ksh
.MKSARGS *:= yes
RM *= $(ROOTDIR)$/bin$/rm
RMFLAGS *= -f
MV *= $(ROOTDIR)$/bin$/mv
DIVFILE *= $(TMPFILE:s,/,${__.DIVSEP-sh-${USESHELL}},)
__.DIVSEP-sh-yes *:= \\\
__.DIVSEP-sh-no *:= \\
.ENDIF
# Does not respect case of filenames.
.DIRCACHERESPCASE := no

View file

@ -0,0 +1,34 @@
# MSDOS Microsoft-C environment customization.
.IF $(OSENVIRONMENT)
.INCLUDE .IGNORE .NOINFER : $(INCFILENAME:d)$(OSENVIRONMENT)$/macros.mk
.ENDIF
# Standard C-language command names and flags
CC *:= cl # C compiler
CPP *:= # C-preprocessor
CFLAGS *= # C compiler flags
"C++" *:= # C++ Compiler
"C++FLAGS" *= # C++ Compiler flags
AS *:= masm # Assembler and flags
ASFLAGS *=
LD *= link # Loader and flags
LDFLAGS *=
LDLIBS *= # Default libraries
AR *:= lib # archiver
ARFLAGS *= ????
# Definition of Print command for this system.
PRINT *= print
# Language and Parser generation Tools and their flags
YACC *:= yacc # standard yacc
YFLAGS *=
LEX *:= lex # standard lex
LFLAGS *=
# Other Compilers, Tools and their flags
PC *:= ??? # pascal compiler
RC *:= ??? # ratfor compiler
FC *:= ??? # fortran compiler

View file

@ -0,0 +1,9 @@
# Define additional MSDOS specific build recipes.
#
# Executables
%$E .SWAP : %$O ; $(CC) $(LDFLAGS) -o$@ $< $(LDLIBS)
%$O : %$S ; $(AS) $(ASFLAGS) $(<:s,/,\)
# Process release-specific refinements, if any.
.INCLUDE .NOINFER .IGNORE : $(INCFILENAME:d)$(OSRELEASE)$/recipes.mk

View file

@ -0,0 +1,30 @@
# MSDOS Zortech-C environment customization.
# Standard C-language command names and flags
CC *:= ztc # C compiler
CPP *:= # C-preprocessor
CFLAGS *= # C compiler flags
"C++" *:= # C++ Compiler
"C++FLAGS" *= # C++ Compiler flags
AS *:= masm # Assembler and flags
ASFLAGS *=
LD *= blink # Loader and flags
LDFLAGS *=
LDLIBS *= # Default libraries
AR *:= ???? # archiver
ARFLAGS *= ????
# Definition of Print command for this system.
PRINT *= print
# Language and Parser generation Tools and their flags
YACC *:= yacc # standard yacc
YFLAGS *=
LEX *:= lex # standard lex
LFLAGS *=
# Other Compilers, Tools and their flags
PC *:= ??? # pascal compiler
RC *:= ??? # ratfor compiler
FC *:= ??? # fortran compiler

View file

@ -0,0 +1,30 @@
# OS/2 1.3 and 2.1 specific customization.
# Standard C-language command names and flags
CC *:= icc # C compiler
CPP *:= # C-preprocessor
CFLAGS *= # C compiler flags
"C++" *:= # C++ Compiler
"C++FLAGS" *= # C++ Compiler flags
AS *:= masm # Assembler and flags
ASFLAGS *=
LD *= link386 # Loader and flags
LDFLAGS *=
LDLIBS *= # Default libraries
AR *:= lib # archiver
ARFLAGS *= ????
# Definition of Print command for this system.
PRINT *= print
# Language and Parser generation Tools and their flags
YACC *:= yacc # standard yacc
YFLAGS *=
LEX *:= lex # standard lex
LFLAGS *=
# Other Compilers, Tools and their flags
PC *:= ??? # pascal compiler
RC *:= ??? # ratfor compiler
FC *:= ??? # fortran compiler

View file

@ -0,0 +1,60 @@
# Define additional OS/2 specific macros.
#
# Process release-specific refinements, if any.
.INCLUDE .NOINFER .IGNORE : $(INCFILENAME:d)$(OSRELEASE)$/macros.mk
# Execution environment configuration.
# Grab the current setting of COMSPEC.
#
.IMPORT .IGNORE : COMSPEC ROOTDIR
# First check if SHELL is defined to be something other than COMSPEC.
# If it is assume that SHELL is a Korn compatible shell like MKS's
.IF $(SHELL) == $(NULL)
.IF $(COMSPEC) == $(NULL)
SHELL *:= $(ROOTDIR)$/bin$/sh$E
.ELSE
SHELL *:= $(COMSPEC)
.END
.END
GROUPSHELL *:= $(SHELL)
# Directory entries are case incensitive
.DIRCACHERESPCASE *:= no
# Applicable suffix definitions
A *:= .lib # Libraries
E *:= .exe # Executables
F *:= .for # Fortran
O *:= .obj # Objects
P *:= .pas # Pascal
S *:= .asm # Assembler sources
V *:= # RCS suffix
# Now set the remaining arguments depending on which SHELL we
# are going to use. COMSPEC (assumed to be command.com) or
# MKS Korn shell.
.IF $(SHELL) == $(COMSPEC)
SHELLFLAGS *:= $(SWITCHAR)c
GROUPFLAGS *:= $(SHELLFLAGS)
SHELLMETAS *:= *"?<>
GROUPSUFFIX *:= .bat
DIRSEPSTR *:= \\\
DIVFILE *= $(TMPFILE:s,/,\,)
RM *= del
RMFLAGS *=
MV *= rename
.ELSE
SHELLFLAGS *:= -c
GROUPFLAGS *:=
SHELLMETAS *:= *"?<>|()&][$$\#`'
GROUPSUFFIX *:= .ksh
.MKSARGS *:= yes
RM *= $(ROOTDIR)$/bin$/rm
RMFLAGS *= -f
MV *= $(ROOTDIR)$/bin$/mv
DIVFILE *= $(TMPFILE:s,/,${__.DIVSEP-sh-${USESHELL}},)
__.DIVSEP-sh-yes !:= \\\
__.DIVSEP-sh-no !:= \\
.ENDIF

View file

@ -0,0 +1,11 @@
# QNX Specific macro definitions
#
# Primary suffixes in common use
A *:= .lib # Libraries
# Standard C-language command names and flags
AS *:= # Don't have an assembler
AR *:= wlib # archiver
ARFLAGS *=

View file

@ -0,0 +1,11 @@
# QNX Specific macro definitions
#
# Primary suffixes in common use
A *:= .lib # Libraries
# Standard C-language command names and flags
AS *:= # Don't have an assembler
AR *:= wlib # archiver
ARFLAGS *=

View file

@ -0,0 +1,8 @@
# Define additional QNX specific build recipes.
#
# Recipe to make archive files.
# --Figure out what to do about the librarian--
%$A .GROUP :
$(AR) $(ARFLAGS) $@ $?
$(RM) $(RMFLAGS) $?

View file

@ -0,0 +1,8 @@
# Define additional QNX specific build recipes.
#
# Recipe to make archive files.
# --Figure out what to do about the librarian--
%$A .GROUP :
$(AR) $(ARFLAGS) $@ $?
$(RM) $(RMFLAGS) $?

View file

@ -0,0 +1,211 @@
# This is the root DMAKE startup file.
#
# Definitions common to all environments are given at the root.
# Definitions parameterized at the root have their parameters specified
# in sub-makefiles which are included based on the values of the three
# make variables:
#
# OS - core operating system flavour
# OSRELEASE - specific release of the operating system
# OSENVIRONMENT - software construction environment in use
#
# See the file 'summary', found in this directory for a list of
# environments supported by this release.
# Disable warnings for macros given on the command line but redefined here.
__.silent !:= $(.SILENT) # Preserve user's .SILENT flag
.SILENT !:= yes
# startup.mk configuration parameters, for each, set it to non-null if you wish
# to enable the named facility.
__.HAVE_RCS !:= # yes => RCS is installed.
__.HAVE_SCCS !:= # yes => SCCS is installed.
__.DEFAULTS !:= yes # yes => define default construction rules.
__.EXECS !:= yes # yes => define how to build executables.
# Grab key definitions from the environment
# The variables OS OSRELEASE OSENVIRONMENT were removed from this
# list because of windows. See issue 43254 for details.
.IMPORT .IGNORE : TMPDIR SHELL
# Default DMAKE configuration, if not overriden by environment
.INCLUDE .NOINFER $(!null,$(OS) .IGNORE) : $(INCFILENAME:d)config.mk
# Look for a local defaults configuration
.INCLUDE .NOINFER .IGNORE : $(INCFILENAME:d)local.mk
# Define the directory separator string.
/ *= $(DIRSEPSTR)
# Customize macro definitions based on setings of OS, OSRELEASE and
# OSENVIRONMENT, this must come before the default macro definitions which
# follow.
.INCLUDE .NOINFER .IGNORE : $(INCFILENAME:d)$(OS)$/macros.mk
# ----------------- Default Control Macro definitions -----------------------
# Select appropriate defaults for basic macros
MAKE *= $(MAKECMD) -S $(MFLAGS)
TMPDIR *:= $/tmp
DIVFILE *= $(TMPFILE)
AUGMAKE *:= no
# Recipe execution configuration
SHELL *:= $/bin$/sh
SHELLFLAGS *:= -ce
GROUPSHELL *:= $(SHELL)
GROUPFLAGS *:=
SHELLMETAS *:= |();&<>?*][$$:\\#`'"
GROUPSUFFIX *:=
# Intermediate target removal configuration
RM *:= $/bin$/rm
RMFLAGS *= -f
RMTARGET *= $<
# Default recipe that is used to remove intermediate targets.
.REMOVE :; # $(RM) $(RMFLAGS) $(RMTARGET)
# Check and enable AUGMAKE extensions for SYSV compatibility
.IF $(AUGMAKE)
"@B" != $(@:b)
"@D" != $(@:d)
"@F" != $(@:f)
"*B" != $(*:b)
"*D" != $(*:d)
"*F" != $(*:f)
"<B" != $(<:b)
"<D" != $(<:d)
"<F" != $(<:f)
"?B" != $(?:b)
"?F" != $(?:f)
"?D" != $(?:d)
.ENDIF
# Directory caching configuration.
.DIRCACHE *:= yes
.DIRCACHERESPCASE *:= yes
# Define the special NULL Prerequisite
NULLPRQ *:= __.NULLPRQ
# ---------- Default Construction Macro and Rule definitions --------------
# The construction rules may be customized further in subsequent recipes.mk
# files.
.IF $(__.DEFAULTS)
# Primary suffixes in common use
A *:= .a # Libraries
E *:= # Executables
F *:= .f # Fortran
O *:= .o # Objects
P *:= .p # Pascal
S *:= .s # Assembler sources
V *:= ,v # RCS suffix
YTAB *:= y.tab # name-stem for yacc output files.
LEXYY *:= lex.yy # lex output file
# Standard C-language command names and flags
CPP *:= $/lib$/cpp # C-preprocessor
CC *:= cc # C compiler
CFLAGS *= # C compiler flags
"C++" *:= CC # C++ Compiler
"C++FLAGS" *= # C++ Compiler flags
AS *:= as # Assembler and flags
ASFLAGS *=
LD *= $(CC) # Loader and flags
LDFLAGS *=
LDLIBS *= # Default libraries
AR *:= ar # archiver
ARFLAGS *= -rv
# Definition of Print command for this system.
PRINT *= lp
# Language and Parser generation Tools and their flags
YACC *:= yacc # standard yacc
YFLAGS *=
LEX *:= lex # standard lex
LFLAGS *=
# Other Compilers, Tools and their flags
PC *:= pc # pascal compiler
RC *:= f77 # ratfor compiler
FC *:= f77 # fortran compiler
MV *:= $/bin$/mv # File rename command
# Implicit generation rules for making inferences.
# lex and yacc rules
%.c : %.y %.Y
$(YACC) $(YFLAGS) $<
$(MV) $(YTAB).c $@
%.c : %.l %.L
$(LEX) $(LFLAGS) $<
$(MV) $(LEXYY).c $@
# Rules for making *$O
%$O : %.c ; $(CC) $(CFLAGS) -c $<
%$O : %$P ; $(PC) $(PFLAGS) -c $<
%$O : %$S ; $(AS) $(ASFLAGS) -o $@ $<
%$O : %.cl ; class -c $<
%$O :| %.e %.r %.F %$F
$(FC) $(RFLAGS) $(EFLAGS) $(FFLAGS) -c $<
# Defibe how to build simple executables
.IF $(__.EXECS)
%$E : %$O ; $(CC) $(LDFLAGS) -o $@ $< $(LDLIBS)
.ENDIF
# Recipe to make archive files, defined only if we have
# an archiver defined.
.IF $(AR)
%$A .SWAP .GROUP :
$(AR) $(ARFLAGS) $@ $?
$(RM) $(RMFLAGS) $?
.ENDIF
# RCS support
.IF $(__.HAVE_RCS)
CO *:= co # check out for RCS
COFLAGS !+= -q
% : $$(@:d)RCS$$/$$(@:f)$V
-$(CO) $(COFLAGS) $(null,$(@:d) $@ $(<:d:s/RCS/)$@)
.NOINFER : $$(@:d)RCS$$/$$(@:f)$V
.IF $V
% : %$V
-$(CO) $(COFLAGS) $(null,$(@:d) $@ $(<:d:s/RCS/)$@)
.NOINFER : %$V
.ENDIF
.END
# SCCS support
.IF $(__.HAVE_SCCS)
GET *:= get
GFLAGS !+=
% : "$$(null,$$(@:d) s.$$@ $$(@:d)s.$$(@:f))"
-$(GET) $(GFLAGS) $@
.NOINFER : "$$(null,$$(@:d) s.$$@ $$(@:d)s.$$(@:f))"
.END
# Customize default recipe definitions for OS, OSRELEASE, etc. settings.
.INCLUDE .NOINFER .IGNORE: $(INCFILENAME:d)$(OS)$/recipes.mk
.ENDIF
# Finally, define the default construction strategy
.ROOT .PHONY .NOSTATE .SEQUENTIAL :- .INIT .TARGETS .DONE;
.INIT .DONE .PHONY: $(NULLPRQ);
# Define the NULL Prerequisite as having no recipe.
$(NULLPRQ) .PHONY :;
# Reset warnings back to previous setting.
.SILENT !:= $(__.silent)
# Check for a Local project file, gets parsed before user makefile.
.INCLUDE .IGNORE .NOINFER: "project.mk"

View file

@ -0,0 +1,3 @@
The following is a summary of the supported dmake environments. When you
issue the build command 'dmake tag' where tag is the target environment it
will build one of these by default.

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= xxOSxx
OSRELEASE *:= xxOSRELEASExx
OSENVIRONMENT *:= xxOSENVIRONMENTxx

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= mac
OSRELEASE *:=
OSENVIRONMENT *:=

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= borland
OSENVIRONMENT *:= bcc30

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= borland
OSENVIRONMENT *:= bcc40

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= borland
OSENVIRONMENT *:= bcc45

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= borland
OSENVIRONMENT *:= bcc50

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= borland
OSENVIRONMENT *:= tcc20

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= microsft
OSENVIRONMENT *:= msc51

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= msdos
OSRELEASE *:= microsft
OSENVIRONMENT *:= msc60

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= os2
OSRELEASE *:= ibm
OSENVIRONMENT *:= icc

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= qssl
OSRELEASE *:=
OSENVIRONMENT *:=

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= tos
OSRELEASE *:=
OSENVIRONMENT *:=

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= unix
OSRELEASE *:= 386ix
OSENVIRONMENT *:=

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= unix
OSRELEASE *:= bsd43
OSENVIRONMENT *:=

View file

@ -0,0 +1,7 @@
# ** Default build configuration for dmake.
# ** DO NOT PLACE LOCAL DEFINITIONS INTO THIS FILE IT IS AUTO GENERATED
# ** USE "startup/local.mk" for those.
OS *:= unix
OSRELEASE *:= bsd43
OSENVIRONMENT *:= uw

Some files were not shown because too many files have changed in this diff Show more