Merge remote branch 'remotes/Sack'

Conflicts:
	bin/dump2marc.pl

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@1322 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/bin/dump2marc.pl b/bin/dump2marc.pl
index daf15cc..60546c6 100755 (executable)
--- a/bin/dump2marc.pl
+++ b/bin/dump2marc.pl
@@ -9,6 +9,7 @@ use MARC::Record;
 use Data::Dump qw(dump);
 use Encode;
 
+my $debug = 0;
 my @fields;
 
 sub parse_subfields {
@@ -38,19 +39,19 @@ while(<>) {
        } elsif ( /^\s{7}_([a-z])(.+)$/ ) {
                push @{ $fields[ $#fields ] }, $1, $2;
        } elsif ( /^$/ ) {
-               warn dump( @fields );
+               warn dump( @fields ) if $debug;
 
                my $marc = new MARC::Record;
                $marc->encoding( 'utf-8' );
                $marc->leader( $leader );
                $marc->add_fields( @fields );
 
-               warn $marc->as_formatted;
+               warn $marc->as_formatted, $/, $/;
                print $marc->as_usmarc;
 
                @fields = ();
        } else {
-               warn "IGNORED: $_\n";
+               warn "IGNORED: $_\n" if $debug;
        }
 
 }

diff --git a/bin/install-debian.sh b/bin/install-debian.sh
new file mode 100755 (executable)
index 0000000..34b99ba
--- /dev/null
+++ b/bin/install-debian.sh
@@ -0,0 +1,4 @@
+#!/bin/sh -x
+
+sudo apt-get install liblog-log4perl-perl libclass-accessor-perl libyaml-perl
+

diff --git a/lib/WebPAC/Input/ISI.pm b/lib/WebPAC/Input/ISI.pm
index bdd36bb..1a9a2de 100644 (file)
--- a/lib/WebPAC/Input/ISI.pm
+++ b/lib/WebPAC/Input/ISI.pm
@@ -7,6 +7,7 @@ use WebPAC::Input;
 use base qw/WebPAC::Common/;
 
 use Data::Dump qw/dump/;
+use Carp qw/confess/;
 
 =head1 NAME
 
@@ -14,7 +15,10 @@ WebPAC::Input::ISI - support for ISI Export Format
 
 =cut
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
+
+our $debug = 0;
+
 
 =head1 SYNOPSIS
 
@@ -51,7 +55,7 @@ path to ISI export file
 
 =cut
 
-my $subfields = {
+our $subfields = {
        'CR' => sub {
                my $full_cr = shift;
                my @v = split(/, /, $full_cr);
@@ -77,9 +81,7 @@ sub new {
 
        my $arg = {@_};
 
-       my $log = $self->_get_logger();
-
-       open( my $fh, '<', $arg->{path} ) || $log->logconfess("can't open $arg->{path}: $!");
+       open( my $fh, '<', $arg->{path} ) || confess "can't open $arg->{path}: $!";
 
        my ( $format, $version );
 
@@ -88,7 +90,7 @@ sub new {
        if ( $line =~ /^FN\s(.+)$/) {
                $format = $1;
        } else {
-               $log->logdie("first line of $arg->{path} has to be FN, but is: $line");
+               die "first line of $arg->{path} has to be FN, but is: $line";
        }
 
        $line = <$fh>;
@@ -96,55 +98,74 @@ sub new {
        if ( $line =~ /^VR\s(.+)$/) {
                $version = $1;
        } else {
-               $log->logdie("second line of $arg->{path} has to be VN, but is: $line");
+               die "second line of $arg->{path} has to be VN, but is: $line";
        }
 
-       $log->info("opening $format $version database '$arg->{path}'");
+       warn "I: $arg->{path} $format $version - generating record offsets\n";
 
-       my $tag;
-       my $rec;
+       $self->{fh} = $fh;
+       $self->{record_offset} = [];
+       $self->{offset} ||= 0;
 
-       my $offset = $self->{offset} || 0;
-       my $limit  = $self->{limit}  || 0;
+       while( $line = <$fh> ) {
+               chomp($line);
+               next unless $line eq 'ER';
+               push @{ $self->{record_offset} }, tell($fh);
+               last if $self->{limit} && $#{ $self->{record_offset} } >= $self->{limit} - 1 + $self->{offset};
+       }
+       push @{ $self->{record_offset} }, tell($fh); # end of file
 
-       my $file_pos = 0;
-       my $end_pos  = 0;
-       $end_pos = $offset + $limit if $limit;
+       warn "I $arg->{path} read ", tell($fh), " bytes $#{ $self->{record_offset} } records\n";
 
-       $self->{_rec} = [];
-       
-       warn "# offset: $offset limit: $limit end: $end_pos";
+       return $self;
+}
 
-       while( $line = <$fh> ) {
+
+
+=head2 fetch_rec
+
+Return record with ID C<$mfn> from database
+
+  my $rec = $input->fetch_rec( $mfn, $filter_coderef );
+
+=cut
+
+sub fetch_rec {
+       my ( $self, $mfn, $filter_coderef ) = @_;
+
+       seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;
+
+       my $tag;
+       my $rec;
+
+       my $fh = $self->{fh};
+
+       while( my $line = <$fh> ) {
                chomp($line);
                my $v;
 
                if ( $line eq 'EF' ) {
-                       last;
+                       return;
                } elsif ( $line eq 'ER' ) {
-                       $file_pos++;
-                       last if $end_pos && $file_pos > $end_pos;
-
-                       if ( ! $offset || $file_pos > $offset ) {
-
-                               # join tags
-                               foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
-                                       $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
-                               }
-                               # split on ;
-                               foreach ( qw/ID SC DE/ ) {
-                                       $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
-                               }
-                               $rec->{'000'} = [ $file_pos ];
-                               push @{ $self->{_rec} }, $rec;
-                       }
 
-                       $rec = {};
                        $line = <$fh>;
                        chomp $line;
-                       $log->logdie("expected blank like in ",$arg->{path}, " +$.: $line") unless ( $line eq '' );
-               } elsif ( $offset && $file_pos < $offset ) {
-                       next;
+                       die "expected blank like in ",$self->{path}, " +$.: $line" unless $line eq '';
+
+                       # join tags
+                       foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
+                               $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
+                       }
+
+                       # split on ;
+                       foreach ( qw/ID SC DE/ ) {
+                               $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
+                       }
+
+                       $rec->{'000'} = [ $mfn ];
+                       warn "## mfn $mfn" if $debug;
+                       return $rec;
+
                } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
                        $tag = $1;
                        $v = $2;
@@ -157,39 +178,21 @@ sub new {
                                $v .= $doi;
                        }
                } elsif ( $line =~ m{^(\S\S)\s*$} ) {
-                       warn "# $arg->{path} +$. empty |$line|\n";
-               } else {
-                       $log->logdie("can't parse +$. $arg->{path} |$line|");
+                       warn "# $self->{path} +$. empty |$line|\n";
+               } elsif ( $line ne '' ) {
+                       warn "E: $self->{path} +$ | can't parse |$line|";
                }
 
                if ( defined $v ) {
                        $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};
 
-                       $log->debug("$tag: ", sub { dump( $v ) });
+                       warn "## $tag: ", sub { dump( $v ) } if $debug;
                        push @{ $rec->{$tag} }, $v;
                }
-
        }
-       $log->debug("loaded ", $self->size, " records");
-
-       $self ? return $self : return undef;
-}
-
-=head2 fetch_rec
-
-Return record with ID C<$mfn> from database
-
-  my $rec = $input->fetch_rec( $mfn, $filter_coderef );
-
-=cut
-
-sub fetch_rec {
-       my $self = shift;
-
-       my ( $mfn, $filter_coderef ) = @_;
 
-       $mfn -= $self->{offset} if $self->{offset};
-       return $self->{_rec}->[$mfn-1];
+       warn "can't get full record $mfn got ", dump $rec;
+       return $rec;
 }
 
 
@@ -203,20 +206,20 @@ Return number of records in database
 
 sub size {
        my $self = shift;
-       $#{ $self->{_rec} } + 1;
+       my $size = $#{ $self->{record_offset} };
+       return 0 if $size < 0;
+       # no need for +1 since we record end of file as last record
+       return $size - $self->{offset};
 }
 
-=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.
+Copyright 2009 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.