C4/AuthoritiesMarc.pm

   1 package C4::AuthoritiesMarc;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Copyright 2018 The National Library of Finland, University of Helsinki
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use strict;
  22 use warnings;
  23 use MARC::Field;
  24
  25 use C4::Context;
  26 use C4::Biblio qw( GetFrameworkCode ModBiblio );
  27 use C4::Search qw( FindDuplicate new_record_from_zebra );
  28 use C4::AuthoritiesMarc::MARC21;
  29 use C4::AuthoritiesMarc::UNIMARC;
  30 use C4::Charset qw( SetUTF8Flag );
  31 use C4::Log qw( logaction );
  32 use Koha::MetadataRecord::Authority;
  33 use Koha::Authorities;
  34 use Koha::Authority::MergeRequests;
  35 use Koha::Authority::Types;
  36 use Koha::Authority;
  37 use Koha::Libraries;
  38 use Koha::RecordProcessor;
  39 use Koha::SearchEngine;
  40 use Koha::SearchEngine::Indexer;
  41 use Koha::SearchEngine::Search;
  42
  43 our (@ISA, @EXPORT_OK);
  44 BEGIN {
  45
  46     require Exporter;
  47     @ISA       = qw(Exporter);
  48     @EXPORT_OK = qw(
  49       GetTagsLabels
  50       GetAuthMARCFromKohaField
  51
  52       AddAuthority
  53       ModAuthority
  54       DelAuthority
  55       GetAuthority
  56       GetAuthorityXML
  57       GetAuthorizedHeading
  58
  59       SearchAuthorities
  60
  61       BuildSummary
  62       BuildAuthHierarchies
  63       BuildAuthHierarchy
  64       GenerateHierarchy
  65       GetHeaderAuthority
  66       AddAuthorityTrees
  67       CompareFieldWithAuthority
  68
  69       merge
  70       FindDuplicateAuthority
  71
  72       GuessAuthTypeCode
  73       GuessAuthId
  74       compare_fields
  75     );
  76 }
  77
  78
  79 =head1 NAME
  80
  81 C4::AuthoritiesMarc
  82
  83 =head2 GetAuthMARCFromKohaField
  84
  85   ( $tag, $subfield ) = &GetAuthMARCFromKohaField ($kohafield,$authtypecode);
  86
  87 returns tag and subfield linked to kohafield
  88
  89 Comment :
  90 Suppose Kohafield is only linked to ONE subfield
  91
  92 =cut
  93
  94 sub GetAuthMARCFromKohaField {
  95 #AUTHfind_marc_from_kohafield
  96   my ( $kohafield,$authtypecode ) = @_;
  97   my $dbh=C4::Context->dbh;
  98   return 0, 0 unless $kohafield;
  99   $authtypecode="" unless $authtypecode;
 100   my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
 101   $sth->execute($kohafield,$authtypecode);
 102   my ($tagfield,$tagsubfield) = $sth->fetchrow;
 103
 104   return  ($tagfield,$tagsubfield);
 105 }
 106
 107 =head2 SearchAuthorities
 108
 109   (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or,
 110      $excluding, $operator, $value, $offset,$length,$authtypecode,
 111      $sortby[, $skipmetadata])
 112
 113 returns ref to array result and count of results returned
 114
 115 =cut
 116
 117 sub SearchAuthorities {
 118     my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_;
 119     # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby);
 120     my $dbh=C4::Context->dbh;
 121     $sortby="" unless $sortby;
 122     my $query;
 123     my $qpquery = '';
 124     my $attr = '';
 125         # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on
 126         # the authtypecode. Then, search on $a of this tag_to_report
 127         # also store main entry MARC tag, to extract it at end of search
 128     ##first set the authtype search and may be multiple authorities
 129     if ($authtypecode) {
 130         my $n=0;
 131         my @authtypecode;
 132         my @auths=split / /,$authtypecode ;
 133         foreach my  $auth (@auths){
 134             $query .=" \@attr 1=authtype \@attr 5=100 ".$auth; ##No truncation on authtype
 135                 push @authtypecode ,$auth;
 136             $n++;
 137         }
 138         if ($n>1){
 139             while ($n>1){$query= "\@or ".$query;$n--;}
 140         }
 141     }
 142
 143     my $dosearch;
 144     my $and=" \@and " ;
 145     my $q2;
 146     my $attr_cnt = 0;
 147     for ( my $i = 0 ; $i <= $#{$value} ; $i++ ) {
 148         if ( @$value[$i] ) {
 149             if ( @$tags[$i] ) {
 150                 if ( @$tags[$i] eq "mainmainentry" ) {
 151                     $attr = " \@attr 1=Heading-Main ";
 152                 }
 153                 elsif ( @$tags[$i] eq "mainentry" ) {
 154                     $attr = " \@attr 1=Heading ";
 155                 }
 156                 elsif ( @$tags[$i] eq "match" ) {
 157                     $attr = " \@attr 1=Match ";
 158                 }
 159                 elsif ( @$tags[$i] eq "match-heading" ) {
 160                     $attr = " \@attr 1=Match-heading ";
 161                 }
 162                 elsif ( @$tags[$i] eq "see-from" ) {
 163                     $attr = " \@attr 1=Match-heading-see-from ";
 164                 }
 165                 elsif ( @$tags[$i] eq "thesaurus" ) {
 166                     $attr = " \@attr 1=Subject-heading-thesaurus ";
 167                 }
 168                 elsif ( @$tags[$i] eq "all" ) {
 169                     $attr = " \@attr 1=Any ";
 170                 }
 171                 else {    # Use the index passed in params
 172                     $attr = " \@attr 1=" . @$tags[$i] . " ";
 173                 }
 174             }         #if @$tags[$i]
 175             else {    # Assume any if no index was specified
 176                 $attr = " \@attr 1=Any ";
 177             }
 178
 179             my $operator = @$operator[$i];
 180             if ( $operator and $operator eq 'is' ) {
 181                 $attr .= " \@attr 4=1  \@attr 5=100 "
 182                   ;    ##Phrase, No truncation,all of subfield field must match
 183             }
 184             elsif ( $operator and $operator eq "=" ) {
 185                 $attr .= " \@attr 4=107 ";    #Number Exact match
 186             }
 187             elsif ( $operator and $operator eq "start" ) {
 188                 $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 \@attr 6=3 "
 189                   ;    #Firstinfield Phrase, Right truncated, Complete field
 190             }
 191             elsif ( $operator and $operator eq "exact" ) {
 192                 $attr .= " \@attr 4=1  \@attr 5=100 \@attr 6=3 "
 193                   ;    ##Phrase, No truncation,all of subfield field must match
 194             }
 195             else {
 196                 $attr .= " \@attr 5=1 \@attr 4=6 "
 197                   ;    ## Word list, right truncated, anywhere
 198                 if ( $sortby eq 'Relevance' ) {
 199                     $attr .= "\@attr 2=102 ";
 200                 }
 201             }
 202             @$value[$i] =~
 203               s/"/\\"/g;    # Escape the double-quotes in the search value
 204             $attr = $attr . "\"" . @$value[$i] . "\"";
 205             $q2 .= $attr;
 206             $dosearch = 1;
 207             ++$attr_cnt;
 208         }    #if value
 209     }
 210     ##Add how many queries generated
 211     if ( defined $query && $query =~ /\S+/ ) {
 212         #NOTE: This code path is used by authority search in cataloguing plugins...
 213         #FIXME: This does not quite work the way the author probably intended.
 214         #It creates a ($query prefix) AND (query 1) AND (query 2) structure instead of
 215         #($query prefix) AND (query 1 AND query 2)
 216         $query = $and x $attr_cnt . $query . ( defined $q2 ? $q2 : '' );
 217     } else {
 218         #NOTE: This code path is used by authority search in authority home and record matching rules...
 219         my $op_prefix = '';
 220         #NOTE: Without the following code, multiple queries will never be joined together
 221         #with a Boolean operator.
 222         if ( $attr_cnt > 1 ) {
 223             #NOTE: We always need 1 less operator than we have operands,
 224             #so long as there is more than 1 operand
 225             my $or_cnt = $attr_cnt - 1;
 226             #NOTE: We hard-code OR here because that's what Elasticsearch does
 227             $op_prefix = ' @or ' x $or_cnt;
 228             #NOTE: This evaluates to a logical structure like (query 1) OR (query 2) OR (query 3)
 229         }
 230         $query = $op_prefix . $q2;
 231     }
 232     ## Adding order
 233     #$query=' @or  @attr 7=2 @attr 1=Heading 0 @or  @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc");
 234     my $orderstring;
 235     if ($sortby eq 'HeadingAsc') {
 236         $orderstring = '@attr 7=1 @attr 1=Heading 0';
 237     } elsif ($sortby eq 'HeadingDsc') {
 238         $orderstring = '@attr 7=2 @attr 1=Heading 0';
 239     } elsif ($sortby eq 'AuthidAsc') {
 240         $orderstring = '@attr 7=1 @attr 4=109 @attr 1=Local-Number 0';
 241     } elsif ($sortby eq 'AuthidDsc') {
 242         $orderstring = '@attr 7=2 @attr 4=109 @attr 1=Local-Number 0';
 243     }
 244     $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''");
 245     $query="\@or $orderstring $query" if $orderstring;
 246
 247     $offset = 0 if not defined $offset or $offset < 0;
 248     my $counter = $offset;
 249     $length=10 unless $length;
 250     my @oAuth;
 251     my $i;
 252     $oAuth[0]=C4::Context->Zconn("authorityserver" , 1);
 253     my $Anewq= ZOOM::Query::PQF->new($query,$oAuth[0]);
 254     my $oAResult;
 255     $oAResult= $oAuth[0]->search($Anewq) ;
 256     while (($i = ZOOM::event(\@oAuth)) != 0) {
 257         my $ev = $oAuth[$i-1]->last_event();
 258         last if $ev == ZOOM::Event::ZEND;
 259     }
 260     my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x();
 261     if ($error) {
 262         warn  "oAuth error: $errmsg ($error) $addinfo $diagset\n";
 263         goto NOLUCK;
 264     }
 265
 266     my $nbresults;
 267     $nbresults=$oAResult->size();
 268     my $nremains=$nbresults;
 269     my @result = ();
 270     my @finalresult = ();
 271
 272     if ($nbresults>0){
 273
 274     ##Find authid and linkid fields
 275     ##we may be searching multiple authoritytypes.
 276     ## FIXME this assumes that all authid and linkid fields are the same for all authority types
 277     # my ($authidfield,$authidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.authid",$authtypecode[0]);
 278     # my ($linkidfield,$linkidsubfield)=GetAuthMARCFromKohaField($dbh,"auth_header.linkid",$authtypecode[0]);
 279         while (($counter < $nbresults) && ($counter < ($offset + $length))) {
 280
 281         ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
 282         my $rec=$oAResult->record($counter);
 283         my $separator=C4::Context->preference('AuthoritySeparator');
 284         my $authrecord = C4::Search::new_record_from_zebra(
 285             'authorityserver',
 286             $rec->raw()
 287         );
 288
 289         if ( !defined $authrecord or !defined $authrecord->field('001') ) {
 290             $counter++;
 291             next;
 292         }
 293
 294         SetUTF8Flag( $authrecord );
 295
 296         my $authid=$authrecord->field('001')->data();
 297         my %newline;
 298         $newline{authid} = $authid;
 299         if ( !$skipmetadata ) {
 300             my $auth_tag_to_report;
 301             $auth_tag_to_report = Koha::Authority::Types->find($authtypecode)->auth_tag_to_report
 302                 if $authtypecode;
 303             my $reported_tag;
 304             my $mainentry = $authrecord->field($auth_tag_to_report);
 305             if ($mainentry) {
 306                 foreach ( $mainentry->subfields() ) {
 307                     $reported_tag .= '$' . $_->[0] . $_->[1];
 308                 }
 309             }
 310
 311             my ( $thisauthtype, $thisauthtypecode );
 312             if ( my $authority = Koha::Authorities->find($authid) ) {
 313                 $thisauthtypecode = $authority->authtypecode;
 314                 $thisauthtype = Koha::Authority::Types->find($thisauthtypecode);
 315             }
 316             unless (defined $thisauthtype) {
 317                 $thisauthtypecode = $authtypecode;
 318                 $thisauthtype = Koha::Authority::Types->find($thisauthtypecode);
 319             }
 320             my $summary = BuildSummary( $authrecord, $authid, $thisauthtypecode );
 321
 322             if ( C4::Context->preference('ShowHeadingUse') ) {
 323                 # checking valid heading use
 324                 my $f008 = $authrecord->field('008');
 325                 my $pos14to16 = substr( $f008->data, 14, 3 );
 326                 my $main = substr( $pos14to16, 0, 1 );
 327                 $newline{main} = 1 if $main eq 'a';
 328                 my $subject = substr( $pos14to16, 1, 1);
 329                 $newline{subject} = 1 if $subject eq 'a';
 330                 my $series = substr( $pos14to16, 2, 1 );
 331                 $newline{series} = 1 if $series eq 'a';
 332             }
 333
 334             $newline{authtype}     = defined($thisauthtype) ?
 335                                         $thisauthtype->authtypetext : '';
 336             $newline{summary}      = $summary;
 337             $newline{even}         = $counter % 2;
 338             $newline{reported_tag} = $reported_tag;
 339         }
 340         $counter++;
 341         push @finalresult, \%newline;
 342         }## while counter
 343         ###
 344         if (! $skipmetadata) {
 345             for (my $z=0; $z<@finalresult; $z++){
 346                 my $count = Koha::Authorities->get_usage_count({ authid => $finalresult[$z]{authid} });
 347                 $finalresult[$z]{used}=$count;
 348             }# all $z's
 349         }
 350
 351     }## if nbresult
 352     NOLUCK:
 353     $oAResult->destroy();
 354     # $oAuth[0]->destroy();
 355
 356     return (\@finalresult, $nbresults);
 357 }
 358
 359 =head2 GuessAuthTypeCode
 360
 361   my $authtypecode = GuessAuthTypeCode($record);
 362
 363 Get the record and tries to guess the adequate authtypecode from its content.
 364
 365 =cut
 366
 367 sub GuessAuthTypeCode {
 368     my ($record, $heading_fields) = @_;
 369     return unless defined $record;
 370     $heading_fields //= {
 371     "MARC21"=>{
 372         '100'=>{authtypecode=>'PERSO_NAME'},
 373         '110'=>{authtypecode=>'CORPO_NAME'},
 374         '111'=>{authtypecode=>'MEETI_NAME'},
 375         '130'=>{authtypecode=>'UNIF_TITLE'},
 376         '147'=>{authtypecode=>'NAME_EVENT'},
 377         '148'=>{authtypecode=>'CHRON_TERM'},
 378         '150'=>{authtypecode=>'TOPIC_TERM'},
 379         '151'=>{authtypecode=>'GEOGR_NAME'},
 380         '155'=>{authtypecode=>'GENRE/FORM'},
 381         '162'=>{authtypecode=>'MED_PERFRM'},
 382         '180'=>{authtypecode=>'GEN_SUBDIV'},
 383         '181'=>{authtypecode=>'GEO_SUBDIV'},
 384         '182'=>{authtypecode=>'CHRON_SUBD'},
 385         '185'=>{authtypecode=>'FORM_SUBD'},
 386     },
 387 #200 Personal name      700, 701, 702 4-- with embedded 700, 701, 702 600
 388 #                    604 with embedded 700, 701, 702
 389 #210 Corporate or meeting name  710, 711, 712 4-- with embedded 710, 711, 712 601 604 with embedded 710, 711, 712
 390 #215 Territorial or geographic name     710, 711, 712 4-- with embedded 710, 711, 712 601, 607 604 with embedded 710, 711, 712
 391 #216 Trademark  716 [Reserved for future use]
 392 #220 Family name        720, 721, 722 4-- with embedded 720, 721, 722 602 604 with embedded 720, 721, 722
 393 #230 Title      500 4-- with embedded 500 605
 394 #240 Name and title (embedded 200, 210, 215, or 220 and 230)    4-- with embedded 7-- and 500 7--  604 with embedded 7-- and 500 500
 395 #245 Name and collective title (embedded 200, 210, 215, or 220 and 235)         4-- with embedded 7-- and 501 604 with embedded 7-- and 501 7-- 501
 396 #250 Topical subject    606
 397 #260 Place access       620
 398 #280 Form, genre or physical characteristics    608
 399 #
 400 #
 401 # Could also be represented with :
 402 #leader position 9
 403 #a = personal name entry
 404 #b = corporate name entry
 405 #c = territorial or geographical name
 406 #d = trademark
 407 #e = family name
 408 #f = uniform title
 409 #g = collective uniform title
 410 #h = name/title
 411 #i = name/collective uniform title
 412 #j = topical subject
 413 #k = place access
 414 #l = form, genre or physical characteristics
 415     "UNIMARC"=>{
 416         '200'=>{authtypecode=>'NP'},
 417         '210'=>{authtypecode=>'CO'},
 418         '215'=>{authtypecode=>'SNG'},
 419         '216'=>{authtypecode=>'TM'},
 420         '220'=>{authtypecode=>'FAM'},
 421         '230'=>{authtypecode=>'TU'},
 422         '235'=>{authtypecode=>'CO_UNI_TI'},
 423         '240'=>{authtypecode=>'SAUTTIT'},
 424         '245'=>{authtypecode=>'NAME_COL'},
 425         '250'=>{authtypecode=>'SNC'},
 426         '260'=>{authtypecode=>'PA'},
 427         '280'=>{authtypecode=>'GENRE/FORM'},
 428     }
 429 };
 430     foreach my $field (keys %{$heading_fields->{uc(C4::Context->preference('marcflavour'))} }) {
 431        return $heading_fields->{uc(C4::Context->preference('marcflavour'))}->{$field}->{'authtypecode'} if (defined $record->field($field));
 432     }
 433     return;
 434 }
 435
 436 =head2 GuessAuthId
 437
 438   my $authtid = GuessAuthId($record);
 439
 440 Get the record and tries to guess the adequate authtypecode from its content.
 441
 442 =cut
 443
 444 sub GuessAuthId {
 445     my ($record) = @_;
 446     return unless ($record && $record->field('001'));
 447 #    my $authtypecode=GuessAuthTypeCode($record);
 448 #    my ($tag,$subfield)=GetAuthMARCFromKohaField("auth_header.authid",$authtypecode);
 449 #    if ($tag > 010) {return $record->subfield($tag,$subfield)}
 450 #    else {return $record->field($tag)->data}
 451     return $record->field('001')->data;
 452 }
 453
 454 =head2 GetTagsLabels
 455
 456   $tagslabel= &GetTagsLabels($forlibrarian,$authtypecode)
 457
 458 returns a ref to hashref of authorities tag and subfield structure.
 459
 460 tagslabel usage :
 461
 462   $tagslabel->{$tag}->{$subfield}->{'attribute'}
 463
 464 where attribute takes values in :
 465
 466   lib
 467   tab
 468   mandatory
 469   repeatable
 470   authorised_value
 471   authtypecode
 472   value_builder
 473   kohafield
 474   seealso
 475   hidden
 476   isurl
 477   link
 478
 479 =cut
 480
 481 sub GetTagsLabels {
 482   my ($forlibrarian,$authtypecode)= @_;
 483   my $dbh=C4::Context->dbh;
 484   $authtypecode="" unless $authtypecode;
 485   my $sth;
 486   my $libfield = ($forlibrarian) ? 'liblibrarian' : 'libopac';
 487
 488
 489   # check that authority exists
 490   $sth=$dbh->prepare("SELECT count(*) FROM auth_tag_structure WHERE authtypecode=?");
 491   $sth->execute($authtypecode);
 492   my ($total) = $sth->fetchrow;
 493   $authtypecode="" unless ($total >0);
 494   $sth= $dbh->prepare(
 495 "SELECT auth_tag_structure.tagfield,auth_tag_structure.liblibrarian,auth_tag_structure.libopac,auth_tag_structure.mandatory,auth_tag_structure.repeatable
 496  FROM auth_tag_structure
 497  WHERE authtypecode=?
 498  ORDER BY tagfield"
 499     );
 500
 501   $sth->execute($authtypecode);
 502   my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 503
 504   while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 505         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 506         $res->{$tag}->{tab}        = " ";            # XXX
 507         $res->{$tag}->{mandatory}  = $mandatory;
 508         $res->{$tag}->{repeatable} = $repeatable;
 509   }
 510   $sth=      $dbh->prepare(
 511 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,frameworkcode as authtypecode,value_builder,kohafield,seealso,hidden,isurl,defaultvalue, display_order
 512 FROM auth_subfield_structure
 513 WHERE authtypecode=?
 514 ORDER BY tagfield, display_order, tagsubfield"
 515     );
 516     $sth->execute($authtypecode);
 517
 518     my $subfield;
 519     my $authorised_value;
 520     my $value_builder;
 521     my $kohafield;
 522     my $seealso;
 523     my $hidden;
 524     my $isurl;
 525     my $defaultvalue;
 526     my $display_order;
 527
 528     while (
 529         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 530         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 531         $value_builder, $kohafield,  $seealso,          $hidden,
 532         $isurl,         $defaultvalue, $display_order )
 533         = $sth->fetchrow
 534       )
 535     {
 536         $res->{$tag}->{$subfield}->{subfield}         = $subfield;
 537         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 538         $res->{$tag}->{$subfield}->{tab}              = $tab;
 539         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 540         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 541         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 542         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 543         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 544         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 545         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 546         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 547         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 548         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
 549         $res->{$tag}->{$subfield}->{display_order}    = $display_order;
 550     }
 551
 552     return $res;
 553 }
 554
 555 =head2 AddAuthority
 556
 557   $authid= &AddAuthority($record, $authid,$authtypecode)
 558
 559 Either Create Or Modify existing authority.
 560 returns authid of the newly created authority
 561
 562 =cut
 563
 564 sub AddAuthority {
 565
 566     # pass the MARC::Record to this function, and it will create the records in the authority table
 567     my ( $record, $authid, $authtypecode, $params ) = @_;
 568
 569     my $skip_record_index = $params->{skip_record_index} || 0;
 570
 571     my $dbh    = C4::Context->dbh;
 572     my $leader = '     nz  a22     o  4500';    #Leader for incomplete MARC21 record
 573
 574     # if authid empty => true add, find a new authid number
 575     my $format;
 576     if ( uc( C4::Context->preference('marcflavour') ) eq 'UNIMARC' ) {
 577         $format = 'UNIMARCAUTH';
 578     } else {
 579         $format = 'MARC21';
 580     }
 581
 582     #update date/time to 005 for marc and unimarc
 583     my $time = POSIX::strftime( "%Y%m%d%H%M%S", localtime );
 584     my $f5   = $record->field('005');
 585     if ( !$f5 ) {
 586         $record->insert_fields_ordered( MARC::Field->new( '005', $time . ".0" ) );
 587     } else {
 588         $f5->update( $time . ".0" );
 589     }
 590
 591     SetUTF8Flag($record);
 592     if ( $format eq "MARC21" ) {
 593         my $userenv = C4::Context->userenv;
 594         my $library;
 595         my $marcorgcode = C4::Context->preference('MARCOrgCode');
 596         if ( $userenv && $userenv->{'branch'} ) {
 597             $library = Koha::Libraries->find( $userenv->{'branch'} );
 598
 599             # userenv's library could not exist because of a trick in misc/commit_file.pl (see FIXME and set_userenv statement)
 600             $marcorgcode = $library ? $library->get_effective_marcorgcode : $marcorgcode;
 601         }
 602         if ( !$record->leader ) {
 603             $record->leader($leader);
 604         }
 605         if ( !$record->field('003') ) {
 606             $record->insert_fields_ordered(
 607                 MARC::Field->new( '003', $marcorgcode ),
 608             );
 609         }
 610         my $date = POSIX::strftime( "%y%m%d", localtime );
 611         if ( !$record->field('008') ) {
 612
 613             # Get a valid default value for field 008
 614             my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
 615             if ( !$default_008 or length($default_008) < 34 ) {
 616                 $default_008 = '|| aca||aabn           | a|a     d';
 617             } else {
 618                 $default_008 = substr( $default_008, 0, 34 );
 619             }
 620
 621             $record->insert_fields_ordered( MARC::Field->new( '008', $date . $default_008 ) );
 622         }
 623         if ( !$record->field('040') ) {
 624             $record->insert_fields_ordered(
 625                 MARC::Field->new(
 626                     '040', '', '',
 627                     'a' => $marcorgcode,
 628                     'c' => $marcorgcode,
 629                 )
 630             );
 631         }
 632     }
 633
 634     if ( $format eq "UNIMARCAUTH" ) {
 635         $record->leader("     nx  j22             ") unless ( $record->leader() );
 636         my $date            = POSIX::strftime( "%Y%m%d", localtime );
 637         my $defaultfield100 = C4::Context->preference('UNIMARCAuthorityField100');
 638         if ( my $string = $record->subfield( '100', "a" ) ) {
 639             $string =~ s/fre50/frey50/;
 640             $record->field('100')->update( 'a' => $string );
 641         } elsif ( $record->field('100') ) {
 642             $record->field('100')->update( 'a' => $date . $defaultfield100 );
 643         } else {
 644             $record->append_fields(
 645                 MARC::Field->new(
 646                     '100', ' ', ' '
 647                     , 'a' => $date . $defaultfield100
 648                 )
 649             );
 650         }
 651     }
 652     my ( $auth_type_tag, $auth_type_subfield ) = get_auth_type_location($authtypecode);
 653     if ( !$authid and $format eq "MARC21" ) {
 654
 655         # only need to do this fix when modifying an existing authority
 656         C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location( $record, $auth_type_tag, $auth_type_subfield );
 657     }
 658     if ( my $field = $record->field($auth_type_tag) ) {
 659         $field->update( $auth_type_subfield => $authtypecode );
 660     } else {
 661         $record->add_fields( $auth_type_tag, '', '', $auth_type_subfield => $authtypecode );
 662     }
 663
 664     if ( C4::Context->preference('StripWhitespaceChars') ) {
 665         my $p = Koha::RecordProcessor->new( { filters => qw(TrimFields) } );
 666         $p->process($record);
 667     }
 668
 669     # Save record into auth_header, update 001
 670     my $action;
 671     my $authority;
 672     if ( !$authid ) {
 673         $action = 'create';
 674
 675         # Save a blank record, get authid
 676         $authority = Koha::Authority->new( { datecreated => \'NOW()', marcxml => '' } )->store();
 677         $authority->discard_changes();
 678         $authid = $authority->authid;
 679         logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
 680     } else {
 681         $action    = 'modify';
 682         $authority = Koha::Authorities->find($authid);
 683     }
 684
 685     # Insert/update the recordID in MARC record
 686     $record->delete_field( $record->field('001') );
 687     $record->insert_fields_ordered( MARC::Field->new( '001', $authid ) );
 688
 689     # Update
 690     $authority->update(
 691         { authtypecode => $authtypecode, marc => $record->as_usmarc, marcxml => $record->as_xml_record($format) } );
 692
 693     unless ($skip_record_index) {
 694         my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
 695         $indexer->index_records( $authid, "specialUpdate", "authorityserver", $record );
 696     }
 697
 698     _after_authority_action_hooks( { action => $action, authority_id => $authid } );
 699     return ($authid);
 700 }
 701
 702 =head2 DelAuthority
 703
 704     DelAuthority({ authid => $authid, [ skip_merge => 1 ] });
 705
 706 Deletes $authid and calls merge to cleanup linked biblio records.
 707 Parameter skip_merge is used in authorities/merge.pl. You should normally not
 708 use it.
 709
 710 skip_record_index will skip the indexation step.
 711
 712 =cut
 713
 714 sub DelAuthority {
 715     my ( $params ) = @_;
 716     my $authid = $params->{authid} || return;
 717     my $skip_merge = $params->{skip_merge};
 718     my $skip_record_index = $params->{skip_record_index} || 0;
 719
 720     my $dbh = C4::Context->dbh;
 721
 722     # Remove older pending merge requests for $authid to itself. (See bug 22437)
 723     my $condition = { authid => $authid, authid_new => [undef, 0, $authid], done => 0 };
 724     Koha::Authority::MergeRequests->search($condition)->delete;
 725
 726     merge({ mergefrom => $authid }) if !$skip_merge;
 727     $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
 728     logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
 729     unless ( $skip_record_index ) {
 730         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
 731         $indexer->index_records( $authid, "recordDelete", "authorityserver", undef );
 732     }
 733
 734     _after_authority_action_hooks({ action => 'delete', authority_id => $authid });
 735 }
 736
 737 =head2 ModAuthority
 738
 739   $authid= &ModAuthority($authid,$record,$authtypecode, [ { skip_merge => 1 ] )
 740
 741 Modifies authority record, optionally updates attached biblios.
 742 The parameter skip_merge is optional and should be used with care.
 743
 744 skip_record_index will skip the indexation step.
 745
 746 =cut
 747
 748 sub ModAuthority {
 749     my ( $authid, $record, $authtypecode, $params ) = @_;
 750
 751     my $skip_record_index = $params->{skip_record_index} || 0;
 752
 753     my $oldrecord = GetAuthority($authid);
 754     #Now rewrite the $record to table with an add
 755     $authid = AddAuthority($record, $authid, $authtypecode, { skip_record_index => $skip_record_index });
 756     merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record }) if !$params->{skip_merge};
 757     logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
 758     return $authid;
 759 }
 760
 761 =head2 GetAuthorityXML
 762
 763   $marcxml= &GetAuthorityXML( $authid)
 764
 765 returns xml form of record $authid
 766
 767 =cut
 768
 769 sub GetAuthorityXML {
 770   # Returns MARC::XML of the authority passed in parameter.
 771   my ( $authid ) = @_;
 772   if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
 773       my $dbh=C4::Context->dbh;
 774       my $sth = $dbh->prepare("select marcxml from auth_header where authid=? "  );
 775       $sth->execute($authid);
 776       my ($marcxml)=$sth->fetchrow;
 777       return $marcxml;
 778   }
 779   else {
 780       # for MARC21, call GetAuthority instead of
 781       # getting the XML directly since we may
 782       # need to fix up the location of the authority
 783       # code -- note that this is reasonably safe
 784       # because GetAuthorityXML is used only by the
 785       # indexing processes like zebraqueue_start.pl
 786       my $record = GetAuthority($authid);
 787       return $record->as_xml_record('MARC21');
 788   }
 789 }
 790
 791 =head2 GetAuthority
 792
 793   $record= &GetAuthority( $authid)
 794
 795 Returns MARC::Record of the authority passed in parameter.
 796
 797 =cut
 798
 799 sub GetAuthority {
 800     my ($authid)=@_;
 801     my $authority = Koha::MetadataRecord::Authority->get_from_authid($authid);
 802     return unless $authority;
 803     return ($authority->record);
 804 }
 805
 806 =head2 FindDuplicateAuthority
 807
 808   $record= &FindDuplicateAuthority( $record, $authtypecode)
 809
 810 return $authid,Summary if duplicate is found.
 811
 812 Comments : an improvement would be to return All the records that match.
 813
 814 =cut
 815
 816 sub FindDuplicateAuthority {
 817
 818     my ($record,$authtypecode)=@_;
 819     my $dbh = C4::Context->dbh;
 820     my $auth_tag_to_report = Koha::Authority::Types->find($authtypecode)->auth_tag_to_report;
 821     # build a request for SearchAuthorities
 822     my $op = 'AND';
 823     my $query='at:"'.$authtypecode.'" '; # Quote authtype code to avoid unescaping slash in GENRE/FORM later
 824     my $filtervalues=qr([\001-\040\Q!'"`#$%&*+,-./:;<=>?@(){[}_|~\E\]]);
 825     if ($record->field($auth_tag_to_report)) {
 826         foreach ($record->field($auth_tag_to_report)->subfields()) {
 827             $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
 828         }
 829     }
 830     my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::AUTHORITIES_INDEX});
 831     my ($error, $results, $total_hits) = $searcher->simple_search_compat( $query, 0, 1, [ 'authorityserver' ] );
 832     # there is at least 1 result => return the 1st one
 833     if (!defined $error && @{$results} ) {
 834         my $marcrecord = C4::Search::new_record_from_zebra(
 835             'authorityserver',
 836             $results->[0]
 837         );
 838         return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
 839     }
 840     # no result, returns nothing
 841     return;
 842 }
 843
 844 =head2 BuildSummary
 845
 846   $summary= &BuildSummary( $record, $authid, $authtypecode)
 847
 848 Returns a hashref with a summary of the specified record.
 849
 850 Comment : authtypecode can be inferred from both record and authid.
 851 Moreover, authid can also be inferred from $record.
 852 Would it be interesting to delete those things.
 853
 854 =cut
 855
 856 sub BuildSummary {
 857     ## give this a Marc record to return summary
 858     my ($record,$authid,$authtypecode)=@_;
 859     my $dbh=C4::Context->dbh;
 860     my %summary;
 861     my $summary_template;
 862     # handle $authtypecode is NULL or eq ""
 863     if ($authtypecode) {
 864         my $authref = Koha::Authority::Types->find($authtypecode);
 865         if ( $authref ) {
 866             $summary{authtypecode} = $authref->authtypecode;
 867             $summary{type} = $authref->authtypetext;
 868             $summary_template = $authref->summary;
 869             # for MARC21, the authority type summary displays a label meant for
 870             # display
 871             if (C4::Context->preference('marcflavour') ne 'UNIMARC') {
 872                 $summary{label} = $authref->summary;
 873             } else {
 874                 $summary{summary} = $authref->summary;
 875             }
 876         }
 877     }
 878     my $marc21subfields = 'abcdfghjklmnopqrstuvxyz68';
 879     my %marc21controlrefs = ( 'a' => 'earlier',
 880         'b' => 'later',
 881         'd' => 'acronym',
 882         'f' => 'musical',
 883         'g' => 'broader',
 884         'h' => 'narrower',
 885         'n' => 'notapplicable',
 886         'i' => 'subfi',
 887         't' => 'parent'
 888     );
 889     my %unimarc_relation_from_code = (
 890         g => 'broader',
 891         h => 'narrower',
 892         a => 'seealso',
 893     );
 894     my %thesaurus;
 895     $thesaurus{'1'}="Peuples";
 896     $thesaurus{'2'}="Anthroponymes";
 897     $thesaurus{'3'}="Oeuvres";
 898     $thesaurus{'4'}="Chronologie";
 899     $thesaurus{'5'}="Lieux";
 900     $thesaurus{'6'}="Sujets";
 901     #thesaurus a remplir
 902     my $reported_tag;
 903 # if the library has a summary defined, use it. Otherwise, build a standard one
 904 # FIXME - it appears that the summary field in the authority frameworks
 905 #         can work as a display template.  However, this doesn't
 906 #         suit the MARC21 version, so for now the "templating"
 907 #         feature will be enabled only for UNIMARC for backwards
 908 #         compatibility.
 909     if ($summary{summary} and C4::Context->preference('marcflavour') eq 'UNIMARC') {
 910         my @matches = ($summary{summary} =~ m/\[(.*?)(\d{3})([\*a-z0-9])(.*?)\]/g);
 911         my (@textbefore, @tag, @subtag, @textafter);
 912         for(my $i = 0; $i < scalar @matches; $i++){
 913             push @textbefore, $matches[$i] if($i%4 == 0);
 914             push @tag,        $matches[$i] if($i%4 == 1);
 915             push @subtag,     $matches[$i] if($i%4 == 2);
 916             push @textafter,  $matches[$i] if($i%4 == 3);
 917         }
 918         for(my $i = scalar @tag; $i >= 0; $i--){
 919             my $textbefore = $textbefore[$i] || '';
 920             my $tag = $tag[$i] || '';
 921             my $subtag = $subtag[$i] || '';
 922             my $textafter = $textafter[$i] || '';
 923             my $value = '';
 924             my $field = $record->field($tag);
 925             if ( $field ) {
 926                 if($subtag eq '*') {
 927                     if($tag < 10) {
 928                         $value = $textbefore . $field->data() . $textafter;
 929                     }
 930                 } else {
 931                     my @subfields = $field->subfield($subtag);
 932                     if(@subfields > 0) {
 933                         $value = $textbefore . join (" - ", @subfields) . $textafter;
 934                     }
 935                 }
 936             }
 937             $summary{summary} =~ s/\[\Q$textbefore$tag$subtag$textafter\E\]/$value/;
 938         }
 939         $summary{summary} =~ s/\\n/<br \/>/g;
 940     }
 941     my @authorized;
 942     my @notes;
 943     my @seefrom;
 944     my @seealso;
 945     my @otherscript;
 946     my @equalterm;
 947
 948     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 949 # construct UNIMARC summary, that is quite different from MARC21 one
 950 # accepted form
 951         foreach my $field ($record->field('2..')) {
 952             push @authorized, {
 953                 heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'),
 954                 hemain  => ( $field->subfield('a') // undef ),
 955                 field   => $field->tag(),
 956             };
 957         }
 958 # rejected form(s)
 959         foreach my $field ($record->field('3..')) {
 960             push @notes, { note => $field->subfield('a'), field => $field->tag() };
 961         }
 962         foreach my $field ($record->field('4..')) {
 963             my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : '';
 964             push @seefrom, {
 965                 heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'),
 966                 hemain  => ( $field->subfield('a') // undef ),
 967                 type    => 'seefrom',
 968                 field   => $field->tag(),
 969             };
 970         }
 971
 972         # see :
 973         @seealso = map {
 974             my $type = $unimarc_relation_from_code{$_->subfield('5') || 'a'};
 975             my $heading = $_->as_string('abcdefgjxyz');
 976             {
 977                 field   => $_->tag,
 978                 type    => $type,
 979                 heading => $heading,
 980                 hemain  => ( $_->subfield('a') // undef ),
 981                 search  => $heading,
 982                 authid  => ( $_->subfield('9') // undef ),
 983             }
 984         } $record->field('5..');
 985
 986         # Other forms
 987         @otherscript = map { {
 988             lang      => length ($_->subfield('8')) == 6 ? substr ($_->subfield('8'), 3, 3) : $_->subfield('8') || '',
 989             term      => $_->subfield('a') . ($_->subfield('b') ? ', ' . $_->subfield('b') : ''),
 990             direction => 'ltr',
 991             field     => $_->tag,
 992         } } $record->field('7..');
 993
 994     } else {
 995 # construct MARC21 summary
 996 # FIXME - looping over 1XX is questionable
 997 # since MARC21 authority should have only one 1XX
 998         use C4::Heading::MARC21;
 999         my $handler = C4::Heading::MARC21->new();
1000         my $subfields_to_report;
1001         my $subfields_to_subdivision = "";
1002         my $delimiter                = C4::Context->preference('AuthoritySeparator');
1003
1004         foreach my $field ($record->field('1..')) {
1005             my $tag = $field->tag();
1006             next if "152" eq $tag;
1007 # FIXME - 152 is not a good tag to use
1008 # in MARC21 -- purely local tags really ought to be
1009 # 9XX
1010
1011             $subfields_to_report = $handler->get_auth_heading_subfields_to_report($tag);
1012
1013             if ($subfields_to_report) {
1014                 push @authorized, {
1015                     heading => $field->as_string($subfields_to_report),
1016                     hemain  => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ),
1017                     field   => $tag,
1018                 };
1019             } else {
1020                 push @authorized, {
1021                     heading => $field->as_string(),
1022                     hemain  => ( $field->subfield( 'a' ) // undef ),
1023                     field   => $tag,
1024                 };
1025             }
1026         }
1027         foreach my $field ($record->field('4..')) { #See From
1028             my $type = 'seefrom';
1029             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1030             if ($type eq 'notapplicable') {
1031                 $type = substr $field->subfield('w'), 2, 1;
1032                 $type = 'earlier' if $type && $type ne 'n';
1033             }
1034             if ($type eq 'subfi') {
1035                 push @seefrom, {
1036                     heading => $field->as_string($marc21subfields),
1037                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1038                     type    => ($field->subfield('i') || ''),
1039                     field   => $field->tag(),
1040                 };
1041             } else {
1042                 push @seefrom, {
1043                     heading => $field->as_string($marc21subfields),
1044                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1045                     type    => $type,
1046                     field   => $field->tag(),
1047                 };
1048             }
1049         }
1050         foreach my $field ($record->field('5..')) { #See Also
1051             my $type = 'seealso';
1052             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1053             if ($type eq 'notapplicable') {
1054                 $type = substr $field->subfield('w'), 2, 1;
1055                 $type = 'earlier' if $type && $type ne 'n';
1056             }
1057             if ($type eq 'subfi') {
1058                 push @seealso, {
1059                     heading => $field->as_string($marc21subfields),
1060                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1061                     type    => scalar $field->subfield('i'),
1062                     field   => $field->tag(),
1063                     search  => $field->as_string($marc21subfields) || '',
1064                     authid  => $field->subfield('9') || ''
1065                 };
1066             } else {
1067                 push @seealso, {
1068                     heading => $field->as_string($marc21subfields),
1069                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1070                     type    => $type,
1071                     field   => $field->tag(),
1072                     search  => $field->as_string($marc21subfields) || '',
1073                     authid  => $field->subfield('9') || ''
1074                 };
1075             }
1076         }
1077         foreach my $field ($record->field('6..')) {
1078             push @notes, { note => $field->as_string(), field => $field->tag() };
1079         }
1080
1081      foreach my $field ( $record->field('7..') ) {
1082         my $tag = $field->tag();
1083
1084         if ( $tag eq '700' ) {
1085             $subfields_to_report      = 'abcdefghjklmnopqrst';
1086             $subfields_to_subdivision = 'vxyz';
1087         } elsif ( $tag eq '710' ) {
1088             $subfields_to_report      = 'abcdefghklmnoprst';
1089             $subfields_to_subdivision = 'vxyz';
1090         } elsif ( $tag eq '711' ) {
1091             $subfields_to_report      = 'acdefghklnpqst';
1092             $subfields_to_subdivision = 'vxyz';
1093         } elsif ( $tag eq '730' ) {
1094             $subfields_to_report      = 'adfghklmnoprst';
1095             $subfields_to_subdivision = 'vxyz';
1096         } elsif ( $tag eq '748' ) {
1097             $subfields_to_report      = 'ab';
1098             $subfields_to_subdivision = 'vxyz';
1099         } elsif ( $tag eq '750' ) {
1100             $subfields_to_report      = 'ab';
1101             $subfields_to_subdivision = 'vxyz';
1102         } elsif ( $tag eq '751' ) {
1103             $subfields_to_report      = 'a';
1104             $subfields_to_subdivision = 'vxyz';
1105         } elsif ( $tag eq '755' ) {
1106             $subfields_to_report      = 'abvxyz';
1107             $subfields_to_subdivision = 'vxyz';
1108         } elsif ( $tag eq '780' ) {
1109             $subfields_to_report = 'vxyz';
1110             $delimiter           = " ";
1111         } elsif ( $tag eq '781' ) {
1112             $subfields_to_report = 'vxyz';
1113             $delimiter           = " ";
1114         } elsif ( $tag eq '782' ) {
1115             $subfields_to_report = 'vxyz';
1116             $delimiter           = " ";
1117         } elsif ( $tag eq '785' ) {
1118             $subfields_to_report = 'vxyz';
1119             $delimiter           = " ";
1120         }
1121
1122         my $heading = $field->as_string($subfields_to_report);
1123
1124         my $subheading = $field->as_string( $subfields_to_subdivision, $delimiter );
1125         if ( length $subheading > 0 ) {
1126             $heading .= $delimiter . $subheading;
1127         }
1128
1129         if ($subfields_to_report) {
1130             push @equalterm, {
1131                 heading => $heading,
1132                 hemain  => ( $field->subfield( substr( $subfields_to_report, 0, 1 ) ) // undef ),
1133                 field   => $tag,
1134             };
1135         } else {
1136             push @equalterm, {
1137                 heading => $field->as_string(),
1138                 hemain  => ( $field->subfield('a') // undef ),
1139                 field   => $tag,
1140             };
1141         }
1142     }
1143
1144         foreach my $field ($record->field('880')) {
1145             my $linkage = $field->subfield('6');
1146             my $category = substr $linkage, 0, 1;
1147             if ($category eq '1') {
1148                 $category = 'preferred';
1149             } elsif ($category eq '4') {
1150                 $category = 'seefrom';
1151             } elsif ($category eq '5') {
1152                 $category = 'seealso';
1153             }
1154             my $type;
1155             if ($field->subfield('w')) {
1156                 $type = $marc21controlrefs{substr $field->subfield('w'), '0'};
1157             } else {
1158                 $type = $category;
1159             }
1160             my $direction = $linkage =~ m#/r$# ? 'rtl' : 'ltr';
1161             push @otherscript, { term => $field->as_string($subfields_to_report), category => $category, type => $type, direction => $direction, linkage => $linkage };
1162         }
1163     }
1164     $summary{mainentry}     = $authorized[0]->{heading};
1165     $summary{mainmainentry} = $authorized[0]->{hemain};
1166     $summary{authorized}    = \@authorized;
1167     $summary{notes}         = \@notes;
1168     $summary{seefrom}       = \@seefrom;
1169     $summary{seealso}       = \@seealso;
1170     $summary{otherscript}   = \@otherscript;
1171     $summary{equalterm}     = \@equalterm;
1172     return \%summary;
1173 }
1174
1175 =head2 GetAuthorizedHeading
1176
1177   $heading = &GetAuthorizedHeading({ record => $record, authid => $authid })
1178
1179 Takes a MARC::Record object describing an authority record or an authid, and
1180 returns a string representation of the first authorized heading. This routine
1181 should be considered a temporary shim to ease the future migration of authority
1182 data from C4::AuthoritiesMarc to the object-oriented Koha::*::Authority.
1183
1184 =cut
1185
1186 sub GetAuthorizedHeading {
1187     my $args = shift;
1188     my $record;
1189     unless ($record = $args->{record}) {
1190         return unless $args->{authid};
1191         $record = GetAuthority($args->{authid});
1192     }
1193     return unless (ref $record eq 'MARC::Record');
1194     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1195 # construct UNIMARC summary, that is quite different from MARC21 one
1196 # accepted form
1197         foreach my $field ($record->field('2..')) {
1198             return $field->as_string('abcdefghijlmnopqrstuvwxyz');
1199         }
1200     } else {
1201         use C4::Heading::MARC21;
1202         my $handler = C4::Heading::MARC21->new();
1203
1204         foreach my $field ($record->field('1..')) {
1205             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1206             return $field->as_string($subfields) if ($subfields);
1207         }
1208     }
1209     return;
1210 }
1211
1212 =head2 CompareFieldWithAuthority
1213
1214   $match = &CompareFieldWithAuthority({ field => $field, authid => $authid })
1215
1216 Takes a MARC::Field from a bibliographic record and an authid, and returns true if they match.
1217
1218 =cut
1219
1220 sub CompareFieldWithAuthority {
1221     my $args = shift;
1222
1223     my $record = GetAuthority($args->{authid});
1224     return unless (ref $record eq 'MARC::Record');
1225     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1226         # UNIMARC has same subfields for bibs and authorities
1227         foreach my $field ($record->field('2..')) {
1228             return compare_fields($field, $args->{field}, 'abcdefghijlmnopqrstuvwxyz');
1229         }
1230     } else {
1231         use C4::Heading::MARC21;
1232         my $handler = C4::Heading::MARC21->new();
1233
1234         foreach my $field ($record->field('1..')) {
1235             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1236             return compare_fields($field, $args->{field}, $subfields) if ($subfields);
1237         }
1238     }
1239     return 0;
1240 }
1241
1242 =head2 BuildAuthHierarchies
1243
1244   $text= &BuildAuthHierarchies( $authid, $force)
1245
1246 return text containing trees for hierarchies
1247 for them to be stored in auth_header
1248
1249 Example of text:
1250 122,1314,2452;1324,2342,3,2452
1251
1252 =cut
1253
1254 sub BuildAuthHierarchies{
1255     my $authid = shift @_;
1256 #   warn "authid : $authid";
1257     my $force = shift @_ || (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 0 : 1);
1258     my @globalresult;
1259     my $dbh=C4::Context->dbh;
1260     my $hierarchies;
1261     my $data = GetHeaderAuthority($authid);
1262     if ($data->{'authtrees'} and not $force){
1263         return $data->{'authtrees'};
1264 #  } elsif ($data->{'authtrees'}){
1265 #    $hierarchies=$data->{'authtrees'};
1266     } else {
1267         my $record = GetAuthority($authid);
1268         my $found;
1269         return unless $record;
1270         foreach my $field ($record->field('5..')){
1271             my $broader = 0;
1272             $broader = 1 if (
1273                     (C4::Context->preference('marcflavour') eq 'UNIMARC' && $field->subfield('5') && $field->subfield('5') eq 'g') ||
1274                     (C4::Context->preference('marcflavour') ne 'UNIMARC' && $field->subfield('w') && substr($field->subfield('w'), 0, 1) eq 'g'));
1275             if ($broader) {
1276                 my $subfauthid=_get_authid_subfield($field) || '';
1277                 next if ($subfauthid eq $authid);
1278                 my $parentrecord = GetAuthority($subfauthid);
1279                 next unless $parentrecord;
1280                 my $localresult=$hierarchies;
1281                 my $trees;
1282                 $trees = BuildAuthHierarchies($subfauthid);
1283                 my @trees;
1284                 if ($trees=~/;/){
1285                     @trees = split(/;/,$trees);
1286                 } else {
1287                     push @trees, $trees;
1288                 }
1289                 foreach (@trees){
1290                     $_.= ",$authid";
1291                 }
1292                 @globalresult = (@globalresult,@trees);
1293                 $found=1;
1294             }
1295             $hierarchies=join(";",@globalresult);
1296         }
1297 #Unless there is no ancestor, I am alone.
1298         $hierarchies="$authid" unless ($hierarchies);
1299     }
1300     AddAuthorityTrees($authid,$hierarchies);
1301     return $hierarchies;
1302 }
1303
1304 =head2 BuildAuthHierarchy
1305
1306   $ref= &BuildAuthHierarchy( $record, $class,$authid)
1307
1308 return a hashref in order to display hierarchy for record and final Authid $authid
1309
1310 "loopparents"
1311 "loopchildren"
1312 "class"
1313 "loopauthid"
1314 "current_value"
1315 "value"
1316
1317 =cut
1318
1319 sub BuildAuthHierarchy{
1320     my $record = shift @_;
1321     my $class = shift @_;
1322     my $authid_constructed = shift @_;
1323     return unless ($record && $record->field('001'));
1324     my $authid=$record->field('001')->data();
1325     my %cell;
1326     my $parents=""; my $children="";
1327     my (@loopparents,@loopchildren);
1328     my $marcflavour = C4::Context->preference('marcflavour');
1329     my $relationshipsf = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1330     foreach my $field ($record->field('5..')){
1331         my $subfauthid=_get_authid_subfield($field);
1332         if ($subfauthid && $field->subfield($relationshipsf) && $field->subfield('a')){
1333             my $relationship = substr($field->subfield($relationshipsf), 0, 1);
1334             if ($relationship eq 'h'){
1335                 push @loopchildren, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1336             }
1337             elsif ($relationship eq 'g'){
1338                 push @loopparents, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1339             }
1340 # brothers could get in there with an else
1341         }
1342     }
1343     $cell{"parents"}=\@loopparents;
1344     $cell{"children"}=\@loopchildren;
1345     $cell{"class"}=$class;
1346     $cell{"authid"}=$authid;
1347     $cell{"current_value"} =1 if ($authid eq $authid_constructed);
1348     $cell{"value"}=C4::Context->preference('marcflavour') eq 'UNIMARC' ? $record->subfield('2..',"a") : $record->subfield('1..', 'a');
1349     return \%cell;
1350 }
1351
1352 =head2 BuildAuthHierarchyBranch
1353
1354   $branch = &BuildAuthHierarchyBranch( $tree, $authid[, $cnt])
1355
1356 Return a data structure representing an authority hierarchy
1357 given a list of authorities representing a single branch in
1358 an authority hierarchy tree. $authid is the current node in
1359 the tree (which may or may not be somewhere in the middle).
1360 $cnt represents the level of the upper-most item, and is only
1361 used when BuildAuthHierarchyBranch is called recursively (i.e.,
1362 don't ever pass in anything but zero to it).
1363
1364 =cut
1365
1366 sub BuildAuthHierarchyBranch {
1367     my ($tree, $authid, $cnt) = @_;
1368     $cnt |= 0;
1369     my $elementdata = GetAuthority(shift @$tree);
1370     my $branch = BuildAuthHierarchy($elementdata,"child".$cnt, $authid);
1371     if (scalar @$tree > 0) {
1372         my $nextBranch = BuildAuthHierarchyBranch($tree, $authid, ++$cnt);
1373         my $nextAuthid = $nextBranch->{authid};
1374         my $found;
1375         # If we already have the next branch listed as a child, let's
1376         # replace the old listing with the new one. If not, we will add
1377         # the branch at the end.
1378         foreach my $cell (@{$branch->{children}}) {
1379             if ($cell->{authid} eq $nextAuthid) {
1380                 $cell = $nextBranch;
1381                 $found = 1;
1382                 last;
1383             }
1384         }
1385         push @{$branch->{children}}, $nextBranch unless $found;
1386     }
1387     return $branch;
1388 }
1389
1390 =head2 GenerateHierarchy
1391
1392   $hierarchy = &GenerateHierarchy($authid);
1393
1394 Return an arrayref holding one or more "trees" representing
1395 authority hierarchies.
1396
1397 =cut
1398
1399 sub GenerateHierarchy {
1400     my ($authid) = @_;
1401     my $trees    = BuildAuthHierarchies($authid);
1402     my @trees    = split /;/,$trees ;
1403     push @trees,$trees unless (@trees);
1404     my @loophierarchies;
1405     foreach my $tree (@trees){
1406         my @tree=split /,/,$tree;
1407         push @tree, $tree unless (@tree);
1408         my $branch = BuildAuthHierarchyBranch(\@tree, $authid);
1409         push @loophierarchies, [ $branch ];
1410     }
1411     return \@loophierarchies;
1412 }
1413
1414 sub _get_authid_subfield{
1415     my ($field)=@_;
1416     return $field->subfield('9')||$field->subfield('3');
1417 }
1418
1419 =head2 GetHeaderAuthority
1420
1421   $ref= &GetHeaderAuthority( $authid)
1422
1423 return a hashref in order auth_header table data
1424
1425 =cut
1426
1427 sub GetHeaderAuthority{
1428   my $authid = shift @_;
1429   my $sql= "SELECT * from auth_header WHERE authid = ?";
1430   my $dbh=C4::Context->dbh;
1431   my $rq= $dbh->prepare($sql);
1432   $rq->execute($authid);
1433   my $data= $rq->fetchrow_hashref;
1434   return $data;
1435 }
1436
1437 =head2 AddAuthorityTrees
1438
1439   $ref= &AddAuthorityTrees( $authid, $trees)
1440
1441 return success or failure
1442
1443 =cut
1444
1445 sub AddAuthorityTrees{
1446   my $authid = shift @_;
1447   my $trees = shift @_;
1448   my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
1449   my $dbh=C4::Context->dbh;
1450   my $rq= $dbh->prepare($sql);
1451   return $rq->execute($trees,$authid);
1452 }
1453
1454 =head2 merge
1455
1456     $count = merge({
1457         mergefrom => $mergefrom,
1458         [ MARCfrom => $MARCfrom, ]
1459         [ mergeto => $mergeto, ]
1460         [ MARCto => $MARCto, ]
1461         [ biblionumbers => [ $a, $b, $c ], ]
1462         [ override_limit => 1, ]
1463     });
1464
1465 Merge biblios linked to authority $mergefrom (mandatory parameter).
1466 If $mergeto equals mergefrom, the linked biblio field is updated.
1467 If $mergeto is different, the biblio field will be linked to $mergeto.
1468 If $mergeto is missing, the biblio field is deleted.
1469
1470 MARCfrom is used to determine if a cleared subfield in the authority record
1471 should be removed from a biblio. MARCto is used to populate the biblio
1472 record with the updated values; if you do not pass it, the biblio field
1473 will be deleted (same as missing mergeto).
1474
1475 Normally all biblio records linked to $mergefrom, will be considered. But
1476 you can pass specific numbers via the biblionumbers parameter.
1477
1478 The parameter override_limit is used by the cron job to force larger
1479 postponed merges.
1480
1481 Note: Although $mergefrom and $mergeto will normally be of the same
1482 authority type, merge also supports moving to another authority type.
1483
1484 =cut
1485
1486 sub merge {
1487     my ( $params ) = @_;
1488     my $mergefrom = $params->{mergefrom} || return;
1489     my $MARCfrom = $params->{MARCfrom};
1490     my $mergeto = $params->{mergeto};
1491     my $MARCto = $params->{MARCto};
1492     my $override_limit = $params->{override_limit};
1493
1494     # If we do not have biblionumbers, we get all linked biblios if the
1495     # number of linked records does not exceed the limit UNLESS we override.
1496     my @biblionumbers;
1497     if( $params->{biblionumbers} ) {
1498         @biblionumbers = @{ $params->{biblionumbers} };
1499     } elsif( $override_limit ) {
1500         @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1501     } else { # now first check number of linked records
1502         my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
1503         my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
1504         if( $hits > 0 && $hits <= $max ) {
1505             @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1506         } elsif( $hits > $max ) { #postpone this merge to the cron job
1507             Koha::Authority::MergeRequest->new({
1508                 authid => $mergefrom,
1509                 oldrecord => $MARCfrom,
1510                 authid_new => $mergeto,
1511             })->store;
1512         }
1513     }
1514     return 0 if !@biblionumbers;
1515
1516     # Search authtypes and reporting tags
1517     my $authfrom = Koha::Authorities->find($mergefrom);
1518     my $authto = Koha::Authorities->find($mergeto);
1519     my $authtypefrom;
1520     my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1521     if( $mergeto && $mergefrom == $mergeto && $MARCfrom ) {
1522         # bulkmarcimport may have changed the authtype; see BZ 19693
1523         my $old_type = $MARCfrom->subfield( get_auth_type_location() ); # going via default
1524         if( $old_type && $authto && $old_type ne $authto->authtypecode ) {
1525             # Type change: handled by simulating a postponed merge where the auth record has been deleted already
1526             # This triggers a walk through all auth controlled tags
1527             undef $authfrom;
1528         }
1529     }
1530     $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode) if $authfrom;
1531     my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1532     my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1533
1534     my @record_to;
1535     @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
1536     # Exceptional: If MARCto and authtypeto exist but $auth_tag_to_report_to
1537     # is empty, make sure that $9 and $a remain (instead of clearing the
1538     # reference) in order to allow for data recovery.
1539     # Note: We need $a too, since a single $9 does not pass ModBiblio.
1540     if( $MARCto && $authtypeto && !@record_to  ) {
1541         push @record_to, [ 'a', ' ' ]; # do not remove the space
1542     }
1543
1544     my @record_from;
1545     if( !$authfrom && $MARCfrom && $MARCfrom->field('1..','2..') ) {
1546     # postponed merge, authfrom was deleted and MARCfrom only contains the old reporting tag (and possibly a 100 for UNIMARC)
1547     # 2XX is for UNIMARC; we use -1 in order to skip 100 in UNIMARC; this will not impact MARC21, since there is only one tag
1548         @record_from = ( $MARCfrom->field('1..','2..') )[-1]->subfields;
1549     } elsif( $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from) ) {
1550         @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields;
1551     }
1552
1553     # Get all candidate tags for the change
1554     # (This will reduce the search scope in marc records).
1555     # For a deleted authority record, we scan all auth controlled fields
1556     my $dbh = C4::Context->dbh;
1557     my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1558     my $tags_using_authtype = $authtypefrom && $authtypefrom->authtypecode ? $dbh->selectcol_arrayref( $sql, undef, ( $authtypefrom->authtypecode )) : $dbh->selectcol_arrayref( "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode IS NOT NULL AND authtypecode<>''" );
1559     my $tags_new;
1560     if( $authtypeto && ( !$authtypefrom || $authtypeto->authtypecode ne $authtypefrom->authtypecode )) {
1561         $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
1562     }
1563
1564     my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict';
1565     my $skip_subfields = $overwrite
1566         # This hash contains all subfields from the authority report fields
1567         # Including $MARCfrom as well as $MARCto
1568         # We only need it in loose merge mode; replaces the former $exclude
1569         ? {}
1570         : { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) };
1571
1572     my $counteditedbiblio = 0;
1573     foreach my $biblionumber ( @biblionumbers ) {
1574         my $biblio = Koha::Biblios->find($biblionumber);
1575         next unless $biblio;
1576         my $marcrecord = $biblio->metadata->record;
1577         my $update = 0;
1578         foreach my $tagfield (@$tags_using_authtype) {
1579             my $countfrom = 0;    # used in strict mode to remove duplicates
1580             foreach my $field ( $marcrecord->field($tagfield) ) {
1581                 my $auth_number = $field->subfield("9");    # link to authority
1582                 my $tag         = $field->tag();
1583                 next if !defined($auth_number) || $auth_number ne $mergefrom;
1584                 $countfrom++;
1585                 if ( !$mergeto || !@record_to ||
1586                   ( $overwrite && $countfrom > 1 ) ) {
1587                     # !mergeto or !record_to indicates a delete
1588                     # Other condition: remove this duplicate in strict mode
1589                     $marcrecord->delete_field($field);
1590                     $update = 1;
1591                     next;
1592                 }
1593                 my $newtag = $tags_new && @$tags_new
1594                   ? _merge_newtag( $tag, $tags_new )
1595                   : $tag;
1596                 my $controlled_ind = $authto->controlled_indicators({ record => $MARCto, biblio_tag => $newtag });
1597                 my $field_to = MARC::Field->new(
1598                     $newtag,
1599                     $controlled_ind->{ind1} // $field->indicator(1),
1600                     $controlled_ind->{ind2} // $field->indicator(2),
1601                     9 => $mergeto, # Needed to create field, will be moved
1602                 );
1603                 my ( @prefix, @postfix );
1604                 if ( !$overwrite ) {
1605                     # add subfields back in loose mode, check skip_subfields
1606                     # The first extra subfields will be in front of the
1607                     # controlled block, the rest at the end.
1608                     my $prefix_flag = 1;
1609                     foreach my $subfield ( $field->subfields ) {
1610                         next if $subfield->[0] eq '9'; # skip but leave flag
1611                         if ( $skip_subfields->{ $subfield->[0] } ) {
1612                             # This marks the beginning of the controlled block
1613                             $prefix_flag = 0;
1614                             next;
1615                         }
1616                         if ($prefix_flag) {
1617                             push @prefix, [ $subfield->[0], $subfield->[1] ];
1618                         } else {
1619                             push @postfix, [ $subfield->[0], $subfield->[1] ];
1620                         }
1621                     }
1622                 }
1623                 foreach my $subfield ( @prefix, @record_to, @postfix ) {
1624                     $field_to->add_subfields($subfield->[0] => $subfield->[1]);
1625                 }
1626                 if( exists $controlled_ind->{sub2} ) { # thesaurus info
1627                     if( defined $controlled_ind->{sub2} ) {
1628                         # Add or replace
1629                         $field_to->update( 2 => $controlled_ind->{sub2} );
1630                     } else {
1631                         # Key alerts us here to remove $2
1632                         $field_to->delete_subfield( code => '2' );
1633                     }
1634                 }
1635                 # Move $9 to the end
1636                 $field_to->delete_subfield( code => '9' );
1637                 $field_to->add_subfields( 9 => $mergeto );
1638
1639                 if ($tags_new && @$tags_new) {
1640                     $marcrecord->delete_field($field);
1641                     append_fields_ordered( $marcrecord, $field_to );
1642                 } else {
1643                     $field->replace_with($field_to);
1644                 }
1645                 $update = 1;
1646             }
1647         }
1648         next if !$update;
1649         ModBiblio($marcrecord, $biblionumber, GetFrameworkCode($biblionumber));
1650         $counteditedbiblio++;
1651     }
1652     return $counteditedbiblio;
1653 }
1654
1655 sub _merge_newtag {
1656 # Routine is only called for an (exceptional) authtypecode change
1657 # Fixes old behavior of returning the first tag found
1658     my ( $oldtag, $new_tags ) = @_;
1659
1660     # If we e.g. have 650 and 151,651,751 try 651 and check presence
1661     my $prefix = substr( $oldtag, 0, 1 );
1662     my $guess = $prefix . substr( $new_tags->[0], -2 );
1663     if( grep { $_ eq $guess } @$new_tags ) {
1664         return $guess;
1665     }
1666     # Otherwise return one from the same block e.g. 6XX for 650
1667     # If not there too, fall back to first new tag (old behavior!)
1668     my @same_block = grep { /^$prefix/ } @$new_tags;
1669     return @same_block ? $same_block[0] : $new_tags->[0];
1670 }
1671
1672 sub append_fields_ordered {
1673 # while we lack this function in MARC::Record
1674 # we do not want insert_fields_ordered since it inserts before
1675     my ( $record, $field ) = @_;
1676     if( my @flds = $record->field( $field->tag ) ) {
1677         $record->insert_fields_after( pop @flds, $field );
1678     } else { # now fallback to insert_fields_ordered
1679         $record->insert_fields_ordered( $field );
1680     }
1681 }
1682
1683 =head2 get_auth_type_location
1684
1685   my ($tag, $subfield) = get_auth_type_location($auth_type_code);
1686
1687 Get the tag and subfield used to store the heading type
1688 for indexing purposes.  The C<$auth_type> parameter is
1689 optional; if it is not supplied, assume ''.
1690
1691 This routine searches the MARC authority framework
1692 for the tag and subfield whose kohafield is
1693 C<auth_header.authtypecode>; if no such field is
1694 defined in the framework, default to the hardcoded value
1695 specific to the MARC format.
1696
1697 =cut
1698
1699 sub get_auth_type_location {
1700     my $auth_type_code = @_ ? shift : '';
1701
1702     my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code);
1703     if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') {
1704         return ($tag, $subfield);
1705     } else {
1706         if (C4::Context->preference('marcflavour') eq "MARC21")  {
1707             return C4::AuthoritiesMarc::MARC21::default_auth_type_location();
1708         } else {
1709             return C4::AuthoritiesMarc::UNIMARC::default_auth_type_location();
1710         }
1711     }
1712 }
1713
1714 =head2 compare_fields
1715
1716   my match = compare_fields($field1, $field2, 'abcde');
1717
1718 Compares the listed subfields of both fields and return true if they all match
1719
1720 =cut
1721
1722 sub compare_fields {
1723     my ($field1, $field2, $subfields) = @_;
1724
1725     foreach my $subfield (split(//, $subfields)) {
1726         my $subfield1 = $field1->subfield($subfield) // '';
1727         my $subfield2 = $field2->subfield($subfield) // '';
1728         return 0 unless $subfield1 eq $subfield2;
1729     }
1730     return 1;
1731 }
1732
1733
1734 =head2 _after_authority_action_hooks
1735
1736 Helper method that takes care of calling all plugin hooks
1737
1738 =cut
1739
1740 sub _after_authority_action_hooks {
1741     my ( $args ) = @_; # hash keys: action, authority_id
1742     return Koha::Plugins->call( 'after_authority_action', $args );
1743 }
1744
1745 END { }       # module clean-up code here (global destructor)
1746
1747 1;
1748 __END__
1749
1750 =head1 AUTHOR
1751
1752 Koha Development Team <http://koha-community.org/>
1753
1754 Paul POULAIN paul.poulain@free.fr
1755 Ere Maijala ere.maijala@helsinki.fi
1756
1757 =cut
1758