File Coverage

blib/lib/Path/Class/Entity.pm
Criterion Covered Total %
statement 51 52 98.0
branch 11 14 78.5
condition 2 3 66.6
subroutine 20 21 95.2
pod 0 13 0.0
total 84 103 81.5


line stmt bran cond sub pod time code
1 7     7   2529 use strict;
  7         16  
  7         333  
2              
3             package Path::Class::Entity;
4             {
5             $Path::Class::Entity::VERSION = '0.36';
6             }
7              
8 7     7   24 use File::Spec 3.26;
  7         179  
  7         137  
9 7     7   3233 use File::stat ();
  7         367264  
  7         148  
10 7     7   44 use Cwd;
  7         10  
  7         390  
11 7     7   26 use Carp();
  7         18  
  7         145  
12              
13             use overload
14             (
15 7         35 q[""] => 'stringify',
16             'bool' => 'boolify',
17             fallback => 1,
18 7     7   21 );
  7         8  
19              
20             sub new {
21 644     644 0 545 my $from = shift;
22             my ($class, $fs_class) = (ref($from)
23             ? (ref $from, $from->{file_spec_class})
24 644 100       1103 : ($from, $Path::Class::Foreign));
25 644         1601 return bless {file_spec_class => $fs_class}, $class;
26             }
27              
28 27     27 0 47 sub is_dir { 0 }
29              
30             sub _spec_class {
31 73     73   76 my ($class, $type) = @_;
32              
33 73 50       357 die "Invalid system type '$type'" unless ($type) = $type =~ /^(\w+)$/; # Untaint
34 73         116 my $spec = "File::Spec::$type";
35             ## no critic
36 73 50       3640 eval "require $spec; 1" or die $@;
37 73         275 return $spec;
38             }
39              
40             sub new_foreign {
41 14     14 0 686 my ($class, $type) = (shift, shift);
42 14         44 local $Path::Class::Foreign = $class->_spec_class($type);
43 14         76 return $class->new(@_);
44             }
45              
46 2031 100 66 2031   10342 sub _spec { (ref($_[0]) && $_[0]->{file_spec_class}) || 'File::Spec' }
47              
48 58     58 0 190 sub boolify { 1 }
49            
50             sub is_absolute {
51             # 5.6.0 has a bug with regexes and stringification that's ticked by
52             # file_name_is_absolute(). Help it along with an explicit stringify().
53 95     95 0 401 $_[0]->_spec->file_name_is_absolute($_[0]->stringify)
54             }
55              
56 10     10 0 22 sub is_relative { ! $_[0]->is_absolute }
57              
58             sub cleanup {
59 43     43 0 38 my $self = shift;
60 43         56 my $cleaned = $self->new( $self->_spec->canonpath("$self") );
61 43         194 %$self = %$cleaned;
62 43         112 return $self;
63             }
64              
65             sub resolve {
66 9     9 0 14 my $self = shift;
67 9 50       57 Carp::croak($! . " $self") unless -e $self; # No such file or directory
68 9         23 my $cleaned = $self->new( scalar Cwd::realpath($self->stringify) );
69              
70             # realpath() always returns absolute path, kind of annoying
71 9 100       24 $cleaned = $cleaned->relative if $self->is_relative;
72              
73 9         51 %$self = %$cleaned;
74 9         1934 return $self;
75             }
76              
77             sub absolute {
78 13     13 0 54 my $self = shift;
79 13 100       23 return $self if $self->is_absolute;
80 6         16 return $self->new($self->_spec->rel2abs($self->stringify, @_));
81             }
82              
83             sub relative {
84 13     13 0 40 my $self = shift;
85 13         23 return $self->new($self->_spec->abs2rel($self->stringify, @_));
86             }
87              
88 2     2 0 401 sub stat { File::stat::stat("$_[0]") }
89 0     0 0 0 sub lstat { File::stat::lstat("$_[0]") }
90              
91 29     29 0 1888 sub PRUNE { return \&PRUNE; }
92              
93             1;
94             __END__