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