Hello,

the File::Listing documentation should probably include "dosftp" as
another option for the parse_dir function.

Attached is a script which implements an "apache" option for
parse_dir. If you like, you can include the File::Listing::apache
package into the File::Listing module.

Regards,
        Slaven
#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: $
# Author: Slaven Rezic
#

package File::Listing::apache;
@ISA = qw(File::Listing);
use Time::Local;

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;

        my $filetime = 
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};
}

package main;
use File::Listing;
use LWP::Simple;
use Data::Dumper;

# $ENV{LANG} = "C";

# some sample URLs
$url = "http://mom.intra.onlineoffice.de/~eserte/cgi/";; # local only
$url = "http://rsd.gsfc.nasa.gov/goesg/earth/Weather/GMS-5/jpg/vis/4km/";;
$url = "http://www.apache.org/~jon/scarab/nightly/";;
$url = "http://www.apache.org/dist/apr/?C=N&O=D";;
$url = "http://xml.apache.org/dist/batik/";;
$url = "http://gump.covalent.net/jars/?C=N&O=D";;
$url = "http://perl.apache.org/rpm/distrib/";;
$url = "http://stein.cshl.org/WWW/software/";;
$url = "http://www.cpan.org/modules/by-module/";;

print Data::Dumper->Dumpxs([parse_dir(get($url),undef,"apache")],[]);

__END__



-- 
use Tk;$c=tkinit->Canvas(-he,20)->grid;$x=5;map{s!\n!!g;map{create$c 'line'=>
map{$a=-43+ord;($x+($a>>3)*2=>5+($a&7)*2)}split''}split"!";$x+=12}split/_/=>'K
PI1_+09IPK_K;-OA1_+K!;A__1;Q!7G_1+QK_3CLPI90,_+K!;A_+1!KQ!.N_K+1Q!.F_1+KN.Q__1+
KN._K+1Q!.F_1+KN.Q_+1Q__+1!KQ!.N_1;Q!7G_K3,09Q_+1!K.Q_K+1Q!.F_1+KN.Q_';MainLoop

Reply via email to