Badger
view release on metacpan or search on metacpan
lib/Badger/Filesystem.pm view on Meta::CPAN
sub is_absolute {
my $self = shift;
# $self->debug("args: ", $self->dump_data(\@_));
$self->spec->file_name_is_absolute(
$self->join_directory(@_)
) ? 1 : 0;
}
sub is_relative {
shift->is_absolute(@_) ? 0 : 1;
}
sub absolute {
my $self = shift;
my $path = $self->join_directory(shift);
my $spec = $self->spec;
return $path if $spec->file_name_is_absolute($path);
$spec->catdir(shift || $self->cwd, $path);
}
sub relative {
my $self = shift;
$self->spec->abs2rel($self->join_directory(shift), shift || $self->cwd);
}
#-----------------------------------------------------------------------
# file/directory test methods
#-----------------------------------------------------------------------
sub path_exists {
shift->stat_path(@_);
}
sub file_exists {
my $self = shift;
my $stats = $self->stat_path(shift) || return;
return -f _ ? $stats : 0; # relies on cached stat
}
sub directory_exists {
my $self = shift;
my $stats = $self->stat_path(shift) || return;
return -d _ ? $stats : 0; # relies on cached stat
}
sub stat_path {
my $self = shift;
my $path = $self->definitive_read(shift) || return;
my @stats = (stat($path), -r _, -w _, -x _, -o _, $path);
return $self->error_msg( bad_stat => $self->{ path } )
unless @stats;
return wantarray
? @stats
: \@stats;
}
sub chmod_path {
my $self = shift;
my $path = $self->definitive_write(shift);
chmod(shift, $path);
}
#-----------------------------------------------------------------------
# file manipulation methods
#-----------------------------------------------------------------------
sub create_file {
my ($self, $path) = @_;
unless (-e $self->definitive_write($path)) {
$self->write_file($path); # calls definitive_write again
}
return 1;
}
sub touch_file {
my ($self, $path) = @_;
my $definitive = $self->definitive_write($path);
if (-e $definitive) {
my $now = time();
utime $now, $now, $definitive;
}
else {
$self->write_file($path); # calls definitive_write again
}
}
sub delete_file {
my $self = shift;
my $path = $self->definitive_write(shift);
unlink($path)
|| return $self->error_msg( delete_failed => file => $path => $! );
}
sub open_file {
my $self = shift;
my $name = shift;
my $mode = $_[0] || 'r'; # leave it in @_ for IO::File
my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
my $path = $mode eq 'r'
? $self->definitive_read($name)
: $self->definitive_write($name);
return $self->error_msg( no_path => $name )
unless defined $path && length $path;
require IO::File;
$self->debug("about to open file $path (", join(', ', @_), ")\n") if $DEBUG;
my $fh = IO::File->new($path, @_)
|| $self->error_msg( open_failed => file => $path => $! );
$fh->binmode( $opts->{ encoding } )
if $opts->{ encoding };
return $fh;
}
sub read_file {
my $self = shift;
my $opts = @_ && ref $_[-1] eq HASH ? pop(@_) : { };
lib/Badger/Filesystem.pm view on Meta::CPAN
}
sub _file_copy {
require File::Copy;
my ($self, $action, $from, $to, $params)
= (shift, shift, shift, shift, params(@_));
my $src
= is_object(PATH, $from) ? $from->definitive # path object
: ref($from) ? $from # file handle
: $self->definitive_read($from); # file path
my $dest
= is_object(PATH, $to) ? $to->definitive # as above
: ref($to) ? $to
: $self->definitive_write($to);
my $code
= $action eq 'copy' ? \&File::Copy::copy
: $action eq 'move' ? \&File::Copy::move
: return $self->error( invalid => action => $action );
my $file;
unless (ref $dest) {
# NOTE: don't use $self->file($dest) because $self could be a
# VFS and $dest is already a definitive path
$file = File($dest);
# capture our current working directory
my $cwd = cwd;
eval {
# Change to the destination volume if one exists.
# Should work for any volume except Windows shares
# where resulting behavior is version dependent.
chdir $file->volume if ($file->volume);
# this code strips volume information
$file->directory->must_exist(
$params->{ mkdir },
$params->{ dir_mode },
);
# change back to the current working directory
chdir $cwd;
} or do {
# capture any exception from above
# change back to the oringial cwd
# and rethrow the execption.
if ($@) {
chdir $cwd;
die $@;
}
}
}
$code->($src, $dest)
|| return $self->error_msg( copy_failed => $action, $from, $to, $! );
my $mode = $params->{ file_mode };
$mode = $params->{ mode } unless defined $mode;
$file->chmod($mode)
if $file && defined $mode;
return $file || $dest;
}
#-----------------------------------------------------------------------
# directory manipulation methods
#-----------------------------------------------------------------------
sub create_directory {
my $self = shift;
my $path = $self->definitive_write(shift);
require File::Path;
eval {
local $Carp::CarpLevel = 1;
File::Path::mkpath($path, 0, @_)
} || return $self->error($@);
}
sub delete_directory {
my $self = shift;
my $path = $self->definitive_write(shift);
require File::Path;
File::Path::rmtree($path, @_)
}
sub open_directory {
my $self = shift;
my $path = $self->definitive_read(shift);
require IO::Dir;
$self->debug("Opening directory: $path\n") if $DEBUG;
return IO::Dir->new($path, @_)
|| $self->error_msg( open_failed => directory => $path => $! );
}
sub read_directory {
my $self = shift;
my $dirh = $self->open_directory(shift);
my $all = shift;
my ($path, @paths);
while (defined ($path = $dirh->read)) {
push(@paths, $path);
}
@paths = $self->spec->no_upwards(@paths)
unless $all || ref $self && $self->{ all_entries };
$dirh->close;
return wantarray ? @paths : \@paths;
}
sub directory_child {
my $self = shift;
my $path = $self->join_directory(@_);
stat $self->definitive_read($path);
lib/Badger/Filesystem.pm view on Meta::CPAN
effect in this module, but provides the relevant hooks that allow the
L<Badger::Filesystem::Virtual> subclass to work properly.
=head2 definitive_read($path)
Converts an absolute or relative path to a definitive one for a read
operation. See L<definitive()>.
=head2 definitive_write($path)
Converts an absolute or relative path to a definitive one for a write
operation. See L<definitive()>.
=head1 PATH TEST METHODS
=head2 path_exists($path)
Returns true if the path exists, false if not.
=head2 file_exists($path)
Returns true if the path exists and is a file, false if not.
=head2 dir_exists($path) / directory_exists($path)
Returns true if the path exists and is a directory, false if not.
=head2 stat_path($path)
Performs a C<stat()> on the filesystem path. It returns a list (in list
context) or a reference to a list (in scalar context) containing 17 items.
The first 13 are those returned by Perl's inbuilt C<stat()> function. The
next 3 items are flags indicating if the file is readable, writeable and/or
executable. The final item is a flag indicating if the file is owned by the
current user (i.e. owner of the current process.
A summary of the fields is shown below. See C<perldoc -f stat> and the
L<stat()|Badger::Filesystem::Path/stat()> method in
L<Badger::Filesystem::Path> for further details.
Field Description
--------------------------------------------------------
0 device number of filesystem
1 inode number
2 file mode (type and permissions)
3 number of (hard) links to the file
4 numeric user ID of file’s owner
5 numeric group ID of file’s owner
6 the device identifier (special files only)
7 total size of file, in bytes
8 last access time in seconds since the epoch
9 last modify time in seconds since the epoch
10 inode change time in seconds since the epoch (*)
11 preferred block size for file system I/O
12 actual number of blocks allocated
13 file is readable by current process
14 file is writeable by current process
15 file is executable by current process
16 file is owned by current process
=head2 chmod_path($path)
Changes the file permissions on a path.
$fs->chmod_path('/path/to/file', 0755);
=head1 FILE MANIPULATION METHODS
=head2 create_file($path)
Creates an empty file if it doesn't already exist. Returns a true value
if the file is created and a false value if it already exists. Errors are
thrown as exceptions.
$fs->create_file('/path/to/file');
=head2 touch_file($path) / touch($path)
Creates a file if it doesn't exists, or updates the timestamp if it does.
$fs->touch_file('/path/to/file');
=head2 delete_file($path)
Deletes a file.
$fs->delete_file('/path/to/file'); # Careful with that axe, Eugene!
=head2 open_file($path, $mode, $perms)
Opens a file for reading (by default) or writing/appending (by passing
C<$mode> and optionally C<$perms>). Accepts the same parameters as for the
L<IO::File::open()|IO::File> method and returns an L<IO::File> object.
my $fh = $fs->open_file('/path/to/file');
my $fh = $fs->open_file('/path/to/file', 'w');
my $fh = $fs->open_file('/path/to/file', 'w', 0644);
=head2 read_file($path)
Reads the content of a file, returning it as a list of lines (in list context)
or a single text string (in scalar context).
my $text = $fs->read_file('/path/to/file');
my @lines = $fs->read_file('/path/to/file');
=head2 write_file($path, @content)
When called with a single C<$path> argument, this method opens the specified
file for writing and returns an L<IO::File> object.
my $fh = $fs->write_file('/path/to/file');
$fh->print("Hello World!\n");
$fh->close;
If any additional C<@content> argument(s) are passed then they will be
written to the file. The file is then closed and a true value returned
to indicate success. Errors are thrown as exceptions.
$fs->write_file('/path/to/file', "Hello World\n", "Regards, Badger\n");
=head2 append_file($path, @content)
This method is similar to L<write_file()>, but opens the file for appending
instead of overwriting. When called with a single C<$path> argument, it opens
( run in 1.049 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )