#!/usr/bin/env perl
# vim:ts=8 sw=4 sts=4 ai
require v5.6.1;
use strict;
use warnings;

=head1 NAME

fv2sqlite - import a Tie::FieldVals datafile into an SQLite database.

=head1 VERSION

This describes version B<0.61> of fv2sqlite.

=cut

our $VERSION = '0.61';

=head1 SYNOPSIS

fv2sqlite --help | --manpage | --version

fv2sqlite { --match I<field>=I<pattern> } [ --match_any I<pattern> ]
[ --num_recs I<num> ] [ --start_rec I<num> ]
{ --sort_by I<field> } { --sort_numeric I<field> } { --sort_reversed I<field> }
--datafile I<datafile>
--sqlitedb I<dbfile> --table I<table>

=head1 DESCRIPTION

This script inserts a (subset of) a Tie::FieldVals datafile into
a table in an SQLite database.
The table and the database must have already been created.

=head1 OPTIONS

=over

=item --datafile I<filename>

The input data file (in Tie::FieldVals format). 

=item --help

Print help message and exit.

=item --manpage

Print the full help documentation (manual page) and exit.

=item --match I<field>=I<pattern>

Extract a subset of records from the file, by only including
those which match the given pattern for the given field.  This option
can be repeated for multiple fields.
For example:

    --match Author=Mary

will give the records for authors which contain the string "Mary".

=item --match_any I<pattern>

Extract a subset of records from the file by only including
those which match the given pattern in any field.

=item --num_recs I<n>

Extract a subset of at most n records from the collection (it may
be less).

=item --sort_by I<field>

Sort by this field.  Can be repeated to sort by multiple fields.
Thus, if one wished to sort by Author and then Title, one would give:

    --sort_by Author --sort_by Title

=item --sort_numeric I<field>

If sorting by this field, use this to alter the type of the sort, to
make it numeric.

For example:

    --sort_by SeriesOrder --sort_numeric SeriesOrder

To switch off numeric sort for a field, give the value of 0 to the
argument.

For example:
    --sort_by SeriesOrder --sort_numeric SeriesOrder=0

=item --sort_reversed I<field>

If sorting by this field, use this to alter the direction of the sort, to
make it sort reversed.

For example:
    --sort_by Author --sort_reversed Author

To switch off reversed sort for a field, give the value of 0 to the
argument.

For example:
    --sort_by Author --sort_reversed Author=0

=item --start_rec I<n>

Extract a subset of records starting from the nth record.

=item --verbose

Print informational messages.

=item --version

Print version information and exit.

=back

=head1 CONVERSION

=head2 FieldVals Format

The input data file is in the form of Field:Value pairs, with each
record separated by a line with '=' on it.

See L<Tie::FieldVals/FILE FORMAT> for more information.

=head2 SQLite

This script expects both the SQLite database and the destination
table to have already been created.  The table is expected to
have the same column names as the fields in the FieldVals file.

=head1 REQUIRES

    Getopt::Long
    Pod::Usage
    Getopt::ArgvFile
    SQLite::Work
    Tie::FieldVals
    Tie::FieldVals::Row
    Tie::FieldVals::Select

=head1 SEE ALSO

perl(1)
Getopt::Long
Getopt::ArgvFile
Pod::Usage

=cut

use Getopt::Long 2.34;
use Getopt::ArgvFile qw(argvFile);
use Pod::Usage;
use Data::Dumper;
use Tie::FieldVals;
use Tie::FieldVals::Row;
use Tie::FieldVals::Select;
use SQLite::Work;

#========================================================
# Subroutines
sub init_data ($) {
    my $data_ref = shift;

    # options
    my %default_conf = ();
    $default_conf{debug} = 0;
    $default_conf{manpage} = 0;
    $default_conf{version} = 0;
    $default_conf{verbose} = 0;
    $default_conf{datafile} = '';
    $default_conf{sort_by} = [];
    $default_conf{sort_numeric} = {};
    $default_conf{sort_reversed} = {};
    $default_conf{start_rec} = 0;
    $default_conf{num_recs} = -1;
    $default_conf{match} = {};
    $default_conf{match_any} = '';
    $data_ref->{options} = \%default_conf;
} # init_data

sub process_args ($) {
    my $data_ref = shift;

    my $ok = 1;

    argvFile(home=>1,current=>1,startupFilename=>'.fv2sqliterc');

    pod2usage(2) unless @ARGV;

    my $op = new Getopt::Long::Parser;
    $op->configure(qw(auto_version auto_help));
    $op->getoptions($data_ref->{options},
		    'verbose!',
		    'manpage',
		    'debug!',
		    'datafile=s',
		    'sort_by=s@',
		    'sort_numeric:1%',
		    'sort_reversed:1%',
		    'start_rec=i',
		    'num_recs=i',
		    'match=s%',
		    'match_any=s',
		    'sqlitedb=s',
		    'table=s',
		   ) or pod2usage(2);

    if ($data_ref->{options}->{'manpage'})
    {
	pod2usage({ -message => "$0 version $VERSION",
		    -exitval => 0,
		    -verbose => 2,
	    });
    }

    if (!$data_ref->{options}->{datafile})
    {
	pod2usage({ -message => "$0 version $VERSION: no datafile",
		    -exitval => 1,
		    -verbose => 0,
	    });
    }
    if (!$data_ref->{options}->{sqlitedb})
    {
	pod2usage({ -message => "$0 version $VERSION: no SQLite database",
		    -exitval => 1,
		    -verbose => 0,
	    });
    }
    if (!$data_ref->{options}->{table})
    {
	pod2usage({ -message => "$0 version $VERSION: no SQLite table",
		    -exitval => 1,
		    -verbose => 0,
	    });
    }

} # process_args

sub convert_file ($) {
    my $data_ref = shift;

    print STDERR "datafile: ", $data_ref->{options}->{datafile},
	" db: ", $data_ref->{options}->{sqlitedb},
	" table: ", $data_ref->{options}->{table},
	"\n" if ($data_ref->{options}->{verbose});
    if ($data_ref->{options}->{verbose}
	&& %{$data_ref->{options}->{match}})
    {
	print STDERR Data::Dumper->Dump([$data_ref->{options}->{match}],
	    [qw(match)]);
    }
    if ($data_ref->{options}->{verbose}
	&& $data_ref->{options}->{match_any})
    {
	print STDERR "match any: ", $data_ref->{options}->{match_any}, "\n";
    }
    if ($data_ref->{options}->{debug})
    {
	print STDERR Data::Dumper->Dump([$data_ref], [qw(fv2sqlite)]);
    }
    # get the records, sort them, and grab them
    my @sel_recs = ();
    Tie::FieldVals::Select::debug($data_ref->{options}->{'debug'});
    my $sel_obj;
    $sel_obj = tie @sel_recs, 'Tie::FieldVals::Select',
	datafile=>$data_ref->{options}->{'datafile'},
	selection=>$data_ref->{options}->{'match'},
	match_any=>$data_ref->{options}->{'match_any'};
    $data_ref->{_sel_recs} = \@sel_recs;
    $data_ref->{_sel_obj} = $sel_obj;
    if (@{$data_ref->{options}->{sort_by}})
    {
	$sel_obj->sort_records(
		sort_by=>$data_ref->{options}->{'sort_by'},
		sort_numeric=>$data_ref->{options}->{'sort_numeric'},
		sort_reversed=>$data_ref->{options}->{'sort_reversed'});
    }

    my $count = @sel_recs;
    print STDERR "$count records found\n" if ($data_ref->{options}->{verbose});

    my $first_rec = 0;
    if ($data_ref->{options}->{start_rec} >= 0
	and $data_ref->{options}->{start_rec} < $count)
    {
	$first_rec = $data_ref->{options}->{start_rec};
    }
    my $last_rec = $first_rec + $data_ref->{options}->{num_recs};
    if ($data_ref->{options}->{num_recs} <= 0)
    {
	$last_rec = $count;
    }
    if ($last_rec > $count)
    {
	$last_rec = $count;
    }
    if ($first_rec > $last_rec)
    {
	warn "record number $first_rec > $last_rec -- aborting\n";
	return 0;
    }
    print STDERR "records from #$first_rec to #$last_rec\n" if ($data_ref->{options}->{verbose});

    my $sq = SQLite::Work->new(database=>$data_ref->{options}->{sqlitedb});
    if (!$sq)
    {
	warn "failed to create DB object -- aborting\n";
	return 0;
    }
    if (!$sq->do_connect())
    {
	warn "failed to connect -- aborting\n";
	return 0;
    }
    for (my $i=$first_rec; $i < $last_rec; $i++)
    {
	my $vals = $sel_recs[$i];
	my $row_obj = tied %{$vals};
	if (!$sq->add_one_row(table=>$data_ref->{options}->{table},
	    add_values=>$vals))
	{
	    warn "failed to add row -- aborting\n";
	    return 0;
	}
    }
    $sq->do_disconnect();
    print STDERR "done!\n" if ($data_ref->{options}->{verbose});
} # convert_file

#========================================================
# Main

MAIN: {
    my %data = ();

    init_data(\%data);
    process_args(\%data);

    convert_file(\%data);
}

=head1 BUGS

Please report any bugs or feature requests to the author.

=head1 AUTHOR

    Kathryn Andersen (RUBYKAT)
    perlkat AT katspace dot com
    http://www.katspace.com

=head1 COPYRIGHT AND LICENCE

Copyright (c) 2004 by Kathryn Andersen

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

__END__
