source: branches/2.2.10/mindi/mindi-get-perl-modules @ 2850

Last change on this file since 2850 was 2850, checked in by Bruno Cornec, 9 years ago

svn merge -r 2773:2849 2.2.9 in 2.2.10

  • Adds 3 binaries called potentially by udev o support USB key mount at restore time (Victor Gattegno)
  • Really support both mkisofs and genisoimage everywhere
  • Try to handle netfs_user better in all cases (NFS and SSHFS)
    • Improve logging in init script
    • Format improvement
    • Removes a warning when trying to launch udevadm and it doesn't exist (RHEL 5 e.g.)
    • Fix syntax description in mondoarchive man page for -E & -I with |
  • Adds download entries for new distro supported (Mageia, Fedora 15, Ubuntu 11.04)

-Fix mindi-get-perl-modules when perl dirs in @INC are symlinks (case on Ubuntu 11.04)

  • Fix option --findkernel in case of Xen kernel so that mondoarchive get a correct answer instead of an empty one.
  • Fix multi-media restore by umounting it before looping to ask for the next (as if already mounted, will not pass to the next alone)
  • Fix 485 by replacing a wrong call to mr_asprintf which was provoking core dumped.
  • Fix -E and -I example in man page which were lacking the '|' as separator
  • Fix #484 by adding support for the arcmsr driver (to support the Areca ARC-1220 RAID Controller)
    • Avoids error msgs if no mondo-restore.cfg file exists (when mindi used stdalone)
    • Adds the swapon feature to mindi-busybox
    • Attempt to fix Xen kernel support by avoiding to remove xen kernel fro; the possible_kernels list too early, whereas it's used afterwards to get them.
    • Fix #481 by supporting the new kbd file in latest Ubuntu 10.10+ (victor.gattegno_at_hp.com)
  • Update from Lester Wade on P2V doc including RHEL6 validation and some minor additions
  • removes telinit call in busybox o try to fix problems whn reboot at end of restore.
  • if -E option for mondoarchive was not specified, variable excp points to NULL, so string exclude_pathes contained '(null)' instead of being avoided (derived from a patch from taguchi_at_ff.iij4u.or.jp)
  • fix -maxdepth option for find command. it sould be '-maxdepth .. -name ..', not '-name .. -maxdepth ..' (patch from taguchi_at_ff.iij4u.or.jp)
  • Adds an extraversion for revision support
  • Adds support for ifconfig and ping for PXE+NFS boot for this version of mindi-busybox
  • Example of MINDI_ADDITIONAL_BOOT_PARAMS in mindi.conf added
  • fix a compilation error
  • Remove an absolute ref in the docs web page
  • Property svn:executable set to *
File size: 7.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;
8use Cwd;
9
10my $file = get_perl_modules(@ARGV) if (defined $ARGV[0]);
11
12foreach my $f (sort keys %$file) {
13    print "$f\n";
14}
15
16sub get_perl_modules {
17
18my %files;
19
20#print "Searching in ";
21#print join "\n", @INC;
22
23my $require = process_file(@_);
24
25my @includes;
26
27# Remove non exiting directories from @INC
28# and thus avoid perl warnings
29#
30foreach my $d (@INC) {
31    $d = read_all_link($d) if (-l $d);
32    push @includes,$d if (-d $d);
33}
34
35find(
36    sub {
37        if ((-f $File::Find::name) 
38            && (/\.pm$/) 
39            && (not defined $files{$File::Find::name})) {
40            foreach my $m (keys %$require,"warnings") {
41                (my $mod = $m) =~ s|::|/|g;
42                #print "Looking at $mod in $File::Find::name\n";
43                if (index($File::Find::name,"$mod.pm") ne -1) {
44                    $files{$File::Find::name} = $mod;
45                    #push @files, $File::Find::name;
46                    #print "Found $mod in $File::Find::name\n";
47                    last;
48                }
49            }
50        }
51    },
52    @includes);
53
54return(\%files);
55}
56
57# Cf: http://www.stonehenge.com/merlyn/UnixReview/col27.html
58sub read_all_link {
59
60my $dir = cwd;
61my $link;
62
63find sub {
64    return unless -l;
65    my @right = split /\//, $File::Find::name;
66    my @left = do {
67        @right && ($right[0] eq "") ?
68        shift @right :            # quick way
69        split /\//, $dir;
70    };    # first element always null
71    while (@right) {
72        my $item = shift @right;
73        next if $item eq "." or $item eq "";
74        if ($item eq "..") {
75            pop @left if @left > 1;
76            next;
77        }
78        my $link = readlink (join "/", @left, $item);
79        if (defined $link) {
80            my @parts = split /\//, $link;
81            if (@parts && ($parts[0] eq "")) { # absolute
82                @left = shift @parts;   # quick way
83            }
84        unshift @right, @parts;
85        next;
86        } else {
87            push @left, $item;
88            next;
89        }
90    }
91    #print "$File::Find::name is ", join("/", @left), "\n";
92    $link = join("/", @left);
93}, @_;
94return($link);
95}
96
97# Adapted From /usr/lib/rpm/mandriva/perl.req
98# by Ken Estes Mail.com kestes@staff.mail.com
99
100sub process_file {
101 
102    my %line;
103    my %require;
104    my $current_line;
105    my $tag;
106
107    foreach my $file (@_) {
108 
109  open(FILE, "<$file") || return(\%require);
110 
111  while (<FILE>) {
112   
113    # skip the "= <<" block
114
115    if ( ( m/^\s*\$(.*)\s*=\s*<<\s*["'](.*)['"]/i) ||
116         ( m/^\s*\$(.*)\s*=\s*<<\s*(.*);/i) ) {
117      $tag = $2;
118      while (<FILE>) {
119        ( $_ =~ /^$tag/) && last;
120      }
121    }
122
123    # skip the documentation
124
125    # we should not need to have item in this if statement (it
126    # properly belongs in the over/back section) but people do not
127    # read the perldoc.
128
129    if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) {
130      next;
131    }
132
133    if ( (m/^=(over)/) .. (m/^=(back)/) ) {
134      next;
135    }
136   
137    # skip the data section
138    if (m/^__(DATA|END)__$/) {
139      last;
140    }
141
142    # Each keyword can appear multiple times.  Don't
143    #  bother with datastructures to store these strings,
144    #  if we need to print it print it now.
145   
146    if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
147      foreach $_ (split(/\s+/, $1)) {
148    print "$_\n";
149      }
150    }
151
152    if ( 
153
154# ouch could be in a eval, perhaps we do not want these since we catch
155# an exception they must not be required
156
157#   eval { require Term::ReadLine } or die $@;
158#   eval "require Term::Rendezvous;" or die $@;
159#   eval { require Carp } if defined $^S; # If error/warning during compilation,
160
161
162    (m/^(\s*)         # we hope the inclusion starts the line
163     (require|use)\s+(?!\{)     # do not want 'do {' loops
164     # quotes around name are always legal
165     [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ]
166     # the syntax for 'use' allows version requirements
167     \s*([.0-9]*)
168     /x)
169       ) {
170      my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4);
171      my $usebase;
172
173      # we only consider require statements that are flush against
174      # the left edge. any other require statements give too many
175      # false positives, as they are usually inside of an if statement
176      # as a fallback module or a rarely used option
177
178      ($whitespace ne "" && $statement eq "require") && next;
179
180      # if there is some interpolation of variables just skip this
181      # dependency, we do not want
182      #        do "$ENV{LOGDIR}/$rcfile";
183
184      ($module =~ m/\$/) && next;
185
186      # skip if the phrase was "use of" -- shows up in gimp-perl, et al
187      next if $module eq 'of';
188
189      # if the module ends in a comma we probaly caught some
190      # documentation of the form 'check stuff,\n do stuff, clean
191      # stuff.' there are several of these in the perl distribution
192
193      ($module  =~ m/[,>]$/) && next;
194
195      # if the module name starts in a dot it is not a module name.
196      # Is this necessary?  Please give me an example if you turn this
197      # back on.
198
199      #      ($module =~ m/^\./) && next;
200
201      # if the module ends with .pm strip it to leave only basename.
202      # starts with /, which means its an absolute path to a file
203      if ($module =~ m(^/)) {
204        print "$module\n";
205        next;
206      }
207
208      # as seen in some perl scripts
209      # use base qw(App::CLI Class::Accessor::Chained::Fast App::CLI::Command);
210      if ($module eq 'base') {
211      $require{$module} = $version;
212      $line{$module} = $current_line;
213      ($module = $_) =~ s/use\s*base\s*//;
214      $module =~ s/qw\((.*)\)\s*;/$1/;
215      $module =~ s/qw(.)(.*)\1\s*;/$2/;
216      $module =~ s/\s*;$//;
217      $module =~ s/#.*//;
218      $usebase = 1;
219      }
220      # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc
221      # we can strip qw.*$, as well as (.*$:
222      $module =~ s/qw.*$//;
223      $module =~ s/\(.*$//;
224
225      $module =~ s/\.pm$//;
226
227      # some perl programmers write 'require URI/URL;' when
228      # they mean 'require URI::URL;'
229
230      $module =~ s/\//::/;
231
232      # trim off trailing parenthesis if any.  Sometimes people pass
233      # the module an empty list.
234
235      $module =~ s/\(\s*\)$//;
236
237      # if module is a number then both require and use interpret that
238      # to mean that a particular version of perl is specified. Don't
239      # add a dependency, though, since the rpm will already require
240      # perl-base at the build version (via find-requires)
241      next if $module =~ /^v?\d/;
242
243      # ph files do not use the package name inside the file.
244      # perlmodlib  documentation says:
245      #       the .ph files made by h2ph will probably end up as
246      #       extension modules made by h2xs.
247      # so do not spend much effort on these.
248
249      # there is no easy way to find out if a file named systeminfo.ph
250      # will be included with the name sys/systeminfo.ph so only use the
251      # basename of *.ph files
252
253      ($module  =~ m/\.ph$/) && next;
254
255      # if the module was loaded trough base, we need to split the list
256      if ($usebase) {
257          my $current_line = $_;
258          foreach (split(/\s+/, $module)) {
259              next unless $_;
260              $require{$_} = $version;
261              $line{$_} = $current_line;
262          }
263      } else {
264      $require{$module}=$version;
265      $line{$module}=$current_line;
266      }
267    }
268  }
269
270  close(FILE) ||
271    die("$0: Could not close file: '$file' : $!\n");
272    }
273
274  return(\%require);
275}
Note: See TracBrowser for help on using the repository browser.