RFC:: FileSystemObjects::File
package FileSystemObjects::File;
use warnings;
use strict;
use File::Basename qw(fileparse);
use File::Spec;
use File::Slurp;
use base qw(File::Copy);
use IO::File;
use POSIX qw(strftime);
use Cwd;
use Carp;
use Time::Local;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use Data::Dumper;
my %size_units = ( b => 1, kb => 1024, mb => 1024 * 1024, tb => 1024 * 1024 * 1024);
my %stat_modes = ( mtime => 9, atime =>8, ctime => 10 );
my %filetest_subs;
my %loaded_optional_modules = ();
my @stat_names = qw (dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks);
my @time_names = qw (sec min hour day mon year);
#documented: synopsis
sub new
{
my $class = shift;
my $name = shift || croak "Must specify a filename!";
my $self = { };
bless $self, $class;
$self->_analyze( $name );
return $self;
}
#documented: -
sub _analyze
{
my $self = shift;
my $name = shift;
$self->{_full_path} = File::Spec->rel2abs ($name);
($self->{_drive}, $self->{_path}, $self->{_name}) = File::Spec->splitpath($self->{_full_path});
}
#documented: synopsis
sub stat
{
my $self = shift;
croak "Can't stat a non existant file" unless -e $self->full_path;
return &stat($self->full_path);
}
#documented: synopsis
sub stath
{
my $self = shift;
my @stat = &stat($self->full_path);
croak "Can't stat a non existant file" unless -e $self->full_path;
return map { $stat_names[$_] => $stat[$_] } (0..12);
}
#documented: synopsis
sub atime
{
my $self = shift;
my $format = shift || "%c";
return $self->_time ($format, "a");
}
#documented: synopsis
sub mtime
{
my $self = shift;
my $format = shift || "%c";
return $self->_time ($format, "m");
}
#documented: synopsis
sub ctime
{
my $self = shift;
my $format = shift || "%c";
croak "Can't time a non existant file" unless -e $self->full_path;
return $self->_time ($format, "c");
}
#documented: -
sub _time
{
my $self = shift;
my $format = shift;
my $mode = shift;
my $t = (CORE::stat($self->full_path))[$stat_modes{"${mode}time"}];
return strftime ($format, localtime($t));
}
#documented: synopsis
sub size
{
my $self = shift;
croak "Can't copy a non existant file" unless -e $self->full_path;
my %args = @_;
my $unit = $size_units{lc($args{unit})} || 1;
my $size = (-s $self->full_path) / $unit;
my $form = $args{format} || "%d";
return sprintf $form, $size;
}
#documented: synopsis
sub exists
{
my $self = shift;
return -e $self->full_path;
}
#documented: synopsis
sub test
{
my $self = shift;
my $test = shift || croak "empty test";
croak "Can't test a non existant file" unless -e $self->full_path;
my @r;
unless ( $self->{_test} )
{
for ( qw(r w x o R W X O e z s f l p S b c t) )
{
$filetest_subs{$_} = eval "sub { return -$_ \$_[0] }";
}
}
for ( split //, $test )
{
next if /-/;
if ( my $sub = $filetest_subs{$_} )
{
push @r, &$sub($self->full_path);
}
else
{
warn "unknown test: $_";
}
}
return scalar @r == 1 ? $r[0] : @r;
}
#documented: synopsis
sub drive
{
my $self = shift;
return $self->{_drive};
}
#documented: synopsis
sub path
{
my $self = shift;
return $self->{_path};
}
#documented: synopsis
sub name
{
my $self = shift;
return $self->{_name};
}
#documented: synopsis
sub full_path
{
my $self = shift;
return $self->{_full_path};
}
#documented: synopsis
sub rel_name
{
my $self = shift;
my $relative = shift || Cwd::abs_path;
my $drive;
($drive, $relative) = File::Spec->splitpath(File::Spec->rel2abs($relative), 1);
croak "cannot find a relative name across drives" unless $drive eq $self->drive;
print $self->full_path, "relative to\n", "$drive$relative is", "\n";
return File::Spec->abs2rel($self->full_path, "$drive$relative");
}
#documented: synopsis
sub content_md5
{
my $self = shift;
my $mode = shift;
croak "Can't md5 a non existant file" unless -e $self->full_path;
if ( not $mode )
{
return md5($self->slurp);
}
elsif ( $mode =~ /^hex$/i )
{
return md5_hex($self->slurp);
}
elsif ( $mode =~ /^base64$/i )
{
return md5_base64($self->slurp);
}
}
#documented: synopsis
sub content_md5_file
{
my $self = shift;
my $mode = shift;
my $md5 = Digest::MD5->new ();
croak "Can't md5 a non existant file" unless -e $self->full_path;
my $digest;
if ( $self->{_handle} )
{
carp "File is already open. The checksum will most likely inaccurate";
}
else
{
$self->open ("<");
}
my $handle = $self->handle;
binmode ($handle);
$md5->addfile($handle);
if ( not $mode )
{
$digest = $md5->digest;
}
elsif ( $mode =~ /^hex$/i )
{
$digest = $md5->hexdigest();
}
elsif ( $mode =~ /^base64$/i )
{
$digest = $md5->b64digest;
}
$self->close;
return $digest;
}
#documented: synopsis
sub slurp
{
my $self = shift;
croak "Can't slurp a non existant file" unless -e $self->full_path;
return wantarray ? (read_file $self->full_path) : read_file $self->full_path;
}
#documented: synopsis
sub open
{
my $self = shift;
my $mode = shift;
carp "Possibly unintended reopen of file" if $self->{_handle};
$self->{_handle} = IO::File->new();
$self->{_handle}->open ($mode.$self->full_path, @_);
return $self->{_handle};
}
#documented: synopsis
sub close
{
my $self = shift;
$self->{_handle}->close if $self->{_handle};
delete $self->{_handle};
}
#documented: synopsis
sub handle
{
my $self = shift;
return $self->{_handle};
}
#documented: synopsis
sub copy
{
my $self = shift;
my $to = shift;
croak "Can't copy a non existant file" unless -e $self->full_path;
$to = File::Spec->join($to, $self->name) if -d $to;
if ( File::Copy::copy ($self->full_path, $to) )
{
return FileSystemObjects::File->new ($to);
}
}
#documented: synopsis
sub move
{
my $self = shift;
my $to = shift;
croak "Can't move a non existant file" unless -e $self->full_path;
$to = File::Spec->join($to, $self->name) if -d $to;
if ( File::Copy::move ($self->full_path, $to ) )
{
$self->_analyze ( $to );
return $self;
}
}
#documented: synopsis
sub delete
{
my $self = shift;
croak "Can't delete a non existant file" unless -e $self->full_path;
return unlink $self->full_path;
}
#documented: synopsis
sub magic
{
my $self = shift;
croak "Can't magic a non existant file" unless -e $self->full_path;
unless ( $loaded_optional_modules{"File::Type"} )
{
eval { require File::Type };
croak "Cant' load required module 'File::Type' for method 'magic' (Original: $@)" if $@;
$loaded_optional_modules{"File::Type"} = 1;
} ;
my $ft = File::Type->new();
return $ft->checktype_filename($self->full_path);
}
#documented: synopsis
sub touch
{
my $self = shift;
my %args = @_;
croak "Can't touch a non existant file" unless -e $self->full_path;
unless ( $loaded_optional_modules{"File::Touch"} )
{
eval { require File::Touch };
croak "Cant' load required module 'File::Touch' for method 'touch' (Original: $@)" if $@;
$loaded_optional_modules{"File::Touch"} = 1;
} ;
for my $mode ( "a", "m")
{
unless ( $args{"${mode}time"} )
{
$args{"${mode}time"} = CORE::time;
}
else
{
$args{"${mode}time"} = (CORE::stat($args{"${mode}time"}))[$stat_modes{"${mode}time"}]
if -e $args{"${mode}time"};
$args{"${mode}time"} = (CORE::stat($args{"${mode}time"}->full_path))[$stat_modes{"${mode}time"}]
if $args{"${mode}time"}->isa ("FileSystemObjects::File");
$args{"${mode}time"} = _touch_time (%{$args{"${mode}time"}})
if ref($args{"${mode}time"}) eq "HASH";
}
}
print Dumper (\%args);
my $ref = File::Touch->new( %args );
$ref->touch($self->full_path);
}
sub _touch_time
{
my %args = @_;
$args{year} -= 1900 if $args{year};
$args{month} -= 1 if $args{month};
my @ltime = localtime;
my %time = map { $time_names[$_] => $args{$time_names[$_]} || $ltime[$_] } (0..5);
my @ntime = map { $time{$_} } @time_names;
return timelocal(@ntime);
}
#todo
#- zip
#- attribute
=pod
=head1 Name
FileSystemObjects::File
=head1 Synopsis
#load the class
use FileSystemObjects::File;
#create a new object, "drive:" is optional on systems
#that have no drives
$file = FileSystemObjects::File->new ("file");
#get the volume/drive
$drive = $f->drive;
#get the absolute path
$path = $f->path;
#get the name
$name = $f->name;
#get the full path (drive, path and name)
$name = $f->full_path;
#get path and name of the file, relative to another
#path. If the path is ommited, the cwd is used
$name = $f->rel_name ($path);
#open file to read, return IO::File - Object
$handle = $f->open ("<");
#open file to write, return IO::File - Object
$handle = $f->open (">");
#get the open handle
$handle = $f->handle;
#close the file
$f->close;
#slurp the file
$content = $f->slurp;
@lines = $f->slurp;
#call stat() on the file
@s = $file->stat;
#call stat() on the file and return a hash containing the result
%s = $file->stath;
print $s{mtime};
#get modification time formatted via sprintf
#same for atime() and ctime()
$mtime = $f->mtime();
$mtime = $f->mtime($format);
#get size of file in bytes
$size = $f->size();
#get size of file in kilobytes, same for "mb" and "tb"
$size = $f->size("kb");
#returns true if file exists
$e = $f->exists;
#run a number of filetests on the file
$size = $f->test("s"); #returns -s
@test = $f->test("efs"); #returns -e, -f and -s
#copy to other file, returns new File - Object
$file2 = $file->copy ("path/to/new/file");
#move to another place
$success = $f->move ("/another/place");
#remove file
$success = $f->delete;
#touch file, using user defined data
#ommited keys are filled up using localtime
#touch mtime only
$f->touch (mtime => { hour => 3, year => 2002, mon => 6, day => 1, hour => 11, min => 22, sec => 33 }, mtime_only => 1);
#touch atime and mtime using localtime
$f->touch ();
#touch using another filename as reference, atime using localtime
$f->touch (mtime => "/autoexec.bat");
#touch mtime using another File-Object as reference, atime using localtime
$f->touch (mtime => $f2);
#touch using an epoch
$f->touch (mtime => 1999597886, atime => 1999597333);
#try to guess the mime type
$mime = $f->magic();
#calculate md5 all in memory
$md5 = $f->content_md5;
$md5 = $f->content_md5("hex");
$md5 = $f->content_md5("base64");
#calculate md5 all on disk
$md5 = $f->content_md5_file;
$md5 = $f->content_md5_file("hex");
$md5 = $f->content_md5_file("base64");
=head1 Description
This module is part of the the still to write suite of FileSystemObjects. It combines the powers of many File::* and other modules to bring the standard tasks with files under one OO-hood.
=back
1;
Re: RFC:: FileSystemObjects::File
created: 2006-01-19 06:55:47
Quick-off, $f->stat() doesn't work because it ends up calling itself. Also, in stath you're checking for file existence after the call to stat, which seems wrong
--- FileSystemObjects/File.pm 2006-01-19 12:50:06.000000000 +0100
+++ FileSystemObjects/File-orig.pm 2006-01-19 12:50:28.000000000 +0100
@@ -60,18 +60,17 @@
croak "Can't stat a non existant file" unless -e $self->full_path;
- return CORE::stat($self->full_path);
+ return &stat($self->full_path);
}
#documented: synopsis
sub stath
{
my $self = shift;
+ my @stat = &stat($self->full_path);
croak "Can't stat a non existant file" unless -e $self->full_path;
- my @stat = CORE::stat($self->full_path);
-
return map { $stat_names[$_] => $stat[$_] } (0..12);
}
There are ten types of people: those that understand binary and those that don't.