package WebPAC::Input::PDF;

use warnings;
use strict;

use WebPAC::Input;
use base qw/WebPAC::Common/;

use CAM::PDF;
use Carp qw/confess/;

use Data::Dump qw/dump/;

=head1 NAME

WebPAC::Input::PDF - try to parse PDF tabular data

=head1 SYNOPSIS

Open PBF file in PDF export fromat

 my $input = new WebPAC::Input::PDF(
	path => '/path/to/file.pdf',
 );

=head1 FUNCTIONS

=head2 new

Returns new low-level input API object

  my $input = new WebPAC::Input::PDF(
  	path => '/path/to/file.pdf'
	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 PDF file

=back

=cut

my $verbose = 1;

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

	my $arg = {@_};

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

	my $file = $arg->{path} || $log->logide("need path");

	my $doc = CAM::PDF->new($file) || $log->logdie( $CAM::PDF::errstr );

	my $pages = $doc->numPages();

	$log->info("opend $file with $pages pages");

	my @lines = ();

	foreach my $p ( 1 .. $pages ) {
		my $tree = $doc->getPageContentTree($p);
		if ($tree) {
			my $out;

			confess "expect array for blocks" unless ref($tree->{blocks}) eq 'ARRAY';

			foreach my $blocks ( @{ $tree->{blocks} } ) {
				foreach my $block ( $blocks ) {
					next unless defined $block->{value};
					foreach my $value ( $block->{value} ) {
					confess "expect array for value" unless ref($value) eq 'ARRAY';
						foreach my $v ( @$value ) {
							next unless defined $v->{args};
#warn "## v ",ref($v),dump( $v );
							my @data;
							foreach my $args ( $v->{args} ) {
#warn "## args ",ref($args),dump( $args );
								confess "expect array for args" unless ref($args) eq 'ARRAY';
								foreach my $a ( @$args ) {
									if ( $a->{type} eq 'array' ) {
#warn "## a ",ref($a),dump( $a );
										foreach my $av ( @{ $a->{value} } ) {
											next unless $av->{type} eq 'string';
#warn "## av ",ref($av),dump( $av );
											push @data, $av->{value};
										}
									} elsif ( $a->{type} eq 'string' ) {
										push @data, $a->{value};
									}
								}
								next unless @data;
								warn "data $#data = ",dump(@data);
								## FIXME data specific!
								if ( $#data == 4 ) {
									push @lines, [ @data ];
								} elsif ( $#data == 0 && $#lines >= 0 ) {
									my $v = shift @data;
									warn "add $#lines to ",dump( $lines[ $#lines ]->[4] );
									$lines[ $#lines ]->[4] = $lines[ $#lines ]->[4] . ' ' . $v;
									warn "added to ",dump( $lines[ $#lines ] );
								} else {
									$log->warn("ignored: ",dump( @data ));
								}
							}
						}
					}
				}
			}
		}
	}

	$self->{_lines} = \@lines;

	$log->debug("loaded ", $self->size, " records", sub { dump( @lines ) });

	$self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

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

Records are returned as field C<A>, C<B> and so on...

Last supported column is C<ZZ>.

=cut

sub fetch_rec {
	my $self = shift;

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

	my $rec = {
		'000' => [ $mfn ],
	};

	my $line = $self->{_lines}->[ $mfn - 1 ] || return;
	confess "expected ARRAY for _lines $mfn" unless ref($line) eq 'ARRAY';

#	warn "## line = ",dump( $line );

	my $col = 'A';
	my $c = 0;
	foreach my $e ( @$line ) {
		$rec->{$col} = $e;
		$c++;
		# FIXME what about columns > ZZ
		if ( $col eq 'Z' ) {
			$col .= 'AA';
		} elsif ( $col eq 'ZZ' ) {
			$self->_get_logger()->logwarn("ignoring colums above ZZ (original ", $#$line + 1, " > $c max columns)");
			last;
		} elsif ( $col =~ m/([A-Z])Z$/ ) {
			$col .= $1++ . 'A';
		} else {
			$col++;
		}
	}

#	warn "## rec = ",dump( $rec );

	return $rec;
}


=head2 size

Return number of records in database

  my $size = $input->size;

=cut

sub size {
	my $self = shift;
	return $#{$self->{_lines}} + 1;
}

=head1 SEE ALSO

L<http://isibasic.com/help/helpprn.html> is only sane source of document format which Google could find...
 
=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::PDF
