/[webpac2]/trunk/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

Annotation of /trunk/lib/WebPAC/Input/ISI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1303 - (hide annotations)
Sun Sep 20 19:56:33 2009 UTC (14 years, 7 months ago) by dpavlin
File size: 4198 byte(s)
implement efficiant offset

1 dpavlin 898 package WebPAC::Input::ISI;
2    
3     use warnings;
4     use strict;
5    
6     use WebPAC::Input;
7     use base qw/WebPAC::Common/;
8    
9 dpavlin 904 use Data::Dump qw/dump/;
10    
11 dpavlin 898 =head1 NAME
12    
13     WebPAC::Input::ISI - support for ISI Export Format
14    
15     =cut
16    
17 dpavlin 1209 our $VERSION = '0.03';
18 dpavlin 898
19     =head1 SYNOPSIS
20    
21     Open file in ISI export fromat
22    
23     my $input = new WebPAC::Input::ISI(
24     path => '/path/to/ISI/records.txt',
25     );
26    
27     =head1 FUNCTIONS
28    
29     =head2 new
30    
31     Returns new low-level input API object
32    
33     my $input = new WebPAC::Input::ISI(
34     path => '/path/to/ISI/records.txt'
35     filter => sub {
36     my ($l,$field_nr) = @_;
37     # do something with $l which is line of input file
38     return $l;
39     },
40     }
41    
42     Options:
43    
44     =over 4
45    
46     =item path
47    
48     path to ISI export file
49    
50     =back
51    
52     =cut
53    
54 dpavlin 901 my $subfields = {
55     'CR' => sub {
56 dpavlin 1194 my $full_cr = shift;
57     my @v = split(/, /, $full_cr);
58     my $f = { full => $full_cr };
59 dpavlin 1209 foreach ( qw/author year reference volume page doi/ ) {
60 dpavlin 901 if ( my $tmp = shift @v ) {
61     $f->{$_} = $tmp;
62     }
63     }
64     if ( $f->{author} =~ /^\*(.+)/ ) {
65     delete $f->{author};
66     $f->{institution} = $1;
67     }
68 dpavlin 1209 $f->{doi} =~ s{DOI\s+}{} if $f->{doi}; # strip DOI prefix
69 dpavlin 901 return $f;
70     },
71     };
72    
73 dpavlin 898 sub new {
74     my $class = shift;
75     my $self = {@_};
76     bless($self, $class);
77    
78     my $arg = {@_};
79    
80     my $log = $self->_get_logger();
81    
82     open( my $fh, '<', $arg->{path} ) || $log->logconfess("can't open $arg->{path}: $!");
83    
84     my ( $format, $version );
85    
86     my $line = <$fh>;
87     chomp($line);
88     if ( $line =~ /^FN\s(.+)$/) {
89     $format = $1;
90     } else {
91     $log->logdie("first line of $arg->{path} has to be FN, but is: $line");
92     }
93    
94     $line = <$fh>;
95     chomp($line);
96     if ( $line =~ /^VR\s(.+)$/) {
97     $version = $1;
98     } else {
99     $log->logdie("second line of $arg->{path} has to be VN, but is: $line");
100     }
101    
102     $log->info("opening $format $version database '$arg->{path}'");
103    
104 dpavlin 899 my $tag;
105     my $rec;
106    
107 dpavlin 1303 my $pos = 0;
108     my $offset = $self->{offset} || 0;
109     my $end_pos = 0;
110     $end_pos = $offset + $self->{limit} if $self->{limit};
111 dpavlin 1077
112 dpavlin 1303 warn "# range: $offset - $end_pos";
113 dpavlin 1287
114 dpavlin 899 while( $line = <$fh> ) {
115     chomp($line);
116     my $v;
117    
118 dpavlin 1303 if ( $line eq 'EF' ) {
119     last;
120 dpavlin 899 } elsif ( $line eq 'ER' ) {
121 dpavlin 1303 last if $end_pos && $pos >= $end_pos;
122     $pos++;
123     next if $offset && $pos < $offset;
124    
125 dpavlin 901 # join tags
126 dpavlin 1288 foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
127 dpavlin 901 $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
128     }
129 dpavlin 1287 # split on ;
130     foreach ( qw/ID SC DE/ ) {
131     $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
132     }
133 dpavlin 1303 $rec->{'000'} = [ $pos ];
134 dpavlin 899 push @{ $self->{_rec} }, $rec;
135 dpavlin 1287
136 dpavlin 899 $rec = {};
137     $line = <$fh>;
138     chomp $line;
139     $log->logdie("expected blank like in ",$arg->{path}, " +$.: $line") unless ( $line eq '' );
140 dpavlin 1303 } elsif ( $offset && $pos < $offset ) {
141     next;
142     } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
143     $tag = $1;
144     $v = $2;
145     } elsif ( $line =~ /^\s{3}(.+)$/ ) {
146     $v = $1;
147     if ( $tag eq 'CR' && $v =~ m{DOI$} ) {
148     my $doi = <$fh>;
149     chomp($doi);
150     $doi =~ s{^\s{3}}{ } || die "can't find DOI in: $doi";
151     $v .= $doi;
152     }
153    
154 dpavlin 1302 } elsif ( $line =~ m{^(\S\S)\s*$} ) {
155     warn "# $arg->{path} +$. empty |$line|\n";
156 dpavlin 899 } else {
157 dpavlin 1302 $log->logdie("can't parse +$. $arg->{path} |$line|");
158 dpavlin 899 }
159    
160 dpavlin 904 if ( defined $v ) {
161     $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};
162 dpavlin 901
163 dpavlin 904 $log->debug("$tag: ", sub { dump( $v ) });
164     push @{ $rec->{$tag} }, $v;
165     }
166 dpavlin 899
167     }
168    
169 dpavlin 1303 $self->{size} = $pos - $offset;
170    
171 dpavlin 899 $log->debug("loaded ", $self->size, " records");
172    
173 dpavlin 898 $self ? return $self : return undef;
174     }
175    
176     =head2 fetch_rec
177    
178     Return record with ID C<$mfn> from database
179    
180 dpavlin 899 my $rec = $input->fetch_rec( $mfn, $filter_coderef );
181 dpavlin 898
182     =cut
183    
184     sub fetch_rec {
185     my $self = shift;
186    
187 dpavlin 899 my ( $mfn, $filter_coderef ) = @_;
188 dpavlin 898
189 dpavlin 899 return $self->{_rec}->[$mfn-1];
190 dpavlin 898 }
191    
192    
193     =head2 size
194    
195     Return number of records in database
196    
197     my $size = $input->size;
198    
199     =cut
200    
201     sub size {
202     my $self = shift;
203 dpavlin 1077 return $self->{size};
204 dpavlin 898 }
205    
206 dpavlin 900 =head1 SEE ALSO
207    
208     L<http://isibasic.com/help/helpprn.html> is only sane source of document format which Google could find...
209 dpavlin 901
210 dpavlin 898 =head1 AUTHOR
211    
212     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
213    
214     =head1 COPYRIGHT & LICENSE
215    
216     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
217    
218     This program is free software; you can redistribute it and/or modify it
219     under the same terms as Perl itself.
220    
221     =cut
222    
223     1; # End of WebPAC::Input::ISI

  ViewVC Help
Powered by ViewVC 1.1.26