summaryrefslogtreecommitdiff
path: root/scripts/perl.prov
blob: 6643f6a6e29c6618e3cab12cdcb7ae563f04eac7 (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
#!/usr/bin/perl

# a simple script to print the proper name for perl libraries.

# 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

# it would be much better if perl could tell us the proper name of a
# given script.


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 {
    print "perl($module)=$require{$module}\n";
  }
}

exit 0;



sub process_file {

  my ($file) = @_;
  chomp $file;
  
  open(FILE, "<$file")||
    die("$0: Could not open file: '$file' : $!\n");

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

  while (<FILE>) {
    
    # skip the documentation
    if ( (m/^=(head1|head2|pod|item)/) .. (m/^=(cut)/) ) {
      next;
    }
    
    if ( (m/^=(over)/) .. (m/^=(back)/) ) {
      next;
    }
    
    # skip the data section
    if (m/^__(DATA|END)__$/) {
      last;
    }

    # not everyone puts the package name of the file as the first
    # package name so we report all namespaces as if they were
    # provided packages (really ugly).

    if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) {
      $package=$1;
      undef $version;
      $require{$package}=undef;
    }

    # after we found the package name take the first assignment to
    # $VERSION as the version number. Exporter requires that the
    # variable be called VERSION so we are safe.

    # here are examples of VERSION lines from the perl distribution

    #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
    #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.2 $, 10;
    #CGI/Apache.pm:$VERSION = (qw$Revision: 1.2 $)[1];
    #DynaLoader.pm:$VERSION = $VERSION = "1.03";     # avoid typo warning

    if ( 
	($package) && 
	(m/^\s*\$VERSION\s*=\s+/)
       ) {

      # first see if the version string contains the string
      # '$Revision' this often causes bizzare strings and is the most
      # common method of non static numbering.

      if (m/(\$Revision: (\d+[.0-9]+))/) {
	$version= $2; 
      } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) {
	
	# look for a static number hard coded in the script
	
	$version= $1; 
      }
      $require{$package}=$version;
    }
    
    # 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_Provides\s*=\s*["'](.*)['"]/i) {
      foreach $_ (spit(/\s+/, $1)) {
	print "$_\n";
      }
    }

  }

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

  return ;
}