--- COBISS.pm 2009/06/19 17:50:34 1 +++ COBISS.pm 2009/06/20 19:42:00 5 @@ -4,53 +4,162 @@ use strict; use WWW::Mechanize; +use MARC::Record; +use File::Slurp; + +binmode STDOUT, ':utf8'; + +my $cobiss_marc21 = { + '010' => { a => [ '020', 'a' ] }, + 200 => { + a => [ 245 , 'a' ], + f => [ 245 , 'f' ], + }, + 205 => { a => [ 250 , 'a' ] }, + 210 => { + a => [ 250 , 'a' ], + c => [ 260 , 'b' ], + d => [ 260 , 'c' ], + }, + 215 => { + a => [ 300 , 'a' ], + c => [ 300 , 'b' ], + d => [ 300 , 'c' ], + }, + 700 => { + a => [ 100 , 'a' ], + }, +}; + +our $mech = WWW::Mechanize->new(); +our $hits; + +sub diag { + print "# ", @_, $/; +} + +# Koha Z39.50 query: +# +# Bib-1 @and @and @and @and @and @and @and @or +# @attr 1=8 isbn-issn +# @attr 1=7 isbn-issn +# @attr 1=4 title +# @attr 1=1003 author +# @attr 1=16 dewey +# @attr 1=21 subject-holding +# @attr 1=12 control-no +# @attr 1=1007 standard-id +# @attr 1=1016 any + +our $usemap = { + 8 => 'BN', # FIXME check + 7 => 'SN', # FIXME check + 4 => 'TI', + 1003 => 'TI', + 16 => 'CU', + 21 => 'SU', +# 12 => '', +# 1007 => '', +# 1016 => '', + +}; + +sub usemap { + my $f = shift || die; + $usemap->{$f}; +} sub search { + my ( $self, $query ) = @_; + + die "need query" unless defined $query; my $url = 'http://cobiss.izum.si/scripts/cobiss?ukaz=GETID&lani=en'; -warn "# get $url\n"; +diag "# get $url"; - my $mech = WWW::Mechanize->new(); $mech->get( $url ); -warn "# got session\n"; +diag "# got session"; $mech->follow_link( text_regex => qr/union/ ); -warn "# submit search\n"; +diag "# switch to advanced form (select)"; + + $mech->follow_link( url_regex => qr/mode=3/ ); + +diag "# submit search $query"; $mech->submit_form( fields => { - 'SS1' => 'Krleza', + 'SS1' => $query, }, ); - my $hits = 1; + $hits = 0; if ( $mech->content =~ m{hits:\s*\s*(\d+)\s*}s ) { $hits = $1; } else { - warn "get't find results in ", $mech->content; + diag "get't find results in ", $mech->content; + return; } -warn "# got $hits results, get first one\n"; +diag "# got $hits results, get first one"; $mech->follow_link( url_regex => qr/ukaz=DISP/ ); -warn "# in COMARC format\n"; +diag "# in COMARC format"; $mech->follow_link( url_regex => qr/fmt=13/ ); +} + + +sub fetch_marc { + my ($self) = @_; my $comarc; - if ( $mech->content =~ m{
\s*(.+1\..+?)\s*}s ) { + if ( $mech->content =~ m{
\s*(.+?(\d+\.)\s+ID=(\d+).+?)\s*}s ) { + my $comarc = $1; + my $nr = $2; + my $id = $3; + +diag "# fetch_marc $nr [$id]"; + $comarc =~ s{?b>}{}gs; - $comarc =~ s{<(/?font)[^>]*>}{