#!/usr/bin/perl

=head1 NAME

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

=cut

use warnings;
use strict;

our $VERSION = '0.26';

=head1 SYNOPSIS

  picaimport [options] [file]*

=head1 OPTIONS

 -help          this brief help message
 -man           show detailed documentation with examples
 -config FILE   read configuration from a file (default: picastore.conf)
 -delete        delete records instead of importing them
 -force         do not ask before deleting
 -from FILE     read files to import from a file (default: - for STDIN)
 -get           download records instead of uploading (implies -write)
 -move          remove imported files on success
 -out FILE      print import information to a file (default: - for STDIN)
 -quiet         suppress additional status messages and output
 -ppn           update with the PPN of a record if no PPN is given
 -version       print version of this script and exit
 -write         write back the resulting record

=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 (with option -move) so you do not import them twice. If options are
read from another file, you must specify PPN and filename seperated by 
space (update) or just a filename on each line. To update via command line
you must specify a PPN (with option -ppn) and a record file or state
with option -update that the PPN is taken from the record. 

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 C<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;
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, $movemode, $help, $man, $quiet, $ppnmode,
    $delete, $force, $allmode, $writemode, $version, $getmode);

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

$writemode = 1 if $getmode;

$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

if ( $getmode ) {
    *handle = *record_get;
} elsif ( $delete ) {
    *handle = *record_delete;
} else {
    *handle = *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_get {
    my $file = shift;
    my $ppn;

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

    return unless defined $file or $ppn;
    $file = '-' unless defined $file and $file ne '';

    if ( $ppnmode ) {
        my $record = readpicarecord( $file );
        $ppn = $record->ppn;
    }

    if (not $ppn) {
        print STDERR "PPN needed to get a record\n";
        return;
    }

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

    if ( $result{id} ) {
        my $writeerror = 0;
        if ( $writemode and $file ne '-' ) {
            if ( writepicarecord( $result{record}, $file ) ) {
                print OUT $result{id} . " " . $file . "\n";
            } else {
                print STDERR "Failed to write file $file\n";
                print OUT $result{id} . "\n";
            }
        } else {
            # error because no UTF-8?
            # writepicarecord( $result{record}, \*STDOUT );
            print $result{record} . "\n";
        }
    } else {
        my $err = $result{errormessage};
        $err =~ s/\n/ /gm;
        print STDERR "failed to get $ppn=$file: $err\n";
        return;
    }  
}

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

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

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

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

    my $record = readpicarecord( $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} ) {
        my $error = 0;
        if ( $writemode ) { # TODO: what if record read from STDIN?
            $error = writepicarecord( $result{record}, $file )
        } elsif( $movemode ) {
            unlink $file; # TODO: check error
        }
        if ( $error ) {
            print STDERR "Failed to write file $file\n";
            print OUT $result{id} . "\n";
        } else {
            print OUT $result{id} . " " . $file . "\n";
        }
    } else {
        my $err = $result{errormessage};
        $err =~ s/\n/ /gm;
        print STDERR "failed to $cmd $file: $err\n";
        return;
    }    
}

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

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

    # TODO: support $writemode

    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 EXAMPLES

Import the first PICA+ record in C<myrecord.pica> to the store specified in 
the default configuration file (C<picastore.conf>).

  picaimport myrecord.pica

Update record C<000073067> in the store specified in the default configuration
file with the first PICA+ record in C<myrecord.pica>.

  picaimport -conf mydb.conf 000073067=title1.pica

Get the record C<000073067> from the default store and write it to C<down.pica>

  picaimport -get 000073067=down.pica

Import the first PICA+ record in C<myrecord.pica> to the default store and
write back the resulting record to myrecord.pica.

  picaimport -write myrecord.pica

Import all files listed in C<newrecords> and delete imported files on success

  picaimport -from newrecords -move

=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!
