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

(-)a/Koha/SharedContent.pm (+454 lines)
Lines 262-265 sub get_sharing_url { Link Here
262
    return C4::Context->config('mana_config');
262
    return C4::Context->config('mana_config');
263
}
263
}
264
264
265
=head2 get_identifier_field_marc
266
267
my ($fields_ref, $inds1_ref) = get_identifier_field_marc();
268
269
Return two hash with the field and the first indicator for each identifier.
270
271
=cut
272
273
sub get_identifier_field_marc{
274
    #choose the field to select depending on marc flavour
275
    my $marcflavour = C4::Context->preference("marcflavour");
276
    my %fields;
277
    my %inds1;
278
    if ($marcflavour eq "UNIMARC"){
279
        %fields = (isbn => "010", issn => "011", ismn => "013", isrn => "015", isrc => "016", upc => "072", ean => "073");
280
        %inds1 = (isbn => "", issn => "", ismn => "", isrn => "", isrc => "", upc => "", ean => "");
281
    }
282
    else{
283
        #if nor UNIMARC, assume MARC21
284
        %fields = (isbn => "020", issn => "022", ismn => "024", isrn => "027", isrc => "024", upc => "024", ean => "024");
285
        %inds1 = (isbn => "", issn => "", ismn => " and \@ind1=\"2\"", isrn => "", isrc => " and \@ind1=\"0\"", upc => " and \@ind1=\"1\"", ean => " and \@ind1=\"3\"");
286
    }
287
288
    return (\%fields, \%inds1);
289
}
290
291
=head2 extract_reading_pairs
292
293
my @reading_pairs = extract_reading_pairs();
294
295
Extract reading pairs from Koha Database.
296
297
=cut
298
299
sub extract_reading_pairs{
300
    my ($fields_ref, $inds1_ref) = get_identifier_field_marc();
301
    my %fields = %$fields_ref;
302
    my %inds1 = %$inds1_ref;
303
304
    my $date=DateTime->now()->strftime("%F")."%";
305
    my $oldest_date=DateTime->now()->subtract(months => 6)->strftime("%F");
306
307
    #define the max number of simultaneous issues for a single borrower
308
    #if a sigle borrower have more issues than this, no pairs will be created for this borrower
309
    #It is used to exlude huge borrower such as libraries or instution (because the issues won't have any connection)
310
    my $current_issues_max = 50;
311
312
    my $dbh = C4::Context->dbh;
313
    my $query_part1 = "
314
    SELECT
315
        issues1.borrowernumber as borrowernumber,
316
        biblio_metadata1.biblionumber as biblionumber1,
317
        biblio_metadata2.biblionumber as biblionumber2,
318
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{isbn}\" $inds1{isbn}]/subfield[\@code=\"a\"]') as isbn1,
319
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{isbn}\" $inds1{isbn}]/subfield[\@code=\"a\"]') as isbn2,
320
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{issn}\" $inds1{issn}]/subfield[\@code=\"a\"]') as issn1,
321
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{issn}\" $inds1{issn}]/subfield[\@code=\"a\"]') as issn2,
322
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{ismn}\" $inds1{ismn}]/subfield[\@code=\"a\"]') as ismn1,
323
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{ismn}\" $inds1{ismn}]/subfield[\@code=\"a\"]') as ismn2,
324
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{isrn}\" $inds1{isrn}]/subfield[\@code=\"a\"]') as isrn1,
325
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{isrn}\" $inds1{isrn}]/subfield[\@code=\"a\"]') as isrn2,
326
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{isrc}\" $inds1{isrc}]/subfield[\@code=\"a\"]') as isrc1,
327
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{isrc}\" $inds1{isrc}]/subfield[\@code=\"a\"]') as isrc2,
328
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{upc}\" $inds1{upc}]/subfield[\@code=\"a\"]') as upc1,
329
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{upc}\" $inds1{upc}]/subfield[\@code=\"a\"]') as upc2,
330
        ExtractValue(biblio_metadata1.metadata, '//datafield[\@tag=\"$fields{ean}\" $inds1{ean}]/subfield[\@code=\"a\"]') as ean1,
331
        ExtractValue(biblio_metadata2.metadata, '//datafield[\@tag=\"$fields{ean}\" $inds1{ean}]/subfield[\@code=\"a\"]') as ean2
332
    FROM
333
        issues AS issues1
334
    JOIN
335
        (SELECT borrowernumber FROM issues GROUP BY borrowernumber HAVING COUNT(*) < $current_issues_max) AS number ON number.borrowernumber=issues1.borrowernumber
336
    JOIN
337
        issues AS issues2 ON issues1.borrowernumber=issues2.borrowernumber
338
    JOIN
339
        items AS items1 ON issues1.itemnumber=items1.itemnumber
340
    JOIN
341
        biblio_metadata AS biblio_metadata1 ON items1.biblionumber=biblio_metadata1.biblionumber
342
    JOIN
343
        items AS items2 ON issues2.itemnumber=items2.itemnumber
344
    JOIN
345
        biblio_metadata AS biblio_metadata2 ON items2.biblionumber=biblio_metadata2.biblionumber
346
    WHERE
347
        issues1.issuedate LIKE ?
348
        AND items1.biblionumber != items2.biblionumber
349
        AND (DATE(issues1.issuedate) != DATE(issues2.issuedate) OR items1.biblionumber < items2.biblionumber)
350
        AND (DATE(issues2.issuedate) > '$oldest_date')
351
        AND biblio_metadata1.format='marcxml'
352
        AND biblio_metadata2.format='marcxml'
353
    ";
354
    my $query_part2 = $query_part1;
355
    $query_part2 =~ s/issues AS issues2/old_issues AS issues2/;
356
357
    # query_part1 match issues of the day with current issues
358
    # query-part2 match issues of the day with old issues
359
    my $query = $query_part1."UNION ALL".$query_part2;
360
361
    my $sth = $dbh->prepare( $query );
362
    $sth->execute($date, $date);
363
364
    my $row;
365
    my @reading_pairs;
366
367
    #for each reading pair, processes the id pairs
368
    while ( $row = $sth->fetchrow_hashref ){
369
        #if necessary, normalize the ids
370
        $row->{isbn1} = Koha::Util::Normalize::NormalizeISBNs({ isbns => $row->{isbn1}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 }) if $row->{isbn1};
371
        $row->{isbn2} = Koha::Util::Normalize::NormalizeISBNs({ isbns => $row->{isbn2}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 }) if $row->{isbn2};
372
        $row->{issn1} = Koha::Util::Normalize::NormalizeISSNs({ issns => $row->{issn1}, pattern => ' ', strip_hyphens => 0 }) if $row->{issn1};
373
        $row->{issn2} = Koha::Util::Normalize::NormalizeISSNs({ issns => $row->{issn2}, pattern => ' ', strip_hyphens => 0 }) if $row->{issn2};
374
        $row->{ismn1} = Koha::Util::Normalize::NormalizeISMNs({ ismns => $row->{ismn1}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 }) if $row->{ismn1};
375
        $row->{ismn2} = Koha::Util::Normalize::NormalizeISMNs({ ismns => $row->{ismn2}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 }) if $row->{ismn2};
376
        $row->{isrc1} = Koha::Util::Normalize::NormalizeISRCs({ isrcs => $row->{isrc1}, pattern => ' ', strip_hyphens => 1 }) if $row->{isrc1};
377
        $row->{isrc2} = Koha::Util::Normalize::NormalizeISRCs({ isrcs => $row->{isrc2}, pattern => ' ', strip_hyphens => 1 }) if $row->{isrc2};
378
        $row->{isrn1} = Koha::Util::Normalize::NormalizeISRNs({ isrns => $row->{isrn1}, pattern => ' ', drop_local_suffix => 1 }) if $row->{isrn1};
379
        $row->{isrn2} = Koha::Util::Normalize::NormalizeISRNs({ isrns => $row->{isrn2}, pattern => ' ', drop_local_suffix => 1 }) if $row->{isrn2};
380
381
        # try to make pairs between every id possible
382
        foreach my $key1 ( qw ( isbn issn ismn isrn ean upc isrc ) ){
383
            if ( $row->{ $key1."1" }){
384
                my @id1_list = split(/ /, $row->{ $key1."1" });
385
                foreach my $key2 ( qw ( isbn issn ismn isrn ean upc isrc ) ){
386
                    # if both selected ids exists
387
                    if ( $row->{ $key2."2" } ){
388
                        my @id2_list = split(/ /, $row->{ $key2."2" });
389
                        # make pairs between every ids of the given type
390
                        foreach my $id1 (@id1_list){
391
                            foreach my $id2 (@id2_list){
392
                                my $currentpair;
393
                                $currentpair->{ idtype1 } = $key1;
394
                                $currentpair->{ documentid1 } = $id1;
395
                                $currentpair->{ idtype2 } = $key2;
396
                                $currentpair->{ documentid2 } = $id2;
397
                                push @reading_pairs, $currentpair;
398
                            }
399
                        }
400
                    }
401
                }
402
            }
403
        }
404
    }
405
    return @reading_pairs;
406
}
407
408
=head2 get_identifiers
409
410
my ($idtype, $documentids) = get_identifiers($biblionumber);
411
412
Get all the identifiers of one type for the given biblio record (identified by it's biblionumber)
413
414
Retrun a string with the type of the ids and string with all the ids.
415
416
=cut
417
418
419
sub get_identifiers {
420
    my ($biblionumber) = @_;
421
422
    my $biblioitem = Koha::Biblioitems->find( $biblionumber );
423
    my $idtype;
424
    my $documentid;
425
    my $documentids;
426
    my $found = 0;
427
428
    # Search in the biblioitem table witch can contain isbn, issn and ean
429
    if ( $biblioitem && $biblioitem->isbn ){
430
        $idtype = "isbn";
431
        $documentids = Koha::Util::Normalize::NormalizeISBNs({ isbns => $biblioitem->isbn, pattern => ' \| ', format => 'ISBN-13', strip_hyphens => 1 });
432
        if ($documentids) { $found = 1; };
433
    }
434
    elsif ( $biblioitem && $biblioitem->issn ){
435
        $idtype = "issn";
436
        $documentids =  Koha::Util::Normalize::NormalizeISSNs({ issns => $biblioitem->issn, pattern => ' \| ', strip_hyphens => 0 });
437
        if ($documentids) { $found = 1; };
438
    }
439
    elsif ( $biblioitem && $biblioitem->ean ){
440
        $idtype = "ean";
441
        $documentids = $biblioitem->ean;
442
        $documentids =~ s/ \| / /;
443
        if ($documentids) { $found = 1; };
444
    }
445
    # Search in biblio_metadata table
446
    if ($found == 0){
447
        my ($fields_ref, $inds1_ref) = get_identifier_field_marc();
448
        my %fields = %$fields_ref;
449
        my %inds1 = %$inds1_ref;
450
451
        my $dbh = C4::Context->dbh;
452
        my $query = "
453
            SELECT
454
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{isbn}\"$inds1{isbn}]/subfield[\@code=\"a\"]') as isbn,
455
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{issn}\"$inds1{issn}]/subfield[\@code=\"a\"]') as issn,
456
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{ismn}\"$inds1{ismn}]/subfield[\@code=\"a\"]') as ismn,
457
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{isrn}\"$inds1{isrn}]/subfield[\@code=\"a\"]') as isrn,
458
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{isrc}\"$inds1{isrc}]/subfield[\@code=\"a\"]') as isrc,
459
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{upc}\"$inds1{upc}]/subfield[\@code=\"a\"]') as upc,
460
              ExtractValue(metadata, '//datafield[\@tag=\"$fields{ean}\"$inds1{ean}]/subfield[\@code=\"a\"]') as ean
461
            FROM biblio_metadata
462
            WHERE biblionumber = ?
463
              AND format=\"marcxml\"
464
        ";
465
        my $sth = $dbh->prepare( $query );
466
        $sth->execute($biblionumber);
467
        my $row = $sth->fetchrow_hashref;
468
469
        if ($row->{isbn}){
470
            $idtype = "isbn";
471
            $documentids = Koha::Util::Normalize::NormalizeISBNs({ isbns => $row->{isbn}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 });
472
        }
473
        elsif ($row->{issn}){
474
            $idtype = "issn";
475
            $documentids = Koha::Util::Normalize::NormalizeISSNs({ issns => $row->{issn}, pattern => ' ', strip_hyphens => 0 });
476
        }
477
        elsif ($row->{ismn}){
478
            $idtype = "ismn";
479
            $documentids = Koha::Util::Normalize::NormalizeISMNs({ ismns => $row->{ismn}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 });
480
        }
481
        elsif ($row->{isrn}){
482
            $idtype = "isrn";
483
            $documentids = Koha::Util::Normalize::NormalizeISRNs({isrns => $row->{isrn}, pattern => ' ', convert_slash => 1, drop_local_suffix => 1 });
484
        }
485
        elsif ($row->{isrc}){
486
            $idtype = "isrc";
487
            $documentids = Koha::Util::Normalize::NormalizeISRCs({ isrcs => $row->{isrc}, pattern => ' ', strip_hyphens => 1 })
488
        }
489
        elsif ($row->{upc}){
490
            $idtype = "upc";
491
            $documentids = $row->{upc};
492
        }
493
        elsif ($row->{ean}){
494
            $idtype = "ean";
495
            $documentids = $row->{ean};
496
        }
497
    }
498
    if ($idtype && $documentids){
499
        return {code => 200, message => "OK", idtype => $idtype, documentids => $documentids};
500
    }
501
    return {code => 404, message => "No usable id found"}
502
}
503
504
=head2 ask_mana_reading_suggestion
505
506
my $response = ask_mana_reading_suggestion({
507
    documentid => $documentid,
508
    idtype => $idtype,
509
    offset => $offset,
510
    length => $length
511
});
512
513
Construct a request for reading suggestion and send it to Mana.
514
Retrun the response.
515
516
=cut
517
518
sub ask_mana_reading_suggestion {
519
        my ($params) = @_;
520
        my $documentid = $params->{documentid};
521
        my $idtype = $params->{idtype};
522
        my $offset = $params->{offset};
523
        my $length = $params->{length};
524
525
        #request mana
526
        my $mana_ip = C4::Context->config('mana_config');
527
        my $url = "$mana_ip/getsuggestion/$documentid/$idtype?offset=$offset&length=$length";
528
        my $request = HTTP::Request->new( GET => $url );
529
        $request->content_type('aplication/json');
530
        my $response = Koha::SharedContent::process_request( $request );
531
532
        return $response;
533
}
534
535
=head2 get_reading_suggestion
536
537
@biblios = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
538
539
Get from Mana the reading suggestion for the given biblio record
540
Store the suggestion in Koha
541
Return them for display
542
543
=cut
544
545
sub get_reading_suggestion {
546
    my ($biblionumber, $local_suggestions) = @_;
547
548
    my $result = get_identifiers( $biblionumber );
549
    if ($result->{code} != 200){
550
        return {code => $result->{code}, message => $result->{message}};
551
    };
552
    my $idtype = $result->{idtype};
553
    my $documentids = $result->{documentids};
554
    my $documentid = (split(/ /, $documentids, 2))[0];
555
    my $offset = 1;
556
    my $length = 10;
557
    my $mananotover;
558
    my @biblios;
559
    my @biblios_blessed;
560
    my $added_biblionumbers;
561
562
    do{
563
        #request mana
564
         my $response = ask_mana_reading_suggestion({
565
            documentid => $documentid,
566
            idtype => $idtype,
567
            offset => $offset,
568
            length => $length
569
        });
570
571
        #error handling
572
        my $resources = $response->{data};
573
        unless ( $resources ){
574
            my $msg = $response->{msg};
575
            my $code = $response->{code};
576
            if ( $code ){
577
                return {code => $response->{code}, message => $msg};
578
            }
579
            else{
580
                return {code => 400, message => "Unknown error"};
581
            }
582
        }
583
584
        if ( scalar @{ $resources } < $length ){
585
            $mananotover = 0;
586
        }
587
        else{
588
            $mananotover = 1;
589
        }
590
591
        #create the list of owned suggested resources
592
        my $ownedbiblioitem;
593
        my $documentid2;
594
        my $found = 0;
595
        my $marcflavour = C4::Context->preference("marcflavour");
596
        my $ctr = 0;
597
        my $resource = @{$resources}[$ctr];
598
599
        # Treate each resources until we don't have any more resource or we found 10 resource
600
        while ($resource && (scalar @biblios_blessed < 10 )){
601
            $found = 0;
602
603
            #isbn and issn can be search for with Koha::Biblioitems->search, ean too for unimarc but not for marc21
604
            if ($resource->{idtype} eq "isbn" || $resource->{idtype} eq "issn" || ($resource->{idtype} eq "ean" && $marcflavour eq "UNIMARC")){
605
                #isbn processsing
606
                if ( $resource->{idtype} eq "isbn" ){
607
                    $documentid2 = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-10', strip_hyphens => 1 });
608
                    $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid2}) if $documentid2;
609
610
                    #if we don't have such a biblioitem, we try to format else the isbn
611
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
612
                        $documentid2 = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-13', strip_hyphens => 1 });
613
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid2}) if $documentid2;
614
                    }
615
616
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
617
                        $documentid2 = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-10', strip_hyphens => 0 });
618
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid2}) if $documentid2;
619
                    }
620
621
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
622
                        $documentid2 = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-13', strip_hyphens => 0 });
623
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid2}) if $documentid2;
624
                    }
625
                }
626
627
                #issn and ean don't need special processing
628
                elsif ($resource->{idtype} eq "issn" or $resource->{idtype} eq "ean"){
629
                    $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $resource->{documentid} });
630
                }
631
632
                #construct the tables with biblionumber
633
                if (scalar @{ $ownedbiblioitem->unblessed() } ){
634
                    $found = 1;
635
                    my $ownedbiblio = Koha::Biblios->find( @{ $ownedbiblioitem->unblessed() }[0]->{biblionumber} );
636
                    #add the biblio if not already present
637
                    if ( not(exists($added_biblionumbers->{@{ $ownedbiblioitem->unblessed() }[0]->{biblionumber}})) ){
638
                        push @biblios_blessed, $ownedbiblio;
639
                        push @biblios, $ownedbiblio->unblessed();
640
                        $added_biblionumbers->{@{ $ownedbiblioitem->unblessed() }[0]->{biblionumber}}=1;
641
                    }
642
                }
643
            }
644
            # if we don't have such a biblioitem, we try to look directly in metadata
645
            # because if the document has multiple isbn they are store in biblioitem table like this 
646
            # "isbn1 | isbn2" and can't be found by biblioitems->seach
647
            # other id need to be search with sql
648
            if ($found != 1) {
649
                my @params;
650
651
                my ($fields_ref, $inds1_ref) = get_identifier_field_marc();
652
                my %fields = %$fields_ref;
653
                my %inds1 = %$inds1_ref;
654
655
                #pattern to be tolerent on the hyphens
656
                my $pattern="";
657
                foreach my $p (split('', $resource->{documentid})){
658
                    $pattern .= "$p-?";
659
                }
660
661
                my $dbh = C4::Context->dbh;
662
                my $query = q{
663
                    SELECT biblioitems.biblionumber as biblionumber
664
                    FROM biblioitems
665
                    LEFT JOIN biblio_metadata ON biblioitems.biblionumber=biblio_metadata.biblionumber
666
                    WHERE ExtractValue(biblio_metadata.metadata, '//datafield[@tag="}.$fields{$resource->{idtype}}.q{"}.$inds1{$resource->{idtype}}.q{]/subfield[@code="a"]') REGEXP "}.$pattern.q{"
667
                      AND biblio_metadata.format="marcxml"
668
                };
669
                my $sth = $dbh->prepare( $query );
670
                $ownedbiblioitem = $sth->execute;
671
672
                #construct the tables with biblionumber
673
                my $row = $sth->fetchrow_hashref;
674
                if ( $row ){
675
                    my $ownedbiblio = Koha::Biblios->find( $row->{biblionumber} );
676
                    #add the biblio if not already present
677
                    if ( not(exists($added_biblionumbers->{$row->{biblionumber}})) ){
678
                        push @biblios_blessed, $ownedbiblio;
679
                        push @biblios, $ownedbiblio->unblessed();
680
                        $added_biblionumbers->{$row->{biblionumber}}=1;
681
                    }
682
                }
683
            }
684
685
            #prepare the next resource to be treated
686
            $ctr++;
687
            $resource = @{$resources}[$ctr];
688
        }
689
        # Prepare the next requeste
690
        # The number of requested resource is inversely proportionnal to the found_items/returned_items ratio, +1 is here just to avoid 0
691
        my $newlength = int( ( 10*( $length + $offset ) - $length ) / (scalar @biblios_blessed + 1 ));
692
        if ( $newlength > 500 ){
693
            $newlength = 500;
694
        }
695
        $offset += $length;
696
        $length = $newlength;
697
698
    } while( (scalar @biblios_blessed < 10 ) and $mananotover );
699
700
    #preparing new suggestion for storing the result in koha
701
    my $newSuggestion;
702
    my $cter = scalar @biblios_blessed;
703
    $cter = 10 unless ($cter < 10);
704
    $newSuggestion->{ biblionumber } = $biblionumber;
705
    while ( $cter > 0 ){
706
        if ( $biblios_blessed[ $cter-1 ] and $biblios_blessed[ $cter-1 ]->biblionumber){
707
            $newSuggestion->{ "biblionumber".$cter }=$biblios_blessed[ $cter-1 ]->biblionumber;
708
        }
709
        $cter--;
710
    }
711
    if ( $local_suggestions ){
712
        Koha::Reading_suggestions->find( $biblionumber )->delete();
713
    }
714
    Koha::Reading_suggestion->new( $newSuggestion )->store;
715
716
    return {code => 200, message => "OK", data => \@biblios};
717
}
718
265
1;
719
1;
(-)a/Koha/Util/Normalize.pm (-2 / +10 lines)
Lines 151-156 sub NormalizeISMN{ Link Here
151
    return unless $string;
151
    return unless $string;
152
152
153
    my $ismn;
153
    my $ismn;
154
    $string =~ s/^-*//;
155
    $string =~ s/-*$//;
156
    $string =~ s/--+/-/;
154
    #test if the string seems valid
157
    #test if the string seems valid
155
    if (is_ismn($string)){
158
    if (is_ismn($string)){
156
        $ismn = $string;
159
        $ismn = $string;
Lines 200-206 sub is_ismn{ Link Here
200
    #check if length match the expected length of an ismn (with and withou hyphens)
203
    #check if length match the expected length of an ismn (with and withou hyphens)
201
    return 0 unless ( (length($string)==10) or (length($string)==13) or (length($string)==14) or length($string)==17 );
204
    return 0 unless ( (length($string)==10) or (length($string)==13) or (length($string)==14) or length($string)==17 );
202
    #check if the pattern look like an ismn
205
    #check if the pattern look like an ismn
203
    return 0 unless ( $string =~ m/^(((979-0-)|(M-))[0-9]{3,7}-[0-9]{1,5}-[0-9])|((M|(9790))[0-9]{9})$/ ) ;
206
    return 0 unless ( $string =~ m/^(((979-0-)|(M-))[0-9]{3,7}-[0-9]{1,5}-[0-9X])|((M|(9790))[0-9]{8}[0-9X])$/ ) ;
204
207
205
    return 1
208
    return 1
206
}
209
}
Lines 224-229 sub NormalizeISRC{ Link Here
224
    return unless $string;
227
    return unless $string;
225
228
226
    my $isrc;
229
    my $isrc;
230
    $string =~ s/^-*//;
231
    $string =~ s/-*$//;
232
    $string =~ s/--+/-/;
227
    #test if the string seems valid
233
    #test if the string seems valid
228
    if (is_isrc($string)){
234
    if (is_isrc($string)){
229
        $isrc = $string;
235
        $isrc = $string;
Lines 281-286 sub NormalizeISRN{ Link Here
281
    return unless $string;
287
    return unless $string;
282
288
283
    my $isrn;
289
    my $isrn;
290
    $string =~ s/^-*//;
291
    $string =~ s/-*$//;
284
    #test if the string seems valid
292
    #test if the string seems valid
285
    if (is_isrn($string)){
293
    if (is_isrn($string)){
286
        $isrn = $string;
294
        $isrn = $string;
Lines 317-323 sub is_isrn{ Link Here
317
    #check if length match the expected length of an isrn
325
    #check if length match the expected length of an isrn
318
    return 0 unless ( length($truncated_string)<=36 );
326
    return 0 unless ( length($truncated_string)<=36 );
319
    #check if the pattern look like an isrn
327
    #check if the pattern look like an isrn
320
    return 0 unless ( $string =~ m/^[A-Z](\w[\/-]?)*--(\d\d[\/-])?\d+([\/-]\w+)?(--[A-Z][A-Z])?(\+[A-Z0-9a-z,\.\/]+)?$/ );
328
    return 0 unless ( $string =~ m/^[A-Z](\w([\/-]\w+)?)*--(\d\d[\/-])?\d+([\/-]\w+)?(--[A-Z][A-Z])?(\+[A-Z0-9a-z,\.\/]+)?$/ );
321
    #check if each part has a valid length
329
    #check if each part has a valid length
322
    $string =~ m/^([\w\/-]+)--([\d\/-]+[\w\/-]*)(--[A-Z][A-Z])?(\+[A-Za-z0-9,\.\/]+)?$/;
330
    $string =~ m/^([\w\/-]+)--([\d\/-]+[\w\/-]*)(--[A-Z][A-Z])?(\+[A-Za-z0-9,\.\/]+)?$/;
323
    return 0 unless ( length($1)<=16 );
331
    return 0 unless ( length($1)<=16 );
(-)a/misc/cronjobs/mana_send_pairs.pl (-111 / +1 lines)
Lines 25-141 if ($help){ Link Here
25
25
26
#if mana is activated
26
#if mana is activated
27
if (C4::Context->preference("Mana") == 1){
27
if (C4::Context->preference("Mana") == 1){
28
    #choose the field to select depending on marc flavour
28
    my @reading_pairs = Koha::SharedContent::extract_reading_pairs();
29
    my $date=DateTime->now()->strftime("%F")."%";
30
31
    #define the max number of simultaneous issues for a single borrower
32
    #if a sigle borrower have more issues than this, no pairs will be created for this borrower
33
    #It is used to exlude huge borrower such as libraries or instution (because the issues won't have any connection)
34
    my $current_issues_max = 50;
35
36
    #choose the field to select depending on marc flavour
37
    my $marcflavour = C4::Context->preference("marcflavour");
38
    my %fields;
39
    my %inds1;
40
    if ($marcflavour eq "UNIMARC"){
41
        %fields = (isbn => "010", issn => "011", ismn => "013", isrn => "015", isrc => "016", upc => "072", ean => "073");
42
        %inds1 = (isbn => "", issn => "", ismn => "", isrn => "", isrc => "", upc => "", ean => "");
43
    }
44
    else{
45
        #if nor UNIMARC, assume MARC21
46
        %fields = (isbn => "020", issn => "022", ismn => "024", isrn => "027", isrc => "024", upc => "024", ean => "024");
47
        %inds1 = (isbn => "", issn => "", ismn => " and \@ind1=\"2\"", isrn => "", isrc => " and \@ind1=\"0\"", upc => " and \@ind1=\"1\"", ean => " and \@ind1=\"3\"");
48
    }
49
50
    my $dbh = C4::Context->dbh;
51
    my $query = q{
52
    SELECT
53
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{isbn}.q{"}.$inds1{isbn}.q{]/subfield[@code="a"]') as isbn1,
54
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{isbn}.q{"}.$inds1{isbn}.q{]/subfield[@code="a"]') as isbn2,
55
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{issn}.q{"}.$inds1{issn}.q{]/subfield[@code="a"]') as issn1,
56
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{issn}.q{"}.$inds1{issn}.q{]/subfield[@code="a"]') as issn2,
57
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{ismn}.q{"}.$inds1{ismn}.q{]/subfield[@code="a"]') as ismn1,
58
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{ismn}.q{"}.$inds1{ismn}.q{]/subfield[@code="a"]') as ismn2,
59
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{isrn}.q{"}.$inds1{isrn}.q{]/subfield[@code="a"]') as isrn1,
60
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{isrn}.q{"}.$inds1{isrn}.q{]/subfield[@code="a"]') as isrn2,
61
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{isrc}.q{"}.$inds1{isrc}.q{]/subfield[@code="a"]') as isrc1,
62
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{isrc}.q{"}.$inds1{isrc}.q{]/subfield[@code="a"]') as isrc2,
63
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{upc}.q{"}.$inds1{upc}.q{]/subfield[@code="a"]') as upc1,
64
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{upc}.q{"}.$inds1{upc}.q{]/subfield[@code="a"]') as upc2,
65
        ExtractValue(biblio_metadata1.metadata, '//datafield[@tag="}.$fields{ean}.q{"}.$inds1{ean}.q{]/subfield[@code="a"]') as ean1,
66
        ExtractValue(biblio_metadata2.metadata, '//datafield[@tag="}.$fields{ean}.q{"}.$inds1{ean}.q{]/subfield[@code="a"]') as ean2
67
    FROM
68
        issues AS issues1
69
    JOIN
70
        (SELECT borrowernumber FROM issues GROUP BY borrowernumber HAVING COUNT(*) < $current_issues_max) AS number ON number.borrowernumber=issues1.borrowernumber
71
    LEFT JOIN
72
        issues AS issues2 ON issues1.borrowernumber=issues2.borrowernumber
73
    LEFT JOIN
74
        items AS items1 ON issues1.itemnumber=items1.itemnumber
75
    LEFT JOIN
76
        biblio_metadata AS biblio_metadata1 ON items1.biblionumber=biblio_metadata1.biblionumber
77
    LEFT JOIN
78
        items AS items2 ON issues2.itemnumber=items2.itemnumber
79
    LEFT JOIN
80
        biblio_metadata AS biblio_metadata2 ON items2.biblionumber=biblio_metadata2.biblionumber
81
    WHERE
82
        issues1.issuedate LIKE ?
83
        AND items1.biblionumber != items2.biblionumber
84
        AND (DATE(issues1.issuedate) != DATE(issues2.issuedate) OR items1.biblionumber < items2.biblionumber)
85
        AND biblio_metadata1.format='marcxml'
86
        AND biblio_metadata2.format='marcxml'
87
    };
88
89
    my $query_part2 = $query_part1;
90
    $query_part2 =~ s/issues AS issues2/old_issues AS issues2/;
91
92
    # query_part1 match issues of the day with current issues
93
    # query-part2 match issues of the day with old issues
94
    my $query = $query_part1."UNION ALL".$query_part2;
95
96
    my $sth = $dbh->prepare( $query );
97
    $sth->execute($date, $date);
98
99
    my $row;
100
    my @reading_pairs;
101
102
    #for each reading pair, processes the id pairs
103
    while ( $row = $sth->fetchrow_hashref ){
104
        #if necessary, normalize the ids
105
        $row->{isbn1} = Koha::Util::Normalize::NormalizeISBNs({ isbns => $row->{isbn1}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 }) if $row->{isbn1};
106
        $row->{isbn2} = Koha::Util::Normalize::NormalizeISBNs({ isbns => $row->{isbn2}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 }) if $row->{isbn2};
107
        $row->{ismn1} = Koha::Util::Normalize::NormalizeISMNs({ ismn => $row->{ismn1}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 }) if $row->{ismn1};
108
        $row->{ismn2} = Koha::Util::Normalize::NormalizeISMNs({ ismn => $row->{ismn2}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 }) if $row->{ismn2};
109
        $row->{isrc1} = Koha::Util::Normalize::NormalizeISRCs({ isrc => $row->{isrc1}, pattern => ' ', strip_hyphens => 1 }) if $row->{isrc1};
110
        $row->{isrc2} = Koha::Util::Normalize::NormalizeISRCs({ isrc => $row->{isrc2}, pattern => ' ', strip_hyphens => 1 }) if $row->{isrc2};
111
        $row->{isrn1} = Koha::Util::Normalize::NormalizeISRNs({ isrn => $row->{isrn1}, pattern => ' ', drop_local_suffix => 1 }) if $row->{isrn1};
112
        $row->{isrn2} = Koha::Util::Normalize::NormalizeISRNs({ isrn => $row->{isrn2}, pattern => ' ', drop_local_suffix => 1 }) if $row->{isrn2};
113
114
        # try to make pairs between every id possible
115
        foreach my $key1 ( qw ( isbn issn ismn isrn ean upc isrc ) ){
116
            if ( $row->{ $key1."1" }){
117
                my @id1_list = split(/ /, $row->{ $key1."1" });
118
                foreach my $key2 ( qw ( isbn issn ismn isrn ean upc isrc ) ){
119
                    # if both selected ids exists
120
                    if ( $row->{ $key2."2" } ){
121
                        my @id2_list = split(/ /, $row->{ $key1."2" });
122
                        # make pairs between every ids of the given type
123
                        foreach my $id1 (@id1_list){
124
                            foreach my $id2 (@id2_list){
125
                                my $currentpair;
126
                                $currentpair->{ idtype1 } = $key1;
127
                                $currentpair->{ documentid1 } = $id1;
128
                                $currentpair->{ idtype2 } = $key2;
129
                                $currentpair->{ documentid2 } = $id2;
130
                                push @reading_pairs, $durrentpair;
131
                            }
132
                        }
133
                   }
134
                }
135
            }
136
        }
137
    }
138
139
    my $content;
29
    my $content;
140
30
141
    #informations for mana
31
    #informations for mana
(-)a/opac/svc/mana/getSuggestion (-257 / +7 lines)
Lines 57-64 if ( $temp_biblionumber ){ Link Here
57
    $biblionumber = $temp_biblionumber;
57
    $biblionumber = $temp_biblionumber;
58
}
58
}
59
59
60
my $biblioitem = Koha::Biblioitems->find( $biblionumber );
61
62
my $local_suggestions;
60
my $local_suggestions;
63
61
64
my $now;
62
my $now;
Lines 72-79 eval { Link Here
72
    $duration = $now - $timestamp;
70
    $duration = $now - $timestamp;
73
};
71
};
74
my @biblios;
72
my @biblios;
75
my @biblios_blessed;
73
my $biblios_ref;
76
my $bibliosnumbers;
77
if ( $local_suggestions and DateTime::Duration->compare( $duration, DURATION_BEFORE_REFRESH ) == -1 ){
74
if ( $local_suggestions and DateTime::Duration->compare( $duration, DURATION_BEFORE_REFRESH ) == -1 ){
78
        delete $local_suggestions->{timestamp};
75
        delete $local_suggestions->{timestamp};
79
        delete $local_suggestions->{biblionumber};
76
        delete $local_suggestions->{biblionumber};
Lines 81-341 if ( $local_suggestions and DateTime::Duration->compare( $duration, DURATION_BEF Link Here
81
            my $biblio = Koha::Biblios->find( $local_suggestions->{ $key } );
78
            my $biblio = Koha::Biblios->find( $local_suggestions->{ $key } );
82
            push @biblios, $biblio->unblessed() if $biblio;
79
            push @biblios, $biblio->unblessed() if $biblio;
83
        }
80
        }
81
        $biblios_ref = \@biblios;
84
}
82
}
85
83
86
else{
84
else{
87
    # get all informations to ask mana
85
    my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
88
    my $idtype;
86
    if ($result->{code} == 200){
89
    my $documentid;
87
        $biblios_ref = $result->{data};
90
    my $documentids;
88
    };
91
    my $notnormalizeddocumentid;
92
    my $found = 0;
93
94
    if ( $biblioitem && $biblioitem->isbn ){
95
        $idtype = "isbn";
96
        $documentids = Koha::Util::Normalize::NormalizeISBNs({ isbns => $biblioitem->isbn, pattern => ' \| ', format => 'ISBN-13', strip_hyphens => 1 });
97
        if ($documentids) { $found = 1; };
98
    }
99
    elsif ( $biblioitem && $biblioitem->issn ){
100
        $idtype = "issn";
101
        $documentids =  Koha::Util::Normalize::NormalizeISSNs({ issns => $biblioitem->issn, pattern => ' \| ', strip_hyphens => 0 });
102
        if ($documentids) { $found = 1; };
103
    }
104
    elsif ( $biblioitem && $biblioitem->ean ){
105
        $idtype = "ean";
106
        $documentid = $biblioitem->ean;
107
        $documentids =~ s/ \| / /;
108
        if ($documentids) { $found = 1; };
109
    }
110
    if ($found == 0){
111
       #choose the field to select depending on marc flavour
112
        my $marcflavour = C4::Context->preference("marcflavour");
113
        my %fields;
114
        my %inds1;
115
        if ($marcflavour eq "UNIMARC"){
116
            %fields = (isbn => "010", issn => "011", ismn => "013", isrn => "015", isrc => "016", upc => "072", ean => "073");
117
            %inds1 = (isbn => "", issn => "", ismn => "", isrn => "", isrc => "", upc => "", ean => "");
118
        }
119
        else{
120
            #if nor UNIMARC, assume MARC21
121
            %fields = (isbn => "020", issn => "022", ismn => "024", isrn => "027", isrc => "024", upc => "024", ean => "024");
122
            %inds1 = (isbn => "", issn => "", ismn => " and \@ind1=\"2\"", isrn => "", isrc => " and \@ind1=\"0\"", upc => " and \@ind1=\"1\"", ean => " and \@ind1=\"3\"");
123
        }
124
125
        my $dbh = C4::Context->dbh;
126
        my $query = q{
127
            SELECT
128
              ExtractValue(metadata, '//datafield[@tag="}.$fields{isbn}.q{"}.$inds1{isbn}.q{]/subfield[\@code="a"]') as isbn,
129
              ExtractValue(metadata, '//datafield[@tag="}.$fields{issn}.q{"}.$inds1{issn}.q{]/subfield[\@code="a"]') as issn,
130
              ExtractValue(metadata, '//datafield[@tag="}.$fields{ismn}.q{"}.$inds1{ismn}.q{]/subfield[@code="a"]') as ismn,
131
              ExtractValue(metadata, '//datafield[@tag="}.$fields{isrn}.q{"}.$inds1{isrn}.q{]/subfield[@code="a"]') as isrn,
132
              ExtractValue(metadata, '//datafield[@tag="}.$fields{isrc}.q{"}.$inds1{isrc}.q{]/subfield[@code="a"]') as isrc,
133
              ExtractValue(metadata, '//datafield[@tag="}.$fields{upc}.q{"}.$inds1{upc}.q{]/subfield[@code="a"]') as upc,
134
              ExtractValue(metadata, '//datafield[@tag="}.$fields{ean}.q{"}.$inds1{ean}.q{]/subfield[@code="a"]') as ean
135
            FROM biblio_metadata
136
            WHERE biblionumber="}.$biblionumber.q{"
137
              AND format="marcxml"
138
        };
139
        my $sth = $dbh->prepare( $query );
140
        $sth->execute($biblionumber);
141
        my $row = $sth->fetchrow_hashref;
142
143
        if ($row->{isbn}){
144
            $idtype = "isbn";
145
            $documentid = Koha::Util::Normalize::NormalizeISBNs({ isbn => $row->{isbn}, pattern => ' ', format => 'ISBN-13', strip_hyphens => 1 });
146
        }
147
        elsif ($row->{issn}){
148
            $idtype = "issn";
149
            $documentid = Koha::Util::Normalize::NormalizeISSNs({ ismn => $row->{issn}, pattern => ' ', strip_hyphens => 1 });
150
        }
151
        elsif ($row->{ismn}){
152
            $idtype = "ismn";
153
            $documentids = Koha::Util::Normalize::NormalizeISMNs({ ismns => $row->{ismn}, pattern => ' ', format => 'ISMN-13', strip_hyphens => 1 });
154
        }
155
        elsif ($row->{isrn}){
156
            $idtype = "isrn";
157
            $documentids = Koha::Util::Normalize::NormalizeISRNs({isrns => $row->{isrn}, pattern => ' ', convert_slash => 1, drop_local_suffix => 1 });
158
        }
159
        elsif ($row->{isrc}){
160
            $idtype = "isrc";
161
            $documentids = Koha::Util::Normalize::NormalizeISRCs({ isrcs => $row->{isrc}, pattern => ' ', strip_hyphens => 1 })
162
        }
163
        elsif ($row->{upc}){
164
            $idtype = "upc";
165
            $documentids = $row->{upc};
166
        }
167
        elsif ($row->{ean}){
168
            $idtype = "ean";
169
            $documentids = $row->{ean};
170
        }
171
        elsif ($row->{ean}){
172
            $idtype = "ean";
173
            $documentid = $row->{ean};
174
        }
175
        else{
176
            die "error: no propper identifier";
177
        }
178
    }
179
180
    $documentid=(split(/ /, $documentids, 2))[0];
181
    $notnormalizeddocumentid = $documentid;
182
    my $offset = 1;
183
    my $length = 10;
184
    my $mananotover;
185
186
    do{
187
        #request mana
188
        my $mana_ip = C4::Context->config('mana_config');
189
        my $url = "$mana_ip/getsuggestion/$notnormalizeddocumentid/$idtype?offset=$offset&length=$length";
190
        my $request = HTTP::Request->new( GET => $url );
191
        $request->content_type('aplication/json');
192
        my $response = Koha::SharedContent::process_request( $request );
193
194
        #error handling
195
        my $resources = $response->{data};
196
        unless ( $resources ){
197
            my $msg;
198
            $msg = $response->{msg};
199
            if ( $msg ){
200
                die $msg;
201
            }
202
            else{
203
                die "Unknown error";
204
            }
205
        }
206
207
        if ( scalar @{ $resources } < $length ){
208
            $mananotover = 0;
209
        }
210
        else{
211
            $mananotover = 1;
212
        }
213
214
215
216
        #create the list of owned suggested resources
217
        my $ownedbiblioitem;
218
        my $marcflavour = C4::Context->preference("marcflavour");
219
        foreach my $resource ( @{ $resources } ){
220
            my $found = 0;
221
222
            #isbn and issn can be search for with Koha::Biblioitems->search, ean too for unimarc but not for marc21
223
            if ($resource->{idtype} eq "isbn" || $resource->{idtype} eq "issn" || ($resource->{idtype} eq "ean" && $marcflavour eq "UNIMARC")){
224
                #isbn processsing
225
                if ( $resource->{idtype} eq "isbn" ){
226
                    $documentid= C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-10', strip_hyphens => 1 });
227
                    $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid}) if $documentid;
228
229
                    #if we don't have such a biblioitem, we try to format else the isbn
230
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
231
                        $documentid = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-13', strip_hyphens => 1 });
232
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid}) if $documentid;
233
                    }
234
235
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
236
                        $documentid = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-10', strip_hyphens => 0 });
237
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid}) if $documentid;
238
                    }
239
240
                    unless ( scalar @{ $ownedbiblioitem->unblessed() } ){
241
                        $documentid = C4::Koha::NormalizeISBN({ isbn => $resource->{documentid}, format => 'ISBN-13', strip_hyphens => 0 });
242
                        $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $documentid}) if $documentid;
243
                    }
244
                }
245
246
                #issn and ean don't need special processing
247
                elsif ($resource->{idtype} eq "issn" or $resource->{idtype} eq "ean"){
248
                    $ownedbiblioitem = Koha::Biblioitems->search({ $resource->{idtype} => $resource->{documentid} });
249
                }
250
251
                #construct the tables with biblionumber
252
                if (scalar @{ $ownedbiblioitem->unblessed() } ){
253
                    $found = 1;
254
                    my $ownedbiblio = Koha::Biblios->find( @{ $ownedbiblioitem->unblessed() }[0]->{biblionumber} );
255
                    #add the biblio if not already present
256
                    if ( not(exists($bibliosnumbers->{@{ $ownedbiblioitem->unblessed() }[0]->{biblionumber}})) ){
257
                        push @biblios_blessed, $ownedbiblio;
258
                        push @biblios, $ownedbiblio->unblessed();
259
                        $bibliosnumbers->{@{ $ownedbiblioitem->unblessed() }[0]->{biblionumber}}=1;
260
                    }
261
                }
262
            }
263
            # if we don't have such a biblioitem, we try to look directly in metadata
264
            # because if the document has multiple isbn they are store in biblioitem table like this
265
            # "isbn1 | isbn2" and can't be found by biblioitems->seach
266
            # other id need to be search with sql
267
            if ($found != 1) {
268
                my @params;
269
270
                #choose the field to select depending on marc flavour
271
                my %fields;
272
                my %inds1;
273
                if ($marcflavour eq "UNIMARC"){
274
                    %fields = (isbn => "010", issn => "011", ismn => "013", isrn => "015", isrc => "016", upc => "072", ean => "073");
275
                    %inds1 = (isbn => "", issn => "", ismn => "", isrn => "", isrc => "", upc => "", ean => "");
276
                }
277
                else{
278
                    #if nor UNIMARC, assume MARC21
279
                    %fields = (isbn => "020", issn => "022", ismn => "024", isrn => "027", isrc => "024", upc => "024", ean => "024");
280
                    %inds1 = (isbn => "", issn => "", ismn => " and \@ind1=\"2\"", isrn => "", isrc => " and \@ind1=\"0\"", upc => " and \@ind1=\"1\"", ean => " and \@ind1=\"3\"");
281
                }
282
283
                #pattern to be tolerent on the hyphens
284
                my $pattern="";
285
                foreach my $p (split('', $resource->{documentid})){
286
                    $pattern .= "$p-?";
287
                }
288
289
                my $dbh = C4::Context->dbh;
290
                my $query = q{
291
                    SELECT biblioitems.biblionumber as biblionumber
292
                    FROM biblioitems
293
                    LEFT JOIN biblio_metadata ON biblioitems.biblionumber=biblio_metadata.biblionumber
294
                    WHERE ExtractValue(biblio_metadata.metadata, '//datafield[@tag="}.$fields{$resource->{idtype}}.q{"}.$inds1{$resource->{idtype}}.q{]/subfield[@code="a"]') REGEXP "}.$pattern.q{"
295
                      AND biblio_metadata.format="marcxml"
296
                };
297
                my $sth = $dbh->prepare( $query );
298
                $ownedbiblioitem = $sth->execute;
299
300
                #construct the tables with biblionumber
301
                my $row = $sth->fetchrow_hashref;
302
                if ( $row ){
303
                    my $ownedbiblio = Koha::Biblios->find( $row->{biblionumber} );
304
                    #add the biblio if not already present
305
                    if ( not(exists($bibliosnumbers->{$row->{biblionumber}})) ){
306
                        push @biblios_blessed, $ownedbiblio;
307
                        push @biblios, $ownedbiblio->unblessed();
308
                        $bibliosnumbers->{$row->{biblionumber}}=1;
309
                    }
310
                }
311
            }
312
        }
313
            #the number of requested resource is inversely proportionnal to the found_items/returned_items ratio, +1 is here just to avoid 0
314
            my $newlength = int( ( 10*( $length + $offset ) - $length ) / (scalar @biblios_blessed + 1 ));
315
            if ( $newlength > 500 ){
316
                $newlength = 500;
317
            }
318
            $offset += $length;
319
            $length = $newlength;
320
321
322
    } while( (scalar @biblios_blessed < 10 ) and $mananotover );
323
324
    #preparing new suggestion
325
    my $newSuggestion;
326
    my $cter = scalar @biblios_blessed;
327
    $cter = 10 unless ($cter < 10);
328
    $newSuggestion->{ biblionumber } = $biblionumber;
329
    while ( $cter > 0 ){
330
        if ( $biblios_blessed[ $cter-1 ] and $biblios_blessed[ $cter-1 ]->biblionumber){
331
            $newSuggestion->{ "biblionumber".$cter }=$biblios_blessed[ $cter-1 ]->biblionumber;
332
        }
333
        $cter--;
334
    }
335
    if ( $local_suggestions ){
336
        Koha::Reading_suggestions->find( $biblionumber )->delete();
337
    }
338
    Koha::Reading_suggestion->new( $newSuggestion )->store;
339
}
89
}
340
90
341
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
91
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
Lines 348-353 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
348
    }
98
    }
349
);
99
);
350
$template->param( JacketImage => 1);
100
$template->param( JacketImage => 1);
351
$template->param( suggestions => \@biblios );
101
$template->param( suggestions => $biblios_ref );
352
102
353
output_with_http_headers $input, $cookie, $template->output, 'json';
103
output_with_http_headers $input, $cookie, $template->output, 'json';
(-)a/t/Koha/Util/Normalize.t (-2 / +301 lines)
Lines 17-31 Link Here
17
17
18
use Modern::Perl;
18
use Modern::Perl;
19
19
20
use Test::More tests => 6;
20
use Test::More tests => 14;
21
use Test::Warn;
21
use Test::Warn;
22
use C4::Koha;
22
23
23
BEGIN {
24
BEGIN {
24
    use_ok('Koha::Util::Normalize');
25
    use_ok('Koha::Util::Normalize');
25
}
26
}
26
27
27
subtest 'pass undef' => sub {
28
subtest 'pass undef' => sub {
28
    plan tests => 8;
29
    plan tests => 24;
29
30
30
    is( legacy_default(), undef, 'legacy_default returns undef' );
31
    is( legacy_default(), undef, 'legacy_default returns undef' );
31
    warning_is { legacy_default() } undef, 'no warn from legacy_default';
32
    warning_is { legacy_default() } undef, 'no warn from legacy_default';
Lines 38-43 subtest 'pass undef' => sub { Link Here
38
39
39
    is( lower_case(), undef, 'lower_case returns undef' );
40
    is( lower_case(), undef, 'lower_case returns undef' );
40
    warning_is { lower_case() } undef, 'no warn from lower_case';
41
    warning_is { lower_case() } undef, 'no warn from lower_case';
42
43
    is( NormalizeISMN(), undef, 'NormalizeISMN returns undef' );
44
    warning_is { NormalizeISMN() } undef, 'no warn from NormalizeISMN';
45
46
    is( NormalizeISRC(), undef, 'NormalizeISRC returns undef' );
47
    warning_is { NormalizeISRC() } undef, 'no warn from NormalizeISRC';
48
49
    is( NormalizeISRN(), undef, 'NormalizeISRN returns undef' );
50
    warning_is { NormalizeISRN() } undef, 'no warn from NormalizeISRN';
51
52
    is( NormalizeISBNs(), undef, 'NormalizeISBNs returns undef' );
53
    warning_is { NormalizeISBNs() } undef, 'no warn from NormalizeISBNs';
54
55
    is( NormalizeISSNs(), undef, 'NormalizeISSNs returns undef' );
56
    warning_is { NormalizeISSNs() } undef, 'no warn from NormalizeISSNs';
57
58
    is( NormalizeISMNs(), undef, 'NormalizeISMNs returns undef' );
59
    warning_is { NormalizeISMNs() } undef, 'no warn from NormalizeISMNs';
60
61
    is( NormalizeISRNs(), undef, 'NormalizeISRNs returns undef' );
62
    warning_is { NormalizeISRNs() } undef, 'no warn from NormalizeISRNs';
63
64
    is( NormalizeISRCs(), undef, 'NormalizeISRCs returns undef' );
65
    warning_is { NormalizeISRCs() } undef, 'no warn from NormalizeISRCs';
41
};
66
};
42
67
43
68
Lines 82-84 subtest 'lower_case() normalizer' => sub { Link Here
82
        'The \'lower_case\' normalizer only makes characters lower-case' );
107
        'The \'lower_case\' normalizer only makes characters lower-case' );
83
};
108
};
84
109
110
subtest 'NormalizeISMN() normalizer' => sub {
111
112
    plan tests => 25;
113
114
    my $string = '979-0-2600-0043-8';
115
116
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-8',
117
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-13' );
118
119
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '9790260000438',
120
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-13' );
121
122
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-8',
123
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-13' );
124
125
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M260000438',
126
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-13' );
127
128
    $string = 'M-2600-0043-8';
129
130
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-8',
131
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-10' );
132
133
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '9790260000438',
134
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-10' );
135
136
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-8',
137
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-10' );
138
139
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M260000438',
140
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-10' );
141
142
    $string = '  .; kY[]:,  (l)/E\'"';
143
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), undef,
144
        'NormalizeISMN correctly return undef is the parameter does not look like an ISMN' );
145
146
    $string = '979-0-2600-0043-X';
147
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-X',
148
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-10 : edge case checksum=X' );
149
150
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '979026000043X',
151
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-10 : edge case checksum=X' );
152
153
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-X',
154
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case checksum=X' );
155
156
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M26000043X',
157
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case checksum=X' );
158
159
    $string = '979-0-2600-0043-8-';
160
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-8',
161
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-10 : edge case trailing -' );
162
163
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '9790260000438',
164
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-10 : edge case trailing -' );
165
166
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-8',
167
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case trailing -' );
168
169
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M260000438',
170
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case trailing -' );
171
172
    $string = '-979-0-2600-0043-8';
173
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-8',
174
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-10 : edge case leading -' );
175
176
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '9790260000438',
177
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-10 : edge case leading -' );
178
179
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-8',
180
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case leading -' );
181
182
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M260000438',
183
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case leading -' );
184
185
    $string = '979-0-2600-0043--8';
186
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2600-0043-8',
187
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-13 from an ISMN-10 : edge case double -' );
188
189
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-13' }  ), '9790260000438',
190
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-13 from and ISMN-10 : edge case double -' );
191
192
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2600-0043-8',
193
        'NormalizeISMN correctly leave hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case double -' );
194
195
    is( Koha::Util::Normalize::NormalizeISMN( { ismn => $string, strip_hyphens => 1, format => 'ISMN-10' }  ), 'M260000438',
196
        'NormalizeISMN correctly strip hyphens and correctly format the ISMN-10 from an ISMN-10 : edge case double -' );
197
};
198
199
subtest 'NormalizeISRC() normalizer' => sub {
200
201
    plan tests => 9;
202
203
    my $string = 'FR-R09-12-40970';
204
205
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 0 }  ), 'FR-R09-12-40970',
206
        'NormalizeISRC correctly leave hyphens' );
207
208
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 1 }  ), 'FRR091240970',
209
        'NormalizeISRC correctly strip hyphens' );
210
211
    $string = '  .; kY[]:,  (l)/E\'"';
212
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 1 }  ), undef,
213
        'NormalizeISRC correctly return undef is the parameter does not look like an ISRC' );
214
215
    $string = 'FR-R09-12--40970';
216
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 1 }  ), 'FRR091240970',
217
        'NormalizeISRC correctly return the ISRC without hyphens : edge case double -' );
218
219
    $string = 'FR-R09--12-40970';
220
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 0 }  ), 'FR-R09-12-40970',
221
        'NormalizeISRC correctly return the ISRC with hyphens : edge case leading -' );
222
223
    $string = 'FR-R09-12-40970-';
224
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 1 }  ), 'FRR091240970',
225
        'NormalizeISRC correctly return the ISRC without hyphens : edge case trailing -' );
226
227
    $string = '-FR-R09-12-40970';
228
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 0 }  ), 'FR-R09-12-40970',
229
        'NormalizeISRC correctly return the ISRC with hyphens : edge case leading -' );
230
231
    $string = '-FR-R09-12-40970';
232
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 1 }  ), 'FRR091240970',
233
        'NormalizeISRC correctly return the ISRC without hyphens  : edge case leading -' );
234
235
    $string = '-FR-R09-12-40970';
236
    is( Koha::Util::Normalize::NormalizeISRC( { isrc => $string, strip_hyphens => 0 }  ), 'FR-R09-12-40970',
237
        'NormalizeISRC correctly return the ISRC with hyphens : edge case leading -' );
238
239
240
};
241
242
subtest 'NormalizeISRN() normalizer' => sub {
243
244
    plan tests => 14;
245
246
    my $string = 'METPRO/CB/TR--74/216+PR.ENVR.WI';
247
248
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 0 }  ), 'METPRO/CB/TR--74/216+PR.ENVR.WI',
249
        'NormalizeISRN correctly leave slash and correclty leave local suffix' );
250
251
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 0 }  ), 'METPRO_CB_TR--74_216+PR.ENVR.WI',
252
        'NormalizeISRC correctly convert slash and correctly leave local suffix' );
253
254
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 1 }  ), 'METPRO/CB/TR--74/216',
255
        'NormalizeISRC correctly leave slash and correctly drop local suffix' );
256
257
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 1 }  ), 'METPRO_CB_TR--74_216',
258
        'NormalizeISRC correctly convert slash and correctly drop local suffix' );
259
260
    $string = '  .; kY[]:,  (l)/E\'"';
261
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 1 }  ), undef,
262
        'NormalizeISRC correctly return undef is the parameter does not look like an ISRN' );
263
264
    $string = '-METPRO/CB/TR--74/216+PR.ENVR.WI';
265
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 0 }  ), 'METPRO/CB/TR--74/216+PR.ENVR.WI',
266
        'NormalizeISRN correctly leave slash and correclty leave local suffix : edge case leading -' );
267
268
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 0 }  ), 'METPRO_CB_TR--74_216+PR.ENVR.WI',
269
        'NormalizeISRC correctly convert slash and correctly leave local suffix : edge case leading -' );
270
271
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 1 }  ), 'METPRO/CB/TR--74/216',
272
        'NormalizeISRC correctly leave slash and correctly drop local suffix : edge case leading -' );
273
274
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 1 }  ), 'METPRO_CB_TR--74_216',
275
        'NormalizeISRC correctly convert slash and correctly drop local suffix : edge case leading -' );
276
277
278
    $string = 'METPRO/CB/TR--74/216+PR.ENVR.WI-';
279
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 0 }  ), 'METPRO/CB/TR--74/216+PR.ENVR.WI',
280
        'NormalizeISRN correctly leave slash and correclty leave local suffix : edge case trailing -' );
281
282
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 0 }  ), 'METPRO_CB_TR--74_216+PR.ENVR.WI',
283
        'NormalizeISRC correctly convert slash and correctly leave local suffix  : edge case trailing -' );
284
285
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 1 }  ), 'METPRO/CB/TR--74/216',
286
        'NormalizeISRC correctly leave slash and correctly drop local suffix  : edge case trailing -' );
287
288
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 1, drop_local_suffix => 1 }  ), 'METPRO_CB_TR--74_216',
289
        'NormalizeISRC correctly convert slash and correctly drop local suffix  : edge case trailing -' );
290
291
292
    $string = 'METPRO/CB/TR---74/216+PR.ENVR.WI';
293
    is( Koha::Util::Normalize::NormalizeISRN( { isrn => $string, convert_slash => 0, drop_local_suffix => 1 }  ), undef,
294
        'NormalizeISRC correctly return undef is the parameter does not look like an ISRN : edge case triple -' );
295
296
};
297
298
subtest 'NormalizeISBNs() normalizer' => sub {
299
300
    plan tests => 4;
301
302
    my $string = '9782379891113 | 978-0-321-49694-2 | 4274 | 2379891117 | 0-321-49694-9 | 542';
303
304
    is( Koha::Util::Normalize::NormalizeISBNs( { isbns => $string, pattern => ' \| ', strip_hyphens => 0, format => 'ISBN-13' }  ), '978-2-37989-111-3 978-0-321-49694-2 978-2-37989-111-3 978-0-321-49694-2',
305
        'NormalizeISBNs correctly normalize all id, leave hyphens and format ISBN-13' );
306
307
    is( Koha::Util::Normalize::NormalizeISBNs( { isbns => $string, pattern => ' \| ', strip_hyphens => 1, format => 'ISBN-13' }  ), '9782379891113 9780321496942 9782379891113 9780321496942',
308
        'NormalizeISBNs correctly normalize all id, strip hyphens and format ISBN-13' );
309
310
    is( Koha::Util::Normalize::NormalizeISBNs( { isbns => $string, pattern => ' \| ', strip_hyphens => 0, format => 'ISBN-10' }  ), '2-37989-111-7 0-321-49694-9 2-37989-111-7 0-321-49694-9',
311
        'NormalizeISBNs correctly normalize all id, leave hyphens and format ISBN-10' );
312
313
    is( Koha::Util::Normalize::NormalizeISBNs( { isbns => $string, pattern => ' \| ', strip_hyphens => 1, format => 'ISBN-10' }  ), '2379891117 0321496949 2379891117 0321496949',
314
        'NormalizeISBNs correctly normalize all id, strip hyphens and format ISBN-10' );
315
316
};
317
318
subtest 'NormalizeISSNs() normalizer' => sub {
319
320
    plan tests => 2;
321
322
    my $string = '03354725 | 1445 | 0220-1186 | 542';
323
324
    is( Koha::Util::Normalize::NormalizeISSNs( { issns => $string, pattern => ' \| ', strip_hyphens => 0 }  ), '0335-4725 0220-1186',
325
        'NormalizeISSNs correctly normalize all id, leave hyphens' );
326
327
    is( Koha::Util::Normalize::NormalizeISSNs( { issns => $string, pattern => ' \| ', strip_hyphens => 1 }  ), '03354725 02201186',
328
        'NormalizeISSNs correctly normalize all id, strip hyphens' );
329
};
330
331
subtest 'NormalizeISMNs() normalizer' => sub {
332
333
    plan tests => 4;
334
335
    my $string = 'M-2309-7938-2 | 979-0-2309-7938-2 | 54 | M230971010 | 9790230971010 | 542';
336
337
    is( Koha::Util::Normalize::NormalizeISMNs( { ismns => $string, pattern => ' \| ', strip_hyphens => 0, format => 'ISMN-13' }  ), '979-0-2309-7938-2 979-0-2309-7938-2 9790230971010 9790230971010',
338
        'NormalizeISMNs correctly normalize all id, leave hyphens and format ISMN-13' );
339
340
    is( Koha::Util::Normalize::NormalizeISMNs( { ismns => $string, pattern => ' \| ', strip_hyphens => 1, format => 'ISMN-13' }  ), '9790230979382 9790230979382 9790230971010 9790230971010',
341
        'NormalizeISMNs correctly normalize all id, strip hyphens and format ISMN-13' );
342
343
    is( Koha::Util::Normalize::NormalizeISMNs( { ismns => $string, pattern => ' \| ', strip_hyphens => 0, format => 'ISMN-10' }  ), 'M-2309-7938-2 M-2309-7938-2 M230971010 M230971010',
344
        'NormalizeISMNs correctly normalize all id, leave hyphens and format ISMN-10' );
345
346
    is( Koha::Util::Normalize::NormalizeISMNs( { ismns => $string, pattern => ' \| ', strip_hyphens => 1, format => 'ISMN-10' }  ), 'M230979382 M230979382 M230971010 M230971010',
347
        'NormalizeISMNs correctly normalize all id, strip hyphens and format ISMN-10' );
348
349
};
350
351
subtest 'NormalizeISRCs() normalizer' => sub {
352
353
    plan tests => 2;
354
355
    my $string = 'FR-R09-12-40970 | 585 | FR6042000056 | 564';
356
357
    is( Koha::Util::Normalize::NormalizeISRCs( { isrcs => $string, pattern => ' \| ', strip_hyphens => 0 }  ), 'FR-R09-12-40970 FR6042000056',
358
        'NormalizeISRCs correctly normalize all id, leave hyphens' );
359
360
    is( Koha::Util::Normalize::NormalizeISRCs( { isrcs => $string, pattern => ' \| ', strip_hyphens => 1 }  ), 'FRR091240970 FR6042000056',
361
        'NormalizeISRCs correctly normalize all id, strip hyphens' );
362
363
};
364
365
subtest 'NormalizeISRNs() normalizer' => sub {
366
367
    plan tests => 4;
368
369
    my $string = 'METPRO/CB/TR--74/216+PR.ENVR.WI | 4536er | COUCOU/ICI--00-45 | 542';
370
371
    is( Koha::Util::Normalize::NormalizeISRNs( { isrns => $string, pattern => ' \| ', convert_slash => 0, drop_local_suffix => 0 }  ), 'METPRO/CB/TR--74/216+PR.ENVR.WI COUCOU/ICI--00-45',
372
        'NormalizeISRNs correctly normalize all id, leave slash, leave local suffix' );
373
374
    is( Koha::Util::Normalize::NormalizeISRNs( { isrns => $string, pattern => ' \| ', convert_slash => 0, drop_local_suffix => 1 }  ), 'METPRO/CB/TR--74/216 COUCOU/ICI--00-45',
375
        'NormalizeISMNs correctly normalize all id, leave slash, drop local suffix' );
376
377
    is( Koha::Util::Normalize::NormalizeISRNs( { isrns => $string, pattern => ' \| ', convert_slash => 1, drop_local_suffix => 0 }  ), 'METPRO_CB_TR--74_216+PR.ENVR.WI COUCOU_ICI--00-45',
378
        'NormalizeISMNs correctly normalize all id, convert slash, leave local suffix' );
379
380
    is( Koha::Util::Normalize::NormalizeISRNs( { isrns => $string, pattern => ' \| ', convert_slash => 1, drop_local_suffix => 1 }  ), 'METPRO_CB_TR--74_216 COUCOU_ICI--00-45',
381
        'NormalizeISMNs correctly normalize all id, convert slash, drop local suffix' );
382
383
};
(-)a/t/db_dependent/Koha/SharedContent.t (-5 / +674 lines)
Lines 1-5 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2016 BibLibre Morgane Alonso
1
# Copyright 2016 BibLibre Morgane Alonso
4
#
2
#
5
# This file is part of Koha
3
# This file is part of Koha
Lines 23-32 use t::lib::TestBuilder; Link Here
23
use t::lib::Mocks;
21
use t::lib::Mocks;
24
use Test::MockModule;
22
use Test::MockModule;
25
use Test::MockObject;
23
use Test::MockObject;
26
use Test::More tests => 45;
24
use Test::More tests => 49;
25
use Test::Exception;
27
use Koha::Database;
26
use Koha::Database;
28
use Koha::Patrons;
27
use Koha::Patrons;
29
use Koha::Subscriptions;
28
use Koha::Subscriptions;
29
use Koha::DateUtils qw(dt_from_string);
30
use Koha::Util::Normalize;
31
use Koha::Reading_suggestions;
30
32
31
use HTTP::Status qw(:constants :is status_message);
33
use HTTP::Status qw(:constants :is status_message);
32
34
Lines 42-48 my $post_request = 0; Link Here
42
my $query = {};
44
my $query = {};
43
45
44
t::lib::Mocks::mock_config( 'mana_config', 'https://foo.bar');
46
t::lib::Mocks::mock_config( 'mana_config', 'https://foo.bar');
45
46
is(Koha::SharedContent::get_sharing_url(), 'https://foo.bar', 'Mana URL');
47
is(Koha::SharedContent::get_sharing_url(), 'https://foo.bar', 'Mana URL');
47
48
48
my $result = Koha::SharedContent::search_entities('report', $query);
49
my $result = Koha::SharedContent::search_entities('report', $query);
Lines 240-243 is($query{resource}, 'subscription', 'Check ressource'); Link Here
240
241
241
is($request->uri->path, '/subscription/12.json/increment/foo', 'Path is subscription');
242
is($request->uri->path, '/subscription/12.json/increment/foo', 'Path is subscription');
242
243
244
# Reading pair.
245
my $record1 = MARC::Record->new();
246
my $record2 = MARC::Record->new();
247
my $record3 = MARC::Record->new();
248
my $record4 = MARC::Record->new();
249
250
my $id1 = '9783161484100';
251
my $id2 = '9780321496942';
252
my $id3 = '9780914378266';
253
my $id4 = '9780491001304';
254
255
my $field1 = MARC::Field->new('020','','','a' => $id1);
256
my $field2 = MARC::Field->new('020','','','a' => $id2);
257
my $field3 = MARC::Field->new('020','','','a' => $id3);
258
my $field4 = MARC::Field->new('020','','','a' => $id4);
259
260
$record1->append_fields( $field1 );
261
$record2->append_fields( $field2 );
262
$record3->append_fields( $field3 );
263
$record4->append_fields( $field4 );
264
265
my %biblionumbers;
266
my ($biblionumber1) = C4::Biblio::AddBiblio($record1, '');
267
$biblionumbers{biblio1} = $biblionumber1;
268
my ($biblionumber2) = C4::Biblio::AddBiblio($record2, '');
269
$biblionumbers{biblio2} = $biblionumber2;
270
my ($biblionumber3) = C4::Biblio::AddBiblio($record3, '');
271
$biblionumbers{biblio3} = $biblionumber3;
272
my ($biblionumber4) = C4::Biblio::AddBiblio($record4, '');
273
$biblionumbers{biblio4} = $biblionumber4;
274
275
my $biblio1 = Koha::Biblios->find( $biblionumber1 );
276
my $biblio2 = Koha::Biblios->find( $biblionumber2 );
277
my $biblio3 = Koha::Biblios->find( $biblionumber3 );
278
my $biblio4 = Koha::Biblios->find( $biblionumber4 );
279
280
my $item1_0 = $builder->build({source => 'Item', value => {
281
        biblionumber => $biblio1->biblionumber
282
    }
283
});
284
my $item1_1 = $builder->build({source => 'Item', value => {
285
        biblionumber => $biblio1->biblionumber
286
    }
287
});
288
my $item1_2 = $builder->build({source => 'Item', value => {
289
        biblionumber => $biblio1->biblionumber
290
    }
291
});
292
my $item1_3 = $builder->build({source => 'Item', value => {
293
        biblionumber => $biblio1->biblionumber
294
    }
295
});
296
my $item1_4 = $builder->build({source => 'Item', value => {
297
        biblionumber => $biblio1->biblionumber
298
    }
299
});
300
my $item1_5 = $builder->build({source => 'Item', value => {
301
        biblionumber => $biblio1->biblionumber
302
    }
303
});
304
my $item2_0 = $builder->build({source => 'Item', value => {
305
        biblionumber => $biblio2->biblionumber
306
    }
307
});
308
my $item3_0 = $builder->build({source => 'Item', value => {
309
        biblionumber => $biblio3->biblionumber
310
    }
311
});
312
my $item4_0 = $builder->build({source => 'Item', value => {
313
        biblionumber => $biblio4->biblionumber
314
    }
315
});
316
my $item3_1 = $builder->build({source => 'Item', value => {
317
        biblionumber => $biblio3->biblionumber
318
    }
319
});
320
321
my $item4_1 = $builder->build({source => 'Item', value => {
322
        biblionumber => $biblio4->biblionumber
323
    }
324
});
325
326
327
my $now=DateTime->now()->strftime('%F');
328
my $yesterday = DateTime->now()->add(days => -1)->strftime('%F');
329
330
my $issue1 = $builder->build({source => 'Issue', value => {
331
        itemnumber => $item1_0->{itemnumber},
332
        issuedate => $now
333
    }
334
});
335
#issue1 and issue2 test if we create a pair between todays issues and an older one
336
my $issue2 = $builder->build({source => 'Issue', value => {
337
        borrowernumber => $issue1->{borrowernumber},
338
        itemnumber => $item2_0->{itemnumber},
339
        issuedate => $yesterday
340
    }
341
});
342
my $issue3 = $builder->build({source => 'Issue', value => {
343
        itemnumber => $item3_0->{itemnumber},
344
        issuedate => $now
345
    }
346
});
347
#issue3 and issue4 test if we create a pair between 2 todays issues (and not mixing borrowers)
348
my $issue4 = $builder->build({source => 'Issue', value => {
349
        borrowernumber => $issue3->{borrowernumber},
350
        itemnumber => $item4_0->{itemnumber},
351
        issuedate => $now
352
    }
353
});
354
#issue1 and issue5 test if we can create more than one pair for a single borrower
355
my $issue5 = $builder->build({source => 'Issue', value => {
356
        borrowernumber => $issue1->{borrowernumber},
357
        itemnumber => $item3_1->{itemnumber},
358
        issuedate => $yesterday
359
    }
360
});
361
#issue6 test if a borrower with a single issues does not create any pair
362
my $issue6 = $builder->build({source => 'Issue', value => {
363
        itemnumber => $item1_1->{itemnumber},
364
        issuedate => $now
365
    }
366
});
367
368
#issue1 and issue7 test pairs are created between todays issues and old_issues table
369
my $issue7 = $builder->build({source => 'OldIssue', value => {
370
        borrowernumber => $issue1->{borrowernumber},
371
        itemnumber => $item4_1->{itemnumber},
372
        issuedate => $yesterday
373
    }
374
});
375
my $issue8 = $builder->build({source => 'OldIssue', value => {
376
        itemnumber => $item1_0->{itemnumber},
377
        issuedate => $now
378
    }
379
});
380
#issue8 and issue9 test that no pairs are created between old_issues issues
381
my $issue9 = $builder->build({source => 'OldIssue', value => {
382
        borrowernumber => $issue8->{borrowernumber},
383
        itemnumber => $item2_0->{itemnumber},
384
        issuedate => $yesterday
385
    }
386
});
387
388
my $issue10 = $builder->build({source => 'Issue', value => {
389
        itemnumber => $item1_2->{itemnumber},
390
        issuedate => $now
391
    }
392
});
393
#issue10 and issue11 test that no pairs are created between same biblio
394
my $issue11 = $builder->build({source => 'Issue', value => {
395
        borrowernumber => $issue10->{borrowernumber},
396
        itemnumber => $item1_3->{itemnumber},
397
        issuedate => $yesterday
398
    }
399
});
400
401
my $issue12 = $builder->build({source => 'Issue', value => {
402
        itemnumber => $item1_4->{itemnumber},
403
        issuedate => $yesterday
404
    }
405
});
406
#issue12 and issue13 test that no pairs are created between two issues from yesterday
407
my $issue13 = $builder->build({source => 'Issue', value => {
408
        borrowernumber => $issue12->{borrowernumber},
409
        itemnumber => $item1_5->{itemnumber},
410
        issuedate => $yesterday
411
    }
412
});
413
414
415
416
417
my $issue_50 = $builder->build({source => 'Issue', value => {
418
        issuedate => $now
419
    }
420
});
421
422
#creating more than 50 issues for a specific borrower to check if, as expected, no pairs are created for this borrower
423
for (my $i = 0; $i <= 50; $i++){
424
    $builder->build({source => 'Issue', value => {
425
        borrowernumber => $issue6->{borrowernumber},
426
        issuedate => $now
427
    }});
428
};
429
430
431
432
my @reading_pairs = Koha::SharedContent::extract_reading_pairs();
433
subtest 'Create pair' => sub {
434
    plan tests => 5;
435
436
    is($#reading_pairs, 3, "There are four pairs as exepected");
437
438
    subtest '1st pair is as expected' => sub {
439
        plan tests => 4;
440
441
        is($reading_pairs[0]->{documentid1}, $id1, "1st pair documentid1 is $id1 as expected");
442
        is($reading_pairs[0]->{documentid2}, $id2, "1st pair documentid2 is $id2 as expected");
443
        is($reading_pairs[0]->{idtype1}, "isbn",  "1st pair idtype1 is isbn as expected");
444
        is($reading_pairs[0]->{idtype2}, "isbn", "1st pair idtype2 is isbn as expected");
445
    };
446
447
    subtest '2nd pair is as expected' => sub {
448
        plan tests => 4;
449
450
        is($reading_pairs[1]->{documentid1}, $id1, "2nd pair documentid1 is $id1 as expected");
451
        is($reading_pairs[1]->{documentid2}, $id3, "2nd pair documentid2 is $id3 as expected");
452
        is($reading_pairs[1]->{idtype1}, "isbn",  "2nd pair idtype1 is isbn as expected");
453
        is($reading_pairs[1]->{idtype2}, "isbn", "2nd pair idtype2 is isbn as expected");
454
    };
455
456
    subtest '3rd pair is as expected' => sub {
457
        plan tests => 4;
458
459
        is($reading_pairs[2]->{documentid1}, $id3, "3rd pair documentid1 is $id3 is as expected");
460
        is($reading_pairs[2]->{documentid2}, $id4, "3rd pair documentid2 is $id4 as expected");
461
        is($reading_pairs[2]->{idtype1}, "isbn",  "3rd pair idtype1 is isbn as expected");
462
        is($reading_pairs[2]->{idtype2}, "isbn", "3rd pair idtype2 is isbn as expected");
463
    };
464
465
    subtest '4th pair is as expected' => sub {
466
        plan tests => 4;
467
468
        is($reading_pairs[3]->{documentid1}, $id1, "4th pair documentid1 is $id4 as expected");
469
        is($reading_pairs[3]->{documentid2}, $id4, "4th pair documentid2 is $id4 as expected");
470
        is($reading_pairs[3]->{idtype1}, "isbn",  "4th pair idtype1 is isbn as expected");
471
        is($reading_pairs[3]->{idtype2}, "isbn", "4th pair idtype2 is isbn as expected");
472
    };
473
};
474
475
subtest 'get_identifier_field_marc' => sub {
476
    plan tests => 28;
477
478
    t::lib::Mocks::mock_preference( 'marcflavour', 'UNIMARC' );
479
    my ($fields_ref, $inds1_ref) = Koha::SharedContent::get_identifier_field_marc();
480
    is($fields_ref->{isbn}, "010", "UNIMARC isbn is in fields 010");
481
    is($fields_ref->{issn}, "011", "UNIMARC issn is in fields 011");
482
    is($fields_ref->{ismn}, "013", "UNIMARC ismn is in fields 013");
483
    is($fields_ref->{isrn}, "015", "UNIMARC isrn is in fields 015");
484
    is($fields_ref->{isrc}, "016", "UNIMARC isbn is in fields 016");
485
    is($fields_ref->{upc}, "072", "UNIMARC upc is in fields 072");
486
    is($fields_ref->{ean}, "073", "UNIMARC ean is in fields 073");
487
488
    is($inds1_ref->{isbn}, "", "UNIMARC isbn does not use inds1");
489
    is($inds1_ref->{issn}, "", "UNIMARC issn does not use inds1");
490
    is($inds1_ref->{ismn}, "", "UNIMARC ismn does not use inds1");
491
    is($inds1_ref->{isrn}, "", "UNIMARC isrn does not use inds1");
492
    is($inds1_ref->{isrc}, "", "UNIMARC isbn does not use inds1");
493
    is($inds1_ref->{upc}, "", "UNIMARC upc does not use inds1");
494
    is($inds1_ref->{ean}, "", "UNIMARC ean does not use inds1");
495
496
    t::lib::Mocks::mock_preference( 'marcflavour', 'MARC21' );
497
    ($fields_ref, $inds1_ref) = Koha::SharedContent::get_identifier_field_marc();
498
    is($fields_ref->{isbn}, "020", "MARC21 isbn is in fields 020");
499
    is($fields_ref->{issn}, "022", "MARC21 issn is in fields 022");
500
    is($fields_ref->{ismn}, "024", "MARC21 ismn is in fields 024");
501
    is($fields_ref->{isrn}, "027", "MARC21 isrn is in fields 027");
502
    is($fields_ref->{isrc}, "024", "MARC21 isbn is in fields 024");
503
    is($fields_ref->{upc}, "024", "MARC21 upc is in fields 024");
504
    is($fields_ref->{ean}, "024", "MARC21 ean is in fields 024");
505
506
    is($inds1_ref->{isbn}, "", "MARC21 isbn does not use inds1");
507
    is($inds1_ref->{issn}, "", "MARC21 issn does not use inds1");
508
    is($inds1_ref->{ismn}, " and \@ind1=\"2\"", "MARC21 ismn inds1 is 2");
509
    is($inds1_ref->{isrn}, "", "MARC21 isrn does not use inds1");
510
    is($inds1_ref->{isrc}, " and \@ind1=\"0\"", "MARC21 isbn inds1 is 0");
511
    is($inds1_ref->{upc}, " and \@ind1=\"1\"", "MARC21 upc inds1 is 1");
512
    is($inds1_ref->{ean}, " and \@ind1=\"3\"", "MARC21 ean inds1 is 3");
513
514
};
515
516
subtest 'Get identifiers' => sub {
517
    plan tests => 10;
518
519
    subtest '1 isbn' => sub {
520
        plan tests => 3;
521
522
        my $result = Koha::SharedContent::get_identifiers($biblio1->biblionumber);
523
        is($result->{idtype}, "isbn", "idtype");
524
        is($result->{documentids}, $id1, "documentid");
525
        is($result->{code}, 200, "code");
526
    };
527
528
    subtest '2 isbn' => sub {
529
        plan tests => 3;
530
531
        my $record = MARC::Record->new();
532
        my $ida = '9783161484100';
533
        my $idb = '9782765410058';
534
        my $fielda = MARC::Field->new('020','','','a' => $ida);
535
        my $fieldb = MARC::Field->new('020','','','a' => $idb);
536
        $record->append_fields( $fielda );
537
        $record->append_fields( $fieldb );
538
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
539
        $biblionumbers{isbn2} = $biblionumber;
540
541
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
542
        is($result->{idtype}, "isbn", "idtype");
543
        is($result->{documentids}, "$ida $idb", "documentids");
544
        is($result->{code}, 200, "code");
545
    };
546
547
    subtest '2 ean' => sub {
548
        plan tests => 3;
549
550
        my $ida = '9783161484100';
551
        my $idb = '9782266247306';
552
        my $record = MARC::Record->new();
553
        my $fielda = MARC::Field->new('024','3','','a' => $ida);
554
        my $fieldb = MARC::Field->new('024','3','','a' => $idb);
555
        $record->append_fields( $fielda );
556
        $record->append_fields( $fieldb );
557
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
558
        $biblionumbers{ean2} = $biblionumber;
559
560
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
561
        is($result->{idtype}, "ean", "idtype");
562
        is($result->{documentids}, "$ida $idb", "documentids");
563
        is($result->{code}, 200, "code");
564
    };
565
566
    subtest '2 issn' => sub {
567
        plan tests => 3;
568
569
        my $ida = '0335-4725';
570
        my $idb = '0151-0282';
571
        my $record = MARC::Record->new();
572
        my $fielda = MARC::Field->new('022','','','a' => $ida);
573
        my $fieldb = MARC::Field->new('022','','','a' => $idb);
574
        $record->append_fields( $fielda );
575
        $record->append_fields( $fieldb );
576
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
577
        $biblionumbers{issn2} = $biblionumber;
578
579
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
580
        is($result->{idtype}, "issn", "idtype");
581
        is($result->{documentids}, "$ida $idb", "documentids");
582
        is($result->{code}, 200, "code");
583
    };
584
585
    subtest '2 ismn' => sub {
586
        plan tests => 3;
587
588
        my $ida = '9790260000438';
589
        my $idb = '9790000001213';
590
        my $record = MARC::Record->new();
591
        my $fielda = MARC::Field->new('024','2','','a' => $ida);
592
        my $fieldb = MARC::Field->new('024','2','','a' => $idb);
593
        $record->append_fields( $fielda );
594
        $record->append_fields( $fieldb );
595
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
596
        $biblionumbers{ismn2} = $biblionumber;
597
598
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
599
        is($result->{idtype}, "ismn", "idtype");
600
        is($result->{documentids}, "$ida $idb", "documentids");
601
        is($result->{code}, 200, "code");
602
    };
603
604
    subtest '2 isrn' => sub {
605
        plan tests => 3;
606
607
        my $ida = 'METPRO-CB-TR--74-216';
608
        my $idb = 'COUCOU-ICI--00-45';
609
        my $record = MARC::Record->new();
610
        my $fielda = MARC::Field->new('027','','','a' => $ida);
611
        my $fieldb = MARC::Field->new('027','','','a' => $idb);
612
        $record->append_fields( $fielda );
613
        $record->append_fields( $fieldb );
614
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
615
        $biblionumbers{isrn2} = $biblionumber;
616
617
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
618
        is($result->{idtype}, "isrn", "idtype");
619
        is($result->{documentids}, "$ida $idb", "documentids");
620
        is($result->{code}, 200, "code");
621
    };
622
623
    subtest '2 isrc' => sub {
624
        plan tests => 3;
625
626
        my $ida = 'FRAB50712345';
627
        my $idb = 'FRR091240970';
628
        my $record = MARC::Record->new();
629
        my $fielda = MARC::Field->new('024','0','','a' => $ida);
630
        my $fieldb = MARC::Field->new('024','0','','a' => $idb);
631
        $record->append_fields( $fielda );
632
        $record->append_fields( $fieldb );
633
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
634
        $biblionumbers{isrc2} = $biblionumber;
635
636
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
637
        is($result->{idtype}, "isrc", "idtype");
638
        is($result->{documentids}, "$ida $idb", "documentids");
639
        is($result->{code}, 200, "code");
640
    };
641
642
    subtest '2 upc' => sub {
643
        plan tests => 3;
644
645
        my $ida = '036000291452';
646
        my $idb = '123601057072';
647
        my $record = MARC::Record->new();
648
        my $fielda = MARC::Field->new('024','1','','a' => $ida);
649
        my $fieldb = MARC::Field->new('024','1','','a' => $idb);
650
        $record->append_fields( $fielda );
651
        $record->append_fields( $fieldb );
652
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
653
        $biblionumbers{upc2} = $biblionumber;
654
655
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
656
        is($result->{idtype}, "upc", "idtype");
657
        is($result->{documentids}, "$ida $idb", "documentids");
658
        is($result->{code}, 200, "code");
659
    };
660
661
    subtest 'invalid isbn' => sub {
662
        plan tests => 2;
663
664
        my $ida = '=af~faf5efg thg';
665
        my $record = MARC::Record->new();
666
        my $fielda = MARC::Field->new('020','','','a' => $ida);
667
        $record->append_fields( $fielda );
668
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
669
        $biblionumbers{isbn_invalid} = $biblionumber;
670
671
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
672
        is($result->{code}, 404, "code");
673
        is($result->{message}, "No usable id found", "message");
674
    };
675
676
    subtest 'no id' => sub {
677
        plan tests => 2;
678
        my $record = MARC::Record->new();
679
        my ($biblionumber) = C4::Biblio::AddBiblio($record, '');
680
        $biblionumbers{no_id} = $biblionumber;
681
682
        my $result = Koha::SharedContent::get_identifiers($biblionumber);
683
        is($result->{code}, 404, "code");
684
        is($result->{message}, "No usable id found", "message");
685
    };
686
};
687
688
my $record5 = MARC::Record->new();
689
my $record6 = MARC::Record->new();
690
691
my $id5 = '9780596003067';
692
my $id6 = '9780596527211';
693
694
my $field5 = MARC::Field->new('024','3','','a' => $id5);
695
my $field6 = MARC::Field->new('020','','','a' => $id6);
696
697
$record5->append_fields( $field5 );
698
$record6->append_fields( $field6 );
699
700
my ($biblionumber5) = C4::Biblio::AddBiblio($record5, '');
701
$biblionumbers{biblio5} = $biblionumber5;
702
my ($biblionumber6) = C4::Biblio::AddBiblio($record6, '');
703
$biblionumbers{biblio6} = $biblionumber6;
704
705
print "bib5 = $biblionumber5, bib6=$biblionumber6\n";
706
my $item5_0 = $builder->build({source => 'Item', value => {
707
        biblionumber => $biblionumber5
708
    }
709
});
710
my $item6_0 = $builder->build({source => 'Item', value => {
711
        biblionumber => $biblionumber6
712
    }
713
});
714
715
sub mock_ask_mana_reading_suggestion {
716
    my ($params) = @_;
717
    my $start = $params->{start};
718
    my $end = $params->{end};
719
    my $code = $params->{code};
720
    my $msg = $params->{msg};
721
722
    if (!$start || !$end){
723
        return {code => $code, msg => $msg}
724
    };
725
726
    my @docs = (
727
        {idtype => "isbn", documentid => "9783161484100"}, #biblio1 0
728
        {idtype => "ean", documentid => "9783161484100"}, #biblio1 1
729
        {idtype => "isbn", documentid => "9780321496942"}, #biblio2 2
730
        {idtype => "issn", documentid => "0335-4725"}, #issn2 3
731
        {idtype => "ismn", documentid => "9790260000438"}, #ismn2 4
732
        {idtype => "isbn", documentid => "9780914378266"}, #biblio3 5
733
        {idtype => "isbn", documentid => "9780491001304"}, #biblio4 6
734
        {idtype => "ean", documentid => "9782259025669"}, #not in database 7
735
        {idtype => "isrn", documentid => "METPRO-CB-TR--74-216"}, #isrn2 8
736
        {idtype => "isrc", documentid => "FRAB50712345"}, #isrc2 9
737
        {idtype => "upc", documentid => "036000291452"}, #upc2 10
738
        {idtype => "isbn", documentid => "9782379891113"}, #not in datbase 11 
739
        {idtype => "ean", documentid => "9782266247306"}, #ean2 12
740
        {idtype => "ean", documentid => "9780596003067"}, #biblio5 13
741
        {idtype => "isbn", documentid => "9780596527211"}, #biblio6 14
742
    );
743
    my @slice = @docs[$start..$end];
744
    my $ref = \@slice;
745
746
    return {code => $code, data => $ref};
747
};
748
749
subtest 'get reading pair' => sub {
750
    plan tests => 7;
751
752
    subtest 'biblio1' => sub {
753
        plan tests => 12;
754
755
        my $module = Test::MockModule->new('Koha::SharedContent');
756
        $module->mock('ask_mana_reading_suggestion', sub {return mock_ask_mana_reading_suggestion{code => 200, start => 2, end => 14}});
757
        my $biblionumber = $biblionumbers{biblio1};
758
        my $local_suggestions;
759
        eval{
760
            $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
761
        };
762
763
        my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
764
        is($result->{code}, 200, "code ok");
765
        is($result->{data}[0]->{biblionumber}, $biblionumbers{biblio2}, "1st suggestion");
766
        is($result->{data}[1]->{biblionumber}, $biblionumbers{issn2}, "2nd suggestion");
767
        is($result->{data}[2]->{biblionumber}, $biblionumbers{ismn2}, "3rd suggestion");
768
        is($result->{data}[3]->{biblionumber}, $biblionumbers{biblio3}, "4th suggestion");
769
        is($result->{data}[4]->{biblionumber}, $biblionumbers{biblio4}, "5th suggestion");
770
        is($result->{data}[5]->{biblionumber}, $biblionumbers{isrn2}, "6th suggestion");
771
        is($result->{data}[6]->{biblionumber}, $biblionumbers{isrc2}, "7th suggestion");
772
        is($result->{data}[7]->{biblionumber}, $biblionumbers{upc2}, "8th suggestion");
773
        is($result->{data}[8]->{biblionumber}, $biblionumbers{ean2}, "9th suggestion");
774
        is($result->{data}[9]->{biblionumber}, $biblionumbers{biblio5}, "10th suggestion");
775
        is(exists($result->{data}[10]), '', "no 11th suggestion");
776
    };
777
778
779
    subtest 'biblio2' => sub {
780
        plan tests => 7;
781
782
        my $module = Test::MockModule->new('Koha::SharedContent');
783
        $module->mock('ask_mana_reading_suggestion', sub {return mock_ask_mana_reading_suggestion{code => 200, start => 5, end => 10}});
784
        my $biblionumber = $biblionumbers{biblio2};
785
        my $local_suggestions;
786
        eval{
787
            $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
788
        };
789
790
        my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
791
        is($result->{code}, 200, "code ok");
792
        is($result->{data}[0]->{biblionumber}, $biblionumbers{biblio3}, "1st suggestion");
793
        is($result->{data}[1]->{biblionumber}, $biblionumbers{biblio4}, "2nd suggestion");
794
        is($result->{data}[2]->{biblionumber}, $biblionumbers{isrn2}, "3rd suggestion");
795
        is($result->{data}[3]->{biblionumber}, $biblionumbers{isrc2}, "4th suggestion");
796
        is($result->{data}[4]->{biblionumber}, $biblionumbers{upc2}, "5th suggestion");
797
        is(exists($result->{data}[5]), '', "no 6th suggestion");
798
    };
799
800
    subtest 'biblio1 suggestion in koha db' => sub {
801
        plan tests => 11;
802
803
        my $dbh = C4::Context->dbh;
804
        my $db_query = q{
805
            SELECT
806
                biblionumber, biblionumber1, biblionumber2, biblionumber3, biblionumber4, biblionumber5, biblionumber6, biblionumber6, biblionumber7, biblionumber8, biblionumber9, biblionumber10
807
            FROM reading_suggestion
808
            WHERE
809
                biblionumber = '}.$biblionumbers{biblio1}.q{'
810
        };
811
        my $sth = $dbh->prepare( $db_query );
812
        $sth->execute;
813
        my $row = $sth->fetchrow_hashref;
814
815
        is($row->{biblionumber}, $biblionumbers{biblio1}, "biblionumber");
816
        is($row->{biblionumber1}, $biblionumbers{biblio2}, "biblionumber1");
817
        is($row->{biblionumber2}, $biblionumbers{issn2}, "biblionumber2");
818
        is($row->{biblionumber3}, $biblionumbers{ismn2}, "biblionumber3");
819
        is($row->{biblionumber4}, $biblionumbers{biblio3}, "biblionumber4");
820
        is($row->{biblionumber5}, $biblionumbers{biblio4}, "biblionumber5");
821
        is($row->{biblionumber6}, $biblionumbers{isrn2}, "biblionumber6");
822
        is($row->{biblionumber7}, $biblionumbers{isrc2}, "biblionumber7");
823
        is($row->{biblionumber8}, $biblionumbers{upc2}, "biblionumber8");
824
        is($row->{biblionumber9}, $biblionumbers{ean2}, "biblionumber9");
825
        is($row->{biblionumber10}, $biblionumbers{biblio5}, "biblionumber10");
826
    };
827
828
    subtest 'biblio2 suggestion in koha db' => sub {
829
        plan tests => 11;
830
831
        my $dbh = C4::Context->dbh;
832
        my $db_query = q{
833
            SELECT
834
                biblionumber, biblionumber1, biblionumber2, biblionumber3, biblionumber4, biblionumber5, biblionumber6, biblionumber6, biblionumber7, biblionumber8, biblionumber9, biblionumber10
835
            FROM reading_suggestion
836
            WHERE
837
                biblionumber = '}.$biblionumbers{biblio2}.q{'
838
        };
839
        my $sth = $dbh->prepare( $db_query );
840
        $sth->execute;
841
        my $row = $sth->fetchrow_hashref;
842
843
        is($row->{biblionumber}, $biblionumbers{biblio2}, "biblionumber");
844
        is($row->{biblionumber1}, $biblionumbers{biblio3}, "biblionumber1");
845
        is($row->{biblionumber2}, $biblionumbers{biblio4}, "biblionumber2");
846
        is($row->{biblionumber3}, $biblionumbers{isrn2}, "biblionumber3");
847
        is($row->{biblionumber4}, $biblionumbers{isrc2}, "biblionumber4");
848
        is($row->{biblionumber5}, $biblionumbers{upc2}, "biblionumber5");
849
        is($row->{biblionumber6}, undef, "biblionumber6");
850
        is($row->{biblionumber7}, undef, "biblionumber7");
851
        is($row->{biblionumber8}, undef, "biblionumber8");
852
        is($row->{biblionumber9}, undef, "biblionumber9");
853
        is($row->{biblionumber10}, undef, "biblionumber10");
854
    };
855
856
857
    subtest 'error code from mana with message' => sub {
858
        plan tests => 2;
859
860
        my $module = Test::MockModule->new('Koha::SharedContent');
861
        $module->mock('ask_mana_reading_suggestion', sub {return mock_ask_mana_reading_suggestion{code => 401, msg => "Error 401"}});
862
863
        my $biblionumber = $biblionumbers{biblio2};
864
        my $local_suggestions;
865
        eval{
866
            $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
867
        };
868
869
        my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
870
871
        is($result->{code}, 401, "code");
872
        is($result->{message}, "Error 401", "message");
873
    };
874
875
    subtest 'error code from mana' => sub {
876
        plan tests => 2;
877
878
        my $module = Test::MockModule->new('Koha::SharedContent');
879
        $module->mock('ask_mana_reading_suggestion', sub {return mock_ask_mana_reading_suggestion{code => 401}});
880
881
        my $biblionumber = $biblionumbers{biblio2};
882
        my $local_suggestions;
883
        eval{
884
            $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
885
        };
886
887
        my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
888
889
        is($result->{code}, 401, "code");
890
        is($result->{message}, undef, "message");
891
    };
892
893
    subtest 'error without code or message from mana' => sub {
894
        plan tests => 2;
895
896
        my $module = Test::MockModule->new('Koha::SharedContent');
897
        $module->mock('ask_mana_reading_suggestion', sub {return mock_ask_mana_reading_suggestion{}});
898
899
        my $biblionumber = $biblionumbers{biblio2};
900
        my $local_suggestions;
901
        eval{
902
            $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
903
        };
904
905
        my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
906
907
        is($result->{code}, 400, "code");
908
        is($result->{message}, "Unknown error", "message");
909
    };
910
911
};
912
243
$schema->storage->txn_rollback;
913
$schema->storage->txn_rollback;
244
- 

Return to bug 18618