Hopefully a really useful mod I just did. What it does is put an extra 'report dead' link next to a link. If a link is dead, a visitor can click it. the script checks the URL, and if it concurs that the link is dead, it gets removed from the database.

Here's the story. The mod works fine. But the coding is extremely messy, and I give up on coding as soon as something works.

So, its up to someone else to tidy up this _extremely_ messy coding / package it up under your own name. would appreciate if you can leave a message in the script saying something like 'original coding by nick greer'. here we go.

deadlink.cgi, goes in ur main directory, with add.cgi, jump,cgi, etc.

then, add <a href="<%db_cgi_url%>/deadlink.cgi?<%ID%>=delete&id=<%ID%>">Report Deadlink</a> to your templates link.html

then, invent a &site_html_deadlink_failure and &site_html_deadlink_success template.

#!/usr/bin/perl

#
# deadlink.cgi
# deadlink killer version 1.
# nick greer.
#
#
# =====================================================================
#
# Required Librariers
# --------------------------------------------------------

## throw in all the stuff that we might need


use LWP::UserAgent;

eval {
($0 =~ m,(.*)/[^/]+,) && unshift (@INC, "$1"); # Get the script location: UNIX /
($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1"); # Get the script location: Windows \

require 5.001; # Make sure we have at least perl 5.001.
require "admin/links.cfg"; # Change this to full path to links.cfg if you have problems.
require "$db_lib_path/db.cgi"; # Database Routines.
require "$db_lib_path/db_utils.cgi"; # Database Support utilities.
require "$db_lib_path/admin_html.cgi"; # Admin HTML routines.
require "$db_lib_path/site_html_templates.cgi"; # Admin HTML routines.

};

if ($@) {
print "Content-type: text/plain\n\n";
print "Error including libraries: $@\n";
print "Make sure they exist, permissions are set properly, and paths are set correctly.";
exit;
}

my ($key, %delete_list, $rec_to_delete, @data, $errstr, $succstr, $output);



# ========================================================
eval { &main; }; # Trap any fatal errors so the program hopefully
if ($@) { &cgierr("fatal error: $@"); } # never produces that nasty 500 server error page.
exit; # There are only two exit calls in the script, here and in in &cgierr.
# ========================================================

sub main {
# --------------------------------------------------------

## i dunno if any of the below is needed much
$| = 1; # Flush Output Right Away

# Main Menu. Check to see what the user requested, then if he has permission for that
# request, do it. Otherwise send the user off to an unauthorized request page.
%in = &parse_form; # Get form input so we know which database to load.



# Load the database definition file and set the link url.
$in{'db'} ?
require "$db_lib_path/$in{'db'}.def" :
require "$db_lib_path/links.def";

$db_script_link_url = "$db_script_url?db=$in{'db'}";


### ok.. important stuff. get the ID= from the input and find out what the URL is

$xdb_delim = '|';
$xdelim = quotemeta($xdb_delim);


open (URL, "<$db_url_name") or &error ("unable to open url database: $db_url_name. Reason: $!");
while (<URL> ) {
(/^$in{'id'}$xdelim(.+)/o) or next;
chomp ($theurl = $1);
last;
}
close URL;



### test the URL, found in step above

#-------------------------------------------------------------------------
# Process Form

my ($key, $status);

# my $URL = ($in{'URL'});
$ua = new LWP::UserAgent;
$ua->agent("UrlScope/8.0");
$ua->timeout(12); # in seconds
$req = new HTTP::Request 'GET' => ($theurl);
$res = $ua->request($req);
if ($res->is_success) {

# the url works. dumb web surfer got it wrong.
&site_html_deadlink_failure (qq|This URL is active. Your message has not been sent.|);

# return;
}
if ($res->is_error) {
# print "Content-type: text/html\n\n";
#print "url not active. ID:$in{'id'} URL:$theurl result:$res";



# this URL really is bad. DELETE THE BAD RECORD

$rec_to_delete = 0;
foreach $key (keys %in) { # Build a hash of keys to delete.
if ($in{$key} eq "delete") {

if ($in{$key} = $in{'id'}) {
$delete_list{$key} = 1;
$rec_to_delete = 1;
}

else { &site_html_deadlink_failure (qq|stop messing around. youre messing around too much.|);
}

}
}
$rec_to_delete or (&site_html_deadlink_failure and return);

# Search the database for a record to delete.
open (DB, "<$db_file_name") or &cgierr("error in delete_records. unable to open db file: $db_file_name.\nReason: $!");
if ($db_use_flock) { flock(DB, 1); }
LINE: while (<DB> ) {
(/^#/) and ($output .= $_ and next LINE);
(/^\s*$/) and next LINE;
chomp;
@data = &split_decode($_);

$delete_list{$data[$db_key_pos]} ? # if this id is one we want to delete
($delete_list{$data[$db_key_pos]} = 0) : # then mark it deleted and don't print it to the new database.
($output .= "$_\n"); # otherwise print it.
}
close DB;

# Reprint out the database.
open (DB, ">$db_file_name") or &cgierr("error in delete_records. unable to open db file: $db_file_name.\nReason: $!");
if ($db_use_flock) {
flock(DB, 2) or &cgierr("unable to get exclusive lock on $db_file_name.\nReason: $!");
}
print DB $output;
close DB; # automatically removes file lock

# Build success/error messages.
foreach $key (keys %delete_list) {
$delete_list{$key} ? # Check to see if any items weren't deleted
($errstr .= "$key,") : # that should have been.
($succstr .= "$key,"); # For logging, we'll remember the one's we deleted.
}
chop($succstr); # Remove trailing delimeter
chop($errstr); # Remove trailing delimeter

$errstr ? # Do we have an error?
&site_html_deadlink_failure : # If so, then let's report go to the failure page
&site_html_deadlink_success; # else, everything went fine.

}







# &cgierr("Done"); # Uncomment this line for Debugging... Will tack on form variables and environment variables
# to the end of every page. Quite Useful.
}

Very nice Mod...

You should post it in the Resource Center.

Also, for creating the new template files and subs in the site_html_templates.pl file, read the FAQ in the Resource Center about adding new template files.

Regards,

------------------
Eliot Lee....
Former Handle: Eliot
* Check Resource Center
* Search Forums


[This message has been edited by AnthroRules (edited March 29, 2000).]

What if a server is temporarily down?

That's it.
I'm trying to add a small database in which a "timeout" is being set for a non available links, say +3 days. When a link is reported dead I'll like to mail the site owner and after 3 days - if the link has not been changed, I'll finally delete it.

Have to study my PERL-book first, but should I finalize that I'll post it here. If epg doesn't mind of course (BTW: cool mod). And if I finalize it ...

Denis

[This message has been edited by Denis (edited March 30, 2000).]

 
yeah, this mod isnt any good if youve got a small database and want to keep it 100% correct.

its because ive got about 3000 links and nph-verify doesnt work anymore for that size, and i really dont have the time to get mailed 50 messages a day about bad links.

so, this thing will keep the links about 90% correct ;-)

btw - if youre doing a redo of the deadlinks.cgi script which mails the owner if a link is dead to get them to check it, this might be nice:

Hello linkowner,

Link 123 appears to be dead.

<a href= "http://www.yoursite.com/dead.cgi?db=links&delete_records=1&123=delete">Click here to kill it right now</a>

dead.cgi is just admin.cgi renamed and put in the base directory where everyone can access it.

 Yikes, that sounds very dangerous if someone figures it out! All it takes is one malicious person receiving a deadlink email that's remotely familiar with cgi...

Dan

Yeah, it could be dangerous, but what if it threw the bad links into a "dead link" bucket for the admin to delete? Perhaps gets thrown into the validate bucket, with the option to delete, rather than validate or modify.

I know very little about cgi programming, but it sounds as if it would only need a new subroutine.

~Darkrose~

I saw your deadlink.cgi.Can you tell me the template files and subs in the site_html_templates.pl file!Thanks!