home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / rescue / usr / lib / rpm / sql.prov < prev    next >
Text File  |  2006-11-29  |  3KB  |  116 lines
  1. #!/usr/bin/perl
  2.  
  3. # RPM and it's source code are covered under two separate licenses. 
  4.  
  5. # The entire code base may be distributed under the terms of the GNU
  6. # General Public License (GPL), which appears immediately below.
  7. # Alternatively, all of the source code in the lib subdirectory of the
  8. # RPM source code distribution as well as any code derived from that
  9. # code may instead be distributed under the GNU Library General Public
  10. # License (LGPL), at the choice of the distributor. The complete text
  11. # of the LGPL appears at the bottom of this file.
  12.  
  13. # This alternatively is allowed to enable applications to be linked
  14. # against the RPM library (commonly called librpm) without forcing
  15. # such applications to be distributed under the GPL.
  16.  
  17. # Any questions regarding the licensing of RPM should be addressed to
  18. # marc@redhat.com and ewt@redhat.com.
  19.  
  20.  
  21. # sql.prov - a simple script to print the proper name for sql from
  22. # both the sepecification and body files.
  23.  
  24.  
  25. # by Ken Estes Mail.com kestes@staff.mail.com
  26.  
  27. if ("@ARGV") {
  28.   foreach (@ARGV) {
  29.     process_file($_);
  30.   }
  31. } else {
  32.  
  33.   # notice we are passed a list of filenames NOT as common in unix the
  34.   # contents of the file.
  35.  
  36.   foreach (<>) {
  37.     process_file($_);
  38.   }
  39. }
  40.  
  41.  
  42.  
  43. foreach $module (sort keys %require) {
  44.   print "sql($module)\n";
  45. }
  46.  
  47. exit 0;
  48.  
  49.  
  50.  
  51. sub process_file {
  52.  
  53.   my ($filename) = @_;
  54.   chomp $filename;
  55.   
  56.   open(FILE, "<$filename")||
  57.     die("$0: Could not open file: '$filename' : $!\n");
  58.  
  59.   my ($package, $version) = ();
  60.  
  61.   my (@file) = <FILE>;
  62.   
  63.   my ($file) = "@file";
  64.  
  65.   close(FILE)||
  66.     die("$0: Could not close file: '$file' : $!\n");
  67.  
  68.   # skip the comments
  69.  
  70.   $file =~ s!/\*(.*?)\*/!!gs;
  71.   $file =~ s!\s*--(.*?)\n!\n!gm;
  72.  
  73.   @file = split(/\n/, $file);
  74.  
  75.   foreach (@file) {
  76.  
  77.     # remove strings
  78.  
  79.     s!\'[^\']*\'!!g;
  80.  
  81.  
  82.     # not everyone puts the package name of the file as the first
  83.     # package name so we report all namespaces as if they were
  84.     # provided packages (really ugly).
  85.  
  86.     if (m/\bpackage\s+(body\s*)?(\S+)\s+[ia]s/i) {
  87.       $package=$2;
  88.       $package=lc($package);
  89.       $require{$package}=1;
  90.     }
  91.  
  92.     if (m/((procedure)|(function))\s+(\S+)\s*\(/i) {
  93.       my $func = $4;
  94.       $func = lc($func);
  95.       if ($package) {
  96.     $require{"$package.$func"}=1;
  97.       } else {
  98.     $require{$func}=1;
  99.       }
  100.     }
  101.  
  102.     # Each keyword can appear multiple times.  Don't
  103.     #  bother with datastructures to store these strings,
  104.     #  if we need to print it print it now.
  105.     
  106.     if ( m/^\s*\$RPM_Provides\s*:=\s*["'](.*)['"]/i) {
  107.       foreach $_ (spit(/\s+/, $1)) {
  108.         print "$_\n";
  109.       }
  110.     }
  111.  
  112.   }
  113.  
  114.   return ;
  115. }
  116.