404 Manager

#!/usr/bin/perl ####################################################### # 404 Manager version 1.0 # # Created by: Solution Scripts # Email: solutions@solutionscripts.com # Web: http://solutionscripts.com # ####################################################### # # # COPYRIGHT NOTICE: # # Copyright 2000 Solution Scripts All Rights Reserved. # # This program is being distributed as freeware. It may be used and # modified free of charge, so long as this copyright notice, the header # above and all the footers in the program that give me credit remain # intact. Please also send me an email, and let me know # where you are using this script. # # By using this program you agree to indemnify Solution Scripts from any liability. # # Selling the code for this program without prior written consent is # expressly forbidden. Obtain permission before redistributing this # program over the Internet or in any other medium. In all cases # copyright and header must remain intact. # ###################################################### ### DATA DIRECTORY ## my $data_path = "d:/cgi-bin/free/404manager/data"; # Location you want 404 Manager data files stored in # Must be writable by the server, (chmod 666 most cases) # There will be a lot of data files. #### REMOVES 404's NOT ACTIVE AFTER THIS MANY DAYS #### ## SET HIGH IF YOU DON"T WANT IT TO AFFECT YOUR REFERERS ### my $total_day = 10; #################### # OPTIONAL OPTIONS # #################### # ALTERNATING TABLE COLORS my @colors = ('silver','Gainsboro'); ################## ## EDIT NO MORE ## use Fcntl; use AnyDBM_File; use Config; use strict; use vars qw(%INPUT); my $current_time = time(); my $time = time; (my $sec,my $min,my $hour,my $mday,my $mon,my $year,my $wday,my $yday,my $isdst) = localtime($time); $year += 1900; $mon++; my $now = "$mon.$mday.$year"; my $uri = 0; my $db = "$data_path/notfound"; print "Content-type: text/html\n\n"; if ($ENV{'QUERY_STRING'}) { my $fnfdb = $ENV{'QUERY_STRING'}; $fnfdb =~ s/\//_/g; $fnfdb =~ s/\./_/g; $db = "$data_path/$fnfdb"; $uri = 1; } my %INPUT; read(STDIN, my $buffer, $ENV{'CONTENT_LENGTH'}); my @pairs = split(/&/, $buffer); foreach my $pair (@pairs) { (my $name, my $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; if ($INPUT{$name}) { $INPUT{$name} = $INPUT{$name}.",".$value; } else { $INPUT{$name} = $value; } } my $cgiurl = $ENV{'SCRIPT_NAME'}; unless ($INPUT{'from'}) { $INPUT{'from'} =1; } unless ($INPUT{'to'}) { $INPUT{'to'} =100; $INPUT{'to'} =1000000 if $uri; } if ($INPUT{'to'} eq "all") { $INPUT{'to'} =1000000; } if ($INPUT{'today'}) { $INPUT{'from'} =1; $INPUT{'to'} =1000000; } my @filters = split(/\,/,$INPUT{'filter'}); print qq~ 404 Manager

404 Manager

~; unless ($uri) { print qq~ ~; } my $flags = O_CREAT | O_RDWR; tie(my %acc, 'AnyDBM_File', $db , $flags, 0666) || &error("Cannot open database-- $db"); my $days=0; my $months=0; my $nums = 0; my $total_count=0; my $new_count =0; my @sort =''; foreach my $key (keys %acc) { my $value = $acc{$key}; my @reffer_array = split(/\|/,$value); if ($now eq $reffer_array[5]){ $days += $reffer_array[6] } if ($mon eq $reffer_array[7]){ $months += $reffer_array[8] } $total_count = $total_count + $reffer_array[0]; my $new_count = $new_count + $reffer_array[2]; $sort[$nums] = "$reffer_array[0]||$key"; $nums++; } unless ($uri) { print qq~
$total_count Total 404 hits counted
on $nums different pages
$days today
$months this month
With $new_count since last checked

~; } else { print qq~
$total_count Total 404 hits for $ENV{'QUERY_STRING'}
from $nums different pages
$days today
$months this month
With $new_count since last checked

Rank

Hits

New

Day

Today

Month

Page URI

~; } my @sorteddata = sort {$a <=> $b } @sort; my @revsort = reverse(@sorteddata); my $color = 0; my $day; my $dayy; my $num=0; my $nnum=0; my $print_out = 0; my $print_now = ''; foreach my $line (@revsort) { my @sorted_array = split(/\|\|/,$line); my $key = @sorted_array[1]; my $value = $acc{$key}; my @reffer_array = split(/\|/,$value); $num++; if ($num == $INPUT{'from'}) { $print_out =1; } if ($INPUT{'today'}) { if ($reffer_array[4] eq $INPUT{'today_date'}) { $print_out =1; } else { $print_out =0; } } my $ffil=""; foreach my $fil(@filters) { if ($key =~ /$fil/i) { $ffil="$fil"; } } if ($ffil) { $print_now=0; } else { $print_now =1; } if ($print_out && $print_now) { print"\n" unless $uri; print"\n" if $uri; if ($color) { $color=0; } else { $color++; } } if ($num == $INPUT{'to'}) { $print_out =0; } } untie (%acc); print "

Rank	Hits	New	Day	Today	Month	Refered URL
$num	$reffer_array[0]	"; } if ($reffer_array[2]){ if ($print_out && $print_now) { print"$reffer_array[2]"; } $reffer_array[2] = 0; $nnum = $num-1; $acc{$key} = join("\\|",@reffer_array); } else { if ($print_out && $print_now) { print" - "; } } if ($print_out && $print_now) { print "	"; } if ($reffer_array[3]){ $dayy = $current_time - $reffer_array[3]; $day = $dayy / 86400; $day = int($day); if ($print_out && $print_now) { if ($day) { print "$day"; } else { print"-"; } } } else { if ($print_out && $print_now) { print "N.A."; } } if ($day > $total_day) { delete ($acc{$key}); } if ($print_out && $print_now) { print "	"; } if ($reffer_array[5] eq $now){ if ($print_out && $print_now) { print "$reffer_array[6]"; } } else { if ($print_out && $print_now) { print "0"; } } if ($print_out && $print_now) { print "	"; } if ($reffer_array[7] eq $mon){ if ($print_out && $print_now) { print "$reffer_array[8]"; } } else { if ($print_out && $print_now) { print "0"; } } if ($print_out && $print_now) { print"	$key
$key

\n"; print "

404 Manager v1.0
Free from Solution Scripts

"; exit; sub error { print qq~

Error - $_[0] - $!

Any and all problems regarding the running and using of 404 Manager
should be posted on our help forum at:
http://forum.solutionscripts.com

Solution Scripts

~; exit; } sub sort_hashs { my $x = shift; my %array = %$x; sort { $array{$b} <=> $array{$a}; } keys %array; } 1;