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(
 678             {
 679                 datecreated  => \'NOW()',
 680                 marcxml      => '',
 681                 authtypecode => $authtypecode
 682             }
 683         )->store();
 684         $authority->discard_changes();
 685         $authid = $authority->authid;
 686         logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
 687     } else {
 688         $action    = 'modify';
 689         $authority = Koha::Authorities->find($authid);
 690     }
 691
 692     # Insert/update the recordID in MARC record
 693     $record->delete_field( $record->field('001') );
 694     $record->insert_fields_ordered( MARC::Field->new( '001', $authid ) );
 695
 696     my $heading = $authority->heading_object( { record => $record } );
 697
 698     # Update
 699     $authority->update(
 700         {
 701             authtypecode => $authtypecode,
 702             marc         => $record->as_usmarc,
 703             marcxml      => $record->as_xml_record($format),
 704             heading      => $heading->display_form,
 705         }
 706     );
 707
 708     unless ($skip_record_index) {
 709         my $indexer = Koha::SearchEngine::Indexer->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } );
 710         $indexer->index_records( $authid, "specialUpdate", "authorityserver", $record );
 711     }
 712
 713     _after_authority_action_hooks( { action => $action, authority_id => $authid } );
 714     return ($authid);
 715 }
 716
 717 =head2 DelAuthority
 718
 719     DelAuthority({ authid => $authid, [ skip_merge => 1 ] });
 720
 721 Deletes $authid and calls merge to cleanup linked biblio records.
 722 Parameter skip_merge is used in authorities/merge.pl. You should normally not
 723 use it.
 724
 725 skip_record_index will skip the indexation step.
 726
 727 =cut
 728
 729 sub DelAuthority {
 730     my ( $params ) = @_;
 731     my $authid = $params->{authid} || return;
 732     my $skip_merge = $params->{skip_merge};
 733     my $skip_record_index = $params->{skip_record_index} || 0;
 734
 735     my $dbh = C4::Context->dbh;
 736
 737     # Remove older pending merge requests for $authid to itself. (See bug 22437)
 738     my $condition = { authid => $authid, authid_new => [undef, 0, $authid], done => 0 };
 739     Koha::Authority::MergeRequests->search($condition)->delete;
 740
 741     merge({ mergefrom => $authid }) if !$skip_merge;
 742     $dbh->do( "DELETE FROM auth_header WHERE authid=?", undef, $authid );
 743     logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog");
 744     unless ( $skip_record_index ) {
 745         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::AUTHORITIES_INDEX });
 746         $indexer->index_records( $authid, "recordDelete", "authorityserver", undef );
 747     }
 748
 749     _after_authority_action_hooks({ action => 'delete', authority_id => $authid });
 750 }
 751
 752 =head2 ModAuthority
 753
 754   $authid= &ModAuthority($authid,$record,$authtypecode, [ { skip_merge => 1 ] )
 755
 756 Modifies authority record, optionally updates attached biblios.
 757 The parameter skip_merge is optional and should be used with care.
 758
 759 skip_record_index will skip the indexation step.
 760
 761 =cut
 762
 763 sub ModAuthority {
 764     my ( $authid, $record, $authtypecode, $params ) = @_;
 765
 766     my $skip_record_index = $params->{skip_record_index} || 0;
 767
 768     my $oldrecord = GetAuthority($authid);
 769     #Now rewrite the $record to table with an add
 770     $authid = AddAuthority($record, $authid, $authtypecode, { skip_record_index => $skip_record_index });
 771     merge({ mergefrom => $authid, MARCfrom => $oldrecord, mergeto => $authid, MARCto => $record }) if !$params->{skip_merge};
 772     logaction( "AUTHORITIES", "MODIFY", $authid, "authority BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog");
 773     return $authid;
 774 }
 775
 776 =head2 GetAuthorityXML
 777
 778   $marcxml= &GetAuthorityXML( $authid)
 779
 780 returns xml form of record $authid
 781
 782 =cut
 783
 784 sub GetAuthorityXML {
 785   # Returns MARC::XML of the authority passed in parameter.
 786   my ( $authid ) = @_;
 787   if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
 788       my $dbh=C4::Context->dbh;
 789       my $sth = $dbh->prepare("select marcxml from auth_header where authid=? "  );
 790       $sth->execute($authid);
 791       my ($marcxml)=$sth->fetchrow;
 792       return $marcxml;
 793   }
 794   else {
 795       # for MARC21, call GetAuthority instead of
 796       # getting the XML directly since we may
 797       # need to fix up the location of the authority
 798       # code -- note that this is reasonably safe
 799       # because GetAuthorityXML is used only by the
 800       # indexing processes like zebraqueue_start.pl
 801       my $record = GetAuthority($authid);
 802       return $record->as_xml_record('MARC21');
 803   }
 804 }
 805
 806 =head2 GetAuthority
 807
 808   $record= &GetAuthority( $authid)
 809
 810 Returns MARC::Record of the authority passed in parameter.
 811
 812 =cut
 813
 814 sub GetAuthority {
 815     my ($authid)=@_;
 816     my $authority = Koha::MetadataRecord::Authority->get_from_authid($authid);
 817     return unless $authority;
 818     return ($authority->record);
 819 }
 820
 821 =head2 FindDuplicateAuthority
 822
 823   $record= &FindDuplicateAuthority( $record, $authtypecode)
 824
 825 return $authid,Summary if duplicate is found.
 826
 827 Comments : an improvement would be to return All the records that match.
 828
 829 =cut
 830
 831 sub FindDuplicateAuthority {
 832
 833     my ($record,$authtypecode)=@_;
 834     my $dbh = C4::Context->dbh;
 835     my $auth_tag_to_report = Koha::Authority::Types->find($authtypecode)->auth_tag_to_report;
 836     # build a request for SearchAuthorities
 837     my $op = 'AND';
 838     my $query='at:"'.$authtypecode.'" '; # Quote authtype code to avoid unescaping slash in GENRE/FORM later
 839     my $filtervalues=qr([\001-\040\Q!'"`#$%&*+,-./:;<=>?@(){[}_|~\E\]]);
 840     if ($record->field($auth_tag_to_report)) {
 841         foreach ($record->field($auth_tag_to_report)->subfields()) {
 842             $_->[1]=~s/$filtervalues/ /g; $query.= " $op he:\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/);
 843         }
 844     }
 845     my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::AUTHORITIES_INDEX});
 846     my ($error, $results, $total_hits) = $searcher->simple_search_compat( $query, 0, 1, [ 'authorityserver' ] );
 847     # there is at least 1 result => return the 1st one
 848     if (!defined $error && @{$results} ) {
 849         my $marcrecord = C4::Search::new_record_from_zebra(
 850             'authorityserver',
 851             $results->[0]
 852         );
 853         return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
 854     }
 855     # no result, returns nothing
 856     return;
 857 }
 858
 859 =head2 BuildSummary
 860
 861   $summary= &BuildSummary( $record, $authid, $authtypecode)
 862
 863 Returns a hashref with a summary of the specified record.
 864
 865 Comment : authtypecode can be inferred from both record and authid.
 866 Moreover, authid can also be inferred from $record.
 867 Would it be interesting to delete those things.
 868
 869 =cut
 870
 871 sub BuildSummary {
 872     ## give this a Marc record to return summary
 873     my ($record,$authid,$authtypecode)=@_;
 874     my $dbh=C4::Context->dbh;
 875     my %summary;
 876     my $summary_template;
 877     # handle $authtypecode is NULL or eq ""
 878     if ($authtypecode) {
 879         my $authref = Koha::Authority::Types->find($authtypecode);
 880         if ( $authref ) {
 881             $summary{authtypecode} = $authref->authtypecode;
 882             $summary{type} = $authref->authtypetext;
 883             $summary_template = $authref->summary;
 884             # for MARC21, the authority type summary displays a label meant for
 885             # display
 886             if (C4::Context->preference('marcflavour') ne 'UNIMARC') {
 887                 $summary{label} = $authref->summary;
 888             } else {
 889                 $summary{summary} = $authref->summary;
 890             }
 891         }
 892     }
 893     my $marc21subfields = 'abcdfghjklmnopqrstuvxyz68';
 894     my %marc21controlrefs = ( 'a' => 'earlier',
 895         'b' => 'later',
 896         'd' => 'acronym',
 897         'f' => 'musical',
 898         'g' => 'broader',
 899         'h' => 'narrower',
 900         'n' => 'notapplicable',
 901         'i' => 'subfi',
 902         't' => 'parent'
 903     );
 904     my %unimarc_relation_from_code = (
 905         g => 'broader',
 906         h => 'narrower',
 907         a => 'seealso',
 908     );
 909     my %thesaurus;
 910     $thesaurus{'1'}="Peuples";
 911     $thesaurus{'2'}="Anthroponymes";
 912     $thesaurus{'3'}="Oeuvres";
 913     $thesaurus{'4'}="Chronologie";
 914     $thesaurus{'5'}="Lieux";
 915     $thesaurus{'6'}="Sujets";
 916     #thesaurus a remplir
 917     my $reported_tag;
 918 # if the library has a summary defined, use it. Otherwise, build a standard one
 919 # FIXME - it appears that the summary field in the authority frameworks
 920 #         can work as a display template.  However, this doesn't
 921 #         suit the MARC21 version, so for now the "templating"
 922 #         feature will be enabled only for UNIMARC for backwards
 923 #         compatibility.
 924     if ($summary{summary} and C4::Context->preference('marcflavour') eq 'UNIMARC') {
 925         my @matches = ($summary{summary} =~ m/\[(.*?)(\d{3})([\*a-z0-9])(.*?)\]/g);
 926         my (@textbefore, @tag, @subtag, @textafter);
 927         for(my $i = 0; $i < scalar @matches; $i++){
 928             push @textbefore, $matches[$i] if($i%4 == 0);
 929             push @tag,        $matches[$i] if($i%4 == 1);
 930             push @subtag,     $matches[$i] if($i%4 == 2);
 931             push @textafter,  $matches[$i] if($i%4 == 3);
 932         }
 933         for(my $i = scalar @tag; $i >= 0; $i--){
 934             my $textbefore = $textbefore[$i] || '';
 935             my $tag = $tag[$i] || '';
 936             my $subtag = $subtag[$i] || '';
 937             my $textafter = $textafter[$i] || '';
 938             my $value = '';
 939             my $field = $record->field($tag);
 940             if ( $field ) {
 941                 if($subtag eq '*') {
 942                     if($tag < 10) {
 943                         $value = $textbefore . $field->data() . $textafter;
 944                     }
 945                 } else {
 946                     my @subfields = $field->subfield($subtag);
 947                     if(@subfields > 0) {
 948                         $value = $textbefore . join (" - ", @subfields) . $textafter;
 949                     }
 950                 }
 951             }
 952             $summary{summary} =~ s/\[\Q$textbefore$tag$subtag$textafter\E\]/$value/;
 953         }
 954         $summary{summary} =~ s/\\n/<br \/>/g;
 955     }
 956     my @authorized;
 957     my @notes;
 958     my @seefrom;
 959     my @seealso;
 960     my @otherscript;
 961     my @equalterm;
 962
 963     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 964 # construct UNIMARC summary, that is quite different from MARC21 one
 965 # accepted form
 966         foreach my $field ($record->field('2..')) {
 967             push @authorized, {
 968                 heading => $field->as_string('abcdefghijlmnopqrstuvwxyz'),
 969                 hemain  => ( $field->subfield('a') // undef ),
 970                 field   => $field->tag(),
 971             };
 972         }
 973 # rejected form(s)
 974         foreach my $field ($record->field('3..')) {
 975             push @notes, { note => $field->subfield('a'), field => $field->tag() };
 976         }
 977         foreach my $field ($record->field('4..')) {
 978             my $thesaurus = $field->subfield('2') ? "thes. : ".$thesaurus{"$field->subfield('2')"}." : " : '';
 979             push @seefrom, {
 980                 heading => $thesaurus . $field->as_string('abcdefghijlmnopqrstuvwxyz'),
 981                 hemain  => ( $field->subfield('a') // undef ),
 982                 type    => 'seefrom',
 983                 field   => $field->tag(),
 984             };
 985         }
 986
 987         # see :
 988         @seealso = map {
 989             my $type = $unimarc_relation_from_code{$_->subfield('5') || 'a'};
 990             my $heading = $_->as_string('abcdefgjxyz');
 991             {
 992                 field   => $_->tag,
 993                 type    => $type,
 994                 heading => $heading,
 995                 hemain  => ( $_->subfield('a') // undef ),
 996                 search  => $heading,
 997                 authid  => ( $_->subfield('9') // undef ),
 998             }
 999         } $record->field('5..');
1000
1001         # Other forms
1002         @otherscript = map { {
1003             lang      => length ($_->subfield('8')) == 6 ? substr ($_->subfield('8'), 3, 3) : $_->subfield('8') || '',
1004             term      => $_->subfield('a') . ($_->subfield('b') ? ', ' . $_->subfield('b') : ''),
1005             direction => 'ltr',
1006             field     => $_->tag,
1007         } } $record->field('7..');
1008
1009     } else {
1010 # construct MARC21 summary
1011 # FIXME - looping over 1XX is questionable
1012 # since MARC21 authority should have only one 1XX
1013         use C4::Heading::MARC21;
1014         my $handler = C4::Heading::MARC21->new();
1015         my $subfields_to_report;
1016         my $subfields_to_subdivision = "";
1017         my $delimiter                = C4::Context->preference('AuthoritySeparator');
1018
1019         foreach my $field ($record->field('1..')) {
1020             my $tag = $field->tag();
1021             next if "152" eq $tag;
1022 # FIXME - 152 is not a good tag to use
1023 # in MARC21 -- purely local tags really ought to be
1024 # 9XX
1025
1026             $subfields_to_report = $handler->get_auth_heading_subfields_to_report($tag);
1027
1028             if ($subfields_to_report) {
1029                 push @authorized, {
1030                     heading => $field->as_string($subfields_to_report),
1031                     hemain  => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ),
1032                     field   => $tag,
1033                 };
1034             } else {
1035                 push @authorized, {
1036                     heading => $field->as_string(),
1037                     hemain  => ( $field->subfield( 'a' ) // undef ),
1038                     field   => $tag,
1039                 };
1040             }
1041         }
1042         foreach my $field ($record->field('4..')) { #See From
1043             my $type = 'seefrom';
1044             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1045             if ($type eq 'notapplicable') {
1046                 $type = substr $field->subfield('w'), 2, 1;
1047                 $type = 'earlier' if $type && $type ne 'n';
1048             }
1049             if ($type eq 'subfi') {
1050                 push @seefrom, {
1051                     heading => $field->as_string($marc21subfields),
1052                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1053                     type    => ($field->subfield('i') || ''),
1054                     field   => $field->tag(),
1055                 };
1056             } else {
1057                 push @seefrom, {
1058                     heading => $field->as_string($marc21subfields),
1059                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1060                     type    => $type,
1061                     field   => $field->tag(),
1062                 };
1063             }
1064         }
1065         foreach my $field ($record->field('5..')) { #See Also
1066             my $type = 'seealso';
1067             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1068             if ($type eq 'notapplicable') {
1069                 $type = substr $field->subfield('w'), 2, 1;
1070                 $type = 'earlier' if $type && $type ne 'n';
1071             }
1072             if ($type eq 'subfi') {
1073                 push @seealso, {
1074                     heading => $field->as_string($marc21subfields),
1075                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1076                     type    => scalar $field->subfield('i'),
1077                     field   => $field->tag(),
1078                     search  => $field->as_string($marc21subfields) || '',
1079                     authid  => $field->subfield('9') || ''
1080                 };
1081             } else {
1082                 push @seealso, {
1083                     heading => $field->as_string($marc21subfields),
1084                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1085                     type    => $type,
1086                     field   => $field->tag(),
1087                     search  => $field->as_string($marc21subfields) || '',
1088                     authid  => $field->subfield('9') || ''
1089                 };
1090             }
1091         }
1092         foreach my $field ($record->field('6..')) {
1093             push @notes, { note => $field->as_string(), field => $field->tag() };
1094         }
1095
1096      foreach my $field ( $record->field('7..') ) {
1097         my $tag = $field->tag();
1098
1099         if ( $tag eq '700' ) {
1100             $subfields_to_report      = 'abcdefghjklmnopqrst';
1101             $subfields_to_subdivision = 'vxyz';
1102         } elsif ( $tag eq '710' ) {
1103             $subfields_to_report      = 'abcdefghklmnoprst';
1104             $subfields_to_subdivision = 'vxyz';
1105         } elsif ( $tag eq '711' ) {
1106             $subfields_to_report      = 'acdefghklnpqst';
1107             $subfields_to_subdivision = 'vxyz';
1108         } elsif ( $tag eq '730' ) {
1109             $subfields_to_report      = 'adfghklmnoprst';
1110             $subfields_to_subdivision = 'vxyz';
1111         } elsif ( $tag eq '748' ) {
1112             $subfields_to_report      = 'ab';
1113             $subfields_to_subdivision = 'vxyz';
1114         } elsif ( $tag eq '750' ) {
1115             $subfields_to_report      = 'ab';
1116             $subfields_to_subdivision = 'vxyz';
1117         } elsif ( $tag eq '751' ) {
1118             $subfields_to_report      = 'a';
1119             $subfields_to_subdivision = 'vxyz';
1120         } elsif ( $tag eq '755' ) {
1121             $subfields_to_report      = 'abvxyz';
1122             $subfields_to_subdivision = 'vxyz';
1123         } elsif ( $tag eq '780' ) {
1124             $subfields_to_report = 'vxyz';
1125             $delimiter           = " ";
1126         } elsif ( $tag eq '781' ) {
1127             $subfields_to_report = 'vxyz';
1128             $delimiter           = " ";
1129         } elsif ( $tag eq '782' ) {
1130             $subfields_to_report = 'vxyz';
1131             $delimiter           = " ";
1132         } elsif ( $tag eq '785' ) {
1133             $subfields_to_report = 'vxyz';
1134             $delimiter           = " ";
1135         }
1136
1137         my $heading = $field->as_string($subfields_to_report);
1138
1139         my $subheading = $field->as_string( $subfields_to_subdivision, $delimiter );
1140         if ( length $subheading > 0 ) {
1141             $heading .= $delimiter . $subheading;
1142         }
1143
1144         if ($subfields_to_report) {
1145             push @equalterm, {
1146                 heading => $heading,
1147                 hemain  => ( $field->subfield( substr( $subfields_to_report, 0, 1 ) ) // undef ),
1148                 field   => $tag,
1149             };
1150         } else {
1151             push @equalterm, {
1152                 heading => $field->as_string(),
1153                 hemain  => ( $field->subfield('a') // undef ),
1154                 field   => $tag,
1155             };
1156         }
1157     }
1158
1159         foreach my $field ($record->field('880')) {
1160             my $linkage = $field->subfield('6');
1161             my $category = substr $linkage, 0, 1;
1162             if ($category eq '1') {
1163                 $category = 'preferred';
1164             } elsif ($category eq '4') {
1165                 $category = 'seefrom';
1166             } elsif ($category eq '5') {
1167                 $category = 'seealso';
1168             }
1169             my $type;
1170             if ($field->subfield('w')) {
1171                 $type = $marc21controlrefs{substr $field->subfield('w'), '0'};
1172             } else {
1173                 $type = $category;
1174             }
1175             my $direction = $linkage =~ m#/r$# ? 'rtl' : 'ltr';
1176             push @otherscript, { term => $field->as_string($subfields_to_report), category => $category, type => $type, direction => $direction, linkage => $linkage };
1177         }
1178     }
1179     $summary{mainentry}     = $authorized[0]->{heading};
1180     $summary{mainmainentry} = $authorized[0]->{hemain};
1181     $summary{authorized}    = \@authorized;
1182     $summary{notes}         = \@notes;
1183     $summary{seefrom}       = \@seefrom;
1184     $summary{seealso}       = \@seealso;
1185     $summary{otherscript}   = \@otherscript;
1186     $summary{equalterm}     = \@equalterm;
1187     return \%summary;
1188 }
1189
1190 =head2 GetAuthorizedHeading
1191
1192   $heading = &GetAuthorizedHeading({ record => $record, authid => $authid })
1193
1194 Takes a MARC::Record object describing an authority record or an authid, and
1195 returns a string representation of the first authorized heading. This routine
1196 should be considered a temporary shim to ease the future migration of authority
1197 data from C4::AuthoritiesMarc to the object-oriented Koha::*::Authority.
1198
1199 =cut
1200
1201 sub GetAuthorizedHeading {
1202     my $args = shift;
1203     my $record;
1204     unless ($record = $args->{record}) {
1205         return unless $args->{authid};
1206         $record = GetAuthority($args->{authid});
1207     }
1208     return unless (ref $record eq 'MARC::Record');
1209     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1210 # construct UNIMARC summary, that is quite different from MARC21 one
1211 # accepted form
1212         foreach my $field ($record->field('2..')) {
1213             return $field->as_string('abcdefghijlmnopqrstuvwxyz');
1214         }
1215     } else {
1216         use C4::Heading::MARC21;
1217         my $handler = C4::Heading::MARC21->new();
1218
1219         foreach my $field ($record->field('1..')) {
1220             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1221             return $field->as_string($subfields) if ($subfields);
1222         }
1223     }
1224     return;
1225 }
1226
1227 =head2 CompareFieldWithAuthority
1228
1229   $match = &CompareFieldWithAuthority({ field => $field, authid => $authid })
1230
1231 Takes a MARC::Field from a bibliographic record and an authid, and returns true if they match.
1232
1233 =cut
1234
1235 sub CompareFieldWithAuthority {
1236     my $args = shift;
1237
1238     my $record = GetAuthority($args->{authid});
1239     return unless (ref $record eq 'MARC::Record');
1240     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1241         # UNIMARC has same subfields for bibs and authorities
1242         foreach my $field ($record->field('2..')) {
1243             return compare_fields($field, $args->{field}, 'abcdefghijlmnopqrstuvwxyz');
1244         }
1245     } else {
1246         use C4::Heading::MARC21;
1247         my $handler = C4::Heading::MARC21->new();
1248
1249         foreach my $field ($record->field('1..')) {
1250             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1251             return compare_fields($field, $args->{field}, $subfields) if ($subfields);
1252         }
1253     }
1254     return 0;
1255 }
1256
1257 =head2 BuildAuthHierarchies
1258
1259   $text= &BuildAuthHierarchies( $authid, $force)
1260
1261 return text containing trees for hierarchies
1262 for them to be stored in auth_header
1263
1264 Example of text:
1265 122,1314,2452;1324,2342,3,2452
1266
1267 =cut
1268
1269 sub BuildAuthHierarchies{
1270     my $authid = shift @_;
1271 #   warn "authid : $authid";
1272     my $force = shift @_ || (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 0 : 1);
1273     my @globalresult;
1274     my $dbh=C4::Context->dbh;
1275     my $hierarchies;
1276     my $data = GetHeaderAuthority($authid);
1277     if ($data->{'authtrees'} and not $force){
1278         return $data->{'authtrees'};
1279 #  } elsif ($data->{'authtrees'}){
1280 #    $hierarchies=$data->{'authtrees'};
1281     } else {
1282         my $record = GetAuthority($authid);
1283         my $found;
1284         return unless $record;
1285         foreach my $field ($record->field('5..')){
1286             my $broader = 0;
1287             $broader = 1 if (
1288                     (C4::Context->preference('marcflavour') eq 'UNIMARC' && $field->subfield('5') && $field->subfield('5') eq 'g') ||
1289                     (C4::Context->preference('marcflavour') ne 'UNIMARC' && $field->subfield('w') && substr($field->subfield('w'), 0, 1) eq 'g'));
1290             if ($broader) {
1291                 my $subfauthid=_get_authid_subfield($field) || '';
1292                 next if ($subfauthid eq $authid);
1293                 my $parentrecord = GetAuthority($subfauthid);
1294                 next unless $parentrecord;
1295                 my $localresult=$hierarchies;
1296                 my $trees;
1297                 $trees = BuildAuthHierarchies($subfauthid);
1298                 my @trees;
1299                 if ($trees=~/;/){
1300                     @trees = split(/;/,$trees);
1301                 } else {
1302                     push @trees, $trees;
1303                 }
1304                 foreach (@trees){
1305                     $_.= ",$authid";
1306                 }
1307                 @globalresult = (@globalresult,@trees);
1308                 $found=1;
1309             }
1310             $hierarchies=join(";",@globalresult);
1311         }
1312 #Unless there is no ancestor, I am alone.
1313         $hierarchies="$authid" unless ($hierarchies);
1314     }
1315     AddAuthorityTrees($authid,$hierarchies);
1316     return $hierarchies;
1317 }
1318
1319 =head2 BuildAuthHierarchy
1320
1321   $ref= &BuildAuthHierarchy( $record, $class,$authid)
1322
1323 return a hashref in order to display hierarchy for record and final Authid $authid
1324
1325 "loopparents"
1326 "loopchildren"
1327 "class"
1328 "loopauthid"
1329 "current_value"
1330 "value"
1331
1332 =cut
1333
1334 sub BuildAuthHierarchy{
1335     my $record = shift @_;
1336     my $class = shift @_;
1337     my $authid_constructed = shift @_;
1338     return unless ($record && $record->field('001'));
1339     my $authid=$record->field('001')->data();
1340     my %cell;
1341     my $parents=""; my $children="";
1342     my (@loopparents,@loopchildren);
1343     my $marcflavour = C4::Context->preference('marcflavour');
1344     my $relationshipsf = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1345     foreach my $field ($record->field('5..')){
1346         my $subfauthid=_get_authid_subfield($field);
1347         if ($subfauthid && $field->subfield($relationshipsf) && $field->subfield('a')){
1348             my $relationship = substr($field->subfield($relationshipsf), 0, 1);
1349             if ($relationship eq 'h'){
1350                 push @loopchildren, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1351             }
1352             elsif ($relationship eq 'g'){
1353                 push @loopparents, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1354             }
1355 # brothers could get in there with an else
1356         }
1357     }
1358     $cell{"parents"}=\@loopparents;
1359     $cell{"children"}=\@loopchildren;
1360     $cell{"class"}=$class;
1361     $cell{"authid"}=$authid;
1362     $cell{"current_value"} =1 if ($authid eq $authid_constructed);
1363     $cell{"value"}=C4::Context->preference('marcflavour') eq 'UNIMARC' ? $record->subfield('2..',"a") : $record->subfield('1..', 'a');
1364     return \%cell;
1365 }
1366
1367 =head2 BuildAuthHierarchyBranch
1368
1369   $branch = &BuildAuthHierarchyBranch( $tree, $authid[, $cnt])
1370
1371 Return a data structure representing an authority hierarchy
1372 given a list of authorities representing a single branch in
1373 an authority hierarchy tree. $authid is the current node in
1374 the tree (which may or may not be somewhere in the middle).
1375 $cnt represents the level of the upper-most item, and is only
1376 used when BuildAuthHierarchyBranch is called recursively (i.e.,
1377 don't ever pass in anything but zero to it).
1378
1379 =cut
1380
1381 sub BuildAuthHierarchyBranch {
1382     my ($tree, $authid, $cnt) = @_;
1383     $cnt |= 0;
1384     my $elementdata = GetAuthority(shift @$tree);
1385     my $branch = BuildAuthHierarchy($elementdata,"child".$cnt, $authid);
1386     if (scalar @$tree > 0) {
1387         my $nextBranch = BuildAuthHierarchyBranch($tree, $authid, ++$cnt);
1388         my $nextAuthid = $nextBranch->{authid};
1389         my $found;
1390         # If we already have the next branch listed as a child, let's
1391         # replace the old listing with the new one. If not, we will add
1392         # the branch at the end.
1393         foreach my $cell (@{$branch->{children}}) {
1394             if ($cell->{authid} eq $nextAuthid) {
1395                 $cell = $nextBranch;
1396                 $found = 1;
1397                 last;
1398             }
1399         }
1400         push @{$branch->{children}}, $nextBranch unless $found;
1401     }
1402     return $branch;
1403 }
1404
1405 =head2 GenerateHierarchy
1406
1407   $hierarchy = &GenerateHierarchy($authid);
1408
1409 Return an arrayref holding one or more "trees" representing
1410 authority hierarchies.
1411
1412 =cut
1413
1414 sub GenerateHierarchy {
1415     my ($authid) = @_;
1416     my $trees    = BuildAuthHierarchies($authid);
1417     my @trees    = split /;/,$trees ;
1418     push @trees,$trees unless (@trees);
1419     my @loophierarchies;
1420     foreach my $tree (@trees){
1421         my @tree=split /,/,$tree;
1422         push @tree, $tree unless (@tree);
1423         my $branch = BuildAuthHierarchyBranch(\@tree, $authid);
1424         push @loophierarchies, [ $branch ];
1425     }
1426     return \@loophierarchies;
1427 }
1428
1429 sub _get_authid_subfield{
1430     my ($field)=@_;
1431     return $field->subfield('9')||$field->subfield('3');
1432 }
1433
1434 =head2 GetHeaderAuthority
1435
1436   $ref= &GetHeaderAuthority( $authid)
1437
1438 return a hashref in order auth_header table data
1439
1440 =cut
1441
1442 sub GetHeaderAuthority{
1443   my $authid = shift @_;
1444   my $sql= "SELECT * from auth_header WHERE authid = ?";
1445   my $dbh=C4::Context->dbh;
1446   my $rq= $dbh->prepare($sql);
1447   $rq->execute($authid);
1448   my $data= $rq->fetchrow_hashref;
1449   return $data;
1450 }
1451
1452 =head2 AddAuthorityTrees
1453
1454   $ref= &AddAuthorityTrees( $authid, $trees)
1455
1456 return success or failure
1457
1458 =cut
1459
1460 sub AddAuthorityTrees{
1461   my $authid = shift @_;
1462   my $trees = shift @_;
1463   my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
1464   my $dbh=C4::Context->dbh;
1465   my $rq= $dbh->prepare($sql);
1466   return $rq->execute($trees,$authid);
1467 }
1468
1469 =head2 merge
1470
1471     $count = merge({
1472         mergefrom => $mergefrom,
1473         [ MARCfrom => $MARCfrom, ]
1474         [ mergeto => $mergeto, ]
1475         [ MARCto => $MARCto, ]
1476         [ biblionumbers => [ $a, $b, $c ], ]
1477         [ override_limit => 1, ]
1478     });
1479
1480 Merge biblios linked to authority $mergefrom (mandatory parameter).
1481 If $mergeto equals mergefrom, the linked biblio field is updated.
1482 If $mergeto is different, the biblio field will be linked to $mergeto.
1483 If $mergeto is missing, the biblio field is deleted.
1484
1485 MARCfrom is used to determine if a cleared subfield in the authority record
1486 should be removed from a biblio. MARCto is used to populate the biblio
1487 record with the updated values; if you do not pass it, the biblio field
1488 will be deleted (same as missing mergeto).
1489
1490 Normally all biblio records linked to $mergefrom, will be considered. But
1491 you can pass specific numbers via the biblionumbers parameter.
1492
1493 The parameter override_limit is used by the cron job to force larger
1494 postponed merges.
1495
1496 Note: Although $mergefrom and $mergeto will normally be of the same
1497 authority type, merge also supports moving to another authority type.
1498
1499 =cut
1500
1501 sub merge {
1502     my ( $params ) = @_;
1503     my $mergefrom = $params->{mergefrom} || return;
1504     my $MARCfrom = $params->{MARCfrom};
1505     my $mergeto = $params->{mergeto};
1506     my $MARCto = $params->{MARCto};
1507     my $override_limit = $params->{override_limit};
1508
1509     # If we do not have biblionumbers, we get all linked biblios if the
1510     # number of linked records does not exceed the limit UNLESS we override.
1511     my @biblionumbers;
1512     if( $params->{biblionumbers} ) {
1513         @biblionumbers = @{ $params->{biblionumbers} };
1514     } elsif( $override_limit ) {
1515         @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1516     } else { # now first check number of linked records
1517         my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
1518         my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
1519         if( $hits > 0 && $hits <= $max ) {
1520             @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1521         } elsif( $hits > $max ) { #postpone this merge to the cron job
1522             Koha::Authority::MergeRequest->new({
1523                 authid => $mergefrom,
1524                 oldrecord => $MARCfrom,
1525                 authid_new => $mergeto,
1526             })->store;
1527         }
1528     }
1529     return 0 if !@biblionumbers;
1530
1531     # Search authtypes and reporting tags
1532     my $authfrom = Koha::Authorities->find($mergefrom);
1533     my $authto = Koha::Authorities->find($mergeto);
1534     my $authtypefrom;
1535     my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1536     if( $mergeto && $mergefrom == $mergeto && $MARCfrom ) {
1537         # bulkmarcimport may have changed the authtype; see BZ 19693
1538         my $old_type = $MARCfrom->subfield( get_auth_type_location() ); # going via default
1539         if( $old_type && $authto && $old_type ne $authto->authtypecode ) {
1540             # Type change: handled by simulating a postponed merge where the auth record has been deleted already
1541             # This triggers a walk through all auth controlled tags
1542             undef $authfrom;
1543         }
1544     }
1545     $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode) if $authfrom;
1546     my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1547     my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1548
1549     my @record_to;
1550     @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
1551     # Exceptional: If MARCto and authtypeto exist but $auth_tag_to_report_to
1552     # is empty, make sure that $9 and $a remain (instead of clearing the
1553     # reference) in order to allow for data recovery.
1554     # Note: We need $a too, since a single $9 does not pass ModBiblio.
1555     if( $MARCto && $authtypeto && !@record_to  ) {
1556         push @record_to, [ 'a', ' ' ]; # do not remove the space
1557     }
1558
1559     my @record_from;
1560     if( !$authfrom && $MARCfrom && $MARCfrom->field('1..','2..') ) {
1561     # postponed merge, authfrom was deleted and MARCfrom only contains the old reporting tag (and possibly a 100 for UNIMARC)
1562     # 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
1563         @record_from = ( $MARCfrom->field('1..','2..') )[-1]->subfields;
1564     } elsif( $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from) ) {
1565         @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields;
1566     }
1567
1568     # Get all candidate tags for the change
1569     # (This will reduce the search scope in marc records).
1570     # For a deleted authority record, we scan all auth controlled fields
1571     my $dbh = C4::Context->dbh;
1572     my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1573     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<>''" );
1574     my $tags_new;
1575     if( $authtypeto && ( !$authtypefrom || $authtypeto->authtypecode ne $authtypefrom->authtypecode )) {
1576         $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
1577     }
1578
1579     my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict';
1580     my $skip_subfields = $overwrite
1581         # This hash contains all subfields from the authority report fields
1582         # Including $MARCfrom as well as $MARCto
1583         # We only need it in loose merge mode; replaces the former $exclude
1584         ? {}
1585         : { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) };
1586
1587     my $counteditedbiblio = 0;
1588
1589     my $biblios = Koha::Biblios->search({ biblionumber => { -in => \@biblionumbers } });
1590
1591     while ( my $biblio = $biblios->next ) {
1592         my $marcrecord = $biblio->metadata->record;
1593         my $update = 0;
1594         foreach my $tagfield (@$tags_using_authtype) {
1595             my $countfrom = 0;    # used in strict mode to remove duplicates
1596             foreach my $field ( $marcrecord->field($tagfield) ) {
1597                 my $auth_number = $field->subfield("9");    # link to authority
1598                 my $tag         = $field->tag();
1599                 next if !defined($auth_number) || $auth_number ne $mergefrom;
1600                 $countfrom++;
1601                 if ( !$mergeto || !@record_to ||
1602                   ( $overwrite && $countfrom > 1 ) ) {
1603                     # !mergeto or !record_to indicates a delete
1604                     # Other condition: remove this duplicate in strict mode
1605                     $marcrecord->delete_field($field);
1606                     $update = 1;
1607                     next;
1608                 }
1609                 my $newtag = $tags_new && @$tags_new
1610                   ? _merge_newtag( $tag, $tags_new )
1611                   : $tag;
1612                 my $controlled_ind = $authto->controlled_indicators({ record => $MARCto, biblio_tag => $newtag });
1613                 my $field_to = MARC::Field->new(
1614                     $newtag,
1615                     $controlled_ind->{ind1} // $field->indicator(1),
1616                     $controlled_ind->{ind2} // $field->indicator(2),
1617                     9 => $mergeto, # Needed to create field, will be moved
1618                 );
1619                 my ( @prefix, @postfix );
1620                 if ( !$overwrite ) {
1621                     # add subfields back in loose mode, check skip_subfields
1622                     # The first extra subfields will be in front of the
1623                     # controlled block, the rest at the end.
1624                     my $prefix_flag = 1;
1625                     foreach my $subfield ( $field->subfields ) {
1626                         next if $subfield->[0] eq '9'; # skip but leave flag
1627                         if ( $skip_subfields->{ $subfield->[0] } ) {
1628                             # This marks the beginning of the controlled block
1629                             $prefix_flag = 0;
1630                             next;
1631                         }
1632                         if ($prefix_flag) {
1633                             push @prefix, [ $subfield->[0], $subfield->[1] ];
1634                         } else {
1635                             push @postfix, [ $subfield->[0], $subfield->[1] ];
1636                         }
1637                     }
1638                 }
1639                 foreach my $subfield ( @prefix, @record_to, @postfix ) {
1640                     $field_to->add_subfields($subfield->[0] => $subfield->[1]);
1641                 }
1642                 if( exists $controlled_ind->{sub2} ) { # thesaurus info
1643                     if( defined $controlled_ind->{sub2} ) {
1644                         # Add or replace
1645                         $field_to->update( 2 => $controlled_ind->{sub2} );
1646                     } else {
1647                         # Key alerts us here to remove $2
1648                         $field_to->delete_subfield( code => '2' );
1649                     }
1650                 }
1651                 # Move $9 to the end
1652                 $field_to->delete_subfield( code => '9' );
1653                 $field_to->add_subfields( 9 => $mergeto );
1654
1655                 if ($tags_new && @$tags_new) {
1656                     $marcrecord->delete_field($field);
1657                     append_fields_ordered( $marcrecord, $field_to );
1658                 } else {
1659                     $field->replace_with($field_to);
1660                 }
1661                 $update = 1;
1662             }
1663         }
1664         next if !$update;
1665         ModBiblio( $marcrecord, $biblio->biblionumber, $biblio->frameworkcode, { disable_autolink => 1 } );
1666         $counteditedbiblio++;
1667     }
1668     return $counteditedbiblio;
1669 }
1670
1671 sub _merge_newtag {
1672 # Routine is only called for an (exceptional) authtypecode change
1673 # Fixes old behavior of returning the first tag found
1674     my ( $oldtag, $new_tags ) = @_;
1675
1676     # If we e.g. have 650 and 151,651,751 try 651 and check presence
1677     my $prefix = substr( $oldtag, 0, 1 );
1678     my $guess = $prefix . substr( $new_tags->[0], -2 );
1679     if( grep { $_ eq $guess } @$new_tags ) {
1680         return $guess;
1681     }
1682     # Otherwise return one from the same block e.g. 6XX for 650
1683     # If not there too, fall back to first new tag (old behavior!)
1684     my @same_block = grep { /^$prefix/ } @$new_tags;
1685     return @same_block ? $same_block[0] : $new_tags->[0];
1686 }
1687
1688 sub append_fields_ordered {
1689 # while we lack this function in MARC::Record
1690 # we do not want insert_fields_ordered since it inserts before
1691     my ( $record, $field ) = @_;
1692     if( my @flds = $record->field( $field->tag ) ) {
1693         $record->insert_fields_after( pop @flds, $field );
1694     } else { # now fallback to insert_fields_ordered
1695         $record->insert_fields_ordered( $field );
1696     }
1697 }
1698
1699 =head2 get_auth_type_location
1700
1701   my ($tag, $subfield) = get_auth_type_location($auth_type_code);
1702
1703 Get the tag and subfield used to store the heading type
1704 for indexing purposes.  The C<$auth_type> parameter is
1705 optional; if it is not supplied, assume ''.
1706
1707 This routine searches the MARC authority framework
1708 for the tag and subfield whose kohafield is
1709 C<auth_header.authtypecode>; if no such field is
1710 defined in the framework, default to the hardcoded value
1711 specific to the MARC format.
1712
1713 =cut
1714
1715 sub get_auth_type_location {
1716     my $auth_type_code = @_ ? shift : '';
1717
1718     my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code);
1719     if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') {
1720         return ($tag, $subfield);
1721     } else {
1722         if (C4::Context->preference('marcflavour') eq "MARC21")  {
1723             return C4::AuthoritiesMarc::MARC21::default_auth_type_location();
1724         } else {
1725             return C4::AuthoritiesMarc::UNIMARC::default_auth_type_location();
1726         }
1727     }
1728 }
1729
1730 =head2 compare_fields
1731
1732   my match = compare_fields($field1, $field2, 'abcde');
1733
1734 Compares the listed subfields of both fields and return true if they all match
1735
1736 =cut
1737
1738 sub compare_fields {
1739     my ($field1, $field2, $subfields) = @_;
1740
1741     foreach my $subfield (split(//, $subfields)) {
1742         my $subfield1 = $field1->subfield($subfield) // '';
1743         my $subfield2 = $field2->subfield($subfield) // '';
1744         return 0 unless $subfield1 eq $subfield2;
1745     }
1746     return 1;
1747 }
1748
1749
1750 =head2 _after_authority_action_hooks
1751
1752 Helper method that takes care of calling all plugin hooks
1753
1754 =cut
1755
1756 sub _after_authority_action_hooks {
1757     my ( $args ) = @_; # hash keys: action, authority_id
1758     return Koha::Plugins->call( 'after_authority_action', $args );
1759 }
1760
1761 END { }       # module clean-up code here (global destructor)
1762
1763 1;
1764 __END__
1765
1766 =head1 AUTHOR
1767
1768 Koha Development Team <http://koha-community.org/>
1769
1770 Paul POULAIN paul.poulain@free.fr
1771 Ere Maijala ere.maijala@helsinki.fi
1772
1773 =cut
1774