From e0058474a97cd95262b06537491669d64cb853d9 Mon Sep 17 00:00:00 2001 From: Matthias Meusburger Date: Wed, 7 Feb 2018 16:02:35 +0100 Subject: [PATCH] Bug 19436: Add SRU support for authorities MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Content-Type: text/plain; charset=utf-8 Test plan: - Apply the patch - Add an SRU authority server in admininistration -> Z39.50/SRU servers You can try with the French national library, configured as such: Hostname: catalogue.bnf.fr Port: 80 Database: api/SRU Syntax: Unimarc Record type: authority Additional SRU options: version=1.2,sru=get SRU Search fields mapping example: Keyword (any): aut.anywhere Name (any): aut.anywhere Author (any): (aut.type any "pep org") and aut.accesspoint Author (personal): aut.type=pep and aut.accesspoint Author (corporate): aut.type=org and aut.accesspoint Author (meeting/conference): aut.type=org and aut.accesspoint Subject heading: (aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint Subject sub-division: aut.type=ram_pe and aut.accesspoint Title (any): (aut.type any "tic tut tum ram_tp ram_tu") and aut.accesspoint Title (uniform):(aut.type any "tut tum ram_tu") and aut.accesspoint - Try a search from Authorities -> New from Z39.50/SRU - Check that the authority is correctly displayed in "Show Marc" - Check that the authority is correclty added to koha in "Import" - prove t/db_dependent/Breeding.t Signed-off-by: François Pichenot Signed-off-by: Marcel de Rooy --- C4/Breeding.pm | 175 +++++++++------------ admin/sru_modmapping.pl | 5 +- cataloguing/z3950_auth_search.pl | 2 +- .../prog/en/includes/authorities-toolbar.inc | 2 +- .../prog/en/modules/admin/sru_modmapping.tt | 4 +- .../prog/en/modules/admin/sru_modmapping_auth.tt | 98 ++++++++++++ .../prog/en/modules/admin/z3950servers.tt | 12 +- t/db_dependent/Breeding.t | 16 +- 8 files changed, 195 insertions(+), 119 deletions(-) create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping_auth.tt diff --git a/C4/Breeding.pm b/C4/Breeding.pm index a17406b..bed7912 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -227,6 +227,53 @@ sub Z3950Search { ); } +sub _auth_build_query { + my ( $pars ) = @_; + + my $nameany= $pars->{nameany}; + my $authorany= $pars->{authorany}; + my $authorpersonal= $pars->{authorpersonal}; + my $authorcorp= $pars->{authorcorp}; + my $authormeetingcon= $pars->{authormeetingcon}; + my $title= $pars->{title}; + my $uniformtitle= $pars->{uniformtitle}; + my $subject= $pars->{subject}; + my $subjectsubdiv= $pars->{subjectsubdiv}; + my $srchany= $pars->{srchany}; + my $authid= $pars->{authid}; + + my $qry_build = { + nameany => '@attr 1=1002 "#term" ', + authorany => '@attr 1=1003 "#term" ', + authorcorp => '@attr 1=2 "#term" ', + authorpersonal => '@attr 1=1 "#term" ', + authormeetingcon => '@attr 1=3 "#term" ', + subject => '@attr 1=21 "#term" ', + subjectsubdiv => '@attr 1=47 "#term" ', + title => '@attr 1=4 "#term" ', + uniformtitle => '@attr 1=6 "#term" ', + srchany => '@attr 1=1016 "#term" ', + }; + + my $zquery=''; + my $squery=''; + my $nterms=0; + foreach my $k ( sort keys %$pars ) { + #note that the sort keys forces an identical result under Perl 5.18 + #one of the unit tests is based on that assumption + if( ( my $val=$pars->{$k} ) && $qry_build->{$k} ) { + $qry_build->{$k} =~ s/#term/$val/g; + $zquery .= $qry_build->{$k}; + $squery .= "[$k]=\"$val\" and "; + $nterms++; + } + } + $zquery = "\@and " . $zquery for 2..$nterms; + $squery =~ s/ and $//; + return ( $zquery, $squery ); + +} + sub _build_query { my ( $pars ) = @_; @@ -268,11 +315,9 @@ sub _handle_one_result { my $raw= $zoomrec->raw(); my $marcrecord; if( $servhref->{servertype} eq 'sru' ) { - $marcrecord= MARC::Record->new_from_xml( $raw, 'UTF-8', - $servhref->{syntax} ); - } else { - ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values + $raw= MARC::Record->new_from_xml( $raw, $servhref->{encoding}, $servhref->{syntax} ); } + ($marcrecord) = MarcToUTF8Record($raw, C4::Context->preference('marcflavour'), $servhref->{encoding} // "iso-5426" ); #ignores charset return values SetUTF8Flag($marcrecord); my $error; ( $marcrecord, $error ) = _do_xslt_proc($marcrecord, $servhref, $xslh); @@ -369,7 +414,6 @@ sub _create_connection { $option1->option( 'user', $server->{userid} ) if $server->{userid}; $option1->option( 'password', $server->{password} ) if $server->{password}; } - my $obj= ZOOM::Connection->create($option1); if( $server->{servertype} eq 'sru' ) { my $host= $server->{host}; @@ -410,7 +454,7 @@ sub _translate_query { #SRU query adjusted per server cf. srufields column =head2 ImportBreedingAuth -ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type); +ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random); ImportBreedingAuth imports MARC records in the reservoir (import_records table). ImportBreedingAuth is based on the ImportBreeding subroutine. @@ -418,9 +462,7 @@ ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random =cut sub ImportBreedingAuth { - my ($marcrecords,$overwrite_auth,$filename,$encoding,$z3950random,$batch_type) = @_; - my @marcarray = split /\x1D/, $marcrecords; - + my ($marcrecord,$overwrite_auth,$filename,$encoding,$z3950random) = @_; my $dbh = C4::Context->dbh; my $batch_id = GetZ3950BatchId($filename); @@ -435,10 +477,6 @@ sub ImportBreedingAuth { 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", $marc_type, $encoding); # Normalize the record so it doesn't have separated diacritics SetUTF8Flag($marcrecord); @@ -482,7 +520,6 @@ sub ImportBreedingAuth { } } } - } return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); } @@ -506,17 +543,6 @@ sub Z3950SearchAuth { my $random= $pars->{random}; my $page= $pars->{page}; - my $nameany= $pars->{nameany}; - my $authorany= $pars->{authorany}; - my $authorpersonal= $pars->{authorpersonal}; - my $authorcorp= $pars->{authorcorp}; - my $authormeetingcon= $pars->{authormeetingcon}; - my $title= $pars->{title}; - my $uniformtitle= $pars->{uniformtitle}; - my $subject= $pars->{subject}; - my $subjectsubdiv= $pars->{subjectsubdiv}; - my $srchany= $pars->{srchany}; - my $authid= $pars->{authid}; my $show_next = 0; my $total_pages = 0; @@ -531,101 +557,38 @@ sub Z3950SearchAuth { my $count; my $record; my @serverhost; - my @servername; my @breeding_loop = (); my @oConnection; my @oResult; my @errconn; + my @servers; my $s = 0; my $query; my $nterms=0; my $marcflavour = C4::Context->preference('marcflavour'); my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour; - - if ($nameany) { - $query .= " \@attr 1=1002 \"$nameany\" "; #Any name (this includes personal, corporate, meeting/conference authors, and author names in subject headings) - #This attribute is supported by both the Library of Congress and Libraries Australia 08/05/2013 - $nterms++; - } - - if ($authorany) { - $query .= " \@attr 1=1003 \"$authorany\" "; #Author-name (this includes personal, corporate, meeting/conference authors, but not author names in subject headings) - #This attribute is not supported by the Library of Congress, but is supported by Libraries Australia 08/05/2013 - $nterms++; - } - - if ($authorcorp) { - $query .= " \@attr 1=2 \"$authorcorp\" "; #1005 is another valid corporate author attribute... - $nterms++; - } - - if ($authorpersonal) { - $query .= " \@attr 1=1 \"$authorpersonal\" "; #1004 is another valid personal name attribute... - $nterms++; - } - - if ($authormeetingcon) { - $query .= " \@attr 1=3 \"$authormeetingcon\" "; #1006 is another valid meeting/conference name attribute... - $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; - } - + my $authid= $pars->{authid}; + my ( $zquery, $squery ) = _auth_build_query( $pars ); 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->{servername}; + $oConnection[$s] = _create_connection( $server ); + + $oResult[$s] = + $server->{servertype} eq 'zed'? + $oConnection[$s]->search_pqf( $zquery ): + $oConnection[$s]->search(new ZOOM::Query::CQL( + _translate_query( $server, $squery ))); $encoding[$s] = ($server->{encoding}?$server->{encoding}:"iso-5426"); + $servers[$s] = $server; $s++; - } ## while fetch + } ## 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; @@ -657,16 +620,18 @@ sub Z3950SearchAuth { $marcdata = $rec->raw(); my ($charset_result, $charset_errors); + if( $servers[$k]->{servertype} eq 'sru' ) { + $marcdata = MARC::Record->new_from_xml( $marcdata, $encoding[$k], $servers[$k]->{syntax} ); + } ($marcrecord, $charset_result, $charset_errors)= MarcToUTF8Record($marcdata, $marc_type, $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 ($notmarcrecord, $alreadyindb, $alreadyinfarm, $imported, $breedingid)= ImportBreedingAuth( $marcrecord, 2, $serverhost[$k], $encoding[$k], $random); my %row_data; - $row_data{server} = $servername[$k]; + $row_data{server} = $servers[$k]->{'servername'}; $row_data{breedingid} = $breedingid; $row_data{heading} = $heading; $row_data{authid} = $authid; @@ -674,7 +639,7 @@ sub Z3950SearchAuth { push( @breeding_loop, \%row_data ); } else { - push(@breeding_loop,{'server'=>$servername[$k],'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1}); + push(@breeding_loop,{'server'=>$servers[$k]->{'servername'},'title'=>join(': ',$oConnection[$k]->error_x()),'breedingid'=>-1,'authid'=>-1}); } } } #if $numresults @@ -696,7 +661,7 @@ sub Z3950SearchAuth { $oConnection[$_]->destroy(); } - my @servers = (); + @servers = (); foreach my $id (@id) { push @servers, {id => $id}; } diff --git a/admin/sru_modmapping.pl b/admin/sru_modmapping.pl index d5ef116..c0ed868 100755 --- a/admin/sru_modmapping.pl +++ b/admin/sru_modmapping.pl @@ -26,8 +26,9 @@ use C4::Output; my $input = new CGI; my $mapstr = $input->param('mapping')//''; +my $type = $input->param('type')//''; my ( $template, $loggedinuser, $cookie ) = get_template_and_user( { - template_name => "admin/sru_modmapping.tt", + template_name => $type eq "authority" ? "admin/sru_modmapping_auth.tt" : "admin/sru_modmapping.tt", query => $input, type => "intranet", authnotrequired => 0, @@ -37,7 +38,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( { my %map; foreach my $singlemap ( split ',', $mapstr ) { - my @temp = split '=', $singlemap; + my @temp = split '=', $singlemap, 2; $map{ $temp[0] } = $temp[1] if @temp>1; } $template->param( mapping => \%map ); diff --git a/cataloguing/z3950_auth_search.pl b/cataloguing/z3950_auth_search.pl index 4526ccf..e65b8aa 100755 --- a/cataloguing/z3950_auth_search.pl +++ b/cataloguing/z3950_auth_search.pl @@ -66,7 +66,7 @@ $template->param( ); if ( $op ne "do_search" ) { - my $sth = $dbh->prepare("SELECT id,host,servername,checked FROM z3950servers WHERE recordtype = 'authority' AND servertype='zed' ORDER BY rank, servername"); + my $sth = $dbh->prepare("SELECT id,host,servername,checked FROM z3950servers WHERE recordtype = 'authority' ORDER BY rank, servername"); $sth->execute(); my $serverloop = $sth->fetchall_arrayref( {} ); $template->param( 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 b42074a..adf3eba 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/authorities-toolbar.inc @@ -38,7 +38,7 @@ [% IF servers.count > 0 %]
- New from Z39.50 + New from Z39.50/SRU
[% END %] [% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping.tt index a73ecb4..6cf7c11 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping.tt @@ -1,6 +1,6 @@ [% SET footerjs = 1 %] [% INCLUDE 'doc-head-open.inc' %] -Koha › SRU search fields mapping +Koha › SRU search fields mapping for bibliographic records [% INCLUDE 'doc-head-close.inc' %] @@ -9,7 +9,7 @@
-

Modify SRU search fields mapping

+

Modify SRU search fields mapping for bibliographic records

diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping_auth.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping_auth.tt new file mode 100644 index 0000000..3b9877a --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/sru_modmapping_auth.tt @@ -0,0 +1,98 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › SRU search fields mapping for authorities +[% INCLUDE 'doc-head-close.inc' %] + + + + + + +
+ +
+

Modify SRU search fields mapping for authorities

+ +
+
+
+
    +
  1. + + +
    2. +
  2. + + +
    3. +
  3. + + +
    4. +
  4. + + +
    5. +
  5. + + +
    6. +
  6. + + +
    7. +
+
+
+
    +
  1. + + +
    2. +
  2. + + +
    3. +
  3. + + +
    4. +
  4. + + +
    5. +
+
+
+
+
+ + Cancel +
+ +
+ +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/z3950servers.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/z3950servers.tt index 8bf8483..d1092bb 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/z3950servers.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/z3950servers.tt @@ -18,6 +18,7 @@ [% IF op == 'list' %] [% END %] + @@ -130,8 +131,8 @@
  • - - + +
    • [% END %]
  • @@ -212,10 +213,6 @@ $("#encoding").val('[% server.encoding %]'); $("#recordtype").val('[% server.recordtype %]'); [% END %] - // Disable recordtype (and default to bib) for non-Z3950 servers until auth is supported - [% UNLESS (server.servertype||type) == 'zed' %] - $("#recordtype").prop('disabled',true); - [% END %] $( "#serverentry" ).validate({ rules: { servername: { required: true }, @@ -248,7 +245,8 @@ }); function ModMapping () { var map= $('#show_sru_fields').val(); - window.open('/cgi-bin/koha/admin/sru_modmapping.pl?mapping='+map,'popup','width=800,height=400,resizable=yes,toolbar=false,scrollbars=yes,top'); + var type= $('#recordtype').val(); + window.open('/cgi-bin/koha/admin/sru_modmapping.pl?mapping='+map + '&type=' + type,'popup','width=800,height=400,resizable=yes,toolbar=false,scrollbars=yes,top'); } [% ELSE %] $(document).ready(function() { diff --git a/t/db_dependent/Breeding.t b/t/db_dependent/Breeding.t index 6cfd684..0193492f 100644 --- a/t/db_dependent/Breeding.t +++ b/t/db_dependent/Breeding.t @@ -36,7 +36,7 @@ use Koha::XSLT_Handler; #Group 1: testing _build_query and _translate_query (part of Z3950Search) subtest '_build_query' => sub { - plan tests => 12; + plan tests => 14; test_build_translate_query(); }; #Group 2: testing _create_connection (part of Z3950Search) @@ -107,6 +107,20 @@ sub test_build_translate_query { my @queries2= C4::Breeding::_build_query( $pars3 ); is( $queries[0] eq $queries2[0] && $queries[1] eq $queries2[1], 1, 'Third query makes no difference'); + + # Check that indexes with equal signs are ok + $server = { sru_fields => 'subjectsubdiv=aut.type=ram_pe and aut.accesspoint' }; + my $pars4 = { subjectsubdiv => 'mysubjectsubdiv' }; + @queries = C4::Breeding::_auth_build_query( $pars4 ); + my $zquery = C4::Breeding::_translate_query( $server, $queries[1] ); + is ( $zquery, 'aut.type=ram_pe and aut.accesspoint="mysubjectsubdiv"', 'SRU query with equal sign in index'); + + # Check that indexes with double-quotes are ok + $server = { sru_fields => 'subject=(aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint' }; + my $pars5 = { subject => 'mysubject' }; + @queries = C4::Breeding::_auth_build_query( $pars5 ); + $zquery = C4::Breeding::_translate_query( $server, $queries[1] ); + is ( $zquery, '(aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint="mysubject"', 'SRU query with double quotes in index'); } sub test_create_connection { -- 2.1.4