view release on metacpan or  search on metacpan

lib/App/GitFind/PathClassMicro.pm  view on Meta::CPAN

  return $self if $self->is_absolute;
  return $self->new($self->_spec->rel2abs($self->stringify, @_));
}

sub relative {
  my $self = shift;
  return $self->new($self->_spec->abs2rel($self->stringify, @_));
}

sub stat  { [stat("$_[0]")] }
sub lstat { [lstat("$_[0]")] }

sub PRUNE { return \&PRUNE; }

1;
# End of App::GitFind::PathClassMicro::Entity

=head1 NAME

App::GitFind::PathClassMicro::Entity - Base class for files and directories

=head1 VERSION

version 0.37

=head1 DESCRIPTION

This class is the base class for C<App::GitFind::PathClassMicro::File> and
C<App::GitFind::PathClassMicro::Dir>, it is not used directly by callers.

=head1 AUTHOR

Ken Williams, kwilliams@cpan.org

=head1 SEE ALSO

L<Path::Class>

=cut

# }}}1
##############################################################################
# File {{{1

package App::GitFind::PathClassMicro::File;
{
  $App::GitFind::PathClassMicro::File::VERSION = '0.37';
}

use strict;

#use App::GitFind::PathClassMicro::Dir;
  # In the same file and has no import() - don't need to `use` it
use parent -norequire, qw(App::GitFind::PathClassMicro::Entity);
#use Carp;
sub croak { require Carp; goto &Carp::croak; }

use IO::File ();

sub new {
  my $self = shift->SUPER::new;
  my $file = pop();
  my @dirs = @_;

  my ($volume, $dirs, $base) = $self->_spec->splitpath($file);

  if (length $dirs) {
    push @dirs, $self->_spec->catpath($volume, $dirs, '');
  }

  $self->{dir}  = @dirs ? $self->dir_class->new(@dirs) : undef;
  $self->{file} = $base;

  return $self;
}

sub dir_class { "App::GitFind::PathClassMicro::Dir" }

sub as_foreign {
  my ($self, $type) = @_;
  local $App::GitFind::PathClassMicro::Foreign = $self->_spec_class($type);
  my $foreign = ref($self)->SUPER::new;
  $foreign->{dir} = $self->{dir}->as_foreign($type) if defined $self->{dir};
  $foreign->{file} = $self->{file};
  return $foreign;
}

sub stringify {
  my $self = shift;
  return $self->{file} unless defined $self->{dir};
  return $self->_spec->catfile($self->{dir}->stringify, $self->{file});
}

sub dir {
  my $self = shift;
  return $self->{dir} if defined $self->{dir};
  return $self->dir_class->new($self->_spec->curdir);
}
BEGIN { *parent = \&dir; }

sub volume {
  my $self = shift;
  return '' unless defined $self->{dir};
  return $self->{dir}->volume;
}

sub components {
  my $self = shift;
  croak "Arguments are not currently supported by File->components()" if @_;
  return ($self->dir->components, $self->basename);
}

sub basename { shift->{file} }
sub open  { IO::File->new(@_) }

sub openr { $_[0]->open('r') or croak "Can't read $_[0]: $!"  }
sub openw { $_[0]->open('w') or croak "Can't write to $_[0]: $!" }
sub opena { $_[0]->open('a') or croak "Can't append to $_[0]: $!" }

sub touch {
  my $self = shift;
  if (-e $self) {
    utime undef, undef, $self;
  } else {
    $self->openw;
  }
}

sub slurp {
  my ($self, %args) = @_;
  my $iomode = $args{iomode} || 'r';
  my $fh = $self->open($iomode) or croak "Can't read $self: $!";

  if (wantarray) {
    my @data = <$fh>;
    chomp @data if $args{chomped} or $args{chomp};

    if ( my $splitter = $args{split} ) {
      @data = map { [ split $splitter, $_ ] } @data;
    }

    return @data;

lib/App/GitFind/PathClassMicro.pm  view on Meta::CPAN

MODIFIED: returns an arrayref of C<lstat()> results.

=item $class = $file->dir_class()

Returns the class which should be used to create directory objects.

Generally overridden whenever this class is subclassed.

=item $copy = $file->copy_to( $dest );

Copies the C<$file> to C<$dest>. It returns a L<App::GitFind::PathClassMicro::File>
object when successful, C<undef> otherwise.

=item $moved = $file->move_to( $dest );

Moves the C<$file> to C<$dest>, and updates C<$file> accordingly.

It returns C<$file> is successful, C<undef> otherwise.

=back

=head1 AUTHOR

Ken Williams, kwilliams@cpan.org

=head1 SEE ALSO

L<Path::Class>, L<Path::Class::Dir>, L<File::Spec>

=cut

# }}}1
##############################################################################
# Dir {{{1

package App::GitFind::PathClassMicro::Dir;
{
  $App::GitFind::PathClassMicro::Dir::VERSION = '0.37';
}

use strict;

#use App::GitFind::PathClassMicro::File;
  # In the same file and has no import() - don't need to `use` it
#use Carp();
sub croak { require Carp; goto &Carp::croak; }
use parent -norequire, qw(App::GitFind::PathClassMicro::Entity);

#use IO::Dir ();
#use File::Path ();
#use File::Temp ();
use Scalar::Util ();

# updir & curdir on the local machine, for screening them out in
# children().  Note that they don't respect 'foreign' semantics.
my $Updir  = __PACKAGE__->_spec->updir;
my $Curdir = __PACKAGE__->_spec->curdir;

sub new {
  my $self = shift->SUPER::new();

  # If the only arg is undef, it's probably a mistake.  Without this
  # special case here, we'd return the root directory, which is a
  # lousy thing to do to someone when they made a mistake.  Return
  # undef instead.
  return if @_==1 && !defined($_[0]);

  my $s = $self->_spec;

  my $first = (@_ == 0     ? $s->curdir :
          !ref($_[0]) && $_[0] eq '' ? (shift, $s->rootdir) :
          shift()
        );

  $self->{dirs} = [];
  if ( Scalar::Util::blessed($first) && $first->isa("App::GitFind::PathClassMicro::Dir") ) {
    $self->{volume} = $first->{volume};
    push @{$self->{dirs}}, @{$first->{dirs}};
  }
  else {
    ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath("$first") , 1);
    push @{$self->{dirs}}, $dirs eq $s->rootdir ? "" : $s->splitdir($dirs);
  }

  push @{$self->{dirs}}, map {
    Scalar::Util::blessed($_) && $_->isa("App::GitFind::PathClassMicro::Dir")
      ? @{$_->{dirs}}
      : $s->splitdir( $s->canonpath($_) )
  } @_;


  return $self;
}

sub file_class { "App::GitFind::PathClassMicro::File" }

sub is_dir { 1 }

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

  my $foreign = do {
    local $self->{file_spec_class} = $self->_spec_class($type);
    $self->SUPER::new;
  };

  # Clone internal structure
  $foreign->{volume} = $self->{volume};
  my ($u, $fu) = ($self->_spec->updir, $foreign->_spec->updir);
  $foreign->{dirs} = [ map {$_ eq $u ? $fu : $_} @{$self->{dirs}}];
  return $foreign;
}

sub stringify {
  my $self = shift;
  my $s = $self->_spec;
  return $s->catpath($self->{volume},
          $s->catdir(@{$self->{dirs}}),
          '');
}

sub volume { shift()->{volume} }

sub file {
  local $App::GitFind::PathClassMicro::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class};
  return $_[0]->file_class->new(@_);
}

sub basename { shift()->{dirs}[-1] }

sub dir_list {
  my $self = shift;
  my $d = $self->{dirs};
  return @$d unless @_;

  my $offset = shift;
  if ($offset < 0) { $offset = $#$d + $offset + 1 }

  return wantarray ? @$d[$offset .. $#$d] : $d->[$offset] unless @_;

  my $length = shift;
  if ($length < 0) { $length = $#$d + $length + 1 - $offset }
  return @$d[$offset .. $length + $offset - 1];
}

sub components {
  my $self = shift;
  return $self->dir_list(@_);
}

sub subdir {
  my $self = shift;
  return $self->new($self, @_);
}

sub parent {
  my $self = shift;
  my $dirs = $self->{dirs};
  my ($curdir, $updir) = ($self->_spec->curdir, $self->_spec->updir);

  if ($self->is_absolute) {
    my $parent = $self->new($self);
    pop @{$parent->{dirs}} if @$dirs > 1;
    return $parent;