#!/home1/mikedlr/bin/perl -w
#!/usr/bin/perl -w
=head1 NAME
database-edit - edit the link databse
=head1 SYNOPSIS
database-edit [options] [link-database-filename]
=head1 DESCRIPTION
This program provides a very simple interface for editing Link
Databases. It simply allows the loading of any link in the database
based on the url and then setting of values in that link.
=head1 COMMANDS
=head2 Link
B<link> I<url>
The link with the given url is retrieved and becomes the current link
to edit. The link is printed. With no argument, the current link is
printed.
=head2 Key
B<key> I<string>
The given key becomes the current key for editing. With no value the
current key is printed.
=head2 Value
B<value> I<perlcode>
The current key is given the value value.
=head2
=cut
require 5.001;
use strict;
use Fcntl;
use DB_File;
use Data::Dumper;
use MLDBM qw(DB_File); #chosen over GDBM for network byte order.
#use MLDBM;
use URI;
use WWW::Link;
use vars qw($olddbm $linkdbm);
##############################################################################
#start command line processing
use Getopt::Function qw(maketrue makevalue);
$::old_database=undef;
$::opthandler = new Getopt::Function
[ "version V>version",
"usage h>usage help>usage",
"help-opt=s",
"verbose:i v>verbose",
"",
"old-database=s o>old-database",
], {
"old-database" => [ \&makevalue,
"Copy links from given old database file.",
"FILENAME" ],
};
$::opthandler->std_opts;
$::opthandler->check_opts;
sub usage() {
print <<'EOF';
copy-list.pl [options] link_database_file list_of_links
EOF
$::opthandler->list_opts;
print <<'EOF';
Copy the links given in the list_of_links file (or STDIN) to the new
version of the database, renaming the old version by appending .bak
(unless the -o option is used).
EOF
}
sub version() {
print <<'EOF';
copy-list version
$Id: database-edit.pl.idea,v 1.3 2002/01/02 22:53:15 mikedlr Exp $
EOF
}
die "missing argument, giving up try --help for usage info\n" unless @ARGV;
$::links=shift;
##############################################################################
#end command line processing
#If your filesystem can't cope with long names REPLACE IT. Same goes
#for the operating system.
$::old_data=0;
if ($::old_database) {
$::olddbm = tie ( %::old_links, "MLDBM", $::old_database, O_RDONLY,
0666, $DB_HASH )
or die "old links failed: $!";
} else {
#calmly and casually trash any similarly named files .. oh hell #FIXME
#and feel really superior and moral if you wish.
rename $::links, $::links . '.bak'
and ( $::olddbm = tie ( %::old_links, "MLDBM", $::links . '.bak' ,
O_RDONLY, 0666, $DB_HASH )
or die "old links failed: $!" )
and $::old_data=1;
}
# FIXME what checks and safety should we have about permissions and
# validity of old database.
$::linkdbm = tie %::links, "MLDBM", $::links, O_CREAT|O_RDWR, 0666, $DB_HASH
or die $!;
URLLINE: while ( <> ) {
chomp;
my $url=$_;
print STDERR "acting on $url\n"
if $::verbose & 4;
unless ( defined $::links{$url} ) {
if ( $::old_data && defined $::old_links{$url} ) {
$::links{$url}=$::old_links{$url};
next URLLINE;
}
my $newlink=new WWW::Link $url;
$::links{$url}=$newlink;
}
}