File Coverage

blib/lib/File/Listing/Ftpcopy.pm

Criterion	Covered	Total	%
statement	60	68	88.2
branch	21	30	70.0
condition	3	6	50.0
subroutine	14	15	93.3
pod	1	1	100.0
total	99	120	82.5

package File::Listing::Ftpcopy;

use strict;
use warnings;
use 5.008001;
use Exporter;
use Carp qw( croak );
use Time::Local qw( timelocal );

# ABSTRACT: parse directory listing using ftpparse from ftpcopy
our $VERSION = '0.08'; # VERSION


sub parse_dir ($;$$$)
{
  my($listing, $time_zone, $type, $error) = @_;

  $error = sub { warn shift } if (defined $error ? $error : '') eq 'warn';

  my $next;
  if(ref($listing) eq 'ARRAY')
  {
    my @lines = @$listing;
    $next = sub { shift @lines };
  }
  elsif(ref($listing) eq 'GLOB')
  {
    $next = sub {
      my $line = <$listing>;
      $line;
    };
  }
  elsif(ref $listing)
  {
    croak "Illegal argument to parse_dir()";
  }
  elsif($listing =~ /^\*\w+(::\w+)+$/)
  {
    $next = sub {
      my $line = <$listing>;
      $line;
    };
  }
  else
  {
    my @lines = split /\015?\012/, $listing;
    $next = sub { shift @lines };
  }

  my @answer;

  my $line = $next->();
  while(defined $line)
  {
    chomp $line;
    my $h = _parse_dir($line);
    if(defined $h)
    {
      my $mtimetype = pop @$h;
      if($mtimetype == MTIME_LOCAL())
      {
        if(defined $time_zone)
        {
          my $secs = localtime($h->[3]);
          local $ENV{TZ} = $time_zone;
          $h->[3] = timelocal($secs);
        }
      }
      elsif($mtimetype == MTIME_REMOTEMINUTE()
      ||    $mtimetype == MTIME_REMOTEDAY()
      ||    $mtimetype == MTIME_REMOTESECOND())
      {
        if(defined $time_zone)
        {
          local $ENV{TZ} = $time_zone;
          $h->[3] = timelocal(gmtime($h->[3]));
        }
        else
        {
          $h->[3] = timelocal(gmtime($h->[3]));
        }
      }
      push @answer, $h;
    }
    elsif(defined $error)
    {
      $error->($line)
    }
    $line = $next->();
  }

  return wantarray ? @answer : \@answer;
}


our @ISA = qw( Exporter );
our @EXPORT = qw( parse_dir );

our %EXPORT_TAGS = (all => [qw(
  parse_dir
  ftpparse
  FORMAT_EPLF
  FORMAT_LS
  FORMAT_MLSX
  FORMAT_UNKNOWN
  ID_FULL
  ID_UNKNOWN
  MTIME_LOCAL
  MTIME_REMOTEDAY
  MTIME_REMOTEMINUTE
  MTIME_REMOTESECOND
  MTIME_UNKNOWN
  SIZE_ASCII
  SIZE_BINARY
  SIZE_UNKNOWN
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );

require XSLoader;
XSLoader::load('File::Listing::Ftpcopy', $VERSION);

sub AUTOLOAD
{
  my $name;
  our $AUTOLOAD;
  ($name = $AUTOLOAD) =~ s/.*:://;
  croak "$AUTOLOAD not defined" if $name eq '_constant';
  my $val = _constant($name);
  croak "$AUTOLOAD not defined" if $val == -1;
  do {
    no strict 'refs';
    *$AUTOLOAD = sub { $val };
  };
  goto &$AUTOLOAD;
}

1;


# http://perldoc.perl.org/perlxstut.html
# http://perldoc.perl.org/perlguts.html
# http://old.nabble.com/*URGENT*-ftpparse-licensing-issue-to61623.html
# http://fossies.org/dox/ftpcopy-0.6.7/index.html
# http://woodsheep.jp/wget-ftpparse/wget-1.5.3-ftpparse-19970712-0.52.patch

__END__