blob: 5d2b3186021321b81698d30d0cd047e6df52ac20 (
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
|
#!/usr/bin/perl
# RPM and it's source code are 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
# marc@redhat.com and ewt@redhat.com.
# sql.prov - a simple script to print the proper name for sql from
# both the sepecification and body files.
# 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) {
print "sql($module)\n";
}
exit 0;
sub process_file {
my ($filename) = @_;
chomp $filename;
open(FILE, "<$filename")||
die("$0: Could not open file: '$filename' : $!\n");
my ($package, $version) = ();
my (@file) = <FILE>;
my ($file) = "@file";
close(FILE)||
die("$0: Could not close file: '$file' : $!\n");
# skip the comments
$file =~ s!/\*(.*?)\*/!!gs;
$file =~ s!\s*--(.*?)\n!\n!gm;
@file = split(/\n/, $file);
foreach (@file) {
# remove strings
s!\'[^\']*\'!!g;
# 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/\bpackage\s+(body\s*)?(\S+)\s+[ia]s/i) {
$package=$2;
$package=lc($package);
$require{$package}=1;
}
if (m/((procedure)|(function))\s+(\S+)\s*\(/i) {
my $func = $4;
$func = lc($func);
if ($package) {
$require{"$package.$func"}=1;
} else {
$require{$func}=1;
}
}
# 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";
}
}
}
return ;
}
|
