← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/libmodule-info-perl/gutsy

« back to all changes in this revision

Viewing changes to bin/module_info

  • 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

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/module_info
 
1
#!/usr/bin/perl -w
 
2
 
 
3
=head1 NAME
 
4
 
 
5
module_info - find informations about modules
 
6
 
 
7
=head1 SYNOPSIS
 
8
 
 
9
  module_info [B<-a>] [B<-s>] [B<-p>] [B<-m>] MODULE|FILE...
 
10
 
 
11
=head1 DESCRIPTION
 
12
 
 
13
List information about the arguments (either module names in the form
 
14
C<Module::Name> or paths in the form C<Foo/Bar.pm> or C<foo/bar.pl>).
 
15
 
 
16
By default only shows module name, version, directory, absolute path
 
17
and a flag indicating if it is a core module. Additional informations
 
18
can be requested through command line switches.
 
19
 
 
20
=over 4
 
21
 
 
22
=item B<-s>
 
23
 
 
24
Show subroutines created by the module.
 
25
 
 
26
=item B<-p>
 
27
 
 
28
Show packages created by the module.
 
29
 
 
30
=item B<-m>
 
31
 
 
32
Show modules C<use()>d by the module.
 
33
 
 
34
=item B<-a>
 
35
 
 
36
Equivalent to C<-s -p -m>.
 
37
 
 
38
=head1 AUTHOR
 
39
 
 
40
Mattia Barbon <MBARBON@cpan.org>
 
41
 
 
42
=head1 SEE ALSO
 
43
 
 
44
L<Module::Info>
 
45
 
 
46
=cut
 
47
 
 
48
use strict;
 
49
use Module::Info;
 
50
use Getopt::Long;
 
51
 
 
52
my( $show_subroutines, $show_modules, $show_packages, $show_all );
 
53
 
 
54
GetOptions( 's' => \$show_subroutines,
 
55
            'p' => \$show_packages,
 
56
            'm' => \$show_modules,
 
57
            'a' => \$show_all,
 
58
          );
 
59
 
 
60
$show_subroutines ||= $show_all;
 
61
$show_modules ||= $show_all;
 
62
$show_packages ||= $show_all;
 
63
 
 
64
my $some_error = 0;
 
65
 
 
66
foreach my $module (@ARGV) {
 
67
    my $info;
 
68
 
 
69
    if( -f $module ) {
 
70
        $info = Module::Info->new_from_file($module);
 
71
    }
 
72
    else {
 
73
        $info = Module::Info->new_from_module($module);
 
74
    }
 
75
 
 
76
    unless( $info ) {
 
77
        warn "Can't create Module::Info object for module '$module'";
 
78
        $some_error = 1;
 
79
        next;
 
80
    }
 
81
 
 
82
    $info->die_on_compilation_error(1);
 
83
 
 
84
    my $name = $info->name || $module;
 
85
    my $version = $info->version || '(unknown)';
 
86
    my $dir = $info->inc_dir;
 
87
    my $file = $info->file;
 
88
    my $is_core = $info->is_core ? "yes" : "no";
 
89
 
 
90
    print <<EOT;
 
91
 
 
92
Name:        $name
 
93
Version:     $version
 
94
Directory:   $dir
 
95
File:        $file
 
96
Core module: $is_core
 
97
EOT
 
98
 
 
99
    my %packages_created;
 
100
    my @modules_used;
 
101
    my %subroutines;
 
102
 
 
103
    eval {
 
104
        @modules_used = $info->modules_used if $show_modules;
 
105
        %packages_created = $info->package_versions if $show_packages;
 
106
        %subroutines = $info->subroutines if $show_subroutines;
 
107
    };
 
108
    if( $@ ) {
 
109
        warn "Compilation failed for module '$module'";
 
110
        $some_error = 1;
 
111
        next;
 
112
    }
 
113
 
 
114
    ###########################################################################
 
115
    # Modules used
 
116
    ###########################################################################
 
117
    if( $show_modules ) {
 
118
        print "\nModules used:\n";
 
119
        foreach my $m (sort @modules_used) {
 
120
            print "    $m\n";
 
121
        }
 
122
        print "    (none)\n" unless @modules_used;
 
123
    }
 
124
 
 
125
    ###########################################################################
 
126
    # Packages defined
 
127
    ###########################################################################
 
128
    if( $show_packages ) {
 
129
        print "\nPackages created:\n";
 
130
        foreach my $p (sort keys %packages_created) {
 
131
            print "    $p\t";
 
132
            print +( defined( $packages_created{$p} ) ?
 
133
                                $packages_created{$p} :
 
134
                                      '(no version)' );
 
135
            print "\n";
 
136
        }
 
137
        print "    (none)\n" unless keys %packages_created;
 
138
    }
 
139
 
 
140
    ###########################################################################
 
141
    # Subroutines
 
142
    ###########################################################################
 
143
    if( $show_subroutines ) {
 
144
        print "\nSubroutines defined:\n";
 
145
        {
 
146
            my @subroutines =
 
147
              sort  { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) }
 
148
              map   {
 
149
                        my($package, $subname) = ($_ =~ m/^(.*)?::(\w+)$/);
 
150
                        warn "Strange subroutine '$_'"
 
151
                          unless $package || $subname;
 
152
                        $package ||= '(unknown)';
 
153
                        $subname ||= '(unknown)';
 
154
                        [ $package, $subname ];
 
155
                    } keys %subroutines;
 
156
            my $prev_package = ':'; # impossible
 
157
            foreach my $s (@subroutines) {
 
158
                my($package, $subname) = @$s;
 
159
                if($prev_package ne $package) {
 
160
                    $prev_package = $package;
 
161
                    print "    $package\n";
 
162
                }
 
163
 
 
164
                print "        $subname\n";
 
165
            }
 
166
        }
 
167
        print "    (none)\n" unless %subroutines;
 
168
    }
 
169
}
 
170
 
 
171
exit $some_error;