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

(-)a/C4/AuthoritiesMarc.pm (-27 / +42 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::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++;
(-)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 (+11 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
(-)a/t/db_dependent/AuthoritiesRameau.t (-1 / +98 lines)
Line 0 Link Here
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" );

Return to bug 14560