line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package File::Locate::Harder; |
2
|
2
|
|
|
2
|
|
306064
|
use base qw( Class::Base ); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
2316
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=head1 NAME |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
File::Locate::Harder - when you're determined to use a locate db |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 SYNOPSIS |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use File::Locate::Harder; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new(); |
13
|
|
|
|
|
|
|
my $results_aref = $flh->locate( $search_term ); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# using a defined db location, plus some locate options |
16
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new( db => $db_file ); |
17
|
|
|
|
|
|
|
my $results_aref = $flh->locate( $search_pattern, |
18
|
|
|
|
|
|
|
{ case_insensitive => 1, |
19
|
|
|
|
|
|
|
regexp => 1, |
20
|
|
|
|
|
|
|
} ); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# creating your own locate db, (in this example for doing tests) |
23
|
|
|
|
|
|
|
use Test::More; |
24
|
|
|
|
|
|
|
SKIP: |
25
|
|
|
|
|
|
|
{ |
26
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new( db => undef ); |
27
|
|
|
|
|
|
|
$flh->create_database( $path_to_tree_to_index, $db_file ); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
if( $flh->check_locate ) { |
30
|
|
|
|
|
|
|
my $reason = "Can't get File::Locate::Harder to work"; |
31
|
|
|
|
|
|
|
skip "Can't run 'locate'", $test_count; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
my $results_aref = $flh->locate( $search_term ); |
34
|
|
|
|
|
|
|
is_deeply( $results_aref, $expected_aref, "Found expected files"); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# introspection (is it reading db directly, or shelling out to locate?) |
38
|
|
|
|
|
|
|
my $report = $flh->how_works; |
39
|
|
|
|
|
|
|
print "This is how File::Locate::Harder is doing locates: $report\n"; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 DESCRIPTION |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
File::Locate::Harder provides a generalized "locate" method to access |
46
|
|
|
|
|
|
|
the file system indexes used by the "locate" command-line utility. |
47
|
|
|
|
|
|
|
It is intended to be a relatively portable way for perl code to |
48
|
|
|
|
|
|
|
quickly ascertain what files are present on the current system. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This code is essentially a wrapper around multiple different techniques |
51
|
|
|
|
|
|
|
of accessing a locate database: it makes an effort to use the fastest |
52
|
|
|
|
|
|
|
method it can find that works. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
The "locate" command is a well-established utility to find files |
55
|
|
|
|
|
|
|
quickly by using a special index database (typically updated via a |
56
|
|
|
|
|
|
|
cron-job). This module is an attempt at providing a perl front-end |
57
|
|
|
|
|
|
|
to "locate" which should be portable across most unix-like systems. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Behind the scenes, File::Locate::Harder silently tries many ways |
60
|
|
|
|
|
|
|
of doing the requested "locate" operation. If it can't establish |
61
|
|
|
|
|
|
|
contact with the file system's locate database, it will error |
62
|
|
|
|
|
|
|
out, otherwise you can be reasonably sure that a "locate" will |
63
|
|
|
|
|
|
|
return a valid result (including an empty set if the search matches |
64
|
|
|
|
|
|
|
nothing). |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
If possible, File::Locate::Harder will use the perl/XS module |
67
|
|
|
|
|
|
|
L to access the locate db directly, otherwise, it |
68
|
|
|
|
|
|
|
will attempt to shell out to a command line version of "locate". |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
If not told explicitly what locate db file to use, this module will |
71
|
|
|
|
|
|
|
try to find the file system's standard locate db using a number of |
72
|
|
|
|
|
|
|
reasonable guesses. If those all fail -- and it's possible for it to |
73
|
|
|
|
|
|
|
fail simply because file permissions make the db file effectively |
74
|
|
|
|
|
|
|
invisible -- as a last ditch effort, it will try shelling out to the |
75
|
|
|
|
|
|
|
command line "locate" without specifying a db for it (because it |
76
|
|
|
|
|
|
|
usually knows where to look). |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Efficiency may be improved in some circumstances if you help |
79
|
|
|
|
|
|
|
File::Locate::Harder find the locate database, either by explicitly |
80
|
|
|
|
|
|
|
saying where it is (using the "db" attribute), or by setting the |
81
|
|
|
|
|
|
|
LOCATE_PATH environment variable. Also see the L"introspection_results"> |
82
|
|
|
|
|
|
|
method. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 METHODS |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=over |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
2
|
|
|
2
|
|
11764
|
use 5.006; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
86
|
|
91
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
58
|
|
92
|
2
|
|
|
2
|
|
13
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
76
|
|
93
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
164
|
|
94
|
2
|
|
|
2
|
|
12
|
use Data::Dumper; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
113
|
|
95
|
2
|
|
|
2
|
|
2326
|
use Hash::Util qw( lock_keys unlock_keys ); |
|
2
|
|
|
|
|
5761
|
|
|
2
|
|
|
|
|
14
|
|
96
|
2
|
|
|
2
|
|
248
|
use File::Path qw(mkpath); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
1731
|
|
97
|
2
|
|
|
2
|
|
55
|
use File::Basename qw(fileparse basename dirname); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
7434
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Note: File::Locate is now "require"ed during init instead of "use"ed. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# for autoload generated accessors |
104
|
|
|
|
|
|
|
our $AUTOLOAD; |
105
|
|
|
|
|
|
|
my %ATTRIBUTES = (); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=item new |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Creates a new File::Locate::Harder object. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
With no arguments, the newly created object (largely) has |
112
|
|
|
|
|
|
|
attributes that are undefined. All may be set later using |
113
|
|
|
|
|
|
|
accessors named according to the "set_*" convention. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Inputs: |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
An optional hashref, with named fields identical to the names of |
118
|
|
|
|
|
|
|
the object attributes. The attributes, in order of likely utility: |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=over |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=item Settings for ways to run "locate" |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=over |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item case_insensitive |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Like the usual command-line "-i". |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item regexp |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
The search term will be interpeted as a POSIX regexp |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item posix_extended |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
The search term is a regexp with the standard POSIX extensions. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=back |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item Overall settings (for "locate", "create_database", etc) |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=over |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item db |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Locate database file, with full path. Use this to work with a |
147
|
|
|
|
|
|
|
non-standard location, or set it to "undef" if you don't want this |
148
|
|
|
|
|
|
|
module to waste time looking for it (e.g. you might be planning to |
149
|
|
|
|
|
|
|
generate your own db via L). |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=back |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item For internal use, testing, and so on: |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
The following items are lists used in the probing process which |
156
|
|
|
|
|
|
|
determines what works on the current system. These lists are |
157
|
|
|
|
|
|
|
defined with hardcoded defaults that will normally remain |
158
|
|
|
|
|
|
|
untouched, though are sometimes over-ridden for testing |
159
|
|
|
|
|
|
|
purposes. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=over |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=item locate_db_location_candidates |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Likely places for a locate db. See L. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=item test_search_terms |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Common terms in unix file paths. See L. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=back |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
The following are status fields where the results of system probing |
174
|
|
|
|
|
|
|
are stored. The user not will normally be uninterested in these, |
175
|
|
|
|
|
|
|
though see L"introspection_results"> for a hint about performance |
176
|
|
|
|
|
|
|
improvements in repeated runs. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=over |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=item system_db_not_found |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
Could not find where the standard locate db is. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item use_shell_locate |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Shell out to locate and forget about using File::Locate |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item shell_locate_failed |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
So don't try probe_db_via_shell_locate again |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item shell_locate_cmd_idx |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Integer: controls the choice of syntax of the locate shell cmd |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=back |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=back |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Note: "new" is inherited from Class::Base, and |
203
|
|
|
|
|
|
|
# calls the following "init" routine automatically. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item init |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Method that initializes object attributes and then locks them |
208
|
|
|
|
|
|
|
down to prevent accidental creation of new ones. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
Not of interest to client coders, though inheriting code should have |
211
|
|
|
|
|
|
|
an init of it's own that calls this one. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=cut |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub init { |
216
|
2
|
|
|
2
|
1
|
5236
|
my $self = shift; |
217
|
2
|
|
|
|
|
5
|
my $args = shift; |
218
|
2
|
|
|
|
|
5
|
unlock_keys( %{ $self } ); |
|
2
|
|
|
|
|
22
|
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# all object attributes, including arguments that become attributes |
221
|
2
|
|
|
|
|
25
|
my @attributes = |
222
|
|
|
|
|
|
|
( |
223
|
|
|
|
|
|
|
'db', # locate database file, with full path |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# results of system introspection on how 'locate' works here |
226
|
|
|
|
|
|
|
'system_db_not_found', |
227
|
|
|
|
|
|
|
'use_shell_locate', # shell out to locate, forget File::Locate |
228
|
|
|
|
|
|
|
'shell_locate_failed', # so don't try probe_db_via_shell_locate again |
229
|
|
|
|
|
|
|
'shell_locate_cmd_idx', # integer, controls syntax of locate shell cmd |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# lists to try in sequence until one works |
232
|
|
|
|
|
|
|
'test_search_terms', # common terms on perl/unix systems |
233
|
|
|
|
|
|
|
'locate_db_location_candidates', # likely places for a locate db |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# options settings for different styles of "locate" |
236
|
|
|
|
|
|
|
'case_insensitive', |
237
|
|
|
|
|
|
|
'regexp', |
238
|
|
|
|
|
|
|
'posix_extended', |
239
|
|
|
|
|
|
|
); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# transform args into attributes, if on the approved list |
242
|
2
|
|
|
|
|
6
|
foreach my $field (@attributes) { |
243
|
20
|
|
|
|
|
53
|
$ATTRIBUTES{ $field } = 1; |
244
|
20
|
|
|
|
|
40
|
$self->{ $field } = $args->{ $field }; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
# (all accessors are now fair game to use here) |
247
|
|
|
|
|
|
|
|
248
|
2
|
|
|
|
|
10
|
$self->define_probe_parameters; |
249
|
|
|
|
|
|
|
# that is, the test_search_terms and locate_db_location_candidates |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# Try to load module "File::Locate", if it fails we'll try shell locate |
252
|
2
|
|
|
|
|
3
|
eval { require File::Locate }; |
|
2
|
|
|
|
|
884
|
|
253
|
2
|
50
|
|
|
|
14
|
if ($@) { |
254
|
2
|
|
|
|
|
108
|
$self->set_use_shell_locate( 1 ); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
2
|
|
|
|
|
5
|
my $probe_db = 1; |
258
|
|
|
|
|
|
|
# check for defined db field, but undef value |
259
|
2
|
50
|
33
|
|
|
3
|
if ( grep{ m/^db$/ } (keys %{ $args } ) || |
|
2
|
|
|
|
|
24
|
|
260
|
|
|
|
|
|
|
( not( defined( $args->{db} ) ) ) ) { |
261
|
|
|
|
|
|
|
# if found we should *not* probe for a file-system db |
262
|
0
|
|
|
|
|
0
|
$probe_db = 0; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# two issues: determining which db to use |
266
|
|
|
|
|
|
|
# and how to use it db (i.e. via module or shell) |
267
|
2
|
|
|
|
|
5
|
my $db; |
268
|
2
|
50
|
|
|
|
7
|
if ( $probe_db ) { |
269
|
2
|
50
|
33
|
|
|
49
|
if ( $db = $args->{ db } || $ENV{ LOCATE_PATH } ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
270
|
0
|
|
|
|
|
0
|
$self->set_db( $db ); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# even if we're told which db to use, must still determine how |
273
|
|
|
|
|
|
|
# But: we can't probe it if it's not created yet, |
274
|
|
|
|
|
|
|
# And: there's no point if we already know we're going via shell |
275
|
0
|
0
|
0
|
|
|
0
|
if ( -e $db && |
276
|
|
|
|
|
|
|
( not ( $self->use_shell_locate ) ) ) { |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# will we use db fast way (module) or slow but sure (shell) |
279
|
0
|
|
|
|
|
0
|
$self->probe_db( $db ); # note: sets use_shell_locate |
280
|
|
|
|
|
|
|
# TODO check return for failure? |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} elsif ( $db = $self->determine_system_db( ) ) { |
284
|
|
|
|
|
|
|
# using the standard file system locate db |
285
|
|
|
|
|
|
|
} elsif ( $self->probe_db_via_shell_locate ) { |
286
|
|
|
|
|
|
|
# the db is unknown to us, but locate may still know |
287
|
0
|
|
|
|
|
0
|
$self->set_use_shell_locate( 1 ); |
288
|
|
|
|
|
|
|
} else { |
289
|
2
|
|
|
|
|
2324
|
croak "File::Locate::Harder is not working. " . |
290
|
|
|
|
|
|
|
"Problem with 'locate' installation?"; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} # end if don't probe db |
293
|
|
|
|
|
|
|
|
294
|
0
|
|
|
|
|
0
|
lock_keys( %{ $self } ); |
|
0
|
|
|
|
|
0
|
|
295
|
0
|
|
|
|
|
0
|
return $self; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=item locate |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
Simple interface to performs the actual "locate" operation |
301
|
|
|
|
|
|
|
in a robust, reliable way. Uses the locate db file indicated |
302
|
|
|
|
|
|
|
by the object's "db" attribute (which is set automatically if |
303
|
|
|
|
|
|
|
not manually overridden). |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Input: |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
A term to search for in the file name or path. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Return: |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
An array reference of matching files with full paths. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=cut |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub locate { |
316
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
317
|
0
|
|
|
|
|
0
|
my $search_term = shift; |
318
|
0
|
|
|
|
|
0
|
my $locate_options = shift; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# apply the current locate options but preserve object settings |
321
|
0
|
|
|
|
|
0
|
my $original_settings = { |
322
|
|
|
|
|
|
|
case_insensitive => $self->case_insensitive, |
323
|
|
|
|
|
|
|
regexp => $self->regexp, |
324
|
|
|
|
|
|
|
posix_extended => $self->posix_extended, |
325
|
|
|
|
|
|
|
}; |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
0
|
foreach my $field (keys (%{ $locate_options })){ |
|
0
|
|
|
|
|
0
|
|
328
|
0
|
|
|
|
|
0
|
my $setter = "set_$field"; |
329
|
0
|
|
|
|
|
0
|
$self->$setter( $locate_options->{ $field } ); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# farm out the locate operation to "via_shell" or "via_module" |
333
|
0
|
|
|
|
|
0
|
my $result = []; |
334
|
0
|
0
|
|
|
|
0
|
if ( $self->use_shell_locate ) { |
335
|
0
|
|
|
|
|
0
|
$result = $self->locate_via_shell( $search_term ); |
336
|
|
|
|
|
|
|
} else { |
337
|
0
|
|
|
|
|
0
|
$result = $self->locate_via_module( $search_term ); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
# restore the original object settings of locate options |
341
|
0
|
|
|
|
|
0
|
foreach my $field (keys (%{ $original_settings })){ |
|
0
|
|
|
|
|
0
|
|
342
|
0
|
|
|
|
|
0
|
my $setter = "set_$field"; |
343
|
0
|
|
|
|
|
0
|
$self->$setter( $original_settings->{ $field } ); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
0
|
return $result; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=item create_database |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
Tries to create the locate database file indicated in the object |
352
|
|
|
|
|
|
|
data, indexing the tree indicated by a path given as an argument. A |
353
|
|
|
|
|
|
|
required second argument specifys the db file: the "db" field in the |
354
|
|
|
|
|
|
|
object is ignored by this method, though if the database is |
355
|
|
|
|
|
|
|
successfully created, the object's "db" field will be set to the |
356
|
|
|
|
|
|
|
newly created database. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Inputs: |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
(1) full path of tree of files to index |
361
|
|
|
|
|
|
|
(2) full path of db file to create |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
Return: |
364
|
|
|
|
|
|
|
false (undef) on failure. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=cut |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub create_database { |
369
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
370
|
0
|
|
|
|
|
0
|
my $location = shift; |
371
|
0
|
|
|
|
|
0
|
my $db = shift; |
372
|
|
|
|
|
|
|
|
373
|
0
|
|
|
|
|
0
|
mkpath( dirname( $db )); |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
0
|
my @cmd = ( "slocate -U $location -o $db", |
376
|
|
|
|
|
|
|
"updatedb --require-visibility 0 --output=$db --database-root='$location'", |
377
|
|
|
|
|
|
|
"updatedb --output=$db --localpaths='$location'", |
378
|
|
|
|
|
|
|
); |
379
|
|
|
|
|
|
|
|
380
|
0
|
|
|
|
|
0
|
my $status = undef; |
381
|
|
|
|
|
|
|
TRY_AGAIN: |
382
|
0
|
|
|
|
|
0
|
foreach my $cmd (@cmd) { |
383
|
0
|
|
|
|
|
0
|
$self->debug("Trying cmd:\n$cmd\n"); |
384
|
0
|
|
|
|
|
0
|
my $ret; |
385
|
0
|
|
|
|
|
0
|
$ret = system( "$cmd 2>/dev/null" ); |
386
|
0
|
0
|
|
|
|
0
|
if ( $ret != 0 ) { |
387
|
0
|
|
|
|
|
0
|
$self->debug( "Failed locate db create command:\n $cmd\n" ); |
388
|
0
|
0
|
|
|
|
0
|
$self->debug( "\$\?: $?\n" ) if $?; |
389
|
0
|
|
|
|
|
0
|
next TRY_AGAIN; |
390
|
|
|
|
|
|
|
} else { |
391
|
0
|
|
|
|
|
0
|
$status = 1; |
392
|
0
|
|
|
|
|
0
|
$self->set_db( $db ); |
393
|
0
|
|
|
|
|
0
|
last; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
} |
396
|
0
|
0
|
|
|
|
0
|
if ( not( $status ) ) { |
397
|
0
|
|
|
|
|
0
|
carp "Could not create db: $db to index $location"; |
398
|
|
|
|
|
|
|
} |
399
|
0
|
0
|
|
|
|
0
|
if ( -e $db ) { |
400
|
0
|
|
|
|
|
0
|
my $mtime = (stat $db)[9]; |
401
|
0
|
|
|
|
|
0
|
my $timestamp = ( localtime($mtime) ); |
402
|
0
|
|
|
|
|
0
|
$self->debug("Looks like database has been created: $db at $timestamp\n"); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
0
|
|
|
|
|
0
|
return $status; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=back |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head2 introspection |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=over |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item check_locate |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Returns true (1) if this module's 'locate' method is capable of working. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
This is very similar to the L method, except that with no |
419
|
|
|
|
|
|
|
arguments *and* an undefined object's db setting, this will |
420
|
|
|
|
|
|
|
initiate a L run to try to find the standard |
421
|
|
|
|
|
|
|
system locate db. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Example usage: |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new( { db => undef } ); |
426
|
|
|
|
|
|
|
$flh->create_database( $tree_location, $db_file ); |
427
|
|
|
|
|
|
|
if ( $flh->probe_db ) { |
428
|
|
|
|
|
|
|
my @files = $flh->locate( "want_this" ); # checks the newly created db, |
429
|
|
|
|
|
|
|
# just indexing $tree_location |
430
|
|
|
|
|
|
|
# ... |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
# Then later, if you want to search the whole file system... |
434
|
|
|
|
|
|
|
$flh->set_db( undef ); |
435
|
|
|
|
|
|
|
if ( $flh->check_locate ) { |
436
|
|
|
|
|
|
|
my @hits = $flh->locate( "search_for_this" ); |
437
|
|
|
|
|
|
|
* ... |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# But even more convenient would be: |
441
|
|
|
|
|
|
|
if ( $flh->determine_system_db ) { |
442
|
|
|
|
|
|
|
my @hits = $flh->locate( "search_for_this" ); |
443
|
|
|
|
|
|
|
* ... |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
(Thus I suspect that this is a redundant, useless method.) |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Rule of thumb: if you want to search the whole system, you can use check_locate |
449
|
|
|
|
|
|
|
to verify that L will (most likely) work, but if you're using your own |
450
|
|
|
|
|
|
|
custom db (e.g. created via L), you might as well just use |
451
|
|
|
|
|
|
|
. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
(Another rule of thumb: if this seems confusing, just ignore the issue |
454
|
|
|
|
|
|
|
for as long as you can.) |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=cut |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub check_locate { |
459
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
460
|
|
|
|
|
|
|
|
461
|
0
|
|
0
|
|
|
0
|
my $db = shift || $self->db || $self->determine_system_db; |
462
|
0
|
|
|
|
|
0
|
my $ret = $self->probe_db( $db ); |
463
|
0
|
|
|
|
|
0
|
return $ret; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=item how_works |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
Returns a report on how this module has been doing "locate" |
469
|
|
|
|
|
|
|
operations (e.g. via the shell or the File::Locate module, |
470
|
|
|
|
|
|
|
and using which db). |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=cut |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
sub how_works { |
475
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
476
|
0
|
|
|
|
|
0
|
my $db = $self->db | 'unknown'; |
477
|
0
|
|
|
|
|
0
|
my $report = ''; |
478
|
0
|
0
|
|
|
|
0
|
if ( $self->use_shell_locate ) { |
479
|
0
|
|
0
|
|
|
0
|
my $version = $self->shell_locate_version || ''; |
480
|
0
|
|
|
|
|
0
|
$report = "We shell out to locate version: $version\n using the locate db: $db\n"; |
481
|
|
|
|
|
|
|
} else { |
482
|
0
|
|
|
|
|
0
|
$report = "Using File::Locate with the locate db: $db\n"; |
483
|
|
|
|
|
|
|
} |
484
|
0
|
|
|
|
|
0
|
return $report; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item introspection_results |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Returns a hashref of the results of File::Locate::Harder's |
490
|
|
|
|
|
|
|
probing of the system's "locate" setup, so that it can be |
491
|
|
|
|
|
|
|
easily used again without re-doing that work. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
Example: |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
my $settings_href = $flh1->introspection_results; |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
# save $settings_href somehow (e.g. dump to yaml file) |
498
|
|
|
|
|
|
|
# restore $settings_href somehow |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
my $flh2 = File::Locate::Harder->new( $settings_href ); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=cut |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub introspection_results { |
505
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
506
|
0
|
|
|
|
|
0
|
my $settings = |
507
|
|
|
|
|
|
|
{ |
508
|
|
|
|
|
|
|
db => $self->db, |
509
|
|
|
|
|
|
|
system_db_not_found => $self->system_db_not_found, |
510
|
|
|
|
|
|
|
use_shell_locate => $self->use_shell_locate, |
511
|
|
|
|
|
|
|
shell_locate_failed => $self->shell_locate_failed, |
512
|
|
|
|
|
|
|
shell_locate_cmd_idx => $self->shell_locate_cmd_idx, |
513
|
|
|
|
|
|
|
}; |
514
|
0
|
|
|
|
|
0
|
return $settings; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=item shell_locate_version |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
Tries to determine the version of the shell's "locate" command. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
This will work only with the GNU locate and Secure Locate |
522
|
|
|
|
|
|
|
variants, not the Free BSD. |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
Returns the version string on success, otherwise 0 for failure. |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
=cut |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub shell_locate_version { |
529
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
530
|
|
|
|
|
|
|
|
531
|
0
|
|
|
|
|
0
|
my @cmd = ( 'locate --version', # gnu & slocate |
532
|
|
|
|
|
|
|
'locate -V', # slocate |
533
|
|
|
|
|
|
|
); # note: freebsd has no version option |
534
|
|
|
|
|
|
|
|
535
|
0
|
|
|
|
|
0
|
my $ret = 0; |
536
|
|
|
|
|
|
|
CMD: |
537
|
0
|
|
|
|
|
0
|
foreach my $cmd (@cmd) { |
538
|
0
|
|
|
|
|
0
|
$self->debug("Trying cmd:\n$cmd\n"); |
539
|
|
|
|
|
|
|
chomp( |
540
|
0
|
|
|
|
|
0
|
$ret = `$cmd` |
541
|
|
|
|
|
|
|
); |
542
|
0
|
0
|
|
|
|
0
|
if ($ret) { |
543
|
0
|
|
|
|
|
0
|
last CMD; |
544
|
|
|
|
|
|
|
} else { |
545
|
0
|
|
|
|
|
0
|
$self->debug( "Failed locate version request of form:\n $cmd\n" ); |
546
|
0
|
0
|
|
|
|
0
|
$self->debug( "\$\?: $?\n" ) if $?; |
547
|
0
|
|
|
|
|
0
|
next CMD; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
0
|
0
|
|
|
|
0
|
if ( not( $ret ) ) { |
552
|
0
|
|
|
|
|
0
|
carp "Could not get version of locate shell command"; |
553
|
|
|
|
|
|
|
} |
554
|
0
|
|
|
|
|
0
|
return $ret; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=back |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 special purpose methods (usually, though not exclusively, for internal use) |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=over |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=item locate_via_module |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Uses the perl/XS module L to perform a locate |
566
|
|
|
|
|
|
|
operation on the given search term, using the db file |
567
|
|
|
|
|
|
|
indicated by the object's db attribute. |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
An optional second argument allows passing in a coderef, |
570
|
|
|
|
|
|
|
an anonymous routine that operates on each match (the match |
571
|
|
|
|
|
|
|
value is set to $_): this makes it possible to work with |
572
|
|
|
|
|
|
|
a large result without storing the entire set in memory. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
Uses the three object attribute toggles |
575
|
|
|
|
|
|
|
(L"case_insensitive">, "regexp">, "posix_extended">) |
576
|
|
|
|
|
|
|
to control the way locate is performed. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=cut |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
sub locate_via_module { |
581
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
582
|
0
|
|
|
|
|
0
|
my $search_term = shift; |
583
|
0
|
|
|
|
|
0
|
my $coderef = shift; |
584
|
|
|
|
|
|
|
|
585
|
0
|
|
|
|
|
0
|
my $db = $self->db; |
586
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
0
|
my @opts = $self->build_opts_for_locate_via_module; |
588
|
|
|
|
|
|
|
|
589
|
0
|
0
|
|
|
|
0
|
if( not( $coderef ) ) { |
590
|
0
|
|
|
|
|
0
|
my @results = File::Locate::locate( $search_term, @opts, $db ); |
591
|
0
|
|
|
|
|
0
|
return \@results; |
592
|
|
|
|
|
|
|
} else { |
593
|
0
|
|
|
|
|
0
|
my $ret = File::Locate::locate( $search_term, @opts, $db, $coderef ); |
594
|
0
|
|
|
|
|
0
|
return $ret; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=item locate_via_shell |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
Given a search term returns an array reference of matches found |
601
|
|
|
|
|
|
|
from a "locate" search. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
An optional second argument containing the locate command's |
604
|
|
|
|
|
|
|
"options string" (e.g. "-i", "-r", "-re", etc) may be passed |
605
|
|
|
|
|
|
|
in (otherwise it is generated from object data). |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
This method uses object data settings: |
608
|
|
|
|
|
|
|
L"db">, L"shell_locate_cmd_idx"> |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
And indirectly (via L): |
611
|
|
|
|
|
|
|
L"case_insensitive">, L"regexp">, L"posix_extended"> |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=cut |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub locate_via_shell { |
616
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
617
|
0
|
|
|
|
|
0
|
my $search_term = shift; |
618
|
0
|
|
|
|
|
0
|
my $opt_str_override = shift; |
619
|
|
|
|
|
|
|
|
620
|
0
|
0
|
|
|
|
0
|
unless( defined( $self->shell_locate_cmd_idx ) ) { |
621
|
0
|
|
|
|
|
0
|
$self->probe_db_via_shell_locate; # side effect: determine cmd_idx |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
0
|
my $cmd_idx = $self->shell_locate_cmd_idx; |
625
|
0
|
|
|
|
|
0
|
my $db = $self->db; |
626
|
0
|
|
0
|
|
|
0
|
my $opt_str = $opt_str_override || $self->build_opts_for_locate_via_shell; |
627
|
|
|
|
|
|
|
|
628
|
0
|
|
|
|
|
0
|
my ($locate_cmd, @results); |
629
|
|
|
|
|
|
|
|
630
|
0
|
|
|
|
|
0
|
$locate_cmd = |
631
|
|
|
|
|
|
|
$self->generate_locate_cmd( $cmd_idx, $search_term, $db, $opt_str ); |
632
|
|
|
|
|
|
|
chomp( |
633
|
0
|
|
|
|
|
0
|
@results = `$locate_cmd` |
634
|
|
|
|
|
|
|
); |
635
|
|
|
|
|
|
|
|
636
|
0
|
|
|
|
|
0
|
return \@results; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=back |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=head2 methods largely for internal use |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=over |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=item determine_system_db |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Internally used routine: looks for a useable system-wide locate db. |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Returns the path to the db if found, and as a side effect sets the |
650
|
|
|
|
|
|
|
object attribute "db". |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=cut |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
# Note: for efficiency reasons, this trys to access all |
655
|
|
|
|
|
|
|
# candidates via module before falling back on via shell. That's |
656
|
|
|
|
|
|
|
# the reason this routine does not use the probe_db method |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub determine_system_db { |
659
|
2
|
|
|
2
|
1
|
6
|
my $self = shift; |
660
|
2
|
50
|
|
|
|
25
|
if ( $self->system_db_not_found ) { |
661
|
0
|
|
|
|
|
0
|
return; # might as well bail if we've failed before |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
|
664
|
2
|
|
|
|
|
18
|
my $candidates = $self->locate_db_location_candidates; |
665
|
2
|
|
|
|
|
5
|
my @exist = grep { -e $_ } @{ $candidates }; |
|
44
|
|
|
|
|
704
|
|
|
2
|
|
|
|
|
4
|
|
666
|
|
|
|
|
|
|
|
667
|
2
|
|
|
|
|
8
|
foreach my $db (@exist) { |
668
|
0
|
0
|
|
|
|
0
|
if( $self->probe_db_via_module_locate( $db ) ) { |
669
|
0
|
|
|
|
|
0
|
$self->set_db( $db ); |
670
|
0
|
|
|
|
|
0
|
return $db; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
2
|
|
|
|
|
5
|
foreach my $db (@exist) { |
674
|
0
|
0
|
|
|
|
0
|
if( $self->probe_db_via_shell_locate( $db ) ) { |
675
|
|
|
|
|
|
|
# $self->set_use_shell_locate(1); ### TODO -- why not do this here |
676
|
0
|
|
|
|
|
0
|
$self->set_db( $db ); |
677
|
0
|
|
|
|
|
0
|
return $db; |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
} |
680
|
2
|
|
|
|
|
20
|
$self->set_system_db_not_found( 1 ); |
681
|
2
|
|
|
|
|
16
|
return; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=item probe_db |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
For when the locate db file you're interested in is known, |
688
|
|
|
|
|
|
|
and you want to initialize access for it (and as a side-effect, |
689
|
|
|
|
|
|
|
find out if it works). |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
Input: db file name with full path (optional, defaults to object's setting). |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Return: for success, the db file name, on failure undef. |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
Side-effect: set's use_shell_locate if the access via module |
696
|
|
|
|
|
|
|
didn't work. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=cut |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub probe_db { |
701
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
702
|
|
|
|
|
|
|
|
703
|
0
|
|
0
|
|
|
0
|
my $db = shift || $self->db; |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
# will we use db fast way (module) or slow but sure (shell) |
706
|
0
|
0
|
|
|
|
0
|
if ( $self->probe_db_via_module_locate ) { |
|
|
0
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# File::Locate module works, so use it |
708
|
0
|
|
|
|
|
0
|
return $db; # success |
709
|
|
|
|
|
|
|
} elsif ( $self->probe_db_via_shell_locate ) { |
710
|
0
|
|
|
|
|
0
|
$self->set_use_shell_locate( 1 ); |
711
|
0
|
|
|
|
|
0
|
return $db; # success |
712
|
|
|
|
|
|
|
} else { |
713
|
0
|
|
|
|
|
0
|
return; # failed |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=item probe_db_via_module_locate |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
Looks to see if it can find anything in the given db by using |
722
|
|
|
|
|
|
|
the File::Locate module. |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=cut |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
sub probe_db_via_module_locate { |
727
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
728
|
0
|
|
0
|
|
|
0
|
my $db = shift || $self->db; |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
# bail immediately if we've already know via_module doesn't work |
731
|
0
|
0
|
|
|
|
0
|
if ( $self->use_shell_locate ) { |
732
|
0
|
|
|
|
|
0
|
return; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
0
|
|
|
|
|
0
|
my @test_search_terms = |
736
|
0
|
|
|
|
|
0
|
@{ $self->test_search_terms }; |
737
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
0
|
foreach my $search_term (@test_search_terms) { |
739
|
0
|
|
|
|
|
0
|
my $found_one; |
740
|
0
|
|
|
|
|
0
|
eval { |
741
|
|
|
|
|
|
|
# in scalar context, this 'locate' returns a boolean |
742
|
0
|
|
|
|
|
0
|
$found_one = File::Locate::locate( $search_term, $db ); |
743
|
|
|
|
|
|
|
}; |
744
|
0
|
0
|
|
|
|
0
|
if ($@) { # traps errors reported by the File::Locate module |
745
|
0
|
|
|
|
|
0
|
$self->debug("File::Locate::locate had a problem with $db:\n$@"); |
746
|
0
|
|
|
|
|
0
|
return; |
747
|
|
|
|
|
|
|
} |
748
|
0
|
0
|
|
|
|
0
|
if ( $found_one ) { |
749
|
0
|
|
|
|
|
0
|
return $db; |
750
|
|
|
|
|
|
|
} else { |
751
|
0
|
|
|
|
|
0
|
$self->debug("File::Locate::locate found no $search_term via $db:\n$?"); |
752
|
|
|
|
|
|
|
} |
753
|
|
|
|
|
|
|
} |
754
|
0
|
|
|
|
|
0
|
return; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=item probe_db_via_shell_locate |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Tries the series of standard test searches by shelling out to |
760
|
|
|
|
|
|
|
the command-line form of locate to make sure that it can be used. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Tries to use the locate db file indicated by the objects "db" |
763
|
|
|
|
|
|
|
attribute, but this can be over-ridden with an optional argument. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
Under some circumstances, the db may remain undefined, but this |
766
|
|
|
|
|
|
|
method will return "1" for success if it appears that command-line |
767
|
|
|
|
|
|
|
locate works in any case. |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
As a side-effect, saves the L"shell_locate_cmd_idx"> that |
770
|
|
|
|
|
|
|
indicates a form of the locate command that has been observed |
771
|
|
|
|
|
|
|
to work. |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Returns: undef for failure, and for success either the db or 1 |
774
|
|
|
|
|
|
|
(because locate can work even if this code can't figure out what |
775
|
|
|
|
|
|
|
db file it's using). |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=cut |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub probe_db_via_shell_locate { |
780
|
2
|
|
|
2
|
1
|
12
|
my $self = shift; |
781
|
|
|
|
|
|
|
|
782
|
2
|
50
|
|
|
|
17
|
if ( $self->shell_locate_failed ) { |
783
|
0
|
|
|
|
|
0
|
return; # bail now if we've failed before |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
2
|
|
|
|
|
3
|
my $default_db; |
787
|
2
|
50
|
|
|
|
15
|
if ( $self->system_db_not_found ) { |
788
|
2
|
|
|
|
|
5
|
$default_db = undef; # locate may find the system db even if we can't |
789
|
|
|
|
|
|
|
} else { |
790
|
0
|
|
|
|
|
0
|
$default_db = $self->db; |
791
|
|
|
|
|
|
|
} |
792
|
2
|
|
33
|
|
|
18
|
my $db = shift || $default_db; |
793
|
2
|
|
50
|
|
|
44
|
my $true = $db || 1; |
794
|
|
|
|
|
|
|
|
795
|
2
|
|
|
|
|
9
|
my $opt_str = $self->build_opts_for_locate_via_shell; |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# Nested loops of trials |
798
|
|
|
|
|
|
|
# The outer loop: different syntax variations of the locate cmd |
799
|
|
|
|
|
|
|
# The inner loop: a series of terms to try searching for. |
800
|
|
|
|
|
|
|
|
801
|
2
|
|
|
|
|
17
|
my $test_search_terms_aref = $self->test_search_terms; |
802
|
2
|
|
|
|
|
5
|
my @test_search_terms; |
803
|
2
|
|
|
|
|
17
|
@test_search_terms = |
804
|
2
|
50
|
|
|
|
8
|
@{ $test_search_terms_aref } if $test_search_terms_aref; |
805
|
|
|
|
|
|
|
|
806
|
2
|
|
|
|
|
14
|
my $lim = $self->generate_locate_cmd; |
807
|
2
|
|
|
|
|
24
|
for (my $cmd_idx = 0; $cmd_idx <= $lim; $cmd_idx++) { |
808
|
|
|
|
|
|
|
|
809
|
8
|
|
|
|
|
24
|
foreach my $search_term (@test_search_terms) { |
810
|
|
|
|
|
|
|
|
811
|
96
|
|
|
|
|
11258
|
my $locate_cmd = |
812
|
|
|
|
|
|
|
$self->generate_locate_cmd( $cmd_idx, $search_term, $db, $opt_str ); |
813
|
|
|
|
|
|
|
chomp( |
814
|
96
|
|
|
|
|
997774
|
my @hits = `$locate_cmd 2>/dev/null` |
815
|
|
|
|
|
|
|
); |
816
|
|
|
|
|
|
|
|
817
|
96
|
50
|
|
|
|
3463
|
if ( scalar( @hits ) > 0 ) { |
818
|
0
|
|
|
|
|
0
|
$self->set_shell_locate_cmd_idx( $cmd_idx ); |
819
|
0
|
|
|
|
|
0
|
return $true; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
2
|
|
|
|
|
238
|
$self->set_shell_locate_failed( 1 ); |
824
|
2
|
|
|
|
|
43
|
return; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item generate_locate_cmd |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Given an ordered list of four required parameters, returns a form |
830
|
|
|
|
|
|
|
of the locate command which can (in theory) be fed to the shell. |
831
|
|
|
|
|
|
|
In practice these different forms are expected to fail (some |
832
|
|
|
|
|
|
|
harder than others) on various different platforms, so some |
833
|
|
|
|
|
|
|
experimentation may be needed to find a form that works (which |
834
|
|
|
|
|
|
|
is the job of L). |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Inputs: |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
$cmd_idx: integer index (beginning with 0) that chooses the |
839
|
|
|
|
|
|
|
form of a command to return. |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
$search_term: string (or possibly regexp) to search for. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
$db: full path to the locate db to search. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
$opt_str: options string, defaults to values generated by |
846
|
|
|
|
|
|
|
build_opts_for_locate_via_shell |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
Example usage: |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
for ($i=0; $i<=$self->generate_locate_cmd; $i++) { |
851
|
|
|
|
|
|
|
my $locate_cmd = |
852
|
|
|
|
|
|
|
$self->generate_locate_cmd( $cmd_idx, $search_term, $db, $opt_str ); |
853
|
|
|
|
|
|
|
my @result = `$locate_cmd 2 > /dev/null `; |
854
|
|
|
|
|
|
|
if ( scalar(@result) > 0 ) { |
855
|
|
|
|
|
|
|
return $i; |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Note: the various forms of locate are discussed below in |
860
|
|
|
|
|
|
|
L"locate shell command"> |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
Special case: |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
with no arguments (specifically, with $cmd_idx undefined) returns |
865
|
|
|
|
|
|
|
the count of avaliable command forms minus 1 ($#cmd_forms); |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=cut |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
sub generate_locate_cmd { |
870
|
98
|
|
|
98
|
1
|
2698
|
my $self = shift; |
871
|
98
|
|
|
|
|
492
|
my $cmd_idx = shift; |
872
|
98
|
|
100
|
|
|
8380
|
my $search_term = shift || ''; # suppressing warnings about subbing undefs |
873
|
98
|
|
50
|
|
|
2155
|
my $db = shift || ''; |
874
|
98
|
|
50
|
|
|
1257
|
my $opt_str = shift || $self->build_opts_for_locate_via_shell || ''; |
875
|
|
|
|
|
|
|
|
876
|
98
|
100
|
|
|
|
10240
|
$self->debug("cmd_idx: $cmd_idx\n") if defined( $cmd_idx ); |
877
|
98
|
|
|
|
|
2194
|
$self->debug("generate_locate_cmd: " . |
878
|
|
|
|
|
|
|
"db: $db search_term: $search_term\n"); |
879
|
|
|
|
|
|
|
|
880
|
98
|
|
|
|
|
771
|
my @shell_locate_cmds; |
881
|
98
|
50
|
|
|
|
300
|
if( $db ) { |
882
|
0
|
|
|
|
|
0
|
@shell_locate_cmds = |
883
|
|
|
|
|
|
|
( |
884
|
|
|
|
|
|
|
"locate -q -d '$db' $opt_str $search_term", |
885
|
|
|
|
|
|
|
"locate -d '$db' $opt_str $search_term", |
886
|
|
|
|
|
|
|
"locate -q --database='$db' $opt_str $search_term", |
887
|
|
|
|
|
|
|
"locate --database='$db' $opt_str $search_term", |
888
|
|
|
|
|
|
|
); |
889
|
|
|
|
|
|
|
} else { |
890
|
98
|
|
|
|
|
628
|
@shell_locate_cmds = |
891
|
|
|
|
|
|
|
( |
892
|
|
|
|
|
|
|
"locate -q $opt_str $search_term", |
893
|
|
|
|
|
|
|
"locate $opt_str $search_term", |
894
|
|
|
|
|
|
|
"locate -q $opt_str $search_term", |
895
|
|
|
|
|
|
|
"locate $opt_str $search_term", |
896
|
|
|
|
|
|
|
); |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
98
|
|
|
|
|
246
|
my $limit = $#shell_locate_cmds; |
900
|
98
|
100
|
|
|
|
257
|
if ( not( defined( $cmd_idx ) ) ) { |
901
|
2
|
|
|
|
|
7
|
return $limit; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
96
|
50
|
|
|
|
1173
|
if ( $cmd_idx > $limit ) { |
905
|
0
|
|
|
|
|
0
|
return; # undef |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
96
|
|
|
|
|
186
|
my $cmd = $shell_locate_cmds[ $cmd_idx ]; |
909
|
96
|
|
|
|
|
373
|
$self->debug("generate_locate_cmd: returned cmd:\n$cmd\n"); |
910
|
96
|
|
|
|
|
1580
|
return $cmd; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=item build_opts_for_locate_via_shell |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
Converts the three object attribute toggles |
916
|
|
|
|
|
|
|
(L"case_insensitive">, "regexp">, "posix_extended">) |
917
|
|
|
|
|
|
|
into the command-line options string for locate. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
The "posix_extended" feature is not supported for locates |
920
|
|
|
|
|
|
|
via the shell, and if used will issue a warning. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=cut |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
sub build_opts_for_locate_via_shell { |
925
|
100
|
|
|
100
|
1
|
388
|
my $self = shift; |
926
|
100
|
|
|
|
|
487
|
my $opt_str = ''; |
927
|
100
|
50
|
|
|
|
1499
|
if ( $self->case_insensitive ) { |
928
|
0
|
|
|
|
|
0
|
$opt_str .= 'i'; |
929
|
|
|
|
|
|
|
}; |
930
|
100
|
50
|
|
|
|
639
|
if ( $self->regexp ) { |
931
|
0
|
|
|
|
|
0
|
$opt_str .= 'r'; |
932
|
|
|
|
|
|
|
} |
933
|
100
|
50
|
|
|
|
522
|
if ( $self->posix_extended ) { |
934
|
0
|
|
|
|
|
0
|
carp("Can't use posix extended regexps with locate via the shell"); |
935
|
|
|
|
|
|
|
}; |
936
|
100
|
50
|
|
|
|
248
|
$opt_str = "-$opt_str" if $opt_str; |
937
|
100
|
|
|
|
|
654
|
return $opt_str; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=item build_opts_for_locate_via_module |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Converting three object attribute toggles |
943
|
|
|
|
|
|
|
(L"case_insensitive">, "regexp">, "posix_extended">) |
944
|
|
|
|
|
|
|
into the form that the File::Locate::locate |
945
|
|
|
|
|
|
|
requires: returns an array. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=cut |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
sub build_opts_for_locate_via_module { |
950
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
951
|
0
|
|
|
|
|
0
|
my $rexopt_str = ''; |
952
|
0
|
|
|
|
|
0
|
my @opts = (); |
953
|
0
|
0
|
|
|
|
0
|
if ( $self->case_insensitive ) { |
954
|
0
|
|
|
|
|
0
|
$rexopt_str .= 'i'; |
955
|
|
|
|
|
|
|
}; |
956
|
0
|
0
|
|
|
|
0
|
if ( $self->posix_extended ) { |
957
|
0
|
|
|
|
|
0
|
$rexopt_str .= 'e'; |
958
|
|
|
|
|
|
|
}; |
959
|
0
|
0
|
0
|
|
|
0
|
if ( $self->regexp || $rexopt_str ) { # any -rexopt (even 'i') implies |
960
|
|
|
|
|
|
|
# a need for -rex |
961
|
0
|
|
|
|
|
0
|
@opts = (-rex => 1); |
962
|
|
|
|
|
|
|
} |
963
|
0
|
0
|
|
|
|
0
|
push @opts, (-rexopt => $rexopt_str) if $rexopt_str; |
964
|
0
|
|
|
|
|
0
|
return @opts; |
965
|
|
|
|
|
|
|
} |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=back |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
=head2 initialization utilities |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=over |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=item define_probe_parameters |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
An internal method, used during the object init process. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
Defines two arrays that are used to control the locate db "probe" |
978
|
|
|
|
|
|
|
process: the test_search_terms and the |
979
|
|
|
|
|
|
|
locate_db_location_candidates. |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
The locate_db_location_candidates are likely places for a |
982
|
|
|
|
|
|
|
system's locate db. See L below. |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
The test_search_terms are common terms in unix file paths, |
985
|
|
|
|
|
|
|
which we can check to see if what looks like the locate |
986
|
|
|
|
|
|
|
database really is one. See L"checking if a form of locate works"> |
987
|
|
|
|
|
|
|
below. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=cut |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
sub define_probe_parameters { |
992
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
# common strings in file paths on perl/unix systems, |
995
|
|
|
|
|
|
|
# in roughly increasing likelihood of size of search result |
996
|
2
|
|
|
|
|
11
|
my @test_search_terms = |
997
|
|
|
|
|
|
|
qw( |
998
|
|
|
|
|
|
|
MakeMaker |
999
|
|
|
|
|
|
|
SelfStubber |
1000
|
|
|
|
|
|
|
DynaLoader |
1001
|
|
|
|
|
|
|
README |
1002
|
|
|
|
|
|
|
tmp |
1003
|
|
|
|
|
|
|
bin |
1004
|
|
|
|
|
|
|
the |
1005
|
|
|
|
|
|
|
htm |
1006
|
|
|
|
|
|
|
txt |
1007
|
|
|
|
|
|
|
home |
1008
|
|
|
|
|
|
|
e |
1009
|
|
|
|
|
|
|
/ |
1010
|
|
|
|
|
|
|
); |
1011
|
2
|
|
|
|
|
45
|
$self->set_test_search_terms( \@test_search_terms ); |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
# some places one might look for the system's |
1014
|
|
|
|
|
|
|
# locate db, in roughly increasing order of likelihood |
1015
|
2
|
|
|
|
|
12
|
my @candidates = |
1016
|
|
|
|
|
|
|
qw( |
1017
|
|
|
|
|
|
|
/var/lib/slocate/slocate.db |
1018
|
|
|
|
|
|
|
/var/cache/locate/locatedb |
1019
|
|
|
|
|
|
|
/var/db/locate.database |
1020
|
|
|
|
|
|
|
/usr/var/locatedb |
1021
|
|
|
|
|
|
|
/var/lib/locatedb |
1022
|
|
|
|
|
|
|
/usr/local/var/locatedb |
1023
|
|
|
|
|
|
|
/var/lib/locate/locatedb |
1024
|
|
|
|
|
|
|
/var/spool/locate/locatedb |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
/var/cache/locate/slocate.db |
1027
|
|
|
|
|
|
|
/var/db/slocate.db |
1028
|
|
|
|
|
|
|
/usr/var/slocate.db |
1029
|
|
|
|
|
|
|
/usr/local/var/slocate.db |
1030
|
|
|
|
|
|
|
/var/lib/locate/slocate.db |
1031
|
|
|
|
|
|
|
/var/spool/locate/slocate.db |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
/var/lib/slocate/locate.database |
1034
|
|
|
|
|
|
|
/var/cache/locate/locate.database |
1035
|
|
|
|
|
|
|
/usr/var/locate.database |
1036
|
|
|
|
|
|
|
/usr/local/var/locate.database |
1037
|
|
|
|
|
|
|
/var/lib/locate/locate.database |
1038
|
|
|
|
|
|
|
/var/spool/locate/locate.database |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
/var/lib/slocate/locatedb |
1041
|
|
|
|
|
|
|
/var/db/locatedb |
1042
|
|
|
|
|
|
|
); |
1043
|
2
|
|
|
|
|
44
|
$self->set_locate_db_location_candidates( \@candidates ); |
1044
|
2
|
|
|
|
|
4
|
return $self; |
1045
|
|
|
|
|
|
|
} |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=back |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head2 basic setters and getters |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=over |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=item db |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
Getter for object attribute system_db |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=item set_db |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
Setter for object attribute set_db |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
As a side-effect, unsets the shell_locate_failed flag |
1062
|
|
|
|
|
|
|
(what if the last db file was bad, and this current |
1063
|
|
|
|
|
|
|
setting will work?). |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
=cut |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
sub set_db { |
1068
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1069
|
0
|
|
|
|
|
0
|
my $db = shift; |
1070
|
0
|
|
|
|
|
0
|
$self->{ db } = $db; |
1071
|
0
|
|
|
|
|
0
|
$self->set_shell_locate_failed( undef ); |
1072
|
0
|
|
|
|
|
0
|
return $db; |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=back |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
=head2 EXPERIMENTAL |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
Having some trouble straightening out the above code as-written. |
1080
|
|
|
|
|
|
|
Going to work on some experimental routines here, that might |
1081
|
|
|
|
|
|
|
have a use somewhere. |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=over |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
=item work_via |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
Try the db various ways, make a recommendation on how to access it. |
1088
|
|
|
|
|
|
|
Return string: 'module' or 'shell'. |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
Q: how to handle the shell-but-undef-db case? |
1091
|
|
|
|
|
|
|
A1: could be a third how-type 'shell_unknown' |
1092
|
|
|
|
|
|
|
A2: could be some sort of meta-field, a "system_db_indeterminate" flag |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=cut |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
sub work_via { |
1097
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1098
|
0
|
|
0
|
|
|
0
|
my $db = shift || $self->db; |
1099
|
|
|
|
|
|
|
|
1100
|
0
|
|
|
|
|
0
|
my $how; |
1101
|
|
|
|
|
|
|
|
1102
|
0
|
0
|
|
|
|
0
|
if ( $self->probe_db_via_module_locate( $db ) ) { |
1103
|
0
|
|
|
|
|
0
|
$how = 'module'; |
1104
|
|
|
|
|
|
|
} else { |
1105
|
0
|
0
|
|
|
|
0
|
if( $self->probe_db_via_shell_locate( $db ) ) { |
1106
|
0
|
|
|
|
|
0
|
$how = 'shell'; |
1107
|
|
|
|
|
|
|
} else { |
1108
|
0
|
|
|
|
|
0
|
$how = 'shell_unknown_db'; |
1109
|
|
|
|
|
|
|
} |
1110
|
|
|
|
|
|
|
} |
1111
|
0
|
|
|
|
|
0
|
return $how; |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=back |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=head2 automatic accessor generation |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
=over |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=item AUTOLOAD |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=cut |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
sub AUTOLOAD { |
1129
|
24
|
50
|
|
24
|
|
176
|
return if $AUTOLOAD =~ /DESTROY$/; # skip calls to DESTROY () |
1130
|
|
|
|
|
|
|
|
1131
|
24
|
|
|
|
|
195
|
my ($name) = $AUTOLOAD =~ /([^:]+)$/; # extract method name |
1132
|
24
|
|
|
|
|
82
|
(my $field = $name) =~ s/^set_//; |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
# check that this is a valid accessor call |
1135
|
24
|
50
|
|
|
|
81
|
croak("Unknown method '$AUTOLOAD' called") |
1136
|
|
|
|
|
|
|
unless defined( $ATTRIBUTES{ $field } ); |
1137
|
|
|
|
|
|
|
|
1138
|
2
|
|
|
2
|
|
43
|
{ no strict 'refs'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
873
|
|
|
24
|
|
|
|
|
32
|
|
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
# create the setter and getter and install them in the symbol table |
1141
|
|
|
|
|
|
|
|
1142
|
24
|
100
|
|
|
|
91
|
if ( $name =~ /^set_/ ) { |
|
|
50
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
*$name = sub { |
1145
|
10
|
|
|
10
|
|
22
|
my $self = shift; |
1146
|
10
|
|
|
|
|
72
|
$self->{ $field } = shift; |
1147
|
10
|
|
|
|
|
26
|
return $self->{ $field }; |
1148
|
10
|
|
|
|
|
90
|
}; |
1149
|
|
|
|
|
|
|
|
1150
|
10
|
|
|
|
|
39
|
goto &$name; # jump to the new method. |
1151
|
|
|
|
|
|
|
} elsif ( $name =~ /^get_/ ) { |
1152
|
0
|
|
|
|
|
0
|
carp("Apparent attempt at using a getter with unneeded 'get_' prefix."); |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
*$name = sub { |
1156
|
310
|
|
|
310
|
|
563
|
my $self = shift; |
1157
|
310
|
|
|
|
|
1355
|
return $self->{ $field }; |
1158
|
14
|
|
|
|
|
73
|
}; |
1159
|
|
|
|
|
|
|
|
1160
|
14
|
|
|
|
|
35
|
goto &$name; # jump to the new method. |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
} |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
1; |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=back |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
=head1 Platforms |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
It's likely that this package will work on any unix-like system |
1171
|
|
|
|
|
|
|
(including cygwin), though on some there might be a need for |
1172
|
|
|
|
|
|
|
additional installation and setup (e.g. a "findutils" package). |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
Development was done on two varieties of linux (aka GNU/linux): |
1175
|
|
|
|
|
|
|
Knoppix (32bit) on a Turion and Kubuntu on an Opteron machine. |
1176
|
|
|
|
|
|
|
This covered two major varieties of the "locate" command: |
1177
|
|
|
|
|
|
|
GNU locate and Secure Locate. |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
A serious attempt was made to support BSD locate on Freebsd, |
1180
|
|
|
|
|
|
|
but the testing has not been completed. |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
Note: at present the File::Locate module appears to fail silently |
1183
|
|
|
|
|
|
|
on 64bit platforms, so there the command-line shell locate will |
1184
|
|
|
|
|
|
|
always be used. |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=head1 MOTIVATION |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
This module uses L, which is a a perl XS interface |
1190
|
|
|
|
|
|
|
to read locate (or slocate) dbs without shellling out to the |
1191
|
|
|
|
|
|
|
command-line "locate" program. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
File::Locate has one great limitation: it must be told which locate |
1194
|
|
|
|
|
|
|
db to use (by explicit parameter, or by environment variable), it |
1195
|
|
|
|
|
|
|
has no notion of a default location. Further, as of this writing, |
1196
|
|
|
|
|
|
|
it appears to be limited to 32bit systems. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
This module then is a wrapper around File::Locate that tries a |
1199
|
|
|
|
|
|
|
number of common locations for the locate database, and instead |
1200
|
|
|
|
|
|
|
of just giving up, it also tries the command-line locate, which |
1201
|
|
|
|
|
|
|
has it's own ways of knowing where the database can be |
1202
|
|
|
|
|
|
|
(configuration file, compiled-in default, or command-line |
1203
|
|
|
|
|
|
|
parameter). |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
The intention here is to make this module as portable as |
1206
|
|
|
|
|
|
|
possible... it might, for example, be useful to use in portable |
1207
|
|
|
|
|
|
|
CPAN modules that need to look for things in the filesystem. |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
(As a case in point: the job of File::Locate::Harder would be a lot |
1210
|
|
|
|
|
|
|
easier if it could use "locate" to find the locate db...). |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
=head1 Additional Examples |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=head2 forcing locate via File::Locate module or via shell command |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new(); |
1217
|
|
|
|
|
|
|
$result_via_module = $flh->locate_via_module( $term ); |
1218
|
|
|
|
|
|
|
$result_via_shell = $flh->locate_via_shell( $term ); |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=head2 using the coderef feature of the File::Locate module |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
my $count = 0; |
1223
|
|
|
|
|
|
|
$flh->locate_via_module( $term, sub { $count++ } ); |
1224
|
|
|
|
|
|
|
print "There are $count matches of $term\n"; |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
$flh->locate_via_module( $term, |
1228
|
|
|
|
|
|
|
sub { $count++ if $_ =~ m{ ^ /home }x } ); |
1229
|
|
|
|
|
|
|
print "There are $count matches of $term located in /home\n"; |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
=head2 speeding up multiple searches if you know you're using shell locate |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
This reduces the number of calls to build_opts_for_locate_via_shell: |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
my @searches = qw( .bashrc .bash_profile .emacs default.el ); |
1236
|
|
|
|
|
|
|
my $flh = File::Locate::Harder->new(); |
1237
|
|
|
|
|
|
|
my $opt_str = $self->build_opts_for_locate_via_shell; |
1238
|
|
|
|
|
|
|
foreach my $term (@searches) { |
1239
|
|
|
|
|
|
|
$result_via_shell = $flh->locate_via_shell( $term, $opt_str ); |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
=head1 SEE ALSO |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
L |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
Manual pages: L, L, and/or L. |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
=head1 NOTES |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
=head2 architecture |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
The general philosophy in use here is to just try things that |
1253
|
|
|
|
|
|
|
are likely to work and then just try something else if they |
1254
|
|
|
|
|
|
|
fail. This is probably better than attempting to guess which |
1255
|
|
|
|
|
|
|
form of locate to use based on the current platform, because (a) |
1256
|
|
|
|
|
|
|
no one (to my knowledge) has a capabilities database that |
1257
|
|
|
|
|
|
|
specifies which locate is found on which platform (b) different |
1258
|
|
|
|
|
|
|
variants may be installed at the whim of a sysadmin (c) there |
1259
|
|
|
|
|
|
|
may after all be variants of locate I've never encountered. |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
So checking ^O is of limited utility, and similarly, some of the |
1262
|
|
|
|
|
|
|
existing forms of locate lack introspection features (e.g. you |
1263
|
|
|
|
|
|
|
can't get freebsd's locate to tell you what version it is). |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=head2 details |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
The object creation process "new" and "init" determines how to do |
1268
|
|
|
|
|
|
|
system-wide locates, and saves it's conclusions for use by future |
1269
|
|
|
|
|
|
|
calls of the locate method on this object. |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
Some of this elaborate initialization process can be |
1272
|
|
|
|
|
|
|
short-circuited if it's told which db file to use, or even just |
1273
|
|
|
|
|
|
|
giving it an "db" option with an undefined value. That's |
1274
|
|
|
|
|
|
|
convenient for cases where you want to use this module to create |
1275
|
|
|
|
|
|
|
a locate db of your own (there's no point in scoping for a |
1276
|
|
|
|
|
|
|
system-wide db if we're going to use a specialized one). |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
If the db location is not known, the search process begins |
1279
|
|
|
|
|
|
|
with making guesses about likely locations it might be found. |
1280
|
|
|
|
|
|
|
It goes through this list: |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
/var/lib/slocate/slocate.db -- Secure Locate under Kubuntu |
1283
|
|
|
|
|
|
|
/var/cache/locate/locatedb -- GNU locate, under Knoppix |
1284
|
|
|
|
|
|
|
/var/db/locate.database -- BSD locate, under FreeBSD |
1285
|
|
|
|
|
|
|
/usr/var/locatedb -- mentioned: File::Locate docs and cygwin lists |
1286
|
|
|
|
|
|
|
/var/lib/locatedb -- mentioned on insecure.org |
1287
|
|
|
|
|
|
|
/usr/local/var/locatedb -- Solaris with findutils installed |
1288
|
|
|
|
|
|
|
/var/lib/locate/locatedb -- mentioned on a Debian list in 2000 |
1289
|
|
|
|
|
|
|
/var/spool/locate/locatedb -- speculative mention on a cygwin list |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
So that's three names, in 8 locations. It also tries other |
1292
|
|
|
|
|
|
|
permutations on speculation: |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
/var/cache/locate/slocate.db |
1295
|
|
|
|
|
|
|
/var/db/slocate.db |
1296
|
|
|
|
|
|
|
/usr/var/slocate.db |
1297
|
|
|
|
|
|
|
/usr/local/var/slocate.db |
1298
|
|
|
|
|
|
|
/var/lib/locate/slocate.db |
1299
|
|
|
|
|
|
|
/var/spool/locate/slocate.db |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
/var/lib/slocate/locate.database |
1302
|
|
|
|
|
|
|
/var/cache/locate/locate.database |
1303
|
|
|
|
|
|
|
/usr/var/locate.database |
1304
|
|
|
|
|
|
|
/usr/local/var/locate.database |
1305
|
|
|
|
|
|
|
/var/lib/locate/locate.database |
1306
|
|
|
|
|
|
|
/var/spool/locate/locate.database |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
/var/lib/slocate/locatedb |
1309
|
|
|
|
|
|
|
/var/db/locatedb |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
Each of these possibilites is checked for simple file-existance, |
1312
|
|
|
|
|
|
|
and then checked to see if one works. (See |
1313
|
|
|
|
|
|
|
L"checking if a form of locate works"> below.) |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=head2 locate shell command |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
If attempts at using L fails, the system falls back |
1318
|
|
|
|
|
|
|
to shelling out to the locate command (which really should already |
1319
|
|
|
|
|
|
|
know how to find the system-wide db, either from a compiled-in |
1320
|
|
|
|
|
|
|
default or a config file setting). |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
But the locate shell command has it's own problems. There are at |
1323
|
|
|
|
|
|
|
least three variants, with some slight differences between GNU |
1324
|
|
|
|
|
|
|
locate, slocate and freebsd locate. |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
The current architecture of locate_via_shell tries all of them |
1327
|
|
|
|
|
|
|
in a certain order, and remembers the one that worked last time. |
1328
|
|
|
|
|
|
|
|
1329
|
|
|
|
|
|
|
Briefly, here are the variations we need to account for: |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
=over |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
=item -d or --database |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
-d is essentially more general, because freebsd has it but does |
1336
|
|
|
|
|
|
|
not have --database. So, we try "-d" first, but also try "--database" |
1337
|
|
|
|
|
|
|
just in case. |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
=item -q for quiet |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
As of this writing, with slocate, if you tell it explicitly |
1342
|
|
|
|
|
|
|
which db to use, that works, but you also get an ignorable error |
1343
|
|
|
|
|
|
|
about how you don't have permissions to mess with the system |
1344
|
|
|
|
|
|
|
wide database. You can get this warning to go away with the |
1345
|
|
|
|
|
|
|
"-q" option, but neither Gnu locate or freebsd has it, and if |
1346
|
|
|
|
|
|
|
you use it with them it's a fatal error. So here we try to use "-q" |
1347
|
|
|
|
|
|
|
first, and if that dies, we run without it. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=back |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
And still other variations exist in requesting version information. |
1352
|
|
|
|
|
|
|
The FreeBSD form does not understand "--version", and in fact |
1353
|
|
|
|
|
|
|
doesn't seem to have any sort of version option. |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
(Ah, Cross-platform programming is such a joy.) |
1356
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=head2 checking if a form of locate works |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
In order to check that a system-wide locate is working, we probe for |
1360
|
|
|
|
|
|
|
files we know (or strongly suspect) will be there on the system. |
1361
|
|
|
|
|
|
|
This module tries a series of guesses of decreasing specificity |
1362
|
|
|
|
|
|
|
(there's no point in getting a huge number of hits if they're not |
1363
|
|
|
|
|
|
|
needed), then bails out on the list if a result is recieved. |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
The list in use here begins with files in the standard perl library |
1366
|
|
|
|
|
|
|
(which should accompany almost any installation of perl, unless they |
1367
|
|
|
|
|
|
|
were removed for some reason): |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
MakeMaker |
1370
|
|
|
|
|
|
|
SelfStubber |
1371
|
|
|
|
|
|
|
DynaLoader |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
It then begins looking for strings that should be relatively common |
1374
|
|
|
|
|
|
|
on most systems: |
1375
|
|
|
|
|
|
|
|
1376
|
|
|
|
|
|
|
README |
1377
|
|
|
|
|
|
|
tmp |
1378
|
|
|
|
|
|
|
bin |
1379
|
|
|
|
|
|
|
the |
1380
|
|
|
|
|
|
|
htm |
1381
|
|
|
|
|
|
|
txt |
1382
|
|
|
|
|
|
|
home |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
The presumption is that if there are no hits on those searchs on a |
1385
|
|
|
|
|
|
|
system-wide database, something is very wrong, and that particular |
1386
|
|
|
|
|
|
|
form of "locate" just isn't working. |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head2 File::Locate |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
By using File::Locate with () to supress import, we need to call |
1391
|
|
|
|
|
|
|
'locate' like so: |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
File::Locate::locate |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
which makes it easy for us to define a new 'locate' method of |
1396
|
|
|
|
|
|
|
our own. |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
The proceedural syntax of File::Locate::locate has it's ugly aspects, |
1399
|
|
|
|
|
|
|
but the documentation is usually clear: |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
my @mp3s = File::Locate::locate "mp3", "/usr/var/locatedb"; |
1402
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
# do regex search |
1404
|
|
|
|
|
|
|
@hits = File::Locate::locate "^/usr", -rex => 1, "/usr/var/locatedb"; |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
@hits = File::Locate::locate "^/usr", -rexopt => 'ie', "/usr/var/locatedb"; |
1407
|
|
|
|
|
|
|
# i - case insensitive |
1408
|
|
|
|
|
|
|
# e - POSIX extended regexps (say what?) |
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
Note: it isn't abundantly clear from the documentation if |
1411
|
|
|
|
|
|
|
-rexopt has to be used with -rex, but it appears that this is |
1412
|
|
|
|
|
|
|
the case. (And there is a syntax diagram that indicates this). |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
Another oddity, though: there doesn't seem to be a way to do a |
1415
|
|
|
|
|
|
|
case-insensitive search without using regexps. |
1416
|
|
|
|
|
|
|
(Note: none of the tests use the "-rexopt" feature.) |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
A very cool touch is that you can hand it a coderef, and avoid |
1419
|
|
|
|
|
|
|
building up a big result set: |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
File::Locate::locate "*.mp3", sub { print "MP3 found: $_n" }; |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
Note: the order of arguments to File::Locate::locate is supposed |
1424
|
|
|
|
|
|
|
to be irrelevant. |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
=head2 creating a database |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
Creating your own private locate database isn't done very often, |
1429
|
|
|
|
|
|
|
but this module tries to support it largely for purposes of writing |
1430
|
|
|
|
|
|
|
portable tests (we can't know what files are installed on a remote system, |
1431
|
|
|
|
|
|
|
so it's difficult to know what a locate operation should have found... |
1432
|
|
|
|
|
|
|
*unless* we generate a small locate database of our own that tracks |
1433
|
|
|
|
|
|
|
a known set of files that we ship with the tests). |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
Unfortunately there are several different invocation forms for doing this, |
1436
|
|
|
|
|
|
|
depending on the variant of locate you have installed. As usual, |
1437
|
|
|
|
|
|
|
we try everything we can think of, and only give up if none of them work. |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
my @cmd = ( "slocate -U $location -o $db", |
1440
|
|
|
|
|
|
|
"updatedb --require-visibility 0 --output=$db --database-root='$location'", |
1441
|
|
|
|
|
|
|
"updatedb --output=$db --localpaths='$location'", |
1442
|
|
|
|
|
|
|
); |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
It probably comes as no surprise that "slocate" and "updatedb" have |
1445
|
|
|
|
|
|
|
different forms. I was, uh, *interested* to see that my updatedb |
1446
|
|
|
|
|
|
|
works differently now (2010) than when I wrote this code in 2007. |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
The man page for the version of updatedb installed on my Ubuntu "jaunty" |
1449
|
|
|
|
|
|
|
box has a version of "update" db written by: "Miloslav Trmac " |
1450
|
|
|
|
|
|
|
where the option I need is called "--database-root", I see that the |
1451
|
|
|
|
|
|
|
old option name I was using, "--localpaths", was used by a version |
1452
|
|
|
|
|
|
|
written by "Glenn Fowler ". |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
Also, with the RedHat version-- which looks as though it thinks |
1455
|
|
|
|
|
|
|
of itself as "mlocate"-- the "-require-visibility 0" option is |
1456
|
|
|
|
|
|
|
recommended for the creation of a small, private locate db. |
1457
|
|
|
|
|
|
|
|
1458
|
|
|
|
|
|
|
=head2 system status fields |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
The system status fields (the one's that can be saved or inspected |
1461
|
|
|
|
|
|
|
via L) no doubt seem redundant: |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
db |
1464
|
|
|
|
|
|
|
system_db_not_found |
1465
|
|
|
|
|
|
|
use_shell_locate |
1466
|
|
|
|
|
|
|
shell_locate_failed |
1467
|
|
|
|
|
|
|
shell_locate_cmd_idx |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
It's possible that they *are* somewhat redundant: they were |
1470
|
|
|
|
|
|
|
invented on-the-fly during development on an ad hoc basis. |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
However, despite the way it looks, this set is resistant to being |
1473
|
|
|
|
|
|
|
reduced in size. Two-valued logic has it's limitations: for our |
1474
|
|
|
|
|
|
|
immediate purpose, there has to be ways to distinguish between "I |
1475
|
|
|
|
|
|
|
don't know what this value is, and you should try to find out" |
1476
|
|
|
|
|
|
|
and "I don't know what this value is, and it isn't worth trying |
1477
|
|
|
|
|
|
|
to find it." For example, the "db" field alone isn't good |
1478
|
|
|
|
|
|
|
enough, it needs to be supplemented with information about what |
1479
|
|
|
|
|
|
|
we've done to try to determine the "db". |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
As for "use_shell_locate" and "shell_locate_failed": |
1482
|
|
|
|
|
|
|
"shell_locate_failed" is used largely to skip doing a probe via |
1483
|
|
|
|
|
|
|
shell if it's failed before (possibly it's name should be |
1484
|
|
|
|
|
|
|
expanded to "shell_locate_probe_failed"). Even if the system has |
1485
|
|
|
|
|
|
|
been explicitly told to work via the shell, it's still necessary |
1486
|
|
|
|
|
|
|
to do a probe to find out which form of the shell locate command |
1487
|
|
|
|
|
|
|
will work ("shell_locate_cmd_idx"). |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
=head1 AUTHOR |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
Joseph Brenner, Edoom@kzsu.stanford.eduE, |
1492
|
|
|
|
|
|
|
29 May 2007 |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
Copyright (C) 2007, 2010 by Joseph Brenner |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
1499
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.2 or, |
1500
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
=head1 BUGS |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
None reported... yet. |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
=cut |