scripts/tcl.req

   1 #!/usr/bin/perl
   2
   3 # tcl.req - a simple makedepends like script for tcl.
   4
   5 # I plan to rewrite this in C so that perl is not required by RPM at
   6 # build time.
   7
   8 # by Ken Estes Mail.com kestes@staff.mail.com
   9
  10 use File::Basename;
  11
  12 if ("@ARGV") {
  13   foreach (@ARGV) {
  14     process_file($_);
  15   }
  16 } else {
  17
  18   # notice we are passed a list of filenames NOT as common in unix the
  19   # contents of the file.
  20
  21   foreach (<>) {
  22     process_file($_);
  23   }
  24 }
  25
  26
  27 foreach $module (sort keys %require) {
  28     print "tcl($module)\n";
  29 }
  30
  31 exit 0;
  32
  33
  34
  35 sub process_file {
  36
  37   my ($file) = @_;
  38   chomp $file;
  39
  40   open(FILE, "<$file")||
  41     die("$0: Could not open file: '$file' : $!\n");
  42
  43   while (<FILE>) {
  44
  45     # Each keyword can appear multiple times.  Don't
  46     #  bother with datastructures to store these strings,
  47     #  if we need to print it print it now.
  48
  49     if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
  50       foreach $_ (spit(/\s+/, $1)) {
  51         print "$_\n";
  52       }
  53     }
  54
  55     s/\#.*//;
  56
  57     # Each keyword can appear multiple times.  Don't
  58     #  bother with datastructures to store these strings,
  59     #  if we need to print it print it now.
  60
  61     if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
  62       foreach $_ (spit(/\s+/, $1))
  63         print "$_\n";
  64     }
  65
  66
  67 # we wish to capture these source statements:
  68
  69 #  source "$PATH/lib/util.tcl"
  70 #  source "comconf.tcl"
  71 #  if {[catch {source $env(CONTROL_PANEL_LIB_DIR)/bindings.tcl}] != 0} {
  72
  73     # quick check to see if the complex regexps could possibly match.
  74     # This should speed things up.
  75
  76     (m/source/) || next;
  77
  78     # note we include parethesis and '$' and '\' in the pattern
  79
  80     if (
  81         (m!source\s+([\'\"])?([0-9A-Za-z/._\-\\\(\)\$]+)!)
  82        ) {
  83
  84       my ($module) = $2;
  85
  86       # If there is some interpolation of variables,
  87       # see if taking the basename will give us the filename.
  88
  89       ($module =~ m/\$/) &&
  90         ($module = basename($module));
  91
  92       ($module =~ m/\$/) ||
  93         ($require{$module}=1);
  94     }
  95   }
  96
  97   close(FILE)||
  98     die("$0: Could not close file: '$file' : $!\n");
  99
 100   return ;
 101 }