home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 September / PCWorld_2000-09_cd.bin / Software / Vyzkuste / cofee / CoffeeHTML85.exe / %MAINDIR% / cgi-bin / links / links.pl < prev    next >
Encoding:
Perl Script  |  2000-07-07  |  7.1 KB  |  186 lines
  1. #!/usr/local/bin/perl
  2. ##############################################################################
  3. # Free For All Link Page        Version 2.2                                  # 
  4. # Copyright 1996 Matt Wright    mattw@worldwidemart.com                      #
  5. # Created 5/14/95               Last Modified 7/17/96                        #
  6. # Scripts Archive at:           http://www.scriptarchive.com                 #
  7. ##############################################################################
  8. #         SEE README.TXT FILE THAT CAME WITH THIS SCRIPT FOR HELP            #
  9. #   OR: Consult the Matt's Script Archive Frequently Asked Questions if you  #
  10. #   are having any problems:                                                 #
  11. #   http://www.worldwidemart.com/scripts/faq/                                #
  12. ##############################################################################
  13. # COPYRIGHT NOTICE                                                           #
  14. # Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
  15. #                                                                            #
  16. # Free For All Links may be used and modified free of charge by anyone so    #
  17. # long as this copyright notice and the comments above remain intact.  By    #
  18. # using this this code you agree to indemnify Matthew M. Wright              #
  19. # and CoffeeCup Software from any liability that might arise from it's use.  #
  20. #                                                                            #
  21. # Selling the code for this program without prior written consent is         #
  22. # expressly forbidden.  In other words, please ask first before you try and  #
  23. # make money off of my program.                                              #
  24. #                                                                            #
  25. # Obtain permission before redistributing this software over the Internet or #
  26. # in any other medium.  In all cases copyright and header must remain intact.#
  27. ##############################################################################
  28. # Define Variables
  29.  
  30. $filename = "/mnt/web/guide/worldwidemart/scripts/demos/links/links.html";
  31. $linksurl = "http://worldwidemart.com/scripts/demos/links/links.html";
  32. $linkscgi = "http://worldwidemart.com/scripts/cgi-bin/demos/links.cgi";
  33. $linkstitle = "Matt's Script Archive: Free For All Demo";
  34. $database = "/mnt/web/guide/worldwidemart/scripts/demos/links/database.txt";
  35.  
  36. # Done
  37. ##############################################################################
  38.  
  39. # Get the input
  40. read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  41.  
  42. # Split the name-value pairs
  43. @pairs = split(/&/, $buffer);
  44.  
  45. foreach $pair (@pairs) {
  46.    ($name, $value) = split(/=/, $pair);
  47.  
  48.    $value =~ tr/+/ /;
  49.    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  50.    $value =~ s/<([^>]|\n)*>//g;
  51.    $value =~ s/<//g;
  52.    $value =~ s/>//g;
  53.    $FORM{$name} = $value;
  54. }
  55.  
  56. if ($FORM{'url'} eq 'http://' || $FORM{'url'} !~ /^(f|ht)tp:\/\/\w+\.\w+/) { 
  57.    &no_url; 
  58. } 
  59. if (!($FORM{'title'})) {
  60.    &no_title;
  61. }
  62.  
  63. # Enter our tags and sections into an associative array
  64.  
  65. %sections = ("busi","Business","comp","Computers","educ","Education",
  66.          "ente","Entertainment","gove","Government",
  67.          "pers","Personal","misc","Miscellaneous");
  68.  
  69. # Suck previous link file into one big string
  70. open(FILE,"$filename");
  71. @lines = <FILE>;
  72. close(FILE);
  73.  
  74. $i=1;
  75. foreach $line (@lines) {    
  76.     if ($line =~ /\<li\>\<a href\=\"([^\"]+)\">([^<]+)<\/a>/) {
  77.         if ($FORM{'url'} eq $1) {
  78.             &repeat_url;
  79.         }
  80.         $i++;
  81.     }
  82. }
  83.  
  84. # Open Link File to Output
  85. open (FILE,">$filename");
  86.  
  87. foreach $line (@lines) { # For every line in our data
  88.  
  89.    if ($line =~ /<!--time-->/) {
  90.       @months = ('January','February','March','April','May','June',
  91.          'July','August','September','October','November','December');
  92.  
  93.       @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday',
  94.            'Friday','Saturday');
  95.  
  96.       ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
  97.       if ($sec < 10) { $sec = "0$sec"; }
  98.       if ($min < 10) { $min = "0$min"; }
  99.       if ($hour < 10) { $hour = "0$hour"; }
  100.       if ($mday < 10) { $mday = "0$mday"; }
  101.       $date = "on $days[$wday], $months[$mon] $mday, 19$year at $hour:$min:$sec";
  102.       print FILE "<!--time--><b>Last link was added $date</b><hr>\n";
  103.    }
  104.    elsif ($line =~ /<!--number-->/) {
  105.       print FILE "<!--number--><b>There are <i>$i</i> links on this ";
  106.       print FILE "page.</b><br>\n";
  107.    }
  108.    else {
  109.        print FILE $line;
  110.    }
  111.  
  112.    foreach $tag ( keys %sections) { # For every tag 
  113.       if ( ($FORM{'section'} eq $sections{$tag}) && 
  114.          ($line =~ /<!--$tag-->/) ) {
  115.  
  116.          print FILE "<li><a href=\"$FORM{'url'}\">$FORM{'title'}</a>\n"; 
  117.       }
  118.    }
  119. }
  120.  
  121. close (FILE);
  122.  
  123. # Return Link File
  124. print "Location: $linksurl\n\n";
  125.  
  126. if ($database ne '') {
  127.     open (DATABASE,">>$database");
  128.     print DATABASE "$FORM{'url'}\n";
  129.     close(DATABASE);
  130. }
  131.  
  132. sub no_url {
  133.    print "Content-type: text/html\n\n";
  134.    print "<html><head><title>ERROR: No URL</title></head>\n";
  135.    print "<body bgcolor=#FFFFFF text=#000000><center>";
  136.    print "<h1>No URL</h1></center>\n";
  137.    print "You forgot to enter a url you wanted added to the Free for ";  
  138.    print "all link page.  Another possible problem was that your link ";
  139.    print "was invalid.<p>\n";
  140.    print "<form method=POST action=\"$linkscgi\">\n";
  141.    print "<input type=hidden name=\"title\" value=\"$FORM{'title'}\">\n";
  142.    print "<input type=hidden name=\"section\""; 
  143.    print "value=\"$FORM{'section'}\">\n";
  144.    print "URL: <input type=text name=\"url\" size=50><p>\n";
  145.    print "<input type=submit> * <input type=reset>\n";
  146.    print "<hr>\n";
  147.    print "<a href=\"$linksurl\">$linkstitle</a>\n";
  148.    print "</form></body></html>\n";
  149.  
  150.    exit;
  151. }
  152.  
  153. sub no_title {
  154.    print "Content-type: text/html\n\n";
  155.    print "<html><head><title>ERROR: No Title</title></head>\n";
  156.    print "<body bgcolor=#FFFFFF text=#000000><center>";
  157.    print "<h1>No Title</h1></center>\n";
  158.    print "You forgot to enter a title you wanted added to the Free for ";
  159.    print "all link page.  Another possible problem is that you title ";
  160.    print "contained illegal characters.<p>\n";
  161.    print "<form method=POST action=\"$linkscgi\">\n";
  162.    print "<input type=hidden name=\"url\" value=\"$FORM{'url'}\">\n"; 
  163.    print "<input type=hidden name=\"section\"";
  164.    print "value=\"$FORM{'section'}\">\n";
  165.    print "TITLE: <input type=text name=\"title\" size=50><p>\n";
  166.    print "<input type=submit> * <input type=reset>\n";
  167.    print "<hr>\n";
  168.    print "<a href=\"$linksurl\">$linkstitle</a>\n";
  169.    print "</form></body></html>\n";
  170.  
  171.    exit;
  172. }
  173.  
  174. sub repeat_url {
  175.    print "Content-type: text/html\n\n";
  176.    print "<html><head><title>ERROR: Repeat URL</title></head>\n";
  177.    print "<body bgcolor=#FFFFFF text=#000000><center><h1>Repeat URL</h1></center>\n";
  178.    print "Sorry, this URL is already in the Free For All Link Page.\n";
  179.    print "You cannot add this URL to it again.  Sorry.<p>\n";
  180.    print "<a href=\"$linksurl\">$linkstitle</a>";
  181.    print "</body></html>\n";
  182.  
  183.    exit;
  184. }
  185.  
  186.