From: Dobrica Pavlinusic Date: Fri, 22 Oct 2010 22:57:58 +0000 (+0200) Subject: rewrite COBISS into perl object X-Git-Url: http://git.rot13.org/?p=Biblio-Z3950.git;a=commitdiff_plain;h=e1035485a42f6e1f9228e8dd36dbf3e0450d810e rewrite COBISS into perl object and modify server to use it --- diff --git a/COBISS.pm b/COBISS.pm index c275f3e..ce1eea0 100644 --- a/COBISS.pm +++ b/COBISS.pm @@ -9,6 +9,14 @@ use Data::Dump qw/dump/; binmode STDOUT, ':utf8'; +sub new { + my ( $class ) = @_; + my $self = {}; + bless $self, $class; + return $self; +} + + my $cobiss_marc21 = { '010' => { a => [ '020', 'a' ] }, 200 => { @@ -31,9 +39,6 @@ my $cobiss_marc21 = { }, }; -our $mech = WWW::Mechanize->new(); -our $hits; - sub diag { print "# ", @_, $/; } @@ -51,7 +56,7 @@ sub diag { # @attr 1=1007 standard-id # @attr 1=1016 any -our $usemap = { +sub usemap {{ 8 => 'BN', # FIXME check 7 => 'SN', # FIXME check 4 => 'TI', @@ -62,7 +67,7 @@ our $usemap = { # 1007 => '', # 1016 => '', -}; +}}; sub search { my ( $self, $query ) = @_; @@ -73,6 +78,8 @@ sub search { diag "get $url"; + my $mech = $self->{mech} = WWW::Mechanize->new(); + my $hits; $mech->get( $url ); diag "got session"; @@ -106,12 +113,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}; diff --git a/server.pl b/server.pl index 8f4f6c5..8d7c60d 100755 --- a/server.pl +++ b/server.pl @@ -5,8 +5,16 @@ use strict; use Net::Z3950::SimpleServer; use Net::Z3950::OID; +use Data::Dumper; use COBISS; +my $databases = { + 'COBISS' => 'COBISS', + 'NSK01' => 'Aleph', + 'NSK10' => 'Aleph', + 'ZAG01' => 'Aleph', +}; + my $max_records = 3; # XXX configure this my $max_result_sets = 10; @@ -24,8 +32,6 @@ sub InitHandle { $session->{SETS} = {}; } -use Data::Dumper; - sub SearchHandle { my $this = shift; @@ -35,7 +41,13 @@ diag "SearchHandle ",Dumper($this); my $rpn = $this->{RPN}; my $query; - eval { $query = $rpn->{query}->render(); }; + my $database = $this->{DATABASES}->[0]; + my $module = $databases->{$database} || 'COBISS'; + my $from = $module->new; + +diag "using $module for $database ", Dumper( $from ); + + eval { $query = $rpn->{query}->render( $from->usemap ); }; warn "ERROR: $@" if $@; if ( $@ && ref($@) ) { ## Did someone/something report any errors? $this->{ERR_CODE} = $@->{errcode}; @@ -48,17 +60,17 @@ diag "search for $query"; my $setname = $this->{SETNAME}; my $repl_set = $this->{REPL_SET}; diag "SETNAME $setname REPL_SET $repl_set"; - my $result; - unless ( $result = COBISS->search( $query ) ) { + my $hits; + unless ( $hits = $from->search( $query ) ) { $this->{ERR_CODE} = 108; return; } - my $hits = $COBISS::hits || diag "no results for $query"; diag "got $hits hits"; my $rs = { lower => 1, upper => $hits < $max_records ? $max_records : $hits, - data => $result->{'resultElements'}, # FIXME + hits => $hits, + from => $from, }; my $sets = $session->{SETS}; @@ -87,8 +99,6 @@ sub FetchHandle { my $rs; my $record; -diag Dumper( $this ); - if ( !defined( $rs = $sets->{$setname} ) ) { $this->{ERR_CODE} = 30; return; @@ -97,6 +107,9 @@ diag Dumper( $this ); $this->{ERR_CODE} = 13; return; } + + my $from = $rs->{from} || die "no from?"; + $this->{BASENAME} = "HtmlZ3950"; # if ( !defined($req_form) || ( $req_form eq &Net::Z3950::OID::xml ) ) @@ -107,11 +120,11 @@ diag Dumper( $this ); } elsif ( $req_form eq &Net::Z3950::OID::unimarc ) { # FIXME convert to usmarc $this->{REP_FORM} = &Net::Z3950::OID::unimarc; - $this->{RECORD} = COBISS->fetch_rec('unimarc'); + $this->{RECORD} = $from->next_marc('unimarc'); } elsif ( $req_form eq &Net::Z3950::OID::usmarc ) { # FIXME convert to usmarc $this->{REP_FORM} = &Net::Z3950::OID::usmarc; - $this->{RECORD} = COBISS->fetch_rec('usmarc'); + $this->{RECORD} = $from->next_marc('usmarc'); } else { ## Unsupported record format $this->{ERR_CODE} = 239; @@ -165,13 +178,10 @@ use Data::Dump qw(dump); use COBISS; sub render { - my ($this,$from) = @_; - -print "render ", dump($this); + my ($this,$usemap) = @_; -my $usemap = eval '$' . $from . '::usemap'; -die $@ if $@; -warn "# $from usermap ",dump($usemap); +warn "# render ", dump($this); +warn "# usemap ", dump($usemap); my $attributes = {}; my $prefix = "";