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 $delimiter = C4::Context->preference('AuthoritySeparator');
1019
1020         foreach my $field ($record->field('1..')) {
1021             my $tag = $field->tag();
1022             next if "152" eq $tag;
1023 # FIXME - 152 is not a good tag to use
1024 # in MARC21 -- purely local tags really ought to be
1025 # 9XX
1026
1027             $subfields_to_report = $handler->get_auth_heading_subfields_to_report($tag);
1028
1029             if ($subfields_to_report) {
1030                 push @authorized, {
1031                     heading => $field->as_string($subfields_to_report),
1032                     hemain  => ( $field->subfield( substr($subfields_to_report, 0, 1) ) // undef ),
1033                     field   => $tag,
1034                 };
1035             } else {
1036                 push @authorized, {
1037                     heading => $field->as_string(),
1038                     hemain  => ( $field->subfield( 'a' ) // undef ),
1039                     field   => $tag,
1040                 };
1041             }
1042         }
1043         foreach my $field ($record->field('4..')) { #See From
1044             my $type = 'seefrom';
1045             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1046             if ($type eq 'notapplicable') {
1047                 $type = substr $field->subfield('w'), 2, 1;
1048                 $type = 'earlier' if $type && $type ne 'n';
1049             }
1050             if ($type eq 'subfi') {
1051                 push @seefrom, {
1052                     heading => $field->as_string($marc21subfields),
1053                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1054                     type    => ($field->subfield('i') || ''),
1055                     field   => $field->tag(),
1056                 };
1057             } else {
1058                 push @seefrom, {
1059                     heading => $field->as_string($marc21subfields),
1060                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1061                     type    => $type,
1062                     field   => $field->tag(),
1063                 };
1064             }
1065         }
1066         foreach my $field ($record->field('5..')) { #See Also
1067             my $type = 'seealso';
1068             $type = ($marc21controlrefs{substr $field->subfield('w'), 0, 1} || '') if ($field->subfield('w'));
1069             if ($type eq 'notapplicable') {
1070                 $type = substr $field->subfield('w'), 2, 1;
1071                 $type = 'earlier' if $type && $type ne 'n';
1072             }
1073             if ($type eq 'subfi') {
1074                 push @seealso, {
1075                     heading => $field->as_string($marc21subfields),
1076                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1077                     type    => scalar $field->subfield('i'),
1078                     field   => $field->tag(),
1079                     search  => $field->as_string($marc21subfields) || '',
1080                     authid  => $field->subfield('9') || ''
1081                 };
1082             } else {
1083                 push @seealso, {
1084                     heading => $field->as_string($marc21subfields),
1085                     hemain  => scalar $field->subfield( substr($marc21subfields, 0, 1) ),
1086                     type    => $type,
1087                     field   => $field->tag(),
1088                     search  => $field->as_string($marc21subfields) || '',
1089                     authid  => $field->subfield('9') || ''
1090                 };
1091             }
1092         }
1093         foreach my $field ($record->field('6..')) {
1094             push @notes, { note => $field->as_string(), field => $field->tag() };
1095         }
1096
1097     foreach my $field ( $record->field('7..') ) {
1098         my $subfields_to_subdivision;
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         if ($subfields_to_subdivision) {
1142             my $subheading = $field->as_string( $subfields_to_subdivision, $delimiter );
1143             if ( length $subheading > 0 ) {
1144                 $heading .= $delimiter . $subheading;
1145             }
1146         }
1147
1148         if ($subfields_to_report) {
1149             push @equalterm, {
1150                 heading => $heading,
1151                 hemain  => ( $field->subfield( substr( $subfields_to_report, 0, 1 ) ) // undef ),
1152                 field   => $tag,
1153             };
1154         } else {
1155             push @equalterm, {
1156                 heading => $field->as_string(),
1157                 hemain  => ( $field->subfield('a') // undef ),
1158                 field   => $tag,
1159             };
1160         }
1161     }
1162
1163         foreach my $field ($record->field('880')) {
1164             my $linkage = $field->subfield('6');
1165             my $category = substr $linkage, 0, 1;
1166             if ($category eq '1') {
1167                 $category = 'preferred';
1168             } elsif ($category eq '4') {
1169                 $category = 'seefrom';
1170             } elsif ($category eq '5') {
1171                 $category = 'seealso';
1172             }
1173             my $type;
1174             if ($field->subfield('w')) {
1175                 $type = $marc21controlrefs{substr $field->subfield('w'), '0'};
1176             } else {
1177                 $type = $category;
1178             }
1179             my $direction = $linkage =~ m#/r$# ? 'rtl' : 'ltr';
1180             push @otherscript, { term => $field->as_string($subfields_to_report), category => $category, type => $type, direction => $direction, linkage => $linkage };
1181         }
1182     }
1183     $summary{mainentry}     = $authorized[0]->{heading};
1184     $summary{mainmainentry} = $authorized[0]->{hemain};
1185     $summary{authorized}    = \@authorized;
1186     $summary{notes}         = \@notes;
1187     $summary{seefrom}       = \@seefrom;
1188     $summary{seealso}       = \@seealso;
1189     $summary{otherscript}   = \@otherscript;
1190     $summary{equalterm}     = \@equalterm;
1191     return \%summary;
1192 }
1193
1194 =head2 GetAuthorizedHeading
1195
1196   $heading = &GetAuthorizedHeading({ record => $record, authid => $authid })
1197
1198 Takes a MARC::Record object describing an authority record or an authid, and
1199 returns a string representation of the first authorized heading. This routine
1200 should be considered a temporary shim to ease the future migration of authority
1201 data from C4::AuthoritiesMarc to the object-oriented Koha::*::Authority.
1202
1203 =cut
1204
1205 sub GetAuthorizedHeading {
1206     my $args = shift;
1207     my $record;
1208     unless ($record = $args->{record}) {
1209         return unless $args->{authid};
1210         $record = GetAuthority($args->{authid});
1211     }
1212     return unless (ref $record eq 'MARC::Record');
1213     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1214 # construct UNIMARC summary, that is quite different from MARC21 one
1215 # accepted form
1216         foreach my $field ($record->field('2..')) {
1217             return $field->as_string('abcdefghijlmnopqrstuvwxyz');
1218         }
1219     } else {
1220         use C4::Heading::MARC21;
1221         my $handler = C4::Heading::MARC21->new();
1222
1223         foreach my $field ($record->field('1..')) {
1224             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1225             return $field->as_string($subfields) if ($subfields);
1226         }
1227     }
1228     return;
1229 }
1230
1231 =head2 CompareFieldWithAuthority
1232
1233   $match = &CompareFieldWithAuthority({ field => $field, authid => $authid })
1234
1235 Takes a MARC::Field from a bibliographic record and an authid, and returns true if they match.
1236
1237 =cut
1238
1239 sub CompareFieldWithAuthority {
1240     my $args = shift;
1241
1242     my $record = GetAuthority($args->{authid});
1243     return unless (ref $record eq 'MARC::Record');
1244     if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
1245         # UNIMARC has same subfields for bibs and authorities
1246         foreach my $field ($record->field('2..')) {
1247             return compare_fields($field, $args->{field}, 'abcdefghijlmnopqrstuvwxyz');
1248         }
1249     } else {
1250         use C4::Heading::MARC21;
1251         my $handler = C4::Heading::MARC21->new();
1252
1253         foreach my $field ($record->field('1..')) {
1254             my $subfields = $handler->get_valid_bib_heading_subfields($field->tag());
1255             return compare_fields($field, $args->{field}, $subfields) if ($subfields);
1256         }
1257     }
1258     return 0;
1259 }
1260
1261 =head2 BuildAuthHierarchies
1262
1263   $text= &BuildAuthHierarchies( $authid, $force)
1264
1265 return text containing trees for hierarchies
1266 for them to be stored in auth_header
1267
1268 Example of text:
1269 122,1314,2452;1324,2342,3,2452
1270
1271 =cut
1272
1273 sub BuildAuthHierarchies{
1274     my $authid = shift @_;
1275 #   warn "authid : $authid";
1276     my $force = shift @_ || (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 0 : 1);
1277     my @globalresult;
1278     my $dbh=C4::Context->dbh;
1279     my $hierarchies;
1280     my $data = GetHeaderAuthority($authid);
1281     if ($data->{'authtrees'} and not $force){
1282         return $data->{'authtrees'};
1283 #  } elsif ($data->{'authtrees'}){
1284 #    $hierarchies=$data->{'authtrees'};
1285     } else {
1286         my $record = GetAuthority($authid);
1287         my $found;
1288         return unless $record;
1289         foreach my $field ($record->field('5..')){
1290             my $broader = 0;
1291             $broader = 1 if (
1292                     (C4::Context->preference('marcflavour') eq 'UNIMARC' && $field->subfield('5') && $field->subfield('5') eq 'g') ||
1293                     (C4::Context->preference('marcflavour') ne 'UNIMARC' && $field->subfield('w') && substr($field->subfield('w'), 0, 1) eq 'g'));
1294             if ($broader) {
1295                 my $subfauthid=_get_authid_subfield($field) || '';
1296                 next if ($subfauthid eq $authid);
1297                 my $parentrecord = GetAuthority($subfauthid);
1298                 next unless $parentrecord;
1299                 my $localresult=$hierarchies;
1300                 my $trees;
1301                 $trees = BuildAuthHierarchies($subfauthid);
1302                 my @trees;
1303                 if ($trees=~/;/){
1304                     @trees = split(/;/,$trees);
1305                 } else {
1306                     push @trees, $trees;
1307                 }
1308                 foreach (@trees){
1309                     $_.= ",$authid";
1310                 }
1311                 @globalresult = (@globalresult,@trees);
1312                 $found=1;
1313             }
1314             $hierarchies=join(";",@globalresult);
1315         }
1316 #Unless there is no ancestor, I am alone.
1317         $hierarchies="$authid" unless ($hierarchies);
1318     }
1319     AddAuthorityTrees($authid,$hierarchies);
1320     return $hierarchies;
1321 }
1322
1323 =head2 BuildAuthHierarchy
1324
1325   $ref= &BuildAuthHierarchy( $record, $class,$authid)
1326
1327 return a hashref in order to display hierarchy for record and final Authid $authid
1328
1329 "loopparents"
1330 "loopchildren"
1331 "class"
1332 "loopauthid"
1333 "current_value"
1334 "value"
1335
1336 =cut
1337
1338 sub BuildAuthHierarchy{
1339     my $record = shift @_;
1340     my $class = shift @_;
1341     my $authid_constructed = shift @_;
1342     return unless ($record && $record->field('001'));
1343     my $authid=$record->field('001')->data();
1344     my %cell;
1345     my $parents=""; my $children="";
1346     my (@loopparents,@loopchildren);
1347     my $marcflavour = C4::Context->preference('marcflavour');
1348     my $relationshipsf = $marcflavour eq 'UNIMARC' ? '5' : 'w';
1349     foreach my $field ($record->field('5..')){
1350         my $subfauthid=_get_authid_subfield($field);
1351         if ($subfauthid && $field->subfield($relationshipsf) && $field->subfield('a')){
1352             my $relationship = substr($field->subfield($relationshipsf), 0, 1);
1353             if ($relationship eq 'h'){
1354                 push @loopchildren, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1355             }
1356             elsif ($relationship eq 'g'){
1357                 push @loopparents, { "authid"=>$subfauthid,"value"=>$field->subfield('a')};
1358             }
1359 # brothers could get in there with an else
1360         }
1361     }
1362     $cell{"parents"}=\@loopparents;
1363     $cell{"children"}=\@loopchildren;
1364     $cell{"class"}=$class;
1365     $cell{"authid"}=$authid;
1366     $cell{"current_value"} =1 if ($authid eq $authid_constructed);
1367     $cell{"value"}=C4::Context->preference('marcflavour') eq 'UNIMARC' ? $record->subfield('2..',"a") : $record->subfield('1..', 'a');
1368     return \%cell;
1369 }
1370
1371 =head2 BuildAuthHierarchyBranch
1372
1373   $branch = &BuildAuthHierarchyBranch( $tree, $authid[, $cnt])
1374
1375 Return a data structure representing an authority hierarchy
1376 given a list of authorities representing a single branch in
1377 an authority hierarchy tree. $authid is the current node in
1378 the tree (which may or may not be somewhere in the middle).
1379 $cnt represents the level of the upper-most item, and is only
1380 used when BuildAuthHierarchyBranch is called recursively (i.e.,
1381 don't ever pass in anything but zero to it).
1382
1383 =cut
1384
1385 sub BuildAuthHierarchyBranch {
1386     my ($tree, $authid, $cnt) = @_;
1387     $cnt |= 0;
1388     my $elementdata = GetAuthority(shift @$tree);
1389     my $branch = BuildAuthHierarchy($elementdata,"child".$cnt, $authid);
1390     if (scalar @$tree > 0) {
1391         my $nextBranch = BuildAuthHierarchyBranch($tree, $authid, ++$cnt);
1392         my $nextAuthid = $nextBranch->{authid};
1393         my $found;
1394         # If we already have the next branch listed as a child, let's
1395         # replace the old listing with the new one. If not, we will add
1396         # the branch at the end.
1397         foreach my $cell (@{$branch->{children}}) {
1398             if ($cell->{authid} eq $nextAuthid) {
1399                 $cell = $nextBranch;
1400                 $found = 1;
1401                 last;
1402             }
1403         }
1404         push @{$branch->{children}}, $nextBranch unless $found;
1405     }
1406     return $branch;
1407 }
1408
1409 =head2 GenerateHierarchy
1410
1411   $hierarchy = &GenerateHierarchy($authid);
1412
1413 Return an arrayref holding one or more "trees" representing
1414 authority hierarchies.
1415
1416 =cut
1417
1418 sub GenerateHierarchy {
1419     my ($authid) = @_;
1420     my $trees    = BuildAuthHierarchies($authid);
1421     my @trees    = split /;/,$trees ;
1422     push @trees,$trees unless (@trees);
1423     my @loophierarchies;
1424     foreach my $tree (@trees){
1425         my @tree=split /,/,$tree;
1426         push @tree, $tree unless (@tree);
1427         my $branch = BuildAuthHierarchyBranch(\@tree, $authid);
1428         push @loophierarchies, [ $branch ];
1429     }
1430     return \@loophierarchies;
1431 }
1432
1433 sub _get_authid_subfield{
1434     my ($field)=@_;
1435     return $field->subfield('9')||$field->subfield('3');
1436 }
1437
1438 =head2 GetHeaderAuthority
1439
1440   $ref= &GetHeaderAuthority( $authid)
1441
1442 return a hashref in order auth_header table data
1443
1444 =cut
1445
1446 sub GetHeaderAuthority{
1447   my $authid = shift @_;
1448   my $sql= "SELECT * from auth_header WHERE authid = ?";
1449   my $dbh=C4::Context->dbh;
1450   my $rq= $dbh->prepare($sql);
1451   $rq->execute($authid);
1452   my $data= $rq->fetchrow_hashref;
1453   return $data;
1454 }
1455
1456 =head2 AddAuthorityTrees
1457
1458   $ref= &AddAuthorityTrees( $authid, $trees)
1459
1460 return success or failure
1461
1462 =cut
1463
1464 sub AddAuthorityTrees{
1465   my $authid = shift @_;
1466   my $trees = shift @_;
1467   my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
1468   my $dbh=C4::Context->dbh;
1469   my $rq= $dbh->prepare($sql);
1470   return $rq->execute($trees,$authid);
1471 }
1472
1473 =head2 merge
1474
1475     $count = merge({
1476         mergefrom => $mergefrom,
1477         [ MARCfrom => $MARCfrom, ]
1478         [ mergeto => $mergeto, ]
1479         [ MARCto => $MARCto, ]
1480         [ biblionumbers => [ $a, $b, $c ], ]
1481         [ override_limit => 1, ]
1482     });
1483
1484 Merge biblios linked to authority $mergefrom (mandatory parameter).
1485 If $mergeto equals mergefrom, the linked biblio field is updated.
1486 If $mergeto is different, the biblio field will be linked to $mergeto.
1487 If $mergeto is missing, the biblio field is deleted.
1488
1489 MARCfrom is used to determine if a cleared subfield in the authority record
1490 should be removed from a biblio. MARCto is used to populate the biblio
1491 record with the updated values; if you do not pass it, the biblio field
1492 will be deleted (same as missing mergeto).
1493
1494 Normally all biblio records linked to $mergefrom, will be considered. But
1495 you can pass specific numbers via the biblionumbers parameter.
1496
1497 The parameter override_limit is used by the cron job to force larger
1498 postponed merges.
1499
1500 Note: Although $mergefrom and $mergeto will normally be of the same
1501 authority type, merge also supports moving to another authority type.
1502
1503 =cut
1504
1505 sub merge {
1506     my ( $params ) = @_;
1507     my $mergefrom = $params->{mergefrom} || return;
1508     my $MARCfrom = $params->{MARCfrom};
1509     my $mergeto = $params->{mergeto};
1510     my $MARCto = $params->{MARCto};
1511     my $override_limit = $params->{override_limit};
1512
1513     # If we do not have biblionumbers, we get all linked biblios if the
1514     # number of linked records does not exceed the limit UNLESS we override.
1515     my @biblionumbers;
1516     if( $params->{biblionumbers} ) {
1517         @biblionumbers = @{ $params->{biblionumbers} };
1518     } elsif( $override_limit ) {
1519         @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1520     } else { # now first check number of linked records
1521         my $max = C4::Context->preference('AuthorityMergeLimit') // 0;
1522         my $hits = Koha::Authorities->get_usage_count({ authid => $mergefrom });
1523         if( $hits > 0 && $hits <= $max ) {
1524             @biblionumbers = Koha::Authorities->linked_biblionumbers({ authid => $mergefrom });
1525         } elsif( $hits > $max ) { #postpone this merge to the cron job
1526             Koha::Authority::MergeRequest->new({
1527                 authid => $mergefrom,
1528                 oldrecord => $MARCfrom,
1529                 authid_new => $mergeto,
1530             })->store;
1531         }
1532     }
1533     return 0 if !@biblionumbers;
1534
1535     # Search authtypes and reporting tags
1536     my $authfrom = Koha::Authorities->find($mergefrom);
1537     my $authto = Koha::Authorities->find($mergeto);
1538     my $authtypefrom;
1539     my $authtypeto   = $authto ? Koha::Authority::Types->find($authto->authtypecode) : undef;
1540     if( $mergeto && $mergefrom == $mergeto && $MARCfrom ) {
1541         # bulkmarcimport may have changed the authtype; see BZ 19693
1542         my $old_type = $MARCfrom->subfield( get_auth_type_location() ); # going via default
1543         if( $old_type && $authto && $old_type ne $authto->authtypecode ) {
1544             # Type change: handled by simulating a postponed merge where the auth record has been deleted already
1545             # This triggers a walk through all auth controlled tags
1546             undef $authfrom;
1547         }
1548     }
1549     $authtypefrom = Koha::Authority::Types->find($authfrom->authtypecode) if $authfrom;
1550     my $auth_tag_to_report_from = $authtypefrom ? $authtypefrom->auth_tag_to_report : '';
1551     my $auth_tag_to_report_to   = $authtypeto ? $authtypeto->auth_tag_to_report : '';
1552
1553     my @record_to;
1554     @record_to = $MARCto->field($auth_tag_to_report_to)->subfields() if $auth_tag_to_report_to && $MARCto && $MARCto->field($auth_tag_to_report_to);
1555     # Exceptional: If MARCto and authtypeto exist but $auth_tag_to_report_to
1556     # is empty, make sure that $9 and $a remain (instead of clearing the
1557     # reference) in order to allow for data recovery.
1558     # Note: We need $a too, since a single $9 does not pass ModBiblio.
1559     if( $MARCto && $authtypeto && !@record_to  ) {
1560         push @record_to, [ 'a', ' ' ]; # do not remove the space
1561     }
1562
1563     my @record_from;
1564     if( !$authfrom && $MARCfrom && $MARCfrom->field('1..','2..') ) {
1565     # postponed merge, authfrom was deleted and MARCfrom only contains the old reporting tag (and possibly a 100 for UNIMARC)
1566     # 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
1567         @record_from = ( $MARCfrom->field('1..','2..') )[-1]->subfields;
1568     } elsif( $auth_tag_to_report_from && $MARCfrom && $MARCfrom->field($auth_tag_to_report_from) ) {
1569         @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields;
1570     }
1571
1572     # Get all candidate tags for the change
1573     # (This will reduce the search scope in marc records).
1574     # For a deleted authority record, we scan all auth controlled fields
1575     my $dbh = C4::Context->dbh;
1576     my $sql = "SELECT DISTINCT tagfield FROM marc_subfield_structure WHERE authtypecode=?";
1577     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<>''" );
1578     my $tags_new;
1579     if( $authtypeto && ( !$authtypefrom || $authtypeto->authtypecode ne $authtypefrom->authtypecode )) {
1580         $tags_new = $dbh->selectcol_arrayref( $sql, undef, ( $authtypeto->authtypecode ));
1581     }
1582
1583     my $overwrite = C4::Context->preference( 'AuthorityMergeMode' ) eq 'strict';
1584     my $skip_subfields = $overwrite
1585         # This hash contains all subfields from the authority report fields
1586         # Including $MARCfrom as well as $MARCto
1587         # We only need it in loose merge mode; replaces the former $exclude
1588         ? {}
1589         : { map { ( $_->[0], 1 ); } ( @record_from, @record_to ) };
1590
1591     my $counteditedbiblio = 0;
1592
1593     my $biblios = Koha::Biblios->search({ biblionumber => { -in => \@biblionumbers } });
1594
1595     while ( my $biblio = $biblios->next ) {
1596         my $marcrecord = $biblio->metadata->record;
1597         my $update = 0;
1598         foreach my $tagfield (@$tags_using_authtype) {
1599             my $countfrom = 0;    # used in strict mode to remove duplicates
1600             foreach my $field ( $marcrecord->field($tagfield) ) {
1601                 my $auth_number = $field->subfield("9");    # link to authority
1602                 my $tag         = $field->tag();
1603                 next if !defined($auth_number) || $auth_number ne $mergefrom;
1604                 $countfrom++;
1605                 if ( !$mergeto || !@record_to ||
1606                   ( $overwrite && $countfrom > 1 ) ) {
1607                     # !mergeto or !record_to indicates a delete
1608                     # Other condition: remove this duplicate in strict mode
1609                     $marcrecord->delete_field($field);
1610                     $update = 1;
1611                     next;
1612                 }
1613                 my $newtag = $tags_new && @$tags_new
1614                   ? _merge_newtag( $tag, $tags_new )
1615                   : $tag;
1616                 my $controlled_ind = $authto->controlled_indicators({ record => $MARCto, biblio_tag => $newtag });
1617                 my $field_to = MARC::Field->new(
1618                     $newtag,
1619                     $controlled_ind->{ind1} // $field->indicator(1),
1620                     $controlled_ind->{ind2} // $field->indicator(2),
1621                     9 => $mergeto, # Needed to create field, will be moved
1622                 );
1623                 my ( @prefix, @postfix );
1624                 if ( !$overwrite ) {
1625                     # add subfields back in loose mode, check skip_subfields
1626                     # The first extra subfields will be in front of the
1627                     # controlled block, the rest at the end.
1628                     my $prefix_flag = 1;
1629                     foreach my $subfield ( $field->subfields ) {
1630                         next if $subfield->[0] eq '9'; # skip but leave flag
1631                         if ( $skip_subfields->{ $subfield->[0] } ) {
1632                             # This marks the beginning of the controlled block
1633                             $prefix_flag = 0;
1634                             next;
1635                         }
1636                         if ($prefix_flag) {
1637                             push @prefix, [ $subfield->[0], $subfield->[1] ];
1638                         } else {
1639                             push @postfix, [ $subfield->[0], $subfield->[1] ];
1640                         }
1641                     }
1642                 }
1643                 foreach my $subfield ( @prefix, @record_to, @postfix ) {
1644                     $field_to->add_subfields($subfield->[0] => $subfield->[1]);
1645                 }
1646                 if( exists $controlled_ind->{sub2} ) { # thesaurus info
1647                     if( defined $controlled_ind->{sub2} ) {
1648                         # Add or replace
1649                         $field_to->update( 2 => $controlled_ind->{sub2} );
1650                     } else {
1651                         # Key alerts us here to remove $2
1652                         $field_to->delete_subfield( code => '2' );
1653                     }
1654                 }
1655                 # Move $9 to the end
1656                 $field_to->delete_subfield( code => '9' );
1657                 $field_to->add_subfields( 9 => $mergeto );
1658
1659                 if ($tags_new && @$tags_new) {
1660                     $marcrecord->delete_field($field);
1661                     append_fields_ordered( $marcrecord, $field_to );
1662                 } else {
1663                     $field->replace_with($field_to);
1664                 }
1665                 $update = 1;
1666             }
1667         }
1668         next if !$update;
1669         ModBiblio( $marcrecord, $biblio->biblionumber, $biblio->frameworkcode, { disable_autolink => 1 } );
1670         $counteditedbiblio++;
1671     }
1672     return $counteditedbiblio;
1673 }
1674
1675 sub _merge_newtag {
1676 # Routine is only called for an (exceptional) authtypecode change
1677 # Fixes old behavior of returning the first tag found
1678     my ( $oldtag, $new_tags ) = @_;
1679
1680     # If we e.g. have 650 and 151,651,751 try 651 and check presence
1681     my $prefix = substr( $oldtag, 0, 1 );
1682     my $guess = $prefix . substr( $new_tags->[0], -2 );
1683     if( grep { $_ eq $guess } @$new_tags ) {
1684         return $guess;
1685     }
1686     # Otherwise return one from the same block e.g. 6XX for 650
1687     # If not there too, fall back to first new tag (old behavior!)
1688     my @same_block = grep { /^$prefix/ } @$new_tags;
1689     return @same_block ? $same_block[0] : $new_tags->[0];
1690 }
1691
1692 sub append_fields_ordered {
1693 # while we lack this function in MARC::Record
1694 # we do not want insert_fields_ordered since it inserts before
1695     my ( $record, $field ) = @_;
1696     if( my @flds = $record->field( $field->tag ) ) {
1697         $record->insert_fields_after( pop @flds, $field );
1698     } else { # now fallback to insert_fields_ordered
1699         $record->insert_fields_ordered( $field );
1700     }
1701 }
1702
1703 =head2 get_auth_type_location
1704
1705   my ($tag, $subfield) = get_auth_type_location($auth_type_code);
1706
1707 Get the tag and subfield used to store the heading type
1708 for indexing purposes.  The C<$auth_type> parameter is
1709 optional; if it is not supplied, assume ''.
1710
1711 This routine searches the MARC authority framework
1712 for the tag and subfield whose kohafield is
1713 C<auth_header.authtypecode>; if no such field is
1714 defined in the framework, default to the hardcoded value
1715 specific to the MARC format.
1716
1717 =cut
1718
1719 sub get_auth_type_location {
1720     my $auth_type_code = @_ ? shift : '';
1721
1722     my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code);
1723     if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') {
1724         return ($tag, $subfield);
1725     } else {
1726         if (C4::Context->preference('marcflavour') eq "MARC21")  {
1727             return C4::AuthoritiesMarc::MARC21::default_auth_type_location();
1728         } else {
1729             return C4::AuthoritiesMarc::UNIMARC::default_auth_type_location();
1730         }
1731     }
1732 }
1733
1734 =head2 compare_fields
1735
1736   my match = compare_fields($field1, $field2, 'abcde');
1737
1738 Compares the listed subfields of both fields and return true if they all match
1739
1740 =cut
1741
1742 sub compare_fields {
1743     my ($field1, $field2, $subfields) = @_;
1744
1745     foreach my $subfield (split(//, $subfields)) {
1746         my $subfield1 = $field1->subfield($subfield) // '';
1747         my $subfield2 = $field2->subfield($subfield) // '';
1748         return 0 unless $subfield1 eq $subfield2;
1749     }
1750     return 1;
1751 }
1752
1753
1754 =head2 _after_authority_action_hooks
1755
1756 Helper method that takes care of calling all plugin hooks
1757
1758 =cut
1759
1760 sub _after_authority_action_hooks {
1761     my ( $args ) = @_; # hash keys: action, authority_id
1762     return Koha::Plugins->call( 'after_authority_action', $args );
1763 }
1764
1765 END { }       # module clean-up code here (global destructor)
1766
1767 1;
1768 __END__
1769
1770 =head1 AUTHOR
1771
1772 Koha Development Team <http://koha-community.org/>
1773
1774 Paul POULAIN paul.poulain@free.fr
1775 Ere Maijala ere.maijala@helsinki.fi
1776
1777 =cut
1778