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