File Coverage

blib/lib/lib/relative/to.pm
Criterion Covered Total %
statement 28 28 100.0
branch 6 6 100.0
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 43 43 100.0


line stmt bran cond sub pod time code
1             package lib::relative::to;
2              
3 5     5   144911 use strict;
  5         29  
  5         143  
4 5     5   24 use warnings;
  5         9  
  5         124  
5              
6 5     5   25 use Cwd;
  5         7  
  5         387  
7 5     5   32 use File::Spec;
  5         10  
  5         114  
8              
9 5     5   1950 use lib ();
  5         2918  
  5         1263  
10              
11             our $VERSION = '1.0000';
12             our $called_from;
13              
14             sub import {
15 11     11   1834 my($class, $plugin, @plugin_args) = @_;
16              
17             # in case we're inherited and someone isn't careful about
18             # Cing their module
19 11 100       63 return unless($class eq __PACKAGE__);
20              
21 8         240 $called_from = Cwd::abs_path((caller(0))[1]);
22 8 100       1928 lib->import(
23             $class->_load_plugin($plugin)
24             ->_find(@plugin_args)
25             ) if($plugin);
26             }
27              
28             sub _load_plugin {
29 5     5   15 my($class, $plugin) = @_;
30              
31 5         24 $plugin = __PACKAGE__ . "::$plugin";
32 5         302 eval "require $plugin";
33 5 100       35 die($@) if($@);
34 4         35 return $plugin;
35             }
36              
37             sub parent_dir {
38 23     23 1 61 my $class = shift;
39 23         248 my($volume, $dir) = File::Spec->splitpath(shift);
40             File::Spec->catdir(
41 23         60 grep { length($_) } ($volume, $dir)
  46         249  
42             );
43             }
44              
45             1;
46              
47             =head1 NAME
48              
49             lib::relative::to
50              
51             =head1 DESCRIPTION
52              
53             Add a path to C<@INC> that is relative to something else
54              
55             =head1 SYNOPSIS
56              
57             Both of these will look up through the parent directories of the file that
58             contains this code until it finds the root of a git repository, then add the
59             'lib' directory in that repository's root to C<@INC>.
60              
61             use lib::relative::to
62             GitRepository => qw(lib t/lib);
63              
64             use lib::relative::to
65             ParentContaining => '.git/config' => qw(lib t/lib);
66              
67             =head1 WHY?
68              
69             I used to work with someone (hi Sam!) who would C all over the place
70             while working on our product, and expected to be able to run tests no matter
71             where he was in our repository.
72              
73             Normal people, of course, stay in the repository root and invoke their tests
74             thus:
75              
76             prove t/wibble/boing/frobnicate.t
77              
78             and if that test file wanted to be able to load modules stored in a C
79             directory alongside C and from C it would just say:
80              
81             use lib qw(t/lib lib);
82              
83             But because of Sam, who liked to do this:
84              
85             cd t/wibble/boing
86             prove frobnicate.t
87              
88             We instead had to have nonsense like this:
89              
90             use lib::abs qw(../../../lib ../../lib);
91              
92             which is just plain hideous. Not only is it ugly, it's hard to read (it's not
93             immediately clear which directories are being included) and it's hard to write
94             - did I get the right number of C<../../>? Did I remember to update the Morse
95             code when I moved a file? Who knows! Hence the
96             L plugin. And because I wanted
97             to support Mercurial (see the L
98             plugin) as well, I abstracted out most of the functionality.
99              
100             Of course, I B work with Sam, so this is too late to save my sanity,
101             but writing it at least made me feel better.
102              
103             =head1 METHODS
104              
105             =head2 import
106              
107             Takes numerous arguments, the first of which is the name of a plugin, the rest
108             are arguments to that plugin. It will load the plugin (or die if it can't) and
109             then pass the rest of the arguments to the plugin.
110              
111             In general the argument list takes the form:
112              
113             =over
114              
115             =item plugin_name
116              
117             =item plugin_configuration
118              
119             =item list_of_directories
120              
121             =back
122              
123             and the plugin will use the C to add C to
124             C<@INC>. In the L above you can see that
125             L and
126             L are plugins, that
127             C<.git/config> is plugin configuration (the C plugin takes no
128             configuration), and that in both cases we want
129             to add C and C to C<@INC>.
130              
131             =head2 parent_dir
132              
133             Class method, takes a file or directory name as its argument, returns the directory
134             containing that object.
135              
136             =head1 WRITING PLUGINS
137              
138             You are encouraged to write your own plugins. I would appreciate, but do not
139             require, that you tell me about your plugins.
140              
141             You can upload your own plugins to the CPAN, or you can send them to me and I
142             will include them in this distribution. The best way of sending them to me is
143             via a Github pull request, but any other way of getting the files to me works.
144             If you want your code to be included in this distribution you B include
145             tests and appropriate fixtures.
146              
147             =head2 NAMING
148              
149             Plugin names must take the form C.
150              
151             The C namespace is reserved.
152              
153             =head2 FUNCTIONS
154              
155             Your plugin must implement a class method called C<_find>, which will be called when your plugin has been loaded, and will have the remainder of the argument list passed to it. That is to say that when your plugin is invoked thus:
156              
157             use lib::relative::to YourPluginName => qw(foo bar baz);
158              
159             your C<_find> method will be called thus:
160              
161             lib::relative::to::YourPluginName->_find(qw(foo bar baz));
162              
163             NB that your C method, if any, will B be called.
164              
165             Your C<_find> method should return a list of absolute paths to be added to C<@INC>. You will probably find L and L useful. Both modules will have already been loaded so you don't need to C them yourself. You may also want to use C - you can get access to it either by inheriting from C or by calling it directly:
166              
167             my $directory = lib::relative::to->parent_dir(...);
168              
169             =head2 CONTEXT
170              
171             C<$lib::relative::to::called_from> will contain the absolute name of the file from which your plugin was invoked.
172              
173             =head2 INHERITANCE
174              
175             The most useful class to inherit from is probably going to be the L plugin. Indeed, that is what the L and L plugins do. The source for the C plugin reads, in its entirety:
176              
177             package lib::relative::to::HgRepository;
178            
179             use strict;
180             use warnings;
181            
182             use parent 'lib::relative::to::ParentContaining';
183            
184             sub _find {
185             my($class, @args) = @_;
186             $class->SUPER::_find('.hg/store', @args);
187             }
188             1;
189              
190             =head1 BUGS
191              
192             I only have access to Unix machines for development and debugging. There may be
193             bugs lurking that affect users of exotic platforms like Amiga, Windows, and
194             VMS. I welcome patches, preferably in the form of a pull request. Ideally any
195             patches will be accompanied by tests, and those tests will either skip or pass
196             on Unix.
197              
198             =head1 AUTHOR, COPYRIGHT and LICENCE
199              
200             Copyright 2020 David Cantrell Edavid@cantrell.org.ukE.
201              
202             This software is free-as-in-speech as well as free-as-in-beer, and may be used,
203             distributed, and modified under the terms of either the GNU General Public
204             Licence version 2 or the Artistic Licence. It's up to you which one you use.
205             The full text of the licences can be found in the files GPL2.txt and
206             ARTISTIC.txt, respectively.
207              
208             =head1 CONSPIRACY
209              
210             This software is also free-as-in-mason.
211              
212             =cut