Lose ancient and unused perllocate* scripts

2 files changed, 0 insertions, 533 deletions

diff --git a/scripts/perllocate b/scripts/perllocate
deleted file mode 100755
index 227790cef..000000000
--- a/scripts/perllocate
+++ /dev/null
@@ -1,246 +0,0 @@
-#!/usr/bin/perl
-
-# perllocate - a perl replacement for GNU locate.  This allows perl
-# regular expressions instead of shell globs.
-
-# Written by Ken Estes, Mail.com.
-
-use Getopt::Long;
-
-
-sub usage {
-  
-    my $usage =<<EOF;
-
-$0  [--version]  [--help]
-	[-d path] [--database=path]  pattern...
-
-Arguments
-
-
---version	Print version information for this program
-
---help		Show this usage page
-
--d path
---database=path
-		Instead of searching the default  file  name  database,
-		search  the  file  name  databases  in path, which is a
-		colon-separated list of database file names.   You  can
-		also  use  the  environment variable LOCATE_PATH to set
-		the list of database files to search.  The option over-
-		rides the environment variable if both are used. If 
-		neither are used the default database file is $DEFAULT_DB.
-
-
-Synopsis
-
-A perl5 based replacement for GNU locate.  The arguments accepted are
-identical but the patterns matched are perl5 instead of the
-traditional locate glob patterns.  This program reads 'LOCATE02'
-databases which were first introduced with locate version 4.0.
-
-For each given pattern, locate searches one or more databases of file
-names and displays the file names that contain the pattern.  Patterns
-that contain metacharacters should be quoted to protect them from
-expansion by the shell.
-
-Patterns are perl5 regular expressions; see perlre(1).  The database
-entries are a stored as a case-insensitive (lowercase) sorted list.
-
-The file name databases contain lists of files that were on the system
-when the databases were last updated.  The system administrator can
-choose the file name of the default database, the frequency with
-which the databases are updated, and the directories for which they
-contain entries; see updatedb(1L).
-
-
-
-Environment
-
-     LOCATE_PATH
-          Colon-separated list of databases to search.
-
-Usage Example
-
-
-$0 --help
-$0 --version
-
-$0 gcc
-$0 perl5
-$0 'rpm$' 'tar$' 'gz$' 'ps$'
-$0 '^\s*' 
-$0 '/RPMS/'
-
-
-EOF
-
-    print $usage;
-    exit 0;
-
-}
-
-
-
-sub set_static_vars {
-
-# This functions sets all the static variables which are often
-# configuration parameters.  Since it only sets variables to static
-# quantites it can not fail at run time. Some of these variables are
-# adjusted by parse_args() but asside from that none of these
-# variables are ever written to. All global variables are defined here
-# so we have a list of them and a comment of what they are for.
-  
-  $DB_FILE_MAGIC = "\0LOCATE02\0";
-  
-  $DEFAULT_DB = '/usr/local/var/locatedb';
-
-  $VERSION = (qw$Revision: 1.2 $)[1];
-  
-  # set a known path.
- 
-  $ENV{'PATH'}= (
-		 '/opt/gnu/bin'.
-		 ':/usr/local/bin'.
-		 ':/usr/bin'.
-		 ':/bin'.
-		 '');
-  
-  # taint perl requires we clean up these bad environmental variables.
-  
-  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
-  
-  return ;
-}
-
-
-sub parse_args{
-
-  if( !GetOptions("version", "help", "d=s", "database=s",) ) {
-    print("Illegal options in \@ARGV: '@ARGV'\n");
-    usage() ;
-    exit 1 ;
-  }
-  
-  if($opt_version) {
-    print "$0: Version: $VERSION\n";
-    exit 0;  
-  }
-  
-  if ($opt_help) {
-    usage();
-  }
-  
-  ($#ARGV == -1) &&
-    die("Must supply a pattern argument.\n");
-
-  $DB_PATH = ( $opt_database ||
-	       $opt_d ||
-	       ENV{'LOCATE_PATH'} ||
-	       $DEFAULT_DB );
-
-  return ;
-}
-
-
-# read the locatedb file into memory
-
-sub read_database {
-  my ($filename) = @_;
-
-  # read whole file into memory
-  {
-    open (DBFILE, "<$filename")||
-      die("$0: Could not open: $filename for reading. $!\n");
-
-    # not needed on unix but lets be very clear
-    binmode (DBFILE);
-
-    # slurp whole file
-    my $old_irs = $/;
-    undef $/;
-
-    $FILE = <DBFILE>;
-    
-    $/ = $old_irs;
-
-    close(DBFILE)||
-      die("$0: Could not close: $filename. $!\n");
-    
-    $FILE =~ m/^$DB_FILE_MAGIC/ ||
-      die("$0: file: $filename is not an GNU locatedb file. ".
-	  "No magic number found.\n");
-  }  
-  return ;
-}
-
-
-sub parse_database {
-  my ($pattern) = @_;
-
-  my $file_size = length($FILE);
-  my $position = length($DB_FILE_MAGIC);
-
-  my ( $new_prefix_size, $new_filename, 
-       $old_prefix_size, $old_filename, ) = ();
-
-  while ($position < $file_size) {
-    my ($offset, $suffix) = ();
-
-    # read offset
-
-    ($offset) = unpack("c", substr($FILE, $position, 1));
-    $position++;
-    if ($offest == 0x80) {
-
-      # offset is too large to store in one byte, the data we want is
-      # in the next two bytes.
-
-      ($offset) = unpack("n", substr($FILE, $position, 2));
-      $position += 2;
-    }
-
-    # read suffix
-
-    {
-      my $null_position = index ($FILE, "\0", $position);
-      my $length = $null_position - $position;
-      $suffix = substr($FILE, $position, $length);
-      $position += $length + 1;
-    }
-    
-    # new values depend on old values and the contents of the database.
-    
-    $new_prefix_size = $offset + $old_prefix_size;
-    
-    $new_filename = substr($old_filename, 0, $new_prefix_size)
-		      .$suffix;
-    
-    if ( $new_filename =~ m/$pattern/ ) {
-      print "$new_filename\n";
-    }
-
-    $old_prefix_size = $new_prefix_size;
-    $old_filename = $new_filename;
-  }
-
-  return ;
-}
-
-
-# -------------- main --------------
-{
-
-  set_static_vars();
-  parse_args();
-
-  foreach $file ( split(/:/, $DB_PATH) ) {
-    read_database($file);
-    my $pattern = '('.join(')|(', @ARGV).')';
-    parse_database($pattern);
-  }
-  
-  exit 0;
-}
-
diff --git a/scripts/perllocate.cgi b/scripts/perllocate.cgi
deleted file mode 100755
index 2ae25a77a..000000000
--- a/scripts/perllocate.cgi
+++ /dev/null
@@ -1,287 +0,0 @@
-#!/usr/bin/perl
-
-# perllocate.cgi - a web interface to a perl version of the Unix
-# locate command.  This script makes it easy to query the RPM
-# repository and find out what packages are availible using Perl5
-# Patterns.
-
-# written by Ken Estes kestes@staff.mail.com
-
-use CGI ':standard';
-use File::Basename;
-use File::stat;
-
-
-
-sub usage {
-
-  # If they are asking for help then they are clueless so reset all
-  # their parameters for them, in case they are in a bad state.
-
-  param(-name=>'Defaults', -value=>'on');
-  my $rpmdiff_version = `perllocate --version`;
-
-  $usage =<<EOF;
-
-  $0          version: $VERSION
-  $perllocate_version
-
-This is a web interface into the perllocate command.
-
-
-EOF
-    print pre($usage);
-
-  return ;
-}
-
-
-sub set_static_vars {
-
-# This functions sets all the static variables which are often
-# configuration parameters.  Since it only sets variables to static
-# quantites it can not fail at run time. Some of these variables are
-# adjusted by parse_args() but asside from that none of these
-# variables are ever written to. All global variables are defined here
-# so we have a list of them and a comment of what they are for.
-
-
-  $VERSION = ( qw$Revision: 1.2 $ )[1];
-  
-  @ORIG_ARGV = @ARGV;
-  
-  $LOCATEDB = '/net/master-mm/export/rpms/redhat/rpmarchive.locatedb';
-
-  # a pattern which matches something inside the rpm archive mount point.
-
-  $MOUNT_DIR_PATTERN = '/redhat/';
-
-  # a pattern to limit the files which are displayed.
-
-  $FILES_TO_DISPLAY_PATTERN = '/RPMS/';
-
-
-  # set a known path.
-  
-  # the correct path has not been finalized yet, but this is close.
-  
-  $ENV{'PATH'}= (
-		 '/usr/local/bin'.
-		 ':/usr/bin'.
-		 ':/bin'.
-		 ':/usr/apache/cgibins/cgi-forms'.
-		 '');
-  
-  # taint perl requires we clean up these bad environmental
-  # variables.
-  
-  delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
-  
-  return 1;
-} #set_static_vars
-
-
-
-
-sub get_env {
-
-# this function sets variables similar to set_static variables.  This
-# function may fail only if the OS is in a very strange state.  after
-# we leave this function we should be all set up to give good error
-# handling, should things fail.
-
-  umask 0022; 
-  $| = 1; 
-  $PID = $$; 
-  $PROGRAM = basename($0); 
-  $TIME = time();
-  $LOCALTIME = localtime($main::TIME); 
-  $START_TIME = $TIME;
-
-  { 
-
-    # We show the results as if they were located in the same
-    # directory as the locatedb appears to the cgi script.  The
-    # directory is exported from the repository machine in a slightly
-    # different place so that all its outputs would look wrong if we
-    # displayed it raw.  This hack is what $DISPLAY_PREFIX is used
-    # for, we try and compute it automatically.
-
-    $LOCATEDB =~ m!$MOUNT_DIR_PATTERN! || 
-      die("db file: $LOCATEDB must be located in a '$MOUNT_DIR_PATTERN' directory");
-    
-    $DISPLAY_PREFIX = $LOCATEDB;
-    $DISPLAY_PREFIX =~ s!$MOUNT_DIR_PATTERN(.*)!$MOUNT_DIR_PATTERN!;
-    
-    (-r $LOCATEDB) || 
-      die("The file: $LOCATEDB, must exists and be readable.");
-
-    my ($mtime) = stat($LOCATEDB)->mtime;
-    
-    $DB_UPDATE_TIME = localtime($mtime);
-  }
-
-  return 1;
-} # get_env
-
-
-# fatal errors need to be valid HTML
-
-sub fatal_error {
-  my  @error = @_;
-
-  print header;
-
-  foreach $_ (@error) {
-    print  $_;
-  }
-
-  print end_html;
-  print "\n\n\n";
-
-  die("\n");
-}
-
-
-
-
-sub print_query_page {
-
-  my @out;
-
-  push @out, start_form;  
-
-  push @out, (
-              "This page allows you to search for all packages ".
-	      "in the RPM repository which match a particular pattern.",
-	      p(),
-	     );
-
-  push @out, (
-	      
-              h3("Pattern",),
-              "Enter a valid Perl5 Pattern: ",
-              textfield(-name=>'pattern',
-                        -size=>30,),
-              p(),
-             );
-  
-  
-  push @out, (
-	      defaults(-name=>'Defaults'),
-	      submit(-name=>'Submit'),
-	      p(),
-	     );
-
-
-  push @out, (
-	      "Locate database created at: $DB_UPDATE_TIME\n",
-	      p(),
-	      "The time is now: $LOCALTIME\n",
-	      p(),
-	     );
-
-  push @out, ( 
-	      end_form(),
-	     );
-
-  print @out;
-
-  return ;
-}
-
-
-
-# given a pattern remove any "tainted" characters.
-
-sub clean_pattern {
-  my ($data) = @_;
-  my $out = '(none)';
-
-  # we do not allow single quotes in the pattern because of the way we
-  # invoke perllocate.  If we allowed \' then users could introduce
-  # strings like "'; rm -rf /' echo 'done".  Unfortunatly we can not
-  # be too strict about other characters because most characters are
-  # needed to specify regular expressions.
-
-  $data =~ s/\'//g;
-
-  if ( $data =~ m/(.*)/ ) {
-    $out = $1;
-  }
-  return $out;
-}
-
-
-
-# show the results of running perllocate on the chosen pattern.
-
-sub print_perllocate {
-  my($pattern, @args) = @_;
-
-  $pattern =~ s/\'/\\\'/g;
-
-  my $cmd = ( 
-	     "perllocate -d $LOCATEDB '$pattern' 2>&1 ".
-	     " | sed -e 's!.*$MOUNT_DIR_PATTERN!$DISPLAY_PREFIX!' ".
-	     " | grep '$FILES_TO_DISPLAY_PATTERN' ".
-	    "");
-
-  print $cmd, p();
-
-  my $result = "\n".qx{$cmd}."\n";
-
-  print pre($result);
-
-  return ;
-}
-
-
-#       Main        
-{
-
-  set_static_vars();
-  get_env();
-
-  my ($pattern) = clean_pattern(param("pattern"));
-
-  my (@perllocate_args) = param("perllocate arguments");
-  @perllocate_args = split(/\s+/, 
-			   '--'.(join(" --", @perllocate_args)));
-  push @perllocate_args, '--';
- 
-  
-  print (
-	 header(),
-	 start_html(-title=>"perllocate"),
-	 h2({-align=>'CENTER'},"perllocate"),
-	 p(),
-	);
-
-
-  if (param("Help Screen")) {
-
-    usage();
-
-  } elsif ( grep {/^(\-\-)((help)|(version))$/} @perllocate_args ) {
-       
-    print_perllocate(@perllocate_args);
-
-  } else {
- 
-    print_query_page();
-
-      ($pattern) &&
-	print_perllocate($pattern);
-
-  }
-
-  print (
-	 end_html(),
-	 "\n\n\n",
-	);
-
-
-  exit 0;
-}
-