/[webpac2]/branches/Sack/lib/WebPAC/Input/ISI.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /branches/Sack/lib/WebPAC/Input/ISI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1310 by dpavlin, Mon Sep 21 19:04:14 2009 UTC revision 1311 by dpavlin, Mon Sep 21 19:36:09 2009 UTC
# Line 7  use WebPAC::Input; Line 7  use WebPAC::Input;
7  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
8    
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10    use Carp qw/confess/;
11    
12  =head1 NAME  =head1 NAME
13    
# Line 14  WebPAC::Input::ISI - support for ISI Exp Line 15  WebPAC::Input::ISI - support for ISI Exp
15    
16  =cut  =cut
17    
18  our $VERSION = '0.03';  our $VERSION = '0.04';
19    
20    our $debug = 0;
21    
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 77  sub new { Line 81  sub new {
81    
82          my $arg = {@_};          my $arg = {@_};
83    
84          my $log = $self->_get_logger();          open( my $fh, '<', $arg->{path} ) || confess "can't open $arg->{path}: $!";
   
         open( my $fh, '<', $arg->{path} ) || $log->logconfess("can't open $arg->{path}: $!");  
85    
86          my ( $format, $version );          my ( $format, $version );
87    
# Line 88  sub new { Line 90  sub new {
90          if ( $line =~ /^FN\s(.+)$/) {          if ( $line =~ /^FN\s(.+)$/) {
91                  $format = $1;                  $format = $1;
92          } else {          } else {
93                  $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";
94          }          }
95    
96          $line = <$fh>;          $line = <$fh>;
# Line 96  sub new { Line 98  sub new {
98          if ( $line =~ /^VR\s(.+)$/) {          if ( $line =~ /^VR\s(.+)$/) {
99                  $version = $1;                  $version = $1;
100          } else {          } else {
101                  $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";
102            }
103    
104            warn "I: $arg->{path} $format $version - generating record offsets\n";
105    
106            $self->{fh} = $fh;
107            $self->{record_offset} = [];
108    
109            while( $line = <$fh> ) {
110                    chomp($line);
111                    next unless $line eq 'ER';
112                    push @{ $self->{record_offset} }, tell($fh);
113                    last if $#{ $self->{record_offset} } > $self->{offset} + $self->{limit};
114          }          }
115            push @{ $self->{record_offset} }, tell($fh); # end of file
116    
117            warn "I $arg->{path} read ", tell($fh), " bytes $#{ $self->{record_offset} } records\n";
118    
119            return $self;
120    }
121    
122    
123    
124    =head2 fetch_rec
125    
126    Return record with ID C<$mfn> from database
127    
128      my $rec = $input->fetch_rec( $mfn, $filter_coderef );
129    
130    =cut
131    
132    sub fetch_rec {
133            my ( $self, $mfn, $filter_coderef ) = @_;
134    
135          $log->info("opening $format $version database '$arg->{path}'");          seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;
136    
137          my $tag;          my $tag;
138          my $rec;          my $rec;
139    
140          my $offset = $self->{offset} || 0;          my $fh = $self->{fh};
         my $limit  = $self->{limit}  || 0;  
141    
142          my $file_pos = 0;          while( my $line = <$fh> ) {
         my $end_pos  = 0;  
         $end_pos = $offset + $limit if $limit;  
   
         $self->{_rec} = [];  
           
         warn "# offset: $offset limit: $limit end: $end_pos";  
   
         while( $line = <$fh> ) {  
143                  chomp($line);                  chomp($line);
144                  my $v;                  my $v;
145    
146                  if ( $line eq 'EF' ) {                  if ( $line eq 'EF' ) {
147                          last;                          return;
148                  } elsif ( $line eq 'ER' ) {                  } elsif ( $line eq 'ER' ) {
                         $file_pos++;  
                         last if $end_pos && $file_pos > $end_pos;  
149    
150                          if ( ! $offset || $file_pos > $offset ) {                          $line = <$fh>;
151                            chomp $line;
152                            die "expected blank like in ",$self->{path}, " +$.: $line" unless $line eq '';
153    
154                                  # join tags                          # join tags
155                                  foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {                          foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
156                                          $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};                                  $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;  
157                          }                          }
158    
159                          $rec = {};                          # split on ;
160                          $line = <$fh>;                          foreach ( qw/ID SC DE/ ) {
161                          chomp $line;                                  $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
162                          $log->logdie("expected blank like in ",$arg->{path}, " +$.: $line") unless ( $line eq '' );                          }
163                  } elsif ( $offset && $file_pos < $offset ) {  
164                          next;                          $rec->{'000'} = [ $mfn ];
165                            warn "## mfn $mfn" if $debug;
166                            return $rec;
167    
168                  } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {                  } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
169                          $tag = $1;                          $tag = $1;
170                          $v = $2;                          $v = $2;
# Line 157  sub new { Line 177  sub new {
177                                  $v .= $doi;                                  $v .= $doi;
178                          }                          }
179                  } elsif ( $line =~ m{^(\S\S)\s*$} ) {                  } elsif ( $line =~ m{^(\S\S)\s*$} ) {
180                          warn "# $arg->{path} +$. empty |$line|\n";                          warn "# $self->{path} +$. empty |$line|\n";
181                  } else {                  } elsif ( $line ne '' ) {
182                          $log->logdie("can't parse +$. $arg->{path} |$line|");                          warn "E: $self->{path} +$ | can't parse |$line|";
183                  }                  }
184    
185                  if ( defined $v ) {                  if ( defined $v ) {
186                          $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};                          $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};
187    
188                          $log->debug("$tag: ", sub { dump( $v ) });                          warn "## $tag: ", sub { dump( $v ) } if $debug;
189                          push @{ $rec->{$tag} }, $v;                          push @{ $rec->{$tag} }, $v;
190                  }                  }
   
191          }          }
         $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 ) = @_;  
192    
193          $mfn -= $self->{offset} if $self->{offset};          warn "can't get full record $mfn got ", dump $rec;
194          return $self->{_rec}->[$mfn-1];          return $rec;
195  }  }
196    
197    
# Line 203  Return number of records in database Line 205  Return number of records in database
205    
206  sub size {  sub size {
207          my $self = shift;          my $self = shift;
208          $#{ $self->{_rec} } + 1;          $#{ $self->{record_offset} } - $self->{offset};
209            # no need for +1 since we record end of file as last record
210  }  }
211    
 =head1 SEE ALSO  
212    
 L<http://isibasic.com/help/helpprn.html> is only sane source of document format which Google could find...  
   
213  =head1 AUTHOR  =head1 AUTHOR
214    
215  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
216    
217  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
218    
219  Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.
220    
221  This program is free software; you can redistribute it and/or modify it  This program is free software; you can redistribute it and/or modify it
222  under the same terms as Perl itself.  under the same terms as Perl itself.
Legend:
Removed from v.1310  
changed lines
  Added in v.1311
  ViewVC Help
Powered by ViewVC 1.1.26