use DB_File;
sub mirror($) {
scalar(reverse(shift));
}
sub domainmatch($$) {
my $search = mirror(lc(shift));
my $found = mirror(lc(shift));
if ("$search." eq $found) {
return(0);
} else {
return(substr($search,0,length($found)) cmp $found);
}
}
sub urlmatch($$) {
my $search = lc(shift) . "/";
my $found = lc(shift) . "/";
if ($search eq $found) {
return(0);
} else {
return(substr($search,0,length($found)) cmp $found);
}
}
my (%url,%domain);
$DB_BTREE->{compare} = \&urlmatch;
my $url_db = tie(%url, "DB_File", "urls.db", O_CREAT|O_RDWR, 0664, $DB_BTREE)
|| die("urls.db: $!\n");
$DB_BTREE->{compare} = \&domainmatch;
my $domain_db = tie(%domain, "DB_File", "domains.db", O_CREAT|O_RDWR, 0664, $DB_BTREE)
|| die("domains.db: $!\n");
# Now you can operate on %url and %domain just as normal perl hashes:)
# Add "playboy.com" to the domainlist unless it's already there:
$domain{".playboy.com"} = "" unless(exists($domain{"playboy.com"}));
# or use the DB_File functions put, get, del and seq:
# Add "sex.com" and "dir.yahoo.com/business_and_economy/companies/sex"
# and delete "cnn.com":
$domain_db->put(".sex.com","") unless(exists($domain{"sex.com"}));
$domain_db->sync; # Seems to only sync the last change.
$domain_db->del("cnn.com") if(exists($domain{"cnn.com"}));
$domain_db->sync; # Seems to only sync the last change.
$url_db->put("xyz.com/~sex","") unless(exists($url{"xyz.com/~sex"}));
$url_db->sync; # Seems to only sync the last change.
$url_db->sync; # Seems to only sync the last change.
$domain_db->sync; # Seems to only sync the last change.
undef($url_db); # Destroy the object
undef($domain_db); # Destroy the object
untie(%url); # Sync and close the file and undef the hash
untie(%domain); # Sync and close the file and undef the hash
See the perltie(1) and DB_File(3) man pages that comes with Perl for more info.