source: branches/2.2.9/mindi/mindi-get-perl-modules @ 2183

Last change on this file since 2183 was 2183, checked in by bruno, 10 years ago

Tries to solve issue on ia64 where perl modules used by mindi were missing by adding a dedicated script handling them based on what is used on mandriva to make rpm deps

  • Property svn:executable set to *
File size: 6.0 KB
Line 
1#!/usr/bin/perl -w
2#
3# Get perl modules required by mindi and mondo and that should be on the restore media
4#
5use strict;
6
7use File::Find;
8
9my $file = get_perl_modules(@ARGV) if (defined $ARGV[0]);
10
11foreach my $f (sort keys %$file) {
12    print "$f\n";
13}
14
15sub get_perl_modules {
16
17my %files;
18
19#print "Searching in ";
20#print join "\n", @INC;
21
22my $require = process_file(@_);
23
24find(
25    sub {
26        if ((-f $File::Find::name) 
27            && (/\.pm$/) 
28            && (not defined $files{$File::Find::name})) {
29            foreach my $m (keys %$require,"warnings") {
30                (my $mod = $m) =~ s|::|/|g;
31                #print "Looking at $mod in $File::Find::name\n";
32                if (index($File::Find::name,"$mod.pm") ne -1) {
33                    $files{$File::Find::name} = $mod;
34                    #push @files, $File::Find::name;
35                    #print "Found $mod in $File::Find::name\n";
36                    last;
37                }
38            }
39        }
40    },
41    @INC);
42
43return(\%files);
44}
45
46# Adapted From /usr/lib/rpm/mandriva/perl.req
47# by Ken Estes Mail.com kestes@staff.mail.com
48
49sub process_file {
50 
51    my %line;
52    my %require;
53    my $current_line;
54    my $tag;
55
56    foreach my $file (@_) {
57 
58  open(FILE, "<$file") || return(\%require);
59 
60  while (<FILE>) {
61   
62    # skip the "= <<" block
63
64    if ( ( m/^\s*\$(.*)\s*=\s*<<\s*["'](.*)['"]/i) ||
65         ( m/^\s*\$(.*)\s*=\s*<<\s*(.*);/i) ) {
66      $tag = $2;
67      while (<FILE>) {
68        ( $_ =~ /^$tag/) && last;
69      }
70    }
71
72    # skip the documentation
73
74    # we should not need to have item in this if statement (it
75    # properly belongs in the over/back section) but people do not
76    # read the perldoc.
77
78    if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) {
79      next;
80    }
81
82    if ( (m/^=(over)/) .. (m/^=(back)/) ) {
83      next;
84    }
85   
86    # skip the data section
87    if (m/^__(DATA|END)__$/) {
88      last;
89    }
90
91    # Each keyword can appear multiple times.  Don't
92    #  bother with datastructures to store these strings,
93    #  if we need to print it print it now.
94   
95    if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
96      foreach $_ (split(/\s+/, $1)) {
97    print "$_\n";
98      }
99    }
100
101    if ( 
102
103# ouch could be in a eval, perhaps we do not want these since we catch
104# an exception they must not be required
105
106#   eval { require Term::ReadLine } or die $@;
107#   eval "require Term::Rendezvous;" or die $@;
108#   eval { require Carp } if defined $^S; # If error/warning during compilation,
109
110
111    (m/^(\s*)         # we hope the inclusion starts the line
112     (require|use)\s+(?!\{)     # do not want 'do {' loops
113     # quotes around name are always legal
114     [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ]
115     # the syntax for 'use' allows version requirements
116     \s*([.0-9]*)
117     /x)
118       ) {
119      my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4);
120      my $usebase;
121
122      # we only consider require statements that are flush against
123      # the left edge. any other require statements give too many
124      # false positives, as they are usually inside of an if statement
125      # as a fallback module or a rarely used option
126
127      ($whitespace ne "" && $statement eq "require") && next;
128
129      # if there is some interpolation of variables just skip this
130      # dependency, we do not want
131      #        do "$ENV{LOGDIR}/$rcfile";
132
133      ($module =~ m/\$/) && next;
134
135      # skip if the phrase was "use of" -- shows up in gimp-perl, et al
136      next if $module eq 'of';
137
138      # if the module ends in a comma we probaly caught some
139      # documentation of the form 'check stuff,\n do stuff, clean
140      # stuff.' there are several of these in the perl distribution
141
142      ($module  =~ m/[,>]$/) && next;
143
144      # if the module name starts in a dot it is not a module name.
145      # Is this necessary?  Please give me an example if you turn this
146      # back on.
147
148      #      ($module =~ m/^\./) && next;
149
150      # if the module ends with .pm strip it to leave only basename.
151      # starts with /, which means its an absolute path to a file
152      if ($module =~ m(^/)) {
153        print "$module\n";
154        next;
155      }
156
157      # as seen in some perl scripts
158      # use base qw(App::CLI Class::Accessor::Chained::Fast App::CLI::Command);
159      if ($module eq 'base') {
160      $require{$module} = $version;
161      $line{$module} = $current_line;
162      ($module = $_) =~ s/use\s*base\s*//;
163      $module =~ s/qw\((.*)\)\s*;/$1/;
164      $module =~ s/qw(.)(.*)\1\s*;/$2/;
165      $module =~ s/\s*;$//;
166      $module =~ s/#.*//;
167      $usebase = 1;
168      }
169      # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc
170      # we can strip qw.*$, as well as (.*$:
171      $module =~ s/qw.*$//;
172      $module =~ s/\(.*$//;
173
174      $module =~ s/\.pm$//;
175
176      # some perl programmers write 'require URI/URL;' when
177      # they mean 'require URI::URL;'
178
179      $module =~ s/\//::/;
180
181      # trim off trailing parenthesis if any.  Sometimes people pass
182      # the module an empty list.
183
184      $module =~ s/\(\s*\)$//;
185
186      # if module is a number then both require and use interpret that
187      # to mean that a particular version of perl is specified. Don't
188      # add a dependency, though, since the rpm will already require
189      # perl-base at the build version (via find-requires)
190      next if $module =~ /^v?\d/;
191
192      # ph files do not use the package name inside the file.
193      # perlmodlib  documentation says:
194      #       the .ph files made by h2ph will probably end up as
195      #       extension modules made by h2xs.
196      # so do not spend much effort on these.
197
198      # there is no easy way to find out if a file named systeminfo.ph
199      # will be included with the name sys/systeminfo.ph so only use the
200      # basename of *.ph files
201
202      ($module  =~ m/\.ph$/) && next;
203
204      # if the module was loaded trough base, we need to split the list
205      if ($usebase) {
206          my $current_line = $_;
207          foreach (split(/\s+/, $module)) {
208              next unless $_;
209              $require{$_} = $version;
210              $line{$_} = $current_line;
211          }
212      } else {
213      $require{$module}=$version;
214      $line{$module}=$current_line;
215      }
216    }
217  }
218
219  close(FILE) ||
220    die("$0: Could not close file: '$file' : $!\n");
221    }
222
223  return(\%require);
224}
Note: See TracBrowser for help on using the repository browser.