File Coverage

blib/lib/Path/Class/Tiny.pm

Criterion	Covered	Total	%
statement	88	89	98.8
branch	32	38	84.2
condition	11	21	52.3
subroutine	29	29	100.0
pod	18	18	100.0
total	178	195	91.2

package Path::Class::Tiny;

use 5.10.0;
use strict;
use warnings;

our $VERSION = '0.04'; # VERSION

use Exporter;
our @EXPORT = qw< cwd path file >;

sub import
{
	no strict 'refs';
	*{ caller . '::dir' } = \&_global_dir if @_ <= 1 or grep { $_ eq 'dir' } @_;
	goto \&Exporter::import;
}


use Carp;
use Module::Runtime qw< require_module >;


use File::Spec ();
use Path::Tiny ();
our @ISA = qw< Path::Tiny >;


sub path
{
	bless Path::Tiny::path(@_), __PACKAGE__;
}

sub cwd
{
	require Cwd;
	path(Cwd::getcwd());
}

*file = \&path;
sub _global_dir { @_ ? path(@_) : path(Path::Tiny->cwd) }

# just like in Path::Tiny
sub new { shift; path(@_) }
sub child { path(shift->[0], @_) }


# This seemed like a good idea when I originally conceived this class.  Now,
# after further thought, it seems wildly reckless.  Who knows?  I may swing
# back the other way before we're all done.  But, for now, I think we're
# leaving this out, and that may very well end up being a permanent thing.
#
# sub isa
# {
#	my ($obj, $type) = @_;
#	return 1 if $type eq 'Path::Class::File';
#	return 1 if $type eq 'Path::Class::Dir';
#	return 1 if $type eq 'Path::Class::Entity';
#	return $obj->SUPER::isa($type);
# }


# essentially just reblessings
sub parent		{ path( &Path::Tiny::parent   )          }
sub realpath	{ path( &Path::Tiny::realpath )          }
sub copy_to		{ path( &Path::Tiny::copy     )          }
sub children	{ map { path($_) } &Path::Tiny::children }

# simple correspondences
*dir		=	\&parent;
*subdir		=	\&child;
*rmtree		=	\&Path::Tiny::remove_tree;

# more complex corresondences
sub cleanup		{ path(shift->canonpath) }
sub open		{ my $io_class = -d $_[0] ? 'IO::Dir' : 'IO::File'; require_module $io_class; $io_class->new(@_) }


# wrappers
sub touch
{
	my ($self, $dt) = @_;
	$dt = $dt->epoch if defined $dt and $dt->can('epoch');
	$self->SUPER::touch($dt);
}

sub move_to
{
	my ($self, $dest) = @_;
	$self->move($dest);
	# if we get this far, the move must have succeeded
	# this is basically the way Path::Class::File does it:
	my $new = path($dest);
	my $max_idx = $#$self > $#$new ? $#$self : $#$new;
	# yes, this is a mutator, which could be considered bad
	# OTOH, the file is actually mutating on the disk,
	# so you can also consider it good that the object mutates to keep up
	$self->[$_] = $new->[$_] foreach 0..$max_idx;
	return $self;
}


# reimplementations

sub dir_list
{
	my $self = shift;
	my @list = ( File::Spec->splitdir($self->parent), $self->basename );

	# The return value of dir_list is remarkably similar to that of splice: it's identical for all
	# cases in list context, and even for one case in scalar context.  So we'll cheat and use splice
	# for most of the cases, and handle the other two scalar context cases specially.
	if (@_ == 0)
	{
		return @list;			# will DTRT regardless of context
	}
	elsif (@_ == 1)
	{
		return wantarray ? splice @list, $_[0] : $list[shift];
	}
	else
	{
		return splice @list, $_[0], $_[1];
	}
}
# components is really just an alias for `dir_list`
*components	=	\&dir_list;


# This is more or less how Path::Class::File does it.
sub slurp
{
	my ($self, %args) = @_;
	my $splitter     = delete $args{split};
	$args{chomp}   //= delete $args{chomped} if exists $args{chomped};
	$args{binmode} //= delete $args{iomode};
	$args{binmode}  =~ s/^

	if (wantarray)
	{
		my @data = $self->lines(\%args);
		@data = map { [ split $splitter, $_ ] } @data if $splitter;
		return @data;
	}
	else
	{
		croak "'split' argument can only be used in list context" if $splitter;
		croak "'chomp' argument not implemented in scalar context" if exists $args{chomp};
		return $self->Path::Tiny::slurp(\%args);
	}
}

# A bit trickier, as we have to distinguish between Path::Class::File style,
# which is optional hash + string-or-arrayref, and Path::Tiny style, which is
# optional hashref + string-or-arrayref.  But, since each one's arg hash(ref)
# only accepts a single option, we should be able to fake it fairly simply.
sub spew
{
	my ($self, @data) = @_;
	if ( @data == 3 and $data[0] eq 'iomode' )
	{
		shift @data;
		my $binmode = shift @data;
		$binmode =~ s/^(>>?)//;						# remove redundant openmode, if present
		unshift @data, {binmode => $binmode} if $binmode;
		# if openmode was '>>', redirect to `append`
		return $self->append(@data) if $1 and $1 eq '>>';
	}
	return $self->Path::Tiny::spew(@data);
}


my $_iter;
sub next
{
	$_iter //= Path::Tiny::path(shift)->iterator;
	my $p = $_iter->();
	return $p ? bless $p, __PACKAGE__ : undef $_iter;
}


# new methods

sub ef
{
	my ($self, $other) = @_;
	return $self->realpath eq path($other)->realpath;
}


sub mtime
{
	require Date::Easy::Datetime or croak("can't locate Date::Easy");
	return Date::Easy::Datetime->new(shift->stat->mtime);
}


1;


# ABSTRACT: a Path::Tiny wrapper for Path::Class compatibility
# COPYRIGHT

__END__