X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=COBISS.pm;h=b2150c6945df3440899d577d6e0a43ecd14f8f2d;hb=027bff190500bcd934ec090e4cf72868f90d98b4;hp=c275f3e1e4e5eb2f83095cdc0c2561580f96d665;hpb=942b2c7aff7ea513a1fd4640abd72ccb5e9380ba;p=Biblio-Z3950.git diff --git a/COBISS.pm b/COBISS.pm index c275f3e..b2150c6 100644 --- a/COBISS.pm +++ b/COBISS.pm @@ -3,11 +3,10 @@ package COBISS; use warnings; use strict; -use WWW::Mechanize; use MARC::Record; use Data::Dump qw/dump/; -binmode STDOUT, ':utf8'; +use base 'Scraper'; my $cobiss_marc21 = { '010' => { a => [ '020', 'a' ] }, @@ -31,9 +30,6 @@ my $cobiss_marc21 = { }, }; -our $mech = WWW::Mechanize->new(); -our $hits; - sub diag { print "# ", @_, $/; } @@ -41,9 +37,9 @@ sub diag { # 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=7 isbn +# @attr 1=8 issn # @attr 1=1003 author # @attr 1=16 dewey # @attr 1=21 subject-holding @@ -51,18 +47,48 @@ sub diag { # @attr 1=1007 standard-id # @attr 1=1016 any -our $usemap = { - 8 => 'BN', # FIXME check - 7 => 'SN', # FIXME check + +# AU= Autor - osoba +# CB= Autor - korporacija +# CL= Zbirka +# CP= Mesto sast./dod. nazivu korp. +# PP= Mesto izdanja +# PU= IzdavaÄ +# PY= Godina izdanja +# P2= ZakljuÄna godina izdanja +# TI= Naslov +# TO= Naslov originala +# BN= ISBN +# SN= ISSN uz Älanak +# SP= ISSN +# PN= Predmetna odrednica - liÄno ime +# CS= Predm. odred. - naziv korporacije +# DU= Slobodno oblikovane predm. odred. +# SU= Predmetne odrednice - sve +# AC= Kod za vrstu autorstva +# CC= Kod za vrstu sadržaja +# CO= Zemlja/regija izdavanja +# FC= Å ifra organizacije +# LA= Jezik teksta +# LC= Kod za književni oblik +# LO= Jezik izvornog dela +# TA= Kod za predviÄene korisnike +# TD= Tipologija dok./dela +# UC= UDK za pretraživanje +# KW= KljuÄne reÄi + +sub usemap {{ + 7 => 'BN', # FIXME check + 8 => 'SP', # FIXME check 4 => 'TI', - 1003 => 'TI', + 1003 => 'AU', 16 => 'CU', 21 => 'SU', # 12 => '', # 1007 => '', # 1016 => '', -}; +}}; sub search { my ( $self, $query ) = @_; @@ -73,6 +99,9 @@ sub search { diag "get $url"; + my $mech = $self->{mech} || die "no mech?"; + + my $hits; $mech->get( $url ); diag "got session"; @@ -93,7 +122,7 @@ diag "submit search $query"; $hits = 0; if ( $mech->content =~ m{hits:\s*\s*(\d+)\s*}s ) { - $hits = $1; + $self->{hits} = $hits = $1; } else { diag "get't find results in ", $mech->content; return; @@ -106,12 +135,16 @@ diag "got $hits results, get first one"; diag "in COMARC format"; $mech->follow_link( url_regex => qr/fmt=13/ ); + + return $hits; } -sub fetch_rec { +sub next_marc { my ($self,$format) = @_; + my $mech = $self->{mech} || die "no mech?"; + $format ||= 'unimarc'; die "unknown format: $format" unless $format =~ m{(uni|us)marc}; @@ -120,81 +153,77 @@ sub fetch_rec { if ( $mech->content =~ m{
\s*(.+?(\d+)\.\s+ID=(\d+).+?)\s*}s ) { - my $comarc = $1; + my $markup = $1; my $nr = $2; my $id = $3; -diag "fetch_marc $nr [$id] $format"; +diag "fetch $nr [$id] $format"; - $comarc =~ s{?b>}{}gs; - $comarc =~ s{]*>}{