r71055 - in /branches/upstream/libfile-listing-perl: ./ current/ current/lib/ current/lib/File/ current/t/

periapt-guest at users.alioth.debian.org periapt-guest at users.alioth.debian.org
Thu Mar 10 19:48:40 UTC 2011


Author: periapt-guest
Date: Thu Mar 10 19:44:19 2011
New Revision: 71055

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71055
Log:
[svn-inject] Installing original source of libfile-listing-perl (6.00)

Added:
    branches/upstream/libfile-listing-perl/
    branches/upstream/libfile-listing-perl/current/
    branches/upstream/libfile-listing-perl/current/Changes
    branches/upstream/libfile-listing-perl/current/MANIFEST
    branches/upstream/libfile-listing-perl/current/META.yml
    branches/upstream/libfile-listing-perl/current/Makefile.PL
    branches/upstream/libfile-listing-perl/current/README
    branches/upstream/libfile-listing-perl/current/lib/
    branches/upstream/libfile-listing-perl/current/lib/File/
    branches/upstream/libfile-listing-perl/current/lib/File/Listing.pm
    branches/upstream/libfile-listing-perl/current/t/
    branches/upstream/libfile-listing-perl/current/t/apache.t
    branches/upstream/libfile-listing-perl/current/t/ls-lR.t

Added: branches/upstream/libfile-listing-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/Changes?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/Changes (added)
+++ branches/upstream/libfile-listing-perl/current/Changes Thu Mar 10 19:44:19 2011
@@ -1,0 +1,8 @@
+_______________________________________________________________________________
+2011-02-25 File-Listing 6.00
+
+Initial release of File-Listing as a separate distribution.  The File::Listing
+module used to be bundled with the libwww-perl distribution.
+
+Since libwww-perl-5.837 File::Listing has been made able to deal with listings
+full of table markup (like what we find at http://www.cpan.org/modules/by-module/).

Added: branches/upstream/libfile-listing-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/MANIFEST?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/MANIFEST (added)
+++ branches/upstream/libfile-listing-perl/current/MANIFEST Thu Mar 10 19:44:19 2011
@@ -1,0 +1,8 @@
+Changes
+lib/File/Listing.pm
+Makefile.PL
+MANIFEST			This list of files
+README
+t/apache.t
+t/ls-lR.t
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libfile-listing-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/META.yml?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/META.yml (added)
+++ branches/upstream/libfile-listing-perl/current/META.yml Thu Mar 10 19:44:19 2011
@@ -1,0 +1,26 @@
+--- #YAML:1.0
+name:               File-Listing
+version:            6.00
+abstract:           parse directory listing
+author:
+    - Gisle Aas <gisle at activestate.com>
+license:            perl
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    HTTP::Date:  6
+    perl:        5.008008
+resources:
+    MailingList:  mailto:libwww at perl.org
+    repository:   http://github.com/gisle/libwww-perl
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.56
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Added: branches/upstream/libfile-listing-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/Makefile.PL?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/Makefile.PL (added)
+++ branches/upstream/libfile-listing-perl/current/Makefile.PL Thu Mar 10 19:44:19 2011
@@ -1,0 +1,45 @@
+#!perl -w
+
+require 5.008008;
+use strict;
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME => 'File::Listing',
+    VERSION_FROM => 'lib/File/Listing.pm',
+    ABSTRACT_FROM => 'lib/File/Listing.pm',
+    AUTHOR => 'Gisle Aas <gisle at activestate.com>',
+    LICENSE => "perl",
+    MIN_PERL_VERSION => 5.008008,
+    PREREQ_PM => {
+	'HTTP::Date' => 6,
+    },
+    META_MERGE => {
+	resources => {
+            repository => 'http://github.com/gisle/libwww-perl',
+	    MailingList => 'mailto:libwww at perl.org',
+        }
+    },
+);
+
+
+BEGIN {
+    # compatibility with older versions of MakeMaker
+    my $developer = -f ".gitignore";
+    my %mm_req = (
+        LICENCE => 6.31,
+        META_MERGE => 6.45,
+        META_ADD => 6.45,
+        MIN_PERL_VERSION => 6.48,
+    );
+    undef(*WriteMakefile);
+    *WriteMakefile = sub {
+        my %arg = @_;
+        for (keys %mm_req) {
+            unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) {
+                warn "$_ $@" if $developer;
+                delete $arg{$_};
+            }
+        }
+        ExtUtils::MakeMaker::WriteMakefile(%arg);
+    };
+}

Added: branches/upstream/libfile-listing-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/README?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/README (added)
+++ branches/upstream/libfile-listing-perl/current/README Thu Mar 10 19:44:19 2011
@@ -1,0 +1,52 @@
+NAME
+    File::Listing - parse directory listing
+
+SYNOPSIS
+     use File::Listing qw(parse_dir);
+     $ENV{LANG} = "C";  # dates in non-English locales not supported
+     for (parse_dir(`ls -l`)) {
+         ($name, $type, $size, $mtime, $mode) = @$_;
+         next if $type ne 'f'; # plain file
+         #...
+     }
+
+     # directory listing can also be read from a file
+     open(LISTING, "zcat ls-lR.gz|");
+     $dir = parse_dir(\*LISTING, '+0000');
+
+DESCRIPTION
+    This module exports a single function called parse_dir(), which can be
+    used to parse directory listings.
+
+    The first parameter to parse_dir() is the directory listing to parse. It
+    can be a scalar, a reference to an array of directory lines or a glob
+    representing a filehandle to read the directory listing from.
+
+    The second parameter is the time zone to use when parsing time stamps in
+    the listing. If this value is undefined, then the local time zone is
+    assumed.
+
+    The third parameter is the type of listing to assume. Currently
+    supported formats are 'unix', 'apache' and 'dosftp'. The default value
+    'unix'. Ideally, the listing type should be determined automatically.
+
+    The fourth parameter specifies how unparseable lines should be treated.
+    Values can be 'ignore', 'warn' or a code reference. Warn means that the
+    perl warn() function will be called. If a code reference is passed, then
+    this routine will be called and the return value from it will be
+    incorporated in the listing. The default is 'ignore'.
+
+    Only the first parameter is mandatory.
+
+    The return value from parse_dir() is a list of directory entries. In a
+    scalar context the return value is a reference to the list. The
+    directory entries are represented by an array consisting of [ $filename,
+    $filetype, $filesize, $filetime, $filemode ]. The $filetype value is one
+    of the letters 'f', 'd', 'l' or '?'. The $filetime value is the seconds
+    since Jan 1, 1970. The $filemode is a bitmask like the mode returned by
+    stat().
+
+CREDITS
+    Based on lsparse.pl (from Lee McLoughlin's ftp mirror package) and
+    Net::FTP's parse_dir (Graham Barr).
+

Added: branches/upstream/libfile-listing-perl/current/lib/File/Listing.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/lib/File/Listing.pm?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/lib/File/Listing.pm (added)
+++ branches/upstream/libfile-listing-perl/current/lib/File/Listing.pm Thu Mar 10 19:44:19 2011
@@ -1,0 +1,413 @@
+package File::Listing;
+
+sub Version { $VERSION; }
+$VERSION = "6.00";
+
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT = qw(parse_dir);
+
+use strict;
+
+use Carp ();
+use HTTP::Date qw(str2time);
+
+
+
+sub parse_dir ($;$$$)
+{
+   my($dir, $tz, $fstype, $error) = @_;
+
+   $fstype ||= 'unix';
+   $fstype = "File::Listing::" . lc $fstype;
+
+   my @args = $_[0];
+   push(@args, $tz) if(@_ >= 2);
+   push(@args, $error) if(@_ >= 4);
+
+   $fstype->parse(@args);
+}
+
+
+sub line { Carp::croak("Not implemented yet"); }
+sub init { } # Dummy sub
+
+
+sub file_mode ($)
+{
+    # This routine was originally borrowed from Graham Barr's
+    # Net::FTP package.
+
+    local $_ = shift;
+    my $mode = 0;
+    my($type,$ch);
+
+    s/^(.)// and $type = $1;
+
+    while (/(.)/g) {
+	$mode <<= 1;
+	$mode |= 1 if $1 ne "-" &&
+		      $1 ne 'S' &&
+		      $1 ne 't' &&
+		      $1 ne 'T';
+    }
+
+    $type eq "d" and $mode |= 0040000 or	# Directory
+      $type eq "l" and $mode |= 0120000 or	# Symbolic Link
+	$mode |= 0100000;			# Regular File
+
+    $mode |= 0004000 if /^...s....../i;
+    $mode |= 0002000 if /^......s.../i;
+    $mode |= 0001000 if /^.........t/i;
+
+    $mode;
+}
+
+
+sub parse
+{
+   my($pkg, $dir, $tz, $error) = @_;
+
+   # First let's try to determine what kind of dir parameter we have
+   # received.  We allow both listings, reference to arrays and
+   # file handles to read from.
+
+   if (ref($dir) eq 'ARRAY') {
+       # Already splitted up
+   }
+   elsif (ref($dir) eq 'GLOB') {
+       # A file handle
+   }
+   elsif (ref($dir)) {
+      Carp::croak("Illegal argument to parse_dir()");
+   }
+   elsif ($dir =~ /^\*\w+(::\w+)+$/) {
+      # This scalar looks like a file handle, so we assume it is
+   }
+   else {
+      # A normal scalar listing
+      $dir = [ split(/\n/, $dir) ];
+   }
+
+   $pkg->init();
+
+   my @files = ();
+   if (ref($dir) eq 'ARRAY') {
+       for (@$dir) {
+	   push(@files, $pkg->line($_, $tz, $error));
+       }
+   }
+   else {
+       local($_);
+       while (<$dir>) {
+	   chomp;
+	   push(@files, $pkg->line($_, $tz, $error));
+       }
+   }
+   wantarray ? @files : \@files;
+}
+
+
+
+package File::Listing::unix;
+
+use HTTP::Date qw(str2time);
+
+# A place to remember current directory from last line parsed.
+use vars qw($curdir @ISA);
+
+ at ISA = qw(File::Listing);
+
+
+
+sub init
+{
+    $curdir = '';
+}
+
+
+sub line
+{
+    shift; # package name
+    local($_) = shift;
+    my($tz, $error) = @_;
+
+    s/\015//g;
+    #study;
+
+    my ($kind, $size, $date, $name);
+    if (($kind, $size, $date, $name) =
+	/^([\-FlrwxsStTdD]{10})                   # Type and permission bits
+	 .*                                       # Graps
+	 \D(\d+)                                  # File size
+	 \s+                                      # Some space
+	 (\w{3}\s+\d+\s+(?:\d{1,2}:\d{2}|\d{4})|\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2})  # Date
+	 \s+                                      # Some more space
+	 (.*)$                                    # File name
+	/x )
+
+    {
+	return if $name eq '.' || $name eq '..';
+	$name = "$curdir/$name" if length $curdir;
+	my $type = '?';
+	if ($kind =~ /^l/ && $name =~ /(.*) -> (.*)/ ) {
+	    $name = $1;
+	    $type = "l $2";
+	}
+	elsif ($kind =~ /^[\-F]/) { # (hopefully) a regular file
+	    $type = 'f';
+	}
+	elsif ($kind =~ /^[dD]/) {
+	    $type = 'd';
+	    $size = undef;  # Don't believe the reported size
+	}
+	return [$name, $type, $size, str2time($date, $tz), 
+              File::Listing::file_mode($kind)];
+
+    }
+    elsif (/^(.+):$/ && !/^[dcbsp].*\s.*\s.*:$/ ) {
+	my $dir = $1;
+	return () if $dir eq '.';
+	$curdir = $dir;
+	return ();
+    }
+    elsif (/^[Tt]otal\s+(\d+)$/ || /^\s*$/) {
+	return ();
+    }
+    elsif (/not found/    || # OSF1, HPUX, and SunOS return
+             # "$file not found"
+             /No such file/ || # IRIX returns
+             # "UX:ls: ERROR: Cannot access $file: No such file or directory"
+                               # Solaris returns
+             # "$file: No such file or directory"
+             /cannot find/     # Windows NT returns
+             # "The system cannot find the path specified."
+             ) {
+	return () unless defined $error;
+	&$error($_) if ref($error) eq 'CODE';
+	warn "Error: $_\n" if $error eq 'warn';
+	return ();
+    }
+    elsif ($_ eq '') {       # AIX, and Linux return nothing
+	return () unless defined $error;
+	&$error("No such file or directory") if ref($error) eq 'CODE';
+	warn "Warning: No such file or directory\n" if $error eq 'warn';
+	return ();
+    }
+    else {
+        # parse failed, check if the dosftp parse understands it
+        File::Listing::dosftp->init();
+        return(File::Listing::dosftp->line($_,$tz,$error));
+    }
+
+}
+
+
+
+package File::Listing::dosftp;
+
+use HTTP::Date qw(str2time);
+
+# A place to remember current directory from last line parsed.
+use vars qw($curdir @ISA);
+
+ at ISA = qw(File::Listing);
+
+
+
+sub init
+{
+    $curdir = '';
+}
+
+
+sub line
+{
+    shift; # package name
+    local($_) = shift;
+    my($tz, $error) = @_;
+
+    s/\015//g;
+
+    my ($date, $size_or_dir, $name, $size);
+
+    # 02-05-96  10:48AM                 1415 src.slf
+    # 09-10-96  09:18AM       <DIR>          sl_util
+    if (($date, $size_or_dir, $name) =
+        /^(\d\d-\d\d-\d\d\s+\d\d:\d\d\wM)         # Date and time info
+         \s+                                      # Some space
+         (<\w{3}>|\d+)                            # Dir or Size
+         \s+                                      # Some more space
+         (.+)$                                    # File name
+        /x )
+    {
+	return if $name eq '.' || $name eq '..';
+	$name = "$curdir/$name" if length $curdir;
+	my $type = '?';
+	if ($size_or_dir eq '<DIR>') {
+	    $type = "d";
+            $size = ""; # directories have no size in the pc listing
+        }
+        else {
+	    $type = 'f';
+            $size = $size_or_dir;
+	}
+	return [$name, $type, $size, str2time($date, $tz), undef];
+    }
+    else {
+	return () unless defined $error;
+	&$error($_) if ref($error) eq 'CODE';
+	warn "Can't parse: $_\n" if $error eq 'warn';
+	return ();
+    }
+
+}
+
+
+
+package File::Listing::vms;
+ at File::Listing::vms::ISA = qw(File::Listing);
+
+package File::Listing::netware;
+ at File::Listing::netware::ISA = qw(File::Listing);
+
+
+
+package File::Listing::apache;
+
+use vars qw(@ISA);
+
+ at ISA = qw(File::Listing);
+
+
+sub init { }
+
+
+sub line {
+    shift; # package name
+    local($_) = shift;
+    my($tz, $error) = @_; # ignored for now...
+
+    s!</?t[rd][^>]*>! !g;  # clean away various table stuff
+    if (m!<A\s+HREF=\"([^\"]+)\">.*</A>.*?(\d+)-([a-zA-Z]+|\d+)-(\d+)\s+(\d+):(\d+)\s+(?:([\d\.]+[kMG]?|-))!i) {
+	my($filename, $filesize) = ($1, $7);
+	my($d,$m,$y, $H,$M) = ($2,$3,$4,$5,$6);
+	if ($m =~ /^\d+$/) {
+	    ($d,$y) = ($y,$d) # iso date
+	}
+	else {
+	    $m = _monthabbrev_number($m);
+	}
+
+	$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,$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;
+
+__END__
+
+=head1 NAME
+
+File::Listing - parse directory listing
+
+=head1 SYNOPSIS
+
+ use File::Listing qw(parse_dir);
+ $ENV{LANG} = "C";  # dates in non-English locales not supported
+ for (parse_dir(`ls -l`)) {
+     ($name, $type, $size, $mtime, $mode) = @$_;
+     next if $type ne 'f'; # plain file
+     #...
+ }
+
+ # directory listing can also be read from a file
+ open(LISTING, "zcat ls-lR.gz|");
+ $dir = parse_dir(\*LISTING, '+0000');
+
+=head1 DESCRIPTION
+
+This module exports a single function called parse_dir(), which can be
+used to parse directory listings.
+
+The first parameter to parse_dir() is the directory listing to parse.
+It can be a scalar, a reference to an array of directory lines or a
+glob representing a filehandle to read the directory listing from.
+
+The second parameter is the time zone to use when parsing time stamps
+in the listing. If this value is undefined, then the local time zone is
+assumed.
+
+The third parameter is the type of listing to assume.  Currently
+supported formats are 'unix', 'apache' and 'dosftp'.  The default
+value 'unix'.  Ideally, the listing type should be determined
+automatically.
+
+The fourth parameter specifies how unparseable lines should be treated.
+Values can be 'ignore', 'warn' or a code reference.  Warn means that
+the perl warn() function will be called.  If a code reference is
+passed, then this routine will be called and the return value from it
+will be incorporated in the listing.  The default is 'ignore'.
+
+Only the first parameter is mandatory.
+
+The return value from parse_dir() is a list of directory entries.  In
+a scalar context the return value is a reference to the list.  The
+directory entries are represented by an array consisting of [
+$filename, $filetype, $filesize, $filetime, $filemode ].  The
+$filetype value is one of the letters 'f', 'd', 'l' or '?'.  The
+$filetime value is the seconds since Jan 1, 1970.  The
+$filemode is a bitmask like the mode returned by stat().
+
+=head1 CREDITS
+
+Based on lsparse.pl (from Lee McLoughlin's ftp mirror package) and
+Net::FTP's parse_dir (Graham Barr).

Added: branches/upstream/libfile-listing-perl/current/t/apache.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/t/apache.t?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/t/apache.t (added)
+++ branches/upstream/libfile-listing-perl/current/t/apache.t Thu Mar 10 19:44:19 2011
@@ -1,0 +1,38 @@
+#!perl -w
+
+BEGIN {
+    eval {
+	require LWP::Simple;
+    };
+    if ($@) {
+	print "1..0 # SKIP LWP::Simple not installed\n";
+	print $@;
+	exit;
+    }
+}
+
+use Test;
+
+use strict;
+use File::Listing;
+use LWP::Simple;
+
+# some sample URLs
+my @urls = (
+	    "http://www.apache.org/dist/apr/?C=N&O=D",
+	    "http://perl.apache.org/rpm/distrib/",
+	    "http://www.cpan.org/modules/by-module/",
+	   );
+plan tests => scalar(@urls);
+
+for my $url (@urls) {
+    print "# $url\n";
+    my $dir = get($url);
+    unless ($dir) {
+	print "# Can't get document at $url\n";
+	ok(0);
+	next;
+    }
+    my @listing = parse_dir($dir, undef, "apache");
+    ok(@listing);
+}

Added: branches/upstream/libfile-listing-perl/current/t/ls-lR.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-listing-perl/current/t/ls-lR.t?rev=71055&op=file
==============================================================================
--- branches/upstream/libfile-listing-perl/current/t/ls-lR.t (added)
+++ branches/upstream/libfile-listing-perl/current/t/ls-lR.t Thu Mar 10 19:44:19 2011
@@ -1,0 +1,91 @@
+#!perl -w
+
+use Test;
+plan tests => 10;
+
+use File::Listing;
+
+$dir = <<'EOL';
+total 68
+drwxr-xr-x   4 aas      users        1024 Mar 16 15:47 .
+drwxr-xr-x  11 aas      users        1024 Mar 15 19:22 ..
+drwxr-xr-x   2 aas      users        1024 Mar 16 15:47 CVS
+-rw-r--r--   1 aas      users        2384 Feb 26 21:14 Debug.pm
+-rw-r--r--   1 aas      users        2145 Feb 26 20:09 IO.pm
+-rw-r--r--   1 aas      users        3960 Mar 15 18:05 MediaTypes.pm
+-rw-r--r--   1 aas      users         792 Feb 26 20:12 MemberMixin.pm
+drwxr-xr-x   3 aas      users        1024 Mar 15 18:05 Protocol
+-rw-r--r--   1 aas      users        5613 Feb 26 20:16 Protocol.pm
+-rw-r--r--   1 aas      users        5963 Feb 26 21:27 RobotUA.pm
+-rw-r--r--   1 aas      users        5071 Mar 16 12:25 Simple.pm
+-rw-r--r--   1 aas      users        8817 Mar 15 18:05 Socket.pm
+-rw-r--r--   1 aas      users        2121 Feb  5 14:22 TkIO.pm
+-rw-r--r--   1 aas      users       19628 Mar 15 18:05 UserAgent.pm
+-rw-r--r--   1 aas      users        2841 Feb  5 19:06 media.types
+
+CVS:
+total 5
+drwxr-xr-x   2 aas      users        1024 Mar 16 15:47 .
+drwxr-xr-x   4 aas      users        1024 Mar 16 15:47 ..
+-rw-r--r--   1 aas      users         545 Mar 16 15:47 Entries
+-rw-r--r--   1 aas      users          39 Mar 10 09:05 Repository
+-rw-r--r--   1 aas      users          19 Mar 10 09:05 Root
+
+Protocol:
+total 37
+drwxr-xr-x   3 aas      users        1024 Mar 15 18:05 .
+drwxr-xr-x   4 aas      users        1024 Mar 16 15:47 ..
+drwxr-xr-x   2 aas      users        1024 Mar 15 18:05 CVS
+-rw-r--r--   1 aas      users        4646 Feb 26 20:13 file.pm
+-rw-r--r--   1 aas      users       13006 Mar 15 18:05 ftp.pm
+-rw-r--r--   1 aas      users        5935 Mar  6 10:29 gopher.pm
+-rw-r--r--   1 aas      users        5453 Mar  6 10:29 http.pm
+-rw-r--r--   1 aas      users        2365 Feb 26 20:13 mailto.pm
+
+Protocol/CVS:
+total 5
+drwxr-xr-x   2 aas      users        1024 Mar 15 18:05 .
+drwxr-xr-x   3 aas      users        1024 Mar 15 18:05 ..
+-rw-r--r--   1 aas      users         238 Mar 15 18:05 Entries
+-rw-r--r--   1 aas      users          48 Mar 10 09:05 Repository
+-rw-r--r--   1 aas      users          19 Mar 10 09:05 Root
+EOL
+
+ at dir = parse_dir($dir, undef, 'unix');
+
+ok(@dir, 25);
+
+for (@dir) {
+   ($name, $type, $size, $mtime, $mode) = @$_;
+   $size ||= 0;  # ensure that it is defined
+   printf "# %-25s $type %6d  ", $name, $size;
+   print scalar(localtime($mtime));
+   printf "  %06o", $mode;
+   print "\n";
+}
+
+# Pick out the Socket.pm line as the sample we check carefully
+($name, $type, $size, $mtime, $mode) = @{$dir[9]};
+
+ok($name, "Socket.pm");
+ok($type, "f");
+ok($size, 8817);
+
+# Must be careful when checking the time stamps because we don't know
+# which year if this script lives for a long time.
+$timestring = scalar(localtime($mtime));
+ok($timestring =~ /Mar\s+15\s+18:05/);
+
+ok($mode, 0100644);
+
+ at dir = parse_dir(<<'EOT');
+drwxr-xr-x 21 root root 704 2007-03-22 21:48 dir
+EOT
+
+ok(@dir, 1);
+ok($dir[0][0], "dir");
+ok($dir[0][1], "d");
+
+$timestring = scalar(localtime($dir[0][3]));
+print "# $timestring\n";
+ok($timestring =~ /^Thu Mar 22 21:48/);




More information about the Pkg-perl-cvs-commits mailing list