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

(-)a/C4/Biblio.pm (-2 / +9 lines)
Lines 507-513 sub BiblioAutoLink { Link Here
507
507
508
=head2 LinkBibHeadingsToAuthorities
508
=head2 LinkBibHeadingsToAuthorities
509
509
510
  my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $verbose]);
510
  my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink, $verbose, $dont_auto_create]);
511
511
512
Links bib headings to authority records by checking
512
Links bib headings to authority records by checking
513
each authority-controlled field in the C<MARC::Record>
513
each authority-controlled field in the C<MARC::Record>
Lines 530-535 sub LinkBibHeadingsToAuthorities { Link Here
530
    my $frameworkcode = shift;
530
    my $frameworkcode = shift;
531
    my $allowrelink = shift;
531
    my $allowrelink = shift;
532
    my $verbose = shift;
532
    my $verbose = shift;
533
    my $dont_auto_create = shift;
533
    my %results;
534
    my %results;
534
    if (!$bib) {
535
    if (!$bib) {
535
        carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
536
        carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
Lines 555-560 sub LinkBibHeadingsToAuthorities { Link Here
555
        }
556
        }
556
557
557
        my ( $authid, $fuzzy, $status ) = $linker->get_link($heading);
558
        my ( $authid, $fuzzy, $status ) = $linker->get_link($heading);
559
        if(defined $status and ($status eq 'NO_CONNECTION' or $status eq 'SERVER_NOT_FOUND')) {
560
            return 0, { error => $status };
561
        }
558
        if ($authid) {
562
        if ($authid) {
559
            $results{ $fuzzy ? 'fuzzy' : 'linked' }
563
            $results{ $fuzzy ? 'fuzzy' : 'linked' }
560
              ->{ $heading->display_form() }++;
564
              ->{ $heading->display_form() }++;
Lines 575-583 sub LinkBibHeadingsToAuthorities { Link Here
575
                $results{'fuzzy'}->{ $heading->display_form() }++;
579
                $results{'fuzzy'}->{ $heading->display_form() }++;
576
                push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
580
                push(@{$results{'details'}}, { tag => $field->tag(), authid => $current_link, status => 'UNCHANGED'}) if $verbose;
577
            }
581
            }
578
            elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
582
            elsif ( !$dont_auto_create && C4::Context->preference('AutoCreateAuthorities') ) {
579
                if ( _check_valid_auth_link( $current_link, $field ) ) {
583
                if ( _check_valid_auth_link( $current_link, $field ) ) {
580
                    $results{'linked'}->{ $heading->display_form() }++;
584
                    $results{'linked'}->{ $heading->display_form() }++;
585
                    push(@{$results{'details'}}, { tag => $field->tag(), authid => $authid, status => 'UNCHANGED'}) if $verbose;
581
                }
586
                }
582
                else {
587
                else {
583
                    $authid = AddAuthorityFromHeading($heading, $field, $bib);
588
                    $authid = AddAuthorityFromHeading($heading, $field, $bib);
Lines 649-654 sub AddAuthorityFromHeading { Link Here
649
    my $heading = shift;
654
    my $heading = shift;
650
    my $field = shift;
655
    my $field = shift;
651
    my $bib = shift;
656
    my $bib = shift;
657
    my $current_link = $field->subfield('9');
652
658
653
    my $authtypedata =
659
    my $authtypedata =
654
      C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
660
      C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
Lines 657-662 sub AddAuthorityFromHeading { Link Here
657
        $marcrecordauth->leader('     nz  a22     o  4500');
663
        $marcrecordauth->leader('     nz  a22     o  4500');
658
        SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
664
        SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
659
    }
665
    }
666
    $field->delete_subfield( code => '9' ) if defined $current_link;
660
    my $authfield =
667
    my $authfield =
661
      MARC::Field->new( $authtypedata->{auth_tag_to_report},
668
      MARC::Field->new( $authtypedata->{auth_tag_to_report},
662
        '', '', "a" => "" . $field->subfield('a') );
669
        '', '', "a" => "" . $field->subfield('a') );
(-)a/C4/Linker/Z3950Server.pm (+308 lines)
Line 0 Link Here
1
package C4::Linker::Z3950Server;
2
3
# Copyright 2012 Frédérick Capovilla - Libéo
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use strict;
19
use warnings;
20
use Carp;
21
use MARC::Field;
22
use MARC::Record;
23
use C4::Context;
24
use C4::Heading;
25
use ZOOM; # For Z39.50 Searches
26
use C4::AuthoritiesMarc; # For Authority addition
27
use C4::Log; # logaction
28
29
use base qw(C4::Linker);
30
31
32
sub get_link {
33
    my $self        = shift;
34
    my $heading     = shift;
35
    my $behavior    = shift || 'default';
36
    my $search_form = $heading->search_form();
37
    my $authid;
38
    my $fuzzy = 0;
39
    my $status = '';
40
41
    if ( $self->{'cache'}->{$search_form}->{'cached'} ) {
42
        $authid = $self->{'cache'}->{$search_form}->{'authid'};
43
        $fuzzy  = $self->{'cache'}->{$search_form}->{'fuzzy'};
44
    }
45
    else {
46
        # Look for matching authorities on the Z39.50 server
47
        unless($self->{'local_first'}) {
48
            ($authid, undef, $status) = $self->getZ3950Authority($heading);
49
50
            if($status eq 'Z3950_SEARCH_ERROR' or
51
               $status eq 'Z3950_QUERY_ERROR' or
52
               $status eq 'NO_CONNECTION' or
53
               $status eq 'SERVER_NOT_FOUND') {
54
                return $authid, $fuzzy, $status;
55
            }
56
        }
57
58
        if(!$authid) {
59
            # look for matching authorities
60
            my $authorities = $heading->authorities(1);    # $skipmetadata = true
61
62
            if ( $behavior eq 'default' && $#{$authorities} == 0 ) {
63
                $authid = $authorities->[0]->{'authid'};
64
            }
65
            elsif ( $behavior eq 'first' && $#{$authorities} >= 0 ) {
66
                $authid = $authorities->[0]->{'authid'};
67
                $fuzzy  = $#{$authorities} > 0;
68
            }
69
            elsif ( $behavior eq 'last' && $#{$authorities} >= 0 ) {
70
                $authid = $authorities->[ $#{$authorities} ]->{'authid'};
71
                $fuzzy  = $#{$authorities} > 0;
72
            }
73
74
            if ( !defined $authid && $self->{'broader_headings'} ) {
75
                my $field     = $heading->field();
76
                my @subfields = $field->subfields();
77
                if ( scalar @subfields > 1 ) {
78
                    pop @subfields;
79
                    $field->replace_with(
80
                        MARC::Field->new(
81
                            $field->tag,
82
                            $field->indicator(1),
83
                            $field->indicator(2),
84
                            map { $_[0] => $_[1] } @subfields
85
                        )
86
                    );
87
                    ( $authid, $fuzzy ) =
88
                      $self->get_link( C4::Heading->new_from_bib_field($field),
89
                        $behavior );
90
                }
91
            }
92
        }
93
94
        if($self->{'local_first'} && !$authid) {
95
            ($authid, undef, $status) = $self->getZ3950Authority($heading);
96
        }
97
98
        $self->{'cache'}->{$search_form}->{'cached'} = 1;
99
        $self->{'cache'}->{$search_form}->{'authid'} = $authid;
100
        $self->{'cache'}->{$search_form}->{'fuzzy'}  = $fuzzy;
101
    }
102
    return $self->SUPER::_handle_auth_limit($authid), $fuzzy, $status;
103
}
104
105
sub flip_heading {
106
    my $self    = shift;
107
    my $heading = shift;
108
109
    # TODO: implement
110
}
111
112
113
=head1 getZ3950Authority
114
115
  ($authid, $record, $status) = $self->getZ3950Authority($heading);
116
117
  Do a Z39.50 search for the heading using the $conn ZOOM::Connection object and the $heading Heading.
118
  The column kx_rcimport_control_number is used to check for duplicates.
119
  FIXME: Use thesaurus in search? As of Koha 3.8, the community stopped using them.
120
121
  RETURNS :
122
  $authid = the ID of the local copy of the authority record that was found. undef if nothing was found.
123
  $record = the MARC record of the found authority.
124
  $status = A string with additional informations on the search status (Z3950_CREATED, Z3950_UPDATED, Z3950_QUERY_ERROR, Z3950_SEARCH_ERROR)
125
126
=cut
127
128
sub getZ3950Authority {
129
    my $self = shift;
130
    my $heading = shift;
131
132
    # Try to find a match on the Z39.50 server if LinkerZ3950Server is set
133
    if(C4::Context->preference('LinkerZ3950Server')) {
134
        unless($self->{'conn'}) {
135
            my $sth = C4::Context->dbh->prepare("select * from z3950servers where name=?");
136
            $sth->execute(C4::Context->preference('LinkerZ3950Server'));
137
            my $server = $sth->fetchrow_hashref or undef;
138
            $sth->finish;
139
140
            if($server) {
141
                my $options = new ZOOM::Options();
142
                $options->option('cclfile' => C4::Context->ModZebrations('authorityserver')->{"ccl2rpn"});
143
                $options->option('elementSetName', 'F');
144
                $options->option('async', 0);
145
                $options->option('databaseName', $server->{db});
146
                $options->option('user',         $server->{userid}  ) if $server->{userid};
147
                $options->option('password',     $server->{password}) if $server->{password};
148
                $options->option('preferredRecordSyntax', $server->{syntax});
149
                $self->{'conn'} = create ZOOM::Connection($options);
150
                eval{ $self->{'conn'}->connect( $server->{host}, $server->{port} ) };
151
                if($@) {
152
                    return (undef, undef, 'NO_CONNECTION');
153
                }
154
            }
155
            else {
156
                return (undef, undef, 'SERVER_NOT_FOUND');
157
            }
158
        }
159
    }
160
    else {
161
        return;
162
    }
163
164
    my $query = qq(Match-heading,do-not-truncate,ext="$heading->{'search_form'}");
165
166
    my $zquery = eval{ new ZOOM::Query::CCL2RPN($query, $self->{'conn'}) };
167
    if($@) {
168
        warn $query . "\n" . $@;
169
        return (undef, undef, 'Z3950_QUERY_ERROR');
170
    }
171
172
    # Try to send the search query to the server.
173
    my $rs = eval{ $self->{'conn'}->search($zquery) };
174
    if($@){
175
        warn $query . "\n" . $@;
176
        return (undef, undef, 'Z3950_SEARCH_ERROR');
177
    }
178
179
    # If authorities are found, select the first valid one for addition in the local authority table.
180
    my $record;
181
    if($rs->size != 0) {
182
        $record = MARC::Record::new_from_usmarc($rs->record(0)->raw());
183
    }
184
    $rs->destroy();
185
    $zquery->destroy();
186
187
    # If a valid authority was found, add it in the local authority database.
188
    if($record) {
189
        my $dbh=C4::Context->dbh;
190
191
        my $authtypecode = C4::AuthoritiesMarc::GuessAuthTypeCode($record);
192
        my $authId;
193
194
        # Use the control number to prevent the creation of duplicate authorities.
195
        my $controlNumber = $record->field('970')->subfield('0');
196
        my $sthExist=$dbh->prepare("SELECT authid FROM auth_header WHERE kx_rcimport_control_number=?");
197
        $sthExist->execute($controlNumber) or die $sthExist->errstr;
198
        ($authId) = $sthExist->fetchrow;
199
        $sthExist->finish;
200
201
        #------------------------------------------------------------------------------------------
202
        # Corrections and verifications before insertion
203
        my $format;
204
        my $leader='     nz  a22     o  4500';# Leader for incomplete MARC21 record
205
206
        if (uc(C4::Context->preference('marcflavour')) eq 'UNIMARC') {
207
            $format= 'UNIMARCAUTH';
208
        }
209
        else {
210
            $format= 'MARC21';
211
        }
212
213
        if ($format eq "MARC21") {
214
            if (!$record->leader) {
215
                $record->leader($leader);
216
            }
217
            if (!$record->field('003')) {
218
                $record->insert_fields_ordered(
219
                        MARC::Field->new('003',C4::Context->preference('MARCOrgCode'))
220
                        );
221
            }
222
            my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime);
223
            if (!$record->field('005')) {
224
                $record->insert_fields_ordered(
225
                        MARC::Field->new('005',$time.".0")
226
                        );
227
            }
228
            my $date=POSIX::strftime("%y%m%d",localtime);
229
            if (!$record->field('008')) {
230
                # Get a valid default value for field 008
231
                my $default_008 = C4::Context->preference('MARCAuthorityControlField008');
232
                if(!$default_008 or length($default_008)<34) {
233
                    $default_008 = '|| aca||aabn           | a|a     d';
234
                }
235
                else {
236
                    $default_008 = substr($default_008,0,34);
237
                }
238
239
                $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) );
240
            }
241
            if (!$record->field('040')) {
242
                $record->insert_fields_ordered(
243
                    MARC::Field->new('040','','',
244
                        'a' => C4::Context->preference('MARCOrgCode'),
245
                        'c' => C4::Context->preference('MARCOrgCode')
246
                    )
247
                );
248
            }
249
        }
250
        if ($format eq "UNIMARCAUTH") {
251
            $record->leader("     nx  j22             ") unless ($record->leader());
252
            my $date=POSIX::strftime("%Y%m%d",localtime);
253
            if (my $string=$record->subfield('100',"a")){
254
                $string=~s/fre50/frey50/;
255
                $record->field('100')->update('a'=>$string);
256
            }
257
            elsif ($record->field('100')){
258
                $record->field('100')->update('a'=>$date."afrey50      ba0");
259
            } else {
260
                $record->append_fields(
261
                    MARC::Field->new('100',' ',' '
262
                        ,'a'=>$date."afrey50      ba0")
263
                );
264
            }
265
        }
266
        my ($auth_type_tag, $auth_type_subfield) = C4::AuthoritiesMarc::get_auth_type_location($authtypecode);
267
        if (!$authId and $format eq "MARC21") {
268
        # only need to do this fix when modifying an existing authority
269
            C4::AuthoritiesMarc::MARC21::fix_marc21_auth_type_location($record, $auth_type_tag, $auth_type_subfield);
270
        }
271
        if (my $field=$record->field($auth_type_tag)){
272
            $field->update($auth_type_subfield=>$authtypecode);
273
        }
274
        else {
275
            $record->add_fields($auth_type_tag,'','', $auth_type_subfield=>$authtypecode);
276
        }
277
        #------------------------------------------------------------------------------------------
278
        if ($authId) {
279
            my $oldRecord=C4::AuthoritiesMarc::GetAuthority($authId);
280
281
            my $sth=$dbh->prepare("UPDATE auth_header SET authtypecode=?,marc=?,marcxml=? WHERE kx_rcimport_control_number=?");
282
            eval { $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$controlNumber) or die $sth->errstr; };
283
            $sth->finish;
284
            warn "Problem with authority $controlNumber : Cannot update" if $@;
285
            $dbh->commit unless $dbh->{AutoCommit};
286
            return if $@;
287
288
            C4::Biblio::ModZebra($authId,'linkerUpdate',"authorityserver",$oldRecord,$record);
289
            return ($authId, $record, 'Z3950_UPDATED');
290
        }
291
        else {
292
            my $sth=$dbh->prepare("INSERT INTO auth_header (datecreated,authtypecode,marc,marcxml,kx_rcimport_control_number) VALUES (NOW(),?,?,?,?)");
293
            eval { $sth->execute($authtypecode,$record->as_usmarc,$record->as_xml_record($format),$controlNumber) or die $sth->errstr; };
294
            $sth->finish;
295
            warn "Problem with authority $controlNumber : Cannot insert" if $@;
296
            my $id = $dbh->{'mysql_insertid'};
297
            $dbh->commit unless $dbh->{AutoCommit};
298
            return if $@;
299
300
            logaction( "AUTHORITIES", "ADD", $id, "authority" ) if C4::Context->preference("AuthoritiesLog");
301
            C4::Biblio::ModZebra($id,'linkerUpdate',"authorityserver",undef,$record);
302
            return ($id, $record, 'Z3950_CREATED');
303
        }
304
    }
305
    return;
306
}
307
308
1;
(-)a/cataloguing/automatic_linker.pl (-3 / +8 lines)
Lines 43-49 if ($auth_status ne "ok") { Link Here
43
#
43
#
44
# tag = the tag number of the field
44
# tag = the tag number of the field
45
# authid = the value of the $9 subfield for this tag
45
# authid = the value of the $9 subfield for this tag
46
# status = The status of the link (LOCAL_FOUND, NONE_FOUND, MULTIPLE_MATCH, UNCHANGED, CREATED)
46
# status = The status of the link (LOCAL_FOUND, NONE_FOUND, MULTIPLE_MATCH, UNCHANGED, CREATED, Z3950_CREATED, Z3950_UPDATED)
47
47
48
my $json;
48
my $json;
49
49
Lines 63-69 my $linker = $linker_module->new( { 'options' => C4::Context->preference("Linker Link Here
63
63
64
my ( $headings_changed, $results ) = LinkBibHeadingsToAuthorities( $linker, $record, $input->param('frameworkcode'), C4::Context->preference("CatalogModuleRelink") || '', 1 );
64
my ( $headings_changed, $results ) = LinkBibHeadingsToAuthorities( $linker, $record, $input->param('frameworkcode'), C4::Context->preference("CatalogModuleRelink") || '', 1 );
65
65
66
$json->{status} = 'OK';
66
if(defined $results->{error}) {
67
$json->{links} = $results->{details} || '';
67
    $json->{status} = $results->{error};
68
}
69
else {
70
    $json->{status} = 'OK';
71
    $json->{links} = $results->{details} || '';
72
}
68
73
69
print to_json($json);
74
print to_json($json);
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/authorities.pref (+5 lines)
Lines 58-63 Authorities: Link Here
58
                  Default: Default
58
                  Default: Default
59
                  FirstMatch: "First Match"
59
                  FirstMatch: "First Match"
60
                  LastMatch: "Last Match"
60
                  LastMatch: "Last Match"
61
                  Z3950Server: "Z39.50 Server"
61
            - linker module for matching headings to authority records.
62
            - linker module for matching headings to authority records.
62
        -
63
        -
63
            - Set the following options for the authority linker
64
            - Set the following options for the authority linker
Lines 85-87 Authorities: Link Here
85
                  yes: Do
86
                  yes: Do
86
                  no: "Do not"
87
                  no: "Do not"
87
            - automatically relink headings that have previously been linked when saving records in the cataloging module.
88
            - automatically relink headings that have previously been linked when saving records in the cataloging module.
89
        -
90
            - "Import authorities from this Z39.50 server when searching for authority links with the 'Z39.50 Server' linker module :"
91
            - pref: LinkerZ3950Server
92
              class: multi
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/cataloguing/addbiblio.tt (-1 / +16 lines)
Lines 231-236 function updateHeadingLinks(links) { Link Here
231
        var message = '';
231
        var message = '';
232
        var field_color = '#FFAAAA';
232
        var field_color = '#FFAAAA';
233
        switch(heading.status) {
233
        switch(heading.status) {
234
            case 'Z3950_CREATED':
235
                image = 'approve.gif';
236
                message = _("A matching authority record was found on the Z39.50 server and was imported locally.");
237
                field_color = '#99FF99';
238
                break;
239
            case 'Z3950_UPDATED':
240
                image = 'approve.gif';
241
                message = _("A matching authority record was found on the Z39.50 server and a local authority was updated.");
242
                field_color = '#99FF99';
243
                break;
234
            case 'LOCAL_FOUND':
244
            case 'LOCAL_FOUND':
235
                image = 'approve.gif';
245
                image = 'approve.gif';
236
                message = _("A matching authority was found in the local database.");
246
                message = _("A matching authority was found in the local database.");
Lines 312-317 function AutomaticLinker() { Link Here
312
                case 'UNAUTHORIZED':
322
                case 'UNAUTHORIZED':
313
                    alert(_("Error : You do not have the permissions necessary to use this functionality."));
323
                    alert(_("Error : You do not have the permissions necessary to use this functionality."));
314
                    break;
324
                    break;
325
                case 'SERVER_NOT_FOUND':
326
                    alert(_("Error : The Z39.50 server configured in the 'LinkerZ3950Server' preference was not found in the Z39.50 servers list."));
327
                    break;
328
                case 'NO_CONNECTION':
329
                    alert(_("Error : Could not connect to the Z39.50 server."));
330
                    break;
315
                case 'OK':
331
                case 'OK':
316
                    updateHeadingLinks(json.links);
332
                    updateHeadingLinks(json.links);
317
                    break;
333
                    break;
318
- 

Return to bug 11300