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->sp +litpath($self->{_full_path}); } #documented: synopsis sub stat { my $self = shift; croak "Can't stat a non existant file" unless -e $self->full_path; return CORE::stat($self->full_path); } #documented: synopsis sub stath { my $self = shift; my @stat = $self->stat; 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($r +elative), 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 inac +curate"; } 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(); if ( $self->{_handle}->open ($mode.$self->full_path, @_) ) { return $self->{_handle}; } else { return; } } #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_pat +h; 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 'mag +ic' (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 'to +uch' (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"}->fu +ll_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[$_]} || $lt +ime[$_] } (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 on success #return false otherwise $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, ho +ur => 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 loca +ltime $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 FileSystemObjec +ts. It combines the powers of many File::* and other modules to bring + the standard tasks with files under one OO-hood. =back 1;
In reply to RFC:: FileSystemObjects::File by holli
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |