« back to all changes in this revision
Viewing changes to lib/Module/Info.pm
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Jay Bonci
- Date: 2003-10-06 10:51:04 UTC
- Revision ID: james.westby@ubuntu.com-20031006105104-1b67d55zyyay6jvo
Tags: upstream-0.24
Import upstream version 0.24
- files added:
- bin
- lib
- lib/B
- lib/B/Module
- lib/Module
- t
- t/lib
- t/lib/Test
added
removed
lib/Module/Info.pm
1
package Module::Info;
2
3
use strict;
4
use Carp;
5
use File::Spec;
6
use Config;
7
require 5.004;
8
9
use vars qw($VERSION);
10
$VERSION = '0.24';
11
12
13
=head1 NAME
14
15
Module::Info - Information about Perl modules
16
17
=head1 SYNOPSIS
18
19
use Module::Info;
20
21
my $mod = Module::Info->new_from_file('Some/Module.pm');
22
my $mod = Module::Info->new_from_module('Some::Module');
23
my $mod = Module::Info->new_from_loaded('Some::Module');
24
25
my @mods = Module::Info->all_installed('Some::Module');
26
27
my $name = $mod->name;
28
my $version = $mod->version;
29
my $dir = $mod->inc_dir;
30
my $file = $mod->file;
31
my $is_core = $mod->is_core;
32
33
# Only available in perl 5.6.1 and up.
34
# These do compile the module.
35
my @packages = $mod->packages_inside;
36
my @used = $mod->modules_used;
37
my @subs = $mod->subroutines;
38
my @isa = $mod->superclasses;
39
my @calls = $mod->subroutines_called;
40
41
# Check for constructs which make perl hard to predict.
42
my @methods = $mod->dynamic_method_calls;
43
my @lines = $mod->eval_string; *UNIMPLEMENTED*
44
my @lines = $mod->gotos; *UNIMPLEMENTED*
45
my @controls = $mod->exit_via_loop_control; *UNIMPLEMENTED*
46
my @unpredictables = $mod->has_unpredictables; *UNIMPLEMENTED*
47
48
# set/get Module::Info options
49
$self->die_on_compilation_error(1);
50
my $die_on_error = $mod->die_on_compilation_error;
51
52
=head1 DESCRIPTION
53
54
Module::Info gives you information about Perl modules B<without
55
actually loading the module>. It actually isn't specific to modules
56
and should work on any perl code.
57
58
=head1 METHODS
59
60
=head2 Constructors
61
62
There are a few ways to specify which module you want information for.
63
They all return Module::Info objects.
64
65
=over 4
66
67
=item new_from_file
68
69
my $module = Module::Info->new_from_file('path/to/Some/Module.pm');
70
71
Given a file, it will interpret this as the module you want
72
information about. You can also hand it a perl script.
73
74
If the file doesn't exist or isn't readable it will return false.
75
76
=cut
77
78
sub new_from_file {
79
my($proto, $file) = @_;
80
my($class) = ref $proto || $proto;
81
82
return unless -r $file;
83
84
my $self = {};
85
$self->{file} = File::Spec->rel2abs($file);
86
$self->{dir} = '';
87
$self->{name} = '';
88
89
return bless $self, $class;
90
}
91
92
=item new_from_module
93
94
my $module = Module::Info->new_from_module('Some::Module');
95
my $module = Module::Info->new_from_module('Some::Module', @INC);
96
97
Given a module name, @INC will be searched and the first module found
98
used. This is the same module that would be loaded if you just say
99
C<use Some::Module>.
100
101
If you give your own @INC, that will be used to search instead.
102
103
=cut
104
105
sub new_from_module {
106
my($class, $module, @inc) = @_;
107
return ($class->_find_all_installed($module, 1, @inc))[0];
108
}
109
110
=item new_from_loaded
111
112
my $module = Module::Info->new_from_loaded('Some::Module');
113
114
Gets information about the currently loaded version of Some::Module.
115
If it isn't loaded, returns false.
116
117
=cut
118
119
sub new_from_loaded {
120
my($class, $name) = @_;
121
122
my $mod_file = join('/', split('::', $name)) . '.pm';
123
my $filepath = $INC{$mod_file} || '';
124
125
my $module = Module::Info->new_from_file($filepath);
126
$module->{name} = $name;
127
($module->{dir} = $filepath) =~ s|/?\Q$mod_file\E$||;
128
$module->{dir} = File::Spec->rel2abs($module->{dir});
129
130
return $module;
131
}
132
133
=item all_installed
134
135
my @modules = Module::Info->all_installed('Some::Module');
136
my @modules = Module::Info->all_installed('Some::Module', @INC);
137
138
Like new_from_module(), except I<all> modules in @INC will be
139
returned, in the order they are found. Thus $modules[0] is the one
140
that would be loaded by C<use Some::Module>.
141
142
=cut
143
144
sub all_installed {
145
my($class, $module, @inc) = @_;
146
return $class->_find_all_installed($module, 0, @inc);
147
}
148
149
# Thieved from Module::InstalledVersion
150
sub _find_all_installed {
151
my($proto, $name, $find_first_one, @inc) = @_;
152
my($class) = ref $proto || $proto;
153
154
@inc = @INC unless @inc;
155
my $file = File::Spec->catfile(split /::/, $name) . '.pm';
156
157
my @modules = ();
158
DIR: foreach my $dir (@inc) {
159
# Skip the new code ref in @INC feature.
160
next if ref $dir;
161
162
my $filename = File::Spec->catfile($dir, $file);
163
if( -r $filename ) {
164
my $module = $class->new_from_file($filename);
165
$module->{dir} = File::Spec->rel2abs($dir);
166
$module->{name} = $name;
167
push @modules, $module;
168
last DIR if $find_first_one;
169
}
170
}
171
172
return @modules;
173
}
174
175
176
=back
177
178
=head2 Information without loading
179
180
The following methods get their information without actually compiling
181
the module.
182
183
=over 4
184
185
=item B<name>
186
187
my $name = $module->name;
188
$module->name($name);
189
190
Name of the module (ie. Some::Module).
191
192
Module loaded using new_from_file() won't have this information in
193
which case you can set it yourself.
194
195
=cut
196
197
sub name {
198
my($self) = shift;
199
200
$self->{name} = shift if @_;
201
return $self->{name};
202
}
203
204
=item B<version>
205
206
my $version = $module->version;
207
208
Divines the value of $VERSION. This uses the same method as
209
ExtUtils::MakeMaker and all caveats therein apply.
210
211
=cut
212
213
# Thieved from ExtUtils::MM_Unix 1.12603
214
sub version {
215
my($self) = shift;
216
217
my $parsefile = $self->file;
218
219
open(MOD, $parsefile) or die $!;
220
221
my $inpod = 0;
222
my $result;
223
while (<MOD>) {
224
$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
225
next if $inpod || /^\s*#/;
226
227
chomp;
228
next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/;
229
my $eval = qq{
230
package Module::Info::_version;
231
no strict;
232
233
local $1$2;
234
\$$2=undef; do {
235
$_
236
}; \$$2
237
};
238
local $^W = 0;
239
$result = eval($eval);
240
warn "Could not eval '$eval' in $parsefile: $@" if $@;
241
$result = "undef" unless defined $result;
242
last;
243
}
244
close MOD;
245
return $result;
246
}
247
248
249
=item B<inc_dir>
250
251
my $dir = $module->inc_dir;
252
253
Include directory in which this module was found. Module::Info
254
objects created with new_from_file() won't have this info.
255
256
=cut
257
258
sub inc_dir {
259
my($self) = shift;
260
261
return $self->{dir};
262
}
263
264
=item B<file>
265
266
my $file = $module->file;
267
268
The absolute path to this module.
269
270
=cut
271
272
sub file {
273
my($self) = shift;
274
275
return $self->{file};
276
}
277
278
=item B<is_core>
279
280
my $is_core = $module->is_core;
281
282
Checks if this module is the one distributed with Perl.
283
284
B<NOTE> This goes by what directory it's in. It's possible that the
285
module has been altered or upgraded from CPAN since the original Perl
286
installation.
287
288
=cut
289
290
sub is_core {
291
my($self) = shift;
292
293
return scalar grep $self->{dir} eq File::Spec->canonpath($_),
294
($Config{installarchlib},
295
$Config{installprivlib});
296
}
297
298
=back
299
300
=head2 Information that requires loading.
301
302
B<WARNING!> From here down reliability drops rapidly!
303
304
The following methods get their information by compiling the module
305
and examining the opcode tree. The module will be compiled in a
306
seperate process so as not to disturb the current program.
307
308
They will only work on 5.6.1 and up and requires the B::Utils module.
309
310
=over 4
311
312
=item B<packages_inside>
313
314
my @packages = $module->packages_inside;
315
316
Looks for any explicit C<package> declarations inside the module and
317
returns a list. Useful for finding hidden classes and functionality
318
(like Tie::StdHandle inside Tie::Handle).
319
320
B<KNOWN BUG> Currently doesn't spot package changes inside subroutines.
321
322
=cut
323
324
sub packages_inside {
325
my $self = shift;
326
327
my %packs = map {$_, 1} $self->_call_B('packages');
328
return keys %packs;
329
}
330
331
=item B<package_versions>
332
333
my %versions = $module->package_versions;
334
335
Returns a hash whose keys are the packages contained in the module
336
(these are the same as what's returned by C<packages_inside()>), and
337
whose values are the versions of those packages.
338
339
=cut
340
341
sub package_versions {
342
my $self = shift;
343
344
my @packs = $self->packages_inside;
345
346
# To survive the print(), we translate undef into '~' and then back again.
347
(my $quoted_file = $self->file) =~ s/(['\\])/\\$1/g;
348
my $command = qq{-le "require '$quoted_file';};
349
foreach (@packs) {
350
$command .= " print defined $_->VERSION ? $_->VERSION : '~';"
351
}
352
$command .= qq{"};
353
354
my ($status, @versions) = $self->_call_perl($command);
355
chomp @versions;
356
foreach (@versions) {
357
$_ = undef if $_ eq '~';
358
}
359
360
my %map;
361
@map{@packs} = @versions;
362
363
return %map;
364
}
365
366
367
=item B<modules_used>
368
369
my @used = $module->modules_used;
370
371
Returns a list of all modules and files which may be C<use>'d or
372
C<require>'d by this module.
373
374
B<NOTE> These modules may be conditionally loaded, can't tell. Also
375
can't find modules which might be used inside an C<eval>.
376
377
=cut
378
379
sub modules_used {
380
my($self) = shift;
381
my %used = $self->modules_required;
382
383
return keys %used;
384
}
385
386
=item B<modules_required>
387
388
my %required = $module->modules_required;
389
390
Returns a list of all modules and files which may be C<use>'d or
391
C<require>'d by this module, together with the minimum required version.
392
393
The hash is keyed on the module/file name, the corrisponding value is
394
an array reference containing the requied versions, or an empty array
395
if no specific version was required.
396
397
B<NOTE> These modules may be conditionally loaded, can't tell. Also
398
can't find modules which might be used inside an C<eval>.
399
400
=cut
401
402
sub modules_required {
403
my($self) = shift;
404
405
my $mod_file = $self->file;
406
my @mods = $self->_call_B('modules_used');
407
408
my @used_mods = ();
409
my %used_mods = ();
410
for (grep /^use \D/ && /at "\Q$mod_file\E" /, @mods) {
411
my($file, $version) = /^use (\S+) \(([^\)]*)\)/;
412
$used_mods{_file2mod($file)} ||= [];
413
next unless defined $version and length $version;
414
415
push @{$used_mods{_file2mod($file)}}, $version;
416
}
417
418
push @used_mods, map { my($file) = /^require bare (\S+)/; _file2mod($file) }
419
grep /^require bare \D/ , @mods;
420
421
push @used_mods, map { /^require not bare (\S+)/; $1 }
422
grep /^require not bare \D/, @mods;
423
424
$used_mods{$_} = [] for @used_mods;
425
return %used_mods;
426
}
427
428
sub _file2mod {
429
my($mod) = shift;
430
$mod =~ s/\.pm//;
431
$mod =~ s|/|::|g;
432
return $mod;
433
}
434
435
436
=item B<subroutines>
437
438
my %subs = $module->subroutines;
439
440
Returns a hash of all subroutines defined inside this module and some
441
info about it. The key is the *full* name of the subroutine
442
(ie. $subs{'Some::Module::foo'} rather than just $subs{'foo'}), value
443
is a hash ref with information about the subroutine like so:
444
445
start => line number of the first statement in the subroutine
446
end => line number of the last statement in the subroutine
447
448
Note that the line numbers may not be entirely accurate and will
449
change as perl's backend compiler improves. They typically correspond
450
to the first and last I<run-time> statements in a subroutine. For
451
example:
452
453
sub foo {
454
package Wibble;
455
$foo = "bar";
456
return $foo;
457
}
458
459
Taking C<sub foo {> as line 1, Module::Info will report line 3 as the
460
start and line 4 as the end. C<package Wibble;> is a compile-time
461
statement. Again, this will change as perl changes.
462
463
Note this only catches simple C<sub foo {...}> subroutine
464
declarations. Anonymous, autoloaded or eval'd subroutines are not
465
listed.
466
467
=cut
468
469
sub subroutines {
470
my($self) = shift;
471
472
my $mod_file = $self->file;
473
my @subs = $self->_call_B('subroutines');
474
return map { /^(\S+) at "[^"]+" from (\d+) to (\d+)/;
475
($1 => { start => $2, end => $3 }) }
476
grep /at "\Q$mod_file\E" /, @subs;
477
}
478
479
sub _is_win95() {
480
return $^O eq 'MSWin32' && Win32::GetOSVersion() == 1;
481
}
482
483
sub _is_macos_classic() {
484
return $^O eq 'MacOS';
485
}
486
487
sub _get_extra_arguments { '' }
488
489
sub _call_perl {
490
my($self, $args) = @_;
491
492
my $perl = _is_macos_classic ? 'perl' : $^X;
493
my $command = "$perl $args";
494
my @out;
495
496
if( _is_win95 ) {
497
require IPC::Open3;
498
local *OUTFH;
499
my($line, $in);
500
my $out = \*OUTFH;
501
my $pid = IPC::Open3::open3($in, $out, $out, $command);
502
close $in;
503
while( defined($line = <OUTFH>) ) {
504
$line =~ s/\r\n$/\n/; # strip CRs
505
push @out, $line;
506
}
507
508
waitpid $pid, 0;
509
}
510
elsif( _is_macos_classic ) {
511
@out = `$command \xb7 Dev:Stdout`;
512
}
513
else {
514
@out = `$command 2>&1`;
515
}
516
517
@out = grep !/^Using.*blib$/, @out;
518
return ($?, @out);
519
}
520
521
sub _call_B {
522
my($self, $arg) = @_;
523
524
my $mod_file = $self->file;
525
my $extra_args = $self->_get_extra_arguments;
526
my $command = qq{$extra_args "-MO=Module::Info,$arg" "$mod_file"};
527
my($status, @out) = $self->_call_perl($command);
528
529
if( $status ) {
530
my $exit = $status >> 8;
531
my $msg = join "\n",
532
"B::Module::Info,$arg use failed with $exit saying:",
533
@out;
534
535
if( $self->{die_on_compilation_error} ) {
536
die $msg;
537
}
538
else {
539
warn $msg;
540
return;
541
}
542
}
543
544
@out = grep !/syntax OK$/, @out;
545
chomp @out;
546
return @out;
547
}
548
549
550
=item B<superclasses>
551
552
my @isa = $module->superclasses;
553
554
Returns the value of @ISA for this $module. Requires that
555
$module->name be set to work.
556
557
B<NOTE> superclasses() is currently cheating. See L<CAVEATS> below.
558
559
=cut
560
561
sub superclasses {
562
my $self = shift;
563
564
my $mod_file = $self->file;
565
my $mod_name = $self->name;
566
unless( $mod_name ) {
567
carp 'isa() requires $module->name to be set';
568
return;
569
}
570
571
my $extra_args = $self->_get_extra_arguments;
572
my $command =
573
qq{-e "require q{$mod_file}; print join qq{\\n}, \@$mod_name\::ISA"};
574
my($status, @isa) = $self->_call_perl("$extra_args $command");
575
chomp @isa;
576
return @isa;
577
}
578
579
=item B<subroutines_called>
580
581
my @calls = $module->subroutines_called;
582
583
Finds all the methods and functions which are called inside the
584
$module.
585
586
Returns a list of hashes. Each hash represents a single function or
587
method call and has the keys:
588
589
line line number where this call originated
590
class class called on if its a class method
591
type function, symbolic function, object method,
592
class method, dynamic object method or
593
dynamic class method.
594
(NOTE This format will probably change)
595
name name of the function/method called if not dynamic
596
597
598
=cut
599
600
sub subroutines_called {
601
my($self) = shift;
602
603
my @subs = $self->_call_B('subs_called');
604
my $mod_file = $self->file;
605
606
@subs = grep /at "\Q$mod_file\E" line/, @subs;
607
my @out = ();
608
foreach (@subs) {
609
my %info = ();
610
($info{type}) = /^(.+) call/;
611
$info{type} = 'symbolic function' if /using symbolic ref/;
612
($info{'name'}) = /to (\S+)/;
613
($info{class})= /via (\S+)/;
614
($info{line}) = /line (\d+)/;
615
push @out, \%info;
616
}
617
return @out;
618
}
619
620
=back
621
622
=head2 Information about Unpredictable Constructs
623
624
Unpredictable constructs are things that make a Perl program hard to
625
predict what its going to do without actually running it. There's
626
nothing wrong with these constructs, but its nice to know where they
627
are when maintaining a piece of code.
628
629
=over 4
630
631
=item B<dynamic_method_calls>
632
633
my @methods = $module->dynamic_method_calls;
634
635
Returns a list of dynamic method calls (ie. C<$obj->$method()>) used
636
by the $module. @methods has the same format as the return value of
637
subroutines_called().
638
639
=cut
640
641
sub dynamic_method_calls {
642
my($self) = shift;
643
return grep $_->{type} =~ /dynamic/, $self->subroutines_called;
644
}
645
646
=back
647
648
=head2 Options
649
650
The following methods get/set specific option values for the
651
Module::Info object.
652
653
=over 4
654
655
=item B<die_on_compilation_error>
656
657
$module->die_on_compilation_error(0); # default
658
$module->die_on_compilation_error(1);
659
my $flag = $module->die_on_compilation_error;
660
661
Sets/gets the "die on compilation error" flag. Whne the flag is off
662
(default), and a module fails to compile, Module::Info simply emits a
663
watning and continues. When the flag is on and a module fails to
664
compile, Module::Info die()s with the same error message it would use
665
in the warning.
666
667
=cut
668
669
sub die_on_compilation_error {
670
my($self) = shift;
671
672
$self->{die_on_compilation_error} = $_[0] ? 1 : 0 if @_;
673
return $self->{die_on_compilation_error};
674
}
675
676
=back
677
678
=head1 AUTHOR
679
680
Michael G Schwern <schwern@pobox.com> with code from ExtUtils::MM_Unix,
681
Module::InstalledVersion and lots of cargo-culting from B::Deparse.
682
683
Mattia Barbon <MBARBON@cpan.org> is the current maintainer.
684
685
=head1 LICENSE
686
687
This program is free software; you can redistribute it and/or
688
modify it under the same terms as Perl itself.
689
690
=head1 THANKS
691
692
Many thanks to Simon Cozens and Robin Houston for letting me chew
693
their ears about B.
694
695
=head1 CAVEATS
696
697
Code refs in @INC are currently ignored. If this bothers you submit a
698
patch.
699
700
superclasses() is cheating and just loading the module in a seperate
701
process and looking at @ISA. I don't think its worth the trouble to
702
go through and parse the opcode tree as it still requires loading the
703
module and running all the BEGIN blocks. Patches welcome.
704
705
I originally was going to call superclasses() isa() but then I
706
remembered that would be bad.
707
708
All the methods that require loading are really inefficient as they're
709
not caching anything. I'll worry about efficiency later.
710
711
=cut
712
713
return 'Stepping on toes is what Schwerns do best! *poing poing poing*';
Loggerhead is a web-based interface for Breezy
Version: 2.0.1