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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 900 - (hide annotations)
Wed Oct 10 19:46:58 2007 UTC (16 years, 7 months ago) by dpavlin
Original Path: trunk/lib/WebPAC/Input/ISI.pm
File size: 2777 byte(s)
 r1348@llin:  dpavlin | 2007-10-10 21:46:55 +0200
 added URL to some documentation

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     =head1 NAME
10    
11     WebPAC::Input::ISI - support for ISI Export Format
12    
13     =head1 VERSION
14    
15     Version 0.00
16    
17     =cut
18    
19     our $VERSION = '0.00';
20    
21    
22     =head1 SYNOPSIS
23    
24     Open file in ISI export fromat
25    
26     my $input = new WebPAC::Input::ISI(
27     path => '/path/to/ISI/records.txt',
28     );
29    
30     =head1 FUNCTIONS
31    
32     =head2 new
33    
34     Returns new low-level input API object
35    
36     my $input = new WebPAC::Input::ISI(
37     path => '/path/to/ISI/records.txt'
38     filter => sub {
39     my ($l,$field_nr) = @_;
40     # do something with $l which is line of input file
41     return $l;
42     },
43     }
44    
45     Options:
46    
47     =over 4
48    
49     =item path
50    
51     path to ISI export file
52    
53     =back
54    
55     =cut
56    
57     sub new {
58     my $class = shift;
59     my $self = {@_};
60     bless($self, $class);
61    
62     my $arg = {@_};
63    
64     my $log = $self->_get_logger();
65    
66     open( my $fh, '<', $arg->{path} ) || $log->logconfess("can't open $arg->{path}: $!");
67    
68     my ( $format, $version );
69    
70     my $line = <$fh>;
71     chomp($line);
72     if ( $line =~ /^FN\s(.+)$/) {
73     $format = $1;
74     } else {
75     $log->logdie("first line of $arg->{path} has to be FN, but is: $line");
76     }
77    
78     $line = <$fh>;
79     chomp($line);
80     if ( $line =~ /^VR\s(.+)$/) {
81     $version = $1;
82     } else {
83     $log->logdie("second line of $arg->{path} has to be VN, but is: $line");
84     }
85    
86     $log->info("opening $format $version database '$arg->{path}'");
87    
88 dpavlin 899 my $tag;
89     my $rec;
90    
91     while( $line = <$fh> ) {
92     chomp($line);
93    
94     my $v;
95    
96     if ( $line =~ /^(\S\S)\s(.+)$/ ) {
97     $tag = $1;
98     $v = $2;
99     } elsif ( $line =~ /^\s{3}(.+)$/ ) {
100     $v = $1;
101     } elsif ( $line eq 'ER' ) {
102     push @{ $self->{_rec} }, $rec;
103     $rec = {};
104     $line = <$fh>;
105     chomp $line;
106     $log->logdie("expected blank like in ",$arg->{path}, " +$.: $line") unless ( $line eq '' );
107     } elsif ( $line eq 'EF' ) {
108     last;
109     } else {
110     $log->logdie("can't parse +$. $arg->{path} : $line");
111     }
112    
113     push @{ $rec->{$tag} }, $v;
114    
115     }
116    
117     $log->debug("loaded ", $self->size, " records");
118    
119 dpavlin 898 $self ? return $self : return undef;
120     }
121    
122     =head2 fetch_rec
123    
124     Return record with ID C<$mfn> from database
125    
126 dpavlin 899 my $rec = $input->fetch_rec( $mfn, $filter_coderef );
127 dpavlin 898
128     =cut
129    
130     sub fetch_rec {
131     my $self = shift;
132    
133 dpavlin 899 my ( $mfn, $filter_coderef ) = @_;
134 dpavlin 898
135 dpavlin 899 return $self->{_rec}->[$mfn-1];
136 dpavlin 898 }
137    
138    
139     =head2 size
140    
141     Return number of records in database
142    
143     my $size = $input->size;
144    
145     =cut
146    
147     sub size {
148     my $self = shift;
149 dpavlin 899 return $#{$self->{_rec}} + 1;
150 dpavlin 898 }
151    
152 dpavlin 900 =head1 SEE ALSO
153    
154     L<http://isibasic.com/help/helpprn.html> is only sane source of document format which Google could find...
155    
156 dpavlin 898 =head1 AUTHOR
157    
158     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
159    
160     =head1 COPYRIGHT & LICENSE
161    
162     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
163    
164     This program is free software; you can redistribute it and/or modify it
165     under the same terms as Perl itself.
166    
167     =cut
168    
169     1; # End of WebPAC::Input::ISI

  ViewVC Help
Powered by ViewVC 1.1.26