[PATCH] libwww-5.10 on win32
Gurusamy Sarathy (gsar@engin.umich.edu)
Sat, 19 Jul 1997 15:23:48 -0400
This makes lwp-5.10 play on win32. Now passes all tests on
that platform.
Best,
- Sarathy.
gsar@engin.umich.edu
-------------------------------8<-------------------------------
--- libwww-perl-5.10/Makefile.PL Sat Jul 19 13:46:21 1997
+++ libwww-perl-5.101/Makefile.PL Sat Jul 19 15:06:28 1997
@@ -127,11 +127,21 @@
my @m;
if (@request_aliases && grep($_ eq 'lwp-request', @programs_to_install)) {
push @m, "all ::\n";
- push @m, "\t\$(FULLPERL) -e 'use Config; chdir q{\$(INST_EXE)}; foreach (qw(@request_aliases)) {' \\\n";
- push @m, <<'EOT';
+ if ($^O eq 'MSWin32') {
+ push @m, "\t\$(FULLPERL) -e \"use Config; chdir q[\$(INST_EXE)]; "
+ ."foreach (qw(@request_aliases)) { \" \\\n";
+ push @m, <<'EOT';
+ -e "unlink \"$$_\"; " \
+ -e "system(\"copy lwp-request $$_\") && die; }"
+EOT
+ } else {
+ push @m, "\t\$(FULLPERL) -e 'use Config; chdir q{\$(INST_EXE)}; "
+ ."foreach (qw(@request_aliases)) {' \\\n";
+ push @m, <<'EOT';
-e 'unlink "$$_";' \
-e 'system("$$Config{\"lns\"} lwp-request $$_") && die; }'
EOT
+ }
}
join "", @m;
}
--- libwww-perl-5.10/lib/LWP/UserAgent.pm Sat Jul 19 13:46:20 1997
+++ libwww-perl-5.101/lib/LWP/UserAgent.pm Sat Jul 19 14:18:17 1997
@@ -147,7 +147,9 @@
'timeout' => 3*60,
'proxy' => undef,
'use_eval' => 1,
- 'use_alarm' => ($Config::Config{d_alarm} eq 'define'),
+ 'use_alarm' => ($Config::Config{d_alarm} ?
+ $Config::Config{d_alarm} eq 'define' :
+ 0),
'parse_head' => 1,
'max_size' => undef,
'no_proxy' => [],
--- libwww-perl-5.10/lib/URI/URL/file.pm Sat Jul 19 13:46:21 1997
+++ libwww-perl-5.101/lib/URI/URL/file.pm Sat Jul 19 11:46:24 1997
@@ -56,12 +56,14 @@
my($class, $path) = @_;
Carp::croak("Only implemented for Unix and OS/2 file systems")
- unless $ostype eq "unix" or $^O eq 'os2';
+ unless $ostype eq "unix" or $^O =~ /os2|mswin32/i;
# XXX: Should implement the same thing for other systems
my $url = new URI::URL "file:";
- unless (defined $path and ($path =~ m:^/: or
- $^O eq 'os2' and Cwd::sys_is_absolute $path)) {
+ unless (defined $path and
+ ($path =~ m:^/: or
+ ($^O eq 'os2' and Cwd::sys_is_absolute($path)) or
+ ($^O eq 'MSWin32' and $path =~ m<^[A-Za-z]:[\\/]|^[\\/]{2}>))) {
require Cwd;
my $cwd = Cwd::fastcwd();
$cwd =~ s:/?$:/:; # force trailing slash on dir
--- libwww-perl-5.10/lib/URI/URL/ftp.pm Sat Jul 19 13:46:20 1997
+++ libwww-perl-5.101/lib/URI/URL/ftp.pm Sat Jul 19 12:05:06 1997
@@ -42,9 +42,10 @@
}
}
unless (defined $whoami) {
- $whoami = $ENV{USER} || $ENV{LOGNAME};
+ $whoami = $ENV{USER} || $ENV{LOGNAME} || $ENV{USERNAME};
unless ($whoami) {
- chomp($whoami = `whoami`);
+ if ($^O eq 'MSWin32') { $whoami = Win32::LoginName() }
+ else { chomp($whoami = `whoami`) }
}
}
$old = "$whoami\@$fqdn";
--- libwww-perl-5.10/t/base/uri.t Sat Jul 19 13:46:19 1997
+++ libwww-perl-5.101/t/base/uri.t Sat Jul 19 12:29:02 1997
@@ -26,9 +26,9 @@
# Must ensure that there is no relative paths in @INC because we will
# chdir in the newlocal tests.
-chomp($pwd = `pwd`);
+chomp($pwd = ($^O =~ /mswin32/i ? `cd` : `pwd`));
for (@INC) {
- next if m|^/| or $^O eq 'os2' and m|^\w:/|;
+ next if m|^/| or $^O =~ /os2|mswin32/i and m|^\w:[\\/]|;
print "Turn lib path $_ into $pwd/$_\n";
$_ = "$pwd/$_";
@@ -620,16 +620,18 @@
sub newlocal_test {
print "newlocal_test:\n";
- my $pwd = -e '/bin/pwd' ? '/bin/pwd' : 'pwd' ;
+ my $pwd = ($^O eq 'MSWin32' ? 'cd' : (-e '/bin/pwd' ? '/bin/pwd' : 'pwd'));
+ my $tmpdir = ($^O eq 'MSWin32' ? $ENV{TEMP} : '/tmp');
+ $tmpdir =~ tr|\\|/|;
my $savedir = `$pwd`; # we don't use Cwd.pm because we want to check
# that it get require'd corretly by URL.pm
chomp $savedir;
# cwd
- chdir('/tmp') or die $!;
- my $dir = `$pwd`;
- chomp $dir;
+ chdir($tmpdir) or die $!;
+ my $dir = `$pwd`; $dir =~ tr|\\|/|;
+ chomp $dir; $dir = uri_escape($dir, ':');
$url = newlocal URI::URL;
$url->_expect('as_string', URI::URL->new("file:$dir/")->as_string);
@@ -645,23 +647,25 @@
$url->_expect('as_string', 'file:/vmunix');
# relative file
- chdir('/tmp') or die $!;
- $dir = `$pwd`;
- chomp $dir;
+ chdir($tmpdir) or die $!;
+ $dir = `$pwd`; $dir =~ tr|\\|/|;
+ chomp $dir; $dir = uri_escape($dir, ':');
$url = newlocal URI::URL 'foo';
$url->_expect('as_string', "file:$dir/foo");
# relative dir
- chdir('/tmp') or die $!;
- $dir = `$pwd`;
- chomp $dir;
+ chdir($tmpdir) or die $!;
+ $dir = `$pwd`; $dir =~ tr|\\|/|;
+ chomp $dir; $dir = uri_escape($dir, ':');
$url = newlocal URI::URL 'bar/';
$url->_expect('as_string', "file:$dir/bar/");
# 0
chdir('/') or die $!;
+ $dir = `$pwd`; $dir =~ tr|\\|/|;
+ chomp $dir; $dir = uri_escape($dir, ':');
$url = newlocal URI::URL '0';
- $url->_expect('as_string', 'file:/0');
+ $url->_expect('as_string', "file:${dir}0");
# Test access methods for file URLs
$url = new URI::URL 'file:/c:/dos';
--- libwww-perl-5.10/t/local/autoload.t Sat Jul 19 13:46:19 1997
+++ libwww-perl-5.101/t/local/autoload.t Sat Jul 19 14:53:39 1997
@@ -7,14 +7,15 @@
require LWP::UserAgent;
# note no LWP::Protocol::file;
-$url = 'file://localhost/';
+# localhost will not work on win32 (when networking is disabled)
+$url = $^O eq 'MSWin32' ? 'file:.' : 'file://localhost/';
print "Trying to fetch " . (new URI::URL $url)->local_path . " ...\n";
my $ua = new LWP::UserAgent; # create a useragent to test
$ua->timeout(30); # timeout in seconds
-$ua->use_alarm(1); # don't use alarms
+$ua->use_alarm(0); # don't use alarms
#$ua->use_eval(0); # don't eval, just die when thing go wrong
# (easier to read while debugging)
--- libwww-perl-5.10/t/local/get.t Sat Jul 19 13:46:19 1997
+++ libwww-perl-5.101/t/local/get.t Sat Jul 19 14:58:14 1997
@@ -12,13 +12,14 @@
last;
}
}
+$TMPDIR ||= $ENV{TEMP} if $^O eq 'MSWin32';
unless ($TMPDIR) {
# Can't run any tests
print "1..0\n";
print "ok 1\n";
exit;
}
-
+$TMPDIR =~ tr|\\|/|;
print "1..2\n";
use LWP::Simple;
@@ -40,7 +41,7 @@
select(OUT);
# do the retrieval
-getprint("file://localhost$orig");
+getprint("file://localhost" . ($orig =~ m|^/| ? $orig : "/$orig"));
close(OUT);
select(STDOUT);
--- libwww-perl-5.10/t/local/http.t Sat Jul 19 13:46:19 1997
+++ libwww-perl-5.101/t/local/http.t Sat Jul 19 13:44:33 1997
@@ -3,9 +3,9 @@
require IO::Socket; # make sure this work before we try to make a HTTP::Daemon
# First we make ourself a daemon in another process
+my $D = shift || '';
+if ($D eq 'daemon') {
-unless (open(DAEMON, "-|")) {
-
require HTTP::Daemon;
my $d = new HTTP::Daemon Timeout => 10;
@@ -28,6 +28,9 @@
}
print STDERR "HTTP Server terminated\n";
exit;
+}
+else {
+ open(DAEMON, "perl local/http.t daemon |") or die "Can't exec daemon: $!";
}
print "1..18\n";
--- libwww-perl-5.10/t/robot/ua.t Sat Jul 19 13:46:19 1997
+++ libwww-perl-5.101/t/robot/ua.t Sat Jul 19 14:49:17 1997
@@ -3,15 +3,15 @@
require IO::Socket; # make sure this work before we try to make a HTTP::Daemon
# First we make ourself a daemon in another process
+my $D = shift || '';
+if ($D eq 'daemon') {
-unless (open(DAEMON, "-|")) {
-
require HTTP::Daemon;
my $d = new HTTP::Daemon Timeout => 10;
print "Please to meet you at: <URL:", $d->url, ">\n";
- open(STDOUT, ">/dev/null");
+ open(STDOUT, $^O eq 'MSWin32' ? ">nul" : ">/dev/null");
while ($c = $d->accept) {
$r = $c->get_request;
@@ -31,6 +31,9 @@
print STDERR "HTTP Server terminated\n";
exit;
}
+else {
+ open(DAEMON , "perl robot/ua.t daemon |") or die "Can't exec daemon: $!";
+}
print "1..7\n";
@@ -47,7 +50,8 @@
require LWP::RobotUA;
require HTTP::Request;
$ua = new LWP::RobotUA 'lwp-spider/0.1', 'gisle@aas.no';
-$ua->delay(0.05); # rather quick robot
+# 0.05 is too slow for Win32, since we won't use_alarm()
+$ua->delay($^O eq 'MSWin32' ? 0.001 : 0.05); # rather quick robot
#----------------------------------------------------------------
sub httpd_get_robotstxt