Attachment 311783 Details for Bug 455276 – A modfied 'perl.req' script to illustrate some possible design changes.

A modfied 'perl.req' script to illustrate some possible design changes.

perl.req (text/plain), 5.77 KB, created by Joe Krahn on 2008-07-14 22:21:23 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Joe Krahn

Created: 2008-07-14 22:21:23 UTC

Size: 5.77 KB

patch

obsolete

>#!/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 grammmar 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 (<>) {
>    process_file($_);
>  }
>}
>
>
>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.
>
>    print "perl($module) >= $require{$module}\n";
>  }
>}
>
>exit 0;
>
>
>
>sub process_file {
>  
>  my ($file) = @_;
>  chomp $file;
>  
>  open(FILE, "<$file") || return;
>  
>  while (<FILE>) {
>    
>    # skip the "= <<" block
>
>    if ( ( m/^\s*\$(.*)\s*=\s*<<\s*["'](.*)['"]/) ||
>         ( m/^\s*\$(.*)\s*=\s*<<\s*(.*);/) ) {
>      $tag = $2;
>      while (<FILE>) {
>        ( $_ =~ /^$tag/) && last;
>      }
>    }
>
>    # skip q{} quoted sections - just hope we don't have curly brackets
>    # within the quote, nor an escaped hash mark that isn't a comment
>    # marker, such as occurs right here. Draw the line somewhere.
>    if ( m/^.*\Wq[qxwr]?\s*([\{\(\[#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) {
>      $tag = $1;
>      $tag =~ tr/{\(\[\#|\//})]#|\//;
>      while (<FILE>) {
>        ( $_ =~ m/\}/ ) && 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.
>    #
>	# Again allow for "our".
>    if ( m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
>      foreach $_ (split(/\s+/, $2)) {
>	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/
>         # we hope the inclusion starts the line
>         ^(\s*)
>
>         # we only consider require statements that are flush 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
>	 (^require|use)\s+
>
>         # do not want 'do {' loops
>         (?!\{)
>
>	 # The reference can be a quoted filename, but skip refereneces
>         # containing variable references (i.e. disallow '$').
>	 (?:['"]([^\;\ \'\"\t\$]*)['"]
>
>         # or a bareword Perl version (skip leading 'v' if present):
>           |v?([.0-9]*)
>
>         # Or a bareword module name:
>         # This assumes module names use only 'word' characters and
>         # "::" delimters to reduce bogus matches.
>           |(\w+(?:::\w+)*)
>
>         )
>         # Module references may followed by '('
>         [(\t\;\ ]
>	 # the syntax for 'use' allows version requirements
>	 \s*([.0-9]*)
>	 /x)
>       ) {
>
>      my ($whitespace, $statement, $filename, $perl_ver, $module, $version) = ($1,$2,$3,$4,$5);
>
>      # skip if the phrase was "use of" -- shows up in gimp-perl, et al.
>      next if $module eq 'of';
>
>      # 'require' does not allow the version qualifier:
>      next if ($statement eq "require" and defined $version);
>
>      if (defined $perl_ver) {
>        printf "perl >= %d:$perl_ver\n", ($ver =~ /5.00/) ? 0 : 1;
>        next;
>      }
>
>      # Convert module string references to bareword syntax:
>      if ($filename =~ m/^(.*)\.pm$/) {
>        $module = $1;
>        $module =~ s{/}{::}g;
>        undef $filename;
>      }
>
>      if (defined $filename) {
>
>      # .ph files are excluded.
>      ($filename =~ m/\.ph$/) && next;
>
>      $module = $filename;
>      }
>
>      $require{$module}=$version;
>      $line{$module}=$_;
>    }
>    
>  }
>
>  close(FILE) ||
>    die("$0: Could not close file: '$file' : $!\n");
>  
>  return ; 
>}

Actions: View

Attachments on bug 455276: 311783