#!/usr/bin/perl -w

=head1 NAME

B<makedb> - Makes a collection of database files from a single raw file

=head1 SYNOPSIS

B<makedb> F<rawfile> ...

Generates a bibliographic database in a series of Berkeley DB files that
come from a flat-file verion produced by the converion program C<index>,
or equivalent software.

=head1 PARAMETERS

=over

=item F<rawfile>

A raw database file, consisting of a sequence of records.  Each record
is on a separate line, and consists of a fixed series of fields, separated
by null characters.  Empty fields just have the null character (and
possibly some whitespace).

=back

=head1 DESCRIPTION

The makedb script creates a separate Berkeley DB file for each field
in the flat-file database passed as the F<rawfile> parameter.  It
generates a unique key for each record read from the flat-file database,
splits the record into the individual fields, trims off any leading
and trailing whitespace, and dispatches any non-null fields to the
appropriate DB file (using the key as an index).

=head1 WARNINGS

The names used for the DB files are fixed, and files with those names
are always removed, whether or not they were created by an earlier run
of makedb.  It requires you to have installed Berkeley DB file support,
and the version of this used by Perl should match the version used by
other applications, since the data bases produced by different versions
are I<not> compatible: see F<http://www.sleepycat.com/> for more
information on this, and to download the software.  The Perl DB_File
module can be downloaded from any CPAN site: if you don't know what this
means you should look at F<http://www.perl.com/>.

=cut

use DB_File;
use Fcntl;

my @fields = qw(
    author date title journal language subject keywords taxa places abstract
);
my %tied = ();  # hash of anonymous hashes, indexed by field name
for (@fields) {
    unlink($_);  # removes existing files with no warning!
    $tied{$_} = +{ };
    tie(%{$tied{$_}}, DB_File, $_, O_RDWR|O_CREAT, 0666, $DB_HASH);
    $@ && die "couldn't open file for $_ ($@), stopped";
}
my $recn = 0;
while (<>) {
    chop;
    my $reckey = join('', sprintf("%7d", int(++$recn)), "\0");
    my @rawfields = split(/\0/, $_);
    my $fld;
    foreach $fld (@fields) {
        last if !(@rawfields);
        my $nextval = shift(@rawfields);
        next unless ($nextval) && ($nextval =~ s/^\s*(\S.*)$/$1/);
        $nextval =~ s/^(.*\S)\s*$/$1/;
        $tied{$fld}{$reckey} = join('', $nextval, "\0");
        $@ && die "couldn't write record for $fld ($@), stopped";
    }
}
for (@fields) {
    untie(%{$tied{$_}});
    $@ && die "couldn't close file for $_ ($@), stopped";
}
