/[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 898 by dpavlin, Wed Oct 10 19:01:55 2007 UTC branches/Sack/lib/WebPAC/Input/ISI.pm revision 1312 by dpavlin, Mon Sep 21 20:05:14 2009 UTC
# Line 6  use strict; Line 6  use strict;
6  use WebPAC::Input;  use WebPAC::Input;
7  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
8    
9    use Data::Dump qw/dump/;
10    use Carp qw/confess/;
11    
12  =head1 NAME  =head1 NAME
13    
14  WebPAC::Input::ISI - support for ISI Export Format  WebPAC::Input::ISI - support for ISI Export Format
15    
 =head1 VERSION  
   
 Version 0.00  
   
16  =cut  =cut
17    
18  our $VERSION = '0.00';  our $VERSION = '0.04';
19    
20    our $debug = 0;
21    
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
# Line 54  path to ISI export file Line 55  path to ISI export file
55    
56  =cut  =cut
57    
58    my $subfields = {
59            'CR' => sub {
60                    my $full_cr = shift;
61                    my @v = split(/, /, $full_cr);
62                    my $f = { full => $full_cr };
63                    foreach ( qw/author year reference volume page doi/ ) {
64                            if ( my $tmp = shift @v ) {
65                                    $f->{$_} = $tmp;
66                            }
67                    }
68                    if ( $f->{author} =~ /^\*(.+)/ ) {
69                            delete $f->{author};
70                            $f->{institution} = $1;
71                    }
72                    $f->{doi} =~ s{DOI\s+}{} if $f->{doi}; # strip DOI prefix
73                    return $f;
74            },
75    };
76    
77  sub new {  sub new {
78          my $class = shift;          my $class = shift;
79          my $self = {@_};          my $self = {@_};
# Line 61  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 72  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 80  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          $self ? return $self : return undef;          return $self;
120  }  }
121    
122    
123    
124  =head2 fetch_rec  =head2 fetch_rec
125    
126  Return record with ID C<$mfn> from database  Return record with ID C<$mfn> from database
127    
128    my $rec = $input->fetch_rec( $mfn, $filter_coderef);    my $rec = $input->fetch_rec( $mfn, $filter_coderef );
129    
130  =cut  =cut
131    
132  sub fetch_rec {  sub fetch_rec {
133          my $self = shift;          my ( $self, $mfn, $filter_coderef ) = @_;
134    
135          my ($mfn, $filter_coderef) = @_;          seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;
136    
137            my $tag;
138          my $rec;          my $rec;
139    
140            my $fh = $self->{fh};
141    
142            while( my $line = <$fh> ) {
143                    chomp($line);
144                    my $v;
145    
146                    if ( $line eq 'EF' ) {
147                            return;
148                    } 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
155                            foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
156                                    $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
157                            }
158    
159                            # split on ;
160                            foreach ( qw/ID SC DE/ ) {
161                                    $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
162                            }
163    
164                            $rec->{'000'} = [ $mfn ];
165                            warn "## mfn $mfn" if $debug;
166                            return $rec;
167    
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 ) {
186                            $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};
187    
188                            warn "## $tag: ", sub { dump( $v ) } if $debug;
189                            push @{ $rec->{$tag} }, $v;
190                    }
191            }
192    
193            warn "can't get full record $mfn got ", dump $rec;
194          return $rec;          return $rec;
195  }  }
196    
# Line 117  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 2;          $#{ $self->{record_offset} } - $self->{offset};
209            # no need for +1 since we record end of file as last record
210  }  }
211    
212    
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.898  
changed lines
  Added in v.1312
  ViewVC Help
Powered by ViewVC 1.1.26