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