1use 5.008; # utf8 2use strict; 3use warnings; 4use utf8; 5 6package Path::IsDev::Role::Matcher::FullPath::Is::Any; 7 8our $VERSION = '1.001002'; 9 10# ABSTRACT: Match if the current directory is the same directory from a list of absolute paths. 11 12our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY 13 14sub _path { 15 require Path::Tiny; 16 Path::Tiny->VERSION('0.004'); 17 goto &Path::Tiny::path; 18} 19 20use Role::Tiny; 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43sub _fullpath_is { 44 my ( $self, $result_object, $this, $comparator ) = @_; 45 46 my $context = {}; 47 48 $context->{tests} = []; 49 50 $context->{test_path} = "$comparator"; 51 52 my $path = _path($comparator); 53 54 if ( not $path->exists ) { 55 push @{ $context->{tests} }, { 'test_path_exists?' => 0 }; 56 $result_object->add_reason( $self, 0, "comparative path $comparator does not exist", $context ); 57 return; 58 } 59 60 push @{ $context->{tests} }, { 'test_path_exists?' => 1 }; 61 62 my $realpath = $path->realpath; 63 64 $context->{source_realpath} = "$this"; 65 $context->{test_realpath} = "$realpath"; 66 67 if ( not $realpath eq $this ) { 68 push @{ $context->{tests} }, { 'test_realpath_eq_source_realpath?' => 0 }; 69 $result_object->add_reason( $self, 0, "$this ne $realpath", $context ); 70 return; 71 } 72 push @{ $context->{tests} }, { 'test_realpath_eq_source_realpath?' => 1 }; 73 $result_object->add_reason( $self, 1, "$this eq $realpath", $context ); 74 return 1; 75} 76 77 78 79 80 81 82 83 84 85 86 87 88 89sub fullpath_is_any { 90 my ( $self, $result_object, @dirnames ) = @_; 91 my $current = $result_object->path->realpath; 92 for my $dirname (@dirnames) { 93 return 1 if $self->_fullpath_is( $result_object, $current, $dirname ); 94 } 95 return; 96} 97 981; 99 100__END__ 101 102=pod 103 104=encoding UTF-8 105 106=head1 NAME 107 108Path::IsDev::Role::Matcher::FullPath::Is::Any - Match if the current directory is the same directory from a list of absolute paths. 109 110=head1 VERSION 111 112version 1.001002 113 114=head1 METHODS 115 116=head2 C<fullpath_is_any> 117 118Note, this is usually invoked on directories anyway. 119 120 if ( $self->fullpath_is_any( $result_object, '/usr/', '/usr/bin/foo' )) { 121 122 } 123 124Matches if any of the provided paths C<realpath>'s correspond to C<< $result_object->path->realpath >> 125 126=head1 PRIVATE METHODS 127 128=head2 C<_fullpath_is> 129 130 $class->_fullpath_is( $result_object, $source_path, $comparison_path ); 131 132Does not match if C<$comparison_path> does not exist. 133 134Otherwise, compare C<$source_path> vs C<< $comparison_path->realpath >>, and return if they match. 135 136=begin MetaPOD::JSON v1.1.0 137 138{ 139 "namespace":"Path::IsDev::Role::Matcher::FullPath::Is::Any", 140 "interface":"role" 141} 142 143 144=end MetaPOD::JSON 145 146=head1 AUTHOR 147 148Kent Fredric <kentfredric@gmail.com> 149 150=head1 COPYRIGHT AND LICENSE 151 152This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>. 153 154This is free software; you can redistribute it and/or modify it under 155the same terms as the Perl 5 programming language system itself. 156 157=cut 158