#!/usr/bin/perl
########## - Ver 2.4 - [CougaLinks] ----- ######################################################
#
#  Created by Paul Williams
#  E-Mail: paul@rainbow.nwnet.co.uk
#  http://scripts.marschall.net/
#  Created: 21 Nov 1996
#  Last Updated: 06 Apr 1998 [My birthday]
#
########## - © Copyright 1998 Cougasoft - ######################################################
#
#  About: The  redistribution or  reselling of  this code  is strictly 
#	  prohibited,  I don't  mind if you alter the  code but please
#	  give credit where credit is due ;)
#
#	  Basically, all I ask is you don't try and make a profit from
#	  this script.  If you are in the webhosting  business, please
#	  visit my website for a serverpack.
#
#  Source  [IS  NOT]  to be redistributed in any form of medium.
#
########## ------------------------------ #####################################################
#

#
########## ------------------------------ #####################################################
#
#  M  A  I  N     P  R  O  G  R  A  M
#
########## ------------------------------ #####################################################
#
  unless (do "data/cl-pref.pref" || do "cl-pref.pref")
   {
	printf("Content-type: text/plain\n\n" .
		"_________________________________________________________\n\n" .
		"-  Preferences file [cl-pref.pref] can not be found !!  -\n" .
		"-  You must upload the preference file to the same dir  -\n" .
		"-  as this .cgi  (.pl) script or to a directory called  -\n" .
                "-  data which is a subdirectory of the directory which  -\n" .
                "-  this script currently lies.\t\t\t\t-\n\n" .
                "-  If I've lost you,  just upload the pref file to the  -\n" .
                "-  same dir which this script is in :)\t\t\t-\n\n" .
                "-  Paul\t\t\t\t\t\t\t-\n" .
		"_________________________________________________________\n\n");
	exit(0);
   }
#
########## ------------------------------ #####################################################
#
########## - SORT_INFORMATION [] -------- #####################################################
#
 read(STDIN, $input, $ENV{'CONTENT_LENGTH'});

	@pairs = split(/&/, $input);

		foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);

		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ tr/;/:/;
		$value =~ s/<([^>]|\n)*>//g if ($html);

	$INPUT{$name} = $value;
 }
#
########## ------------------------------ #####################################################
#
########## - ACTION:REDIRECT [] --------- #####################################################
#
 if ($ENV{'QUERY_STRING'} =~ /direct=(.*)/i)
  {
        open(WHITWORTH, "$link_file") || &notify("500 Data Server Error", "I was not able to find the \$data file<BR>upload it to and try again<BR><BR>If this is not admin, please let him/her<BR> know about this problem.", 0);
        flock WHITWORTH, 1;
           @jaqueline = <WHITWORTH>;
	close(WHITWORTH);

	open(JANUARY, ">$link_file") || &notify("500 Data Server Error", "I was not able to write to the \$data file<BR>chmod it to 666 and try again<BR><BR>If this is not admin, please let him/her<BR> know about this problem.", 0);
   flock JANUARY, 2;
          foreach (@jaqueline)
           {
		  ($name, $url, $date, $description, $click) = split('\|DI\|');

                  if ($url eq "$1")
                   {
                        $click++;
                        printf(JANUARY "%s|DI|%s|DI|%s|DI|%s|DI|%d|DI|\n",
                                     $name, $url, $date, $description, $click);
                   }
                  else
                   {
                        printf(JANUARY "%s", $_);
                   }
           }
        close(JANUARY);

	printf("Content-type: text/html\n");
        printf("Location: %s\n\n", $1);
  }
#
########## ------------------------------ #####################################################
#
########## - ACTION:REDIRECT [] --------- #####################################################
#
 elsif ($ENV{'QUERY_STRING'} =~ /action=random/i)
  {
        open(WILLIAMS, "$link_file") || &notify("500 Data Server Error", "I was not able to find the \$data file<BR>upload it to and try again<BR><BR>If this is not admin, please let him/her<BR> know about this problem.", 0);
        flock WILLIAMS, 1;
           @andrew = <WILLIAMS>;
	close(WILLIAMS);

        srand(time ^ $$);

        $l = sprintf("%s", $andrew[rand($#andrew)]);
        ($name, $url, $date, $description, $click) = split('\|DI\|', $l);

	printf("Content-type: text/html\n");
        printf("Location: %s\n\n", $url);
  }
#
########## ------------------------------ #####################################################
#
########## - ACTION:SUBMIT_URL [] ------- #####################################################
#
 elsif ($ENV{'QUERY_STRING'} eq "action=submit-url")
  {
	&notify("500 Internal Server Error", "[BAD HTTP_REFERER !]", 2) if ($ENV{'HTTP_REFERER'} !~ /^http:\/\/$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}/);
	&missing("SITE NAME") unless $INPUT{'name'};
	&missing("URL") unless $INPUT{'url'};
	&missing("DESCRIPTION") unless $INPUT{'description'};
	&notify("501 Data Server Error", "There is a problem with the URL.", 1) if ($INPUT{'url'} !~ /^\w.*:\/\/[\w\W]+\.[\w\W]+$/);

	open (CAR_DOOR, "$link_file") || &notify("500 Internal Server Error", "I was not able to find the \$data file<BR>upload it to and try again<BR><BR>If this is not admin, please let him/her<BR> know about this problem.", 0);
   flock CAR_DOOR, 1;
	while (<CAR_DOOR>) {
		if (/$INPUT{'url'}/) {
		&notify("Link added.", "That URL has already been added.", 1);
		}
	} close(CAR_DOOR);

	&add();
	&top_html("Success !");
	&nframe("[Thank you for adding a link]<BR><BR>Please click <A HREF='$ENV{'SCRIPT_NAME'}?action=new-link'> " .
	        "h e r e</A> to view the link.");
	&bottom(1);
 }
#
########## ------------------------------ #####################################################
#
########## - ACTION:ADD-URL [] ---------- #####################################################
#
 elsif ($ENV{'QUERY_STRING'} eq "action=add-url")
  {
        $browser = sprintf("%s", $BGCOLORPG);
        $browser = sprintf("%s", $TBCOLOR) if ($ENV{'HTTP_USER_AGENT'} !~ /MSIE/);

        &top_html("Submit a URL");
	    printf("<CENTER><TABLE CELLSPACING=0 CELLPADDING=0 WIDTH='70%%' BGCOLOR='%s'>\n".
		   "<FORM METHOD=POST ACTION='%s?action=submit-url'>\n", $TBCOLOR, $ENV{'SCRIPT_NAME'});
            
            printf("<TR>\n" .
	           "<TD BGCOLOR='%s' ALIGN=RIGHT><FONT SIZE=-1><I>Please fill out all fields. </I></FONT>\n" .
	           "</TD></TR>\n\n", $browser);

            printf("<TR>\n" .
		   "<TD><FONT SIZE=-1>&nbsp;Site Name </FONT>\n" .
		   "</TD></TR>\n\n" .
	           "<TR>\n" .
		   "<TD BGCOLOR='%s'>&nbsp;<INPUT TYPE='text' SIZE='25' MAXLENGTH='60' NAME='name'>\n" .
		   "</TD></TR>\n\n", $BGCOLORPG);
            
            printf("<TR>\n" .
                   "<TD><FONT SIZE=-1>&nbsp;Site url - [http://www.yourdomain.com/] </FONT>\n" .
		   "</TD></TR>\n\n" .
	           "<TR>\n" .
		   "<TD BGCOLOR='%s'>&nbsp;<INPUT TYPE='text' SIZE='40' MAXLENGTH='250' NAME='url' VALUE='http://'>\n" .
		   "</TD></TR>\n\n", $BGCOLORPG);

	    printf("<TR>\n" .
		   "<TD><FONT SIZE=-1>&nbsp;Description - [35 words or less] </FONT>\n" .
		   "</TD></TR>\n\n" .
                   "<TR>\n" .
		   "<TD BGCOLOR='%s'>&nbsp;<TEXTAREA NAME='description' COLS='55' ROWS='7' WRAP=PHYSICAL></TEXTAREA>\n" .
		   "</TD></TR>\n\n", $BGCOLORPG);

	    printf("<TR>\n" .
		   "<TD><FONT SIZE=-1>&nbsp;</FONT>\n" .
		   "</TD></TR>\n\n" .
	           "<TR>\n" .
		   "<TD BGCOLOR='%s'>&nbsp;<INPUT TYPE='SUBMIT' VALUE='s u b m i t'><BR>\n" .
	 	   "</TD></TR>\n\n", $BGCOLORPG);

	    printf("</TABLE></CENTER>\n");
	&bottom(1);
 }
#
########## ------------------------------ #####################################################
#
########## - ACTION:MAIN [] ------------ #####################################################
#
 else
  {
        &status();
	open(BRAVO, "$link_file");
   flock BRAVO, 1;
	   if ($display == 1)    { @johnny = sort(<BRAVO>); }
           elsif ($display == 2) { @johnny = <BRAVO>; }
           else                  { @johnny = reverse(<BRAVO>); }
	close(BRAVO);

	$n = 1;
	$data = @johnny;

	if ($data == 1) {  $title = sprintf("%d link", $data); }
        else { $title = sprintf("%d links", $data); }

	&top_html("$title", 1);
           printf("<CENTER><TABLE WIDTH='60%%' >\n" .
                "<TR><TD COLSPAN='3' ALIGN=CENTER BGCOLOR='%s'><FONT SIZE=+0>%s</FONT></TD></TR>\n" .
                "\n<TR>\n" .
                "<TD ALIGN=CENTER BGCOLOR='%s' WIDTH='5%%'><FONT SIZE=-1>Number</FONT></TD>\n" .
                "<TD ALIGN=CENTER BGCOLOR='%s' WIDTH='80%%'><FONT SIZE=-1>LINK </FONT></TD>\n" .
                "<TD ALIGN=CENTER BGCOLOR='%s' WIDTH='15%%'><FONT SIZE=-1>Clicks</FONT></TD>\n",
                 $RESHADE, $CATEGORY,$TBCOLOR, $TBCOLOR, $TBCOLOR );
           printf("</TR>\n\n");

        foreach (@johnny)
	 {
		($name, $url, $date, $description, $click) = split('\|DI\|');

                   printf("<TR>\n<TD ALIGN=CENTER><FONT SIZE=-1>%d.</FONT></TD>", $n);
                   printf("<TD><FONT SIZE=-1><A HREF='%s?direct=%s'>%s</A> -<I> [%s] </I> </FONT>", $ENV{'SCRIPT_NAME'}, $url, $name, $date);
                   printf("<BR><FONT SIZE=-1>%s</FONT></TD>\n", $description);
                   printf("<TD ALIGN=CENTER><FONT SIZE=-1>%d</FONT></TD>\n\n", $click);

		$n++;
	 }

           printf("<TR>\n<TD COLSPAN='3' BGCOLOR='%s'><FONT SIZE=-1>&nbsp; </FONT></TD></TR>", $RESHADE);
           printf("</TABLE></CENTER>\n");
           printf("<CENTER><P><HR SIZE=1 WIDTH='45%%' NOSHADE><FONT SIZE=-1>Script written by Paul Williams <A HREF='http://scripts.marschall.net/'>" .
                  "CougaSoft</A></FONT></P></CENTER>");
	&bottom(1);
 }
#
########## ---------------------- #############################################################
#
#  S  U  B  R  O  U  T  I  N  E  S
#
########## - ADDITIONAL STUFF []  #############################################################
#
  sub top_html
   {
        printf("Content-type: text/html\n\n" .
	    "<!-- © Copyright 1998 Cougasoft [paul\@rainbow.nwnet.co.uk] -->\n" .
	    "<HTML>\n" .
	    "<HEAD>\n" .
	    "	 <TITLE>Cougalinks - %s</TITLE>\n" .
	    "</HEAD>\n" .
	    "<BODY TEXT='%s' BGCOLOR='%s' LINK='%s' VLINK='%s' ALINK='%s' BACKGROUND='%s'>\n\n", $_[0], $BODYTEXT, $BGCOLORPG, $LINK, $VLINK, $ALINK, $BGGIF);
       	printf("<CENTER><A HREF='http://scripts.marschall.net/'><IMG SRC='%s' BORDER='0' ></CENTER></A>\n\n", $gif) if ($my_link);
	printf("<CENTER><IMG SRC='%s'></CENTER>\n\n", $gif) if (!$my_link);

	printf("<CENTER><FONT SIZE=-1>[<A HREF='%s?action=add-url'>Add-A-Link</A>] - [<A HREF='%s'>H o m e</A>] - " .
            "[<A HREF='%s?action=random'>Random Link</A>] </FONT></CENTER><BR>", $ENV{'SCRIPT_NAME'}, $HOME, $ENV{'SCRIPT_NAME'}) if ($_[1]);
   }
#
########## ---------------------- #############################################################
#
#  S  U  B     A  D  D
#
########## - ADD [] ------------- #############################################################
#
 sub add
  {
        $INPUT{'name'} =~ s/<([^>]|\n)*>//g;
	$INPUT{'name'} =~ s/\&/\&amp\;/g;
	$INPUT{'name'} =~ s/"/\&quot\;/g;
        $INPUT{'name'} =~ s/(.)/sprintf("%s", &uppercase($1))/e;
	$INPUT{'description'} =~ s/\s/ /g;

	&date();
	$init = 0;
	$mlog = $mlog - 1;

		open(LINK, "$link_file");
      flock LINK, 1;
			@link = <LINK>;
		close(LINK);

		open(FILE, ">$link_file") || &notify("500 Internal Server Error", "I was not able to write to the \$data file<BR>chmod it to 666 and try again<BR><BR>If this is not admin, please let him/her<BR> know about this problem.", 0);
      flock FILE, 2;
                        printf(FILE "%s|DI|%s|DI|%s|DI|%s|DI|0|DI|\n", $INPUT{'name'}, $INPUT{'url'}, $date, $INPUT{'description'});
			while ($init !=$mlog) {
			printf(FILE "%s", $link[$init]);
			$init++;
			}
		close(FILE);
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     U  P  P  E  R  C  A  S  E
#
########## - UPPERCASE [] ------- #############################################################
#
 sub uppercase
  {
        $tmp = $_[0];
        $tmp =~ tr/a-z/A-Z/;

        return ($tmp);
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     D  A  T  E
#
########## - DATE [] ------------ #############################################################
#
 sub date
  {
	@days   = ('Sun','Mon','Tues','Wed','Thur','Fri','Sat');
	@months = ('Jan','Feb','Mar','Apr','May','Jun','Jul',
		   'Aug','Sept','Oct','Nov','Dec');

	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
		$hour = "0$hour" if ($hour < 10);
		$min  = "0$min"  if ($min < 10);
		$sec  = "0$sec"  if ($sec < 10);
	$year = $year + 1900;

	$date = "$months[$mon] $mday $year";
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     S  T  A  T  U  S
#
########## - STATUS [] ---------- #############################################################
#
 sub status
  {
	if (!-e "$link_file")
	 {
	    &top_html("Problema !", 0);
                printf("<BR><CENTER><TABLE CELLSPACING=0 CELLPADDING=9 >" .
                        "<TR><TD BGCOLOR='%s'><FONT SIZE=-1>" .
                        "<DT><I>Currently -</I></DT><DD>Link Data File</DD>" .
                        "<DT><I>Can not be found.</I></DT><DD>Please update location(s) in <A HREF='cl-admin.cgi'>Administration</A>.</DD>\n" .
                        "</FONT></TD>" .
                        "</TR>", $TBCOLOR);
                printf("</TABLE></CENTER>\n\n");
            &bottom(1);
         }
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     N  F  R  A  M  E
#
########## - NFRAME [] ---------- #############################################################
#
 sub nframe
  {
	printf("<BR><CENTER><TABLE CELLSPACING=0 CELLPADDING=9 >\n" .
	       " <TR>\n<TD ALIGN=CENTER BGCOLOR='$TBCOLOR'><TT>\n" .
	       " %s</TT></TD>\n </TR>\n", $_[0]);
	printf("</TABLE></CENTER>\n\n");
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     M  I  S  S  I  N  G
#
########## - MISSING [] --------- #############################################################
#
 sub missing
  {
	&top_html("Missing Field");
	&nframe("Missing Field [$_[0]]<BR> Return to the " .
	    "<a href='$ENV{'HTTP_REFERER'}'> F O R M</a> and try again.");
	&bottom(1);
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     N  O  T  I  F  Y
#
########## - NOTIFY [] ---------- #############################################################
#
 sub notify
  {
        $xtra = sprintf("<BR>Return to the <a href='%s'> F O R M</a> and try again.", $ENV{'HTTP_REFERER'}) if ($_[2] ==1);
        $xtra = sprintf("<BR>Return to my <A HREF='%s'>S  I  T  E</A> and surf on.", $HOME) if ($_[2] == 2);

        &top_html("$_[0]");
        &nframe("<TT>$_[1] $xtra</TT>");
        &bottom(1);
  }
#
########## ---------------------- #############################################################
#
#  S  U  B     B  O  T  T  O  M
#
########## - BOTTOM [] ---------- #############################################################
#
 sub bottom
  {
	printf("</BODY>\n");
	printf("</HTML>\n");
	exit(0) if ($_[0]);
  }
#
########## ---------------------- #############################################################
#
########## - EXIT(0) ------------ #############################################################
#