Skip Menu |
 

This queue is for tickets about the libwww-perl CPAN distribution.

Report information
The Basics
Id: 2772
Status: resolved
Priority: 0/
Queue: libwww-perl

People
Owner: Nobody in particular
Requestors: slaven [...] rezic.de
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: Additional package: File::Listing::apache
Download (untitled) / with headers
text/plain 434b
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 ####


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.