File Coverage

blib/lib/ful.pm
Criterion Covered Total %
statement 42 42 100.0
branch 16 16 100.0
condition 24 24 100.0
subroutine 11 11 100.0
pod 0 1 0.0
total 93 94 98.9


line stmt bran cond sub pod time code
1 6     6   624855 use strict;
  6         63  
  6         179  
2 6     6   32 use warnings;
  6         9  
  6         395  
3              
4             package ful;
5              
6             =pod
7              
8             =encoding utf-8
9              
10             =head1 NAME
11              
12             ful - a useI "Bind Bpper Bib" pragma that ascends dirs to include
13             module directories in C<@INC>.
14              
15             =head1 SYNOPSIS
16              
17             =begin HTML
18              
19            
20            
21             CPAN Module Quality
22            
23            
24             Build Status
25            
26            
27             Coverage Status
28            
29            
30              
31             =end HTML
32              
33             One line to rule them all.
34              
35             use ful;
36              
37             Brings the first C directory found by directory ascencion and adds it to
38             C<@INC>.
39              
40             Instead of:
41              
42             use lib::relative '../../lib';
43             # or
44             use FindBin;
45             use lib "$FindBin::Bin/../lib";
46             # or even
47             BEGIN {
48             use Path::Tiny;
49             my $base = path(__FILE__)->parent;
50             $base = $base->parent until -d "$base/lib" or $base->is_rootdir;
51             unshift @INC, "$base/lib";
52             }
53              
54             =head1 USAGE
55              
56             When you're working within C when your project looks like this:
57              
58             project-root/
59             ├── bin/
60             │ └── utils/
61             │ └── a-script.pl
62             ├── lib/
63             │ └── Some/
64             │ └── Module.pm
65             ├── vendor/
66             │ └── SomeOrg/
67             │ └── Some/
68             │ └── Module.pm
69              
70             Just drop the line before your other C statements:
71              
72             use ful;
73             use Some::Module;
74              
75             And that's all.
76              
77             If you need more than just the C dir, you can do this:
78              
79             use ful qw/vendor lib/;
80             use Some::Module;
81             use SomeOrg::Some::Module;
82              
83             =head1 ADVANCED
84              
85             use ful \%options;
86              
87             =head2 OPTIONS
88              
89             =over 4
90              
91             =item * C \@dirs>
92              
93             Equivalent to C but can be combined with all other
94             options.
95              
96             # multiple @INC dirs
97             use ful { libdirs => [qw/lib vendor/] };
98              
99             # combined with another option
100             use ful {
101             libdirs => [qw(lib vendor/lib)],
102             dir => 'vendor/lib',
103             };
104              
105             =item * C $file>, C $file>, C $file>
106              
107             Finds an existing file to add a sibling directory to C<@INC>.
108              
109             # adds 'lib'
110             use ful { file => '.file-in-project-root' };
111              
112             =item * C $dname>, C $dname>, C $dname>
113              
114             Finds an existing directory to add a sibling directory to C<@INC>.
115              
116             # adds 'lib'
117             use ful { dir => 'bin' };
118              
119             =item * C 1>
120              
121             Finds a git repository to add a sibling directory to C<@INC>.
122              
123             # adds 'lib'
124             use ful { git => 1 };
125              
126             =back
127              
128             =head1 LICENSE
129              
130             MIT License
131              
132             Copyright (c) 2020 Ryan Willis
133              
134             Permission is hereby granted, free of charge, to any person obtaining a copy
135             of this software and associated documentation files (the "Software"), to deal
136             in the Software without restriction, including without limitation the rights
137             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
138             copies of the Software, and to permit persons to whom the Software is
139             furnished to do so, subject to the following conditions:
140              
141             The above copyright notice and this permission notice shall be included in all
142             copies or substantial portions of the Software.
143              
144             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
145             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
146             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
147             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
148             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
149             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
150             SOFTWARE.
151              
152             =head1 VERSION
153              
154             0.08
155              
156             =head1 SUPPORT
157              
158             Support is by the author. Please file bug reports or ask questions at
159             L.
160              
161             =cut
162              
163             our $VERSION = '0.08';
164              
165 6     6   33 use Cwd;
  6         9  
  6         398  
166 6     6   41 use File::Spec;
  6         11  
  6         3480  
167              
168             my $cursor;
169              
170             my $FS = 'File::Spec';
171              
172             our $crum = undef;
173              
174 2     2 0 1104 sub crum { $crum }
175              
176             sub import {
177 15     15   5978 my $me = shift;
178              
179 15         51 my @user = caller();
180 15         333 my $used_me = $user[1];
181              
182 15         608 $cursor = Cwd::abs_path($used_me);
183              
184 15         40 my %args = ();
185 15         34 my @libdirs = ('lib');
186              
187 15 100 100     102 if (@_ && ref($_[0]) eq 'HASH') {
    100          
188 11         19 %args = %{$_[0]};
  11         44  
189             }
190             elsif(@_) {
191 2         6 @libdirs = @_;
192             }
193              
194 15 100       55 @libdirs = @{$args{libdirs}} if ref($args{libdirs}) eq 'ARRAY';
  2         6  
195              
196 15 100 100     126 if (my $file = $args{file} // $args{target_file} // $args{target}) {
    100 100        
    100 100        
      100        
197 4   100     11 $me->_ascend until $me->_is_file($file) or $me->_heaven;
198             }
199             elsif (my $dir = $args{dir} // $args{has_dir} // $args{child_dir}) {
200 4   100     12 $me->_ascend until $me->_is_dir($dir) or $me->_heaven;
201             }
202             elsif ($args{git}) {
203 2         6 my @gitparts = qw(.git config);
204 2   100     7 $me->_ascend until $me->_is_file(@gitparts) or $me->_heaven;
205             }
206             else {
207 5         15 while (!$me->_heaven) {
208 18 100       38 last if scalar @libdirs == grep { $me->_is_dir($_) } @libdirs;
  32         73  
209 15         51 $me->_ascend;
210             }
211             }
212              
213 15 100       59 return if $me->_heaven;
214 8         20 $crum = $me->_comb($cursor);
215 8         30 unshift @INC => $me->_comb($cursor, $_) for @libdirs;
216             }
217              
218 35     35   76 sub _is_file { -f shift->_comb($cursor, @_) }
219 49     49   96 sub _is_dir { -d shift->_comb($cursor, @_) }
220 102     102   10126 sub _comb { $FS->catfile(@_[1..$#_]) }
221              
222 57     57   903 sub _ascend { $cursor = $FS->catdir(($FS->splitpath($cursor))[0..1]) }
223 82     82   539 sub _heaven { $cursor eq $FS->rootdir }
224              
225             1;
226              
227             __END__