C4/AuthoritiesMarc.pm

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