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