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

(-)a/C4/AuthoritiesMarc.pm (-28 / +43 lines)
Lines 24-29 use C4::Biblio; Link Here
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::Authority;
30
use Koha::Authority;
Lines 1446-1452 Then we should add some new parameter : bibliotargettag, authtargettag Link Here
1446
=cut
1447
=cut
1447
1448
1448
sub merge {
1449
sub merge {
1449
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
1450
    my ($mergefrom,$MARCfrom,$mergeto,$MARCto, $biblionumber) = @_;
1450
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1451
    my ($counteditedbiblio,$countunmodifiedbiblio,$counterrors)=(0,0,0);        
1451
    my $dbh=C4::Context->dbh;
1452
    my $dbh=C4::Context->dbh;
1452
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
1453
    my $authtypecodefrom = GetAuthTypeCode($mergefrom);
Lines 1468-1501 sub merge { Link Here
1468
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1469
    @record_from = $MARCfrom->field($auth_tag_to_report_from)->subfields() if $MARCfrom->field($auth_tag_to_report_from);
1469
    
1470
    
1470
    my @reccache;
1471
    my @reccache;
1471
    # search all biblio tags using this authority.
1472
    if ($biblionumber) {
1472
    #Getting marcbiblios impacted by the change.
1473
        my $marcrecorddb = GetMarcBiblio($biblionumber);
1473
    #zebra connection
1474
    my $oConnection=C4::Context->Zconn("biblioserver",0);
1475
    # We used to use XML syntax here, but that no longer works.
1476
    # Thankfully, we don't need it.
1477
    my $query;
1478
    $query= "an=".$mergefrom;
1479
    my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1480
    my $count = 0;
1481
    if  ($oResult) {
1482
        $count=$oResult->size();
1483
    }
1484
    my $z=0;
1485
    while ( $z<$count ) {
1486
        my $marcrecordzebra = C4::Search::new_record_from_zebra(
1487
            'biblioserver',
1488
            $oResult->record($z)->raw()
1489
        );
1490
        my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1491
        my $i = ($biblionumbertagfield < 10)
1492
            ? $marcrecordzebra->field( $biblionumbertagfield )->data
1493
            : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
1494
        my $marcrecorddb = GetMarcBiblio($i);
1495
        push @reccache, $marcrecorddb;
1474
        push @reccache, $marcrecorddb;
1496
        $z++;
1475
    } else {
1476
      # search all biblio tags using this authority.
1477
      #Getting marcbiblios impacted by the change.
1478
      #zebra connection
1479
      my $oConnection=C4::Context->Zconn("biblioserver",0);
1480
      # We used to use XML syntax here, but that no longer works.
1481
      # Thankfully, we don't need it.
1482
      my $query;
1483
      $query= "an=".$mergefrom;
1484
      my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
1485
      my $count = 0;
1486
      if  ($oResult) {
1487
          $count=$oResult->size();
1488
      }
1489
      my $z=0;
1490
      while ( $z<$count ) {
1491
          my $marcrecordzebra = C4::Search::new_record_from_zebra(
1492
              'biblioserver',
1493
              $oResult->record($z)->raw()
1494
          );
1495
          my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
1496
          my $i = ($biblionumbertagfield < 10)
1497
              ? $marcrecordzebra->field( $biblionumbertagfield )->data
1498
              : $marcrecordzebra->subfield( $biblionumbertagfield, $biblionumbertagsubfield );
1499
          my $marcrecorddb = GetMarcBiblio($i);
1500
          push @reccache, $marcrecorddb;
1501
          $z++;
1502
      }
1503
      $oResult->destroy();
1497
    }
1504
    }
1498
    $oResult->destroy();
1499
    #warn scalar(@reccache)." biblios to update";
1505
    #warn scalar(@reccache)." biblios to update";
1500
    # Get All candidate Tags for the change 
1506
    # Get All candidate Tags for the change 
1501
    # (This will reduce the search scope in marc records).
1507
    # (This will reduce the search scope in marc records).
Lines 1515-1524 sub merge { Link Here
1515
    # BulkEdit marc records
1521
    # BulkEdit marc records
1516
    # May be used as a template for a bulkedit field  
1522
    # May be used as a template for a bulkedit field  
1517
    foreach my $marcrecord(@reccache){
1523
    foreach my $marcrecord(@reccache){
1518
        my $update;           
1524
        my $update;
1519
        foreach my $tagfield (@tags_using_authtype){
1525
        foreach my $tagfield (@tags_using_authtype){
1520
#             warn "tagfield : $tagfield ";
1526
#             warn "tagfield : $tagfield ";
1521
            foreach my $field ($marcrecord->field($tagfield)){
1527
            foreach my $field ($marcrecord->field($tagfield)){
1528
1529
                # If Rameau authorities are enabled and there are multiple $9's in the field, skip it.
1530
                my @internallinks = $field->subfield("9");
1531
                next if (C4::Context->preference('useRameau') && scalar(@internallinks) > 1);
1532
1522
                # biblio is linked to authority with $9 subfield containing authid
1533
                # biblio is linked to authority with $9 subfield containing authid
1523
                my $auth_number=$field->subfield("9");
1534
                my $auth_number=$field->subfield("9");
1524
                my $tag=$field->tag();          
1535
                my $tag=$field->tag();          
Lines 1553-1558 sub merge { Link Here
1553
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1564
            warn "pas de numéro de notice bibliographique dans : ".$marcrecord->as_formatted;
1554
            next;
1565
            next;
1555
        }
1566
        }
1567
        if (C4::Context->preference('useRameau')) {
1568
          my $rameauUpdate = rameauProcessing($marcrecord);
1569
          $update = 1 if ($rameauUpdate == 1);
1570
        }
1556
        if ($update==1){
1571
        if ($update==1){
1557
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1572
            &ModBiblio($marcrecord,$biblionumber,GetFrameworkCode($biblionumber)) ;
1558
            $counteditedbiblio++;
1573
            $counteditedbiblio++;
(-)a/C4/AuthoritiesRameau.pm (+169 lines)
Line 0 Link Here
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;
(-)a/installer/data/mysql/atomicupdate/Bug14560-Rameau_authorities.sql (+1 lines)
Line 0 Link Here
1
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');
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref (+12 lines)
Lines 85-87 Authorities: Link Here
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
99
(-)a/t/db_dependent/AuthoritiesRameau.t (-1 / +101 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
5
use C4::Context;
6
use C4::Branch;
7
8
use Test::More tests => 10;
9
use Test::MockModule;
10
use MARC::Record;
11
use C4::Biblio;
12
use C4::Items;
13
use C4::AuthoritiesMarc;
14
use C4::AuthoritiesRameau;
15
use Data::Dumper;
16
17
BEGIN {
18
    use FindBin;
19
    use lib $FindBin::Bin;
20
}
21
22
my $dbh = C4::Context->dbh;
23
24
# Start transaction
25
$dbh->{AutoCommit} = 0;
26
$dbh->{RaiseError} = 1;
27
28
# isRameau
29
my $noRameauField = MARC::Field->new('600', ' ', ' ', a => 'Whatever');
30
ok( C4::AuthoritiesRameau::isRameau($noRameauField) eq 0, "Verify that the field is not a Rameau field." );
31
32
my $rameauField1 = MARC::Field->new('600', ' ', ' ', a => 'One $a', 'b' => 'Dontcare', 'a' => 'Another $a');
33
ok( C4::AuthoritiesRameau::isRameau($rameauField1) eq 1, "Verify that the field is a Rameau field (multiple \$a's)." );
34
35
my $rameauField2 = MARC::Field->new('600', ' ', ' ', 2 => 'rameau');
36
ok( C4::AuthoritiesRameau::isRameau($rameauField2) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau)." );
37
38
my $rameauField3 = MARC::Field->new('600', ' ', ' ', 2 => 'Rameau');
39
ok( C4::AuthoritiesRameau::isRameau($rameauField3) eq 1, "Verify that the field is a Rameau field (\$2 contains rameau, case-insensitive)." );
40
41
my $rameauField4 = MARC::Field->new('600', ' ', ' ', y => 'value');
42
ok( C4::AuthoritiesRameau::isRameau($rameauField4) eq 1, "Verify that the field is a Rameau field (contains at least one of \$jxyz)." );
43
44
# Update
45
my $rameauRecord = MARC::Record->new();
46
$rameauRecord->append_fields(
47
  MARC::Field->new('600', ' ', ' ', y => 'value')
48
);
49
50
is( C4::AuthoritiesRameau::rameauProcessing($rameauRecord), 1, "Verify that rameauProcessing returns that an update is needed." );
51
52
my $noRameauRecord = MARC::Record->new();
53
$noRameauRecord->append_fields(
54
  MARC::Field->new('600', ' ', ' ', a => 'Whatever')
55
);
56
57
is( C4::AuthoritiesRameau::rameauProcessing($noRameauRecord), 0, "Verify that rameauProcessing returns that no update is needed." );
58
59
60
# addInternalLinks
61
my $rameauFieldLinks = MARC::Field->new('600', ' ', ' ', '3' => '1',
62
                                                         'a' => "toto",
63
                                                         '9' => 'misplaced$9',
64
                                                         '3' => '1231',
65
                                                         '9' => 'needsupdate',
66
                                                         'x' => "titi",
67
                                                         '9' => 'doublemisplaced',
68
                                                         '9' => 'doublemisplaced',
69
                                                         'y' => "tata",
70
                                                         '3' => '1',
71
                                                         'k' => 'toto',
72
                                                         );
73
74
my $c4_authoritiesrameau_mock = new Test::MockModule('C4::AuthoritiesRameau');
75
$c4_authoritiesrameau_mock->mock('_findLocalAuth', sub {
76
    return $_[0] + 1;
77
});
78
79
# [ 3 => 'value, 9 => 'value', 'a' => 'value' ] => [3, 9, 'a']
80
sub extract_subtags {
81
  my @subfields = @_;
82
83
  my @return;
84
  foreach my $subfield (@subfields) {
85
     push @return, $subfield->[0];
86
    }
87
  return @return;
88
}
89
90
my @subfields = $rameauFieldLinks->subfields();
91
my @subtags = extract_subtags(@subfields);
92
is_deeply( [@subtags], [3, 'a', 9, 3, 9, 'x', 9, 9, 'y', 3, 'k'], "Test extract_subtags test function" );
93
94
my $processedRameauField = C4::AuthoritiesRameau::addInternalLinks($rameauFieldLinks);
95
my @processedRameauSubfields = $processedRameauField->subfields();
96
97
is_deeply( [extract_subtags(@processedRameauSubfields)], [3, 9, 'a', 3, 9, 'x', 'y', 3, 9, 'k'], "Verify that subfield order is correct" );
98
99
is_deeply( [$processedRameauField->subfield('9')], ["2", "1232", "2"], "Verify that internal links are added" );
100
101

Return to bug 14560