Aleph.pm

   1 package Aleph;
   2
   3 use warnings;
   4 use strict;
   5
   6 use MARC::Record;
   7 use Data::Dump qw/dump/;
   8
   9 use base 'Scraper';
  10
  11 our $mech = WWW::Mechanize->new();
  12 our $hits;
  13
  14 sub diag {
  15         print "# ", @_, $/;
  16 }
  17
  18 # Koha Z39.50 query:
  19 #
  20 # Bib-1 @and @and @and @and @and @and @and @or
  21 # @attr 1=8 isbn-issn
  22 # @attr 1=7 isbn-issn
  23 # @attr 1=4 title
  24 # @attr 1=1003 author
  25 # @attr 1=16 dewey
  26 # @attr 1=21 subject-holding
  27 # @attr 1=12 control-no
  28 # @attr 1=1007 standard-id
  29 # @attr 1=1016 any
  30
  31 # LCC - Klasifikacija Kongresne knjižnice
  32 # LCN - Signatura Kongresne knjižnice
  33 # DDC - Deweyjeva klasifikacija
  34 # TIT - Naslovi
  35 # AUT - Autori
  36 # IMP - Impresum
  37 # SUB - Predmetnice
  38 # SRS - Nakladnička cjelina
  39 # LOC - Lokacija
  40 # WRD - Riječi
  41 # WTI - Riječi u polju naslova
  42 # WAU - Riječi u polju autora
  43 # WPE - Riječi u polju individualnog autora
  44 # WCO - Riječi u polju korporativnog autora
  45 # WME - Riječi u polju sastanka
  46 # WUT - Riječi u polju jedinstvenog naslova
  47 # WPL - Riječi u polju mjesta izdavanja
  48 # WPU - Riječi u polju nakladnika
  49 # WSU - Riječi u polju predmetnica
  50 # WSM - Riječi u predmetnicama MeSH-a
  51 # WST - Riječi u polju status
  52 # WGA - Riječi u geografskim odrednicama
  53 # WYR - Godina izdavanja
  54
  55 sub usemap {{
  56         4               => 'WTI',
  57         1003    => 'WTI',
  58         16              => 'CU',
  59         21              => 'SU',
  60 #       12              => '',
  61 #       1007    => '',
  62 #       1016    => '',
  63
  64 };
  65
  66
  67 sub search {
  68         my ( $self, $query ) = @_;
  69
  70         die "need query" unless defined $query;
  71
  72         my $url = 'http://161.53.240.197:8991/F?RN=' . rand(1000000000);
  73         # fake JavaScript code on page which creates random session
  74
  75 diag "get $url";
  76
  77         my $mech = $self->{mech} || die "no mech?";
  78         $mech->get( $url );
  79
  80 diag "advanced search";
  81
  82         $mech->follow_link( url_regex => qr/find-c/ );
  83
  84 diag "submit search $query";
  85
  86         $mech->submit_form(
  87                 fields => {
  88                         'ccl_term' => $query,
  89                 },
  90         );
  91
  92         $hits = 0;
  93         if ( $mech->content =~ m{ukupno\s+(\d+).*(do\s+(\d+))}s ) {
  94                 $hits = $1;
  95                 $hits = $2 if $2 && $2 < $1; # correct for max. results
  96         } else {
  97                 diag "get't find results in ", $mech->content;
  98                 return;
  99         }
 100
 101 diag "got $hits results, get first one";
 102
 103         $mech->follow_link( url_regex => qr/set_entry=000001/ );
 104
 105 diag "in MARC format";
 106
 107         $mech->follow_link( url_regex => qr/format=001/ );
 108
 109         return $hits;
 110 }
 111
 112
 113 sub next_marc {
 114         my ($self,$format) = @_;
 115
 116         my $mech = $self->{mech} || die "no mech?";
 117
 118 print $mech->content;
 119
 120         if ( $mech->content =~ m{Zapis\s+(\d+)}s ) {
 121
 122                 my $nr = $1;
 123
 124 diag "parse $nr";
 125
 126                 my $marc = MARC::Record->new;
 127
 128                 my $html = $mech->content;
 129                 my $hash;
 130
 131                 sub field {
 132                         my ( $f, $v ) = @_;
 133                         $v =~ s/\Q&nbsp;\E/ /gs;
 134 warn "# $f\t$v\n";
 135                         $hash->{$f} = $v;
 136                         my ($i1,$i2) = (' ',' ');
 137                         ($i1,$i2) = ($2,$3) if $f =~ s/^(...)(.)?(.)?/$1/;
 138                         my @sf = split(/\|/, $v);
 139                         shift @sf;
 140                         @sf = map { s/^(\w)\s+//; { $1 => $_ } } @sf;
 141 diag "sf = ", dump(@sf);
 142                         $marc->add_fields( $f, $i1, $i2, @sf ) if $f =~ m/^\d+$/;
 143                 }
 144
 145                 $html =~ s|<tr>\s*<td class=td1 id=bold[^>]*>(.+?)</td>\s*<td class=td1>(.+?)</td>|field($1,$2)|ges;
 146                 diag dump($hash);
 147
 148                 my $id = $hash->{SYS} || die "no SYS";
 149
 150
 151
 152                 my $path = "marc/$id.$format";
 153
 154                 open(my $out, '>:utf8', $path);
 155                 print $out $marc->as_usmarc;
 156                 close($out);
 157
 158                 diag "created $path ", -s $path, " bytes";
 159
 160                 diag $marc->as_formatted;
 161
 162                 $nr++;
 163
 164                 die if $nr == 3; # FIXME
 165
 166                 $mech->follow_link( url_regex => qr/set_entry=0*$nr/ );
 167
 168                 return $marc->as_usmarc;
 169         } else {
 170                 die "can't fetch COMARC format from ", $mech->content;
 171         }
 172
 173 }
 174
 175 1;