package WebPAC::Input::DBF;

use warnings;
use strict;

use WebPAC::Input;
use WebPAC::Input::Helper;
use base qw/WebPAC::Common WebPAC::Input::Helper/;
use XBase;
use Data::Dump qw/dump/;
use Encode qw/encode_utf8/;
use YAML qw/LoadFile DumpFile/;

=head1 NAME

WebPAC::Input::DBF - support for reading DBF tables

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Read data from DBF tables (do you remember Clipper applications?) and create
pseudo-MARC records from them.

 my $ll_db = new WebPAC::Input::DBF(
	path => '/path/to/database.dbf',
 );

=head1 FUNCTIONS

=head2 new

Returns new low-level input API object

  my $ll_db = new WebPAC::Input::DBF(
  	path => '/path/to/database.dbf'
	mapping_path => '/path/to/input/dbf/mapping.yml',
	filter => sub {
		my ($l,$field_nr) = @_;
		# do something with $l which is line of input file
		return $l;
	},
  }

Options:

=over 4

=item path

path to DBF file

=item mapping_path

path to mapping YAML which will be created on first run

=back

=cut

sub new {
	my $class = shift;
	my $self = {@_};
	bless($self, $class);

	my $arg = {@_};

	my $log = $self->_get_logger();

	$log->logconfess("this module requires input_config") unless ( $arg->{input_config} );

	my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!");

	my $size = $db->last_record;

	$log->info("opening DBF database '$arg->{path}' with $size records");

	my $mapping_path = $arg->{input_config}->{mapping_path} || $self->{input_config}->{mapping_path};
	my $mapping;

	if ( ! $mapping_path || ! -e $mapping_path ) {
		$log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) });

		foreach my $field ( $db->field_names ) {
			push @$mapping, { $field => { '900' => 'x' } };
		}

		my $mapping_path = $arg->{path};
		$mapping_path =~ s!^.+/([^/]+)\.dbf!$1.yml!;

		$log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path );

		DumpFile( $mapping_path, { mapping => $mapping } ) ||
			$log->logdie("can't write template file for mapping_path $mapping_path: $!");

		$log->logdie("template file for mapping_path created as $mapping_path");

	} else {
		$mapping = LoadFile( $mapping_path ) || $log->logdie("can't open $mapping_path: $!");
		$log->logdie("missing top-level mapping key in $mapping_path") unless ( $mapping->{mapping} );
		$mapping = $mapping->{mapping};
		$log->debug("using mapping from $mapping_path = ", sub { dump($mapping) });
	}

	foreach my $mfn ( 1 .. $size ) {

		my $row = $db->get_record_as_hash( $mfn );

		$log->debug("dbf row = ", sub { dump( $row ) });

		my $record = {
			'001' => [ $mfn ],
		};

		# fixme -- this *will* break given wrong structure!
		foreach my $m ( @$mapping ) {
			my $db_field = (keys %$m)[0];
			my ( $f, $sf ) = %{ $m->{$db_field} };
			push @{ $record->{$f} }, '^' . $sf . $row->{$db_field} if ( defined( $row->{$db_field} ) && $row->{$db_field} ne '' );
		}

		$self->{_rows}->{ $mfn } = $record;
		$log->debug("created row $mfn ", dump( $record ));
	}

	$self->{size} = $size;

	$self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

  my $rec = $ll_db->fetch_rec( $mfn, $filter_coderef );

=cut

sub fetch_rec {
	my $self = shift;

	my ($mfn, $filter_coderef) = @_;

	my $rec = $self->_to_hash(
		mfn => $mfn,
		row => $self->{_rows}->{$mfn},
		hash_filter => $filter_coderef,
	);

	my $log = $self->_get_logger();
	$log->debug("fetch_rec($mfn) = ", dump($rec));

	return $rec;
}

=head2 size

Return number of records in database

  my $size = $ll_db->size;

=cut

sub size {
	my $self = shift;
	return $self->{size};
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.

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

=cut

1; # End of WebPAC::Input::DBF
