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
|
|
|
|
|
|
|
# C |
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 |
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 |