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.req < prev    next >
Text File  |  2006-11-29  |  2KB  |  109 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.req - a simple script to print the uses of sql functions.
  22.  
  23.  
  24. # by Ken Estes Mail.com kestes@staff.mail.com
  25.  
  26. if ("@ARGV") {
  27.   foreach (@ARGV) {
  28.     process_file($_);
  29.   }
  30. } else {
  31.  
  32.   # notice we are passed a list of filenames NOT as common in unix the
  33.   # contents of the file.
  34.  
  35.   foreach (<>) {
  36.     process_file($_);
  37.   }
  38. }
  39.  
  40.  
  41.  
  42. foreach $module (sort keys %require) {
  43.   print "sql($module)\n";
  44. }
  45.  
  46. exit 0;
  47.  
  48.  
  49.  
  50. sub process_file {
  51.  
  52.   my ($filename) = @_;
  53.   chomp $filename;
  54.   
  55.   open(FILE, "<$filename")||
  56.     die("$0: Could not open file: '$filename' : $!\n");
  57.  
  58.   my ($package, $version) = ();
  59.  
  60.   my (@file) = <FILE>;
  61.   
  62.   my ($file) = "@file";
  63.  
  64.   close(FILE)||
  65.     die("$0: Could not close file: '$file' : $!\n");
  66.  
  67.   # skip the comments
  68.  
  69.   # Suck the whole file in to make removing /* */ (multiple lines
  70.   # comments) comments easier
  71.  
  72.   $file =~ s!/\*(.*?)\*/!!gs;
  73.   $file =~ s!^\s*--(.*?)\n!\n!gm;
  74.  
  75.   @file = split(/\n/, $file);
  76.  
  77.   foreach (@file) {
  78.  
  79.     # remove strings
  80.  
  81.     s!\'[^\']*\'!!g;
  82.  
  83.  
  84.     # we are interested in function names which have a dot in them and
  85.     # are followed by an open parenthesis
  86.  
  87.     foreach ( m/([a-zA-Z0-9._-]+\.[a-zA-Z0-9._-]+)\s*\(/ ) {
  88.       my $func = $_;
  89.       $func=lc($func);
  90.       $func =~ m/\.\./ && 
  91.     next;
  92.       $require{$func}=1;
  93.     }
  94.     
  95.     # Each keyword can appear multiple times.  Don't
  96.     #  bother with datastructures to store these strings,
  97.     #  if we need to print it print it now.
  98.     
  99.     if ( m/^\s*\$RPM_Provides\s*:=\s*["'](.*)['"]/i) {
  100.       foreach $_ (spit(/\s+/, $1)) {
  101.         print "$_\n";
  102.       }
  103.     }
  104.  
  105.   }
  106.  
  107.   return ;
  108. }
  109.