I talked my tech into letting me post his adjustments to the script.
Instead of always reading the whole database (links.db),
set it to read only delete.db if called from the new admin link:
$db_file_name = './data/links.db';
63,72d56
my $db_delete_name;
if ($ENV{'QUERY_STRING'} =~ m/db=([a-z0-9\.]+)/) {
$db_file_name = "./data/$1";
} else {
$db_file_name = './data/links.db';
$db_delete_name = './data/delete.db';
}
Specify which status codes qualify a link to
be added to delete.db:
119,130d100
my %delete_status = (
-1, "Could not lookup server",
301, "Found, but moved",
302, "Found, but data resides under different URL (add a / ?)",
401, "Unauthorized",
403, "Forbidden",
404, "File Not found",
500, "Internal Error",
502, "Service temporarily overloaded"
);
If we're running the whole links.db, save files
which ought to be deleted into delete.db:
137,140d103
if ($db_delete_name) {
open(DELE, ">$db_delete_name") or die "could not open '$db_delete_name': $!";
}
167,171d123
if ( ($db_delete_name) && (exists $delete_status{$status}) ) {
print DELE $_, "\n";
$willdelete = 'DELETE';
}
Add the requested button to delete them directly.
This calls the same old delete function the same
way it was called before, just with fewer clicks:
173,186c125,127
if ( ($use_html) && ($db_file_name =~ m/delete\.db/) ) {
$willdelete = qq|
<form action="
http://MYSITE.com/links/admin/admin.cgi" METHOD="POST" target="_blank">
<input type="hidden" name="$id" value="delete">
<INPUT TYPE="SUBMIT" name="delete_records" VALUE="Delete">
</form>
|;
}
Also display the word "DELETE" in red if it's being added to the delete list:
189,193c130,132
if ($use_html) {
print qq|<br /><br />Checked <a href="$url" target="_blank">$id</a> - Request Failed. ($status) Message: $error. <font color="red">$willdelete</font> URL: <a href="$url" target="_blank">$url<a/><br />\n|;
} else {
print qq|Checked $id - Request Failed. ($status) Message: $error. $willdelete URL: $url\n|;
}
---
$use_html ?
print qq|Checked <a href="$url" target="_blank">$id</a> - Request Failed. Message: $error. URL: $url\n| :
print qq|Checked $id - Request Failed. Message: $error. URL: $url\n|;
Just some house keeping closing delete.db:
200,204d138
close DELE if ($db_delete_name);
Return code -1 for a DNS error, rather than no error code at all:
246,254c180
);
unless ($sock) {
if ($@ =~ /Bad hostname/) {
return -1, $@;
} else {
return undef, $@;
}
}
---
) or return undef, $@;
This is the fully automatic delete routine which is NOT
being called in the current code:
265,307c191
}
sub remove_links {
# for efficiency and safety in case of IO error we'll read and write in place
my @delete_ids = @_;
my (@data, $total, $request, %seen, $status, $error, $url, $id);
open (DB, "+<$db_file_name") or &cgierr("error in verify_links. unable to open db file: $db_file_name. Reason: $!");
flock(DB,2);
my $oldh = select(DB);
$| = 1;
select($oldh);
seek(DB,0,0);
my $readpos;
my $writepos = 0;
while (<DB>) {
$readpos = tell(DB);
if ( (/^\s*$/) || (/^#/) ) {
seek(DB, $writepos, 0);
print DB $_;
$writepos = tell(DB);
next; # Skip comment lines and blank lines.
}
@data = &split_decode($_);
if ( ($data[$db_url] =~ /^http/) or ($data[$db_url] =~ /^ftp/) ) {
my $id = $data[$db_key_pos];
seek(DB, $writepos, 0);
print DB $_ unless ( grep(/^$id$/, @delete_ids) );
$writepos = tell(DB);
} else {
seek(DB, $writepos, 0);
print DB $_;
$writepos = tell(DB);
}
seek(DB, $readpos, 0);
}
truncate( DB, $writepos );
close DB;
}
---
}