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 / get_magic.pl < prev    next >
Perl Script  |  2006-11-29  |  2KB  |  116 lines
  1. #!/usr/bin/perl
  2.  
  3. # Given a filename on the command line or on stdin this script returns
  4. # the (single) interpreter that is required to run the executable.  We
  5. # need this information to pick the best dependency parser for this
  6. # file.
  7.  
  8. # Usually this is extracted from the #! line of the file
  9. # but we also handle the various 'exec' tricks that people use to
  10. # start the interpreter via an intermediate shell.  
  11.  
  12.  
  13. # These have all been seen on our system or are "recommended" in
  14. # various man pages.
  15.  
  16. # Examples:
  17.  
  18. #   #!/bin/sh
  19. #   # the next line restarts using wish \
  20. #   exec wish "$0" "$@"
  21.  
  22.  
  23. #   #!/bin/sh -- # -*- perl -*- -p
  24. #     eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}'
  25. #       if $running_under_some_shell;
  26.  
  27.  
  28. #   #!/bin/sh -- # -*- perl -*- -p
  29. #   eval '(exit $?0)' && eval 'exec /usr/bin/perl -wS $0 ${1+"$@"}'
  30.  
  31.  
  32. #   #!/bin/sh -- # -*- perl -*- -p
  33. #   & eval 'exec /usr/bin/perl -wS $0 $argv:q'
  34. #     if $running_under_some_shell;
  35.  
  36.  
  37. #   #! /usr/bin/env python
  38.  
  39.  
  40. use File::Basename;
  41.  
  42. if ("@ARGV") {
  43.   foreach (@ARGV) {
  44.     process_file($_);
  45.   }
  46. } else {
  47.   
  48.   # notice we are passed a list of filenames NOT as common in unix the
  49.   # contents of the file.
  50.   
  51.   foreach (<>) {
  52.     process_file($_);
  53.   }
  54. }
  55.  
  56. foreach $prog (sort keys %require) {
  57.  
  58.   $prog=basename($prog);
  59.  
  60.   # ignore variable interpolation and any program whose name is made
  61.   # up only of non word characters ('<', '&&', etc).
  62.  
  63.   ( ( $prog != /\$/ ) || ( $prog =~ /^\W+$/ ) ) && 
  64.     next;
  65.  
  66.   print "exectuable($prog)\n";
  67.  
  68. }
  69.  
  70. exit 0;
  71.  
  72.  
  73. sub process_file {
  74.   
  75.   my ($file) = @_;
  76.   chomp $file;
  77.   
  78.   my ($version, $magic) = ();
  79.   
  80.   (-f $file) || return ;  
  81.  
  82.   open(FILE, "<$file")||
  83.     die("$0: Could not open file: '$file' : $!\n");
  84.   
  85.   my $rc = sysread(FILE,$line,1000);
  86.  
  87.   $rc =~ s/\#.*\n//g;
  88.  
  89.   # Ignore all parameter substitution.
  90.   # I have no hope of parsing something like: 
  91.   #  exec ${SHELL:-/bin/sh}
  92.  
  93.   $rc =~ s/\$\{.*\}//g;
  94.   $rc =~ s/echo\s+.*[\n;]//g;
  95.   
  96.   if  ( ($rc > 1) && ($line =~ m/^\#\!\s*/) )  {
  97.     
  98.     if ($line =~ m/\b(exec|env)\s+([\'\"\`\\]+)?([^ \t\n\r]+)/) {
  99.       $require{$3} = 1;
  100.       last;
  101.     }
  102.     
  103.     # strip off extra lines and any arguments
  104.     if ($line =~ m/^\#\!\s*([^ \t\n\r]+)/) {
  105.       $require{$1} = 1;
  106.       last;
  107.     }
  108.  
  109.   }
  110.  
  111.   close(FILE) ||
  112.     die("$0: Could not close file: '$file' : $!\n");
  113.   
  114.   return ; 
  115. }
  116.