From 486d44ec95344bfb3b6f88b94aca9bdfaed7021c Mon Sep 17 00:00:00 2001 From: David Cook Date: Tue, 7 May 2013 17:06:33 +1000 Subject: [PATCH] Bug 10096 - Add a Z39.50 interface for authority searching This patch introduces a new Z39.50 interface for searching z39.50 compliant databases for MARC authority records. These databases aren't as common as their bibliographic equivalents, but they're out there and very useful. I have included info at the bottom of this messsage for sample authority databases you can try. To test this patch: 1) Set up Z39.50 client targets for authority databases. (I've included information at the bottom of this message for LibrariesAustralia's test server for authorities as well as instructions on how to use your Koha's z39.50 authority server as well. The Library of Congress also has authority databases available (unsure if these are test or prod), and you might have access to others through OCLC or RLIN. OCLC provides login credentials for their test databases. 2) Go to the Authorities module 3) Click on the new "Z39.50 search button" 4) Select your authoriy search targets from the list (N.B. bibliographic targets will also display. These are of no use to you.) 5) Do a search for an authority you would like using either the "Raw" input box or the more specific input boxes for names, subjects, subject sub divisions, or titles. (I like searching Name (personal): Eric on the LibrariesAustralia test DB.) 6) You should see a table listing the server, heading, authority type, and two other columns (MARC and a nameless column). "Authority type" is the type of authority it will become when imported in to Koha. In the Eric example, "PERSO_NAME". 7) Click on "MARC" next to the results of interest to review the MARC authority record. 8) When you're satisfied with a record, click on "Import". 9) The pop-up window will close and your original Koha window will change to the "Adding authority Personal Name" screen (in the Eric example). 10) All the relevant fields should be filled out for the record. Review them and make any changes as necessary. (N.B. The 001 will be cleared when saved, so if you have a use for the imported control number, move it to the 010, 016, or 035 as appropriate. If you have a default value for the 003, this will also likely be overwritten. Move it if necessary. The 005 will also be updated when saved, so do not worry about that.) 11) When you're satisfied, click save. 12) Presto! You've imported your first authority record via Z39.50! -- Here is the info for the LibrariesAustralia test Z39.50 authority database: Z39.50 server: LibrariesAustralia Authorities Hostname: z3950-test.librariesaustralia.nla.gov.au Port: 210 Database: AuthTraining Userid: ANLEZ Password: z39.50 Syntax: MARC21/USMARC Encoding: utf8 For testing purposes, you can also set up a Z39.50 client target, which points at your own Koha instance's Z39.50 authority server. To find the hostname, go to /etc/koha-conf.xml and find the value for the element. Depending on your configuration, this could be something like the following: unix:/zebra/koha/var/run/zebradb/authoritysocket (N.B. You might be using a different scheme than unix sockets...) To find the database, scroll down to the bottom of koha-conf.xml until you reach the element. Within this, look for the value of the element . It should probably be "authorities". To set up this Z39.50 client target in Koha... Z39.50 server: my koha authorities Hostname: unix:/zebra/koha/var/run/zebradb/authoritysocket Port: Database: authorities Userid: Password: Syntax: MARC21/USMARC (or whichever flavour you need) Encoding: utf8 --- C4/Breeding.pm | 300 +++++++++++++++++++- authorities/authorities.pl | 29 ++- cataloguing/z3950_auth_search.pl | 105 +++++++ .../prog/en/includes/authorities-toolbar.inc | 9 + .../en/modules/cataloguing/z3950_auth_search.tt | 232 +++++++++++++++ 5 files changed, 672 insertions(+), 3 deletions(-) create mode 100755 cataloguing/z3950_auth_search.pl create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/z3950_auth_search.tt diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 01aca21..1d6ceee 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -1,6 +1,7 @@ package C4::Breeding; # Copyright 2000-2002 Katipo Communications +# Parts Copyright 2013 Prosentient Systems # # This file is part of Koha. # @@ -25,6 +26,7 @@ use C4::Koha; use C4::Charset; use MARC::File::USMARC; use C4::ImportBatch; +use C4::AuthoritiesMarc; #GuessAuthTypeCode, FindDuplicateAuthority use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -33,7 +35,7 @@ BEGIN { $VERSION = 3.07.00.049; require Exporter; @ISA = qw(Exporter); - @EXPORT = qw(&ImportBreeding &BreedingSearch &Z3950Search); + @EXPORT = qw(&ImportBreeding &BreedingSearch &Z3950Search &Z3950SearchAuth); } =head1 NAME @@ -436,6 +438,302 @@ sub Z3950Search { ); } +=head2 ImportBreedingAuth + + ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); + + TODO description + +=cut + +sub ImportBreedingAuth { + my ($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type) = @_; + my @marcarray = split /\x1D/, $marcrecords; + + my $dbh = C4::Context->dbh; + + my $batch_id = GetZ3950BatchId($filename); + my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where controlnumber=? and authorized_heading=?"); + +# $encoding = C4::Context->preference("marcflavour") unless $encoding; + # fields used for import results + my $imported=0; + my $alreadyindb = 0; + my $alreadyinfarm = 0; + my $notmarcrecord = 0; + my $breedingid; + for (my $i=0;$i<=$#marcarray;$i++) { + my ($marcrecord, $charset_result, $charset_errors); + ($marcrecord, $charset_result, $charset_errors) = + MarcToUTF8Record($marcarray[$i]."\x1D", C4::Context->preference("marcflavour"), $encoding); + + # Normalize the record so it doesn't have separated diacritics + SetUTF8Flag($marcrecord); + +# warn "$i : $marcarray[$i]"; + # FIXME - currently this does nothing + my @warnings = $marcrecord->warnings(); + + if (scalar($marcrecord->fields()) == 0) { + $notmarcrecord++; + } else { + + my $heading; + $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); + + my $heading_authtype_code; + $heading_authtype_code = GuessAuthTypeCode($marcrecord); + + my $controlnumber; + $controlnumber = $marcrecord->field('001')->data; + + #Check if the authority record already exists in the database... + my ($duplicateauthid,$duplicateauthvalue); + if ($marcrecord && $heading_authtype_code) { + ($duplicateauthid,$duplicateauthvalue) = FindDuplicateAuthority( $marcrecord, $heading_authtype_code); + } + + if ($duplicateauthid && $overwrite_auth ne 2) { + #If the authority record exists and $overwrite_auth doesn't equal 2, then mark it as already in the DB + #FIXME: What does $overwrite_auth = 2 even mean? + + #FIXME: Should we bother with $overwrite_auth values? Currently, the hard-coded $overwrite_auth value is 2, which means the database gets filled with import_records... + #^^ of course, we might not want to reject records if their control number/heading exist in the db or breeding/import pool...as we might be wanting to update existing authority records... + $alreadyindb++; + } else { + + if ($controlnumber && $heading) { + $searchbreeding->execute($controlnumber,$heading); + ($breedingid) = $searchbreeding->fetchrow; + } + if ($breedingid && $overwrite_auth eq '0') { + #FIXME: What does $overwrite_auth = 0 even mean? + $alreadyinfarm++; + } else { + if ($breedingid && $overwrite_auth eq '1') { + #FIXME: What does $overwrite_auth = 1 even mean? + ModAuthInBatch($breedingid, $marcrecord); + } else { + my $import_id = AddAuthToBatch($batch_id, $imported, $marcrecord, $encoding, $z3950random); + $breedingid = $import_id; + } + $imported++; + } + } + } + } + return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); +} + +=head2 Z3950SearchAuth + +Z3950SearchAuth($pars, $template); + +Parameters for Z3950 search are all passed via the $pars hash. It may contain nameany, namepersonal, namecorp, namemeetingcon, +title, uniform title, subject, subjectsubdiv, srchany. +Also it should contain an arrayref id that points to a list of IDs of the z3950 targets to be queried (see z3950servers table). +This code is used in cataloging/z3950_auth_search. +The second parameter $template is a Template object. The routine uses this parameter to store the found values into the template. + +=cut + +sub Z3950SearchAuth { + my ($pars, $template)= @_; + + my $dbh = C4::Context->dbh; + my @id= @{$pars->{id}}; + my $random= $pars->{random}; + my $page= $pars->{page}; + + my $nameany= $pars->{nameany}; + my $namepersonal= $pars->{namepersonal}; + my $namecorp= $pars->{namecorp}; + my $namemeetingcon= $pars->{namemeetingcon}; + my $title= $pars->{title}; + my $uniformtitle= $pars->{uniformtitle}; + my $subject= $pars->{subject}; + my $subjectsubdiv= $pars->{subjectsubdiv}; + my $srchany= $pars->{srchany}; + + my $show_next = 0; + my $total_pages = 0; + my $attr = ''; + my $host; + my $server; + my $database; + my $port; + my $marcdata; + my @encoding; + my @results; + my $count; + my $record; + my @serverhost; + my @servername; + my @breeding_loop = (); + + my @oConnection; + my @oResult; + my @errconn; + my $s = 0; + my $query; + my $nterms=0; + + + if ($nameany) { + $query .= " \@attr 1=1003 \"$nameany\" "; #Author-name + $nterms++; + } + + if ($namecorp) { + $query .= " \@attr 1=2 \"$namecorp\" "; #1005 is another valid corporate author attribute... + $nterms++; + } + + if ($namepersonal) { + $query .= " \@attr 1=1 \"$namepersonal\" "; #1004 is another valid personal name attribute... + $nterms++; + } + + if ($namemeetingcon) { + $query .= " \@attr 1=1006 \"$namemeetingcon\" "; + $nterms++; + } + + if ($subject) { + $query .= " \@attr 1=21 \"$subject\" "; + $nterms++; + } + + if ($subjectsubdiv) { + $query .= " \@attr 1=47 \"$subjectsubdiv\" "; + $nterms++; + } + + if ($title) { + $query .= " \@attr 1=4 \"$title\" "; #This is a regular title search. 1=6 will give just uniform titles + $nterms++; + } + + if ($uniformtitle) { + $query .= " \@attr 1=6 \"$uniformtitle\" "; #This is the uniform title search + $nterms++; + } + + if($srchany) { + $query .= " \@attr 1=1016 \"$srchany\" "; + $nterms++; + } + + for my $i (1..$nterms-1) { + $query = "\@and " . $query; + } + + foreach my $servid (@id) { + my $sth = $dbh->prepare("select * from z3950servers where id=?"); + $sth->execute($servid); + while ( $server = $sth->fetchrow_hashref ) { + my $option1 = new ZOOM::Options(); + $option1->option( 'async' => 1 ); + $option1->option( 'elementSetName', 'F' ); + $option1->option( 'databaseName', $server->{db} ); + $option1->option( 'user', $server->{userid} ) if $server->{userid}; + $option1->option( 'password', $server->{password} ) if $server->{password}; + $option1->option( 'preferredRecordSyntax', $server->{syntax} ); + $option1->option( 'timeout', $server->{timeout} ) if $server->{timeout}; + $oConnection[$s] = create ZOOM::Connection($option1); + $oConnection[$s]->connect( $server->{host}, $server->{port} ); + $serverhost[$s] = $server->{host}; + $servername[$s] = $server->{name}; + $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); + $s++; + } ## while fetch + } # foreach + my $nremaining = $s; + + for ( my $z = 0 ; $z < $s ; $z++ ) { + $oResult[$z] = $oConnection[$z]->search_pqf($query); + } + + while ( $nremaining-- ) { + my $k; + my $event; + while ( ( $k = ZOOM::event( \@oConnection ) ) != 0 ) { + $event = $oConnection[ $k - 1 ]->last_event(); + last if $event == ZOOM::Event::ZEND; + } + + if ( $k != 0 ) { + $k--; + my ($error, $errmsg, $addinfo, $diagset)= $oConnection[$k]->error_x(); + if ($error) { + if ($error =~ m/^(10000|10007)$/ ) { + push(@errconn, {'server' => $serverhost[$k]}); + } + } + else { + my $numresults = $oResult[$k]->size(); + my $i; + my $result = ''; + if ( $numresults > 0 and $numresults >= (($page-1)*20)) { + $show_next = 1 if $numresults >= ($page*20); + $total_pages = int($numresults/20)+1 if $total_pages < ($numresults/20); + for ($i = ($page-1)*20; $i < (($numresults < ($page*20)) ? $numresults : ($page*20)); $i++) { + my $rec = $oResult[$k]->record($i); + if ($rec) { + my $marcrecord; + my $marcdata; + $marcdata = $rec->raw(); + + my ($charset_result, $charset_errors); + ($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, C4::Context->preference('marcflavour'), $encoding[$k]); + + my $heading; + my $heading_authtype_code; + $heading_authtype_code = GuessAuthTypeCode($marcrecord); + $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord }); + + my ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcdata, 2, $serverhost[$k], $encoding[$k], $random, 'z3950' ); + my %row_data; + $row_data{server} = $servername[$k]; + $row_data{breedingid} = $breedingid; + $row_data{heading} = $heading; + $row_data{heading_code} = $heading_authtype_code; + push( @breeding_loop, \%row_data ); + } + else { + push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1}); + } + } + } #if $numresults + } + } # if $k !=0 + + $template->param( + numberpending => $nremaining, + current_page => $page, + total_pages => $total_pages, + show_nextbutton => $show_next?1:0, + show_prevbutton => $page!=1, + ); + } # while nremaining + + #close result sets and connections + foreach(0..$s-1) { + $oResult[$_]->destroy(); + $oConnection[$_]->destroy(); + } + + my @servers = (); + foreach my $id (@id) { + push @servers, {id => $id}; + } + $template->param( + breeding_loop => \@breeding_loop, + servers => \@servers, + errconn => \@errconn + ); +} + 1; __END__ diff --git a/authorities/authorities.pl b/authorities/authorities.pl index 19a03e8..d989df1 100755 --- a/authorities/authorities.pl +++ b/authorities/authorities.pl @@ -24,6 +24,7 @@ use CGI; use C4::Auth; use C4::Output; use C4::AuthoritiesMarc; +use C4::ImportBatch; #GetImportRecordMarc use C4::Context; use C4::Koha; # XXX subfield_is_koha_internal_p use Date::Calc qw(Today); @@ -47,6 +48,22 @@ builds list, depending on authorised value... =cut +sub MARCfindbreeding_auth { + my ( $id ) = @_; + my ($marc, $encoding) = GetImportRecordMarc($id); + if ($marc) { + my $record = MARC::Record->new_from_usmarc($marc); + + if ( !defined(ref($record)) ) { + return -1; + } else { + return $record, $encoding; + } + } else { + return -1; + } +} + sub build_authorized_values_list { my ( $tag, $subfield, $value, $dbh, $authorised_values_sth,$index_tag,$index_subfield ) = @_; @@ -544,6 +561,7 @@ my $nonav = $input->param('nonav'); my $myindex = $input->param('index'); my $linkid=$input->param('linkid'); my $authtypecode = $input->param('authtypecode'); +my $breedingid = $input->param('breedingid'); my $dbh = C4::Context->dbh; if(!$authtypecode) { @@ -558,11 +576,18 @@ my ($template, $loggedinuser, $cookie) flagsrequired => {editauthorities => 1}, debug => 1, }); -$template->param(nonav => $nonav,index=>$myindex,authtypecode=>$authtypecode,); +$template->param(nonav => $nonav,index=>$myindex,authtypecode=>$authtypecode,breedingid=>$breedingid,); + $tagslib = GetTagsLabels(1,$authtypecode); my $record=-1; my $encoding=""; -$record = GetAuthority($authid) if ($authid); +if (($authid) && !($breedingid)){ + $record = GetAuthority($authid); +} +if ($breedingid) { + ( $record, $encoding ) = MARCfindbreeding_auth( $breedingid ); +} + my ($oldauthnumtagfield,$oldauthnumtagsubfield); my ($oldauthtypetagfield,$oldauthtypetagsubfield); $is_a_modif=0; diff --git a/cataloguing/z3950_auth_search.pl b/cataloguing/z3950_auth_search.pl new file mode 100755 index 0000000..8fdf96d --- /dev/null +++ b/cataloguing/z3950_auth_search.pl @@ -0,0 +1,105 @@ +#!/usr/bin/perl + +# This is a completely new Z3950 clients search using async ZOOM -TG 02/11/06 +# Copyright 2000-2002 Katipo Communications +# +# This is a new Z3950 authority search using the current Z3950 bibliographic search as a model 07/05/2013 +# Parts Copyright 2013 Prosentient Systems +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use CGI qw( -utf8 ); + +use C4::Auth; +use C4::Output; +use C4::Context; +use C4::Breeding; +use C4::Koha; + +my $input = new CGI; +my $dbh = C4::Context->dbh; +my $error = $input->param('error'); +my $nameany = $input->param('nameany'); +my $namecorp = $input->param('namecorp'); +my $namepersonal = $input->param('namepersonal'); +my $namemeetingcon = $input->param('namemeetingcon'); +my $title = $input->param('title'); +my $uniformtitle = $input->param('uniformtitle'); +my $subject = $input->param('subject'); +my $subjectsubdiv = $input->param('subjectsubdiv'); +my $srchany = $input->param('srchany'); +my $op = $input->param('op')||''; +my $page = $input->param('current_page') || 1; +$page = $input->param('goto_page') if $input->param('changepage_goto'); + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user({ + template_name => "cataloguing/z3950_auth_search.tmpl", + query => $input, + type => "intranet", + authnotrequired => 1, + flagsrequired => { catalogue => 1 }, +}); + +$template->param( + nameany => $nameany, + namecorp => $namecorp, + namepersonal => $namepersonal, + namemeetingcon => $namemeetingcon, + title => $title, + uniformtitle => $uniformtitle, + subject => $subject, + subjectsubdiv => $subjectsubdiv, + srchany => $srchany, +); + +if ( $op ne "do_search" ) { + my $sth = $dbh->prepare("SELECT id,host,name,checked FROM z3950servers ORDER BY rank, name"); + $sth->execute(); + my $serverloop = $sth->fetchall_arrayref( {} ); + $template->param( + serverloop => $serverloop, + opsearch => "search", + ); + output_html_with_http_headers $input, $cookie, $template->output; + exit; +} + +my @id = $input->param('id'); +if ( @id==0 ) { + # empty server list -> report and exit + $template->param( emptyserverlist => 1 ); + output_html_with_http_headers $input, $cookie, $template->output; + exit; +} + +my $pars= { + random => $input->param('random') || rand(1000000000), + page => $page, + id => \@id, + nameany => $nameany, + namecorp => $namecorp, + namepersonal => $namepersonal, + namemeetingcon => $namemeetingcon, + title => $title, + uniformtitle => $uniformtitle, + subject => $subject, + subjectsubdiv => $subjectsubdiv, + srchany => $srchany, +}; +Z3950SearchAuth($pars, $template); +output_html_with_http_headers $input, $cookie, $template->output; diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc index e25f49f..62f70a8 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc @@ -5,6 +5,12 @@ confirm_deletion(); return false; }); + + $("#z3950submit").click(function(){ + window.open("/cgi-bin/koha/cataloguing/z3950_auth_search.pl","z3950search",'width=740,height=450,location=yes,toolbar=no,scrollbars=yes,resize=yes'); + return false; + }); + }); //]]> @@ -40,4 +46,7 @@ [% END %] + diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/z3950_auth_search.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/z3950_auth_search.tt new file mode 100644 index 0000000..1f9e709 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/z3950_auth_search.tt @@ -0,0 +1,232 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Z39.50 search results +[% INCLUDE 'greybox.inc' %] +[% INCLUDE 'doc-head-close.inc' %] + + + +[% INCLUDE 'datatables-strings.inc' %] + + + + + [% IF ( opsearch ) %] + + + +
+ [% ELSE %] + + +
+ [% END %] +
+ [% IF ( opsearch ) %] +

Z39.50 Authority search points

+
+ +
+
+
+
    +
  1. +
  2. +
  3. +
  4. +
  5. +
+ +
+
+
+ +
+
    +
  1. +
  2. +
  3. +
  4. + +
+
+
+
+
+

Search targets Select allClear all

+ [% FOREACH serverloo IN serverloop %] +

+ [% IF ( serverloo.checked ) %] + + [% ELSE %] + + [% END %] + +

+ [% END %] +
+
Cancel
+
+ + +[% ELSE %] +

Results for Authority Records

+ [% IF ( breeding_loop ) %] + + + + + + + + + + [% FOREACH breeding_loo IN breeding_loop %] + [% IF ( breeding_loo.breedingid ) %] + + + + + + + + + + [% END %] + [% END %] +
ServerHeadingAuthority TypeMARC 
[% breeding_loo.server %] [% breeding_loo.heading %][% breeding_loo.heading_code %]MARCImport
+ +
+ + + + + + + + + + + + + + [% FOREACH server IN servers %] + + [% END %] + + [% IF ( show_prevbutton ) %] + + [% END %] + Page [% current_page %] / [% total_pages %] + [% IF ( show_nextbutton ) %] + + [% END %] +
Go to page : +
+ +

+ [% ELSE %] + [% IF ( errconn ) %] +
+
    + [% FOREACH errcon IN errconn %] + [% IF ( errcon.error == '10000' ) %]
  • Connection failed to [% errcon.server %]
  • + [% ELSIF ( errcon.error == '10007' ) %]
  • Connection timeout to [% errcon.server %]
  • [% END %] + [% END %] +
+
+ [% END %] +
Nothing found.
+

+ [% END %] + + +[% END %] + +
+
+ +[% IF ( numberpending ) %]

Still [% numberpending %] servers to search

[% END %] + + + + -- 1.7.7.4