view release on metacpan or  search on metacpan

lib/Test/Smoke/FTPClient.pm  view on Meta::CPAN

            date => __time_from_windows( @field[0, 1] ),
        }
    }
}

=head2 __get_mode_from_text( $tmode )

This takes the text representation of a file-mode (like 'rwxr--r--')
and return the numeric value.

=cut

sub __get_mode_from_text {
    my( $tmode ) = @_; # nine letter/dash

    $tmode =~ tr/rwx-/1110/;
    my $mode = 0;
    for ( my $i = 0; $i < 3; $i++ ) {
        $mode <<= 3;
        $mode  += ord(pack B3 => substr $tmode, $i*3, 3) >> 5;
    }

    return $mode;
}

=head2 __time_from_ls( $mname, $day, $time_or_year )

This takes the three date/time related columns from the C<ls -la> output
and returns a localtime-stamp.

=cut

sub __time_from_ls {
    my( $mname, $day, $time_or_year ) = @_;

    my( $local_year, $local_month) = (localtime)[5, 4];
    $local_year += 1900;

    my $month = int( index('JanFebMarAprMayJunJulAugSepOctNovDec', $mname)/3 );

    my( $year, $time ) = $time_or_year =~ /:/
        ? $month > $local_month ? ( $local_year - 1, $time_or_year ) :
            ($local_year, $time_or_year) : ($time_or_year, '00:00' );

    my( $hour, $minutes ) = $time =~ /(\d+):(\d+)/;

    require Time::Local;
    return Time::Local::timelocal( 0, $minutes, $hour, $day, $month, $year );
}

=head2 __time_from_windows( $date, $time )

This takes the two date/time related columns from the C<dir> output
and returns a localtime-stamp

=cut

sub __time_from_windows {
    my( $date, $time ) = @_;

    my( $day, $month, $year ) = split m/-/, $date;
    $month--;
    my( $hour, $minutes, $off )     = $time =~ m/(\d+):(\d+)([ap])m/i;
    $off && lc $off eq 'p' and $hour += 12;

    require Time::Local;
    return Time::Local::timelocal( 0, $minutes, $hour, $day, $month, $year );
}

1;

=head1 SEE ALSO

L<Test::Smoke::Syncer>

=head1 COPYRIGHT & LICENSE

(c) 2003, 2004, 2005, Abe Timmerman <abeltje@cpan.org> All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See:

  * <http://www.perl.com/perl/misc/Artistic.html>,
  * <http://www.gnu.org/copyleft/gpl.html>

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut