Changeset 3147 in MondoRescue for branches/3.1/mindi/mindi-get-perl-modules
- Timestamp:
- Jun 19, 2013, 8:34:46 AM (11 years ago)
- File:
-
- 1 edited
-
branches/3.1/mindi/mindi-get-perl-modules (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/3.1/mindi/mindi-get-perl-modules
r2850 r3147 1 1 #!/usr/bin/perl -w 2 # 3 # $Id$ 4 # Copyright B. Cornec 2005-2013 5 # Provided under the GPL v2 2 6 # 3 7 # Get perl modules required by mindi and mondo and that should be on the restore media … … 7 11 use File::Find; 8 12 use Cwd; 13 14 15 =pod 16 17 =head1 NAME 18 19 mindi-get-perl-modules keeps track of the perl modules that should be on your restore media 20 21 =head1 DESCRIPTION 22 23 mindi-get-perl-modules keeps track of the perl modules that should be on your restore media by analyzing the references made to them in the scripts passed as parameters and returning all the modules needed to have them work correctly. 24 25 =head1 SYNOPSIS 26 27 mindi-get-perl-modules /path/to/perl-script ... 28 29 =head1 ARGUMENTS 30 31 =over 4 32 33 =item B</path/to/perl-script> 34 35 This is the path of the perl script to analyze and for which we want its perl modules in dependence to be included 36 37 =back 38 39 =head1 WEB SITES 40 41 The main Web site of the project is available at L<http://www.mondorescue.org>. Bug reports should be filled using the trac instance of the project at L<http://trac.mondorescue.org/>. 42 43 =head1 USER MAILING LIST 44 45 For community exchanges around MondoRescue please use the list L<http://sourceforge.net/mailarchive/forum.php?forum_name=mondo-devel> 46 47 =head1 AUTHORS 48 49 The MondoRescue team lead by Bruno Cornec L<mailto:bruno@mondorescue.org>. 50 51 =head1 COPYRIGHT 52 53 MondoRescue is distributed under the GPL v2.0 license or later, 54 described in the file C<COPYING> included with the distribution. 55 56 =cut 57 9 58 10 59 my $file = get_perl_modules(@ARGV) if (defined $ARGV[0]); … … 100 149 sub process_file { 101 150 102 103 104 105 106 107 151 my %line; 152 my %require; 153 my $current_line; 154 my $tag; 155 156 foreach my $file (@_) { 108 157 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 ( 158 open(FILE, "<$file") || return(\%require); 159 while (<FILE>) { 160 161 # skip the "= <<" block 162 163 if ( ( m/^\s*\$(.*)\s*=\s*<<\s*["'](.*)['"]/i) || 164 ( m/^\s*\$(.*)\s*=\s*<<\s*(.*);/i) ) { 165 $tag = $2; 166 while (<FILE>) { 167 ( $_ =~ /^$tag/) && last; 168 } 169 } 170 171 # skip the documentation 172 173 # we should not need to have item in this if statement (it 174 # properly belongs in the over/back section) but people do not 175 # read the perldoc. 176 177 if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) { 178 next; 179 } 180 181 if ( (m/^=(over)/) .. (m/^=(back)/) ) { 182 next; 183 } 184 185 # skip the data section 186 if (m/^__(DATA|END)__$/) { 187 last; 188 } 189 190 # Each keyword can appear multiple times. Don't 191 # bother with datastructures to store these strings, 192 # if we need to print it print it now. 193 194 if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) { 195 foreach $_ (split(/\s+/, $1)) { 196 print "$_\n"; 197 } 198 } 199 200 if ( 153 201 154 202 # ouch could be in a eval, perhaps we do not want these since we catch … … 160 208 161 209 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"); 210 (m/^(\s*) # we hope the inclusion starts the line 211 (require|use)\s+(?!\{) # do not want 'do bracket' loops 212 # quotes around name are always legal 213 [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ] 214 # the syntax for 'use' allows version requirements 215 \s*([.0-9]*) 216 /x) 217 ) { 218 my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4); 219 my $usebase; 220 221 # we only consider require statements that are flush against 222 # the left edge. any other require statements give too many 223 # false positives, as they are usually inside of an if statement 224 # as a fallback module or a rarely used option 225 226 ($whitespace ne "" && $statement eq "require") && next; 227 228 # if there is some interpolation of variables just skip this 229 # dependency, we do not want 230 # do "$ENV{LOGDIR}/$rcfile"; 231 232 ($module =~ m/\$/) && next; 233 234 # skip if the phrase was "use of" -- shows up in gimp-perl, et al 235 next if $module eq 'of'; 236 237 # if the module ends in a comma we probaly caught some 238 # documentation of the form 'check stuff,\n do stuff, clean 239 # stuff.' there are several of these in the perl distribution 240 241 ($module =~ m/[,>]$/) && next; 242 243 # if the module name starts in a dot it is not a module name. 244 # Is this necessary? Please give me an example if you turn this 245 # back on. 246 247 # ($module =~ m/^\./) && next; 248 249 # if the module ends with .pm strip it to leave only basename. 250 # starts with /, which means its an absolute path to a file 251 if ($module =~ m(^/)) { 252 print "$module\n"; 253 next; 254 } 255 256 # as seen in some perl scripts 257 # use base qw(App::CLI Class::Accessor::Chained::Fast App::CLI::Command); 258 if ($module eq 'base') { 259 $require{$module} = $version; 260 $line{$module} = $current_line; 261 ($module = $_) =~ s/use\s*base\s*//; 262 $module =~ s/qw\((.*)\)\s*;/$1/; 263 $module =~ s/qw(.)(.*)\1\s*;/$2/; 264 $module =~ s/\s*;$//; 265 $module =~ s/#.*//; 266 $usebase = 1; 267 } 268 # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc 269 # we can strip qw.*$, as well as (.*$: 270 $module =~ s/qw.*$//; 271 $module =~ s/\(.*$//; 272 273 $module =~ s/\.pm$//; 274 275 # some perl programmers write 'require URI/URL;' when 276 # they mean 'require URI::URL;' 277 278 $module =~ s/\//::/; 279 280 # trim off trailing parenthesis if any. Sometimes people pass 281 # the module an empty list. 282 283 $module =~ s/\(\s*\)$//; 284 285 # if module is a number then both require and use interpret that 286 # to mean that a particular version of perl is specified. Don't 287 # add a dependency, though, since the rpm will already require 288 # perl-base at the build version (via find-requires) 289 next if $module =~ /^v?\d/; 290 291 # ph files do not use the package name inside the file. 292 # perlmodlib documentation says: 293 # the .ph files made by h2ph will probably end up as 294 # extension modules made by h2xs. 295 # so do not spend much effort on these. 296 297 # there is no easy way to find out if a file named systeminfo.ph 298 # will be included with the name sys/systeminfo.ph so only use the 299 # basename of *.ph files 300 301 ($module =~ m/\.ph$/) && next; 302 303 # if the module was loaded trough base, we need to split the list 304 if ($usebase) { 305 my $current_line = $_; 306 foreach (split(/\s+/, $module)) { 307 next unless $_; 308 $require{$_} = $version; 309 $line{$_} = $current_line; 310 } 311 } else { 312 $require{$module}=$version; 313 $line{$module}=$current_line; 314 } 315 } 272 316 } 273 317 274 return(\%require); 275 } 318 close(FILE) || die("$0: Could not close file: '$file' : $!\n"); 319 } 320 321 return(\%require); 322 }
Note:
See TracChangeset
for help on using the changeset viewer.
