Links

#!/usr/bin/perl -w # # Program by Bruno Veldeman # # Copyright (c) 2001 # All rights reserved # # linkpagegen.pl # 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.veldeman@veldemanvalls.com # use strict; use Socket; #use Benchmark; use HTTP::Request; use LWP::UserAgent; my($line,$state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$date,$cat,$buffer); my(%postinputs); my($datafile,$datadir); $datadir = "/var/www/serverinfo/data/"; $datafile = "links.txt"; 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{ # 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"); # Fill the table with data open(LINKS,"<$datadir$datafile"); while ( not eof(LINKS)){ $line = ; #Split the line in vars ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$date,$cat) = split(/\t/,$line); if ( "$state" eq "A") { print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); print("\n"); print(''); 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"); } 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('Fecha'); print("\n"); print('	'); print("\n"); print('Tiempos de respuesta'); print("\n"); print('
'); print("\n"); print(''); print("$name, $descr"); print("\n"); print('	'); print("\n"); print(''); print("$URL"); print("\n"); print('	'); print("\n"); ratprn ($rating); print("\n"); print('	'); print("\n"); print("$date"); print("\n"); print('	'); print("\n"); print("$restime"); 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("$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('

by Bruno Veldeman'); 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) = @_; for ( $counter = 0 ; $counter < $num ; $counter++){ 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'}) ){ 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,$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"; } if ($mon < 10) { $mon = "0$mon"; } if ($mday < 10) { $mday = "0$mday"; } if ($year > 99) { $year += 1900; } $now = "$hour\:$min\:$sec $mon/$mday/$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,$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'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\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'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\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'}\t$fields{'name'}\t$fields{'descr'}\t$fields{'URL'}\t0\t$fields{'rating'}\t0\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('

'); 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"); print(' '); print("\n"); 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"); print(' '); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print(' '); print("\n"); print('

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

'); 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 printthankyou sub checklink{ my ($url) = @_; my $ua = new LWP::UserAgent; my $request = new HTTP::Request GET => $url; my $response = $ua->request($request); print $url; print("\n"); if ( $response->is_success ){ print $response->code; print("\n"); return(1); } else { print $response->code ; print("\n"); return(0); } } sub checkall{ my (%fields) = @_; my ($line,$tempfile,$result,$t,$curcat,$now,$copy); my ($state,$who,$name,$descr,$URL,$clicks,$rating,$restime,$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,$date,$cat) = split(/\t/,$line); if ( "$state" eq "A"){ # Is active link, just check and time $result = checklink($URL); $restime = 0; if ( $result == 0 ){ $state = "I"; $restime = 1; } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\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 == 0 ){ $restime++; if ( $restime <= 5 ){ $state = "I"; } else{ $state = "B"; } } else{ $state = "A"; #$restime = timestr($t); } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\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 = timestr($t); $state = "A"; } else{ $restime++; } } print TEMP "$state\t$who\t$name\t$descr\t$URL\t$clicks\t$rating\t$restime\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); }