git.rot13.org Git - webpac2/blob - lib/WebPAC/Input/AK.pm

   1 package WebPAC::Input::AK;
   2
   3 use warnings;
   4 use strict;
   5
   6 use WebPAC::Input;
   7 use base qw/WebPAC::Common/;
   8
   9 use Data::Dump qw/dump/;
  10 use Carp qw/confess/;
  11
  12 =head1 NAME
  13
  14 WebPAC::Input::AK - support for AK Export Format
  15
  16 =cut
  17
  18 our $VERSION = '0.01';
  19
  20 our $debug = 0;
  21
  22
  23 =head1 SYNOPSIS
  24
  25 Open file in AK export fromat
  26
  27  my $input = new WebPAC::Input::AK(
  28         path => '/path/to/AK/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::AK(
  38         path => '/path/to/AK/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 AK export file
  53
  54 =back
  55
  56 =cut
  57
  58 sub new {
  59         my $class = shift;
  60         my $self = {@_};
  61         bless($self, $class);
  62
  63         my $arg = {@_};
  64
  65         open( my $fh, '<', $arg->{path} ) || confess "can't open $arg->{path}: $!";
  66
  67         $self->{fh} = $fh;
  68         $self->{record_offset} = [];
  69         $self->{offset} ||= 0;
  70
  71         my $tell = tell($fh);
  72
  73         while( my $line = <$fh> ) {
  74                 chomp($line);
  75                 if ( $line =~ m/^\s*ISBN/ ) {
  76                         push @{ $self->{record_offset} }, $tell;
  77                         last if $self->{limit} && $#{ $self->{record_offset} } >= $self->{limit} - 1 + $self->{offset};
  78                 }
  79                 $tell = tell($fh);
  80         }
  81
  82         warn "I $arg->{path} read ", tell($fh), " bytes $#{ $self->{record_offset} } records\n";
  83
  84         return $self;
  85 }
  86
  87
  88
  89 =head2 fetch_rec
  90
  91 Return record with ID C<$mfn> from database
  92
  93   my $rec = $input->fetch_rec( $mfn, $filter_coderef );
  94
  95 =cut
  96
  97 sub fetch_rec {
  98         my ( $self, $mfn, $filter_coderef ) = @_;
  99
 100         my $fh = $self->{fh};
 101
 102         seek $fh, $self->{record_offset}->[ $mfn - 1 ], 0;
 103
 104         my $rec;
 105
 106         my ( $tag, $v );
 107
 108         while( my $line = <$fh> ) {
 109                 chomp($line);
 110                 $line =~ s/\r$//;
 111
 112                 if ( $line eq '' ) {
 113
 114                         if ( $tag && $v ) {
 115                                 $rec->{$tag} = $v;
 116                         }
 117
 118                         $rec->{'000'} = [ $mfn ];
 119                         warn "## mfn $mfn" if $debug;
 120
 121                         return $rec;
 122
 123                 }
 124
 125                 if ( $line =~ m/^\s{19}(.*)/ ) {
 126                         $v .= "\n" . $1;
 127                 } elsif ( $line =~ m/^\s*(\S+.+):\s(.+)/ ) {
 128
 129                         if ( $tag && $v ) {
 130                                 $rec->{$tag} = $v;
 131                         }
 132
 133                         $tag = $1;
 134                         $v   = $2;
 135                 } else {
 136                         confess "can't parse ",dump($line);
 137                 }
 138         }
 139
 140         return $rec;
 141 }
 142
 143
 144 =head2 size
 145
 146 Return number of records in database
 147
 148   my $size = $input->size;
 149
 150 =cut
 151
 152 sub size {
 153         my $self = shift;
 154         my $size = $#{ $self->{record_offset} };
 155         return 0 if $size < 0;
 156         # no need for +1 since we record end of file as last record
 157         return $size - $self->{offset};
 158 }
 159
 160
 161 =head1 AUTHOR
 162
 163 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 164
 165 =head1 COPYRIGHT & LICENSE
 166
 167 Copyright 2015 Dobrica Pavlinusic, All Rights Reserved.
 168
 169 This program is free software; you can redistribute it and/or modify it
 170 under the same terms as Perl itself.
 171
 172 =cut
 173
 174 1; # End of WebPAC::Input::AK