rpm-build/scripts/perl.req

#!/usr/bin/perl

# RPM (and it's 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 makedepends 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
# modified by Mikhail Zabaluev <mookid@mu.ru>

require File::Spec;


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($_);
  }
}


# obtain the list of library directories. If not provided, use @INC

if (exists $ENV{RPM_PERL_LIB_PATH}) {
  @perl_inc = split(/[:,\s]+/, $ENV{RPM_PERL_LIB_PATH});
}
else {
  @perl_inc = grep { m|^/| } @INC;
}

# add installation mirrors to the library search list

my $buildroot = $ENV{RPM_BUILD_ROOT};
push @perl_inc, map { "${buildroot}$_" } @perl_inc;


foreach $module (sort keys %require) {

  # search for the file to be installed in the system or in this same package

  my $found = 0;
  for (@perl_inc) {
    if (-e "$_/$module") {
      $found = 1;
      last;
    }
  }
  next unless $found;

  if (length($require{$module}) == 0) {
    print "perl($module)\n";
  } else {
    print "perl($module) >= $require{$module}\n";
  }
}

exit 0;



sub process_file {
  
  my ($file) = @_;
  chomp($file);

  return if $file eq '';

  open(FILE, "<$file")||
    die("$0: Could not open file: '$file' : $!\n");
  
  while (<FILE>) {
    
    # 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[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) {
      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";
      }
      next;
    }

    my ($module, $version) = ();

    if (m/^\s*(require|use)\s+(v?\d[.\d_]*)/) {

      # statement requires a particular version of Perl

      print "perl-base >= " . package_version($2, '%.5f') . "\n";
      next;
    }
    elsif (m/^\s*require[\s(]+([_A-Za-z][\w:']*)/) {

      # require Module::Name

      $module = module_filename($1);
    }
    elsif (m/^\s*use\s+([_A-Za-z][\w:']*)(\s+(v?[._\d]+))?/) {

      # use Module::Name [VERSION]

      $module = module_filename($1);
      if (defined($2)) {
	$version = package_version($3);
      }
    }
    elsif (m/^\s*(do|require)[\s(]*(['"])([^'"\s\\]+)\2[\s)]*;/) {

      # invocation of a file by its name

      $module = $3;

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

      next if $2 eq '"' && $module =~ /\$/;

      $module = File::Spec->canonpath($module);

      if (File::Spec->file_name_is_absolute) {

	# references to absolute filenames are reported explicitly

	print "$module\n";
	next;
      }

      # unsure what to do with paths that lead to parent directories

      next if $module =~ /(^|\/)\.\.\//;

      # otherwise, continue with $module set

    }
    elsif (m/^\s*([_A-Za-z][\w:']*)\s*->\s*require_version\s*\(\s*(v?[._\d]+)\s*\)/
 	   || m/^\s*require_version\s+([_A-Za-z][\w:']*)\s+(v?[._\d]+)/) {
      $module = module_filename($1);
      $version = package_version($2);
    }

    if (defined($module)) {
      $require{$module} = $version
	unless defined($require{$module}) && $require{$module} >= $version;
    }
  }

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


# module_filename($name) -
# converts module name to relative file path

sub module_filename {
  my $name = shift;
  $name =~ s{::|'}{/}g;
  return $name . '.pm'; 	#'
}


# package_version($version[, $oldformat]) -
# converts Perl version constant to RPM package version.
# New style 'vN.N.N' numbers are converted to epoch 1 versions,
# whereas old-style floating point versions are given epoch 0 and
# optionally formatted by sprintf() using supplied format.
# Parameters:
#   $version - version number in 'vN.N.N' or 'N.NNN_NN' format
#   $oldformat - format specifier for sprintf() used to format old-style
#       floating-point version number

sub package_version {
  my $version = shift;
  if ($version =~ s/^v// || $version =~ /\.[\d_]+\./) {
    return "1:$version";
  }
  else {
    my $format = shift;
    $format = '%s' unless defined $format;
    return '0:' . sprintf($format, $version);
  }
}