WebPAC/Input/ISI.pm

package WebPAC::Input::ISI;

use warnings;
use strict;

use WebPAC::Input;
use base qw/WebPAC::Common/;

use Data::Dump qw/dump/;
use Carp qw/confess/;

=head1 NAME

WebPAC::Input::ISI - support for ISI Export Format

=cut

our $VERSION = '0.04';

our $debug = 0;


=head1 SYNOPSIS

Open file in ISI export fromat

 my $input = new WebPAC::Input::ISI(
        path => '/path/to/ISI/records.txt',
 );

=head1 FUNCTIONS

=head2 new

Returns new low-level input API object

  my $input = new WebPAC::Input::ISI(
        path => '/path/to/ISI/records.txt'
        filter => sub {
                my ($l,$field_nr) = @_;
                # do something with $l which is line of input file
                return $l;
        },
  }

Options:

=over 4

=item path

path to ISI export file

=back

=cut

my $subfields = {
        'CR' => sub {
                my $full_cr = shift;
                my @v = split(/, /, $full_cr);
                my $f = { full => $full_cr };
                foreach ( qw/author year reference volume page doi/ ) {
                        if ( my $tmp = shift @v ) {
                                $f->{$_} = $tmp;
                        }
                }
                if ( $f->{author} =~ /^\*(.+)/ ) {
                        delete $f->{author};
                        $f->{institution} = $1;
                }
                $f->{doi} =~ s{DOI\s+}{} if $f->{doi}; # strip DOI prefix
                return $f;
        },
};

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $arg = {@_};

        open( my $fh, '<', $arg->{path} ) || confess "can't open $arg->{path}: $!";

        my ( $format, $version );

        my $line = <$fh>;
        chomp($line);
        if ( $line =~ /^FN\s(.+)$/) {
                $format = $1;
        } else {
                die "first line of $arg->{path} has to be FN, but is: $line";
        }

        $line = <$fh>;
        chomp($line);
        if ( $line =~ /^VR\s(.+)$/) {
                $version = $1;
        } else {
                die "second line of $arg->{path} has to be VN, but is: $line";
        }

        warn "I: $arg->{path} $format $version - generating record offsets\n";

        $self->{fh} = $fh;
        $self->{record_offset} = [];

        while( $line = <$fh> ) {
                chomp($line);
                next unless $line eq 'ER';
                push @{ $self->{record_offset} }, tell($fh);
                last if $#{ $self->{record_offset} } > $self->{offset} + $self->{limit};
        }
        push @{ $self->{record_offset} }, tell($fh); # end of file

        warn "I $arg->{path} read ", tell($fh), " bytes $#{ $self->{record_offset} } records\n";

        return $self;
}


=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, $mfn, $filter_coderef ) = @_;

        seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;

        my $tag;
        my $rec;

        my $fh = $self->{fh};

        while( my $line = <$fh> ) {
                chomp($line);
                my $v;

                if ( $line eq 'EF' ) {
                        return;
                } elsif ( $line eq 'ER' ) {

                        $line = <$fh>;
                        chomp $line;
                        die "expected blank like in ",$self->{path}, " +$.: $line" unless $line eq '';

                        # join tags
                        foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
                                $rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
                        }

                        # split on ;
                        foreach ( qw/ID SC DE/ ) {
                                $rec->{$_} = [ split(/;\s/, $rec->{$_}) ] if defined $rec->{$_};
                        }

                        $rec->{'000'} = [ $mfn ];
                        warn "## mfn $mfn" if $debug;
                        return $rec;

                } elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
                        $tag = $1;
                        $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;
                        }
                } elsif ( $line =~ m{^(\S\S)\s*$} ) {
                        warn "# $self->{path} +$. empty |$line|\n";
                } elsif ( $line ne '' ) {
                        warn "E: $self->{path} +$ | can't parse |$line|";
                }

                if ( defined $v ) {
                        $v = $subfields->{$tag}->($v) if defined $subfields->{$tag};

                        warn "## $tag: ", sub { dump( $v ) } if $debug;
                        push @{ $rec->{$tag} }, $v;
                }
        }

        warn "can't get full record $mfn got ", dump $rec;
        return $rec;
}


=head2 size

Return number of records in database

  my $size = $input->size;

=cut

sub size {
        my $self = shift;
        $#{ $self->{record_offset} } - $self->{offset};
        # no need for +1 since we record end of file as last record
}


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Input::ISI
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	dpavlin	1311	use Carp qw/confess/;
11	dpavlin	904
12	dpavlin	898	=head1 NAME
13
14			WebPAC::Input::ISI - support for ISI Export Format
15
16			=cut
17
18	dpavlin	1311	our $VERSION = '0.04';
19	dpavlin	898
20	dpavlin	1311	our $debug = 0;
21
22
23	dpavlin	898	=head1 SYNOPSIS
24
25			Open file in ISI export fromat
26
27			my $input = new WebPAC::Input::ISI(
28			path => '/path/to/ISI/records.txt',
29			);
30
31			=head1 FUNCTIONS
32
33			=head2 new
34
35			Returns new low-level input API object
36
37			my $input = new WebPAC::Input::ISI(
38			path => '/path/to/ISI/records.txt'
39			filter => sub {
40			my ($l,$field_nr) = @_;
41			# do something with $l which is line of input file
42			return $l;
43			},
44			}
45
46			Options:
47
48			=over 4
49
50			=item path
51
52			path to ISI export file
53
54			=back
55
56			=cut
57
58	dpavlin	901	my $subfields = {
59			'CR' => sub {
60	dpavlin	1194	my $full_cr = shift;
61			my @v = split(/, /, $full_cr);
62			my $f = { full => $full_cr };
63	dpavlin	1209	foreach ( qw/author year reference volume page doi/ ) {
64	dpavlin	901	if ( my $tmp = shift @v ) {
65			$f->{$_} = $tmp;
66			}
67			}
68			if ( $f->{author} =~ /^\*(.+)/ ) {
69			delete $f->{author};
70			$f->{institution} = $1;
71			}
72	dpavlin	1209	$f->{doi} =~ s{DOI\s+}{} if $f->{doi}; # strip DOI prefix
73	dpavlin	901	return $f;
74			},
75			};
76
77	dpavlin	898	sub new {
78			my $class = shift;
79			my $self = {@_};
80			bless($self, $class);
81
82			my $arg = {@_};
83
84	dpavlin	1311	open( my $fh, '<', $arg->{path} ) \|\| confess "can't open $arg->{path}: $!";
85	dpavlin	898
86			my ( $format, $version );
87
88			my $line = <$fh>;
89			chomp($line);
90			if ( $line =~ /^FN\s(.+)$/) {
91			$format = $1;
92			} else {
93	dpavlin	1311	die "first line of $arg->{path} has to be FN, but is: $line";
94	dpavlin	898	}
95
96			$line = <$fh>;
97			chomp($line);
98			if ( $line =~ /^VR\s(.+)$/) {
99			$version = $1;
100			} else {
101	dpavlin	1311	die "second line of $arg->{path} has to be VN, but is: $line";
102	dpavlin	898	}
103
104	dpavlin	1311	warn "I: $arg->{path} $format $version - generating record offsets\n";
105	dpavlin	898
106	dpavlin	1311	$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			seek $self->{fh}, $self->{record_offset}->[ $mfn - 1 ], 0;
136
137	dpavlin	899	my $tag;
138			my $rec;
139
140	dpavlin	1311	my $fh = $self->{fh};
141	dpavlin	1077
142	dpavlin	1311	while( my $line = <$fh> ) {
143	dpavlin	899	chomp($line);
144			my $v;
145
146	dpavlin	1303	if ( $line eq 'EF' ) {
147	dpavlin	1311	return;
148	dpavlin	899	} elsif ( $line eq 'ER' ) {
149	dpavlin	1303
150	dpavlin	1311	$line = <$fh>;
151			chomp $line;
152			die "expected blank like in ",$self->{path}, " +$.: $line" unless $line eq '';
153	dpavlin	1305
154	dpavlin	1311	# join tags
155			foreach ( qw/AB DE ID TI SO RP SC FU FX PA JI/ ) {
156			$rec->{$_} = join(' ', @{ $rec->{$_} }) if defined $rec->{$_};
157	dpavlin	901	}
158	dpavlin	1287
159	dpavlin	1311	# 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	dpavlin	1303	} elsif ( $line =~ /^(\S\S)\s(.+)$/ ) {
169	dpavlin	1305	$tag = $1;
170			$v = $2;
171	dpavlin	1303	} elsif ( $line =~ /^\s{3}(.+)$/ ) {
172	dpavlin	1305	$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	dpavlin	1302	} elsif ( $line =~ m{^(\S\S)\s*$} ) {
180	dpavlin	1311	warn "# $self->{path} +$. empty \|$line\|\n";
181			} elsif ( $line ne '' ) {
182			warn "E: $self->{path} +$ \| can't parse \|$line\|";
183	dpavlin	899	}
184
185	dpavlin	904	if ( defined $v ) {
186			$v = $subfields->{$tag}->($v) if defined $subfields->{$tag};
187	dpavlin	901
188	dpavlin	1311	warn "## $tag: ", sub { dump( $v ) } if $debug;
189	dpavlin	904	push @{ $rec->{$tag} }, $v;
190			}
191	dpavlin	899	}
192
193	dpavlin	1311	warn "can't get full record $mfn got ", dump $rec;
194			return $rec;
195	dpavlin	898	}
196
197
198			=head2 size
199
200			Return number of records in database
201
202			my $size = $input->size;
203
204			=cut
205
206			sub size {
207			my $self = shift;
208	dpavlin	1311	$#{ $self->{record_offset} } - $self->{offset};
209			# no need for +1 since we record end of file as last record
210	dpavlin	898	}
211
212	dpavlin	900
213	dpavlin	898	=head1 AUTHOR
214
215			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
216
217			=head1 COPYRIGHT & LICENSE
218
219	dpavlin	1311	Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.
220	dpavlin	898
221			This program is free software; you can redistribute it and/or modify it
222			under the same terms as Perl itself.
223
224			=cut
225
226			1; # End of WebPAC::Input::ISI