Links

#!/usr/bin/perl -w # # Program by Bruno Veldeman # # Copyright (c) 2001 # All rights reserved # # linkpagegen.pl # Version : 0.1.0 Beta # # A program for automated link management. # # Links are tested for correctness before adding and # are checked every x days by a cron job. (linkpagegen.pl -check) # Bad links are marked inactive. If the link is down after 5 # consecutive checks, the link will not be displayed, but still # be checked. If the links stays down for 30 more checks, the # link will be removed from the list and will be added to the # badlinks.txt file. # # This program will be released under GPL when passed the # development stage if there is any interest. # # Any sugestions to bruno@igamcenter.net # use strict; use warnings; use diagnostics; use Socket; use Benchmark; use HTTP::Request; use HTTP::Cookies; use LWP::UserAgent; my($line,$state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat,$buffer); my(%postinputs); my($datafile,$datadir,$cookiefile); # Set pname to program name, just in case anybody wants to change the name. my($pname) = "linkpagegen.pl"; #$0; $datadir = "../data/"; $datafile = "links.txt"; $cookiefile = "lwpcookies.txt"; # $pname = ; # print("$datadir$datafile"); # exit(0); if ( defined($ENV{ 'CONTENT_LENGTH'})){ read(STDIN, $buffer, $ENV{ 'CONTENT_LENGTH'} ); if ($ENV{ 'REQUEST_METHOD'} eq 'POST'){ %postinputs = readpostinput($buffer); if ( "$postinputs{'function'}" eq "addlink" ){ # add link to datafile addlink(%postinputs); } if ( "$postinputs{'function'}" eq "addlinkpage" ){ # Print add link page printaddpage(); } } } else { my (@par); @par=@ARGV; if ( defined($par[0])){ if ("$par[0]" eq "-check"){ checkall(); } } else { showlinks(); } } exit(0); sub showlinks{ # Set the date and time my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } $mon++; if ($mon < 10) { $mon = "0$mon"; } if ($mday < 10) { $mday = "0$mday"; } if ($year > 99) { $year += 1900; } # $hour\:$min\:$sec my ($now,$m1,$m2,$d1,$d2,$y1,$y2,$dif,$tag); $now = "$mday/$mon/$year"; ($d1,$m1,$y1) = split(/\//,$now); # Tel browser this is HTML print("Content-type: text/html\n\n"); # Document Headers print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('Links'); print("\n"); print(''); # Document Body print("\n"); print(''); print("\n"); print('

Links

'); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); # Fill the table with data open(LINKS,"<$datadir$datafile") or die print("Error Reading Datafile"); while ( not eof(LINKS)){ $line = ; #Split the line in vars ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat) = split(/\t/,$line); if ( "$state" eq "A") { ($d2,$m2,$y2) = split(/\//,$date); $dif = abs(($d1+$m1*30+$y1*356) - ($d2+$m2*30+$y2*356)); if ( $dif < 5 ){ $tag = ' bgcolor=#ffffff text=#777777 link=#222222 alink=#444444 vlink=#444444'; } else{ $tag = ''; } print(''); print("\n"); print(""); print("\n"); print(''); print("$name, $descr"); print("\n"); print(''); print("\n"); print(""); print("\n"); print(''); if ( length($URL) > 30){ print (substr($URL,0,30)); print ("..."); } else{ print("$URL") } print(""); print("\n"); print(''); print("\n"); print(""); print("\n"); ratprn ($rating); print("\n"); print(''); print("\n"); print(""); print("\n"); print("$lang"); print("\n"); print(''); print("\n"); print(""); print("\n"); print("$date"); print("\n"); print(''); print("\n"); print(""); print("\n"); print("$restime"); print("\n"); print(''); print("\n"); print(''); print("\n"); } if ( "$state" eq "I" ){ print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); } if ( "$state" eq "C" ){ print(''); print("\n"); print(''); print("\n"); } } close(LINKS); print('

'); print("\n"); print('Nombre y descripción'); print("\n"); print('	'); print("\n"); print('URL'); print("\n"); print('	'); print("\n"); print('Valoración'); print("\n"); print('	'); print("\n"); print('Idiomas'); print("\n"); print('	'); print("\n"); print('Fecha'); print("\n"); print('	'); print("\n"); print('Ping (s)'); print("\n"); print('
'); print("\n"); print(''); print("$name, $descr"); print("\n"); print('	'); print("\n"); print("Inactivo"); print("\n"); print('	'); print("\n"); ratprn ($rating); print("\n"); print('	'); print("\n"); print("$lang"); print("\n"); print('	'); print("\n"); print("$date"); print("\n"); print('	'); print("\n"); print("#"); print("\n"); print('
'); print("\n"); print("--- $name ---"); print("\n"); print('

'); # Document Ending print("\n"); print('

'); print("\n"); print('

...'); print("\n"); print('

'); print("\n"); print('

'); print("\n"); print(''); print("\n"); print('

'); print("\n"); print(''); print("\n"); print(''); print("\n"); return(0); } #End showlinks sub ratprn{ my ($counter); my ($num) = @_; if ( $num != 0 ){ for ( $counter = 0 ; $counter < $num ; $counter++){ print ("*"); } } else { print ("-"); } return; } #End ratprn sub readpostinput{ my (%searchField, $pair, @pairs, $value); my($buffer) = @_; @pairs = split(/&/,$buffer); foreach $pair (@pairs){ ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $searchField{ $name} = $value; } return(%searchField); } #End readpostinput sub addlink{ my (%fields) = @_; my ($name) = $fields{'who'}; if ( checklink($fields{'URL'}) != -1){ addtofile(%fields); printthankyou(%fields); } else{ printnogood(%fields); } # Code to add the link to the database return(0); } #End addlink sub addtofile{ my (%fields) = @_; my ($line,$tempfile,$result,$t,$curcat,$now,$copy,$iscat); my ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat); $tempfile = "tempfile.tmp"; # Set the date and time my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } $mon++; if ($mon < 10) { $mon = "0$mon"; } if ($mday < 10) { $mday = "0$mday"; } if ($year > 99) { $year += 1900; } # $hour\:$min\:$sec $now = "$mday/$mon/$year"; $iscat = 0; $copy = 0; open(LINKS,"$datadir$datafile"); # Open the data file open(TEMP,">$datadir$tempfile"); # Open a temp file while ( not eof(LINKS)){ $line = ; chomp($line); if ( not (substr($line,1) eq "#") ){ #Split the line in vars ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat) = split(/\t/,$line); if ( "$state" eq "C"){ # Is cat header if ($who eq $fields{'cat'}){ # Is cat of link being added $iscat = 1; } else{ if ($iscat == 1){ print TEMP "A\t$fields{'who'}-$fields{'email'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\t$fields{'lang'}\t$now\t$fields{'cat'}\n"; $copy = 1; $iscat = 0; } } print TEMP "$line\n"; } else{ if ( $iscat == 1){ if ( ("$fields{'name'}" le "$name") and ($copy == 0)){ print TEMP "A\t$fields{'who'}-$fields{'email'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\t$fields{'lang'}\t$now\t$fields{'cat'}\n"; $copy = 1; $iscat = 0; } } print TEMP "$line\n"; } } else{ print TEMP "$line\n"; } } if ( $copy eq 0){ print TEMP "A\t$fields{'who'}-$fields{'email'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\t$fields{'lang'}\t$now\t$fields{'cat'}\n"; } close(TEMP); close(LINKS); system("mv -f $datadir$tempfile $datadir$datafile"); return(0); } sub printaddpage{ my ($counter); # Tel browser this is HTML print("Content-type: text/html\n\n"); # Document Headers print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('Añadir Link'); print("\n"); print(''); print("\n"); print(''); print("\n"); print('

'); print("\n"); print('

Añadir Link

'); print("\n"); print('

Su nombre :	(Opcional)
E-mail :	(Opcional)
Nombre de la página :
Descripción corta :
Dirección :
Valoración :
Categoría :
Idiomas :

'); print("\n"); print('

'); print("\n"); print(''); print("\n"); print(''); print("\n"); return(0); } #End printaddpage sub printthankyou{ my (%fields) = @_; my ($name) = $fields{'who'}; # Tel browser this is HTML print("Content-type: text/html\n\n"); # Document Headers print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('Gracias'); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('

'); print("\n"); print(''); print("\n"); print("Gracias $name "); print("\n"); print(' '); print("\n"); print(''); print("\n"); print(' El link ya ha sido agregado a la lista.'); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' Volver a la página de links'); print("\n"); print(' '); print("\n"); print(''); print("\n"); print('

'); print("\n"); print(''); print("\n"); print(''); print("\n"); return(0); } #End printthankyou sub printnogood{ my (%fields) = @_; my ($name) = $fields{'who'}; # Tel browser this is HTML print("Content-type: text/html\n\n"); # Document Headers print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('Error'); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print('

'); print("\n"); print(''); print("\n"); print("Lo siento $name "); print("\n"); print(' '); print("\n"); print(''); print("\n"); print(' El link no es válido.'); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' Volver atras'); print("\n"); print(' '); print("\n"); print(''); print("\n"); print('

'); print("\n"); print(''); print("\n"); print(''); print("\n"); return(0); } #End printnotgood sub checklink{ my ($url) = @_; my $ua; my $request = new HTTP::Request GET => $url; my $stime = new Benchmark; my ($etime,$dtime,$time); $ua = LWP::UserAgent->new; $ua->cookie_jar(HTTP::Cookies->new(file => "$datadir$cookiefile", autosave => 1)); $ua->agent('Linkpage Generator (compatible; LPG 3.21; Red Hat Linux)'); $ua->timeout(20); my $response = $ua->request($request); $etime = new Benchmark; $dtime = timediff($etime,$stime); print "$url "; $time = $dtime->real; print "--- $time --- running on: "; if ( $response->is_success ){ print $response->server; print ("\n"); return($time); } else { return( -1 ); } } sub checkall{ my (%fields) = @_; my ($line,$tempfile,$result,$t,$curcat,$now,$copy); my ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat); $tempfile = "tempfile.tmp"; open(LINKS,"$datadir$datafile"); # Open the data file open(TEMP,">$datadir$tempfile"); # Open a temp file while ( not eof(LINKS)){ $copy = 0; $line = ; chomp($line); #Split the line in vars ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$lang,$date,$cat) = split(/\t/,$line); if ( "$state" eq "A"){ # Is active link, just check and time $result = checklink($URL); $restime = $result; if ( $result == -1 ){ $state = "I"; $restime = 1; } if ( $result == 0 ){ $restime = "<1"; } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\t$lang\t$date\t$cat\n"; } else{ if ( "$state" eq "I"){ # Is inactive link, check and increment counter if not ok $result = checklink($URL); if ( $result == -1 ){ $restime++; if ( $restime <= 5 ){ $state = "I"; } else{ $state = "B"; } } else{ $state = "A"; $restime = $result; } if ( $result == 0 ){ $restime = "<1"; } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\t$lang\t$date\t$cat\n"; } else{ if ( "$state" eq "B"){ # Is bad link, check and increment counter if not ok if ( $restime <= 10 ){ $result = checklink($URL); if ( $result == 1 ){ $restime = $result; $state = "A"; } else{ $restime++; } } if ( $result == 0 ){ $restime = "<1"; } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\t$lang\t$date\t$cat\n"; } else{ if ( "$state" eq "C"){ # Is category header, just copy print TEMP "$state\t$who\t$name\n"; } else{ # Just copy the line, must be a comment print TEMP "$line\n"; } } } } } close(TEMP); close(LINKS); system("mv -f $datadir$tempfile $datadir$datafile"); return(0); }