File Coverage

blib/lib/Module/Installed/Tiny.pm
Criterion Covered Total %
statement 69 126 54.7
branch 46 100 46.0
condition 3 8 37.5
subroutine 7 7 100.0
pod 2 2 100.0
total 127 243 52.2


line stmt bran cond sub pod time code
1              
2             use strict;
3 2     2   198730 use warnings;
  2         17  
  2         48  
4 2     2   9  
  2         3  
  2         45  
5             use Exporter qw(import);
6 2     2   8  
  2         2  
  2         249  
7             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
8             our $DATE = '2022-07-30'; # DATE
9             our $DIST = 'Module-Installed-Tiny'; # DIST
10             our $VERSION = '0.010'; # VERSION
11              
12             our @EXPORT_OK = qw(module_installed module_source);
13              
14             our $SEPARATOR;
15             BEGIN {
16             if ($^O =~ /^(dos|os2)/i) {
17 2 50   2   18 $SEPARATOR = '\\';
    50          
18 0         0 } elsif ($^O =~ /^MacOS/i) {
19             $SEPARATOR = ':';
20 0         0 } else {
21             $SEPARATOR = '/';
22 2         2063 }
23             }
24              
25             my $name = shift;
26              
27 17     17   22 my ($name_mod, $name_pm, $name_path);
28             # name_mod is Foo::Bar form, name_pm is Foo/Bar.pm form, name_path is
29 17         24 # Foo/Bar.pm or Foo\Bar.pm (uses native path separator), name_path_prefix is
30             # Foo/Bar.
31              
32             if ($name =~ m!/|\.pm\z!) {
33             # assume it's name_pm form
34 17 100 33     85 $name_pm = $name;
    50          
35             $name_mod = $name; $name_mod =~ s/\.pm\z//; $name_mod =~ s!/!::!g;
36 1         2 $name_path = $name_pm; $name_path =~ s!/!$SEPARATOR!g if $SEPARATOR ne '/';
37 1         1 } elsif ($SEPARATOR ne '/' && $name =~ m!\Q$SEPARATOR!) {
  1         4  
  1         3  
38 1 50       2 # assume it's name_path form
  1         2  
39             $name_path = $name;
40             ($name_pm = $name_path) =~ s!\Q$SEPARATOR!/!g;
41 0         0 $name_mod = $name_pm; $name_mod =~ s/\.pm\z//; $name_mod =~ s!/!::!g;
42 0         0 } else {
43 0         0 # assume it's name_mod form
  0         0  
  0         0  
44             $name_mod = $name;
45             ($name_pm = "$name_mod.pm") =~ s!::!/!g;
46 16         25 $name_path = $name_pm; $name_path =~ s!/!$SEPARATOR!g if $SEPARATOR ne '/';
47 16         48 }
48 16 50       23  
  16         30  
49             ($name_mod, $name_pm, $name_path);
50             }
51 17         45  
52             my ($name, $opts) = @_;
53              
54             $opts //= {};
55 12     12 1 17205 $opts->{die} = 1 unless defined $opts->{die};
56              
57 12   100     37 my ($name_mod, $name_pm, $name_path) = _parse_name($name);
58 12 100       28  
59             my $index = -1;
60 12         19 my @res;
61             ENTRY:
62 12         28 for my $entry (@INC) {
63 12         14 $index++;
64             next unless defined $entry;
65 12         27 my $ref = ref($entry);
66 133         165 my ($is_hook, @hook_res);
67 133 50       183 if ($ref eq 'ARRAY') {
68 133         166 $is_hook++;
69 133         153 eval { @hook_res = $entry->[0]->($entry, $name_pm) };
70 133 50       481 if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
    100          
    50          
71 0         0 } elsif (UNIVERSAL::can($entry, 'INC')) {
72 0         0 $is_hook++;
  0         0  
73 0 0       0 eval { @hook_res = $entry->INC($name_pm) };
  0 0       0  
  0         0  
  0         0  
74             if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
75 1         3 } elsif ($ref eq 'CODE') {
76 1         2 $is_hook++;
  1         5  
77 1 50       47 eval { @hook_res = $entry->($entry, $name_pm) };
  1 50       3  
  0         0  
  1         3  
78             if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
79 0         0 } else {
80 0         0 my $path = "$entry$SEPARATOR$name_path";
  0         0  
81 0 0       0 if (-f $path) {
  0 0       0  
  0         0  
  0         0  
82             my $fh;
83 132         222 unless (open $fh, "<", $path) {
84 132 100       1187 if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: $path: $! (\@INC contains ".join(" ", @INC).")" } else { return }
    100          
85 7         15 }
86 7 50       189 local $/;
87 0 0       0 my $res = wantarray ? [scalar <$fh>, $path, $entry, $index, $name_mod, $name_pm, $name_path] : scalar <$fh>;
  0         0  
  0         0  
88             if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
89 7         30 } elsif ($opts->{find_prefix}) {
90 7 100       157 $name_path =~ s/\.pm\z//;
91 7 100       21 if (-d $path) {
  4 100       46  
  3         52  
92             my $res = wantarray ? [undef, $path, $entry, $index, $name_mod, $name_pm, $name_path] : \$path;
93 24         52 if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
94 24 100       155 }
95 2 100       9 }
96 2 100       15 }
  0 50       0  
  2         11  
97              
98             if ($is_hook) {
99             next unless @hook_res;
100             my ($src, $fh, $code);
101 127 50       295 eval {
102 0 0       0 my $prepend_ref; $prepend_ref = shift @hook_res if ref($hook_res[0]) eq 'SCALAR';
103 0         0 $fh = shift @hook_res if ref($hook_res[0]) eq 'GLOB';
104 0         0 $code = shift @hook_res if ref($hook_res[0]) eq 'CODE';
105 0 0       0 my $code_state ; $code_state = shift @hook_res if @hook_res;
  0         0  
106 0 0       0 if ($fh) {
107 0 0       0 $src = "";
108 0 0       0 local $_;
  0         0  
109 0 0       0 while (!eof($fh)) {
    0          
110 0         0 $_ = <$fh>;
111 0         0 if ($code) {
112 0         0 $code->($code, $code_state);
113 0         0 }
114 0 0       0 $src .= $_;
115 0         0 }
116             $src = $$prepend_ref . $src if $prepend_ref;
117 0         0 } elsif ($code) {
118             $src = "";
119 0 0       0 local $_;
120             while ($code->($code, $code_state)) {
121 0         0 $src .= $_;
122 0         0 }
123 0         0 $src = $$prepend_ref . $src if $prepend_ref;
124 0         0 }
125             }; # eval
126 0 0       0 if ($@) { if ($opts->{die}) { die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module): $entry: ".($fh || $code).": $@ (\@INC contains ".join(" ", @INC).")" } else { return } }
127             my $res = wantarray ? [$src, undef, $entry, $index, $name_mod, $name_pm, $name_path] : $src;
128             if ($opts->{all}) { push @res, $res } else { return wantarray ? @$res : $res }
129 0 0 0     0 } # if $is_hook
  0 0       0  
  0         0  
  0         0  
130 0 0       0 }
131 0 0       0  
  0 0       0  
  0         0  
132             if (@res) {
133             return wantarray ? @res : \@res;
134             } else {
135 6 100       15 if ($opts->{die}) {
136 2 100       12 die "Can't locate $name_pm in \@INC (you may need to install the $name_mod module) (\@INC contains ".join(" ", @INC).")";
137             } else {
138 4 100       7 return;
139 1         23 }
140             }
141 3         12 }
142              
143             my ($name, $opts) = @_;
144              
145             # convert Foo::Bar -> Foo/Bar.pm
146             my ($name_mod, $name_pm, $name_path) = _parse_name($name);
147 5     5 1 2869  
148             return 1 if exists $INC{$name_pm};
149              
150 5         14 my $res = module_source($name, {%{ $opts || {}}, die=>0});
151             defined($res) ? 1:0;
152 5 100       17 }
153              
154 3 50       14 1;
  3         21  
155 3 100       19 # ABSTRACT: Check if a module is installed, with as little code as possible
156              
157              
158             =pod
159              
160             =encoding UTF-8
161              
162             =head1 NAME
163              
164             Module::Installed::Tiny - Check if a module is installed, with as little code as possible
165              
166             =head1 VERSION
167              
168             This document describes version 0.010 of Module::Installed::Tiny (from Perl distribution Module-Installed-Tiny), released on 2022-07-30.
169              
170             =head1 SYNOPSIS
171              
172             use Module::Installed::Tiny qw(module_installed module_source);
173              
174             # check if a module is available
175             if (module_installed "Foo::Bar") {
176             # Foo::Bar is available
177             } elsif (module_installed "Foo/Baz.pm") {
178             # Foo::Baz is available
179             }
180              
181             # get a module's source code, dies on failure
182             my $src = module_source("Foo/Baz.pm");
183              
184             =head1 DESCRIPTION
185              
186             To check if a module is installed (available), generally the simplest way is to
187             try to C<require()> it:
188              
189             if (eval { require Foo::Bar; 1 }) {
190             # Foo::Bar is available
191             }
192             # or
193             my $mod_pm = "Foo/Bar.pm";
194             if (eval { require $mod_pm; 1 }) {
195             # Foo::Bar is available
196             }
197              
198             However, this actually loads the module. There are some cases where this is not
199             desirable: 1) we have to check a lot of modules (actually loading the modules
200             will take a lot of CPU time and memory; 2) some of the modules conflict with one
201             another and cannot all be loaded; 3) the module is OS specific and might not
202             load under another OS; 4) we simply do not want to execute the module, for
203             security or other reasons.
204              
205             C<Module::Installed::Tiny> provides a routine C<module_installed()> which works
206             like Perl's C<require> but does not actually load the module.
207              
208             This module does not require any other module except L<Exporter>.
209              
210             =head1 FUNCTIONS
211              
212             =head2 module_source
213              
214             Usage:
215              
216             module_source($name [ , \%opts ]) => str | list
217              
218             Return module's source code, without actually loading/executing it. Module
219             source will be searched in C<@INC> the way Perl's C<require()> finds modules.
220             This include executing require hooks in C<@INC> if there are any.
221              
222             Die on failure (e.g. module named C<$name> not found in C<@INC> or module source
223             file cannot be read) with the same/similar message as Perl's C<require()>:
224              
225             Can't locate Foo/Bar.pm (you may need to install the Foo::Bar module) ...
226              
227             Module C<$name> can be in the form of C<Foo::Bar>, C<Foo/Bar.pm> or
228             C<Foo\Bar.pm> (on Windows).
229              
230             In list context, will return a record of information:
231              
232             # [0] [1] [2] [3] [4] [5] [6]
233             my ($src, $path, $entry, $index, $name_mod, $name_pm, $name_path) = module_source($name);
234              
235             where:
236              
237             =over
238              
239             =item * $src
240              
241             String. The module source code.
242              
243             =item * $path
244              
245             String. The filesystem path (C<undef> if source comes from a require hook).
246              
247             =item * $entry
248              
249             The element in C<@INC> where the source comes from.
250              
251             =item * $index
252              
253             Integer, the index of entry in C<@INC> where the source comes from, 0 means the
254             first entry.
255              
256             =item * $name_mod
257              
258             Module name normalized to C<Foo::Bar> form.
259              
260             =item * $name_pm
261              
262             Module name normalized to C<Foo/Bar.pm> form.
263              
264             =item * $name_path
265              
266             Module name normalized to C<Foo/Bar.pm> form or C<Foo\Bar.pm> form depending on
267             the native path separator character.
268              
269             =back
270              
271             Options:
272              
273             =over
274              
275             =item * die
276              
277             Bool. Default true. If set to false, won't die upon failure but instead will
278             return undef (or empty list in list context).
279              
280             =item * find_prefix
281              
282             Bool. If set to true, when a module (e.g. C<Foo/Bar.pm>) is not found in the
283             fileysstem but its directory is (C<Foo/Bar/>), then instead of dying or
284             returning undef/empty list, the function will return:
285              
286             \$path
287              
288             in scalar context, or:
289              
290             (undef, $path, $entry, $index, $name_mod, $name_pm, $name_path)
291              
292             in list context. In scalar context, you can differentiate path from module
293             source because the path is returned as a scalar reference. So to get the path:
294              
295             $source_or_pathref = module_source("Foo/Bar.pm", {find_prefix=>1});
296             if (ref $source_or_pathref eq 'SCALAR') {
297             say "Path is ", $$source_or_pathref;
298             } else {
299             say "Module source code is $source_or_pathref";
300             }
301              
302             =item * all
303              
304             Bool. If set to true, then instead of stopping after one source is found, the
305             function will continue finding sources until all entries in C<@INC> is
306             exhausted. Then will return all the found sources as an arrayref:
307              
308             my $sources = module_source($name, {all=>1});
309              
310             In list context, will return a list of records instead of a single record:
311              
312             my @records = module_source($name, {all=>1});
313             for my $record (@records) {
314             my ($src, $path, $entry, $index, $name_mod, $name_pm, $name_path) = @$record;
315             ...
316             }
317              
318             =back
319              
320             =head2 module_installed
321              
322             Usage:
323              
324             module_installed($name [ , \%opts ]) => bool
325              
326             Check that module named C<$name> is available to load, without actually
327             loading/executing the module. Module will be searched in C<@INC> the way Perl's
328             C<require()> finds modules. This include executing require hooks in C<@INC> if
329             there are any.
330              
331             Note that this does not guarantee that the module can eventually be loaded
332             successfully, as there might be syntax or runtime errors in the module's source.
333             To check for that, one would need to actually load the module using C<require>.
334              
335             Module C<$name> can be in the form of C<Foo::Bar>, C<Foo/Bar.pm> or
336             F<Foo\Bar.pm> (on Windows).
337              
338             Options:
339              
340             =over
341              
342             =item * find_prefix
343              
344             See L</module_source> documentation.
345              
346             =back
347              
348             =head1 FAQ
349              
350             =head2 How to get module source without dying? I want to just get undef if module source is not available.
351              
352             Set the C<die> option to false:
353              
354             my $src = module_source($name, {die=>0});
355              
356             This is what C<module_installed()> does.
357              
358             =head2 How to know which @INC entry the source comes from?
359              
360             Call the L</module_source> in list context, where you will get more information
361             including the entry. See the function documentation for more details.
362              
363             =head1 HOMEPAGE
364              
365             Please visit the project's homepage at L<https://metacpan.org/release/Module-Installed-Tiny>.
366              
367             =head1 SOURCE
368              
369             Source repository is at L<https://github.com/perlancar/perl-Module-Installed-Tiny>.
370              
371             =head1 SEE ALSO
372              
373             L<Module::Load::Conditional> provides C<check_install> which also does what
374             C<module_installed> does, plus can check module version. It also has a couple
375             other knobs to customize its behavior. It's less tiny than
376             Module::Installed::Tiny though.
377              
378             L<Module::Path> and L<Module::Path::More>. These modules can also be used to
379             check if a module on the filesystem is available. They do not handle require
380             hooks, nor do they actually check that the module file is readable.
381              
382             =head1 AUTHOR
383              
384             perlancar <perlancar@cpan.org>
385              
386             =head1 CONTRIBUTING
387              
388              
389             To contribute, you can send patches by email/via RT, or send pull requests on
390             GitHub.
391              
392             Most of the time, you don't need to build the distribution yourself. You can
393             simply modify the code, then test via:
394              
395             % prove -l
396              
397             If you want to build the distribution (e.g. to try to install it locally on your
398             system), you can install L<Dist::Zilla>,
399             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
400             Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
401             beyond that are considered a bug and can be reported to me.
402              
403             =head1 COPYRIGHT AND LICENSE
404              
405             This software is copyright (c) 2022, 2021, 2020, 2016 by perlancar <perlancar@cpan.org>.
406              
407             This is free software; you can redistribute it and/or modify it under
408             the same terms as the Perl 5 programming language system itself.
409              
410             =head1 BUGS
411              
412             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Installed-Tiny>
413              
414             When submitting a bug or request, please include a test-file or a
415             patch to an existing test-file that illustrates the bug or desired
416             feature.
417              
418             =cut