home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 May / Pcwk5b98.iso / WEBSERVE / SAMBAR / DATA.1 / nph-redir.pl < prev    next >
Perl Script  |  1997-07-16  |  2KB  |  66 lines
  1. #!/usr/bin/perl
  2. #
  3. # Redirection Script        Version 2.3
  4. # Created by Jeff Carnahan  jeffc@terminalp.com
  5. # Created on: 4/10/95       Last Modified on: 05/30/96 13:45 
  6. # Scripts Archive:          http://www.terminalp.com/scripts/
  7. #
  8. # Copyright (C) 1996 - Jeffrey D. Carnahan
  9. #   Copyright Information Can Be found in the attacted README file.
  10. #
  11. # ---------------------------------------------------------------------
  12. # Program Specific Quickie Notes:
  13. #     * Make Sure The First Line Is Pointing To The Correct Location Of Perl.
  14. #     * Make Sure This Program is chmodded with the permissions '755'.
  15. #     * Make Sure This Programs Name begins with 'nph-'!!
  16. #
  17. # ---------------------------------------------------------------------
  18. # ---------------------------------------------------------------------
  19. # Don't Modify Anything Past This Line Unless You Know What Your Doing!
  20. # ---------------------------------------------------------------------
  21. # ---------------------------------------------------------------------
  22. #
  23.  
  24. &GetInput;
  25. &RedirectUser;
  26.  
  27. # ---------------------------------------------------------------------
  28.  
  29. sub GetInput {
  30.  
  31.     read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  32.     @forminput = split(/&/, $buffer);
  33.     @moreinput = split(/&/, $ENV{'QUERY_STRING'});
  34.     @finalinput = (@forminput, @moreinput);
  35.     foreach (@finalinput) {
  36.         tr/+/ /;
  37.         ($name, $value) = split(/=/, $_);
  38.         $value =~ s/%(..)/pack("C", hex($1))/eg;
  39.         $name  =~ tr/A-Z/a-z/;
  40.         $in{$name}=$value;
  41.     }
  42. }
  43.  
  44. # ---------------------------------------------------------------------
  45.  
  46. sub RedirectUser {
  47.     if ($in{'dest'}) {
  48.         print "HTTP/1.0 302 Found\n";
  49.         print "Window-target: $in{'target'}\n" if ($in{'target'});
  50.         print "Location: $in{'dest'}\n\n";
  51.         exit;
  52.     } else {
  53.         print "HTTP/1.0 200 OK\n";
  54.         print "Window-target: $in{'target'}\n" if ($in{'target'});
  55.         print "Content-type: text/html\n\n";
  56.         print "<HTML><HEAD><TITLE>Error!</TITLE></HEAD><BODY BGCOLOR=\"\#FFFFFF\">\n";
  57.         print "<H1>Error!</H1>\n";
  58.         print "<P>You didn't supply information for the destination...\n";
  59.         print "</BODY></HTML>\n";
  60.         exit;
  61.     }
  62. }
  63.  
  64. # ---------------------------------------------------------------------
  65. # EOF
  66.