#!/usr/bin/perl

=head1 NAME

picaimport - Import or delete PICA+ records in a L<PICA::Store>

=cut

use warnings;
use strict;
use utf8;

our $VERSION = '0.24';

=head1 SYNOPSIS

  picawebcat [options] [file]*

=head1 OPTIONS

 -config FILE   read configuration from a file (default: picastore.conf)
 -from FILE     read files to import from a file (default: - for STDIN)
 -out FILE      print import information to a file (default: - for STDIN)
 -help          brief help message
 -move          remove imported files on success
 -delete        delete records instead of importing them
 -force         do not ask before deleting
 -ppn           use the PPN of a record if no PPN is given for updating
 -quiet         suppress additional status messages and output
 -version       print version of this script and exit

=head1 DESCRIPTION 

This script can be used to import or delete PICA records in a L<PICA::Store>,
for instance via webcat (L<PICA::SOAPClient>) or into a SQLite database
(L<PICA::SQLiteStore>). By default only the first PICA record of each file
that you specify is imported. 

The PICA+ files to be imported can be specified either as command line 
parameters or listed in another file (option -from) or you type in the
file names on request. It is recommended to delete sucessfully imported
files (option -move) so you do not import them twice. To update an existing
record you must specify a PPN and a record (or with option -ppn the PPN is 
taken from the record). You must specify PPN and filename seperated by space.

On import or update picaimport prints the PPN and filename of each record
in one line - you can use this output format as input format with option
-from to later update the records.

To connect to a PICA store you must provide a config file via the -config
parameter or the PICASTORE environment variable - or name it picastore.conf
and put it in the current directory. The config file can contain all 
parameters that may be provided to the L<PICA::Store> constructor.
At least there must be one of the following parameters:

  webcat = URL
  SQLite = FILE

Other known configuration parameters include dbsid, userkey, password,
and language.

=cut

use PICA::Record qw(getrecord);
use PICA::Parser;
use PICA::Store;
use PICA::Source;
use Getopt::Long;
use Pod::Usage;
use IO::File;
use Data::Dumper;

my ($configfile, $outfile, $fromfile, $move, $help, $quiet, $ppnmode,
    $delete, $force, $allmode, $writemode, $version); # TODO: all and write

GetOptions(
    'all' => \$allmode,
    'config:s' => \$configfile,
    'from:s' => \$fromfile, 
    'out:s' => \$outfile,
    'move' => \$move,
    'delete' => \$delete,
    'ppn'  => \$ppnmode,
    'force' => \$force,
    'help|?' => \$help,
    'quiet' => \$quiet,
    'version' => \$version,
) or pod2usage(2);
pod2usage(1) if $help;
print "picaimport version $VERSION\n" and pod2usage(1)
    if $version;
pod2usage("Please provide EITHER files OR -from option")
    unless (defined $fromfile xor scalar @ARGV);

$fromfile = '-' unless defined $fromfile or @ARGV;

# Support TODO output to STDOUT *and* to a file (-verbose)
$outfile = "-" unless defined $outfile;
if ( $outfile eq '-' ) {
    *OUT = *STDOUT;
} else {
    # TODO: append to a file?
    print "Resulting mappings are written to $outfile\n" unless $quiet;
    open OUT, ">$outfile" or die("Failed to open $outfile");
}

my $store = PICA::Store->new( config => $configfile );

# TODO; print some information about this store

*handle = $delete ? *record_delete : *record_import;

if (@ARGV) {
    if ( $delete ) {
        betterask("Do you really want to delete " . @ARGV . " records?");
    } else {
        print "Importing " . @ARGV . " records\n" unless $quiet;
    }
    while (@ARGV) {
        handle(shift);
    }
} else {
    betterask("Do you really want to delete records?") if $delete;
    if ( $fromfile eq "-" ) {
        print "Please provide a filename or PPN and filename (seperated by space) each line!\n"
            unless $quiet;
        while(<STDIN>) {
            chomp;
            exit if $_ eq '';
            handle($_);
        }
    } else {
        print "Reading from $fromfile\n" unless $quiet;
        open FROM, $fromfile or die("Error opening $fromfile");
        while(<FROM>) {
            chomp;
            handle($_);
        }
    }
}

sub betterask {
    return if $force;
    print $_[0] . " Then type 'Y'!\n";
    my $answer = readline(STDIN);
    exit unless $answer =~ /^y$/i;
}

sub import_multiple {
    # TODO: import all records from a given file
}

sub delete_multiple {
    # TODO: delete all records with PPNs in a given file
}

sub record_import {
    my $file = shift;
    my $ppn;

    if ( $file =~ /^([0-9]+[0-9X])\s+(.+)$/i ) {
        ($ppn, $file) = ($1, $2);
    }

    # ignore blank lines
    return unless defined $file and $file ne '';

    my (%result, $cmd, $op);

    my $record = getrecord( $file );

    if ( not $record or $record->empty ) {
        print STDERR "Failed to read PICA+ record from $file\n";
        return;
    }

    $ppn = $record->ppn if not $ppn and $ppnmode;

    if ( $ppn ) {
        $cmd = "update";
        %result = $store->update( $ppn, $record );
    } else {
        $cmd = "create";
        %result = $store->create( $record );
    }

    if ( $result{id} ) {
        print OUT $result{id} . " " . $file . "\n";
        unlink $file if $move;
    } else {
        my $err = $result{errormessage};
        $err =~ s/\n/ /gm;
        print STDERR "failed to $cmd $file: $err\n";
    }    
}

sub record_delete {
    my $line = shift;
    return unless defined $line and $line ne '';

    my ($ppn, $file);
    if ( $line =~ /^([0-9]*[0-9X])(\s+(.+))?$/i ) {
        ($ppn, $file) = ($1, $3);
    } else {
        print STDERR "This is not a valid PPN: $line\n";
        return;
    }

    my %result = $store->delete( $ppn );

    if ( $result{id} ) {
        print OUT $result{id} . "\n"; # TODO support download on delete
    } else {
        my $err = $result{errormessage};
        $err =~ s/\n/ /gm;
        print STDERR "failed to delete $ppn: $err\n";
    }    
}

=head1 AUTHOR

Jakob Voss C<< jakob.voss@gbv.de >>

=head1 LICENSE

This script is published as Public Domain. Feel free to reuse as you like!
