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

(-)a/misc/migration_tools/bulkmarcimport.pl (-262 / +303 lines)
Lines 2-7 Link Here
2
# Import an iso2709 file into Koha 3
2
# Import an iso2709 file into Koha 3
3
3
4
use Modern::Perl;
4
use Modern::Perl;
5
5
#use diagnostics;
6
#use diagnostics;
6
7
7
# Koha modules used
8
# Koha modules used
Lines 21-28 use C4::Biblio qw( Link Here
21
    BiblioAutoLink
22
    BiblioAutoLink
22
);
23
);
23
use C4::Koha;
24
use C4::Koha;
24
use C4::Charset qw( MarcToUTF8Record SetUTF8Flag );
25
use C4::Charset                   qw( MarcToUTF8Record SetUTF8Flag );
25
use C4::Items qw( AddItemBatchFromMarc );
26
use C4::Items                     qw( AddItemBatchFromMarc );
26
use C4::MarcModificationTemplates qw(
27
use C4::MarcModificationTemplates qw(
27
    GetModificationTemplates
28
    GetModificationTemplates
28
    ModifyRecordWithTemplate
29
    ModifyRecordWithTemplate
Lines 30-40 use C4::MarcModificationTemplates qw( Link Here
30
use C4::AuthoritiesMarc qw( GuessAuthTypeCode GuessAuthId GetAuthority ModAuthority AddAuthority );
31
use C4::AuthoritiesMarc qw( GuessAuthTypeCode GuessAuthId GetAuthority ModAuthority AddAuthority );
31
32
32
use YAML::XS;
33
use YAML::XS;
33
use Time::HiRes qw( gettimeofday );
34
use Time::HiRes  qw( gettimeofday );
34
use Getopt::Long qw( GetOptions );
35
use Getopt::Long qw( GetOptions );
35
use IO::File;
36
use IO::File;
36
use Pod::Usage qw( pod2usage );
37
use Pod::Usage qw( pod2usage );
37
use FindBin ();
38
use FindBin    ();
38
39
39
use Koha::Logger;
40
use Koha::Logger;
40
use Koha::Biblios;
41
use Koha::Biblios;
Lines 42-49 use Koha::SearchEngine; Link Here
42
use Koha::SearchEngine::Search;
43
use Koha::SearchEngine::Search;
43
44
44
use open qw( :std :encoding(UTF-8) );
45
use open qw( :std :encoding(UTF-8) );
45
binmode(STDOUT, ":encoding(UTF-8)");
46
binmode( STDOUT, ":encoding(UTF-8)" );
46
my ($input_marc_file, $number, $offset, $cleanisbn) = ('', 0, 0, 1);
47
my ( $input_marc_file, $number, $offset, $cleanisbn ) = ( '', 0, 0, 1 );
47
my $version;
48
my $version;
48
my $delete;
49
my $delete;
49
my $test_parameter;
50
my $test_parameter;
Lines 72-114 my $idmapfl; Link Here
72
my $dedup_barcode;
73
my $dedup_barcode;
73
my $framework = '';
74
my $framework = '';
74
my $localcust;
75
my $localcust;
75
my $marc_mod_template = '';
76
my $marc_mod_template    = '';
76
my $marc_mod_template_id = -1;
77
my $marc_mod_template_id = -1;
77
$| = 1;
78
$| = 1;
78
79
79
GetOptions(
80
GetOptions(
80
    'commit:f' => \$commit,
81
    'commit:f'          => \$commit,
81
    'file:s' => \$input_marc_file,
82
    'file:s'            => \$input_marc_file,
82
    'n:f' => \$number,
83
    'n:f'               => \$number,
83
    'o|offset:f' => \$offset,
84
    'o|offset:f'        => \$offset,
84
    'h' => \$version,
85
    'h'                 => \$version,
85
    'd' => \$delete,
86
    'd'                 => \$delete,
86
    't|test' => \$test_parameter,
87
    't|test'            => \$test_parameter,
87
    's' => \$skip_marc8_conversion,
88
    's'                 => \$skip_marc8_conversion,
88
    'c:s' => \$char_encoding,
89
    'c:s'               => \$char_encoding,
89
    'v:+' => \$verbose,
90
    'v:+'               => \$verbose,
90
    'fk' => \$fk_off,
91
    'fk'                => \$fk_off,
91
    'm:s' => \$format,
92
    'm:s'               => \$format,
92
    'l:s' => \$logfile,
93
    'l:s'               => \$logfile,
93
    'append' => \$append,
94
    'append'            => \$append,
94
    'k|keepids:s' => \$keepids,
95
    'k|keepids:s'       => \$keepids,
95
    'b|biblios' => \$biblios,
96
    'b|biblios'         => \$biblios,
96
    'a|authorities' => \$authorities,
97
    'a|authorities'     => \$authorities,
97
    'authtypes:s' => \$authtypes,
98
    'authtypes:s'       => \$authtypes,
98
    'filter=s@' => \$filters,
99
    'filter=s@'         => \$filters,
99
    'insert' => \$insert,
100
    'insert'            => \$insert,
100
    'update' => \$update,
101
    'update'            => \$update,
101
    'all' => \$all,
102
    'all'               => \$all,
102
    'match=s@' => \$match,
103
    'match=s@'          => \$match,
103
    'i|isbn' => \$isbn_check,
104
    'i|isbn'            => \$isbn_check,
104
    'x:s' => \$sourcetag,
105
    'x:s'               => \$sourcetag,
105
    'y:s' => \$sourcesubfield,
106
    'y:s'               => \$sourcesubfield,
106
    'idmap:s' => \$idmapfl,
107
    'idmap:s'           => \$idmapfl,
107
    'cleanisbn!' => \$cleanisbn,
108
    'cleanisbn!'        => \$cleanisbn,
108
    'yaml:s' => \$yamlfile,
109
    'yaml:s'            => \$yamlfile,
109
    'dedupbarcode' => \$dedup_barcode,
110
    'dedupbarcode'      => \$dedup_barcode,
110
    'framework=s' => \$framework,
111
    'framework=s'       => \$framework,
111
    'custom:s' => \$localcust,
112
    'custom:s'          => \$localcust,
112
    'marcmodtemplate:s' => \$marc_mod_template,
113
    'marcmodtemplate:s' => \$marc_mod_template,
113
);
114
);
114
115
Lines 116-136 $biblios ||= !$authorities; Link Here
116
$insert  ||= !$update;
117
$insert  ||= !$update;
117
my $writemode = ($append) ? "a" : "w";
118
my $writemode = ($append) ? "a" : "w";
118
119
119
pod2usage( -msg => "\nYou must specify either --biblios or --authorities, not both.\n", -exitval ) if $biblios && $authorities;
120
pod2usage( -msg => "\nYou must specify either --biblios or --authorities, not both.\n", -exitval )
121
    if $biblios && $authorities;
120
122
121
if ($all) {
123
if ($all) {
122
    $insert = 1;
124
    $insert = 1;
123
    $update = 1;
125
    $update = 1;
124
}
126
}
125
127
126
my $using_elastic_search = (C4::Context->preference('SearchEngine') eq 'Elasticsearch');
128
my $using_elastic_search = ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' );
127
my $mod_biblio_options = {
129
my $mod_biblio_options   = {
128
    disable_autolink => $using_elastic_search,
130
    disable_autolink  => $using_elastic_search,
129
    skip_record_index => $using_elastic_search,
131
    skip_record_index => $using_elastic_search,
130
    overlay_context => { source => 'bulkmarcimport' }
132
    overlay_context   => { source => 'bulkmarcimport' }
131
};
133
};
132
my $add_biblio_options = {
134
my $add_biblio_options = {
133
    disable_autolink => $using_elastic_search,
135
    disable_autolink  => $using_elastic_search,
134
    skip_record_index => $using_elastic_search
136
    skip_record_index => $using_elastic_search
135
};
137
};
136
138
Lines 140-209 my $indexer; Link Here
140
if ($using_elastic_search) {
142
if ($using_elastic_search) {
141
    use Koha::SearchEngine::Elasticsearch::Indexer;
143
    use Koha::SearchEngine::Elasticsearch::Indexer;
142
    $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
144
    $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
143
        { index => $authorities ?
145
        {
144
            $Koha::SearchEngine::Elasticsearch::AUTHORITIES_INDEX :
146
            index => $authorities
145
            $Koha::SearchEngine::Elasticsearch::BIBLIOS_INDEX
147
            ? $Koha::SearchEngine::Elasticsearch::AUTHORITIES_INDEX
148
            : $Koha::SearchEngine::Elasticsearch::BIBLIOS_INDEX
146
        }
149
        }
147
    );
150
    );
148
}
151
}
149
152
150
if ($version || ($input_marc_file eq '')) {
153
if ( $version || ( $input_marc_file eq '' ) ) {
151
    pod2usage( -verbose => 2 );
154
    pod2usage( -verbose => 2 );
152
    exit;
155
    exit;
153
}
156
}
154
if( $update && !( $match || $isbn_check ) ) {
157
if ( $update && !( $match || $isbn_check ) ) {
155
    warn "Using -update without -match or -isbn seems to be useless.\n";
158
    warn "Using -update without -match or -isbn seems to be useless.\n";
156
}
159
}
157
160
158
if (defined $localcust) { #local customize module
161
if ( defined $localcust ) {    #local customize module
159
    if (!-e $localcust) {
162
    if ( !-e $localcust ) {
160
        $localcust = $localcust || 'LocalChanges'; #default name
163
        $localcust = $localcust || 'LocalChanges';        #default name
161
        $localcust =~ s/^.*\/([^\/]+)$/$1/; #extract file name only
164
        $localcust =~ s/^.*\/([^\/]+)$/$1/;               #extract file name only
162
        $localcust =~ s/\.pm$//;           #remove extension
165
        $localcust =~ s/\.pm$//;                          #remove extension
163
        my $fqcust = $FindBin::Bin . "/$localcust.pm"; #try migration_tools dir
166
        my $fqcust = $FindBin::Bin . "/$localcust.pm";    #try migration_tools dir
164
        if (-e $fqcust) {
167
        if ( -e $fqcust ) {
165
            $localcust= $fqcust;
168
            $localcust = $fqcust;
166
        }
169
        } else {
167
        else {
168
            print "WARNING: customize module $localcust.pm not found!\n";
170
            print "WARNING: customize module $localcust.pm not found!\n";
169
            exit 1;
171
            exit 1;
170
        }
172
        }
171
    }
173
    }
172
    require $localcust if $localcust;
174
    require $localcust       if $localcust;
173
    $localcust = \&customize if $localcust;
175
    $localcust = \&customize if $localcust;
174
}
176
}
175
177
176
if($marc_mod_template ne '') {
178
if ( $marc_mod_template ne '' ) {
177
    my @templates = GetModificationTemplates();
179
    my @templates = GetModificationTemplates();
178
    foreach my $this_template (@templates) {
180
    foreach my $this_template (@templates) {
179
        if($this_template->{'name'} eq $marc_mod_template) {
181
        if ( $this_template->{'name'} eq $marc_mod_template ) {
180
            if($marc_mod_template_id < 0) {
182
            if ( $marc_mod_template_id < 0 ) {
181
                $marc_mod_template_id = $this_template->{'template_id'};
183
                $marc_mod_template_id = $this_template->{'template_id'};
182
            } else {
184
            } else {
183
                print "WARNING: MARC modification template name " .
185
                print "WARNING: MARC modification template name "
184
                "'$marc_mod_template' matches multiple templates. " .
186
                    . "'$marc_mod_template' matches multiple templates. "
185
                "Please rename these templates\n";
187
                    . "Please rename these templates\n";
186
                exit 1;
188
                exit 1;
187
            }
189
            }
188
        }
190
        }
189
    }
191
    }
190
    if($marc_mod_template_id < 0) {
192
    if ( $marc_mod_template_id < 0 ) {
191
        die "Can't located MARC modification template '$marc_mod_template'\n";
193
        die "Can't located MARC modification template '$marc_mod_template'\n";
192
    } else {
194
    } else {
193
        print "Records will be modified using MARC modification template: $marc_mod_template\n" if $verbose;
195
        print "Records will be modified using MARC modification template: $marc_mod_template\n" if $verbose;
194
    }
196
    }
195
}
197
}
196
198
197
my $dbh = C4::Context->dbh;
199
my $dbh            = C4::Context->dbh;
198
my $heading_fields = get_heading_fields();
200
my $heading_fields = get_heading_fields();
199
my $idmapfh;
201
my $idmapfh;
200
202
201
if (defined $idmapfl) {
203
if ( defined $idmapfl ) {
202
  open($idmapfh, '>', $idmapfl) or die "cannot open $idmapfl \n";
204
    open( $idmapfh, '>', $idmapfl ) or die "cannot open $idmapfl \n";
203
}
205
}
204
206
205
if ((not defined $sourcesubfield) && (not defined $sourcetag)) {
207
if ( ( not defined $sourcesubfield ) && ( not defined $sourcetag ) ) {
206
    $sourcetag = "910";
208
    $sourcetag      = "910";
207
    $sourcesubfield = "a";
209
    $sourcesubfield = "a";
208
}
210
}
209
211
Lines 225-232 if ($delete) { Link Here
225
        $dbh->do("ALTER TABLE biblioitems AUTO_INCREMENT = 1");
227
        $dbh->do("ALTER TABLE biblioitems AUTO_INCREMENT = 1");
226
        $dbh->do("DELETE FROM items");
228
        $dbh->do("DELETE FROM items");
227
        $dbh->do("ALTER TABLE items AUTO_INCREMENT = 1");
229
        $dbh->do("ALTER TABLE items AUTO_INCREMENT = 1");
228
    }
230
    } else {
229
    else {
230
        print "Deleting authorities\n";
231
        print "Deleting authorities\n";
231
        $dbh->do("truncate auth_header");
232
        $dbh->do("truncate auth_header");
232
    }
233
    }
Lines 244-250 my $marc_flavour = C4::Context->preference('marcflavour') || 'MARC21'; Link Here
244
my $searcher = Koha::SearchEngine::Search->new(
245
my $searcher = Koha::SearchEngine::Search->new(
245
    {
246
    {
246
        index => (
247
        index => (
247
            $authorities
248
              $authorities
248
            ? $Koha::SearchEngine::AUTHORITIES_INDEX
249
            ? $Koha::SearchEngine::AUTHORITIES_INDEX
249
            : $Koha::SearchEngine::BIBLIOS_INDEX
250
            : $Koha::SearchEngine::BIBLIOS_INDEX
250
        )
251
        )
Lines 254-261 my $searcher = Koha::SearchEngine::Search->new( Link Here
254
print "Characteristic MARC flavour: $marc_flavour\n" if $verbose;
255
print "Characteristic MARC flavour: $marc_flavour\n" if $verbose;
255
my $starttime = gettimeofday;
256
my $starttime = gettimeofday;
256
257
257
my $fh = IO::File->new($input_marc_file); # don't let MARC::Batch open the file, as it applies the ':utf8' IO layer
258
my $fh = IO::File->new($input_marc_file);    # don't let MARC::Batch open the file, as it applies the ':utf8' IO layer
258
if (defined $format && $format =~ /XML/i) {
259
if ( defined $format && $format =~ /XML/i ) {
260
259
    # ugly hack follows -- MARC::File::XML, when used by MARC::Batch,
261
    # ugly hack follows -- MARC::File::XML, when used by MARC::Batch,
260
    # appears to try to convert incoming XML records from MARC-8
262
    # appears to try to convert incoming XML records from MARC-8
261
    # to UTF-8.  Setting the BinaryEncoding key turns that off
263
    # to UTF-8.  Setting the BinaryEncoding key turns that off
Lines 266-279 if (defined $format && $format =~ /XML/i) { Link Here
266
    #       extract the records, not using regexes to look
268
    #       extract the records, not using regexes to look
267
    #       for <record>.*</record>.
269
    #       for <record>.*</record>.
268
    $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8';
270
    $MARC::File::XML::_load_args{BinaryEncoding} = 'utf-8';
269
    my $recordformat = ($marc_flavour eq "MARC21" ? "USMARC" : uc($marc_flavour));
271
    my $recordformat = ( $marc_flavour eq "MARC21" ? "USMARC" : uc($marc_flavour) );
272
270
    #UNIMARC Authorities have a different way to manage encoding than UNIMARC biblios.
273
    #UNIMARC Authorities have a different way to manage encoding than UNIMARC biblios.
271
    $recordformat = $recordformat . "AUTH" if ($authorities and $marc_flavour ne "MARC21");
274
    $recordformat = $recordformat . "AUTH" if ( $authorities and $marc_flavour ne "MARC21" );
272
    $MARC::File::XML::_load_args{RecordFormat} = $recordformat;
275
    $MARC::File::XML::_load_args{RecordFormat} = $recordformat;
273
    $batch = MARC::Batch->new('XML', $fh);
276
    $batch = MARC::Batch->new( 'XML', $fh );
274
}
277
} else {
275
else {
278
    $batch = MARC::Batch->new( 'USMARC', $fh );
276
    $batch = MARC::Batch->new('USMARC', $fh);
277
}
279
}
278
280
279
$batch->warnings_off();
281
$batch->warnings_off();
Lines 284-302 my $yamlhash; Link Here
284
# Skip file offset
286
# Skip file offset
285
if ($offset) {
287
if ($offset) {
286
    print "Skipping file offset: $offset records\n";
288
    print "Skipping file offset: $offset records\n";
287
    $batch->next() while ($offset--);
289
    $batch->next() while ( $offset-- );
288
}
290
}
289
291
290
my ($tagid, $subfieldid);
292
my ( $tagid, $subfieldid );
291
if ($authorities) {
293
if ($authorities) {
292
    $tagid = '001';
294
    $tagid = '001';
293
}
295
} else {
294
else {
296
    ( $tagid, $subfieldid ) = GetMarcFromKohaField("biblio.biblionumber");
295
    ($tagid, $subfieldid) = GetMarcFromKohaField("biblio.biblionumber");
296
    $tagid ||= "001";
297
    $tagid ||= "001";
297
}
298
}
298
299
299
my $sth_isbn;
300
my $sth_isbn;
301
300
# the SQL query to search on isbn
302
# the SQL query to search on isbn
301
if ($isbn_check) {
303
if ($isbn_check) {
302
    $sth_isbn = $dbh->prepare("SELECT biblionumber, biblioitemnumber FROM biblioitems WHERE isbn=?");
304
    $sth_isbn = $dbh->prepare("SELECT biblionumber, biblioitemnumber FROM biblioitems WHERE isbn=?");
Lines 304-324 if ($isbn_check) { Link Here
304
306
305
my $loghandle;
307
my $loghandle;
306
if ($logfile) {
308
if ($logfile) {
307
    $loghandle= IO::File->new($logfile, $writemode);
309
    $loghandle = IO::File->new( $logfile, $writemode );
308
    print $loghandle "id;operation;status\n";
310
    print $loghandle "id;operation;status\n";
309
}
311
}
310
312
311
my $record_number = 0;
313
my $record_number = 0;
312
my $logger = Koha::Logger->get;
314
my $logger        = Koha::Logger->get;
313
my $schema = Koha::Database->schema;
315
my $schema        = Koha::Database->schema;
314
my $marc_records = [];
316
my $marc_records  = [];
315
RECORD: while (  ) {
317
RECORD: while () {
316
    my $record;
318
    my $record;
317
    $record_number++;
319
    $record_number++;
320
318
    # get record
321
    # get record
319
    eval { $record = $batch->next() };
322
    eval { $record = $batch->next() };
320
    if ($@) {
323
    if ($@) {
321
        print "Bad MARC record $record_number: $@ skipped\n";
324
        print "Bad MARC record $record_number: $@ skipped\n";
325
322
        # FIXME - because MARC::Batch->next() combines grabbing the next
326
        # FIXME - because MARC::Batch->next() combines grabbing the next
323
        # blob and parsing it into one operation, a correctable condition
327
        # blob and parsing it into one operation, a correctable condition
324
        # such as a MARC-8 record claiming that it's UTF-8 can't be recovered
328
        # such as a MARC-8 record claiming that it's UTF-8 can't be recovered
Lines 328-338 RECORD: while ( ) { Link Here
328
        next;
332
        next;
329
    }
333
    }
330
    if ($record) {
334
    if ($record) {
335
331
        # transcode the record to UTF8 if needed & applicable.
336
        # transcode the record to UTF8 if needed & applicable.
332
        if ($record->encoding() eq 'MARC-8' and not $skip_marc8_conversion) {
337
        if ( $record->encoding() eq 'MARC-8' and not $skip_marc8_conversion ) {
333
            my ($guessed_charset, $charset_errors);
338
            my ( $guessed_charset, $charset_errors );
334
            ($record, $guessed_charset, $charset_errors) = MarcToUTF8Record($record, $marc_flavour . (($authorities and $marc_flavour ne "MARC21") ? 'AUTH' : ''));
339
            ( $record, $guessed_charset, $charset_errors ) = MarcToUTF8Record(
335
            if ($guessed_charset eq 'failed') {
340
                $record,
341
                $marc_flavour . ( ( $authorities and $marc_flavour ne "MARC21" ) ? 'AUTH' : '' )
342
            );
343
            if ( $guessed_charset eq 'failed' ) {
336
                warn "ERROR: failed to perform character conversion for record $record_number\n";
344
                warn "ERROR: failed to perform character conversion for record $record_number\n";
337
                next RECORD;
345
                next RECORD;
338
            }
346
            }
Lines 340-347 RECORD: while ( ) { Link Here
340
        SetUTF8Flag($record);
348
        SetUTF8Flag($record);
341
        &$localcust($record) if $localcust;
349
        &$localcust($record) if $localcust;
342
        push @{$marc_records}, $record;
350
        push @{$marc_records}, $record;
343
    }
351
    } else {
344
    else {
345
        last;
352
        last;
346
    }
353
    }
347
}
354
}
Lines 349-403 RECORD: while ( ) { Link Here
349
$record_number = 0;
356
$record_number = 0;
350
my $records_total = @{$marc_records};
357
my $records_total = @{$marc_records};
351
$schema->txn_begin;
358
$schema->txn_begin;
352
RECORD: foreach my $record (@{$marc_records}) {
359
RECORD: foreach my $record ( @{$marc_records} ) {
353
    $record_number++;
360
    $record_number++;
354
    if (($verbose//1) == 1) { #no dot for verbose==2
361
    if ( ( $verbose // 1 ) == 1 ) {    #no dot for verbose==2
355
        print "." . ($record_number % 100 == 0 ? "\n$record_number" : '');
362
        print "." . ( $record_number % 100 == 0 ? "\n$record_number" : '' );
356
    }
363
    }
357
364
358
    if ($marc_mod_template_id > 0) {
365
    if ( $marc_mod_template_id > 0 ) {
359
        print "Modifying MARC\n" if $verbose;
366
        print "Modifying MARC\n" if $verbose;
360
        ModifyRecordWithTemplate( $marc_mod_template_id, $record );
367
        ModifyRecordWithTemplate( $marc_mod_template_id, $record );
361
    }
368
    }
362
369
363
    my $isbn;
370
    my $isbn;
371
364
    # remove trailing - in isbn (only for biblios, of course)
372
    # remove trailing - in isbn (only for biblios, of course)
365
    if ($biblios && ($cleanisbn || $isbn_check)) {
373
    if ( $biblios && ( $cleanisbn || $isbn_check ) ) {
366
        my $tag = $marc_flavour eq 'UNIMARC' ? '010' : '020';
374
        my $tag   = $marc_flavour eq 'UNIMARC' ? '010' : '020';
367
        my $field = $record->field($tag);
375
        my $field = $record->field($tag);
368
        $isbn = $field && $field->subfield('a');
376
        $isbn = $field && $field->subfield('a');
369
        if ($isbn && $cleanisbn) {
377
        if ( $isbn && $cleanisbn ) {
370
            $isbn =~ s/-//g;
378
            $isbn =~ s/-//g;
371
            $field->update('a' => $isbn);
379
            $field->update( 'a' => $isbn );
372
        }
380
        }
373
    }
381
    }
382
374
    # search for duplicates (based on Local-number)
383
    # search for duplicates (based on Local-number)
375
    my $originalid = GetRecordId($record, $tagid, $subfieldid);
384
    my $originalid        = GetRecordId( $record, $tagid, $subfieldid );
376
    my $matched_record_id = undef;
385
    my $matched_record_id = undef;
377
    if ($match) {
386
    if ($match) {
378
        require C4::Search;
387
        require C4::Search;
379
        my $server = ($authorities ? 'authorityserver' : 'biblioserver');
388
        my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
380
        my $query = build_query($match, $record);
389
        my $query  = build_query( $match, $record );
381
        $logger->debug("Bulkmarcimport: $query");
390
        $logger->debug("Bulkmarcimport: $query");
382
        my ($error, $results, $totalhits) = $searcher->simple_search_compat($query, 0, 3, [$server]);
391
        my ( $error, $results, $totalhits ) = $searcher->simple_search_compat( $query, 0, 3, [$server] );
392
383
        # changed to warn so able to continue with one broken record
393
        # changed to warn so able to continue with one broken record
384
        if (defined $error) {
394
        if ( defined $error ) {
385
            warn "unable to search the database for duplicates : $error";
395
            warn "unable to search the database for duplicates : $error";
386
            printlog({ id => $originalid , op => "match", status => "ERROR" }) if ($logfile);
396
            printlog( { id => $originalid, op => "match", status => "ERROR" } ) if ($logfile);
387
            next RECORD;
397
            next RECORD;
388
        }
398
        }
389
        $logger->debug("Bulkmarcimport: $query $server : $totalhits");
399
        $logger->debug("Bulkmarcimport: $query $server : $totalhits");
400
390
        # sub SimpleSearch could return undefined, but only on error, so
401
        # sub SimpleSearch could return undefined, but only on error, so
391
        # should not really need to safeguard here, but do so anyway
402
        # should not really need to safeguard here, but do so anyway
392
        $results //= [];
403
        $results //= [];
393
        if (@{$results} == 1) {
404
        if ( @{$results} == 1 ) {
394
            my $matched_record = C4::Search::new_record_from_zebra($server, $results->[0]);
405
            my $matched_record = C4::Search::new_record_from_zebra( $server, $results->[0] );
395
            SetUTF8Flag($matched_record);
406
            SetUTF8Flag($matched_record);
396
            $matched_record_id = GetRecordId($matched_record, $tagid, $subfieldid);
407
            $matched_record_id = GetRecordId( $matched_record, $tagid, $subfieldid );
408
409
            if ( $authorities && $marc_flavour ) {
397
410
398
            if ($authorities && $marc_flavour) {
399
                #Skip if authority in database is the same or newer than the incoming record
411
                #Skip if authority in database is the same or newer than the incoming record
400
                if (RecordRevisionIsGtOrEq($matched_record, $record)) {
412
                if ( RecordRevisionIsGtOrEq( $matched_record, $record ) ) {
401
                    if ($yamlfile) {
413
                    if ($yamlfile) {
402
                        $yamlhash->{$originalid} = YAMLFileEntry(
414
                        $yamlhash->{$originalid} = YAMLFileEntry(
403
                            $matched_record,
415
                            $matched_record,
Lines 408-664 RECORD: foreach my $record (@{$marc_records}) { Link Here
408
                    next;
420
                    next;
409
                }
421
                }
410
            }
422
            }
411
        }
423
        } elsif ( @{$results} > 1 ) {
412
        elsif(@{$results} > 1) {
413
            $logger->debug("More than one match for: $query");
424
            $logger->debug("More than one match for: $query");
414
        }
425
        } else {
415
        else {
416
            $logger->debug("No match for: $query");
426
            $logger->debug("No match for: $query");
417
        }
427
        }
418
428
419
        if ($keepids && $originalid) {
429
        if ( $keepids && $originalid ) {
420
            my $storeidfield;
430
            my $storeidfield;
421
            if (length($keepids) == 3) {
431
            if ( length($keepids) == 3 ) {
422
                $storeidfield = MARC::Field->new($keepids, $originalid);
432
                $storeidfield = MARC::Field->new( $keepids, $originalid );
423
            } else {
433
            } else {
424
                $storeidfield = MARC::Field->new(substr($keepids, 0, 3), "", "", substr($keepids, 3, 1), $originalid);
434
                $storeidfield =
435
                    MARC::Field->new( substr( $keepids, 0, 3 ), "", "", substr( $keepids, 3, 1 ), $originalid );
425
            }
436
            }
426
            $record->insert_fields_ordered($storeidfield);
437
            $record->insert_fields_ordered($storeidfield);
427
            $record->delete_field($record->field($tagid));
438
            $record->delete_field( $record->field($tagid) );
428
        }
439
        }
429
    }
440
    }
430
441
431
    foreach my $stringfilter (@$filters) {
442
    foreach my $stringfilter (@$filters) {
432
        if (length($stringfilter) == 3) {
443
        if ( length($stringfilter) == 3 ) {
433
            foreach my $field ($record->field($stringfilter)) {
444
            foreach my $field ( $record->field($stringfilter) ) {
434
                $record->delete_field($field);
445
                $record->delete_field($field);
435
                $logger->debug("Removed: ", $field->as_string);
446
                $logger->debug( "Removed: ", $field->as_string );
436
            }
447
            }
437
        } elsif ($stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/) {
448
        } elsif ( $stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/ ) {
438
            my $removetag = $1;
449
            my $removetag      = $1;
439
            my $removesubfield = $2;
450
            my $removesubfield = $2;
440
            my $removematch = $3;
451
            my $removematch    = $3;
441
            if (($removetag > "010") && $removesubfield) {
452
            if ( ( $removetag > "010" ) && $removesubfield ) {
442
                foreach my $field ($record->field($removetag)) {
453
                foreach my $field ( $record->field($removetag) ) {
443
                    $field->delete_subfield(code => "$removesubfield", match => $removematch);
454
                    $field->delete_subfield( code => "$removesubfield", match => $removematch );
444
                    $logger->debug("Potentially removed: ", $field->subfield($removesubfield));
455
                    $logger->debug( "Potentially removed: ", $field->subfield($removesubfield) );
445
                }
456
                }
446
            }
457
            }
447
        }
458
        }
448
    }
459
    }
449
    unless ($test_parameter) {
460
    unless ($test_parameter) {
450
        if ($authorities) {
461
        if ($authorities) {
451
            my $authtypecode = GuessAuthTypeCode($record, $heading_fields);
462
            my $authtypecode = GuessAuthTypeCode( $record, $heading_fields );
452
            my $authid;
463
            my $authid;
453
464
454
            if ($matched_record_id) {
465
            if ($matched_record_id) {
455
                if ($update) {
466
                if ($update) {
456
                    ## Authority has an id and is in database: update
467
                    ## Authority has an id and is in database: update
457
                    eval { ($authid) = ModAuthority($matched_record_id, $record, $authtypecode) };
468
                    eval { ($authid) = ModAuthority( $matched_record_id, $record, $authtypecode ) };
458
                    if ($@) {
469
                    if ($@) {
459
                        warn "ERROR: Update authority $matched_record_id failed: $@\n";
470
                        warn "ERROR: Update authority $matched_record_id failed: $@\n";
460
                        printlog({ id => $matched_record_id, op => "update", status => "ERROR" }) if ($logfile);
471
                        printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile);
461
                    }
472
                    } else {
462
                    else {
473
                        printlog( { id => $authid, op => "update", status => "ok" } ) if ($logfile);
463
                        printlog({ id => $authid, op => "update", status => "ok" }) if ($logfile);
464
                    }
474
                    }
465
                }
475
                } elsif ($logfile) {
466
                elsif ($logfile) {
467
                    warn "WARNING: Update authority $originalid skipped";
476
                    warn "WARNING: Update authority $originalid skipped";
468
                    printlog({
477
                    printlog(
469
                        id => $matched_record_id,
478
                        {
470
                        op => "update",
479
                            id     => $matched_record_id,
471
                        status => "warning: authority already in database and option -update not enabled, skipping..."
480
                            op     => "update",
472
                    });
481
                            status =>
482
                                "warning: authority already in database and option -update not enabled, skipping..."
483
                        }
484
                    );
473
                }
485
                }
474
            }
486
            } elsif ($insert) {
475
            elsif ($insert) {
476
                ## An authid is defined but no authority in database: insert
487
                ## An authid is defined but no authority in database: insert
477
                eval { ($authid) = AddAuthority($record, undef, $authtypecode) };
488
                eval { ($authid) = AddAuthority( $record, undef, $authtypecode ) };
478
                if ($@) {
489
                if ($@) {
479
                    warn "ERROR: Insert authority $originalid failed: $@\n";
490
                    warn "ERROR: Insert authority $originalid failed: $@\n";
480
                    printlog({ id => $originalid, op => "insert", status => "ERROR" }) if ($logfile);
491
                    printlog( { id => $originalid, op => "insert", status => "ERROR" } ) if ($logfile);
481
                }
492
                } else {
482
                else {
493
                    printlog( { id => $authid, op => "insert", status => "ok" } ) if ($logfile);
483
                    printlog({ id => $authid, op => "insert", status => "ok" }) if ($logfile);
484
                }
494
                }
485
            }
495
            } else {
486
            else {
487
                warn "WARNING: Insert authority $originalid skipped";
496
                warn "WARNING: Insert authority $originalid skipped";
488
                printlog( { id => $originalid, op => "insert", status => "warning : biblio not in database and option -insert not enabled, skipping..." } ) if ($logfile);
497
                printlog(
498
                    {
499
                        id     => $originalid, op => "insert",
500
                        status => "warning : biblio not in database and option -insert not enabled, skipping..."
501
                    }
502
                ) if ($logfile);
489
            }
503
            }
490
504
491
            if ($yamlfile) {
505
            if ($yamlfile) {
492
                $yamlhash->{$originalid} = YAMLFileEntry(
506
                $yamlhash->{$originalid} = YAMLFileEntry(
493
                    $record,
507
                    $record,
494
                    $authid,
508
                    $authid,
495
                    1 #@FIXME: Really always updated?
509
                    1    #@FIXME: Really always updated?
496
                );
510
                );
497
            }
511
            }
498
        }
512
        } else {
499
        else {
513
            my ( $biblioitemnumber, $itemnumbers_ref, $errors_ref, $record_id );
500
            my ($biblioitemnumber, $itemnumbers_ref, $errors_ref, $record_id);
514
501
            # check for duplicate, based on ISBN (skip it if we already have found a duplicate with match parameter
515
            # check for duplicate, based on ISBN (skip it if we already have found a duplicate with match parameter
502
            if (!$matched_record_id && $isbn_check && $isbn) {
516
            if ( !$matched_record_id && $isbn_check && $isbn ) {
503
                $sth_isbn->execute($isbn);
517
                $sth_isbn->execute($isbn);
504
                ($matched_record_id, $biblioitemnumber) = $sth_isbn->fetchrow;
518
                ( $matched_record_id, $biblioitemnumber ) = $sth_isbn->fetchrow;
505
            }
519
            }
506
520
507
            if (defined $idmapfl && $matched_record_id) {
521
            if ( defined $idmapfl && $matched_record_id ) {
508
                if ($sourcetag < "010") {
522
                if ( $sourcetag < "010" ) {
509
                    if ($record->field($sourcetag)) {
523
                    if ( $record->field($sourcetag) ) {
510
                        my $source = $record->field($sourcetag)->data();
524
                        my $source = $record->field($sourcetag)->data();
511
                        printf($idmapfh "%s|%s\n", $source, $matched_record_id);
525
                        printf( $idmapfh "%s|%s\n", $source, $matched_record_id );
512
                    }
526
                    }
513
                }
527
                } else {
514
                else {
528
                    my $source = $record->subfield( $sourcetag, $sourcesubfield );
515
                    my $source = $record->subfield($sourcetag, $sourcesubfield);
529
                    printf( $idmapfh "%s|%s\n", $source, $matched_record_id );
516
                    printf($idmapfh "%s|%s\n", $source, $matched_record_id);
517
                }
530
                }
518
            }
531
            }
519
532
520
            # Create biblio, unless we already have it (either match or ISBN)
533
            # Create biblio, unless we already have it (either match or ISBN)
521
            if ($matched_record_id) {
534
            if ($matched_record_id) {
522
                eval{
535
                eval { $biblioitemnumber = Koha::Biblios->find($matched_record_id)->biblioitem->biblioitemnumber; };
523
                    $biblioitemnumber = Koha::Biblios->find( $matched_record_id )->biblioitem->biblioitemnumber;
524
                };
525
                if ($update) {
536
                if ($update) {
526
                    my $success;
537
                    my $success;
527
                    eval { $success = ModBiblio($record, $matched_record_id, GetFrameworkCode($matched_record_id), $mod_biblio_options) };
538
                    eval {
539
                        $success = ModBiblio(
540
                            $record, $matched_record_id, GetFrameworkCode($matched_record_id),
541
                            $mod_biblio_options
542
                        );
543
                    };
528
                    if ($@) {
544
                    if ($@) {
529
                        warn "ERROR: Update biblio $matched_record_id failed: $@\n";
545
                        warn "ERROR: Update biblio $matched_record_id failed: $@\n";
530
                        printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile);
546
                        printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile);
531
                        next RECORD;
547
                        next RECORD;
532
                    }
548
                    } elsif ( !$success ) {
533
                    elsif (!$success) {
534
                        warn "ERROR: Update biblio $matched_record_id failed for unknown reason";
549
                        warn "ERROR: Update biblio $matched_record_id failed for unknown reason";
535
                        printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile);
550
                        printlog( { id => $matched_record_id, op => "update", status => "ERROR" } ) if ($logfile);
536
                        next RECORD;
551
                        next RECORD;
537
                    }
552
                    } else {
538
                    else {
539
                        $record_id = $matched_record_id;
553
                        $record_id = $matched_record_id;
540
                        printlog( { id => $record_id, op => "update", status => "ok" } ) if ($logfile);
554
                        printlog( { id => $record_id, op => "update", status => "ok" } ) if ($logfile);
541
                    }
555
                    }
542
                }
556
                } else {
543
                else {
544
                    warn "WARNING: Update biblio $originalid skipped";
557
                    warn "WARNING: Update biblio $originalid skipped";
545
                    printlog( { id => $matched_record_id, op => "update", status => "warning : already in database and option -update not enabled, skipping..." } ) if ($logfile);
558
                    printlog(
559
                        {
560
                            id     => $matched_record_id, op => "update",
561
                            status => "warning : already in database and option -update not enabled, skipping..."
562
                        }
563
                    ) if ($logfile);
546
                }
564
                }
547
            }
565
            } elsif ($insert) {
548
            elsif ($insert) {
549
                my $record_clone = $record->clone();
566
                my $record_clone = $record->clone();
550
                C4::Biblio::_strip_item_fields($record_clone);
567
                C4::Biblio::_strip_item_fields($record_clone);
551
                eval { ($record_id, $biblioitemnumber) = AddBiblio($record_clone, $framework, $add_biblio_options) };
568
                eval { ( $record_id, $biblioitemnumber ) = AddBiblio( $record_clone, $framework, $add_biblio_options ) };
552
                if ($@) {
569
                if ($@) {
553
                    warn "ERROR: Insert biblio $originalid failed: $@\n";
570
                    warn "ERROR: Insert biblio $originalid failed: $@\n";
554
                    printlog( { id => $originalid, op => "insert", status => "ERROR" } ) if ($logfile);
571
                    printlog( { id => $originalid, op => "insert", status => "ERROR" } ) if ($logfile);
555
                    next RECORD;
572
                    next RECORD;
556
                }
573
                } else {
557
                else {
558
                    printlog( { id => $originalid, op => "insert", status => "ok" } ) if ($logfile);
574
                    printlog( { id => $originalid, op => "insert", status => "ok" } ) if ($logfile);
559
                }
575
                }
576
560
                # If incoming record has bib ids set we need to transfer
577
                # If incoming record has bib ids set we need to transfer
561
                # new ids from record_clone to incoming record to avoid
578
                # new ids from record_clone to incoming record to avoid
562
                # working on wrong record (the original record) later on
579
                # working on wrong record (the original record) later on
563
                # when adding items for example
580
                # when adding items for example
564
                C4::Biblio::_koha_marc_update_bib_ids($record, $framework, $record_id, $biblioitemnumber);
581
                C4::Biblio::_koha_marc_update_bib_ids( $record, $framework, $record_id, $biblioitemnumber );
565
            }
582
            } else {
566
            else {
567
                warn "WARNING: Insert biblio $originalid skipped";
583
                warn "WARNING: Insert biblio $originalid skipped";
568
                printlog( { id => $originalid, op => "insert", status => "warning : biblio not in database and option -insert not enabled, skipping..." } ) if ($logfile);
584
                printlog(
585
                    {
586
                        id     => $originalid, op => "insert",
587
                        status => "warning : biblio not in database and option -insert not enabled, skipping..."
588
                    }
589
                ) if ($logfile);
569
                next RECORD;
590
                next RECORD;
570
            }
591
            }
571
            my $record_has_added_items = 0;
592
            my $record_has_added_items = 0;
572
            if ($record_id) {
593
            if ($record_id) {
573
                $yamlhash->{$originalid} = $record_id if $yamlfile;
594
                $yamlhash->{$originalid} = $record_id if $yamlfile;
574
                eval { ($itemnumbers_ref, $errors_ref) = AddItemBatchFromMarc($record, $record_id, $biblioitemnumber, $framework); };
595
                eval {
596
                    ( $itemnumbers_ref, $errors_ref ) =
597
                        AddItemBatchFromMarc( $record, $record_id, $biblioitemnumber, $framework );
598
                };
575
                my $error_adding = $@;
599
                my $error_adding = $@;
576
                $record_has_added_items = @{$itemnumbers_ref};
600
                $record_has_added_items = @{$itemnumbers_ref};
577
601
578
                if ($error_adding) {
602
                if ($error_adding) {
579
                    warn "ERROR: Adding items to bib $record_id failed: $error_adding";
603
                    warn "ERROR: Adding items to bib $record_id failed: $error_adding";
580
                    printlog({ id => $record_id, op => "insert items", status => "ERROR"}) if ($logfile);
604
                    printlog( { id => $record_id, op => "insert items", status => "ERROR" } ) if ($logfile);
605
581
                    # if we failed because of an exception, assume that
606
                    # if we failed because of an exception, assume that
582
                    # the MARC columns in biblioitems were not set.
607
                    # the MARC columns in biblioitems were not set.
583
                    next RECORD;
608
                    next RECORD;
584
                }
609
                }
585
                if ($dedup_barcode && grep { exists $_->{error_code} && $_->{error_code} eq 'duplicate_barcode' } @$errors_ref) {
610
                if ( $dedup_barcode && grep { exists $_->{error_code} && $_->{error_code} eq 'duplicate_barcode' }
611
                    @$errors_ref )
612
                {
586
                    # Find the record called 'barcode'
613
                    # Find the record called 'barcode'
587
                    my ($tag, $sub) = C4::Biblio::GetMarcFromKohaField('items.barcode');
614
                    my ( $tag, $sub ) = C4::Biblio::GetMarcFromKohaField('items.barcode');
615
588
                    # Now remove any items that didn't have a duplicate_barcode error,
616
                    # Now remove any items that didn't have a duplicate_barcode error,
589
                    # erase the barcodes on items that did, and re-add those items.
617
                    # erase the barcodes on items that did, and re-add those items.
590
                    my %dupes;
618
                    my %dupes;
591
                    foreach my $i (0 .. $#{$errors_ref}) {
619
                    foreach my $i ( 0 .. $#{$errors_ref} ) {
592
                        my $ref = $errors_ref->[$i];
620
                        my $ref = $errors_ref->[$i];
593
                        if ($ref && ($ref->{error_code} eq 'duplicate_barcode')) {
621
                        if ( $ref && ( $ref->{error_code} eq 'duplicate_barcode' ) ) {
594
                            $dupes{$ref->{item_sequence}} = 1;
622
                            $dupes{ $ref->{item_sequence} } = 1;
623
595
                            # Delete the error message because we're going to
624
                            # Delete the error message because we're going to
596
                            # retry this one.
625
                            # retry this one.
597
                            delete $errors_ref->[$i];
626
                            delete $errors_ref->[$i];
598
                        }
627
                        }
599
                    }
628
                    }
600
                    my $seq = 0;
629
                    my $seq = 0;
601
                    foreach my $field ($record->field($tag)) {
630
                    foreach my $field ( $record->field($tag) ) {
602
                        $seq++;
631
                        $seq++;
603
                        if ($dupes{$seq}) {
632
                        if ( $dupes{$seq} ) {
633
604
                            # Here we remove the barcode
634
                            # Here we remove the barcode
605
                            $field->delete_subfield(code => $sub);
635
                            $field->delete_subfield( code => $sub );
606
                        }
636
                        } else {
607
                        else {
637
608
                            # otherwise we delete the field because we don't want
638
                            # otherwise we delete the field because we don't want
609
                            # two of them
639
                            # two of them
610
                            $record->delete_fields($field);
640
                            $record->delete_fields($field);
611
                        }
641
                        }
612
                    }
642
                    }
643
613
                    # Now re-add the record as before, adding errors to the prev list
644
                    # Now re-add the record as before, adding errors to the prev list
614
                    my $more_errors;
645
                    my $more_errors;
615
                    eval { ($itemnumbers_ref, $more_errors) =
646
                    eval {
616
                        AddItemBatchFromMarc($record, $record_id, $biblioitemnumber, ''); };
647
                        ( $itemnumbers_ref, $more_errors ) =
648
                            AddItemBatchFromMarc( $record, $record_id, $biblioitemnumber, '' );
649
                    };
617
                    if ($@) {
650
                    if ($@) {
618
                        warn "ERROR: Adding items to bib $record_id failed: $@\n";
651
                        warn "ERROR: Adding items to bib $record_id failed: $@\n";
619
                        printlog({ id => $record_id, op => "insert items", status => "ERROR" }) if ($logfile);
652
                        printlog( { id => $record_id, op => "insert items", status => "ERROR" } ) if ($logfile);
653
620
                        # if we failed because of an exception, assume that
654
                        # if we failed because of an exception, assume that
621
                        # the MARC columns in biblioitems were not set.
655
                        # the MARC columns in biblioitems were not set.
622
                        next RECORD;
656
                        next RECORD;
623
                    }
657
                    }
624
                    $record_has_added_items ||= @{$itemnumbers_ref};
658
                    $record_has_added_items ||= @{$itemnumbers_ref};
625
                    if (@{$more_errors}) {
659
                    if ( @{$more_errors} ) {
626
                        push @$errors_ref, @{$more_errors};
660
                        push @$errors_ref, @{$more_errors};
627
                    }
661
                    }
628
                }
662
                }
629
663
630
                if ($record_has_added_items)  {
664
                if ($record_has_added_items) {
631
                    printlog({ id => $record_id, op => "insert items", status => "ok" }) if ($logfile);
665
                    printlog( { id => $record_id, op => "insert items", status => "ok" } ) if ($logfile);
632
                }
666
                }
633
667
634
                if (@{$errors_ref}) {
668
                if ( @{$errors_ref} ) {
635
                    report_item_errors($record_id, $errors_ref);
669
                    report_item_errors( $record_id, $errors_ref );
636
                }
670
                }
637
671
638
                my $biblio = Koha::Biblios->find($record_id);
672
                my $biblio = Koha::Biblios->find($record_id);
639
                $record = $biblio->metadata->record( { embed_items => 1 } );
673
                $record = $biblio->metadata->record( { embed_items => 1 } );
640
674
641
                push @search_engine_record_ids, $record_id;
675
                push @search_engine_record_ids, $record_id;
642
                push @search_engine_records, $record;
676
                push @search_engine_records,    $record;
643
            }
677
            }
644
        }
678
        }
645
        if ($record_number % $commitnum == 0 || $record_number == $number || $record_number == $records_total) {
679
        if ( $record_number % $commitnum == 0 || $record_number == $number || $record_number == $records_total ) {
646
            $schema->txn_commit;
680
            $schema->txn_commit;
647
            $schema->txn_begin;
681
            $schema->txn_begin;
648
            if ($indexer) {
682
            if ($indexer) {
649
                $indexer->update_index(\@search_engine_record_ids, \@search_engine_records);
683
                $indexer->update_index( \@search_engine_record_ids, \@search_engine_records );
650
                if (C4::Context->preference('AutoLinkBiblios')) {
684
                if ( C4::Context->preference('AutoLinkBiblios') ) {
651
                    foreach my $record (@search_engine_records) {
685
                    foreach my $record (@search_engine_records) {
652
                        BiblioAutoLink($record, $framework);
686
                        BiblioAutoLink( $record, $framework );
653
                    }
687
                    }
654
                }
688
                }
655
                @search_engine_record_ids = ();
689
                @search_engine_record_ids = ();
656
                @search_engine_records = ();
690
                @search_engine_records    = ();
657
            }
691
            }
658
        }
692
        }
659
    }
693
    }
660
    print $record->as_formatted() . "\n" if ($verbose//0) == 2;
694
    print $record->as_formatted() . "\n" if ( $verbose // 0 ) == 2;
661
    last if $record_number == $number;
695
    last                                 if $record_number == $number;
662
}
696
}
663
$schema->txn_commit;
697
$schema->txn_commit;
664
698
Lines 679-782 if ($logfile) { Link Here
679
}
713
}
680
if ($yamlfile) {
714
if ($yamlfile) {
681
    open my $yamlfileout, q{>}, "$yamlfile" or die "cannot open $yamlfile \n";
715
    open my $yamlfileout, q{>}, "$yamlfile" or die "cannot open $yamlfile \n";
682
    print $yamlfileout Encode::decode_utf8(YAML::XS::Dump($yamlhash));
716
    print $yamlfileout Encode::decode_utf8( YAML::XS::Dump($yamlhash) );
683
}
717
}
684
exit 0;
718
exit 0;
685
719
686
sub YAMLFileEntry {
720
sub YAMLFileEntry {
687
    my ($record, $record_id, $updated) = @_;
721
    my ( $record, $record_id, $updated ) = @_;
688
722
689
    my $entry = {
723
    my $entry = { authid => $record_id };
690
        authid => $record_id
691
    };
692
724
693
    # we recover all subfields of the heading authorities
725
    # we recover all subfields of the heading authorities
694
    my @subfields;
726
    my @subfields;
695
    foreach my $field ($record->field("2..")) {
727
    foreach my $field ( $record->field("2..") ) {
696
        push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
728
        push @subfields, map { ( $_->[0] =~ /[a-z]/ ? $_->[1] : () ) } $field->subfields();
697
    }
729
    }
698
    $entry->{'subfields'} = \@subfields;
730
    $entry->{'subfields'} = \@subfields;
699
    $entry->{'updated'} = $updated;
731
    $entry->{'updated'}   = $updated;
700
732
701
    return $entry;
733
    return $entry;
702
}
734
}
703
735
704
sub RecordRevisionIsGtOrEq {
736
sub RecordRevisionIsGtOrEq {
705
    my ($record_a, $record_b) = @_;
737
    my ( $record_a, $record_b ) = @_;
706
    return $record_a->field('005') && $record_b->field('005') &&
738
    return
707
    $record_a->field('005')->data && $record_b->field('005')->data &&
739
           $record_a->field('005')
708
    $record_a->field('005')->data >= $record_b->field('005')->data;
740
        && $record_b->field('005')
741
        && $record_a->field('005')->data
742
        && $record_b->field('005')->data
743
        && $record_a->field('005')->data >= $record_b->field('005')->data;
709
}
744
}
710
745
711
sub GetRecordId {
746
sub GetRecordId {
712
    my $marcrecord = shift;
747
    my $marcrecord = shift;
713
    my $tag = shift;
748
    my $tag        = shift;
714
    my $subfield = shift;
749
    my $subfield   = shift;
715
    if ($tag lt "010") {
750
    if ( $tag lt "010" ) {
716
        return $marcrecord->field($tag)->data() if $marcrecord->field($tag);
751
        return $marcrecord->field($tag)->data() if $marcrecord->field($tag);
717
    }
752
    } elsif ($subfield) {
718
    elsif ($subfield) {
753
        if ( $marcrecord->field($tag) ) {
719
        if ($marcrecord->field($tag)) {
754
            return $marcrecord->subfield( $tag, $subfield );
720
            return $marcrecord->subfield($tag, $subfield);
721
        }
755
        }
722
    }
756
    }
723
}
757
}
758
724
sub build_query {
759
sub build_query {
725
    my ($match, $record) = @_;
760
    my ( $match, $record ) = @_;
726
    my @searchstrings;
761
    my @searchstrings;
727
762
728
    foreach my $matchpoint (@$match) {
763
    foreach my $matchpoint (@$match) {
729
        my $query = build_simplequery($matchpoint, $record);
764
        my $query = build_simplequery( $matchpoint, $record );
730
        push (@searchstrings, $query) if $query;
765
        push( @searchstrings, $query ) if $query;
731
    }
766
    }
732
    my $op = 'AND';
767
    my $op = 'AND';
733
    return join(" $op ", @searchstrings);
768
    return join( " $op ", @searchstrings );
734
}
769
}
770
735
sub build_simplequery {
771
sub build_simplequery {
736
    my ($matchpoint, $record) = @_;
772
    my ( $matchpoint, $record ) = @_;
737
773
738
    my @searchstrings;
774
    my @searchstrings;
739
    my ($index, $record_data) = split (/,/, $matchpoint);
775
    my ( $index, $record_data ) = split( /,/, $matchpoint );
740
    if ($record_data =~ /(\d{3})(.*)/) {
776
    if ( $record_data =~ /(\d{3})(.*)/ ) {
741
        my ($tag, $subfields) = ($1, $2);
777
        my ( $tag, $subfields ) = ( $1, $2 );
742
        foreach my $field ($record->field($tag)) {
778
        foreach my $field ( $record->field($tag) ) {
743
            if (length($field->as_string("$subfields")) > 0) {
779
            if ( length( $field->as_string("$subfields") ) > 0 ) {
744
                push (@searchstrings, "$index:\"" . $field->as_string("$subfields") . "\"");
780
                push( @searchstrings, "$index:\"" . $field->as_string("$subfields") . "\"" );
745
            }
781
            }
746
        }
782
        }
747
    }
783
    } else {
748
    else {
749
        print "Invalid matchpoint format, invalid marc-field: $matchpoint\n";
784
        print "Invalid matchpoint format, invalid marc-field: $matchpoint\n";
750
    }
785
    }
751
    my $op = 'AND';
786
    my $op = 'AND';
752
    return join(" $op ", @searchstrings);
787
    return join( " $op ", @searchstrings );
753
}
788
}
789
754
sub report_item_errors {
790
sub report_item_errors {
755
    my $biblionumber = shift;
791
    my $biblionumber = shift;
756
    my $errors_ref = shift;
792
    my $errors_ref   = shift;
757
793
758
    foreach my $error (@{ $errors_ref }) {
794
    foreach my $error ( @{$errors_ref} ) {
759
        next if !$error;
795
        next if !$error;
760
        my $msg = "Item not added (bib $biblionumber, item tag #$error->{'item_sequence'}, barcode $error->{'item_barcode'}): ";
796
        my $msg =
797
            "Item not added (bib $biblionumber, item tag #$error->{'item_sequence'}, barcode $error->{'item_barcode'}): ";
761
        my $error_code = $error->{'error_code'};
798
        my $error_code = $error->{'error_code'};
762
        $error_code =~ s/_/ /g;
799
        $error_code =~ s/_/ /g;
763
        $msg .= "$error_code $error->{'error_information'}";
800
        $msg .= "$error_code $error->{'error_information'}";
764
        print $msg, "\n";
801
        print $msg, "\n";
765
    }
802
    }
766
}
803
}
804
767
sub printlog {
805
sub printlog {
768
    my $logelements = shift;
806
    my $logelements = shift;
769
    print $loghandle join(";", map { defined $_ ? $_ : "" } @$logelements{qw<id op status>}), "\n";
807
    print $loghandle join( ";", map { defined $_ ? $_ : "" } @$logelements{qw<id op status>} ), "\n";
770
}
808
}
809
771
sub get_heading_fields {
810
sub get_heading_fields {
772
    my $headingfields;
811
    my $headingfields;
773
    if ($authtypes) {
812
    if ($authtypes) {
774
        $headingfields = YAML::XS::LoadFile($authtypes);
813
        $headingfields = YAML::XS::LoadFile($authtypes);
775
        $headingfields = { C4::Context->preference('marcflavour') => $headingfields };
814
        $headingfields = { C4::Context->preference('marcflavour') => $headingfields };
776
        $logger->debug(Encode::decode_utf8(YAML::XS::Dump($headingfields)));
815
        $logger->debug( Encode::decode_utf8( YAML::XS::Dump($headingfields) ) );
777
    }
816
    }
778
    unless ($headingfields) {
817
    unless ($headingfields) {
779
        $headingfields = $dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
818
        $headingfields = $dbh->selectall_hashref(
819
            "SELECT auth_tag_to_report, authtypecode from auth_types", 'auth_tag_to_report',
820
            { Slice => {} }
821
        );
780
        $headingfields = { C4::Context->preference('marcflavour') => $headingfields };
822
        $headingfields = { C4::Context->preference('marcflavour') => $headingfields };
781
    }
823
    }
782
    return $headingfields;
824
    return $headingfields;
783
- 

Return to bug 30349