scripts/perl.req

   1 #!/usr/bin/perl
   2
   3 # RPM (and it's source code) is covered under two separate licenses.
   4
   5 # The entire code base may be distributed under the terms of the GNU
   6 # General Public License (GPL), which appears immediately below.
   7 # Alternatively, all of the source code in the lib subdirectory of the
   8 # RPM source code distribution as well as any code derived from that
   9 # code may instead be distributed under the GNU Library General Public
  10 # License (LGPL), at the choice of the distributor. The complete text
  11 # of the LGPL appears at the bottom of this file.
  12
  13 # This alternatively is allowed to enable applications to be linked
  14 # against the RPM library (commonly called librpm) without forcing
  15 # such applications to be distributed under the GPL.
  16
  17 # Any questions regarding the licensing of RPM should be addressed to
  18 # Erik Troan <ewt@redhat.com>.
  19
  20 # a simple makedepends like script for perl.
  21
  22 # To save development time I do not parse the perl grammmar but
  23 # instead just lex it looking for what I want.  I take special care to
  24 # ignore comments and pod's.
  25
  26 # It would be much better if perl could tell us the dependencies of a
  27 # given script.
  28
  29 # The filenames to scan are either passed on the command line or if
  30 # that is empty they are passed via stdin.
  31
  32 # If there are strings in the file which match the pattern
  33 #     m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i
  34 # then these are treated as additional names which are required by the
  35 # file and are printed as well.
  36
  37 # I plan to rewrite this in C so that perl is not required by RPM at
  38 # build time.
  39
  40 # by Ken Estes Mail.com kestes@staff.mail.com
  41
  42 if ("@ARGV") {
  43   foreach (@ARGV) {
  44     process_file($_);
  45   }
  46 } else {
  47
  48   # notice we are passed a list of filenames NOT as common in unix the
  49   # contents of the file.
  50
  51   foreach (<>) {
  52     process_file($_);
  53   }
  54 }
  55
  56
  57 foreach $module (sort keys %require) {
  58   if (length($require{$module}) == 0) {
  59     print "perl($module)\n";
  60   } else {
  61
  62     # I am not using rpm3.0 so I do not want spaces arround my
  63     # operators. Also I will need to change the processing of the
  64     # $RPM_* vairable when I upgrage.
  65
  66     print "perl($module) >= $require{$module}\n";
  67   }
  68 }
  69
  70 exit 0;
  71
  72
  73
  74 sub process_file {
  75
  76   my ($file) = @_;
  77   chomp $file;
  78
  79   open(FILE, "<$file") || return;
  80
  81   while (<FILE>) {
  82
  83     # skip the documentation
  84
  85     # we should not need to have item in this if statement (it
  86     # properly belongs in the over/back section) but people do not
  87     # read the perldoc.
  88
  89     if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) {
  90       next;
  91     }
  92
  93     if ( (m/^=(over)/) .. (m/^=(back)/) ) {
  94       next;
  95     }
  96
  97     # skip the data section
  98     if (m/^__(DATA|END)__$/) {
  99       last;
 100     }
 101
 102     # Each keyword can appear multiple times.  Don't
 103     #  bother with datastructures to store these strings,
 104     #  if we need to print it print it now.
 105
 106     if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
 107       foreach $_ (spit(/\s+/, $1)) {
 108         print "$_\n";
 109       }
 110     }
 111
 112     if (
 113
 114 # ouch could be in a eval, perhaps we do not want these since we catch
 115 # an exception they must not be required
 116
 117 #   eval { require Term::ReadLine } or die $@;
 118 #   eval "require Term::Rendezvous;" or die $@;
 119 #   eval { require Carp } if defined $^S; # If error/warning during compilation,
 120
 121
 122         (m/^\s*         # we hope the inclusion starts the line
 123          (do|require|use)\s+(?!\{)     # do not want 'do {' loops
 124          # quotes around name are always legal
 125          [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ]
 126          # the syntax for 'use' allows version requirements
 127          \s*([.0-9]*)
 128          /x)
 129        ) {
 130       my ($module, $version) = ($2,$3);
 131
 132       # if there is some interpolation of variables just skip this
 133       # dependency, we do not want
 134       #        do "$ENV{LOGDIR}/$rcfile";
 135
 136       ($module =~ m/\$/) && next;
 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
 152       $module =~ s/\.pm$//;
 153
 154       # some perl programmers write 'require URI/URL;' when
 155       # they mean 'require URI::URL;'
 156
 157       $module =~ s/\//::/;
 158
 159       # trim off trailing parenthesis if any.  Sometimes people pass
 160       # the module an empty list.
 161
 162       $module =~ s/\(\s*\)$//;
 163
 164       if ( $module =~ m/^[0-9._]+$/ ) {
 165       # if module is a number then both require and use interpret that
 166       # to mean that a particular version of perl is specified
 167
 168         print "perl > $module\n";
 169         next;
 170       };
 171
 172       # ph files do not use the package name inside the file.
 173       # perlmodlib  documentation says:
 174
 175       #       the .ph files made by h2ph will probably end up as
 176       #       extension modules made by h2xs.
 177
 178       # so do not expend much effort on these.
 179
 180
 181       # there is no easy way to find out if a file named systeminfo.ph
 182       # will be included with the name sys/systeminfo.ph so only use the
 183       # basename of *.ph files
 184
 185       ($module  =~ m/\.ph$/) && ($module =~ s!.*/!!g );
 186
 187
 188       $require{$module}=$version;
 189       $line{$module}=$_;
 190     }
 191
 192   }
 193
 194   close(FILE) ||
 195     die("$0: Could not close file: '$file' : $!\n");
 196
 197   return ;
 198 }