#!/usr/local/bin/perl -w

# POD docs at bottom of file

use strict;
use Data::Stag qw(:all);
use DBIx::DBStag;
use Getopt::Long;

my $record_type;
my $unique_key;
my $dir;
my $fmt = '';
my $out;
my $help;
my $top;
my $dbname;
my $qf;
my @query = ();
my $keys;
my $reset;
my $verbose;
my $create;
my $clear;
my $newonly;
my $insertonly;
my $transaction_size;
my $all;
my $ID_DOMAIN = 'VARCHAR(255)';
GetOptions("record_type|r=s"=>\$record_type,
	   "unique_key|unique|u|k=s"=>\$unique_key,
	   "parser|format|p=s"=>\$fmt,
	   "out|o=s"=>\$out,
	   "dbname|d=s"=>\$dbname,
	   "top|t=s"=>\$top,
	   "query|q=s@"=>\@query,
	   "qf=s"=>\$qf,
	   "all|a"=>\$all,
	   "create"=>\$create,
	   "clear"=>\$clear,
	   "newonly"=>\$newonly,
	   "insertonly"=>\$insertonly,
	   "transaction_size=s"=>\$transaction_size,
	   "help|h"=>\$help,
	   "keys"=>\$keys,
	   "reset"=>\$reset,
	   "idtype=s"=>\$ID_DOMAIN,
	   "verbose|v"=>\$verbose,
	  );
if ($help) {
    system("perldoc $0");
    exit 0;
}

my $dbh = DBIx::DBStag->connect($dbname);

if ($create) {
    $dbh->do("CREATE TABLE $record_type (id $ID_DOMAIN NOT NULL PRIMARY KEY, xml TEXT NOT NULL)");
    # No index required, because it is a primary key
}
if ($clear) {
    $dbh->do("DELETE FROM $record_type");
}

my $is_store_mode = scalar(@ARGV);

$dbh->dbh->{AutoCommit} = 0 if $transaction_size;

if ($is_store_mode) {
    my $sth = 
      $dbh->prepare("INSERT INTO $record_type (id,xml) VALUES (?, ?)");
    my $sthcheck = 
      $dbh->prepare("SELECT id FROM $record_type WHERE id = ?");
    my $n=0;

    my $store_handler;
    if ($insertonly) {
	my $sth = 
	  $dbh->prepare("INSERT INTO $record_type (id,xml) VALUES (?, ?)");
	$store_handler =
	  Data::Stag->makehandler($record_type=>sub {
				      my ($self, $stag) = @_;
				      my $id = $stag->get($unique_key);
				      $sth->execute($id, $stag->xml);
				      $n++;
				      $dbh->commit if $transaction_size && $n % $transaction_size == 0;
				      return;
				  });
    }
    elsif ($newonly) {
	# don't touch existing
	$store_handler =
	  Data::Stag->makehandler($record_type=>sub {
				      my ($self, $stag) = @_;
				      my $id = $stag->get($unique_key);
				      my $ids =
					$dbh->selectcol_arrayref($sthcheck,undef,$id);
				      if (!@$ids) {
					  $sth->execute($id, $stag->xml);
					  $n++;
				      }
				      $dbh->commit if $transaction_size && $n % $transaction_size == 0;
				      return;
				  });
    }
    else {
	# default clobber mode
	my $sthupdate = 
	  $dbh->prepare("UPDATE $record_type SET xml = ? WHERE id = ?");
	$store_handler =
	  Data::Stag->makehandler($record_type=>sub {
				      my ($self, $stag) = @_;
				      my $id = $stag->get($unique_key);
				      my $ids =
					$dbh->selectcol_arrayref($sthcheck,undef,$id);
				      if (@$ids) {
					  $sthupdate->execute($stag->xml, $id);
				      }
				      else {
					  $sth->execute($id, $stag->xml);
				      }
				      $n++;
				      $dbh->commit if $transaction_size && $n % $transaction_size == 0;
				      return;
				  });
    }
    foreach my $file (@ARGV) {
	my $p;
	if ($file eq '-') {
	    $fmt ||= 'xml';
	    $p = Data::Stag->parser(-format=>$fmt, -fh=>\*STDIN);
	    $p->handler($store_handler);
	    $p->parse(-fh=>\*STDIN);
	}
	else {
	    if (!-f $file) {
		print "the file \"$file\" does not exist\n";
	    }
	    $p = Data::Stag->parser($file, $fmt);
	    $p->handler($store_handler);
	    $p->parse($file);
	}
    }
    
    $dbh->commit if $transaction_size;
}
else {  # query mode

    if ($keys) {
	my $cols =
	  $dbh->selectcol_arrayref("SELECT id FROM $record_type");
	printf "$_\n", $_ foreach (@$cols);
	exit 0;
    }

    if ($qf) {
	open(F, $qf) || die "cannot open queryfile: $qf";
	@query = map {chomp;$_} <F>;
	close(F);
    }

    my $fh;
    if ($out) {
	$fh = FileHandle->new(">$out") || die("cannot write to $out");
    }
    else {
	$fh = \*STDOUT;
    }
    if ($top) {
	print $fh "<top>\n";
    }

    if ($all) {
	my $sth =
	  $dbh->prepare("SELECT xml FROM $record_type") || die;
	$sth->execute;
	while (my $row = $sth->fetchrow_arrayref) {
	    print $fh "@$row";
	}
    }

    if (@query) {
    
	my $n_found = 0;

	my $sth = 
	  $dbh->prepare("SELECT xml FROM $record_type WHERE id = ?");
	    
	foreach my $q (@query) {
	
	    my $xmls = $dbh->selectcol_arrayref($sth, undef, $q);
	    if (!@$xmls) {
		print STDERR "Could not find a record indexed by key: \"$q\"\n";
		next;
	    }
	    if (@$xmls > 1) {
		die "assertion error $q";
	    }
	    my $xml = shift @$xmls;
	    print $fh $xml;
	    $n_found++;
	}
	if (!$n_found && !$top) {
	    print STDERR "NONE FOUND!\n";
	}
    }
    if ($top) {
	print "</$top>\n";
    }
    $fh->close if $out;
}
$dbh->disconnect;
exit 0;

__END__

=head1 NAME 

stag-ir.pl - information retrieval using a simple relational index

=head1 SYNOPSIS

  stag-ir.pl -r person -k social_security_no -d Pg:mydb myrecords.xml
  stag-ir.pl -d Pg:mydb -q 999-9999-9999 -q 888-8888-8888

=head1 DESCRIPTION

Indexes stag nodes (XML Elements) in a simple relational db structure
- keyed by ID with an XML Blob as a value

Imagine you have a very large file of data, in a stag compatible
format such as XML. You want to index all the elements of type
B<person>; each person can be uniquely identified by
B<social_security_no>, which is a direct subnode of B<person>

The first thing to do is to build the index file, which will be stored
in the database mydb

  stag-ir.pl -r person -k social_security_no -d Pg:mydb myrecords.xml

You can then use the index "person-idx" to retrieve B<person> nodes by
their social security number

  stag-ir.pl -d Pg:mydb -q 999-9999-9999 > some-person.xml

You can export using different stag formats

  stag-ir.pl -d Pg:mydb -q 999-9999-9999 -w sxpr > some-person.xml

You can retrieve multiple nodes (although these need to be rooted to
make a valid file)

  stag-ir.pl -d Pg:mydb -q 999-9999-9999 -q 888-8888-8888 -top personset

Or you can use a list of IDs from a file (newline delimited)

  stag-ir.pl -d Pg:mydb -qf my_ss_nmbrs.txt -top personset

=head2 ARGUMENTS

=head3 -d DB_NAME

This database will be used for storing the stag nodes

The name can be a logical name or DBI locator or DBStag shorthand -
see L<DBIx::DBStag>

The database must already exist

=head3 -clear

Deletes all data from the relation type (specified with B<-r>) before loading

=head3 -insertonly

Does not check if the ID in the file exists in the db - will always
attempt an INSERT (and will fail if ID already exists)

This is the fastest way to load data (only one SQL operation per node
rather than two) but is only safe if there is no existing data

(Default is clobber mode - existing data with same ID will be replaced)

=head3 -newonly

If there is already data in the specified relation in the db, and the
XML being loaded specifies an ID that is already in the db, then this
node will be ignored

(Default is clobber mode - existing data with same ID will be replaced)

=head3 -transaction_size

A commit will be performed every n UPDATEs/COMMITs (and at the end)

Default is autocommit

note that if you are using -insertonly, and you are using
transactions, and the input file contains an ID already in the
database, then the transaction will fail because this script will try
and insert a duplicate ID

=head3 -r RELATION-NAME

This is the name of the stag node (XML element) that will be stored in
the index; for example, with the XML below you may want to use the
node name B<person> and the unique key B<id>

  <person_set>
    <person>
      <id>...</id>
    </person>
    <person>
      <id>...</id>
    </person>
    ...
  </person_set>

This flag should only be used when you want to store data

=head3 -k UNIQUE-KEY

This node will be used as the unique/primary key for the data

This node should be nested directly below the node that is being
stored in the index - if it is more that one below, specify a path

This flag should only be used when you want to store data

=head3 -u UNIQUE-KEY

Synonym for B<-k>

=head3 -create

If specified, this will create a table for the relation name specified
below; you should use this the first time you index a relation

=head3 -idtype TYPE

(optional)

This is the SQL datatype for the unique key; it defaults to VARCHAR(255)

If you know that your id is an integer, you can specify INTEGER here

If your id is always a 8-character field you can do this

  -idtype 'CHAR(8)'

This option only makes sense when combined with the B<-c> option

=head3 -p PARSER

This can be the name of a stag supported format (xml, sxpr, itext) -
XML is assumed by default

It can also be a module name - this module is used to parse the input
file into a stag stream; see L<Data::Stag::BaseGenerator> for details
on writing your own parsers/event generators

This flag should only be used when you want to store data

=head3 -q QUERY-ID

Fetches the relation/node with unique key value equal to query-id

Multiple arguments can be passed by specifying -q multple times

This flag should only be used when you want to query data

=head3 -top NODE-NAME

If this is specified in conjunction with B<-q> or B<-qf> then all the
query result nodes will be nested inside a node with this name (ie
this provides a root for the resulting document tree)

=head3 -qf QUERY-FILE

This is a file of newline-seperated IDs; this is useful for querying
the index in batch

=head3 -keys

This will write a list of all primary keys in the index

=head1 SEE ALSO

L<Data::Stag>

For more complex stag to database mapping, see L<DBIx::DBStag> and the
scripts

L<stag-db.pl> use file DBM indexes

L<stag-storenode.pl> is for storing fully normalised stag trees

L<selectall_xml>

=cut