Attachment #58871 for bug #14560

View | Details | Raw Unified | Return to bug 14560
Collapse All | Expand All




use C4::Search;
use C4::AuthoritiesMarc::MARC21;
use C4::AuthoritiesMarc::UNIMARC;
use C4::AuthoritiesRameau;
use C4::Charset;
use C4::Log;
use Koha::MetadataRecord::Authority;

=cut

sub merge {
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto, $biblionumber) = @_;
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
    my $dbh=C4::Context->dbh;
    my $authfrom = Koha::Authorities->find($mergefrom);

    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
    
    my @reccache;
    if ($biblionumber) {
        my $marcrecorddb = GetMarcBiblio($biblionumber);
    #zebra connection
    my $oConnection=C4::Context->Zconn("biblioserver",0);
    # We used to use XML syntax here, but that no longer works.
    # Thankfully, we don't need it.
    my $query;
    $query= "an=".$mergefrom;
    my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
    my $count = 0;
    if  ($oResult) {
        $count=$oResult->size();
    }
    my $z=0;
    while ( $z<$count ) {
        my $marcrecordzebra = C4::Search::new_record_from_zebra(
            'biblioserver',
            $oResult->record($z)->raw()
        );
        my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
        my $i = ($biblionumbertagfield < 10)
            ? $marcrecordzebra->field( $biblionumbertagfield )->data
            : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
        my $marcrecorddb = GetMarcBiblio($i);
        push @reccache, $marcrecorddb;
    } else {
      # search all biblio tags using this authority.
      #Getting marcbiblios impacted by the change.
      #zebra connection
      my $oConnection=C4::Context->Zconn("biblioserver",0);
      # We used to use XML syntax here, but that no longer works.
      # Thankfully, we don't need it.
      my $query;
      $query= "an=".$mergefrom;
      my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
      my $count = 0;
      if  ($oResult) {
          $count=$oResult->size();
      }
      my $z=0;
      while ( $z<$count ) {
          my $marcrecordzebra = C4::Search::new_record_from_zebra(
              'biblioserver',
              $oResult->record($z)->raw()
          );
          my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
          my $i = ($biblionumbertagfield < 10)
              ? $marcrecordzebra->field( $biblionumbertagfield )->data
              : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
          my $marcrecorddb = GetMarcBiblio($i);
          push @reccache, $marcrecorddb;
          $z++;
      }
      $oResult->destroy();
    }
    $oResult->destroy();
    #warn scalar(@reccache)." biblios to update";
    # Get All candidate Tags for the change 
    # (This will reduce the search scope in marc records).

        foreach my $tagfield (@tags_using_authtype){
#             warn "tagfield : $tagfield ";
            foreach my $field ($marcrecord->field($tagfield)){

                # If Rameau authorities are enabled and there are multiple $9's in the field, skip it.
                my @internallinks = $field->subfield("9");
                next if (C4::Context->preference('useRameau') && scalar(@internallinks) > 1);

                # biblio is linked to authority with $9 subfield containing authid
                my $auth_number=$field->subfield("9");
                my $tag=$field->tag();          

            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
            next;
        }
        if (C4::Context->preference('useRameau')) {
          my $rameauUpdate = rameauProcessing($marcrecord);
          $update = 1 if ($rameauUpdate == 1);
        }
        if ($update==1){
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
            $counteditedbiblio++;




package C4::AuthoritiesRameau;
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;
use C4::Context;
use MARC::Record;
use MARC::Field;
use C4::Biblio;
use C4::Search;
use C4::AuthoritiesMarc::MARC21;
use C4::AuthoritiesMarc::UNIMARC;
use C4::Charset;
use C4::Log;
use Koha::Authority;

use vars qw($VERSION @ISA @EXPORT);

BEGIN {

	require Exporter;
	@ISA = qw(Exporter);
	@EXPORT = qw(
	    &rameauProcessing
	);
}


# Is this a Rameau field?
sub isRameau {
  my $field = shift @_;

  # Is there a $2 with rameau value?
  foreach my $subfield ($field->subfield('2')) {
    return 1 if lc $subfield eq lc 'rameau';
  }

  # Or
  # Are there multiple $a?
  my $acount = 0;
  foreach my $subfield ($field->subfield('a')) {
    $acount++;
  }
  return 1 if ($acount >= 2);

  # Or
  # Is there one of these subfields? ($jxyz)
  my @rameauSubfields = qw/j x y z/;
  foreach my $rameauSubfield (@rameauSubfields) {
    return 1 if ($field->subfield($rameauSubfield));
  }
  return 0;
}

# Add $2rameau in a field if it is not already here.
sub addRameau {
  my $field = shift @_;
  foreach my $subfield ($field->subfield('2')) {
    return if lc $subfield eq lc 'rameau';
  }
  $field->add_subfields('2' => 'rameau');
}

# Find an auth in koha by its bnfid.
sub _findLocalAuth {
  my $id = shift @_;
  my $ctn = C4::Context->Zconn("authorityserver");
  my $rs;
  eval {
    $rs = $ctn->search(new ZOOM::Query::CCL2RPN(C4::Context->preference('rameauBnfIdIndex') . '=' . $id, $ctn));
  };
  if ($@) {
    print "Error searching\n";
    return -1;
  }
  if ($rs && $rs->size() == 1) {
   my $zoomauth = $rs->record(0);
   my $kohaauth = new_from_usmarc MARC::Record ($zoomauth->raw());
   my $kohaauthid = $kohaauth->field('001')->data();
   $rs->destroy();
   return $kohaauthid;

  }
  return -1;

}

# Add internal links to authorities in the rameau field.
sub addInternalLinks {
  my $field = shift @_;
  my $found_authid = 0;
  my @newsubfields;

  foreach my $subfield ($field->subfields()) {
    # Adding/updating $9 right after $3 if the auth was found
    my $tag = $subfield->[0];
    my $value = $subfield->[1];
    if ($found_authid) {
      if ($subfield->[0] eq '9') {
        $value = $found_authid;
      } else {
        push @newsubfields, '9' => $found_authid;
      }
    }

    # This is needed for cleaning misplaced $9 that might have been here before.
    if ($found_authid or $subfield->[0] ne '9') {
      push @newsubfields, $tag => $value;
    }

    $found_authid = 0;

    # Looking for an auth
    if ($subfield->[0] eq 3) {
      if (my $kohaauthid = _findLocalAuth($subfield->[1])) {
        if ($kohaauthid != -1) {
          $found_authid = $kohaauthid;
          print "Adding authid $kohaauthid\n";
        }
      }
    }
  }

  my $newfield = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @newsubfields);
  $field->replace_with($newfield);
  return $field;
}

# Main function. Start rameau processing for a record.
sub rameauProcessing {
  my $marcrecord = shift @_;
  my $update = 0;

  my @rameauFields = (600, 601, 602, 606, 607);
  foreach my $tag (@rameauFields) {
    foreach my $field ($marcrecord->field($tag)) {
      if (isRameau($field)) {
        if ($marcrecord->field('001')) {
          print "Merging Rameau for biblionumber " . $marcrecord->field('001')->data() . " field $tag\n";
        } else {
          print "Merging Rameau for an unknown biblionumber field $tag\n";
        }
        addRameau($field);
        addInternalLinks($field);
        $update = 1;
      }
    }
  }
  return $update;
}

END { }       # module clean-up code here (global destructor)

1;

(-)a/installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql (+1 lines)

Line 0 Link Here

INSERT INTO `systempreferences` (`variable`, `value`, `options`, `explanation`, `type`) VALUES ('useRameau', '0', '', 'use Rameau authorities processing', 'YesNo'), ('rameauBnfIdIndex', 'bnfid', '', 'The zebra index that contains BNF Id for Rameau processing', 'Free');




                  yes: Do
                  no: "Do not"
            - automatically relink headings that have previously been linked when saving records in the cataloging module.
        -
            - pref: useRameau
              default: no
              choices:
                yes: Do
                no: "Do not"
            - use Rameau authorities processing.
        -
            - The zebra index that contains BNF Id's for Rameau processing
            - pref: rameauBnfIdIndex
              default: bnfid




#!/usr/bin/perl

use Modern::Perl;

use C4::Context;

use Test::More tests => 10;
use Test::MockModule;
use MARC::Record;
use C4::Biblio;
use C4::Items;
use C4::AuthoritiesMarc;
use C4::AuthoritiesRameau;
use Data::Dumper;

BEGIN {
    use FindBin;
    use lib $FindBin::Bin;
}

my $dbh = C4::Context->dbh;

# Start transaction
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;

# isRameau
my $noRameauField = MARC::Field->new('600', ' ', ' ', a => 'Whatever');
ok( C4::AuthoritiesRameau::isRameau($noRameauField) eq 0, "Verify that the field is not a Rameau field." );

my $rameauField1 = MARC::Field->new('600', ' ', ' ', a => 'One $a', 'b' => 'Dontcare', 'a' => 'Another $a');
ok( C4::AuthoritiesRameau::isRameau($rameauField1) eq 1, "Verify that the field is a Rameau field (multiple \$a's)." );

my $rameauField2 = MARC::Field->new('600', ' ', ' ', 2 => 'rameau');
ok( C4::AuthoritiesRameau::isRameau($rameauField2) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau)." );

my $rameauField3 = MARC::Field->new('600', ' ', ' ', 2 => 'Rameau');
ok( C4::AuthoritiesRameau::isRameau($rameauField3) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau, case-insensitive)." );

my $rameauField4 = MARC::Field->new('600', ' ', ' ', y => 'value');
ok( C4::AuthoritiesRameau::isRameau($rameauField4) eq 1, "Verify that the field is a Rameau field (contains at least one of \$jxyz)." );

# Update
my $rameauRecord = MARC::Record->new();
$rameauRecord->append_fields(
  MARC::Field->new('600', ' ', ' ', y => 'value')
);

is( C4::AuthoritiesRameau::rameauProcessing($rameauRecord), 1, "Verify that rameauProcessing returns that an update is needed." );

my $noRameauRecord = MARC::Record->new();
$noRameauRecord->append_fields(
  MARC::Field->new('600', ' ', ' ', a => 'Whatever')
);

is( C4::AuthoritiesRameau::rameauProcessing($noRameauRecord), 0, "Verify that rameauProcessing returns that no update is needed." );


# addInternalLinks
my $rameauFieldLinks = MARC::Field->new('600', ' ', ' ', '3' => '1',
                                                         'a' => "toto",
                                                         '9' => 'misplaced$9',
                                                         '3' => '1231',
                                                         '9' => 'needsupdate',
                                                         'x' => "titi",
                                                         '9' => 'doublemisplaced',
                                                         '9' => 'doublemisplaced',
                                                         'y' => "tata",
                                                         '3' => '1',
                                                         'k' => 'toto',
                                                         );

my $c4_authoritiesrameau_mock = new Test::MockModule('C4::AuthoritiesRameau');
$c4_authoritiesrameau_mock->mock('_findLocalAuth', sub {
    return $_[0] + 1;
});

# [ 3 => 'value, 9 => 'value', 'a' => 'value' ] => [3, 9, 'a']
sub extract_subtags {
  my @subfields = @_;

  my @return;
  foreach my $subfield (@subfields) {
     push @return, $subfield->[0];
    }
  return @return;
}

my @subfields = $rameauFieldLinks->subfields();
my @subtags = extract_subtags(@subfields);
is_deeply( [@subtags], [3, 'a', 9, 3, 9, 'x', 9, 9, 'y', 3, 'k'], "Test extract_subtags test function" );

my $processedRameauField = C4::AuthoritiesRameau::addInternalLinks($rameauFieldLinks);
my @processedRameauSubfields = $processedRameauField->subfields();

is_deeply( [extract_subtags(@processedRameauSubfields)], [3, 9, 'a', 3, 9, 'x', 'y', 3, 9, 'k'], "Verify that subfield order is correct" );

is_deeply( [$processedRameauField->subfield('9')], ["2", "1232", "2"], "Verify that internal links are added" );

Return to bug 14560

Lines 24-29 use C4::Biblio; Link Here

(-)a/C4/AuthoritiesMarc.pm (-27 / +42 lines)
24	use C4::Search;	24	use C4::Search;
25	use C4::AuthoritiesMarc::MARC21;	25	use C4::AuthoritiesMarc::MARC21;
26	use C4::AuthoritiesMarc::UNIMARC;	26	use C4::AuthoritiesMarc::UNIMARC;
		27	use C4::AuthoritiesRameau;
27	use C4::Charset;	28	use C4::Charset;
28	use C4::Log;	29	use C4::Log;
29	use Koha::MetadataRecord::Authority;	30	use Koha::MetadataRecord::Authority;
Lines 1407-1413 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1407	=cut	1408	=cut
1408		1409
1409	sub merge {	1410	sub merge {
1410	my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;	1411	my ($mergefrom,$MARCfrom,$mergeto,$MARCto, $biblionumber) = @_;
1411	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);	1412	my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);
1412	my $dbh=C4::Context->dbh;	1413	my $dbh=C4::Context->dbh;
1413	my $authfrom = Koha::Authorities->find($mergefrom);	1414	my $authfrom = Koha::Authorities->find($mergefrom);
Lines 1427-1460 sub merge { Link Here
1427	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);	1428	@record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1428		1429
1429	my @reccache;	1430	my @reccache;
1430	# search all biblio tags using this authority.	1431	if ($biblionumber) {
1431	#Getting marcbiblios impacted by the change.	1432	my $marcrecorddb = GetMarcBiblio($biblionumber);
1432	#zebra connection
1433	my $oConnection=C4::Context->Zconn("biblioserver",0);
1434	# We used to use XML syntax here, but that no longer works.
1435	# Thankfully, we don't need it.
1436	my $query;
1437	$query= "an=".$mergefrom;
1438	my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1439	my $count = 0;
1440	if ($oResult) {
1441	$count=$oResult->size();
1442	}
1443	my $z=0;
1444	while ( $z<$count ) {
1445	my $marcrecordzebra = C4::Search::new_record_from_zebra(
1446	'biblioserver',
1447	$oResult->record($z)->raw()
1448	);
1449	my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1450	my $i = ($biblionumbertagfield < 10)
1451	? $marcrecordzebra->field( $biblionumbertagfield )->data
1452	: $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
1453	my $marcrecorddb = GetMarcBiblio($i);
1454	push @reccache, $marcrecorddb;	1433	push @reccache, $marcrecorddb;
1455	$z++;	1434	} else {
		1435	# search all biblio tags using this authority.
		1436	#Getting marcbiblios impacted by the change.
		1437	#zebra connection
		1438	my $oConnection=C4::Context->Zconn("biblioserver",0);
		1439	# We used to use XML syntax here, but that no longer works.
		1440	# Thankfully, we don't need it.
		1441	my $query;
		1442	$query= "an=".$mergefrom;
		1443	my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
		1444	my $count = 0;
		1445	if ($oResult) {
		1446	$count=$oResult->size();
		1447	}
		1448	my $z=0;
		1449	while ( $z<$count ) {
		1450	my $marcrecordzebra = C4::Search::new_record_from_zebra(
		1451	'biblioserver',
		1452	$oResult->record($z)->raw()
		1453	);
		1454	my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
		1455	my $i = ($biblionumbertagfield < 10)
		1456	? $marcrecordzebra->field( $biblionumbertagfield )->data
		1457	: $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
		1458	my $marcrecorddb = GetMarcBiblio($i);
		1459	push @reccache, $marcrecorddb;
		1460	$z++;
		1461	}
		1462	$oResult->destroy();
1456	}	1463	}
1457	$oResult->destroy();
1458	#warn scalar(@reccache)." biblios to update";	1464	#warn scalar(@reccache)." biblios to update";
1459	# Get All candidate Tags for the change	1465	# Get All candidate Tags for the change
1460	# (This will reduce the search scope in marc records).	1466	# (This will reduce the search scope in marc records).
Lines 1478-1483 sub merge { Link Here
1478	foreach my $tagfield (@tags_using_authtype){	1484	foreach my $tagfield (@tags_using_authtype){
1479	# warn "tagfield : $tagfield ";	1485	# warn "tagfield : $tagfield ";
1480	foreach my $field ($marcrecord->field($tagfield)){	1486	foreach my $field ($marcrecord->field($tagfield)){
		1487
		1488	# If Rameau authorities are enabled and there are multiple $9's in the field, skip it.
		1489	my @internallinks = $field->subfield("9");
		1490	next if (C4::Context->preference('useRameau') && scalar(@internallinks) > 1);
		1491
1481	# biblio is linked to authority with $9 subfield containing authid	1492	# biblio is linked to authority with $9 subfield containing authid
1482	my $auth_number=$field->subfield("9");	1493	my $auth_number=$field->subfield("9");
1483	my $tag=$field->tag();	1494	my $tag=$field->tag();
Lines 1512-1517 sub merge { Link Here
1512	warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;	1523	warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1513	next;	1524	next;
1514	}	1525	}
		1526	if (C4::Context->preference('useRameau')) {
		1527	my $rameauUpdate = rameauProcessing($marcrecord);
		1528	$update = 1 if ($rameauUpdate == 1);
		1529	}
1515	if ($update==1){	1530	if ($update==1){
1516	&ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;	1531	&ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1517	$counteditedbiblio++;	1532	$counteditedbiblio++;

Line 0 Link Here

(-)a/C4/AuthoritiesRameau.pm (+169 lines)
		1	package C4::AuthoritiesRameau;
		2	# Copyright 2000-2002 Katipo Communications
		3	#
		4	# This file is part of Koha.
		5	#
		6	# Koha is free software; you can redistribute it and/or modify it under the
		7	# terms of the GNU General Public License as published by the Free Software
		8	# Foundation; either version 2 of the License, or (at your option) any later
		9	# version.
		10	#
		11	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		12	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		13	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License along
		16	# with Koha; if not, write to the Free Software Foundation, Inc.,
		17	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		18
		19	use strict;
		20	use warnings;
		21	use C4::Context;
		22	use MARC::Record;
		23	use MARC::Field;
		24	use C4::Biblio;
		25	use C4::Search;
		26	use C4::AuthoritiesMarc::MARC21;
		27	use C4::AuthoritiesMarc::UNIMARC;
		28	use C4::Charset;
		29	use C4::Log;
		30	use Koha::Authority;
		31
		32	use vars qw($VERSION @ISA @EXPORT);
		33
		34	BEGIN {
		35
		36	require Exporter;
		37	@ISA = qw(Exporter);
		38	@EXPORT = qw(
		39	&rameauProcessing
		40	);
		41	}
		42
		43
		44	# Is this a Rameau field?
		45	sub isRameau {
		46	my $field = shift @_;
		47
		48	# Is there a $2 with rameau value?
		49	foreach my $subfield ($field->subfield('2')) {
		50	return 1 if lc $subfield eq lc 'rameau';
		51	}
		52
		53	# Or
		54	# Are there multiple $a?
		55	my $acount = 0;
		56	foreach my $subfield ($field->subfield('a')) {
		57	$acount++;
		58	}
		59	return 1 if ($acount >= 2);
		60
		61	# Or
		62	# Is there one of these subfields? ($jxyz)
		63	my @rameauSubfields = qw/j x y z/;
		64	foreach my $rameauSubfield (@rameauSubfields) {
65	return 1 if ($field->subfield($rameauSubfield));
66	}
67	return 0;
68	}
69
70	# Add $2rameau in a field if it is not already here.
71	sub addRameau {
72	my $field = shift @_;
73	foreach my $subfield ($field->subfield('2')) {
74	return if lc $subfield eq lc 'rameau';
75	}
76	$field->add_subfields('2' => 'rameau');
77	}
78
79	# Find an auth in koha by its bnfid.
80	sub _findLocalAuth {
81	my $id = shift @_;
82	my $ctn = C4::Context->Zconn("authorityserver");
83	my $rs;
84	eval {
85	$rs = $ctn->search(new ZOOM::Query::CCL2RPN(C4::Context->preference('rameauBnfIdIndex') . '=' . $id, $ctn));
86	};
87	if ($@) {
88	print "Error searching\n";
89	return -1;
90	}
91	if ($rs && $rs->size() == 1) {
92	my $zoomauth = $rs->record(0);
93	my $kohaauth = new_from_usmarc MARC::Record ($zoomauth->raw());
94	my $kohaauthid = $kohaauth->field('001')->data();
95	$rs->destroy();
96	return $kohaauthid;
97
98	}
99	return -1;
100
101	}
102
103	# Add internal links to authorities in the rameau field.
104	sub addInternalLinks {
105	my $field = shift @_;
106	my $found_authid = 0;
107	my @newsubfields;
108
109	foreach my $subfield ($field->subfields()) {
110	# Adding/updating $9 right after $3 if the auth was found
111	my $tag = $subfield->[0];
112	my $value = $subfield->[1];
113	if ($found_authid) {
114	if ($subfield->[0] eq '9') {
115	$value = $found_authid;
116	} else {
117	push @newsubfields, '9' => $found_authid;
118	}
119	}
120
121	# This is needed for cleaning misplaced $9 that might have been here before.
122	if ($found_authid or $subfield->[0] ne '9') {
123	push @newsubfields, $tag => $value;
124	}
125
126	$found_authid = 0;
127
128	# Looking for an auth
129	if ($subfield->[0] eq 3) {
130	if (my $kohaauthid = _findLocalAuth($subfield->[1])) {
131	if ($kohaauthid != -1) {
132	$found_authid = $kohaauthid;
133	print "Adding authid $kohaauthid\n";
134	}
135	}
136	}
137	}
138
139	my $newfield = MARC::Field->new($field->tag(), $field->indicator(1), $field->indicator(2), @newsubfields);
140	$field->replace_with($newfield);
141	return $field;
142	}
143
144	# Main function. Start rameau processing for a record.
145	sub rameauProcessing {
146	my $marcrecord = shift @_;
147	my $update = 0;
148
149	my @rameauFields = (600, 601, 602, 606, 607);
150	foreach my $tag (@rameauFields) {
151	foreach my $field ($marcrecord->field($tag)) {
152	if (isRameau($field)) {
153	if ($marcrecord->field('001')) {
154	print "Merging Rameau for biblionumber " . $marcrecord->field('001')->data() . " field $tag\n";
155	} else {
156	print "Merging Rameau for an unknown biblionumber field $tag\n";
157	}
158	addRameau($field);
159	addInternalLinks($field);
160	$update = 1;
161	}
162	}
163	}
164	return $update;
165	}
166
167	END { } # module clean-up code here (global destructor)
168
169	1;

Lines 85-87 Authorities: Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref (+11 lines)
85	yes: Do	85	yes: Do
86	no: "Do not"	86	no: "Do not"
87	- automatically relink headings that have previously been linked when saving records in the cataloging module.	87	- automatically relink headings that have previously been linked when saving records in the cataloging module.
		88	-
		89	- pref: useRameau
		90	default: no
		91	choices:
		92	yes: Do
		93	no: "Do not"
		94	- use Rameau authorities processing.
		95	-
		96	- The zebra index that contains BNF Id's for Rameau processing
		97	- pref: rameauBnfIdIndex
		98	default: bnfid

Line 0 Link Here

(-)a/t/db_dependent/AuthoritiesRameau.t (-1 / +98 lines)
0	-	1	#!/usr/bin/perl
		2
		3	use Modern::Perl;
		4
		5	use C4::Context;
		6
		7	use Test::More tests => 10;
		8	use Test::MockModule;
		9	use MARC::Record;
		10	use C4::Biblio;
		11	use C4::Items;
		12	use C4::AuthoritiesMarc;
		13	use C4::AuthoritiesRameau;
		14	use Data::Dumper;
		15
		16	BEGIN {
		17	use FindBin;
		18	use lib $FindBin::Bin;
		19	}
		20
		21	my $dbh = C4::Context->dbh;
		22
		23	# Start transaction
		24	$dbh->{AutoCommit} = 0;
		25	$dbh->{RaiseError} = 1;
		26
		27	# isRameau
		28	my $noRameauField = MARC::Field->new('600', ' ', ' ', a => 'Whatever');
		29	ok( C4::AuthoritiesRameau::isRameau($noRameauField) eq 0, "Verify that the field is not a Rameau field." );
		30
		31	my $rameauField1 = MARC::Field->new('600', ' ', ' ', a => 'One $a', 'b' => 'Dontcare', 'a' => 'Another $a');
		32	ok( C4::AuthoritiesRameau::isRameau($rameauField1) eq 1, "Verify that the field is a Rameau field (multiple \$a's)." );
		33
		34	my $rameauField2 = MARC::Field->new('600', ' ', ' ', 2 => 'rameau');
		35	ok( C4::AuthoritiesRameau::isRameau($rameauField2) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau)." );
		36
		37	my $rameauField3 = MARC::Field->new('600', ' ', ' ', 2 => 'Rameau');
		38	ok( C4::AuthoritiesRameau::isRameau($rameauField3) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau, case-insensitive)." );
		39
		40	my $rameauField4 = MARC::Field->new('600', ' ', ' ', y => 'value');
		41	ok( C4::AuthoritiesRameau::isRameau($rameauField4) eq 1, "Verify that the field is a Rameau field (contains at least one of \$jxyz)." );
		42
		43	# Update
		44	my $rameauRecord = MARC::Record->new();
		45	$rameauRecord->append_fields(
		46	MARC::Field->new('600', ' ', ' ', y => 'value')
		47	);
		48
		49	is( C4::AuthoritiesRameau::rameauProcessing($rameauRecord), 1, "Verify that rameauProcessing returns that an update is needed." );
		50
		51	my $noRameauRecord = MARC::Record->new();
		52	$noRameauRecord->append_fields(
		53	MARC::Field->new('600', ' ', ' ', a => 'Whatever')
		54	);
		55
		56	is( C4::AuthoritiesRameau::rameauProcessing($noRameauRecord), 0, "Verify that rameauProcessing returns that no update is needed." );
		57
		58
		59	# addInternalLinks
		60	my $rameauFieldLinks = MARC::Field->new('600', ' ', ' ', '3' => '1',
		61	'a' => "toto",
		62	'9' => 'misplaced$9',
		63	'3' => '1231',
		64	'9' => 'needsupdate',
		65	'x' => "titi",
66	'9' => 'doublemisplaced',
67	'9' => 'doublemisplaced',
68	'y' => "tata",
69	'3' => '1',
70	'k' => 'toto',
71	);
72
73	my $c4_authoritiesrameau_mock = new Test::MockModule('C4::AuthoritiesRameau');
74	$c4_authoritiesrameau_mock->mock('_findLocalAuth', sub {
75	return $_[0] + 1;
76	});
77
78	# [ 3 => 'value, 9 => 'value', 'a' => 'value' ] => [3, 9, 'a']
79	sub extract_subtags {
80	my @subfields = @_;
81
82	my @return;
83	foreach my $subfield (@subfields) {
84	push @return, $subfield->[0];
85	}
86	return @return;
87	}
88
89	my @subfields = $rameauFieldLinks->subfields();
90	my @subtags = extract_subtags(@subfields);
91	is_deeply( [@subtags], [3, 'a', 9, 3, 9, 'x', 9, 9, 'y', 3, 'k'], "Test extract_subtags test function" );
92
93	my $processedRameauField = C4::AuthoritiesRameau::addInternalLinks($rameauFieldLinks);
94	my @processedRameauSubfields = $processedRameauField->subfields();
95
96	is_deeply( [extract_subtags(@processedRameauSubfields)], [3, 9, 'a', 3, 9, 'x', 'y', 3, 9, 'k'], "Verify that subfield order is correct" );
97
98	is_deeply( [$processedRameauField->subfield('9')], ["2", "1232", "2"], "Verify that internal links are added" );