libwww-perl-5.01 under MacPerl
Paul Schinder (schinder@pjstoaster.pg.md.us)
Sat, 03 Aug 96 16:37:29 -0500
I promised a while ago to post the changes necessary to get
libwww-perl-5 working on a Macintosh under the beta MacPerl 5.002.
Here they are, using libwww-perl-5.01 and libnet-1.00 as the base
versions.
First the changes to libnet. Only trivial changes are needed to Net::FTP,
which make it completely portable:
leprss% diff FTP.pm FTP.pm-
354d353
< use File::Basename;
732,733c731
< # ($remote = $local) =~ s%.*/%%;
< $remote = basename($local);
---
> ($remote = $local) =~ s%.*/%%;
1018,1019c1016
< # ($dfile = $sfile) =~ s#.*/##
< $dfile = basename($sfile)
---
> ($dfile = $sfile) =~ s#.*/##
Net::Domain needs to be changed only because MacPerl understands
`hostname` but not `(hostname) 2>/dev/null`. I moved the method it
understands to the front.
leprss% diff Domain.pm Domain.pm-
78,83d77
< # method 3 - trusty old hostname command
< # moved to method 2 and slightly changed because this works under
< # MacPerl
< eval {
< chop($host = `hostname`); # BSD'ish
< }
85c79
< || eval {
---
> eval {
91a86,91
> }
>
>
> # method 3 - trusty old hostname command
> || eval {
> chop($host = `(hostname) 2>/dev/null`); # BSD'ish
Now to libwww-perl-5.01. I changed File::CounterFile to give Mac users
more flexibility (/usr/tmp/$file is a perfectly valid filename, but won't do
what's intended on a Mac):
95,99c95
< if($^O eq "MacOS") {
< $DEFAULT_DIR = $ENV{TMPDIR} || "";
< } else {
< $DEFAULT_DIR = $ENV{TMPDIR} || "/usr/tmp";
< }
---
> $DEFAULT_DIR = $ENV{TMPDIR} || "/usr/tmp";
114,118c110
< if($^O eq "MacOS") {
< $file = "$DEFAULT_DIR:$file" unless $file =~ /^:/;
< } else {
< $file = "$DEFAULT_DIR/$file" unless $file =~ /^[\.\/]/;
< }
---
> $file = "$DEFAULT_DIR/$file" unless $file =~ /^[\.\/]/;
LWP::MediaTypes.pm is another place where File::Basename should be used,
but that doesn't fix everything because of the different path separators.
There really ought to be methods in File::Path to construct absolute and
relative paths out of a list of names, and somewhere (Config.pm?) the
local path separator should be defined in a variable so a module writer
doesn't have to know what it is.
30d29
< use File::Basename;
50,52c49
< #push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
< # if defined $ENV{HOME}; # Some does not have a home (for instance Win32)
< push(@priv_files, "$ENV{HOME}:.media.types", "$ENV{HOME}:.mime.types")
---
> push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
56,57c53
< # for $typefile ((map {"$_/LWP/media.types"} @INC), @priv_files) {
< for $typefile ((map {"$_:LWP:media.types"} @INC), @priv_files) {
---
> for $typefile ((map {"$_/LWP/media.types"} @INC), @priv_files) {
107,108c103
< # $file =~ s,.*/,,; # only basename left
< $file = basename($file); # only basename left
---
> $file =~ s,.*/,,; # only basename left
In LWP::Protocol.pm a Unix path is assumed:
leprss% diff Protocol.pm Protocol.pm-
112,113c112
< # $package =~ s|::|/|g;
< $package =~ s|::|:|g; $package = ":".$package;
---
> $package =~ s|::|/|g;
In LWP::Protocol::file.pm a Unix path is assumed for a -d check:
leprss% diff file.pm file.pm-
103,104c103
< # $_ .= "/" if -d "$path/$_";
< $_ .= "/" if -d "$path:$_";
---
> $_ .= "/" if -d "$path/$_";
In URI::URL, the require on a pathname needs to be fixed
leprss% diff URL.pm URL.pm-
162,163c162
< # eval { require "URI/URL/$scheme.pm"; };
< eval { require ":URI:URL:$scheme.pm";};
---
> eval { require "URI/URL/$scheme.pm"; };
URI::URL::file needs to be fixed only because $Config{'osname'}
returns "MacOS" rather than "Mac".
leprss% diff file.pm file.pm-
13c13
< $ostype = 'mac', last if $os eq "MacOS";
---
> $ostype = 'mac', last if $os eq "Mac";
Now for the autosplit files. I made my changes on the .al rather than in
the .pm because I'm not worried that "make install" will trash things on my
Mac. I changed mac_path.al and newlocal.al extensively by reworking some
scripts I had already written, which can handle some pretty bizzare Unix
paths (whenever I see some of the paths that dbx comes up with I
shudder...). I've made a couple of assumptions noted in the comments, and
I'd like some guidance on whether or not they're correct. Basically I'm
not sure when things are escaped and when things are not.
auto/URI/URL/file/newlocal.al:
#-----------------------------------------------------------------------------
# NOTE: Derived from ./blib/lib/URI/URL/file.pm. Changes made here will be lost.
#
# MacPerl assumptions: $path contains a local path (with :) not a network
# path (with /). $path *must* contain a : to be
# considered absolute ($path = "Macintosh HD" will
# be treated as a relative, $path = "Macintosh HD:"
# will be treated as absolute. This is annoying, but
# then so are the MacOS rules for pathnames-in-string).
# $path should be converted to network before passing
# to $url->path. It's yet to be determined whether
# they should be generally escaped before that,
# but / in names will be taken care of here as will
# the legal names "." and "..". This may cause
# trouble if things get escaped again.
#
package URI::URL::file;
sub newlocal {
my($class, $path) = @_;
Carp::croak("This version only works for Mac filesystems")
unless $ostype eq "MacOS";
# XXX: Should implement the same thing for other systems
my $url = new URI::URL "file:";
unless (defined $path and $path !~ m/^:/ and $path =~ /:/) {
require Cwd;
my $cwd = Cwd::fastcwd();
$cwd =~ s/:?$/:/; # force trailing : on dir
$path = (defined $path) ? $cwd . $path : $cwd;
}
$path = localtonet($path);
$url->path($path);
$url;
}
sub localtonet {
#
# Mac path to the Unix like equivalent to be used in file URL's.
# This makes no attempt to detect illegal Mac paths (e.g. a:::a).
#
my $inpath = $_[0];
#
# First problem: if the path contains "/", trigraph it.
#
$inpath =~ s,/,%2F,g;
#
# If there are no :'s in the name at all, assume it's a single item in the
# current directory. Return it
#
return $inpath if ($inpath !~ m,:,);
#
# If we now split on :, there will be just as many nulls in the list as
# there should be up requests, except if it begins with a :, where there
# will be one extra.
#
my @names = split(/:/,$inpath);
shift(@names) unless $names[0];
my @outname = ();
#
# Work from the end.
#
my $i;
for($i = $#names; $i >= 0;$i--) {
unless ($names[$i]) {
unshift(@outname,"..");
} else {
$names[$i] = "%2E%2E" if($names[$i] eq "..");
$names[$i] = "%2E" if($names[$i] eq ".");
unshift(@outname,$names[$i]);
}
}
my $netpath = join("/",@outname);
if($inpath !~ m,^:,) {
return "/".$netpath;
} else {
return $netpath;
}
}
1;
#------------------------------------------------------------------------------
auto/URI/URL/file/mac_path.al
#------------------------------------------------------------------------------# NOTE: Derived from ./blib/lib/URI/URL/file.pm. Changes made here will be lost.
package URI::URL::file;
sub mac_path
{
my $self = shift;
my $path = $self->path; #this gives me an unescaped path
$path = nettolocal($path);
return $path;
}
sub nettolocal {
my $inpath = $_[0];
my $macpath = '';
#
# First nail all groups of /, and convert them to single /.
#
$inpath =~ s:/{2,}:/:g;
#
# Next get rid of the no-op, ./. But we must make sure names like
# /g./f./h. are treated as legal file names and not touched. First
# nail the possible /. at the end...
#
$inpath =~ s,/\.$,/,;
#
# and then nail the interior ./
#
$inpath =~ s,/(\./)+,/,g;
#
# Now that they're all taken care of, only the leading one should be
# left.
#
$inpath =~ s,^\./,,;
#
# If after this $inpath is empty, it must have been all ./'s. Just return
# ":" here.
#
return ":" unless ($inpath);
#
# If here $inpath = "/", we'll return an error. Guessing what might
# have been meant on a Mac is too hard. Let the user fix the path.
#
Carp::croak("root directory: which one do you mean?") if ($inpath eq "/");
#
# If there are no / left in the name, it's a file in the pwd. Simply
# return it as a Mac relative (could leave off the :, but why foster
# bad habits)
#
return ":".$inpath if ($inpath !~ m,/,);
#
# Now all that should be left are names and ../.
#
my @names = split(/\//,$inpath);
#
# There may be a null on the front if the path began with /
#
shift (@names) unless $names[0];
my @outname = ();
#
# Work from the end.
#
my $i;
for($i = $#names;$i >= 0;$i--) {
if ($names[$i] eq "..") {
unshift(@outname,"");
} else {
unshift(@outname,$names[$i]);
}
}
#
# Now check for illegal Mac names before joining them all
# together
#
foreach $name (@outname) {
if(length($name) > 31 or $name =~ /:/) {
Carp::croak("$name is > 31 characters or contains :");
}
}
$macpath = join(":",@outname);
#
# If the Unix path is relative, so should be the Mac path.
# Prepend a : (this also puts the proper number of : at the beginning if it
# already has one or more).
#
$macpath = ":".$macpath if ($inpath !~ m,^/,);
#
# This is just a nicety: if the Unix path ends in /, the Mac path should
# end in : unless it already does.
#
if ($inpath =~ m,/$,) {
$macpath .= ":" unless ($macpath =~ m,:$,);
}
return $macpath;
}
1;
#------------------------------------------------------------------------------
That's everything. I haven't done much testing yet, but everything
I've tried so far seems to work.
Because it's difficult to install libwww-perl-5 without make to do the
autosplitting, I've placed a ready-to-run Macintosh Stuffit archive of the
files needed to run libwww-perl-5 (libwww-perl-5, libnet, and MD5, already
autosplit) at the following URL:
<gopher://mors.gsfc.nasa.gov/11/MacPerl/Scripts/Beta>
---
--------
Paul J. Schinder
NASA Goddard Space Flight Center,
Code 693, Greenbelt, MD 20771 USA
schinder@pjstoaster.pg.md.us