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