The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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; 
  }
}