view release on metacpan or  search on metacpan

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

=head1 NAME

App::GitFind::PathClassMicro.pm - Only the bits of Path::Class used in App::GitFind

=head1 SYNOPSIS

This combines pieces of L<Path::Class::Entity>, L<Path::Class::File>, and
L<Path::Class::Dir> by Ken Williams.  Those are licensed under the same terms
as Perl itself.  This file is licensed under the Artistic license, and these
modifications are believed to be permissible under clause 3(a) of the
Artistic License.  This file is available for use and modification under the
terms of the Artistic License.

B<Modifications>: This file was modified by Christopher White
C<< <cxw@cpan.org> >> to combine files and remove functions I don't use in
L<App::GitFind>.

The remainder of the documentation comes from the individual modules.
Multiple packages are combined in this file.

=cut

# Path::Class is not included - we use the functions directly

# }}}1
##############################################################################
# Entity {{1

package App::GitFind::PathClassMicro::Entity;
use strict;
{
  $App::GitFind::PathClassMicro::Entity::VERSION = '0.37';
}

use File::Spec 3.26;
#use File::stat ();
use Cwd;
#use Carp();
sub croak { require Carp; goto &Carp::croak; }

use overload
  (
   q[""] => 'stringify',
   'bool' => 'boolify',
   fallback => 1,
  );

sub new {
  my $from = shift;
  my ($class, $fs_class) = (ref($from)
          ? (ref $from, $from->{file_spec_class})
          : ($from, $App::GitFind::PathClassMicro::Foreign));
  return bless {file_spec_class => $fs_class}, $class;
}

sub is_dir { 0 }

sub _spec_class {
  my ($class, $type) = @_;

  die "Invalid system type '$type'" unless ($type) = $type =~ /^(\w+)$/;  # Untaint
  my $spec = "File::Spec::$type";
  ## no critic
  eval "require $spec; 1" or die $@;
  return $spec;
}

sub new_foreign {
  my ($class, $type) = (shift, shift);
  local $App::GitFind::PathClassMicro::Foreign = $class->_spec_class($type);
  return $class->new(@_);
}

sub _spec { (ref($_[0]) && $_[0]->{file_spec_class}) || 'File::Spec' }

sub boolify { 1 }

sub is_absolute {
  # 5.6.0 has a bug with regexes and stringification that's ticked by
  # file_name_is_absolute().  Help it along with an explicit stringify().
  $_[0]->_spec->file_name_is_absolute($_[0]->stringify)
}

sub is_relative { ! $_[0]->is_absolute }

sub cleanup {
  my $self = shift;
  my $cleaned = $self->new( $self->_spec->canonpath("$self") );
  %$self = %$cleaned;
  return $self;
}

sub resolve {
  my $self = shift;
  croak($! . " $self") unless -e $self;  # No such file or directory
  my $cleaned = $self->new( scalar Cwd::realpath($self->stringify) );

  # realpath() always returns absolute path, kind of annoying
  $cleaned = $cleaned->relative if $self->is_relative;

  %$self = %$cleaned;
  return $self;
}

sub absolute {
  my $self = shift;
  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;