This commit is contained in:
Daveo
commit
47aee91ef4
396 changed files with 32003 additions and 0 deletions
BIN
tools/Banker.exe
Normal file
BIN
tools/Banker.exe
Normal file
Binary file not shown.
BIN
tools/MkData.exe
Normal file
BIN
tools/MkData.exe
Normal file
Binary file not shown.
BIN
tools/MkSpeech.exe
Normal file
BIN
tools/MkSpeech.exe
Normal file
Binary file not shown.
505
tools/Perl/bin/GET
Normal file
505
tools/Perl/bin/GET
Normal file
|
|
@ -0,0 +1,505 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-request.PL,v 1.33 1998/08/04 09:18:11 aas Exp $
|
||||
#
|
||||
# Simple user agent using LWP library.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-request, GET, HEAD, POST - Simple WWW user agent
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
|
||||
[-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
|
||||
[-p <proxy-url>] [-o <format>] <url>...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program can be used to send requests to WWW servers and your
|
||||
local file system. The request content for POST, PUT and CHECKIN
|
||||
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 will probably reject the request.
|
||||
|
||||
=item -b <url>
|
||||
|
||||
This URL will be used as the base URL for the URLs that the method is
|
||||
applied to. The base URL only takes effect for relative URLs. If you
|
||||
do not provide this option and the URLs are relative, then they will
|
||||
be treated as files in the local file system.
|
||||
|
||||
=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> it 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 recogniced 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, PUT and CHECKIN. 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 -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 autorization
|
||||
requests that are handled by the library.
|
||||
|
||||
=item -e
|
||||
|
||||
Print response headers. This option is always on for HEAD requests.
|
||||
|
||||
=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.
|
||||
|
||||
=item -v
|
||||
|
||||
Print the version number of the program and quit.
|
||||
|
||||
=item -h
|
||||
|
||||
Print usage message and quit.
|
||||
|
||||
=item -x
|
||||
|
||||
Extra debugging output.
|
||||
|
||||
=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-1997 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 <aas@sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
$progname = $0;
|
||||
$progname =~ s,.*/,,; # use basename only
|
||||
$progname =~ s/\.\w*$//; # strip extension, if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
|
||||
require LWP;
|
||||
require LWP::Debug;
|
||||
require URI::URL;
|
||||
|
||||
use URI::Heuristic qw(uf_url);
|
||||
|
||||
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::opt_C) {
|
||||
return split(':', $main::opt_C, 2);
|
||||
} elsif (-t) {
|
||||
my $netloc = $uri->netloc;
|
||||
print "Enter username for $realm at $netloc: ";
|
||||
my $user = <STDIN>;
|
||||
chomp($user);
|
||||
return (undef, undef) unless length $user;
|
||||
print "Password: ";
|
||||
system("stty -echo");
|
||||
my $password = <STDIN>;
|
||||
system("stty echo");
|
||||
print "\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::Std;
|
||||
|
||||
$opt_a = undef; # content i/o in text(ascii) mode
|
||||
$opt_m = undef; # set method
|
||||
$opt_f = undef; # make request even if method is not in %allowed_methods
|
||||
$opt_b = undef; # base url
|
||||
$opt_t = undef; # timeout
|
||||
$opt_i = undef; # if-modified-since
|
||||
$opt_c = undef; # content type for POST
|
||||
$opt_C = undef; # credidentials for basic authorization
|
||||
|
||||
$opt_u = undef; # display method, URL and headers of request
|
||||
$opt_U = undef; # display request headers also
|
||||
$opt_s = undef; # display status code
|
||||
$opt_S = undef; # display whole chain of status codes
|
||||
$opt_e = undef; # display response headers (default for HEAD)
|
||||
$opt_d = undef; # don't display content
|
||||
|
||||
$opt_h = undef; # print usage
|
||||
$opt_v = undef; # print version
|
||||
|
||||
$opt_x = undef; # extra debugging info
|
||||
$opt_p = undef; # proxy URL
|
||||
$opt_P = undef; # don't load proxy setting from environment
|
||||
|
||||
$opt_o = undef; # output format
|
||||
|
||||
unless (getopts("axhvuUsSedPp:b:t:i:c:C:m:fo:")) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ($opt_v) {
|
||||
require LWP;
|
||||
my $DISTNAME = 'libwww-perl-' . LWP::Version();
|
||||
die <<"EOT";
|
||||
This is lwp-request version $VERSION ($DISTNAME)
|
||||
|
||||
Copyright 1995-1997, 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 $opt_h || !@ARGV;
|
||||
|
||||
LWP::Debug::level('+') if $opt_x;
|
||||
|
||||
# Create the user agent object
|
||||
$ua = new RequestAgent;
|
||||
|
||||
# Load proxy settings from *_proxy environment variables.
|
||||
$ua->env_proxy unless $opt_P;
|
||||
|
||||
$method = uc($opt_m) if defined $opt_m;
|
||||
|
||||
if ($opt_f) {
|
||||
if ($opt_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 ($method eq "HEAD") {
|
||||
$opt_s = 1;
|
||||
$opt_e = 1 unless $opt_d;
|
||||
$opt_d = 1;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
if (defined $opt_i) {
|
||||
if (-e $opt_i) {
|
||||
$time = (stat _)[9];
|
||||
} else {
|
||||
$time = str2time($opt_i);
|
||||
die "$progname: Illegal time syntax for -i option\n"
|
||||
unless defined $time;
|
||||
}
|
||||
$opt_i = time2str($time);
|
||||
}
|
||||
|
||||
$content = undef;
|
||||
if ($allowed_methods{$method} eq "C") {
|
||||
# This request needs some content
|
||||
unless (defined $opt_c) {
|
||||
# set default content type
|
||||
$opt_c = ($method eq "POST") ?
|
||||
"application/x-www-form-urlencoded"
|
||||
: "text/plain";
|
||||
} else {
|
||||
die "$progname: Illegal Content-type format\n"
|
||||
unless $opt_c =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
|
||||
}
|
||||
print "Please enter content ($opt_c) to be ${method}ed:\n"
|
||||
if -t;
|
||||
binmode STDIN unless -t or $opt_a;
|
||||
$content = join("", <STDIN>);
|
||||
} else {
|
||||
die "$progname: Can't set Content-type for $method requests\n"
|
||||
if defined $opt_c;
|
||||
}
|
||||
|
||||
# Set up a request. We will use the same request object for all URLs.
|
||||
$request = new HTTP::Request $method;
|
||||
$request->header('If-Modified-Since', $opt_i) if defined $opt_i;
|
||||
#$request->header('Accept', '*/*');
|
||||
if ($opt_c) { # will always be set for request that wants content
|
||||
$request->header('Content-Type', $opt_c);
|
||||
$request->header('Content-Length', length $content); # Not really needed
|
||||
$request->content($content);
|
||||
}
|
||||
|
||||
|
||||
$errors = 0;
|
||||
|
||||
# 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+:/ || $opt_b) { # is there any scheme specification
|
||||
$url = URI::URL->new($url, $opt_b);
|
||||
} else {
|
||||
$url = uf_url($url);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
$@ =~ s/at\s+\S+\s+line\s\d+//;
|
||||
print STDERR $@;
|
||||
$errors++;
|
||||
next;
|
||||
}
|
||||
|
||||
$ua->proxy($url->scheme, $opt_p) if $opt_p;
|
||||
|
||||
# Send the request and get a response back from the server
|
||||
$request->url($url);
|
||||
$response = $ua->request($request);
|
||||
|
||||
if ($opt_u || $opt_U) {
|
||||
my $url = $response->request->url->as_string;
|
||||
print "$method $url\n";
|
||||
print $response->request->headers_as_string, "\n" if $opt_U;
|
||||
}
|
||||
|
||||
if ($opt_S) {
|
||||
printResponseChain($response);
|
||||
} elsif ($opt_s) {
|
||||
print $response->status_line, "\n";
|
||||
}
|
||||
|
||||
if ($opt_e) {
|
||||
# Display headers
|
||||
print $response->headers_as_string;
|
||||
print "\n"; # separate headers and content
|
||||
}
|
||||
|
||||
if ($response->is_success) {
|
||||
unless ($opt_d) {
|
||||
if ($opt_o &&
|
||||
$response->content_type eq 'text/html') {
|
||||
require HTML::Parse;
|
||||
my $html = HTML::Parse::parse_html($response->content);
|
||||
{
|
||||
$opt_o eq 'ps' && do {
|
||||
require HTML::FormatPS;
|
||||
my $f = new HTML::FormatPS;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'text' && do {
|
||||
require HTML::FormatText;
|
||||
my $f = new HTML::FormatText;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'html' && do {
|
||||
print $html->as_HTML;
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'links' && do {
|
||||
my $base = $response->base;
|
||||
for ( @{ $html->extract_links } ) {
|
||||
my($link, $elem) = @$_;
|
||||
my $tag = uc $elem->tag;
|
||||
$link = new URI::URL $link, $base;
|
||||
print "$tag\t", $link->abs->as_string, "\n";
|
||||
}
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'dump' && do {
|
||||
$html->dump;
|
||||
last;
|
||||
};
|
||||
# It is bad to not notice this before now :-(
|
||||
die "Illegal -o option value ($opt_o)\n";
|
||||
}
|
||||
} else {
|
||||
binmode STDOUT unless $opt_a;
|
||||
print $response->content;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR $response->error_as_HTML unless $opt_d;
|
||||
$errors++;
|
||||
}
|
||||
}
|
||||
|
||||
exit $errors;
|
||||
|
||||
|
||||
sub printResponseChain
|
||||
{
|
||||
my($response) = @_;
|
||||
return unless defined $response;
|
||||
printResponseChain($response->previous);
|
||||
my $method = $response->request->method;
|
||||
my $url = $response->request->url->as_string;
|
||||
my $code = $response->code;
|
||||
print "$method $url --> ", $response->status_line, "\n";
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
||||
-u Display method and URL before any response
|
||||
-U Display request headers (implies -u)
|
||||
-s Display response status code
|
||||
-S Display response status chain
|
||||
-e Display response headers
|
||||
-d Do not display content
|
||||
-o <format> Process HTML content in various ways
|
||||
|
||||
-v Show program version
|
||||
-h Print this message
|
||||
|
||||
-x Extra debugging output
|
||||
EOT
|
||||
}
|
||||
505
tools/Perl/bin/HEAD
Normal file
505
tools/Perl/bin/HEAD
Normal file
|
|
@ -0,0 +1,505 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-request.PL,v 1.33 1998/08/04 09:18:11 aas Exp $
|
||||
#
|
||||
# Simple user agent using LWP library.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-request, GET, HEAD, POST - Simple WWW user agent
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
|
||||
[-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
|
||||
[-p <proxy-url>] [-o <format>] <url>...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program can be used to send requests to WWW servers and your
|
||||
local file system. The request content for POST, PUT and CHECKIN
|
||||
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 will probably reject the request.
|
||||
|
||||
=item -b <url>
|
||||
|
||||
This URL will be used as the base URL for the URLs that the method is
|
||||
applied to. The base URL only takes effect for relative URLs. If you
|
||||
do not provide this option and the URLs are relative, then they will
|
||||
be treated as files in the local file system.
|
||||
|
||||
=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> it 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 recogniced 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, PUT and CHECKIN. 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 -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 autorization
|
||||
requests that are handled by the library.
|
||||
|
||||
=item -e
|
||||
|
||||
Print response headers. This option is always on for HEAD requests.
|
||||
|
||||
=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.
|
||||
|
||||
=item -v
|
||||
|
||||
Print the version number of the program and quit.
|
||||
|
||||
=item -h
|
||||
|
||||
Print usage message and quit.
|
||||
|
||||
=item -x
|
||||
|
||||
Extra debugging output.
|
||||
|
||||
=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-1997 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 <aas@sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
$progname = $0;
|
||||
$progname =~ s,.*/,,; # use basename only
|
||||
$progname =~ s/\.\w*$//; # strip extension, if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
|
||||
require LWP;
|
||||
require LWP::Debug;
|
||||
require URI::URL;
|
||||
|
||||
use URI::Heuristic qw(uf_url);
|
||||
|
||||
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::opt_C) {
|
||||
return split(':', $main::opt_C, 2);
|
||||
} elsif (-t) {
|
||||
my $netloc = $uri->netloc;
|
||||
print "Enter username for $realm at $netloc: ";
|
||||
my $user = <STDIN>;
|
||||
chomp($user);
|
||||
return (undef, undef) unless length $user;
|
||||
print "Password: ";
|
||||
system("stty -echo");
|
||||
my $password = <STDIN>;
|
||||
system("stty echo");
|
||||
print "\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::Std;
|
||||
|
||||
$opt_a = undef; # content i/o in text(ascii) mode
|
||||
$opt_m = undef; # set method
|
||||
$opt_f = undef; # make request even if method is not in %allowed_methods
|
||||
$opt_b = undef; # base url
|
||||
$opt_t = undef; # timeout
|
||||
$opt_i = undef; # if-modified-since
|
||||
$opt_c = undef; # content type for POST
|
||||
$opt_C = undef; # credidentials for basic authorization
|
||||
|
||||
$opt_u = undef; # display method, URL and headers of request
|
||||
$opt_U = undef; # display request headers also
|
||||
$opt_s = undef; # display status code
|
||||
$opt_S = undef; # display whole chain of status codes
|
||||
$opt_e = undef; # display response headers (default for HEAD)
|
||||
$opt_d = undef; # don't display content
|
||||
|
||||
$opt_h = undef; # print usage
|
||||
$opt_v = undef; # print version
|
||||
|
||||
$opt_x = undef; # extra debugging info
|
||||
$opt_p = undef; # proxy URL
|
||||
$opt_P = undef; # don't load proxy setting from environment
|
||||
|
||||
$opt_o = undef; # output format
|
||||
|
||||
unless (getopts("axhvuUsSedPp:b:t:i:c:C:m:fo:")) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ($opt_v) {
|
||||
require LWP;
|
||||
my $DISTNAME = 'libwww-perl-' . LWP::Version();
|
||||
die <<"EOT";
|
||||
This is lwp-request version $VERSION ($DISTNAME)
|
||||
|
||||
Copyright 1995-1997, 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 $opt_h || !@ARGV;
|
||||
|
||||
LWP::Debug::level('+') if $opt_x;
|
||||
|
||||
# Create the user agent object
|
||||
$ua = new RequestAgent;
|
||||
|
||||
# Load proxy settings from *_proxy environment variables.
|
||||
$ua->env_proxy unless $opt_P;
|
||||
|
||||
$method = uc($opt_m) if defined $opt_m;
|
||||
|
||||
if ($opt_f) {
|
||||
if ($opt_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 ($method eq "HEAD") {
|
||||
$opt_s = 1;
|
||||
$opt_e = 1 unless $opt_d;
|
||||
$opt_d = 1;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
if (defined $opt_i) {
|
||||
if (-e $opt_i) {
|
||||
$time = (stat _)[9];
|
||||
} else {
|
||||
$time = str2time($opt_i);
|
||||
die "$progname: Illegal time syntax for -i option\n"
|
||||
unless defined $time;
|
||||
}
|
||||
$opt_i = time2str($time);
|
||||
}
|
||||
|
||||
$content = undef;
|
||||
if ($allowed_methods{$method} eq "C") {
|
||||
# This request needs some content
|
||||
unless (defined $opt_c) {
|
||||
# set default content type
|
||||
$opt_c = ($method eq "POST") ?
|
||||
"application/x-www-form-urlencoded"
|
||||
: "text/plain";
|
||||
} else {
|
||||
die "$progname: Illegal Content-type format\n"
|
||||
unless $opt_c =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
|
||||
}
|
||||
print "Please enter content ($opt_c) to be ${method}ed:\n"
|
||||
if -t;
|
||||
binmode STDIN unless -t or $opt_a;
|
||||
$content = join("", <STDIN>);
|
||||
} else {
|
||||
die "$progname: Can't set Content-type for $method requests\n"
|
||||
if defined $opt_c;
|
||||
}
|
||||
|
||||
# Set up a request. We will use the same request object for all URLs.
|
||||
$request = new HTTP::Request $method;
|
||||
$request->header('If-Modified-Since', $opt_i) if defined $opt_i;
|
||||
#$request->header('Accept', '*/*');
|
||||
if ($opt_c) { # will always be set for request that wants content
|
||||
$request->header('Content-Type', $opt_c);
|
||||
$request->header('Content-Length', length $content); # Not really needed
|
||||
$request->content($content);
|
||||
}
|
||||
|
||||
|
||||
$errors = 0;
|
||||
|
||||
# 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+:/ || $opt_b) { # is there any scheme specification
|
||||
$url = URI::URL->new($url, $opt_b);
|
||||
} else {
|
||||
$url = uf_url($url);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
$@ =~ s/at\s+\S+\s+line\s\d+//;
|
||||
print STDERR $@;
|
||||
$errors++;
|
||||
next;
|
||||
}
|
||||
|
||||
$ua->proxy($url->scheme, $opt_p) if $opt_p;
|
||||
|
||||
# Send the request and get a response back from the server
|
||||
$request->url($url);
|
||||
$response = $ua->request($request);
|
||||
|
||||
if ($opt_u || $opt_U) {
|
||||
my $url = $response->request->url->as_string;
|
||||
print "$method $url\n";
|
||||
print $response->request->headers_as_string, "\n" if $opt_U;
|
||||
}
|
||||
|
||||
if ($opt_S) {
|
||||
printResponseChain($response);
|
||||
} elsif ($opt_s) {
|
||||
print $response->status_line, "\n";
|
||||
}
|
||||
|
||||
if ($opt_e) {
|
||||
# Display headers
|
||||
print $response->headers_as_string;
|
||||
print "\n"; # separate headers and content
|
||||
}
|
||||
|
||||
if ($response->is_success) {
|
||||
unless ($opt_d) {
|
||||
if ($opt_o &&
|
||||
$response->content_type eq 'text/html') {
|
||||
require HTML::Parse;
|
||||
my $html = HTML::Parse::parse_html($response->content);
|
||||
{
|
||||
$opt_o eq 'ps' && do {
|
||||
require HTML::FormatPS;
|
||||
my $f = new HTML::FormatPS;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'text' && do {
|
||||
require HTML::FormatText;
|
||||
my $f = new HTML::FormatText;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'html' && do {
|
||||
print $html->as_HTML;
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'links' && do {
|
||||
my $base = $response->base;
|
||||
for ( @{ $html->extract_links } ) {
|
||||
my($link, $elem) = @$_;
|
||||
my $tag = uc $elem->tag;
|
||||
$link = new URI::URL $link, $base;
|
||||
print "$tag\t", $link->abs->as_string, "\n";
|
||||
}
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'dump' && do {
|
||||
$html->dump;
|
||||
last;
|
||||
};
|
||||
# It is bad to not notice this before now :-(
|
||||
die "Illegal -o option value ($opt_o)\n";
|
||||
}
|
||||
} else {
|
||||
binmode STDOUT unless $opt_a;
|
||||
print $response->content;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR $response->error_as_HTML unless $opt_d;
|
||||
$errors++;
|
||||
}
|
||||
}
|
||||
|
||||
exit $errors;
|
||||
|
||||
|
||||
sub printResponseChain
|
||||
{
|
||||
my($response) = @_;
|
||||
return unless defined $response;
|
||||
printResponseChain($response->previous);
|
||||
my $method = $response->request->method;
|
||||
my $url = $response->request->url->as_string;
|
||||
my $code = $response->code;
|
||||
print "$method $url --> ", $response->status_line, "\n";
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
||||
-u Display method and URL before any response
|
||||
-U Display request headers (implies -u)
|
||||
-s Display response status code
|
||||
-S Display response status chain
|
||||
-e Display response headers
|
||||
-d Do not display content
|
||||
-o <format> Process HTML content in various ways
|
||||
|
||||
-v Show program version
|
||||
-h Print this message
|
||||
|
||||
-x Extra debugging output
|
||||
EOT
|
||||
}
|
||||
505
tools/Perl/bin/POST
Normal file
505
tools/Perl/bin/POST
Normal file
|
|
@ -0,0 +1,505 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-request.PL,v 1.33 1998/08/04 09:18:11 aas Exp $
|
||||
#
|
||||
# Simple user agent using LWP library.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-request, GET, HEAD, POST - Simple WWW user agent
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
|
||||
[-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
|
||||
[-p <proxy-url>] [-o <format>] <url>...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program can be used to send requests to WWW servers and your
|
||||
local file system. The request content for POST, PUT and CHECKIN
|
||||
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 will probably reject the request.
|
||||
|
||||
=item -b <url>
|
||||
|
||||
This URL will be used as the base URL for the URLs that the method is
|
||||
applied to. The base URL only takes effect for relative URLs. If you
|
||||
do not provide this option and the URLs are relative, then they will
|
||||
be treated as files in the local file system.
|
||||
|
||||
=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> it 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 recogniced 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, PUT and CHECKIN. 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 -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 autorization
|
||||
requests that are handled by the library.
|
||||
|
||||
=item -e
|
||||
|
||||
Print response headers. This option is always on for HEAD requests.
|
||||
|
||||
=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.
|
||||
|
||||
=item -v
|
||||
|
||||
Print the version number of the program and quit.
|
||||
|
||||
=item -h
|
||||
|
||||
Print usage message and quit.
|
||||
|
||||
=item -x
|
||||
|
||||
Extra debugging output.
|
||||
|
||||
=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-1997 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 <aas@sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
$progname = $0;
|
||||
$progname =~ s,.*/,,; # use basename only
|
||||
$progname =~ s/\.\w*$//; # strip extension, if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
|
||||
require LWP;
|
||||
require LWP::Debug;
|
||||
require URI::URL;
|
||||
|
||||
use URI::Heuristic qw(uf_url);
|
||||
|
||||
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::opt_C) {
|
||||
return split(':', $main::opt_C, 2);
|
||||
} elsif (-t) {
|
||||
my $netloc = $uri->netloc;
|
||||
print "Enter username for $realm at $netloc: ";
|
||||
my $user = <STDIN>;
|
||||
chomp($user);
|
||||
return (undef, undef) unless length $user;
|
||||
print "Password: ";
|
||||
system("stty -echo");
|
||||
my $password = <STDIN>;
|
||||
system("stty echo");
|
||||
print "\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::Std;
|
||||
|
||||
$opt_a = undef; # content i/o in text(ascii) mode
|
||||
$opt_m = undef; # set method
|
||||
$opt_f = undef; # make request even if method is not in %allowed_methods
|
||||
$opt_b = undef; # base url
|
||||
$opt_t = undef; # timeout
|
||||
$opt_i = undef; # if-modified-since
|
||||
$opt_c = undef; # content type for POST
|
||||
$opt_C = undef; # credidentials for basic authorization
|
||||
|
||||
$opt_u = undef; # display method, URL and headers of request
|
||||
$opt_U = undef; # display request headers also
|
||||
$opt_s = undef; # display status code
|
||||
$opt_S = undef; # display whole chain of status codes
|
||||
$opt_e = undef; # display response headers (default for HEAD)
|
||||
$opt_d = undef; # don't display content
|
||||
|
||||
$opt_h = undef; # print usage
|
||||
$opt_v = undef; # print version
|
||||
|
||||
$opt_x = undef; # extra debugging info
|
||||
$opt_p = undef; # proxy URL
|
||||
$opt_P = undef; # don't load proxy setting from environment
|
||||
|
||||
$opt_o = undef; # output format
|
||||
|
||||
unless (getopts("axhvuUsSedPp:b:t:i:c:C:m:fo:")) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ($opt_v) {
|
||||
require LWP;
|
||||
my $DISTNAME = 'libwww-perl-' . LWP::Version();
|
||||
die <<"EOT";
|
||||
This is lwp-request version $VERSION ($DISTNAME)
|
||||
|
||||
Copyright 1995-1997, 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 $opt_h || !@ARGV;
|
||||
|
||||
LWP::Debug::level('+') if $opt_x;
|
||||
|
||||
# Create the user agent object
|
||||
$ua = new RequestAgent;
|
||||
|
||||
# Load proxy settings from *_proxy environment variables.
|
||||
$ua->env_proxy unless $opt_P;
|
||||
|
||||
$method = uc($opt_m) if defined $opt_m;
|
||||
|
||||
if ($opt_f) {
|
||||
if ($opt_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 ($method eq "HEAD") {
|
||||
$opt_s = 1;
|
||||
$opt_e = 1 unless $opt_d;
|
||||
$opt_d = 1;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
if (defined $opt_i) {
|
||||
if (-e $opt_i) {
|
||||
$time = (stat _)[9];
|
||||
} else {
|
||||
$time = str2time($opt_i);
|
||||
die "$progname: Illegal time syntax for -i option\n"
|
||||
unless defined $time;
|
||||
}
|
||||
$opt_i = time2str($time);
|
||||
}
|
||||
|
||||
$content = undef;
|
||||
if ($allowed_methods{$method} eq "C") {
|
||||
# This request needs some content
|
||||
unless (defined $opt_c) {
|
||||
# set default content type
|
||||
$opt_c = ($method eq "POST") ?
|
||||
"application/x-www-form-urlencoded"
|
||||
: "text/plain";
|
||||
} else {
|
||||
die "$progname: Illegal Content-type format\n"
|
||||
unless $opt_c =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
|
||||
}
|
||||
print "Please enter content ($opt_c) to be ${method}ed:\n"
|
||||
if -t;
|
||||
binmode STDIN unless -t or $opt_a;
|
||||
$content = join("", <STDIN>);
|
||||
} else {
|
||||
die "$progname: Can't set Content-type for $method requests\n"
|
||||
if defined $opt_c;
|
||||
}
|
||||
|
||||
# Set up a request. We will use the same request object for all URLs.
|
||||
$request = new HTTP::Request $method;
|
||||
$request->header('If-Modified-Since', $opt_i) if defined $opt_i;
|
||||
#$request->header('Accept', '*/*');
|
||||
if ($opt_c) { # will always be set for request that wants content
|
||||
$request->header('Content-Type', $opt_c);
|
||||
$request->header('Content-Length', length $content); # Not really needed
|
||||
$request->content($content);
|
||||
}
|
||||
|
||||
|
||||
$errors = 0;
|
||||
|
||||
# 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+:/ || $opt_b) { # is there any scheme specification
|
||||
$url = URI::URL->new($url, $opt_b);
|
||||
} else {
|
||||
$url = uf_url($url);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
$@ =~ s/at\s+\S+\s+line\s\d+//;
|
||||
print STDERR $@;
|
||||
$errors++;
|
||||
next;
|
||||
}
|
||||
|
||||
$ua->proxy($url->scheme, $opt_p) if $opt_p;
|
||||
|
||||
# Send the request and get a response back from the server
|
||||
$request->url($url);
|
||||
$response = $ua->request($request);
|
||||
|
||||
if ($opt_u || $opt_U) {
|
||||
my $url = $response->request->url->as_string;
|
||||
print "$method $url\n";
|
||||
print $response->request->headers_as_string, "\n" if $opt_U;
|
||||
}
|
||||
|
||||
if ($opt_S) {
|
||||
printResponseChain($response);
|
||||
} elsif ($opt_s) {
|
||||
print $response->status_line, "\n";
|
||||
}
|
||||
|
||||
if ($opt_e) {
|
||||
# Display headers
|
||||
print $response->headers_as_string;
|
||||
print "\n"; # separate headers and content
|
||||
}
|
||||
|
||||
if ($response->is_success) {
|
||||
unless ($opt_d) {
|
||||
if ($opt_o &&
|
||||
$response->content_type eq 'text/html') {
|
||||
require HTML::Parse;
|
||||
my $html = HTML::Parse::parse_html($response->content);
|
||||
{
|
||||
$opt_o eq 'ps' && do {
|
||||
require HTML::FormatPS;
|
||||
my $f = new HTML::FormatPS;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'text' && do {
|
||||
require HTML::FormatText;
|
||||
my $f = new HTML::FormatText;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'html' && do {
|
||||
print $html->as_HTML;
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'links' && do {
|
||||
my $base = $response->base;
|
||||
for ( @{ $html->extract_links } ) {
|
||||
my($link, $elem) = @$_;
|
||||
my $tag = uc $elem->tag;
|
||||
$link = new URI::URL $link, $base;
|
||||
print "$tag\t", $link->abs->as_string, "\n";
|
||||
}
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'dump' && do {
|
||||
$html->dump;
|
||||
last;
|
||||
};
|
||||
# It is bad to not notice this before now :-(
|
||||
die "Illegal -o option value ($opt_o)\n";
|
||||
}
|
||||
} else {
|
||||
binmode STDOUT unless $opt_a;
|
||||
print $response->content;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR $response->error_as_HTML unless $opt_d;
|
||||
$errors++;
|
||||
}
|
||||
}
|
||||
|
||||
exit $errors;
|
||||
|
||||
|
||||
sub printResponseChain
|
||||
{
|
||||
my($response) = @_;
|
||||
return unless defined $response;
|
||||
printResponseChain($response->previous);
|
||||
my $method = $response->request->method;
|
||||
my $url = $response->request->url->as_string;
|
||||
my $code = $response->code;
|
||||
print "$method $url --> ", $response->status_line, "\n";
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
||||
-u Display method and URL before any response
|
||||
-U Display request headers (implies -u)
|
||||
-s Display response status code
|
||||
-S Display response status chain
|
||||
-e Display response headers
|
||||
-d Do not display content
|
||||
-o <format> Process HTML content in various ways
|
||||
|
||||
-v Show program version
|
||||
-h Print this message
|
||||
|
||||
-x Extra debugging output
|
||||
EOT
|
||||
}
|
||||
BIN
tools/Perl/bin/PerlCRT.dll
Normal file
BIN
tools/Perl/bin/PerlCRT.dll
Normal file
Binary file not shown.
BIN
tools/Perl/bin/PerlEz.dll
Normal file
BIN
tools/Perl/bin/PerlEz.dll
Normal file
Binary file not shown.
BIN
tools/Perl/bin/PerlMsg.dll
Normal file
BIN
tools/Perl/bin/PerlMsg.dll
Normal file
Binary file not shown.
BIN
tools/Perl/bin/PerlSE.dll
Normal file
BIN
tools/Perl/bin/PerlSE.dll
Normal file
Binary file not shown.
BIN
tools/Perl/bin/PerlSE.pl
Normal file
BIN
tools/Perl/bin/PerlSE.pl
Normal file
Binary file not shown.
BIN
tools/Perl/bin/a2p.exe
Normal file
BIN
tools/Perl/bin/a2p.exe
Normal file
Binary file not shown.
232
tools/Perl/bin/lwp-download
Normal file
232
tools/Perl/bin/lwp-download
Normal file
|
|
@ -0,0 +1,232 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-download.PL,v 1.7 1998/08/04 09:03:35 aas Exp $
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-download - fetch large files from the net
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-download [-a] <url> [<local file>]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The I<lwp-download> program will down load the document specified by the URL
|
||||
given as the first command line argument to a local file. The local
|
||||
filename used to save the document is guessed from the URL unless
|
||||
specified as the second command line argument.
|
||||
|
||||
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'...
|
||||
1.47 MB received in 22 seconds (68.7 KB/sec)
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Gisle Aas <gisle@aas.no>
|
||||
|
||||
=cut
|
||||
|
||||
use LWP::UserAgent;
|
||||
use LWP::MediaTypes;
|
||||
use URI::URL;
|
||||
use strict;
|
||||
|
||||
my $progname = $0;
|
||||
$progname =~ s,.*/,,; # only basename left in progname
|
||||
$progname =~ s/\.\w*$//; # strip extension if any
|
||||
|
||||
#parse option
|
||||
use Getopt::Std;
|
||||
my %opts;
|
||||
unless (getopts('a', \%opts)) {
|
||||
usage();
|
||||
}
|
||||
my $opt_a = $opts{a}; # save in binary mode
|
||||
|
||||
my $url = url(shift || usage());
|
||||
my $argfile = shift;
|
||||
|
||||
my $ua = new LWP::UserAgent;
|
||||
|
||||
$ua->agent("lwp-download/0.1 " . $ua->agent);
|
||||
$ua->env_proxy;
|
||||
|
||||
my $req = new HTTP::Request GET => $url;
|
||||
|
||||
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($req,
|
||||
sub {
|
||||
unless($file) {
|
||||
my $res = $_[1];
|
||||
unless ($argfile) {
|
||||
# must find a suitable name to use. First thing
|
||||
# to do is to look for the "Content-Disposition"
|
||||
# header defined by RFC1806. This is also supported
|
||||
# by Netscape
|
||||
my $cd = $res->header("Content-Disposition");
|
||||
if ($cd && $cd =~ /\bfilename\s*=\s*(\S+)/) {
|
||||
$file = $1;
|
||||
$file =~ s/;$//;
|
||||
$file =~ s/^([\"\'])(.*)\1$/$2/;
|
||||
}
|
||||
|
||||
# if this fails we try to make something from the URL
|
||||
unless ($file) {
|
||||
my $req = $res->request; # now always there
|
||||
my $rurl = $req ? $req->url : $url;
|
||||
|
||||
$file = ($rurl->path_components)[-1];
|
||||
unless (length $file) {
|
||||
$file = "index";
|
||||
my $suffix = media_suffix($res->content_type);
|
||||
$file .= ".$suffix" if $suffix;
|
||||
} elsif ($rurl->scheme eq 'ftp' ||
|
||||
$file =~ /\.tgz$/ ||
|
||||
$file =~ /\.tar(\.(Z|gz))?$/
|
||||
) {
|
||||
# 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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Check if the file is already present
|
||||
if (-f $file && -t) {
|
||||
print "Overwrite $file? [y] ";
|
||||
my $ans = <STDIN>;
|
||||
exit if !defined($ans) || !($ans =~ /^y?\n/);
|
||||
} else {
|
||||
print "Saving to '$file'...\n";
|
||||
}
|
||||
} else {
|
||||
$file = $argfile;
|
||||
}
|
||||
open(FILE, ">$file") || die "Can't open $file: $!";
|
||||
binmode FILE unless $opt_a;
|
||||
$length = $res->content_length;
|
||||
$flength = fbytes($length) if defined $length;
|
||||
$start_t = time;
|
||||
$last_dur = 0;
|
||||
}
|
||||
$size += length($_[0]);
|
||||
print FILE $_[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);
|
||||
}
|
||||
} else {
|
||||
show( fbytes($size) . " received");
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
if ($res->is_success || $res->message =~ /^Interrupted/) {
|
||||
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";
|
||||
my $died = $res->header("X-Died");
|
||||
if ($died || !$res->is_success) {
|
||||
if (-t) {
|
||||
print "Transfer aborted. Delete $file? [n] ";
|
||||
my $ans = <STDIN>;
|
||||
unlink($file) if defined($ans) && $ans =~ /^y\n/;
|
||||
} else {
|
||||
print "Transfer aborted, $file kept\n";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print "\n" if $shown;
|
||||
print "$progname: Can't download: ", $res->code, " ", $res->message, "\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";
|
||||
}
|
||||
}
|
||||
|
||||
sub show
|
||||
{
|
||||
my $mess = shift;
|
||||
print "\r$mess", (" " x (75 - length $mess));
|
||||
$shown++;
|
||||
}
|
||||
|
||||
sub usage
|
||||
{
|
||||
die "Usage: $progname [-a] <url> [<lpath>]\n";
|
||||
}
|
||||
104
tools/Perl/bin/lwp-mirror
Normal file
104
tools/Perl/bin/lwp-mirror
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-mirror.PL,v 1.18 1997/12/03 21:21:00 aas Exp $
|
||||
#
|
||||
# Simple mirror utility using LWP
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-mirror - Simple mirror utility for WWW
|
||||
|
||||
=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 transfered 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, repectively.
|
||||
|
||||
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 <aas@a.sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use LWP::Simple;
|
||||
use Getopt::Std;
|
||||
|
||||
$progname = $0;
|
||||
$progname =~ s,.*/,,; # use basename only
|
||||
$progname =~ s/\.\w*$//; #strip extension if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
$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-1996, Gisle Aas.
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
EOT
|
||||
}
|
||||
|
||||
$url = shift or usage();
|
||||
$file = 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");
|
||||
$LWP::Simple::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
|
||||
}
|
||||
505
tools/Perl/bin/lwp-request
Normal file
505
tools/Perl/bin/lwp-request
Normal file
|
|
@ -0,0 +1,505 @@
|
|||
#!perl -w
|
||||
|
||||
# $Id: lwp-request.PL,v 1.33 1998/08/04 09:18:11 aas Exp $
|
||||
#
|
||||
# Simple user agent using LWP library.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-request, GET, HEAD, POST - Simple WWW user agent
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-request [-aeEdvhx] [-m method] [-b <base URL>] [-t <timeout>]
|
||||
[-i <if-modified-since>] [-c <content-type>] [-C <credentials>]
|
||||
[-p <proxy-url>] [-o <format>] <url>...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program can be used to send requests to WWW servers and your
|
||||
local file system. The request content for POST, PUT and CHECKIN
|
||||
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 will probably reject the request.
|
||||
|
||||
=item -b <url>
|
||||
|
||||
This URL will be used as the base URL for the URLs that the method is
|
||||
applied to. The base URL only takes effect for relative URLs. If you
|
||||
do not provide this option and the URLs are relative, then they will
|
||||
be treated as files in the local file system.
|
||||
|
||||
=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> it 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 recogniced 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, PUT and CHECKIN. 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 -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 autorization
|
||||
requests that are handled by the library.
|
||||
|
||||
=item -e
|
||||
|
||||
Print response headers. This option is always on for HEAD requests.
|
||||
|
||||
=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.
|
||||
|
||||
=item -v
|
||||
|
||||
Print the version number of the program and quit.
|
||||
|
||||
=item -h
|
||||
|
||||
Print usage message and quit.
|
||||
|
||||
=item -x
|
||||
|
||||
Extra debugging output.
|
||||
|
||||
=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-1997 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 <aas@sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
$progname = $0;
|
||||
$progname =~ s,.*/,,; # use basename only
|
||||
$progname =~ s/\.\w*$//; # strip extension, if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
|
||||
require LWP;
|
||||
require LWP::Debug;
|
||||
require URI::URL;
|
||||
|
||||
use URI::Heuristic qw(uf_url);
|
||||
|
||||
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::opt_C) {
|
||||
return split(':', $main::opt_C, 2);
|
||||
} elsif (-t) {
|
||||
my $netloc = $uri->netloc;
|
||||
print "Enter username for $realm at $netloc: ";
|
||||
my $user = <STDIN>;
|
||||
chomp($user);
|
||||
return (undef, undef) unless length $user;
|
||||
print "Password: ";
|
||||
system("stty -echo");
|
||||
my $password = <STDIN>;
|
||||
system("stty echo");
|
||||
print "\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::Std;
|
||||
|
||||
$opt_a = undef; # content i/o in text(ascii) mode
|
||||
$opt_m = undef; # set method
|
||||
$opt_f = undef; # make request even if method is not in %allowed_methods
|
||||
$opt_b = undef; # base url
|
||||
$opt_t = undef; # timeout
|
||||
$opt_i = undef; # if-modified-since
|
||||
$opt_c = undef; # content type for POST
|
||||
$opt_C = undef; # credidentials for basic authorization
|
||||
|
||||
$opt_u = undef; # display method, URL and headers of request
|
||||
$opt_U = undef; # display request headers also
|
||||
$opt_s = undef; # display status code
|
||||
$opt_S = undef; # display whole chain of status codes
|
||||
$opt_e = undef; # display response headers (default for HEAD)
|
||||
$opt_d = undef; # don't display content
|
||||
|
||||
$opt_h = undef; # print usage
|
||||
$opt_v = undef; # print version
|
||||
|
||||
$opt_x = undef; # extra debugging info
|
||||
$opt_p = undef; # proxy URL
|
||||
$opt_P = undef; # don't load proxy setting from environment
|
||||
|
||||
$opt_o = undef; # output format
|
||||
|
||||
unless (getopts("axhvuUsSedPp:b:t:i:c:C:m:fo:")) {
|
||||
usage();
|
||||
}
|
||||
|
||||
if ($opt_v) {
|
||||
require LWP;
|
||||
my $DISTNAME = 'libwww-perl-' . LWP::Version();
|
||||
die <<"EOT";
|
||||
This is lwp-request version $VERSION ($DISTNAME)
|
||||
|
||||
Copyright 1995-1997, 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 $opt_h || !@ARGV;
|
||||
|
||||
LWP::Debug::level('+') if $opt_x;
|
||||
|
||||
# Create the user agent object
|
||||
$ua = new RequestAgent;
|
||||
|
||||
# Load proxy settings from *_proxy environment variables.
|
||||
$ua->env_proxy unless $opt_P;
|
||||
|
||||
$method = uc($opt_m) if defined $opt_m;
|
||||
|
||||
if ($opt_f) {
|
||||
if ($opt_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 ($method eq "HEAD") {
|
||||
$opt_s = 1;
|
||||
$opt_e = 1 unless $opt_d;
|
||||
$opt_d = 1;
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
if (defined $opt_i) {
|
||||
if (-e $opt_i) {
|
||||
$time = (stat _)[9];
|
||||
} else {
|
||||
$time = str2time($opt_i);
|
||||
die "$progname: Illegal time syntax for -i option\n"
|
||||
unless defined $time;
|
||||
}
|
||||
$opt_i = time2str($time);
|
||||
}
|
||||
|
||||
$content = undef;
|
||||
if ($allowed_methods{$method} eq "C") {
|
||||
# This request needs some content
|
||||
unless (defined $opt_c) {
|
||||
# set default content type
|
||||
$opt_c = ($method eq "POST") ?
|
||||
"application/x-www-form-urlencoded"
|
||||
: "text/plain";
|
||||
} else {
|
||||
die "$progname: Illegal Content-type format\n"
|
||||
unless $opt_c =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
|
||||
}
|
||||
print "Please enter content ($opt_c) to be ${method}ed:\n"
|
||||
if -t;
|
||||
binmode STDIN unless -t or $opt_a;
|
||||
$content = join("", <STDIN>);
|
||||
} else {
|
||||
die "$progname: Can't set Content-type for $method requests\n"
|
||||
if defined $opt_c;
|
||||
}
|
||||
|
||||
# Set up a request. We will use the same request object for all URLs.
|
||||
$request = new HTTP::Request $method;
|
||||
$request->header('If-Modified-Since', $opt_i) if defined $opt_i;
|
||||
#$request->header('Accept', '*/*');
|
||||
if ($opt_c) { # will always be set for request that wants content
|
||||
$request->header('Content-Type', $opt_c);
|
||||
$request->header('Content-Length', length $content); # Not really needed
|
||||
$request->content($content);
|
||||
}
|
||||
|
||||
|
||||
$errors = 0;
|
||||
|
||||
# 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+:/ || $opt_b) { # is there any scheme specification
|
||||
$url = URI::URL->new($url, $opt_b);
|
||||
} else {
|
||||
$url = uf_url($url);
|
||||
}
|
||||
};
|
||||
if ($@) {
|
||||
$@ =~ s/at\s+\S+\s+line\s\d+//;
|
||||
print STDERR $@;
|
||||
$errors++;
|
||||
next;
|
||||
}
|
||||
|
||||
$ua->proxy($url->scheme, $opt_p) if $opt_p;
|
||||
|
||||
# Send the request and get a response back from the server
|
||||
$request->url($url);
|
||||
$response = $ua->request($request);
|
||||
|
||||
if ($opt_u || $opt_U) {
|
||||
my $url = $response->request->url->as_string;
|
||||
print "$method $url\n";
|
||||
print $response->request->headers_as_string, "\n" if $opt_U;
|
||||
}
|
||||
|
||||
if ($opt_S) {
|
||||
printResponseChain($response);
|
||||
} elsif ($opt_s) {
|
||||
print $response->status_line, "\n";
|
||||
}
|
||||
|
||||
if ($opt_e) {
|
||||
# Display headers
|
||||
print $response->headers_as_string;
|
||||
print "\n"; # separate headers and content
|
||||
}
|
||||
|
||||
if ($response->is_success) {
|
||||
unless ($opt_d) {
|
||||
if ($opt_o &&
|
||||
$response->content_type eq 'text/html') {
|
||||
require HTML::Parse;
|
||||
my $html = HTML::Parse::parse_html($response->content);
|
||||
{
|
||||
$opt_o eq 'ps' && do {
|
||||
require HTML::FormatPS;
|
||||
my $f = new HTML::FormatPS;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'text' && do {
|
||||
require HTML::FormatText;
|
||||
my $f = new HTML::FormatText;
|
||||
print $f->format($html);
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'html' && do {
|
||||
print $html->as_HTML;
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'links' && do {
|
||||
my $base = $response->base;
|
||||
for ( @{ $html->extract_links } ) {
|
||||
my($link, $elem) = @$_;
|
||||
my $tag = uc $elem->tag;
|
||||
$link = new URI::URL $link, $base;
|
||||
print "$tag\t", $link->abs->as_string, "\n";
|
||||
}
|
||||
last;
|
||||
};
|
||||
$opt_o eq 'dump' && do {
|
||||
$html->dump;
|
||||
last;
|
||||
};
|
||||
# It is bad to not notice this before now :-(
|
||||
die "Illegal -o option value ($opt_o)\n";
|
||||
}
|
||||
} else {
|
||||
binmode STDOUT unless $opt_a;
|
||||
print $response->content;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print STDERR $response->error_as_HTML unless $opt_d;
|
||||
$errors++;
|
||||
}
|
||||
}
|
||||
|
||||
exit $errors;
|
||||
|
||||
|
||||
sub printResponseChain
|
||||
{
|
||||
my($response) = @_;
|
||||
return unless defined $response;
|
||||
printResponseChain($response->previous);
|
||||
my $method = $response->request->method;
|
||||
my $url = $response->request->url->as_string;
|
||||
my $code = $response->code;
|
||||
print "$method $url --> ", $response->status_line, "\n";
|
||||
}
|
||||
|
||||
|
||||
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
|
||||
|
||||
-u Display method and URL before any response
|
||||
-U Display request headers (implies -u)
|
||||
-s Display response status code
|
||||
-S Display response status chain
|
||||
-e Display response headers
|
||||
-d Do not display content
|
||||
-o <format> Process HTML content in various ways
|
||||
|
||||
-v Show program version
|
||||
-h Print this message
|
||||
|
||||
-x Extra debugging output
|
||||
EOT
|
||||
}
|
||||
584
tools/Perl/bin/lwp-rget
Normal file
584
tools/Perl/bin/lwp-rget
Normal file
|
|
@ -0,0 +1,584 @@
|
|||
#!perl -w
|
||||
|
||||
#line 18
|
||||
|
||||
=head1 NAME
|
||||
|
||||
lwp-rget - Retrieve WWW documents recursively
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
lwp-rget [--verbose] [--auth=USER:PASS] [--depth=N] [--hier] [--iis]
|
||||
[--keepext=mime/type[,mime/type]] [--limit=N] [--nospace]
|
||||
[--prefix=URL] [--sleep=N] [--tolower] <URL>
|
||||
lwp-rget --version
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This program will retrieve a document and store it in a local file. It
|
||||
will follow any links found in the document and store these documents
|
||||
as well, patching links so that they refer to these local copies.
|
||||
This process continues until there are no more unvisited links or the
|
||||
process is stopped by the one or more of the limits which can be
|
||||
controlled by the command line arguments.
|
||||
|
||||
This program is useful if you want to make a local copy of a
|
||||
collection of documents or want to do web reading off-line.
|
||||
|
||||
All documents are stored as plain files in the current directory. The
|
||||
file names chosen are derived from the last component of URL paths.
|
||||
|
||||
The options are:
|
||||
|
||||
=over 3
|
||||
|
||||
=item --auth=USER:PASS<n>
|
||||
|
||||
Set the authentication credentials to user "USER" and password "PASS" if
|
||||
any restricted parts of the web site are hit. If there are restricted
|
||||
parts of the web site and authentication credentials are not available,
|
||||
those pages will not be downloaded.
|
||||
|
||||
=item --depth=I<n>
|
||||
|
||||
Limit the recursive level. Embedded images are always loaded, even if
|
||||
they fall outside the I<--depth>. This means that one can use
|
||||
I<--depth=0> in order to fetch a single document together with all
|
||||
inline graphics.
|
||||
|
||||
The default depth is 5.
|
||||
|
||||
=item --hier
|
||||
|
||||
Download files into a hierarchy that mimics the web site structure.
|
||||
The default is to put all files in the current directory.
|
||||
|
||||
=item --iis
|
||||
|
||||
Sends an "Accept: */*" on all URL requests as a workaround for a bug in
|
||||
IIS 2.0. If no Accept MIME header is present, IIS 2.0 returns with a
|
||||
"406 No acceptable objects were found" error. Also converts any back
|
||||
slashes (\\) in URLs to forward slashes (/).
|
||||
|
||||
=item --keepext=I<mime/type[,mime/type]>
|
||||
|
||||
Keeps the current extension for the list MIME types. Useful when
|
||||
downloading text/plain documents that shouldn't all be translated to
|
||||
*.txt files.
|
||||
|
||||
=item --limit=I<n>
|
||||
|
||||
Limit the number of documents to get. The default limit is 50.
|
||||
|
||||
=item --nospace
|
||||
|
||||
Changes spaces in all URLs to underscore characters (_). Useful when
|
||||
downloading files from sites serving URLs with spaces in them. Does not
|
||||
remove spaces from fragments, e.g., "file.html#somewhere in here".
|
||||
|
||||
=item --prefix=I<url_prefix>
|
||||
|
||||
Limit the links to follow. Only URLs that start the prefix string are
|
||||
followed.
|
||||
|
||||
The default prefix is set as the "directory" of the initial URL to
|
||||
follow. For instance if we start lwp-rget with the URL
|
||||
C<http://www.sn.no/foo/bar.html>, then prefix will be set to
|
||||
C<http://www.sn.no/foo/>.
|
||||
|
||||
Use C<--prefix=''> if you don't want the fetching to be limited by any
|
||||
prefix.
|
||||
|
||||
=item --sleep=I<n>
|
||||
|
||||
Sleep I<n> seconds before retrieving each document. This options allows
|
||||
you to go slowly, not loading the server you visiting too much.
|
||||
|
||||
=item --tolower
|
||||
|
||||
Translates all links to lowercase. Useful when downloading files from
|
||||
IIS since it does not serve files in a case sensitive manner.
|
||||
|
||||
=item --verbose
|
||||
|
||||
Make more noise while running.
|
||||
|
||||
=item --quiet
|
||||
|
||||
Don't make any noise.
|
||||
|
||||
=item --version
|
||||
|
||||
Print program version number and quit.
|
||||
|
||||
=item --help
|
||||
|
||||
Print the usage message and quit.
|
||||
|
||||
=back
|
||||
|
||||
Before the program exits the name of the file, where the initial URL
|
||||
is stored, is printed on stdout. All used filenames are also printed
|
||||
on stderr as they are loaded. This printing can be suppressed with
|
||||
the I<--quiet> option.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<lwp-request>, L<LWP>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Gisle Aas <aas@sn.no>
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
|
||||
use Getopt::Long qw(GetOptions);
|
||||
use URI::URL qw(url);
|
||||
use LWP::MediaTypes qw(media_suffix);
|
||||
|
||||
use vars qw($VERSION);
|
||||
use vars qw($MAX_DEPTH $MAX_DOCS $PREFIX $VERBOSE $QUIET $SLEEP $HIER $AUTH $IIS $TOLOWER $NOSPACE %KEEPEXT);
|
||||
|
||||
my $progname = $0;
|
||||
$progname =~ s|.*/||; # only basename left
|
||||
$progname =~ s/\.\w*$//; #strip extension if any
|
||||
|
||||
$VERSION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);
|
||||
|
||||
#$Getopt::Long::debug = 1;
|
||||
#$Getopt::Long::ignorecase = 0;
|
||||
|
||||
# Defaults
|
||||
$MAX_DEPTH = 5;
|
||||
$MAX_DOCS = 50;
|
||||
|
||||
GetOptions('version' => \&print_version,
|
||||
'help' => \&usage,
|
||||
'depth=i' => \$MAX_DEPTH,
|
||||
'limit=i' => \$MAX_DOCS,
|
||||
'verbose!' => \$VERBOSE,
|
||||
'quiet!' => \$QUIET,
|
||||
'sleep=i' => \$SLEEP,
|
||||
'prefix:s' => \$PREFIX,
|
||||
'hier' => \$HIER,
|
||||
'auth=s' => \$AUTH,
|
||||
'iis' => \$IIS,
|
||||
'tolower' => \$TOLOWER,
|
||||
'nospace' => \$NOSPACE,
|
||||
'keepext=s' => \$KEEPEXT{'OPT'},
|
||||
) || usage();
|
||||
|
||||
sub print_version {
|
||||
require LWP;
|
||||
my $DISTNAME = 'libwww-perl-' . LWP::Version();
|
||||
print <<"EOT";
|
||||
This is lwp-rget version $VERSION ($DISTNAME)
|
||||
|
||||
Copyright 1996-1998, Gisle Aas.
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
EOT
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $start_url = shift || usage();
|
||||
usage() if @ARGV;
|
||||
|
||||
require LWP::UserAgent;
|
||||
my $ua = new LWP::UserAgent;
|
||||
$ua->agent("$progname/$VERSION " . $ua->agent);
|
||||
$ua->env_proxy;
|
||||
|
||||
unless (defined $PREFIX) {
|
||||
$PREFIX = url($start_url); # limit to URLs below this one
|
||||
eval {
|
||||
$PREFIX->eparams(undef);
|
||||
$PREFIX->equery(undef);
|
||||
};
|
||||
|
||||
$_ = $PREFIX->epath;
|
||||
s|[^/]+$||;
|
||||
$PREFIX->epath($_);
|
||||
$PREFIX = $PREFIX->as_string;
|
||||
}
|
||||
|
||||
%KEEPEXT = map { lc($_) => 1 } split(/\s*,\s*/, $KEEPEXT{'OPT'});
|
||||
|
||||
print <<"" if $VERBOSE;
|
||||
START = $start_url
|
||||
MAX_DEPTH = $MAX_DEPTH
|
||||
MAX_DOCS = $MAX_DOCS
|
||||
PREFIX = $PREFIX
|
||||
|
||||
|
||||
my $no_docs = 0;
|
||||
my %seen = (); # mapping from URL => local_file
|
||||
|
||||
my $filename = fetch($start_url);
|
||||
print "$filename\n" unless $QUIET;
|
||||
|
||||
sub fetch
|
||||
{
|
||||
my($url, $type, $depth) = @_;
|
||||
|
||||
# Fix http://sitename.com/../blah/blah.html to
|
||||
# http://sitename.com/blah/blah.html
|
||||
$url = $url->as_string if (ref($url));
|
||||
while ($url =~ s#(https?://[^/]+/)\.\.\/#$1#) {}
|
||||
|
||||
# Fix backslashes (\) in URL if $IIS defined
|
||||
$url = fix_backslashes($url) if (defined $IIS);
|
||||
|
||||
$url = url($url) unless ref($url);
|
||||
$type ||= 'a';
|
||||
# Might be the background attribute
|
||||
$type = 'img' if ($type eq 'body' || $type eq 'td');
|
||||
$depth ||= 0;
|
||||
|
||||
# Print the URL before we start checking...
|
||||
my $out = (" " x $depth) . $url . " ";
|
||||
$out .= "." x (60 - length($out));
|
||||
print STDERR $out . " " if $VERBOSE;
|
||||
|
||||
# Can't get mailto things
|
||||
if ($url->scheme eq 'mailto') {
|
||||
print STDERR "*skipping mailto*\n" if $VERBOSE;
|
||||
return $url->as_string;
|
||||
}
|
||||
|
||||
# The $plain_url is a URL without the fragment part
|
||||
my $plain_url = $url->clone;
|
||||
$plain_url->frag(undef);
|
||||
|
||||
# Check PREFIX, but not for <IMG ...> links
|
||||
if ($type ne 'img' and $url->as_string !~ /^\Q$PREFIX/o) {
|
||||
print STDERR "*outsider*\n" if $VERBOSE;
|
||||
return $url->as_string;
|
||||
}
|
||||
|
||||
# Translate URL to lowercase if $TOLOWER defined
|
||||
$plain_url = to_lower($plain_url) if (defined $TOLOWER);
|
||||
|
||||
# If we already have it, then there is nothing to be done
|
||||
my $seen = $seen{$plain_url->as_string};
|
||||
if ($seen) {
|
||||
my $frag = $url->frag;
|
||||
$seen .= "#$frag" if defined($frag);
|
||||
$seen = protect_frag_spaces($seen);
|
||||
print STDERR "$seen (again)\n" if $VERBOSE;
|
||||
return $seen;
|
||||
}
|
||||
|
||||
# Too much or too deep
|
||||
if ($depth > $MAX_DEPTH and $type ne 'img') {
|
||||
print STDERR "*too deep*\n" if $VERBOSE;
|
||||
return $url;
|
||||
}
|
||||
if ($no_docs > $MAX_DOCS) {
|
||||
print STDERR "*too many*\n" if $VERBOSE;
|
||||
return $url;
|
||||
}
|
||||
|
||||
# Fetch document
|
||||
$no_docs++;
|
||||
sleep($SLEEP) if $SLEEP;
|
||||
my $req = HTTP::Request->new(GET => $url);
|
||||
# See: http://ftp.sunet.se/pub/NT/mirror-microsoft/kb/Q163/7/74.TXT
|
||||
$req->header ('Accept', '*/*') if (defined $IIS); # GIF/JPG from IIS 2.0
|
||||
$req->authorization_basic(split (/:/, $AUTH)) if (defined $AUTH);
|
||||
my $res = $ua->request($req);
|
||||
|
||||
# Check outcome
|
||||
if ($res->is_success) {
|
||||
my $doc = $res->content;
|
||||
my $ct = $res->content_type;
|
||||
my $name = find_name($res->request->url, $ct);
|
||||
print STDERR "$name\n" unless $QUIET;
|
||||
$seen{$plain_url->as_string} = $name;
|
||||
|
||||
# If the file is HTML, then we look for internal links
|
||||
if ($ct eq "text/html") {
|
||||
# Save an unprosessed version of the HTML document. This
|
||||
# both reserves the name used, and it also ensures that we
|
||||
# don't loose everything if this program is killed before
|
||||
# we finish.
|
||||
save($name, $doc);
|
||||
my $base = $res->base;
|
||||
|
||||
# Follow and substitute links...
|
||||
$doc =~
|
||||
s/
|
||||
(
|
||||
<(img|a|body|area|frame|td)\b # some interesting tag
|
||||
[^>]+ # still inside tag (not strictly correct)
|
||||
\b(?:src|href|background) # some link attribute
|
||||
\s*=\s* # =
|
||||
)
|
||||
(?: # scope of OR-ing
|
||||
(")([^"]*)" | # value in double quotes OR
|
||||
(')([^']*)' | # value in single quotes OR
|
||||
([^\s>]+) # quoteless value
|
||||
)
|
||||
/
|
||||
new_link($1, lc($2), $3||$5, $4||$6||$7, $base, $name, $depth+1)
|
||||
/giex;
|
||||
# XXX
|
||||
# The regular expression above is not strictly correct.
|
||||
# It is not really possible to parse HTML with a single
|
||||
# regular expression, but it is faster. Tags that might
|
||||
# confuse us include:
|
||||
# <a alt="href" href=link.html>
|
||||
# <a alt=">" href="link.html">
|
||||
#
|
||||
}
|
||||
save($name, $doc);
|
||||
return $name;
|
||||
} else {
|
||||
print STDERR $res->code . " " . $res->message . "\n" if $VERBOSE;
|
||||
$seen{$plain_url->as_string} = $url->as_string;
|
||||
return $url->as_string;
|
||||
}
|
||||
}
|
||||
|
||||
sub new_link
|
||||
{
|
||||
my($pre, $type, $quote, $url, $base, $localbase, $depth) = @_;
|
||||
|
||||
$url = protect_frag_spaces($url);
|
||||
|
||||
$url = fetch(url($url, $base)->abs, $type, $depth);
|
||||
$url = url("file:$url", "file:$localbase")->rel
|
||||
unless $url =~ /^[.+\-\w]+:/;
|
||||
|
||||
$url = unprotect_frag_spaces($url);
|
||||
|
||||
return $pre . $quote . $url . $quote;
|
||||
}
|
||||
|
||||
|
||||
sub protect_frag_spaces
|
||||
{
|
||||
my ($url) = @_;
|
||||
|
||||
$url = $url->as_string if (ref($url));
|
||||
|
||||
if ($url =~ m/^([^#]*#)(.+)$/)
|
||||
{
|
||||
my ($base, $frag) = ($1, $2);
|
||||
$frag =~ s/ /%20/g;
|
||||
$url = $base . $frag;
|
||||
}
|
||||
|
||||
return $url;
|
||||
}
|
||||
|
||||
|
||||
sub unprotect_frag_spaces
|
||||
{
|
||||
my ($url) = @_;
|
||||
|
||||
$url = $url->as_string if (ref($url));
|
||||
|
||||
if ($url =~ m/^([^#]*#)(.+)$/)
|
||||
{
|
||||
my ($base, $frag) = ($1, $2);
|
||||
$frag =~ s/%20/ /g;
|
||||
$url = $base . $frag;
|
||||
}
|
||||
|
||||
return $url;
|
||||
}
|
||||
|
||||
|
||||
sub fix_backslashes
|
||||
{
|
||||
my ($url) = @_;
|
||||
my ($base, $frag);
|
||||
|
||||
$url = $url->as_string if (ref($url));
|
||||
|
||||
if ($url =~ m/([^#]+)(#.*)/)
|
||||
{
|
||||
($base, $frag) = ($1, $2);
|
||||
}
|
||||
else
|
||||
{
|
||||
$base = $url;
|
||||
$frag = "";
|
||||
}
|
||||
|
||||
$base =~ tr/\\/\//;
|
||||
$base =~ s/%5[cC]/\//g; # URL-encoded back slash is %5C
|
||||
|
||||
return $base . $frag;
|
||||
}
|
||||
|
||||
|
||||
sub to_lower
|
||||
{
|
||||
my ($url) = @_;
|
||||
my $was_object = 0;
|
||||
|
||||
if (ref($url))
|
||||
{
|
||||
$url = $url->as_string;
|
||||
$was_object = 1;
|
||||
}
|
||||
|
||||
if ($url =~ m/([^#]+)(#.*)/)
|
||||
{
|
||||
$url = lc($1) . $2;
|
||||
}
|
||||
else
|
||||
{
|
||||
$url = lc($url);
|
||||
}
|
||||
|
||||
if ($was_object == 1)
|
||||
{
|
||||
return url($url);
|
||||
}
|
||||
else
|
||||
{
|
||||
return $url;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub translate_spaces
|
||||
{
|
||||
my ($url) = @_;
|
||||
my ($base, $frag);
|
||||
|
||||
$url = $url->as_string if (ref($url));
|
||||
|
||||
if ($url =~ m/([^#]+)(#.*)/)
|
||||
{
|
||||
($base, $frag) = ($1, $2);
|
||||
}
|
||||
else
|
||||
{
|
||||
$base = $url;
|
||||
$frag = "";
|
||||
}
|
||||
|
||||
$base =~ s/^ *//; # Remove initial spaces from base
|
||||
$base =~ s/ *$//; # Remove trailing spaces from base
|
||||
|
||||
$base =~ tr/ /_/;
|
||||
$base =~ s/%20/_/g; # URL-encoded space is %20
|
||||
|
||||
return $base . $frag;
|
||||
}
|
||||
|
||||
|
||||
sub mkdirp
|
||||
{
|
||||
my($directory, $mode) = @_;
|
||||
my @dirs = split(/\//, $directory);
|
||||
my $path = shift(@dirs); # build it as we go
|
||||
my $result = 1; # assume it will work
|
||||
|
||||
unless (-d $path) {
|
||||
$result &&= mkdir($path, $mode);
|
||||
}
|
||||
|
||||
foreach (@dirs) {
|
||||
$path .= "/$_";
|
||||
if ( ! -d $path) {
|
||||
$result &&= mkdir($path, $mode);
|
||||
}
|
||||
}
|
||||
|
||||
return $result;
|
||||
}
|
||||
|
||||
|
||||
sub find_name
|
||||
{
|
||||
my($url, $type) = @_;
|
||||
#print "find_name($url, $type)\n";
|
||||
|
||||
# Translate spaces in URL to underscores (_) if $NOSPACE defined
|
||||
$url = translate_spaces($url) if (defined $NOSPACE);
|
||||
|
||||
# Translate URL to lowercase if $TOLOWER defined
|
||||
$url = to_lower($url) if (defined $TOLOWER);
|
||||
|
||||
$url = url($url) unless ref($url);
|
||||
|
||||
my $path = $url->path;
|
||||
|
||||
# trim path until only the basename is left
|
||||
$path =~ s|(.*/)||;
|
||||
my $dirname = ".$1";
|
||||
if (!$HIER) {
|
||||
$dirname = "";
|
||||
} elsif (! -d $dirname) {
|
||||
mkdirp($dirname, 0775);
|
||||
}
|
||||
|
||||
my $extra = ""; # something to make the name unique
|
||||
my $suffix;
|
||||
|
||||
if ($KEEPEXT{lc($type)}) {
|
||||
$suffix = ($path =~ m/\.(.*)/) ? $1 : "";
|
||||
} else {
|
||||
$suffix = media_suffix($type);
|
||||
}
|
||||
|
||||
$path =~ s|\..*||; # trim suffix
|
||||
$path = "index" unless length $path;
|
||||
|
||||
while (1) {
|
||||
# Construct a new file name
|
||||
my $file = $dirname . $path . $extra;
|
||||
$file .= ".$suffix" if $suffix;
|
||||
# Check if it is unique
|
||||
return $file unless -f $file;
|
||||
|
||||
# Try something extra
|
||||
unless ($extra) {
|
||||
$extra = "001";
|
||||
next;
|
||||
}
|
||||
$extra++;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub save
|
||||
{
|
||||
my $name = shift;
|
||||
#print "save($name,...)\n";
|
||||
open(FILE, ">$name") || die "Can't save $name: $!";
|
||||
binmode FILE;
|
||||
print FILE $_[0];
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
|
||||
sub usage
|
||||
{
|
||||
die <<"";
|
||||
Usage: $progname [options] <URL>
|
||||
Allowed options are:
|
||||
--auth=USER:PASS Set authentication credentials for web site
|
||||
--depth=N Maximum depth to traverse (default is $MAX_DEPTH)
|
||||
--hier Download into hierarchy (not all files into cwd)
|
||||
--iis Workaround IIS 2.0 bug by sending "Accept: */*" MIME
|
||||
header; translates backslashes (\\) to forward slashes (/)
|
||||
--keepext=type Keep file extension for MIME types (comma-separated list)
|
||||
--limit=N A limit on the number documents to get (default is $MAX_DOCS)
|
||||
--nospace Translate spaces URLs (not #fragments) to underscores (_)
|
||||
--version Print version number and quit
|
||||
--verbose More output
|
||||
--quiet No output
|
||||
--sleep=SECS Sleep between gets, ie. go slowly
|
||||
--prefix=PREFIX Limit URLs to follow to those which begin with PREFIX
|
||||
--tolower Translate all URLs to lowercase (useful with IIS servers)
|
||||
|
||||
}
|
||||
17
tools/Perl/bin/p_uninst.dat
Normal file
17
tools/Perl/bin/p_uninst.dat
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
$app_name = 'ActivePerl';
|
||||
$is_uninstall_string = 'C:\\WINNT\\uninst.exe -fC:\\Perl\\DeIsL1.isu';
|
||||
$path_info = [
|
||||
'C:\\Perl\\bin'
|
||||
];
|
||||
$iis_virt_dir = [];
|
||||
$iis_script_map = {};
|
||||
$ns_config_dir = undef;
|
||||
$lines_in_file = {};
|
||||
$directory = [
|
||||
'C:\\Perl\\html\\lib'
|
||||
];
|
||||
$file = [
|
||||
'C:\\Perl\\bin\\ppm.bat',
|
||||
'C:\\Perl\\bin\\perlse.pl',
|
||||
'C:\\Perl\\bin/p_uninst.dat'
|
||||
];
|
||||
BIN
tools/Perl/bin/perl.exe
Normal file
BIN
tools/Perl/bin/perl.exe
Normal file
Binary file not shown.
BIN
tools/Perl/bin/perl5.00502.exe
Normal file
BIN
tools/Perl/bin/perl5.00502.exe
Normal file
Binary file not shown.
BIN
tools/Perl/bin/perlcore.dll
Normal file
BIN
tools/Perl/bin/perlcore.dll
Normal file
Binary file not shown.
BIN
tools/Perl/bin/perlglob.exe
Normal file
BIN
tools/Perl/bin/perlglob.exe
Normal file
Binary file not shown.
1108
tools/Perl/bin/ppm.pl
Normal file
1108
tools/Perl/bin/ppm.pl
Normal file
File diff suppressed because it is too large
Load diff
211
tools/Perl/bin/uninstall.pl
Normal file
211
tools/Perl/bin/uninstall.pl
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
#
|
||||
# Uninstall.pl
|
||||
#
|
||||
# Author: Michael Smith (mikes@ActiveState.com)
|
||||
#
|
||||
# Copyright © 1998 ActiveState Tool Corp., all rights reserved.
|
||||
#
|
||||
###########################################################
|
||||
|
||||
use Win32::Registry;
|
||||
use File::Find;
|
||||
use MetabaseConfig;
|
||||
|
||||
my $data_file = $ARGV[0];
|
||||
my $ENVIRONMENT_KEY = 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment';
|
||||
|
||||
ReadData();
|
||||
Warn();
|
||||
UninstallDependents();
|
||||
CleanPath();
|
||||
RemoveIISVirtDirs();
|
||||
RemoveIISScriptMaps();
|
||||
RemoveLinesFromFiles();
|
||||
RemoveDirectories();
|
||||
RemoveFiles();
|
||||
CallInstallShield();
|
||||
sleep(3);
|
||||
exit(0);
|
||||
|
||||
sub ReadData {
|
||||
print "Reading uninstall data...\n";
|
||||
my $data = '';
|
||||
$rv = open(DATA, "<$data_file");
|
||||
if($rv) {
|
||||
map($data .= $_, <DATA>);
|
||||
close(DATA);
|
||||
eval($data);
|
||||
}else{
|
||||
die "Error reading uninstallation data file. Aborting!!";
|
||||
}
|
||||
}
|
||||
|
||||
sub Warn {
|
||||
print "This will uninstall $app_name. Do you wish to continue?\n";
|
||||
print "[y|N] ==>";
|
||||
my $response = '';
|
||||
while(($response = <STDIN>) !~ /^[\nyn]/i){};
|
||||
if($response !~ /^y/i) {
|
||||
print "Aborting $app_name uninstallation!\n";
|
||||
exit(0);
|
||||
}
|
||||
}
|
||||
|
||||
sub UninstallDependents {
|
||||
my $RegObj = 0;
|
||||
my $UninstallString = '';
|
||||
my $type = 0;
|
||||
my $rv = 0;
|
||||
|
||||
foreach $dependent (@$dependents) {
|
||||
print "$dependent is dependent on $app_name\n" .
|
||||
"and will not function correctly without it.\n" .
|
||||
"Would you like to uninstall $dependent?\n" .
|
||||
"[y|n] ==>";
|
||||
while(($response = <STDIN>) !~ /[yn]/i){};
|
||||
|
||||
if($response =~ /y/i) {
|
||||
$rv = $HKEY_LOCAL_MACHINE->Open("software\\microsoft\\windows\\currentversion\\uninstall\\$dependent", $RegObj);
|
||||
if($rv) {
|
||||
$rv = $RegObj->QueryValueEx("UninstallString", $type, $UninstallString);
|
||||
if($rv) {
|
||||
$RegObj->Close();
|
||||
print $UninstallString;
|
||||
print "Uninstalling $dependent...\n";
|
||||
$rv = (system($UninstallString) ? 0 : 1);
|
||||
}
|
||||
}
|
||||
|
||||
if(!$rv) {
|
||||
print "Error uninstalling $dependent!\n\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub CleanPath {
|
||||
if(@$path_info) {
|
||||
print "Cleaning PATH...\n";
|
||||
my $path = '';
|
||||
if(Win32::IsWinNT) {
|
||||
my $Environment = 0;
|
||||
if($HKEY_LOCAL_MACHINE->Open($ENVIRONMENT_KEY, $Environment)) {
|
||||
if($Environment->QueryValueEx("PATH", $type, $path)) {
|
||||
for $dir (@$path_info) {
|
||||
$dir =~ s/\\/\\\\/g;
|
||||
$path =~ s/$dir;?//ig;
|
||||
}
|
||||
$Environment->SetValueEx("PATH", -1, $type, $path);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
my $file = "$ENV{'SystemDrive'}/autoexec.bat";
|
||||
if(open(FILE, "<$file")) {
|
||||
my @statements = <FILE>;
|
||||
close(FILE);
|
||||
my $path = '';
|
||||
for $statement (@statements) {
|
||||
if($statement =~ /\s+path\s?=/i) {
|
||||
$path = $statement;
|
||||
for $dir (@$path_info) {
|
||||
$dir =~ s/\\/\\\\/g;
|
||||
$path =~ s/$dir;?//ig;
|
||||
}
|
||||
}
|
||||
}
|
||||
if(open(FILE, ">$file")) {
|
||||
print FILE @statements;
|
||||
close(FILE);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub RemoveIISVirtDirs {
|
||||
if(@$iis_virt_dir) {
|
||||
print "Removing IIS4 virtual directories...\n";
|
||||
for $virt_dir (@$iis_virt_dir) {
|
||||
$rv = MetabaseConfig::DeleteVirDir(1, $virt_dir);
|
||||
if($rv =~ /^Error/i){
|
||||
print "$rv\n";
|
||||
system('pause');
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub RemoveIISScriptMaps {
|
||||
if(keys %$iis_script_map) {
|
||||
print "Removing IIS4 script maps...\n";
|
||||
my $virt_dir = '';
|
||||
for $key (keys %$iis_script_map) {
|
||||
print "Virtual Directory ==> $key\n";
|
||||
for $script_map (@{$iis_script_map->{$key}}) {
|
||||
print "\t$key ==> $script_map\n";
|
||||
$virt_dir = $key;
|
||||
$virt_dir = ($virt_dir eq '.' ? '' : $virt_dir);
|
||||
$rv = MetabaseConfig::RemoveFileExtMapping(1, $virt_dir, $script_map);
|
||||
if($rv =~ /^Error/i){
|
||||
print "$rv\n";
|
||||
system('pause');
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub RemoveLinesFromFiles {
|
||||
my $file;
|
||||
|
||||
foreach $file (keys %$lines_in_file) {
|
||||
open(FILE, "<$file") or next;
|
||||
my @lines = <FILE>;
|
||||
close(FILE);
|
||||
open(FILE, ">$file") or next;
|
||||
LINE: foreach $line (@lines) {
|
||||
chomp $line;
|
||||
for ($offset = 0; $offset <= $#{$$lines_in_file{$file}}; $offset++) {
|
||||
if ($line eq $$lines_in_file{$file}[$offset]) {
|
||||
splice(@{$$lines_in_file{$file}}, $offset, 1);
|
||||
next LINE;
|
||||
}
|
||||
}
|
||||
print FILE "$line\n";
|
||||
}
|
||||
close(FILE);
|
||||
}
|
||||
}
|
||||
|
||||
sub RemoveDirectories {
|
||||
if(@$directory) {
|
||||
print "Removing directories...\n";
|
||||
for $dir (@$directory) {
|
||||
finddepth(\&DeleteFiles, $dir);
|
||||
rmdir($dir);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub RemoveFiles {
|
||||
if(@$file) {
|
||||
print "Removing files...\n";
|
||||
for $file (@$file) {
|
||||
unlink($file);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub CallInstallShield {
|
||||
print "Calling InstallShield...\n";
|
||||
system("start $is_uninstall_string");
|
||||
}
|
||||
|
||||
sub DeleteFiles {
|
||||
if(-d $File::Find::name) {
|
||||
rmdir("$File::Find::name");
|
||||
} else {
|
||||
unlink("$File::Find::name");
|
||||
}
|
||||
}
|
||||
|
||||
120
tools/Perl/pl/REP.PL
Normal file
120
tools/Perl/pl/REP.PL
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
# main
|
||||
#{
|
||||
($ReportFile,$OldFile)=@ARGV;
|
||||
|
||||
if ($OldFile ne "")
|
||||
{
|
||||
ReadOldFile($OldFile);
|
||||
}
|
||||
|
||||
&FindStuff($ReportFile);
|
||||
#}
|
||||
|
||||
sub ReadOldFile
|
||||
{
|
||||
local ($INFILE)=@_;
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
chop $_;
|
||||
next if ($_ eq "");
|
||||
|
||||
if (/^Reporting Section (\w+)\s/)
|
||||
{
|
||||
local($Section)=$1;
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
chop $_;
|
||||
last if ($_ eq "");
|
||||
if (/^(\w+)\s+(\d+)/)
|
||||
{
|
||||
local ($FileName)=$1;
|
||||
local ($Size)=$2;
|
||||
local ($SecFile)="$Section:$FileName";
|
||||
|
||||
$OldSecFileToSize{$SecFile}=$2;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
die "Expection section got $_";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub FindStuff
|
||||
{
|
||||
local ($INFILE)=@_;
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
chop $_;
|
||||
last if (/^Program/);
|
||||
|
||||
if (/^\s[A-Z0-9]+\s[A-Z0-9]+\s([A-Z0-9]+)\s[A-Z0-9]+\s(\w+)+\s+\.(\w+)_.*/)
|
||||
{
|
||||
$Size=$1;
|
||||
$Section=$2;
|
||||
$File=$3;
|
||||
|
||||
push (@AllSecs,$Section) if (!$SecSeen{$Section}++);
|
||||
|
||||
$SecToRec{$Section}.="!" if ($SecToRec{$Section} ne "");
|
||||
$SecToRec{$Section}.="$File:$Size";
|
||||
}
|
||||
}
|
||||
|
||||
close(INFILE);
|
||||
|
||||
foreach $Sec (@AllSecs)
|
||||
{
|
||||
local(@Recs)=split(/!/,$SecToRec{$Sec});
|
||||
local(%SizeToFile);
|
||||
|
||||
local ($SizeInAll)=0;
|
||||
|
||||
foreach $DatRec (@Recs)
|
||||
{
|
||||
($File,$Size)= split(/:/,$DatRec);
|
||||
$Size=hex($Size);
|
||||
|
||||
$SizeInAll+=$Size;
|
||||
|
||||
$SizeToFile{$Size}.=":" if ($SizeToFile{$Size} ne "");
|
||||
$SizeToFile{$Size}.=$File;
|
||||
}
|
||||
|
||||
$SizeK=$SizeInAll/1024;
|
||||
|
||||
print "\nReporting Section $Sec ($SizeK $SizeInAll)\n";
|
||||
|
||||
foreach $Num (sort numerically keys(%SizeToFile))
|
||||
{
|
||||
local(@Files)=split(/:/,$SizeToFile{$Num});
|
||||
|
||||
foreach $LastFile (@Files)
|
||||
{
|
||||
print "$LastFile\t$Num";
|
||||
local($SecFile)="$Sec:$LastFile";
|
||||
|
||||
if ($OldSecFileToSize{$SecFile})
|
||||
{
|
||||
local($Changed)=$Num-$OldSecFileToSize{$SecFile};
|
||||
print"\t$Changed";
|
||||
# print"was $OldSecFileToSize{$SecFile}";
|
||||
}
|
||||
|
||||
print "\n";
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub numerically { $b <=> $a;}
|
||||
94
tools/Perl/pl/anim.pl
Normal file
94
tools/Perl/pl/anim.pl
Normal file
|
|
@ -0,0 +1,94 @@
|
|||
LettersAndNames=
|
||||
(
|
||||
"A","ANGRY",
|
||||
"B","BORED",
|
||||
"C","CHEER",
|
||||
"F","FIGHT",
|
||||
"H","THROW",
|
||||
"I","ITCH",
|
||||
"K","CRY",
|
||||
"L","LOOPLEASE",
|
||||
"N","SLIDE",
|
||||
"O","DEAD",
|
||||
"R","RUN",
|
||||
"S","STAND",
|
||||
"T","TUMBLE",
|
||||
# "U","WATING",
|
||||
"V","VOMIT",
|
||||
"W","WALK",
|
||||
"Y","YARN",
|
||||
);
|
||||
|
||||
foreach $Val (keys %LettersAndNames)
|
||||
{
|
||||
push (@Letters,$Val);
|
||||
}
|
||||
|
||||
while (<>)
|
||||
{
|
||||
foreach $Letter (@Letters)
|
||||
{
|
||||
if (/(FRM_CH\d$Letter\d+)/)
|
||||
{
|
||||
$AllFrames{$Letter}.=":$1";
|
||||
}
|
||||
}
|
||||
}
|
||||
print ("/* Generated by anim.pl, so please don't go hand editing this file like some sort of cunt. xxxx gaz. */ \n");
|
||||
|
||||
print ("#include \"data\\graf\\kid.h\"\n");
|
||||
print ("#include \"gfx\\anim.h\"\n\n");
|
||||
|
||||
foreach $Letter (@Letters)
|
||||
{
|
||||
@ThisLettersFrames=split(/:/,$AllFrames{$Letter});
|
||||
|
||||
$LargestFrame=0;
|
||||
|
||||
foreach $Frame (@ThisLettersFrames)
|
||||
{
|
||||
$Frame=~/FRM_CH\d$Letter(\d+)/;
|
||||
$LargestFrame=$1 if ($1 > $LargestFrame);
|
||||
}
|
||||
|
||||
{
|
||||
|
||||
$LargestFrame=sprintf("%d",$LargestFrame);
|
||||
$NumOfFrames=$LargestFrame+1;
|
||||
|
||||
for ($f=1;$f<6;$f++)
|
||||
{
|
||||
printf("static u16 const ANM_$LettersAndNames{$Letter}$f\[$NumOfFrames\]={",);
|
||||
|
||||
for ($i=0;$i<$NumOfFrames;$i++)
|
||||
{
|
||||
$Str=sprintf("FRM_CH$f$Letter%04d,",$i);
|
||||
print $Str;
|
||||
}
|
||||
|
||||
print "};\n";
|
||||
}
|
||||
print("\nstatic ANM const ANM_$LettersAndNames{$Letter}={");
|
||||
print ("$NumOfFrames,");
|
||||
print ("{");
|
||||
|
||||
for ($f=1;$f<6;$f++)
|
||||
{
|
||||
print "ANM_$LettersAndNames{$Letter}$f,";
|
||||
}
|
||||
print ("}};\n\n\n");
|
||||
}
|
||||
}
|
||||
|
||||
print "ANM const * const AnimTab[]=\n{\n";
|
||||
|
||||
foreach $Letter (@Letters)
|
||||
{
|
||||
print "\t&ANM_$LettersAndNames{$Letter},\n";
|
||||
|
||||
}
|
||||
|
||||
print "};\n";
|
||||
|
||||
|
||||
|
||||
37
tools/Perl/pl/check.pl
Normal file
37
tools/Perl/pl/check.pl
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
$HadOver=0;
|
||||
|
||||
while (<>)
|
||||
{
|
||||
chop $_;
|
||||
$File=$_;
|
||||
|
||||
if ($File ne "")
|
||||
{
|
||||
local($INFILE)=$File;
|
||||
binmode($INFILE);
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
binmode INFILE;
|
||||
$Size= -s INFILE;
|
||||
|
||||
$buf='';
|
||||
read(INFILE,$buf,$Size);
|
||||
|
||||
if ($buf=~/_GLOBAL_\.[ID]/)
|
||||
{
|
||||
print "Construction code in $File\n";
|
||||
$HadOver=1;
|
||||
}
|
||||
|
||||
close(INFILE);
|
||||
}
|
||||
}
|
||||
|
||||
if ($HadOver == 0)
|
||||
{
|
||||
print "No errors";
|
||||
}
|
||||
else
|
||||
{
|
||||
print "Error: Constructors in overlay code";
|
||||
}
|
||||
97
tools/Perl/pl/checkdat.pl
Normal file
97
tools/Perl/pl/checkdat.pl
Normal file
|
|
@ -0,0 +1,97 @@
|
|||
$Errors=0;
|
||||
|
||||
while (<>)
|
||||
{
|
||||
/^\[(.*)\]/;
|
||||
|
||||
if ($1 ne "")
|
||||
{
|
||||
local (@Text);
|
||||
local ($StrId)=($1);
|
||||
|
||||
$Text[0]=GetLang("Eng");
|
||||
$Text[1]=GetLang("Fre");
|
||||
$Text[2]=GetLang("Ger");
|
||||
$Text[3]=GetLang("Swe");
|
||||
$Text[5]=GetLang("Jap");
|
||||
|
||||
$Errors+=CheckPerc($StrId,@Text);
|
||||
}
|
||||
}
|
||||
|
||||
if ($Errors != 0)
|
||||
{
|
||||
print "Some monkey's messed up the dbase with $Errors errors";
|
||||
}
|
||||
|
||||
sub GetLang
|
||||
{
|
||||
local ($LangStr)=@_;
|
||||
|
||||
$_=<>;
|
||||
die if (!(/($LangStr=\".*\")/));
|
||||
("File $ARGV line $. : $1");
|
||||
}
|
||||
|
||||
|
||||
sub CheckPerc
|
||||
{
|
||||
local ($StrId,@Text)=@_;
|
||||
local ($f);
|
||||
local ($Errors);
|
||||
|
||||
@Master=MakePercArray($Text[0]);
|
||||
|
||||
for ($f=1;$f<6;$f++)
|
||||
{
|
||||
local (@Local)=MakePercArray($Text[$f]);
|
||||
|
||||
if (!CheckPercArray(@Local))
|
||||
{
|
||||
print "Error with $StrId\n";
|
||||
$Text[0]=~/^File .* line .* : (.*)/;
|
||||
local ($ShouldBe)=$1;
|
||||
print "Should be $ShouldBe\n";
|
||||
print "$Text[$f]\n\n";
|
||||
$Errors++;
|
||||
}
|
||||
}
|
||||
return($Errors);
|
||||
}
|
||||
|
||||
sub CheckPercArray
|
||||
{
|
||||
local(@Local)=@_;
|
||||
local ($f);
|
||||
|
||||
for ($f=0;$f<@Local;$f++)
|
||||
{
|
||||
return(0) if ($Local[$f] ne $Master[$f])
|
||||
}
|
||||
|
||||
return(1);
|
||||
}
|
||||
|
||||
sub MakePercArray
|
||||
{
|
||||
local ($Str)=@_;
|
||||
local (@Ret);
|
||||
|
||||
$Str=~s/%%/!!/g;
|
||||
|
||||
while (1)
|
||||
{
|
||||
if ($Str=~/%([A-Za-z0-9+-]*)/)
|
||||
{
|
||||
push (@Ret,$1);
|
||||
$Str=$';
|
||||
}
|
||||
else
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
return(@Ret);
|
||||
|
||||
}
|
||||
18
tools/Perl/pl/dep.pl
Normal file
18
tools/Perl/pl/dep.pl
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
# main
|
||||
#{
|
||||
($InFile,$OutFile,$ObjFile)=@ARGV;
|
||||
|
||||
$OutFile=">$OutFile";
|
||||
|
||||
open(InFile) || die "Can't open in file $InFile; $!";
|
||||
open(OutFile) || die "Can't open in file $OutFile; $!";
|
||||
|
||||
while (<InFile>)
|
||||
{
|
||||
s/^.*\.obj.*:\w*.*\.cpp/$ObjFile:/g;
|
||||
print (OutFile $_);
|
||||
}
|
||||
|
||||
close(OutFile);
|
||||
close(InFile);
|
||||
#}
|
||||
60
tools/Perl/pl/features.pl
Normal file
60
tools/Perl/pl/features.pl
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
$OutFile=shift(@ARGV);
|
||||
$World=shift(@ARGV);
|
||||
$Type=shift(@ARGV);
|
||||
$Command=shift(@ARGV);
|
||||
$DataOut=shift(@ARGV);
|
||||
$GrafDir=shift(@ARGV);
|
||||
|
||||
$OutFile=">$OutFile";
|
||||
|
||||
open(OutFile) || die "Can't open in file $OutFile; $!";
|
||||
|
||||
printf(OutFile ".PHONY : $World$Type clean$World$Type\n\n");
|
||||
|
||||
foreach $Val (@ARGV)
|
||||
{
|
||||
@Stuff=split(/-/,$Val);
|
||||
$ArsName=shift(@Stuff);
|
||||
|
||||
push(@ArsNames,$ArsName);
|
||||
|
||||
$ArsNameToAnims{$ArsName}=join('!',@Stuff);
|
||||
}
|
||||
|
||||
printf(OutFile "$World$Type");
|
||||
printf(OutFile "_ARS_FILES := ");
|
||||
|
||||
foreach $Ars (@ArsNames)
|
||||
{printf(OutFile "$DataOut$Ars.ars ");}
|
||||
|
||||
printf(OutFile "\n");
|
||||
|
||||
foreach $Ars (@ArsNames)
|
||||
{
|
||||
printf(OutFile "$DataOut$Ars.ars : ");
|
||||
|
||||
@Anims=split(/!/,$ArsNameToAnims{$Ars});
|
||||
|
||||
foreach $Anim (@Anims)
|
||||
{printf(OutFile "$GrafDir$Ars/$Anim.gin ");}
|
||||
|
||||
printf(OutFile "\n\t$Command ");
|
||||
|
||||
foreach $Anim (@Anims)
|
||||
{printf(OutFile "$GrafDir$Ars/$Anim.gin ");}
|
||||
|
||||
printf(OutFile "\n\n");
|
||||
}
|
||||
|
||||
printf(OutFile "$World$Type : \$($World$Type");
|
||||
printf(OutFile "_ARS_FILES)\n\n");
|
||||
|
||||
printf(OutFile "clean$World$Type :\n");
|
||||
printf(OutFile "\t\@\$(RM) -f \$($World$Type");
|
||||
printf(OutFile "_ARS_FILES)\n");
|
||||
printf(OutFile "\t\@\$(ECHO) Cleaned $World $Type\n");
|
||||
|
||||
close(OutFile);
|
||||
|
||||
|
||||
|
||||
204
tools/Perl/pl/gfxmak.pl
Normal file
204
tools/Perl/pl/gfxmak.pl
Normal file
|
|
@ -0,0 +1,204 @@
|
|||
|
||||
$OutFile=shift(@ARGV);
|
||||
$World=shift(@ARGV);
|
||||
$DataOut=shift(@ARGV);
|
||||
$GrafDir=shift(@ARGV);
|
||||
|
||||
if (0)
|
||||
{
|
||||
printf "OutFile : $OutFile\n";
|
||||
printf "World : $World\n";
|
||||
printf "DataOut : $DataOut\n";
|
||||
printf "GrafDir : $GrafDir\n";
|
||||
printf "\n";
|
||||
}
|
||||
|
||||
$OutFile=">$OutFile";
|
||||
|
||||
open(OutFile) || die "Can't open in file $OutFile; $!";
|
||||
|
||||
$RidesDir=$GrafDir;
|
||||
|
||||
$RidesOutDir=$DataOut;
|
||||
|
||||
foreach $Val (@ARGV)
|
||||
{
|
||||
@Stuff=split(/-/,$Val);
|
||||
|
||||
$RideBank=shift(@Stuff);
|
||||
|
||||
$RideName=shift(@Stuff);
|
||||
|
||||
if ($RideBank eq 1)
|
||||
{
|
||||
push(@RideNamesBank1,$RideName);
|
||||
}
|
||||
|
||||
if ($RideBank eq 2)
|
||||
{
|
||||
push(@RideNamesBank2,$RideName);
|
||||
}
|
||||
|
||||
|
||||
push(@RideNames,$RideName);
|
||||
|
||||
$RideNameToAnims{$RideName}=join('!',@Stuff);
|
||||
$RideNameToRideBank{$RideName}=$RideBank;
|
||||
}
|
||||
|
||||
foreach $Ride (@RideNames)
|
||||
{push (@AllArsFiles,"$RidesOutDir$Ride.ars");}
|
||||
|
||||
$SharedOutWorld_1 ="shared_out_";
|
||||
$SharedOutWorld_1 .="$World";
|
||||
$SharedOutWorld_1 .="_1";
|
||||
|
||||
|
||||
$SharedOutWorld_2 ="shared_out_";
|
||||
$SharedOutWorld_2 .="$World";
|
||||
$SharedOutWorld_2 .="_2";
|
||||
|
||||
print (OutFile ".PHONY : make$World clean$World shared$World shared$World");
|
||||
print (OutFile "1 shared$World");
|
||||
print (OutFile "2 cleanshared$World\n\n");
|
||||
|
||||
printf(OutFile "shared_out_$World := \$(REPORT_DIR)/$World.rep\n");
|
||||
|
||||
printf (OutFile "$SharedOutWorld_1 := \$(REPORT_DIR)/$World");
|
||||
printf (OutFile "_1.rep\n");
|
||||
|
||||
printf (OutFile "$SharedOutWorld_2 := \$(REPORT_DIR)/$World");
|
||||
printf (OutFile "_2.rep\n");
|
||||
|
||||
printf (OutFile "\n\n");
|
||||
|
||||
print (OutFile $World,"_ARS_FILES := ",join(' ',@AllArsFiles),"\n\n");
|
||||
|
||||
|
||||
printf (OutFile "BANK_1_GIN_$World := ");
|
||||
|
||||
foreach $Ride (@RideNamesBank1)
|
||||
{
|
||||
@TheseGins=split(/!/,$RideNameToAnims{$Ride});
|
||||
foreach $Gin (@TheseGins)
|
||||
{
|
||||
printf(OutFile "$GrafDir$Ride/$Gin.gin ");
|
||||
}
|
||||
}
|
||||
|
||||
printf (OutFile "\n");
|
||||
|
||||
|
||||
printf (OutFile "BANK_2_GIN_$World := ");
|
||||
|
||||
foreach $Ride (@RideNamesBank2)
|
||||
{
|
||||
@TheseGins=split(/!/,$RideNameToAnims{$Ride});
|
||||
foreach $Gin (@TheseGins)
|
||||
{
|
||||
printf(OutFile "$GrafDir$Ride/$Gin.gin ");
|
||||
}
|
||||
}
|
||||
printf (OutFile "\n");
|
||||
|
||||
printf (OutFile "\n\n");
|
||||
|
||||
|
||||
foreach $Ride (@RideNames)
|
||||
{
|
||||
@Anims=split(/!/,$RideNameToAnims{$Ride});
|
||||
|
||||
printf (OutFile "$RidesOutDir$Ride.ars : ");
|
||||
|
||||
foreach $RideAnim (@Anims)
|
||||
{printf (OutFile "$RidesDir$Ride/$RideAnim.gin ");}
|
||||
|
||||
print (OutFile "\n\t@\$(ECHO) Creating $Ride.ars from ",join(" ",@Anims));
|
||||
print (OutFile "\n\t\$(");
|
||||
print (OutFile "$World");
|
||||
print (OutFile "_MAKE_RIDE_");
|
||||
print (OutFile "$RideNameToRideBank{$Ride}) ");
|
||||
|
||||
foreach $RideAnim (@Anims)
|
||||
{printf (OutFile "$RidesDir$Ride/$RideAnim.gin ");}
|
||||
|
||||
print (OutFile "\n\n");
|
||||
}
|
||||
|
||||
|
||||
printf(OutFile "\nshared$World");
|
||||
printf(OutFile "1 : \$($SharedOutWorld_1)\n\n");
|
||||
|
||||
printf(OutFile "\nshared$World");
|
||||
printf(OutFile "2 : \$($SharedOutWorld_2)\n\n");
|
||||
|
||||
printf(OutFile "\ncleanshared$World");
|
||||
printf(OutFile "1 :\n\t\$(RM) -f \$($SharedOutWorld_1)\n\n");
|
||||
|
||||
printf(OutFile "\ncleanshared$World");
|
||||
printf(OutFile "2 :\n\t\$(RM) -f \$($SharedOutWorld_2)\n\n");
|
||||
|
||||
printf(OutFile "\nshared$World : \$(shared_out_$World)\n\n");
|
||||
|
||||
printf(OutFile "cleanshared$World : \n\t\$(RM) -f \$(shared_out_$World)\n\n");
|
||||
|
||||
printf(OutFile "\$(shared_out_$World) : \$($World");
|
||||
printf(OutFile "_shared_tx_full)\n");
|
||||
printf(OutFile "\t\$(MAKE_SHARED) \$($World");
|
||||
|
||||
printf(OutFile "_shared_tx_full) \$($World");
|
||||
printf(OutFile "_anim_shared_tx_full)\n\n");
|
||||
|
||||
printf(OutFile "\$(");
|
||||
printf(OutFile $World);
|
||||
printf(OutFile "_ARS_FILES) : \$(shared_out_$World) \$($SharedOutWorld_1) \$($SharedOutWorld_2)\n\n");
|
||||
|
||||
printf(OutFile "\$($SharedOutWorld_1) : \$(BANK_1_GIN_$World)\n\t\$(MAKE_SHARED_1) \$(BANK_1_GIN_$World)\n\n");
|
||||
printf(OutFile "\$($SharedOutWorld_2) : \$(BANK_1_GIN_$World)\n\t\$(MAKE_SHARED_2) \$(BANK_2_GIN_$World)\n\n");
|
||||
|
||||
print (OutFile "make$World : shared$World shared$World");
|
||||
print (OutFile "1 shared$World");
|
||||
print (OutFile "2 \$(",$World,"_ARS_FILES)\n\n");
|
||||
|
||||
print (OutFile "shared$World");
|
||||
print (OutFile "1 shared$World");
|
||||
print (OutFile "2 : shared$World\n");
|
||||
|
||||
printf (OutFile "\n\n");
|
||||
|
||||
print (OutFile "clean$World :\n\t@\$(RM) -f \$(",$World,"_ARS_FILES)\n\t@\$(ECHO) cleaned $World rides\n");
|
||||
|
||||
printf (OutFile "\n");
|
||||
printf (OutFile "\n");
|
||||
|
||||
printf (OutFile "\n\n");
|
||||
|
||||
|
||||
close(OutFile);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
147
tools/Perl/pl/lang.pl
Normal file
147
tools/Perl/pl/lang.pl
Normal file
|
|
@ -0,0 +1,147 @@
|
|||
#=========================================================================
|
||||
#
|
||||
# LANG.PL
|
||||
#
|
||||
# Author: Gary Liddon @ Climax
|
||||
# Created:
|
||||
# Project: TPW PSX
|
||||
# Purpose:
|
||||
# Usage:
|
||||
#
|
||||
# Copyright (c) 1999 Climax Development Ltd
|
||||
#
|
||||
#===========================================================================
|
||||
|
||||
# PKG - Added check for invalid id tags
|
||||
|
||||
|
||||
#MAIN
|
||||
#{
|
||||
local ($englishFile,$outFile,@langFiles)=@ARGV;
|
||||
|
||||
readTransFile($englishFile,"eng",\%english);
|
||||
|
||||
foreach $Id (keys(%english))
|
||||
{
|
||||
$idToTrans{$Id}="eng=$english{$Id}";
|
||||
}
|
||||
|
||||
|
||||
foreach $file (@langFiles)
|
||||
{
|
||||
local (%otherLang);
|
||||
$otherLang={};
|
||||
|
||||
printf "trying $file\n";
|
||||
|
||||
if ($file=~/^.*\\(.*)\.dat/)
|
||||
{
|
||||
$prefix=$1;
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($file=~/^.*\/(.*)\.dat/)
|
||||
{
|
||||
$prefix=$1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
printf "reading $file\n";
|
||||
readTransFile($file,$prefix,\%otherLang);
|
||||
printf "read $file\n";
|
||||
|
||||
foreach $Id (keys(%english))
|
||||
{
|
||||
if ($otherLang{$Id} ne "")
|
||||
{
|
||||
local (@trans)=split(/arsebiscuits/,$idToTrans{$Id});
|
||||
push(@trans,"$prefix=$otherLang{$Id}");
|
||||
$idToTrans{$Id}=join('arsebiscuits',@trans);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if ($outFile ne "")
|
||||
{
|
||||
$OUTFILE= ">$outFile";
|
||||
|
||||
open(OUTFILE) || die "Can't open file $outFile; $!";
|
||||
|
||||
foreach $Id (keys(%idToTrans))
|
||||
{
|
||||
print (OUTFILE "[$Id]\n");
|
||||
|
||||
local (@trans)=split(/arsebiscuits/,$idToTrans{$Id});
|
||||
|
||||
foreach $text (@trans)
|
||||
{
|
||||
print (OUTFILE "$text\n");
|
||||
}
|
||||
|
||||
print (OUTFILE "\n");
|
||||
}
|
||||
|
||||
close(OUTFILE);
|
||||
}
|
||||
|
||||
#}
|
||||
|
||||
# Read a translation file into an associative array
|
||||
sub readTransFile
|
||||
{
|
||||
local($inFile,$prefix,$destArray)=@_;
|
||||
|
||||
$INFILE = $inFile;
|
||||
|
||||
open(INFILE) || die "Can't open file $inFile; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
if (/^\[(.*)]\n/)
|
||||
{
|
||||
$id=$1;
|
||||
if($id=~/[^a-zA-Z0-9_]/)
|
||||
{
|
||||
die("Invalid id tag [$id] in $inFile\nTag may only contain a-z, A-Z, 0-9 and _\n");
|
||||
}
|
||||
|
||||
$Done = 0;
|
||||
|
||||
while (!$Done)
|
||||
{
|
||||
$_=<INFILE>;
|
||||
chop $_;
|
||||
s/;.*//g;
|
||||
|
||||
if ($_ ne "")
|
||||
{
|
||||
if (/^(.*)\=(.*)/)
|
||||
{
|
||||
if ($1 eq $prefix)
|
||||
{
|
||||
|
||||
$text=$2;
|
||||
$Done=1;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
print "!$_!";
|
||||
die "incorrectly formatted file $inFile\nlooking for $prefix=<text> for id $id\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$$destArray{$id}="$text";
|
||||
}
|
||||
}
|
||||
|
||||
close(INFILE);
|
||||
}
|
||||
|
||||
|
||||
|
||||
#===========================================================================
|
||||
#ends
|
||||
25
tools/Perl/pl/makeconf.pl
Normal file
25
tools/Perl/pl/makeconf.pl
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
use Win32;
|
||||
|
||||
&WriteConf($ARGV[0],$ARGV[1]);
|
||||
|
||||
sub WriteConf
|
||||
{
|
||||
local ($INFILE,$OutName)=@_;
|
||||
local ($OUTFILE);
|
||||
$OUTFILE=">";
|
||||
$OUTFILE.=$OutName;
|
||||
|
||||
$Name=Win32::LoginName;
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
open(OUTFILE) || die "Can't open output file $OutName; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
s/\!/$Name/g;
|
||||
print (OUTFILE $_);
|
||||
}
|
||||
|
||||
close($OUTFILE);
|
||||
close(INFILE);
|
||||
}
|
||||
42
tools/Perl/pl/mkbig.pl
Normal file
42
tools/Perl/pl/mkbig.pl
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
#=========================================================================
|
||||
#
|
||||
# MKSTR.PL
|
||||
#
|
||||
# Author: Gary Liddon @ Climax
|
||||
# Created:
|
||||
# Project: Diablo PSX
|
||||
# Purpose: Makes some bse files from a base file
|
||||
# Usage: pl mkstr.pl <base file> <data dir> <gfx dir> <music dir> <stream sfx dir> <sfx dir>
|
||||
#
|
||||
# Copyright (c) 1997 Climax Development Ltd
|
||||
#
|
||||
#===========================================================================
|
||||
|
||||
|
||||
#MAIN
|
||||
#{
|
||||
|
||||
local ($BaseFile,$BinDir,$OutFile)=@ARGV;
|
||||
|
||||
$OUTFILE=">";
|
||||
$OUTFILE.=$OutFile;
|
||||
|
||||
local ($INFILE)=$BaseFile;
|
||||
|
||||
open(OUTFILE) || die "Can't open output file $OutFile: $!";
|
||||
open(INFILE) || die "Can't open monst inffile $InfFile; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
s/\[BINDIR\]/$BinDir/g;
|
||||
s/\//\\/g;
|
||||
print (OUTFILE $_);
|
||||
}
|
||||
|
||||
print "written $OutFile\n";
|
||||
|
||||
close(INFILE);
|
||||
close($OUTFILE);
|
||||
#}
|
||||
|
||||
|
||||
48
tools/Perl/pl/mkstr.pl
Normal file
48
tools/Perl/pl/mkstr.pl
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
#=========================================================================
|
||||
#
|
||||
# MKSTR.PL
|
||||
#
|
||||
# Author: Gary Liddon @ Climax
|
||||
# Created:
|
||||
# Project: Diablo PSX
|
||||
# Purpose: Makes some bse files from a base file
|
||||
# Usage: pl mkstr.pl <base file> <data dir> <gfx dir> <music dir> <stream sfx dir> <sfx dir>
|
||||
#
|
||||
# Copyright (c) 1997 Climax Development Ltd
|
||||
#
|
||||
#===========================================================================
|
||||
|
||||
|
||||
#MAIN
|
||||
#{
|
||||
|
||||
local ($BaseFile,$DataDir,$GfxDir,$VagDir,$SfxDir,$OutFile)=@ARGV;
|
||||
|
||||
#die if ($BaseFile eq "" or $DataDir eq "" or $GfxDir eq "" or $MusicDir eq "" or $StreamSfxDir eq "" or $SfxDir or $OutFile eq "");
|
||||
|
||||
$OUTFILE=">";
|
||||
$OUTFILE.=$OutFile;
|
||||
|
||||
local ($INFILE)=$BaseFile;
|
||||
|
||||
open(OUTFILE) || die "Can't open output file $OutFile: $!";
|
||||
open(INFILE) || die "Can't open monst inffile $InfFile; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
s/\[DATA\]/$DataDir/g;
|
||||
s/\[GFX\]/$GfxDir/g;
|
||||
s/\[VAG\]/$VagDir/g;
|
||||
s/\[SFX\]/$SfxDir/g;
|
||||
s/\//\\/g;
|
||||
print (OUTFILE $_);
|
||||
}
|
||||
|
||||
print "written $OutFile\n";
|
||||
|
||||
close(INFILE);
|
||||
close($OUTFILE);
|
||||
|
||||
#}
|
||||
|
||||
|
||||
22
tools/Perl/pl/notused.pl
Normal file
22
tools/Perl/pl/notused.pl
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
while (<>)
|
||||
{
|
||||
if (/^\s+.*\s+(\d+)\s+(\d+)\s+(\d+)/)
|
||||
{
|
||||
if ($1 eq "0")
|
||||
{
|
||||
if ($2 eq "0")
|
||||
{
|
||||
if ($3 eq "0")
|
||||
{
|
||||
print "$_";
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
print $_;
|
||||
|
||||
}
|
||||
}
|
||||
64
tools/Perl/pl/shops.pl
Normal file
64
tools/Perl/pl/shops.pl
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
$OutFile=shift(@ARGV);
|
||||
$World=shift(@ARGV);
|
||||
$Type=shift(@ARGV);
|
||||
$Command=shift(@ARGV);
|
||||
$DataOut=shift(@ARGV);
|
||||
$GrafDir=shift(@ARGV);
|
||||
|
||||
$OutFile=">$OutFile";
|
||||
|
||||
open(OutFile) || die "Can't open in file $OutFile; $!";
|
||||
|
||||
printf(OutFile "ifdef POO\n");
|
||||
|
||||
printf(OutFile ".PHONY : $World$Type clean$World$Type\n\n");
|
||||
|
||||
foreach $Val (@ARGV)
|
||||
{
|
||||
@Stuff=split(/-/,$Val);
|
||||
$ArsName=shift(@Stuff);
|
||||
|
||||
push(@ArsNames,$ArsName);
|
||||
|
||||
$ArsNameToAnims{$ArsName}=join('!',@Stuff);
|
||||
}
|
||||
|
||||
printf(OutFile "$World$Type");
|
||||
printf(OutFile "_ARS_FILES := ");
|
||||
|
||||
foreach $Ars (@ArsNames)
|
||||
{printf(OutFile "$DataOut$Ars.ars ");}
|
||||
|
||||
printf(OutFile "\n");
|
||||
|
||||
foreach $Ars (@ArsNames)
|
||||
{
|
||||
printf(OutFile "$DataOut$Ars.ars : ");
|
||||
|
||||
@Anims=split(/!/,$ArsNameToAnims{$Ars});
|
||||
|
||||
foreach $Anim (@Anims)
|
||||
{printf(OutFile "$GrafDir$Ars/$Anim.gin ");}
|
||||
|
||||
printf(OutFile "\n\t$Command ");
|
||||
|
||||
foreach $Anim (@Anims)
|
||||
{printf(OutFile "$GrafDir$Ars/$Anim.gin ");}
|
||||
|
||||
printf(OutFile "\n\n");
|
||||
}
|
||||
|
||||
printf(OutFile "$World$Type : \$($World$Type");
|
||||
printf(OutFile "_ARS_FILES)\n\n");
|
||||
|
||||
printf(OutFile "clean$World$Type :\n");
|
||||
printf(OutFile "\t\@\$(RM) -f \$($World$Type");
|
||||
printf(OutFile "_ARS_FILES)\n");
|
||||
printf(OutFile "\t\@\$(ECHO) Cleaned $World $Type\n");
|
||||
|
||||
printf(OutFile "\n\nendif");
|
||||
|
||||
close(OutFile);
|
||||
|
||||
|
||||
|
||||
37
tools/Perl/pl/size.pl
Normal file
37
tools/Perl/pl/size.pl
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
|
||||
&PrintSize($ARGV[0]);
|
||||
|
||||
|
||||
sub PrintSize
|
||||
{
|
||||
local ($INFILE)=@_;
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
chop $_;
|
||||
|
||||
if (/^\s[A-Z0-9]+\s([A-Z0-9]+)\s[A-Z0-9]+\s[A-Z0-9]+\s\w+\s+\.last/)
|
||||
{
|
||||
$Addr=$1;
|
||||
|
||||
$Addr=hex($Addr)-hex("80000000");
|
||||
$Over=$Addr-(2*1024*1024);
|
||||
if ($Over ge 0)
|
||||
{
|
||||
print "Size is $Addr ($Over over)\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
$Over=0-$Over;
|
||||
print "Size is $Addr ($Over to spare)\n";
|
||||
}
|
||||
last;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
51
tools/Perl/pl/sizes.pl
Normal file
51
tools/Perl/pl/sizes.pl
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
&GetSizes($ARGV[0]);
|
||||
|
||||
|
||||
|
||||
sub GetSizes
|
||||
{
|
||||
local ($INFILE)=@_;
|
||||
|
||||
open(INFILE) || die "Can't open in file $INFILE; $!";
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
last if (/.*Names in address order/);
|
||||
}
|
||||
|
||||
while (<INFILE>)
|
||||
{
|
||||
chop $_;
|
||||
|
||||
if (/^\s([A-F0-9][A-F0-9][A-F0-9][A-F0-9][A-F0-9][A-F0-9][A-F0-9][A-F0-9])\s(.*)/)
|
||||
{
|
||||
$Addr=$1;
|
||||
$Label=$2;
|
||||
$Addr=hex($Addr);
|
||||
|
||||
if ($Addr >= hex("80000000"))
|
||||
{
|
||||
if (!$Seen{$Label})
|
||||
{
|
||||
$Seen{$Label}++;
|
||||
$Addr=$Addr-hex("80000000");
|
||||
|
||||
if ($LastLabel ne "")
|
||||
{
|
||||
print "$LastLabel\tsize\t",$Addr-$LastAddr,"\n";
|
||||
}
|
||||
|
||||
$LastAddr=$Addr;
|
||||
$LastLabel=$Label;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
close(INFILE);
|
||||
}
|
||||
96
tools/Perl/pl/stats.pl
Normal file
96
tools/Perl/pl/stats.pl
Normal file
|
|
@ -0,0 +1,96 @@
|
|||
|
||||
while (<>)
|
||||
{
|
||||
/^.*:\s+(.*)\n/;
|
||||
$CodeFile=$1;
|
||||
|
||||
if ($CodeFile ne "")
|
||||
{
|
||||
$Code=<>;
|
||||
$Data=<>;
|
||||
$Bss=<>;
|
||||
<>;
|
||||
|
||||
$Code=&GetNum($Code);
|
||||
$Data=&GetNum($Data);
|
||||
$Bss=&GetNum($Bss);;
|
||||
|
||||
$CodeSizeToFile{$Code}.="!" if ($CodeSizeToFile{$Code} ne "");
|
||||
$CodeSizeToFile{$Code}.=$CodeFile;
|
||||
|
||||
$DataSizeToFile{$Data}.="!" if ($DataSizeToFile{$Data} ne "");
|
||||
$DataSizeToFile{$Data}.=$CodeFile;
|
||||
|
||||
$BssSizeToFile{$Bss}.="!" if ($BssSizeToFile{$Bss} ne "");
|
||||
$BssSizeToFile{$Bss}.=$CodeFile;
|
||||
}
|
||||
else
|
||||
{
|
||||
die "Strange line $_";
|
||||
}
|
||||
}
|
||||
|
||||
print "Code Section\n";
|
||||
print "------------\n";
|
||||
|
||||
foreach $Num (sort numerically keys(%CodeSizeToFile))
|
||||
{
|
||||
local(@Files)=split(/!/,$CodeSizeToFile{$Num});
|
||||
|
||||
foreach $File (@Files)
|
||||
{
|
||||
print "$File\t$Num\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "\n";
|
||||
|
||||
|
||||
print "Data Section\n";
|
||||
print "------------\n";
|
||||
|
||||
foreach $Num (sort numerically keys(%DataSizeToFile))
|
||||
{
|
||||
local(@Files)=split(/!/,$DataSizeToFile{$Num});
|
||||
|
||||
foreach $File (@Files)
|
||||
{
|
||||
print "$File\t$Num\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "\n";
|
||||
|
||||
print "Bss Section\n";
|
||||
print "-----------\n";
|
||||
|
||||
foreach $Num (sort numerically keys(%BssSizeToFile))
|
||||
{
|
||||
local(@Files)=split(/!/,$BssSizeToFile{$Num});
|
||||
|
||||
foreach $File (@Files)
|
||||
{
|
||||
print "$File\t$Num\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "\n";
|
||||
|
||||
sub GetNum
|
||||
{
|
||||
local ($Line)=@_;
|
||||
|
||||
if ($Line=~/^\s+\w+\s+size:\s+(\d+)/)
|
||||
{
|
||||
($1);
|
||||
}
|
||||
else
|
||||
{
|
||||
die "Fuck";
|
||||
}
|
||||
|
||||
($1);
|
||||
}
|
||||
|
||||
|
||||
sub numerically { $b <=> $a;}
|
||||
21
tools/Perl/pl/user.pl
Normal file
21
tools/Perl/pl/user.pl
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
use Win32;
|
||||
|
||||
if ($ARGV[0] ne "")
|
||||
{
|
||||
&WriteUserFile($ARGV[0]);
|
||||
}
|
||||
|
||||
sub WriteUserFile
|
||||
{
|
||||
local ($OutName)=@_;
|
||||
local ($OUTFILE);
|
||||
$OUTFILE=">";
|
||||
$OUTFILE.=$OutName;
|
||||
|
||||
open(OUTFILE) || die "Can't open output file $OutName; $!";
|
||||
|
||||
$Name=lc(Win32::LoginName);
|
||||
print (OUTFILE "USER_NAME := $Name\n");
|
||||
|
||||
close($OUTFILE);
|
||||
}
|
||||
BIN
tools/chkshare.exe
Normal file
BIN
tools/chkshare.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/a.exe
Normal file
BIN
tools/cygwin/a.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/addr2line.exe
Normal file
BIN
tools/cygwin/addr2line.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/ar.exe
Normal file
BIN
tools/cygwin/ar.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/as.exe
Normal file
BIN
tools/cygwin/as.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/awk.exe
Normal file
BIN
tools/cygwin/awk.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/basename.exe
Normal file
BIN
tools/cygwin/basename.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/bash.exe
Normal file
BIN
tools/cygwin/bash.exe
Normal file
Binary file not shown.
143
tools/cygwin/bashbug
Normal file
143
tools/cygwin/bashbug
Normal file
|
|
@ -0,0 +1,143 @@
|
|||
#!/bin/sh -
|
||||
#
|
||||
# bashbug - create a bug report and mail it to the bug address
|
||||
#
|
||||
# The bug address depends on the release status of the shell. Versions
|
||||
# with status `alpha' or `beta' mail bug reports to chet@po.cwru.edu.
|
||||
# Other versions send mail to bug-bash@gnu.org.
|
||||
#
|
||||
# configuration section:
|
||||
# these variables are filled in by the make target in cpp-Makefile
|
||||
#
|
||||
MACHINE="i586"
|
||||
OS="cygwin32"
|
||||
CC="i586-cygwin32-gcc"
|
||||
CFLAGS=" -DPROGRAM='bash.exe' -DHOSTTYPE='i586' -DOSTYPE='cygwin32' -DMACHTYPE='i586-pc-cygwin32' -DCROSS_COMPILING -DSHELL -DHAVE_CONFIG_H -I. -I/home/noer/src/b20/user-tools/devo/bash -I/home/noer/src/b20/user-tools/devo/bash/lib -O2"
|
||||
RELEASE="2.02"
|
||||
PATCHLEVEL="1"
|
||||
RELSTATUS="release"
|
||||
MACHTYPE="i586-pc-cygwin32"
|
||||
|
||||
PATH=/bin:/usr/bin:/usr/local/bin:$PATH
|
||||
export PATH
|
||||
|
||||
TEMP=/tmp/bbug.$$
|
||||
|
||||
# Figure out how to echo a string without a trailing newline
|
||||
N=`echo 'hi there\c'`
|
||||
case "$N" in
|
||||
*c) n=-n c= ;;
|
||||
*) n= c='\c' ;;
|
||||
esac
|
||||
|
||||
BASHTESTERS="bash-testers@po.cwru.edu"
|
||||
|
||||
case "$RELSTATUS" in
|
||||
alpha*|beta*) BUGBASH=chet@po.cwru.edu ;;
|
||||
*) BUGBASH=bug-bash@gnu.org ;;
|
||||
esac
|
||||
|
||||
case "$RELSTATUS" in
|
||||
alpha*|beta*) echo "$0: This is a testing release. Would you like your bug report"
|
||||
echo "$0: to be sent to the bash-testers mailing list?"
|
||||
echo $n "$0: Send to bash-testers? $c"
|
||||
read ans
|
||||
case "$ans" in
|
||||
y*|Y*) BUGBASH="${BUGBASH},${BASHTESTERS}" ;;
|
||||
esac ;;
|
||||
esac
|
||||
|
||||
BUGADDR="${1-$BUGBASH}"
|
||||
|
||||
: ${EDITOR=emacs}
|
||||
|
||||
: ${USER=${LOGNAME-`whoami`}}
|
||||
|
||||
trap 'rm -f $TEMP $TEMP.x; exit 1' 1 2 3 13 15
|
||||
trap 'rm -f $TEMP $TEMP.x' 0
|
||||
|
||||
UN=
|
||||
if (uname) >/dev/null 2>&1; then
|
||||
UN=`uname -a`
|
||||
fi
|
||||
|
||||
if [ -f /usr/lib/sendmail ] ; then
|
||||
RMAIL="/usr/lib/sendmail"
|
||||
elif [ -f /usr/sbin/sendmail ] ; then
|
||||
RMAIL="/usr/sbin/sendmail"
|
||||
else
|
||||
RMAIL=rmail
|
||||
fi
|
||||
|
||||
# this is raceable
|
||||
rm -f $TEMP
|
||||
|
||||
cat > $TEMP <<EOF
|
||||
From: ${USER}
|
||||
To: ${BUGADDR}
|
||||
Subject: [50 character or so descriptive subject here (for reference)]
|
||||
|
||||
Configuration Information [Automatically generated, do not change]:
|
||||
Machine: $MACHINE
|
||||
OS: $OS
|
||||
Compiler: $CC
|
||||
Compilation CFLAGS: $CFLAGS
|
||||
uname output: $UN
|
||||
Machine Type: $MACHTYPE
|
||||
|
||||
Bash Version: $RELEASE
|
||||
Patch Level: $PATCHLEVEL
|
||||
Release Status: $RELSTATUS
|
||||
|
||||
Description:
|
||||
[Detailed description of the problem, suggestion, or complaint.]
|
||||
|
||||
Repeat-By:
|
||||
[Describe the sequence of events that causes the problem
|
||||
to occur.]
|
||||
|
||||
Fix:
|
||||
[Description of how to fix the problem. If you don't know a
|
||||
fix for the problem, don't include this section.]
|
||||
EOF
|
||||
|
||||
# this is still raceable
|
||||
rm -f $TEMP.x
|
||||
cp $TEMP $TEMP.x
|
||||
chmod u+w $TEMP
|
||||
|
||||
trap '' 2 # ignore interrupts while in editor
|
||||
|
||||
until $EDITOR $TEMP; do
|
||||
echo "$0: editor \`$EDITOR' exited with nonzero status."
|
||||
echo "$0: Perhaps it was interrupted."
|
||||
echo "$0: Type \`y' to give up, and lose your bug report;"
|
||||
echo "$0: type \`n' to re-enter the editor."
|
||||
echo $n "$0: Do you want to give up? $c"
|
||||
|
||||
read ans
|
||||
case "$ans" in
|
||||
[Yy]*) exit 1 ;;
|
||||
esac
|
||||
done
|
||||
|
||||
trap 'rm -f $TEMP $TEMP.x; exit 1' 2 # restore trap on SIGINT
|
||||
|
||||
if cmp -s $TEMP $TEMP.x
|
||||
then
|
||||
echo "File not changed, no bug report submitted."
|
||||
exit
|
||||
fi
|
||||
|
||||
echo $n "Send bug report? [y/n] $c"
|
||||
read ans
|
||||
case "$ans" in
|
||||
[Nn]*) exit 0 ;;
|
||||
esac
|
||||
|
||||
${RMAIL} $BUGADDR < $TEMP || {
|
||||
cat $TEMP >> $HOME/dead.bashbug
|
||||
echo "$0: mail failed: report saved in $HOME/dead.bashbug" >&2
|
||||
}
|
||||
|
||||
exit 0
|
||||
BIN
tools/cygwin/bison.exe
Normal file
BIN
tools/cygwin/bison.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/bunzip2.exe
Normal file
BIN
tools/cygwin/bunzip2.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/byacc.exe
Normal file
BIN
tools/cygwin/byacc.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/bzcat.exe
Normal file
BIN
tools/cygwin/bzcat.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/bzip2.exe
Normal file
BIN
tools/cygwin/bzip2.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/bzip2recover.exe
Normal file
BIN
tools/cygwin/bzip2recover.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/c++.exe
Normal file
BIN
tools/cygwin/c++.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/c++filt.exe
Normal file
BIN
tools/cygwin/c++filt.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cat.exe
Normal file
BIN
tools/cygwin/cat.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/chgrp.exe
Normal file
BIN
tools/cygwin/chgrp.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/chmod.exe
Normal file
BIN
tools/cygwin/chmod.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/chown.exe
Normal file
BIN
tools/cygwin/chown.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/chroot.exe
Normal file
BIN
tools/cygwin/chroot.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cksum.exe
Normal file
BIN
tools/cygwin/cksum.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cmp.exe
Normal file
BIN
tools/cygwin/cmp.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/comm.exe
Normal file
BIN
tools/cygwin/comm.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cp.exe
Normal file
BIN
tools/cygwin/cp.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/csplit.exe
Normal file
BIN
tools/cygwin/csplit.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cut.exe
Normal file
BIN
tools/cygwin/cut.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cygcheck.exe
Normal file
BIN
tools/cygwin/cygcheck.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cygpath.exe
Normal file
BIN
tools/cygwin/cygpath.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cygtclsh80.exe
Normal file
BIN
tools/cygwin/cygtclsh80.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/cygwish80.exe
Normal file
BIN
tools/cygwin/cygwish80.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/date.exe
Normal file
BIN
tools/cygwin/date.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dd.exe
Normal file
BIN
tools/cygwin/dd.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/df.exe
Normal file
BIN
tools/cygwin/df.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/diff.exe
Normal file
BIN
tools/cygwin/diff.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/diff3.exe
Normal file
BIN
tools/cygwin/diff3.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dir.exe
Normal file
BIN
tools/cygwin/dir.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dircolors.exe
Normal file
BIN
tools/cygwin/dircolors.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dirname.exe
Normal file
BIN
tools/cygwin/dirname.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dlltool.exe
Normal file
BIN
tools/cygwin/dlltool.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/dllwrap.exe
Normal file
BIN
tools/cygwin/dllwrap.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/du.exe
Normal file
BIN
tools/cygwin/du.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/echo.exe
Normal file
BIN
tools/cygwin/echo.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/egrep.exe
Normal file
BIN
tools/cygwin/egrep.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/env.exe
Normal file
BIN
tools/cygwin/env.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/expand.exe
Normal file
BIN
tools/cygwin/expand.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/expect.exe
Normal file
BIN
tools/cygwin/expect.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/expr.exe
Normal file
BIN
tools/cygwin/expr.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/factor.exe
Normal file
BIN
tools/cygwin/factor.exe
Normal file
Binary file not shown.
24
tools/cygwin/false
Normal file
24
tools/cygwin/false
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
#!/bin/sh
|
||||
|
||||
usage="Usage: $0 [OPTION]...
|
||||
Exit unsucessfully.
|
||||
|
||||
--help display this help and exit
|
||||
--version output version information and exit
|
||||
|
||||
Report bugs to sh-utils-bugs@gnu.ai.mit.edu"
|
||||
|
||||
case $# in
|
||||
1 )
|
||||
case "z${1}" in
|
||||
z--help )
|
||||
echo "$usage"; exit 0 ;;
|
||||
z--version )
|
||||
echo "false (GNU sh-utils) 1.16"; exit 0 ;;
|
||||
* ) ;;
|
||||
esac
|
||||
;;
|
||||
* ) ;;
|
||||
esac
|
||||
|
||||
exit 1
|
||||
BIN
tools/cygwin/fgrep.exe
Normal file
BIN
tools/cygwin/fgrep.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/find.exe
Normal file
BIN
tools/cygwin/find.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/flex++.exe
Normal file
BIN
tools/cygwin/flex++.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/flex.exe
Normal file
BIN
tools/cygwin/flex.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/fmt.exe
Normal file
BIN
tools/cygwin/fmt.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/fold.exe
Normal file
BIN
tools/cygwin/fold.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/g++.exe
Normal file
BIN
tools/cygwin/g++.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/gasp.exe
Normal file
BIN
tools/cygwin/gasp.exe
Normal file
Binary file not shown.
BIN
tools/cygwin/gawk.exe
Normal file
BIN
tools/cygwin/gawk.exe
Normal file
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue