Path::Extended::Entity - Path::Extended::Entity documentation

Path-Extended documentation Contained in the Path-Extended distribution.

Index

Code Index:

NAME

Top

Path::Extended::Entity

SYNOPSIS

Top

  use Path::Extended::File;
  my $file = Path::Extended::File->new('path/to/some.file');

DESCRIPTION

Top

This is a base class for Path::Extended::File and Path::Extended::Dir.

METHODS

Top

new

creates an appropriate object. Note that this base class itself doesn't hold anything.

absolute

may take an optional hash, and returns an absolute path of the file/directory. Note that back slashes in the path will be converted to forward slashes unless you explicitly set a native option to true.

relative

may take an optional hash, and returns a relative path of the file/directory (compared to the current directory (Cwd::cwd) by default, but you may change this bahavior by passing a base option). Note that back slashes in the path will be converted to forward slashes unless you explicitly set a native option to true.

is_absolute

returns if the path you passed to the constructor was absolute or not (note that the path stored in an object is always absolute).

is_dir

returns if the object represents directory or not.

resolve

does a physical cleanup of the path with Cwd::realpath, that means, resolves a symbolic link if necessary. Note that this method may croak (when the path does not exist).

copy_to

copies the file/directory to the destination by File::Copy::copy.

move_to

moves the file/directory to the destination by File::Copy::move. If the file/directory is open, it'll automatically close.

rename_to

renames the file/directory. If the file/directory is open, it'll automatically close. If your OS allows rename of an open file, you may want to use built-in rename function for better atomicity.

unlinks the file/directory. The same thing can be said as for the rename_to method.

exists

returns true if the file/directory exists.

is_readable, is_writable

returns true if the file/directory is readable/writable.

is_open

returns true if the file/directory is open.

stat, lstat

returns a File::stat object for the file/directory.

parent

returns a Path::Extended::Dir object that points to the parent directory of the file/directory.

path, stringify

explicitly returns a path string.

log, logger, logfile, logfilter

You may optionally pass a logger object with log method that accepts ( label => @log_messages ) array arguments to notifty when some (usually unfavorable) thing occurs. By default, a built-in Carp logger will be used. If you want to disable logging, set a false value to logger. See Log::Dump for details, and for how to use logfile and logfilter methods.

SEE ALSO

Top

Path::Extended, Path::Extended::File, Path::Extended::Dir, Log::Dump

AUTHOR

Top

Kenichi Ishigaki, <ishigaki@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2008 by Kenichi Ishigaki.

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

Path-Extended documentation Contained in the Path-Extended distribution. 
package Path::Extended::Entity;

use strict;
use warnings;
use Carp ();
use File::Spec;
use Log::Dump;
use Scalar::Util qw( blessed );

use overload
  '""'   => sub { shift->path },
  'cmp'  => sub { return "$_[0]" cmp "$_[1]" },
  'bool' => sub { shift->_boolify },
  '*{}'  => sub { shift->_handle };

sub new {
  my $class = shift;
  my $self  = bless {}, $class;

  $self->_initialize(@_) or return;

  $self;
}

sub _initialize {1}
sub _boolify {1}

sub _class {
  my ($self, $type) = @_;
  my $class = ref $self;
  $class =~ s/::(?:File|Dir|Entity)$//;
  return $class unless $type;
  return $class.'::'.($type eq 'file' ? 'File' : 'Dir');
}

sub _related {
  my ($self, $type, @parts) = @_;

  my $class = $self->_class($type);
  eval "require $class" or Carp::croak $@;
  my $item;
  if ( @parts && $parts[0] eq '..' ) { # parent
    require File::Basename;
    $item = $class->new( File::Basename::dirname($self->_absolute) );
  }
  elsif ( @parts && File::Spec->file_name_is_absolute($parts[0]) ) {
    $item = $class->new( @parts );
  }
  else {
    $item = $class->new( $self->_absolute, @parts );
  }
  foreach my $key ( grep /^_/, keys %{ $self } ) {
    $item->{$key} = $self->{$key};
  }
  $item;
}

sub _unixify {
  my ($self, $path) = @_;

  $path =~ s{\\}{/}g if $^O eq 'MSWin32';

  return $path;
}

sub _handle { shift->{handle} }

sub path {
  my $self = shift;
  return ( $self->is_absolute ) ? $self->_absolute : $self->_relative;
}

sub stringify { shift->path }

sub is_dir      { shift->{is_dir} }
sub is_open     { shift->{handle} ? 1 : 0 }
sub is_absolute {
  my $self = shift;
  $self->{_absolute} && !$self->{_base} ? 1 : '';
}

sub resolve {
  my $self = shift;
  Carp::croak $! unless -e $self->{path};
  $self->{path} = $self->_unixify(Cwd::realpath($self->{path}));
  $self->{_absolute} = File::Spec->file_name_is_absolute($self->{path});
  $self;
}

sub _absolute {
  my ($self, %options) = @_;

  my $path = File::Spec->canonpath( $self->{path} );
  if ( $options{native} ) {
    return $path;
  }
  elsif ( $self->{_compat} ) {
    my ($vol, @parts) = File::Spec->splitpath( $path );
    $vol = '' if $Path::Extended::IgnoreVolume;
    return $self->_unixify( File::Spec->catpath($vol, File::Spec->catdir( @parts ), '') );
  }
  else {
    return $self->_unixify($path);
  }
}

sub _relative {
  my $self = shift;
  my $base = @_ % 2 ? shift : undef;
  my %options = @_;

  $base ||= $options{base} || $self->{_base};

  my $path = File::Spec->abs2rel( $self->{path}, $base );
     $path = $self->_unixify($path) unless $options{native};

  $path;
}

sub absolute { shift->_absolute(@_) }
sub relative { shift->_relative(@_) }

sub parent { shift->_related( dir => '..' ); }

sub unlink {
  my $self = shift;

  $self->close if $self->is_open;
  unlink $self->_absolute if $self->exists;
}

sub exists {
  my $self = shift;

  -e $self->_absolute ? 1 : 0;
}

sub is_writable {
  my $self = shift;

  -w $self->_absolute ? 1 : 0;
}

sub is_readable {
  my $self = shift;

  -r $self->_absolute ? 1 : 0;
}

sub copy_to {
  my ($self, $destination) = @_;

  unless ( $destination ) {
    $self->log( fatal => 'requires destination' );
    return;
  }

  my $class = ref $self;
  $destination = $class->new( "$destination" );

  require File::Copy::Recursive;
  File::Copy::Recursive::rcopy( $self->_absolute, $destination->_absolute )
    or do { $self->log( error =>  $! ); return; };

  $self;
}

sub move_to {
  my ($self, $destination) = @_;

  unless ( $destination ) {
    $self->log( fatal => 'requires destination' );
    return;
  }

  my $class = ref $self;
  $destination = $class->new( "$destination" );

  $self->close if $self->is_open;

  require File::Copy::Recursive;
  File::Copy::Recursive::rmove( $self->_absolute, $destination->_absolute )
    or do { $self->log( error =>  $! ); return; };

  $self->{path} = $destination->_absolute;

  $self;
}

sub rename_to {
  my ($self, $destination) = @_;

  unless ( $destination ) {
    $self->log( fatal => 'requires destination' );
    return;
  }

  my $class = ref $self;
  $destination = $class->new( "$destination" );

  $self->close if $self->is_open;

  rename $self->_absolute => $destination->_absolute
    or do { $self->log( error => $! ); return; };

  $self->{path} = $destination->_absolute;

  $self;
}

sub stat {
  my $self = shift;

  require File::stat;
  File::stat::stat( $self->{handle} || $self->{path} );
}

sub lstat {
  my $self = shift;

  require File::stat;
  File::stat::lstat( $self->{handle} || $self->{path} );
}

1;

__END__