/[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

trunk/lib/WebPAC/Input/ISI.pm revision 1215 by dpavlin, Tue Jun 2 13:16:02 2009 UTC branches/Sack/lib/WebPAC/Input/ISI.pm revision 1312 by dpavlin, Mon Sep 21 20:05:14 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->{limit} && $#{ $self->{record_offset} } >= $self->{limit} - 1 + $self->{offset};
114          }          }
115            push @{ $self->{record_offset} }, tell($fh); # end of file
116    
117          $log->info("opening $format $version database '$arg->{path}'");          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            seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;
136    
137          my $tag;          my $tag;
138          my $rec;          my $rec;
139    
140          $self->{size} = 0;          my $fh = $self->{fh};
141    
142          while( $line = <$fh> ) {          while( my $line = <$fh> ) {
143                  chomp($line);                  chomp($line);
   
144                  my $v;                  my $v;
145    
146                  if ( $line =~ /^(\S\S)\s(.+)$/ ) {                  if ( $line eq 'EF' ) {
147                                  $tag = $1;                          return;
                                 $v = $2;  
                 } elsif ( $line =~ /^\s{3}(.+)$/ ) {  
                                 $v = $1;  
                                 if ( $tag eq 'CR' && $v =~ m{DOI$} ) {  
                                         my $doi = <$fh>;  
                                         chomp($doi);  
                                         $doi =~ s{^\s{3}}{ } || die "can't find DOI in: $doi";  
                                         $v .= $doi;  
                                 }  
148                  } elsif ( $line eq 'ER' ) {                  } elsif ( $line eq 'ER' ) {
149    
150                            $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/ ) {                          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->{$_};
157                          }                          }
158                          $rec->{'000'} = [ ++$self->{size} ];  
159                          push @{ $self->{_rec} }, $rec;                          # split on ;
160                          $rec = {};                          foreach ( qw/ID SC DE/ ) {
161                          $line = <$fh>;                                  $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
162                          chomp $line;                          }
163                          $log->logdie("expected blank like in ",$arg->{path}, " +$.: $line") unless ( $line eq '' );  
164                  } elsif ( $line eq 'EF' ) {                          $rec->{'000'} = [ $mfn ];
165                          last;                          warn "## mfn $mfn" if $debug;
166                  } else {                          return $rec;
167                          $log->logdie("can't parse +$. $arg->{path} : $line");  
168                    } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
169                            $tag = $1;
170                            $v = $2;
171                    } elsif ( $line =~ /^\s{3}(.+)$/ ) {
172                            $v = $1;
173                            if ( $tag eq 'CR' && $v =~ m{DOI$} ) {
174                                    my $doi = <$fh>;
175                                    chomp($doi);
176                                    $doi =~ s{^\s{3}}{ } || die "can't find DOI in: $doi";
177                                    $v .= $doi;
178                            }
179                    } elsif ( $line =~ m{^(\S\S)\s*$} ) {
180                            warn "# $self->{path} +$. empty |$line|\n";
181                    } elsif ( $line ne '' ) {
182                            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          }          }
192    
193          $log->debug("loaded ", $self->size, " records");          warn "can't get full record $mfn got ", dump $rec;
194            return $rec;
         $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 ) = @_;  
   
         return $self->{_rec}->[$mfn-1];  
195  }  }
196    
197    
# Line 180  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          return $self->{size};          $#{ $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.1215  
changed lines
  Added in v.1312
  ViewVC Help
Powered by ViewVC 1.1.26