File Coverage

blib/lib/Net/FTPServer/XferLog.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	7	8	87.5
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	38	40	95.0

package Net::FTPServer::XferLog;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::FTPServer::XferLog ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

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

our @EXPORT = qw(

);
our $VERSION = '1.5';


# Preloaded methods go here.

# unused. was going to be strict about the parse. but it is
# time-consuming and harder to debug.

my $day_name  = qr/\w{3}/;      my $month     = qr/\w{3}/;
    my $day       = qr/\d{1,2}/;    my $time      = qr/\d{2}:\d{2}\d{2}/;
    my $year      = qr/\d{4}/;      my $xfer_time   = qr/\d+/;
    my $remote_host = qr/.*/;       my $bytes_xfer  = qr/\d+/;
    my $filename    = qr/(\w|[.])+/;my $xfer_type   = qr/([ab])/;
    my $special_act = qr/([CUT_])+/;my $direction   = qr/(o|i)/;
    my $access_mode = qr/(a|g|r)/;  my $user_name   = qr/\w+/;
    my $svc_name    = qr/ftp/;      my $auth_method = qr/(0|1)/;
    my $auth_userid = qr/([*]|\w+)/;my $status      = qr/(c|i)/;


our @field = qw(day_name month day current_time  year  transfer_time
		   remote_host     file_size  filename   transfer_type
		   special_action_flag    direction access_mode username
		   service_name    authentication_method  authenticated_user_id
		   completion_status);


sub parse_line {
    my $self = shift;   my $line = shift or die "must supply xferlog line";

    my %field;

    my @field = @field;

    my @tmp = split /\s+/, $line;
    if (scalar @tmp == scalar @field) {
	@field{@field} = @tmp;
    } else {
	for (@field) {
	    last if $_ eq 'filename';
	    $field{$_} = shift @tmp;
	}

	@field = reverse @field;
	@tmp   = reverse @tmp;

	for (@field) {
	    last if $_ eq 'filename';
	    $field{$_} = shift @tmp;
	}

	@tmp = reverse @tmp ;
	$field{filename} = "@tmp";
    }



#    map { print "$_ => $field{$_} \n" } @field;
#    print "-------------------";
    \%field;
}


1;
__END__