| Subject: | Additional package: File::Listing::apache |
Attached is a patch to add a new File::Listing::apache package to the
File::Listing module. The listing module should work for the standard
Apache directory listing. There's also a new test file which is not enabled
by default but can be run separately by using
perl -Mblib t/base/apache-listing.t -f
I hope this could go into the standard libwww distribution. If not,
I would like to make a separate package.
Regards,
Slaven
#
#
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# If you have a decent Bourne-type shell:
# STEP 2: Run the shell with this file as input.
# If you don't have such a shell, you may need to manually create
# the files as shown below.
# STEP 3: Run the 'patch' program with this file as input.
#
# These are the commands needed to create/delete files/directories:
#
touch 't/base/apache-listing.t'
chmod 0775 't/base/apache-listing.t'
#
# This command terminates the shell and need not be executed manually.
exit
#
#### End of Preamble ####
#### Patch data follows ####
diff -up '/usr/local/dist/cpan/build/libwww-perl-5.69/MANIFEST' 'MANIFEST'
Index: ./MANIFEST
--- ./MANIFEST Sun Jan 19 05:05:37 2003
+++ ./MANIFEST Tue Jun 10 11:44:22 2003
@@ -61,6 +61,7 @@ lwpcook.pod Libwww-perl examples
lwptut.pod Libwww-perl tutorial
t/README How to run and set up tests
t/TEST Run tests
+t/base/apache-listing.t Test File::Listing::apache package
t/base/common-req.t Test HTTP::Request::Common module
t/base/cookies.t Test HTTP::Cookies module
t/base/date.t Test HTTP::Date module
diff -up '/usr/local/dist/cpan/build/libwww-perl-5.69/lib/File/Listing.pm' 'lib/File/Listing.pm'
Index: ./lib/File/Listing.pm
Prereq: 1.11
--- ./lib/File/Listing.pm Sat Mar 20 08:37:35 1999
+++ ./lib/File/Listing.pm Tue Jun 10 11:35:34 2003
@@ -310,4 +310,64 @@ package File::Listing::vms;
package File::Listing::netware;
@File::Listing::unix::ISA = qw(File::Listing);
+package File::Listing::apache;
+@ISA = qw(File::Listing);
+
+sub init { }
+
+sub line {
+ shift; # package name
+ local($_) = shift;
+ my($tz, $error) = @_; # ignored for now...
+
+ if (m!<A\s+HREF=\"([^\"]+)\">.*</A>.*?(\d+)-([a-zA-Z]+)-(\d+)\s+(\d+):(\d+)\s+(?:([\d\.]+[kM]?|-))!i) {
+ my($filename, $filesize) = ($1, $7);
+ my($d,$m,$y, $H,$M) = ($2,$3,$4,$5,$6);
+
+ $filesize = 0 if $filesize eq '-';
+ if ($filesize =~ s/k$//i) {
+ $filesize *= 1024;
+ } elsif ($filesize =~ s/M$//) {
+ $filesize *= 1024*1024;
+ } elsif ($filesize =~ s/G$//) {
+ $filesize *= 1024*1024*1024;
+ }
+ $filesize = int $filesize;
+
+ require Time::Local;
+ my $filetime = Time::Local::timelocal(0,$M,$H,$d,_monthabbrev_number($m)-1,_guess_year($y)-1900);
+ my $filetype = ($filename =~ s|/$|| ? "d" : "f");
+ return [$filename, $filetype, $filesize, $filetime, undef];
+ }
+
+ return ();
+}
+
+sub _guess_year {
+ my $y = shift;
+ if ($y >= 90) {
+ $y = 1900+$y;
+ } elsif ($y < 100) {
+ $y = 2000+$y;
+ }
+ $y;
+}
+
+sub _monthabbrev_number {
+ my $mon = shift;
+ +{'Jan' => 1,
+ 'Feb' => 2,
+ 'Mar' => 3,
+ 'Apr' => 4,
+ 'May' => 5,
+ 'Jun' => 6,
+ 'Jul' => 7,
+ 'Aug' => 8,
+ 'Sep' => 9,
+ 'Oct' => 10,
+ 'Nov' => 11,
+ 'Dec' => 12,
+ }->{$mon};
+}
+
1;
diff -up /dev/null 't/base/apache-listing.t'
Index: ./t/base/apache-listing.t
--- ./t/base/apache-listing.t Thu Jan 1 01:00:00 1970
+++ ./t/base/apache-listing.t Tue Jun 10 11:48:34 2003
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use Getopt::Long;
+use File::Listing;
+use LWP::Simple;
+
+my $force;
+my $ok = 1;
+if (!GetOptions("f" => \$force)) {
+ die "usage";
+}
+
+if (!$force) {
+ print "1..0 # run this test with -f and a running internet connection\n";
+ exit 0;
+}
+
+# some sample URLs
+my @urls = (
+ "http://rsd.gsfc.nasa.gov/goesg/earth/Weather/GMS-5/jpg/vis/4km/",
+ "http://www.apache.org/~jon/scarab/nightly/",
+ "http://www.apache.org/dist/apr/?C=N&O=D",
+ "http://xml.apache.org/dist/batik/",
+ "http://gump.covalent.net/jars/?C=N&O=D",
+ "http://perl.apache.org/rpm/distrib/",
+ "http://stein.cshl.org/WWW/software/",
+ "http://www.cpan.org/modules/by-module/",
+ );
+print "1.." . scalar(@urls) . "\n";
+
+for my $url (@urls) {
+ my @listing = parse_dir(get($url),undef,"apache");
+ print "not " if @listing == 0;
+ print "ok " . $ok++ . "\n";
+ #require Data::Dumper; print Data::Dumper->Dump(["Listing for $url", \@listing],[]);
+}
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Tue Jun 10 11:48:37 2003
# Generated by : makepatch 2.00_07*
# Recurse directories : Yes
# Excluded files : (\A|/).*\~\Z
# (\A|/).*\.a\Z
# (\A|/).*\.bak\Z
# (\A|/).*\.BAK\Z
# (\A|/).*\.elc\Z
# (\A|/).*\.exe\Z
# (\A|/).*\.gz\Z
# (\A|/).*\.ln\Z
# (\A|/).*\.o\Z
# (\A|/).*\.obj\Z
# (\A|/).*\.olb\Z
# (\A|/).*\.old\Z
# (\A|/).*\.orig\Z
# (\A|/).*\.rej\Z
# (\A|/).*\.so\Z
# (\A|/).*\.Z\Z
# (\A|/)\.del\-.*\Z
# (\A|/)\.make\.state\Z
# (\A|/)\.nse_depinfo\Z
# (\A|/)core\Z
# (\A|/)tags\Z
# (\A|/)TAGS\Z
# p 'MANIFEST' 4923 1055238262 0100644
# p 'lib/File/Listing.pm' 8380 1055237734 0100644
# c 't/base/apache-listing.t' 0 1055238514 0100775
#### End of ApplyPatch data ####
#### End of Patch kit [created: Tue Jun 10 11:48:37 2003] ####
#### Patch checksum: 160 4836 2737 ####
#### Checksum: 190 5864 23957 ####