aboutsummaryrefslogtreecommitdiffstats
path: root/perl.req
blob: 4e43ef485ac97bf0d18964413d80df2c810cf0a9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
#!/usr/bin/perl

# RPM (and its source code) is covered under two separate licenses.

# The entire code base may be distributed under the terms of the GNU
# General Public License (GPL), which appears immediately below.
# Alternatively, all of the source code in the lib subdirectory of the
# RPM source code distribution as well as any code derived from that
# code may instead be distributed under the GNU Library General Public
# License (LGPL), at the choice of the distributor. The complete text
# of the LGPL appears at the bottom of this file.

# This alternatively is allowed to enable applications to be linked
# against the RPM library (commonly called librpm) without forcing
# such applications to be distributed under the GPL.

# Any questions regarding the licensing of RPM should be addressed to
# Erik Troan <ewt@redhat.com>.

# a simple makedepend like script for perl.
 
# To save development time I do not parse the perl grammar but
# instead just lex it looking for what I want.  I take special care to
# ignore comments and pod's.

# It would be much better if perl could tell us the dependencies of a
# given script.

# The filenames to scan are either passed on the command line or if
# that is empty they are passed via stdin.

# If there are strings in the file which match the pattern
#     m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i
# then these are treated as additional names which are required by the
# file and are printed as well.

# I plan to rewrite this in C so that perl is not required by RPM at
# build time.

# by Ken Estes Mail.com kestes@staff.mail.com

if ("@ARGV") {
  foreach (@ARGV) {
    process_file($_);
  }
} else {

  # notice we are passed a list of filenames NOT as common in unix the
  # contents of the file.

  foreach (<>) {
    chomp $_;
    process_file($_) if -f $_;
  }
}


foreach $module (sort keys %require) {
  if (length($require{$module}) == 0) {
    print "perl($module)\n";
  } else {

    # I am not using rpm3.0 so I do not want spaces around my
    # operators. Also I will need to change the processing of the
    # $RPM_* variable when I upgrade.

    my $v = qx{ rpm --eval '%perl_convert_version $require{$module}' };
    print "perl($module) >= $v\n";
  }
}

exit 0;



sub process_file {
  
  my ($file) = @_;
  
  if (!open(FILE, $file)) {
    warn("$0: Warning: Could not open file '$file' for reading: $!\n");
    return;
  }
  
  while (<FILE>) {
    
    # skip the "= <<" block

    if ( ( m/^\s*\$(.*)\s*=\s*<<\s*["'](.*)['"]/i) ||
         ( m/^\s*\$(.*)\s*=\s*<<\s*(.*);/i) ) {
      $tag = $2;
      while (<FILE>) {
        ( $_ =~ /^$tag/) && last;
      }
    }

    # skip the documentation

    # we should not need to have item in this if statement (it
    # properly belongs in the over/back section) but people do not
    # read the perldoc.

    if ( (m/^=(head[1-4]|pod|item)/) .. (m/^=(cut)/) ) {
      next;
    }

    if ( (m/^=(over)/) .. (m/^=(back)/) ) {
      next;
    }

    # skip the data section
    if (m/^__(DATA|END)__$/) {
      last;
    }

    # Each keyword can appear multiple times.  Don't
    #  bother with datastructures to store these strings,
    #  if we need to print it print it now.
    
    if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
      foreach $_ (split(/\s+/, $1)) {
	print "$_\n";
      }
    }

    if ( 

# ouch could be in a eval, perhaps we do not want these since we catch
# an exception they must not be required

#   eval { require Term::ReadLine } or die $@;
#   eval "require Term::Rendezvous;" or die $@;
#   eval { require Carp } if defined $^S; # If error/warning during compilation,


	(m/^(\s*)         # we hope the inclusion starts the line
	 (require|use)\s+(?!\{)     # do not want 'do {' loops
	 # quotes around name are always legal
	 [\'\"]?([^\;\ \'\"\t]+)[\'\"]?[\t\;\ ]
	 # the syntax for 'use' allows version requirements
	 \s*([.0-9]*)
	 /x)
       ) {
      my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4);
      my $usebase;

      # we only consider require statements that are flushed against
      # the left edge. any other require statements give too many
      # false positives, as they are usually inside of an if statement
      # as a fallback module or a rarely used option

      ($whitespace ne "" && $statement eq "require") && next;

      # if there is some interpolation of variables just skip this
      # dependency, we do not want
      #        do "$ENV{LOGDIR}/$rcfile";

      ($module =~ m/\$/) && next;

      # skip if the phrase was "use of" -- shows up in gimp-perl, et al.
      next if $module eq 'of';

      # if the module ends in a comma we probably caught some
      # documentation of the form 'check stuff,\n do stuff, clean
      # stuff.' there are several of these in the perl distribution

      ($module  =~ m/[,>]$/) && next;

      # if the module name starts in a dot it is not a module name.
      # Is this necessary?  Please give me an example if you turn this
      # back on.

      #      ($module =~ m/^\./) && next;

      # if the module starts with /, it is an absolute path to a file
      if ($module =~ m(^/)) {
        print "$module\n";
        next;
      }

      # as seen in some perl scripts
      # use base qw(App::CLI Class::Accessor::Chained::Fast App::CLI::Command);
      if ($module eq 'base') {
	  $require{$module} = $version;
	  $line{$module} = $current_line;
	  ($module = $_) =~ s/use\s*base\s*//;
	  $module =~ s/qw\((.*)\)\s*;/$1/;
	  $module =~ s/qw(.)(.*)\1\s*;/$2/;
	  $module =~ s/\s*;$//;
	  $module =~ s/#.*//;
	  $usebase = 1;
      }
      # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc.
      # we can strip qw.*$, as well as (.*$:
      $module =~ s/qw.*$//;
      $module =~ s/\(.*$//;

      # if the module ends with .pm, strip it to leave only basename.
      $module =~ s/\.pm$//;

      # some perl programmers write 'require URI/URL;' when
      # they mean 'require URI::URL;'

      $module =~ s/\//::/;

      # trim off trailing parentheses if any.  Sometimes people pass
      # the module an empty list.

      $module =~ s/\(\s*\)$//;

      # if module is a number then both require and use interpret that
      # to mean that a particular version of perl is specified
      next if $module =~ /^v?\d/;

      # ph files do not use the package name inside the file.
      # perlmodlib  documentation says:

      #       the .ph files made by h2ph will probably end up as
      #       extension modules made by h2xs.

      # so do not expend much effort on these.


      # there is no easy way to find out if a file named systeminfo.ph
      # will be included with the name sys/systeminfo.ph so only use the
      # basename of *.ph files

      ($module  =~ m/\.ph$/) && next;

      # if the module was loaded trough base, we need to split the list
      if ($usebase) {
          my $current_line = $_;
          foreach (split(/\s+/, $module)) {
              next unless $_;
              $require{$_} = $version;
              $line{$_} = $current_line;
          }
      } else {
	  $require{$module}=$version;
	  $line{$module}=$current_line;
      }
    }
  }

  close(FILE) ||
    die("$0: Could not close file: '$file' : $!\n");

  return ;
}