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

(-)a/Koha/Biblio.pm (+13 lines)
Lines 893-898 sub to_api_mapping { Link Here
893
893
894
=cut
894
=cut
895
895
896
=head3 normalized_isbn
897
898
my $normalized_isbn = $biblio->normalizedisbn();
899
900
Return the normalized isbn of the biblio ( isbn-10 without hyphens )
901
902
=cut
903
904
sub normalized_isbn {
905
    my $self = shift;
906
    return NormalizeISBN({ isbn => $self->biblioitem->isbn, format => 'ISBN-10', strip_hyphens => 1 });
907
}
908
896
sub _type {
909
sub _type {
897
    return 'Biblio';
910
    return 'Biblio';
898
}
911
}
(-)a/Koha/Reading_suggestion.pm (+50 lines)
Line 0 Link Here
1
package Koha::Reading_suggestion;
2
3
# Copyright Biblibre 2017 - Baptiste Wojtkowski
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use Carp;
23
24
use Koha::Database;
25
use Koha::DateUtils qw( dt_from_string );
26
27
use base qw(Koha::Object);
28
29
30
=head1 NAME
31
32
Koha::Biblio - Koha Biblio Object class
33
34
=head1 API
35
36
=head2 Class Methods
37
38
=cut
39
40
sub _type {
41
    return 'ReadingSuggestion';
42
}
43
44
=head1 AUTHOR
45
46
Baptiste Wojtkowski <baptiste.wojtkowski@biblibre.com>
47
48
=cut
49
50
1;
(-)a/Koha/Reading_suggestions.pm (+58 lines)
Line 0 Link Here
1
package Koha::Reading_suggestions;
2
3
# Copiright Biblibre 2017 - Baptiste Wojtkowski
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Carp;
22
use Koha::Database;
23
use Koha::Reading_suggestion;
24
use base qw(Koha::Objects);
25
26
=head1 NAME
27
28
Koha::Reading_suggestions - Koha Reading_suggestion object set class
29
30
=head1 API
31
32
=head2 Class Methods
33
34
=cut
35
36
=head3 type
37
38
=cut
39
40
sub _type {
41
    return 'ReadingSuggestion';
42
}
43
44
=head3 object_class
45
46
=cut
47
48
sub object_class {
49
    return 'Koha::Reading_suggestion';
50
}
51
52
=head1 AUTHOR
53
54
Baptiste Wojtkowski <baptiste.wojtkowski@biblibre.com>
55
56
=cut
57
58
1
(-)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 (-1 / +386 lines)
Lines 18-23 package Koha::Util::Normalize; Link Here
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use Scalar::Util;
21
22
22
use parent qw( Exporter );
23
use parent qw( Exporter );
23
24
Lines 27-32 our @EXPORT = qw( Link Here
27
  upper_case
28
  upper_case
28
  lower_case
29
  lower_case
29
  ISBN
30
  ISBN
31
  NormalizeISMN
32
  NormalizeISRC
33
  NormalizeISRN
34
  NormalizeISBNs
35
  NormalizeISSNs
36
  NormalizeISMNs
37
  NormalizeISRNs
38
  NormalizeISRCs
30
);
39
);
31
40
32
=head1 NAME
41
=head1 NAME
Lines 121-131 sub ISBN { Link Here
121
    return $isbn;
130
    return $isbn;
122
}
131
}
123
132
133
=head2 NormalizeISMN
134
135
Normalization function converting ISMN strings to ISMN13
136
my $ismn = NormalizeISMN({
137
  ismn => $ismn,
138
  strip_hyphens => [0, 1],
139
  format => ['ISMN-10', 'ISMN-13']
140
});
141
142
=cut
143
sub NormalizeISMN{
144
    my ( $params ) = @_;
145
146
    my $string = $params->{ismn};
147
    my $strip_hyphens = $params->{strip_hyphens};
148
    my $format = $params->{format} || q{};
149
    my $return_invalid = $params->{return_invalid};
150
151
    return unless $string;
152
153
    my $ismn;
154
    $string =~ s/^-*//;
155
    $string =~ s/-*$//;
156
    $string =~ s/--+/-/;
157
    #test if the string seems valid
158
    if (is_ismn($string)){
159
        $ismn = $string;
160
    }
161
    #if the string seems valid
162
    if ($ismn){
163
        if ( $format eq 'ISMN-10' ) {
164
            #grab the first digit, if it's an "9" then the format is ISMN-13
165
            my $first = substr $ismn, 0, 1;
166
            #if the ismn is in ISMN-13 format
167
            if ($first eq "9"){
168
                #replace the prefix of ISMN-10 by the prefix of ISMN-13
169
                length($ismn)==17 ? $ismn =~ s/979-0-/M-/ : $ismn =~ s/9790/M/;
170
            }
171
        }
172
        elsif ($format eq 'ISMN-13' ) {
173
            #grab the first digit, if it's an "M" then the format is ISMN-10
174
            my $first = substr $ismn, 0, 1;
175
            #if the ismn is in ISMN-10 format
176
            if ($first eq "M"){
177
                #replace the prefix of ISMN-10 by the prefix of ISMN-13
178
                length($ismn)==13 ? $ismn =~ s/M-/979-0-/ : $ismn =~ s/M/9790/;
179
            }
180
        }
181
        if ($strip_hyphens) {
182
            $ismn =~ s/-//g;
183
        }
184
        return $ismn;
185
    }
186
    elsif($return_invalid){
187
        return $string;
188
    }
189
    else {
190
        return;
191
    }
192
}
193
194
=head2 is_ismn
195
196
Check if the string given looks like an ismn
197
198
=cut
199
200
sub is_ismn{
201
    my ( $string ) = @_;
202
203
    #check if length match the expected length of an ismn (with and withou hyphens)
204
    return 0 unless ( (length($string)==10) or (length($string)==13) or (length($string)==14) or length($string)==17 );
205
    #check if the pattern look like an ismn
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])$/ ) ;
207
208
    return 1
209
}
210
211
=head2 NormalizeISRC
212
213
Normalization function removing hyphens
214
my $isrc = NormalizeISRC({
215
  isrc => $isrc,
216
  strip_hyphens => [0, 1]
217
});
218
219
=cut
220
sub NormalizeISRC{
221
    my ( $params ) = @_;
222
223
    my $string = $params->{isrc};
224
    my $strip_hyphens = $params->{strip_hyphens};
225
    my $return_invalid = $params->{return_invalid};
226
227
    return unless $string;
228
229
    my $isrc;
230
    $string =~ s/^-*//;
231
    $string =~ s/-*$//;
232
    $string =~ s/--+/-/;
233
    #test if the string seems valid
234
    if (is_isrc($string)){
235
        $isrc = $string;
236
    }
237
    #if the string seems valid
238
    if ($isrc){
239
        if ($strip_hyphens) {
240
            $isrc =~ s/-//g;
241
        }
242
        return $isrc;
243
    }
244
    elsif($return_invalid){
245
        return $string;
246
    }
247
    else {
248
        return;
249
    }
250
}
251
252
=head2 is_isrc
253
254
Check if the string given looks like an isrc
255
256
=cut
257
258
sub is_isrc{
259
    my ( $string ) = @_;
260
261
    #check if length match the expected length of an isrc (with and withou hyphens)
262
    return 0 unless ( (length($string)==15) or (length($string)==12) );
263
    #check if the pattern look like an isrc
264
    return 0 unless ( $string =~ m/^([A-Z]{2}-\w{3}-\w{2}-\w{5})|(([A-Z]{2}\w{10}))$/ ) ;
265
266
    return 1
267
}
268
269
=head2 NormalizeISRN
270
271
Normalization function removing hyphens
272
my $isrn = NormalizeISRN({
273
  isrn => $isrn,
274
  convert_slash, => [0, 1],
275
  drop_local_suffix => [0, 1]
276
});
277
278
=cut
279
sub NormalizeISRN{
280
    my ( $params ) = @_;
281
282
    my $string = $params->{isrn};
283
    my $convert_slash = $params->{convert_slash};
284
    my $drop_local_suffix = $params->{drop_local_suffix};
285
    my $return_invalid = $params->{return_invalid};
286
287
    return unless $string;
288
289
    my $isrn;
290
    $string =~ s/^-*//;
291
    $string =~ s/-*$//;
292
    #test if the string seems valid
293
    if (is_isrn($string)){
294
        $isrn = $string;
295
    }
296
    #if the string seems valid
297
    if ($isrn){
298
        if($convert_slash){
299
            $isrn =~ s/\//_/g;
300
        }
301
        if($drop_local_suffix){
302
            $isrn =~ s/\+.*$//;
303
        }
304
        return $isrn;
305
    }
306
    elsif($return_invalid){
307
        return $string;
308
    }
309
    else {
310
        return;
311
    }
312
}
313
314
=head2 is_isrn
315
316
Check if the string given looks like an isrn
317
318
=cut
319
320
sub is_isrn{
321
    my ( $string ) = @_;
322
323
    my $truncated_string = $string;
324
    $truncated_string =~ s/\+.*$//;
325
    #check if length match the expected length of an isrn
326
    return 0 unless ( length($truncated_string)<=36 );
327
    #check if the pattern look like an isrn
328
    return 0 unless ( $string =~ m/^[A-Z](\w([\/-]\w+)?)*--(\d\d[\/-])?\d+([\/-]\w+)?(--[A-Z][A-Z])?(\+[A-Z0-9a-z,\.\/]+)?$/ );
329
    #check if each part has a valid length
330
    $string =~ m/^([\w\/-]+)--([\d\/-]+[\w\/-]*)(--[A-Z][A-Z])?(\+[A-Za-z0-9,\.\/]+)?$/;
331
    return 0 unless ( length($1)<=16 );
332
    return 0 unless ( length($2)<=14 );
333
334
    return 1
335
}
336
124
1;
337
1;
338
339
340
=head2 NormalizeISBNs
341
342
Normalization function normalizing a string with a list of ISBNs seperated by a given pattern
343
my $isbns = NormalizeISBNs({
344
  pattern => $pattern,
345
  isbns => $isbns,
346
  strip_hyphens => [0, 1]
347
  format => ['ISBN-10', 'ISBN-13']
348
});
349
350
=cut
351
352
sub NormalizeISBNs{
353
    my ( $params ) = @_;
354
355
    my $string = $params->{isbns};
356
    my $pattern = $params->{pattern};
357
    my $strip_hyphens = $params->{strip_hyphens};
358
    my $format = $params->{format} || q{};
359
    my $return_invalid = $params->{return_invalid};
360
361
    if ($string){
362
        my @isbn_list = split(/$pattern/, $string);
363
        my $result = "";
364
        foreach my $isbn (@isbn_list){
365
            my $normalized_isbn = C4::Koha::NormalizeISBN({ isbn => $isbn, format => $format, strip_hyphens => $strip_hyphens, return_invalid => $return_invalid });
366
            $result .= $normalized_isbn." " if ($normalized_isbn);
367
        }
368
        $result =~ s/ $//;
369
        return $result;
370
    } else {
371
        return;
372
    }
373
}
374
375
=head2 NormalizeISSNs
376
377
Normalization function normalizing a string with a list of ISSNs seperated by a given pattern
378
my $issns = NormalizeISSNs({
379
  issns => $issns,
380
  pattern => $pattern,
381
  strip_hyphens => [0, 1]
382
});
383
384
=cut
385
386
sub NormalizeISSNs{
387
    my ( $params ) = @_;
388
389
    my $string = $params->{issns};
390
    my $pattern = $params->{pattern};
391
    my $strip_hyphens = $params->{strip_hyphens};
392
393
    if ($string){
394
        my @issn_list = split(/$pattern/, $string);
395
        my $result = "";
396
        foreach my $issn (@issn_list){
397
            my $normalized_issn = C4::Koha::NormalizeISSN({ issn => $issn, strip_hyphen => $strip_hyphens });
398
            $result .= $normalized_issn." " if ($normalized_issn);
399
        }
400
        $result =~ s/ $//;
401
        return $result;
402
    } else {
403
        return;
404
    }
405
}
406
407
=head2 NormalizeISMNs
408
409
Normalization function normalizing a string with a list of ISMNs seperated by a given pattern
410
my $ismns = NormalizeISMNs({
411
  ismns => $ismns,
412
  pattern => $pattern,
413
  strip_hyphens => [0, 1]
414
  format => ['ISMN-10', 'ISMN-13']
415
});
416
417
=cut
418
419
sub NormalizeISMNs{
420
    my ( $params ) = @_;
421
422
    my $string = $params->{ismns};
423
    my $pattern = $params->{pattern};
424
    my $strip_hyphens = $params->{strip_hyphens};
425
    my $format = $params->{format} || q{};
426
    my $return_invalid = $params->{return_invalid};
427
428
    if ($string){
429
        my @ismn_list = split(/$pattern/, $string);
430
        my $result = "";
431
        foreach my $ismn (@ismn_list){
432
            my $normalized_ismn = Koha::Util::Normalize::NormalizeISMN({ ismn => $ismn, format => $format, strip_hyphens => $strip_hyphens, return_invalid => $return_invalid });
433
            $result .= $normalized_ismn." " if ($normalized_ismn);
434
        }
435
        $result =~ s/ $//;
436
        return $result;
437
    } else {
438
        return;
439
    }
440
}
441
442
=head2 NormalizeISRCs
443
444
Normalization function normalizing a string with a list of ISRCs seperated by a given pattern
445
my $isrcs = NormalizeISRCs({
446
  isrcs => $isrcs,
447
  pattern => $pattern,
448
  strip_hyphens => [0, 1]
449
});
450
451
=cut
452
453
sub NormalizeISRCs{
454
    my ( $params ) = @_;
455
456
    my $string = $params->{isrcs};
457
    my $pattern = $params->{pattern};
458
    my $strip_hyphens = $params->{strip_hyphens};
459
    my $return_invalid = $params->{return_invalid};
460
461
    if ($string){
462
        my @isrc_list = split(/$pattern/, $string);
463
        my $result = "";
464
        foreach my $isrc (@isrc_list){
465
            my $normalized_isrc = Koha::Util::Normalize::NormalizeISRC({ isrc => $isrc, strip_hyphens => $strip_hyphens, return_invalid => $return_invalid });
466
            $result .= $normalized_isrc." " if ($normalized_isrc);
467
        }
468
        $result =~ s/ $//;
469
        return $result;
470
    } else {
471
        return;
472
    }
473
}
474
475
=head2 NormalizeISRNs
476
477
Normalization function normalizing a string with a list of ISRNs seperated by a given pattern
478
my $isrns = NormalizeISRNs({
479
  isrns => $isrns,
480
  pattern => $pattern,
481
  convert_slash = [0, 1],
482
  drop_local_suffix = [0, 1]
483
});
484
485
=cut
486
487
sub NormalizeISRNs{
488
    my ( $params ) = @_;
489
490
    my $string = $params->{isrns};
491
    my $pattern = $params->{pattern};
492
    my $drop_local_suffix = $params->{drop_local_suffix};
493
    my $convert_slash = $params->{convert_slash};
494
    my $return_invalid = $params->{return_invalid};
495
496
    if ($string){
497
        my @isrn_list = split(/$pattern/, $string);
498
        my $result = "";
499
        foreach my $isrn (@isrn_list){
500
            my $normalized_isrn = Koha::Util::Normalize::NormalizeISRN({ isrn => $isrn, drop_local_suffix => $drop_local_suffix, convert_slash => $convert_slash, return_invalid => $return_invalid });
501
            $result .= $normalized_isrn." " if ($normalized_isrn);
502
        }
503
        $result =~ s/ $//;
504
        return $result;
505
    } else {
506
        return;
507
    }
508
}
509
510
125
__END__
511
__END__
126
512
127
=head1 AUTHOR
513
=head1 AUTHOR
128
129
Koha Development Team <http://koha-community.org/>
514
Koha Development Team <http://koha-community.org/>
130
515
131
Tomas Cohen Arazi <tomascohen@theke.io>
516
Tomas Cohen Arazi <tomascohen@theke.io>
(-)a/installer/data/mysql/atomicupdate/mana_add_table_reading_pairs.sql (+16 lines)
Line 0 Link Here
1
-- biblionumber1 not null otherwise the data is useless
2
CREATE TABLE `reading_suggestion` (
3
  `biblionumber` int(11) NOT NULL,
4
  `biblionumber1` int(11) NOT NULL,
5
  `biblionumber2` int(11) DEFAULT NULL,
6
  `biblionumber3` int(11) DEFAULT NULL,
7
  `biblionumber4` int(11) DEFAULT NULL,
8
  `biblionumber5` int(11) DEFAULT NULL,
9
  `biblionumber6` int(11) DEFAULT NULL,
10
  `biblionumber7` int(11) DEFAULT NULL,
11
  `biblionumber8` int(11) DEFAULT NULL,
12
  `biblionumber9` int(11) DEFAULT NULL,
13
  `biblionumber10` int(11) DEFAULT NULL,
14
  `timestamp` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP,
15
  PRIMARY KEY (`biblionumber`)
16
);
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/modules/mana/mana_suggestions.tt (+40 lines)
Line 0 Link Here
1
[% USE Koha %]
2
[% IF suggestions %]
3
    <table id="suggestions_tab" class="table table-bordered table-striped">
4
        <caption>[% issues_count %] Item(s) you should try</caption>
5
        <thead>
6
            <tr>
7
                <th class="nosort">Cover Image</th>
8
                <th class="anti-the">Title</th>
9
                <th>Author</th>
10
                <th>Publisher</th>
11
            </tr>
12
        </thead>
13
        <tbody>
14
            [% FOREACH suggestion IN suggestions %]
15
            <tr>
16
               <td class="jacketcell">
17
                [% IF ( Koha.Preference('OPACAmazonCoverImages') ) %]
18
19
                [% IF ( suggestion.normalized_isbn() ) %]
20
                    <a href="http://www.amazon.com/gp/reader/[% suggestion.normalized_isbn() %]/ref=sib_dp_pt/002-7879865-0184864#reader-link" title="View on Amazon.com"><img src="https://images-na.ssl-images-amazon.com/images/P/[% suggestion.normalized_isbn() %].01.THUMBZZZ.jpg" alt="View on Amazon.com" class="item-thumbnail"/></a>
21
                [% ELSE %]
22
                    <a href="#"><span class="no-image">No cover image available</span></a>
23
                [% END %]
24
                [% END %]
25
                </td>
26
                <td class="title">
27
                    <a class="title" href="/cgi-bin/koha/opac-detail.pl?biblionumber=[% suggestion.biblionumber %]">[% suggestion.title |html %] [% FOREACH subtitl IN suggestion.subtitles %] [% subtitl.subfield %][% END %]</a>
28
                </td>
29
                <td class="author">[% suggestion.author %]</td>
30
                </td>
31
                <td class="publisher">
32
                    <span class="publisher">[% suggestion.biblioitem.publishercode %]</td>
33
                </td>
34
            </tr>
35
            [% END # /FOREACH suggestions %]
36
        </tbody>
37
    </table>
38
[% ELSE %]
39
    <h1> There are no available suggestions on mana KB </h1>
40
[% END # IF suggestions %]
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-detail.tt (+28 lines)
Lines 589-594 Link Here
589
                            [% IF ( defaulttab == 'media' ) %]<li id="tab_html5media" class="ui-tabs-active">[% ELSE %]<li id="tab_html5media">[% END %]<a href="#html5media">Play media</a></li>
589
                            [% IF ( defaulttab == 'media' ) %]<li id="tab_html5media" class="ui-tabs-active">[% ELSE %]<li id="tab_html5media">[% END %]<a href="#html5media">Play media</a></li>
590
                        [% END %]
590
                        [% END %]
591
591
592
                        [% IF Koha.Preference( 'Mana' ) == 1 %]
593
                            <li id="tab_suggestions"><a href="#reading_suggestions">Suggestion </a></li>
594
                        [% END %]
592
                    </ul>
595
                    </ul>
593
596
594
                    [% IF ( serialcollection ) %]
597
                    [% IF ( serialcollection ) %]
Lines 881-886 Link Here
881
                        </div>
884
                        </div>
882
                    [% END # / IF LibraryThingForLibrariesID && LibraryThingForLibrariesTabbedView %]
885
                    [% END # / IF LibraryThingForLibrariesID && LibraryThingForLibrariesTabbedView %]
883
886
887
                    [% IF Koha.Preference( 'Mana' ) == 1 %]
888
                        <div id="reading_suggestions">
889
                        </div>
890
                    [% END # / IF Koha.Preference( 'Mana') ==1 %]
891
884
                    [% IF Koha.Preference( 'OPACComments' ) == 1 %]
892
                    [% IF Koha.Preference( 'OPACComments' ) == 1 %]
885
                        <div id="comments">
893
                        <div id="comments">
886
                            <div id="newcomment"></div>
894
                            <div id="newcomment"></div>
Lines 1851-1854 Link Here
1851
1859
1852
        }
1860
        }
1853
    </script>
1861
    </script>
1862
    [% IF Koha.Preference('Mana') %]
1863
        <script>
1864
            $("#reading_suggestions").html("");
1865
            $(document).ready( function(){
1866
                $( "#tab_suggestions" ).one( "click", function(){
1867
                    $.ajax({
1868
                        type: "POST",
1869
                        url: "/cgi-bin/koha/svc/mana/getSuggestion",
1870
                        data: { biblionumber : [% biblionumber %] },
1871
                        dataType: "html",
1872
                    } ).done( function( data ) {
1873
                        $( "#reading_suggestions" ).html(data)
1874
                    } ).fail( function( error, msg, longmsg ) {
1875
                        $( "#reading_suggestions" ).html( "<h1> An error occured: unknown error </h1>" )
1876
                    } );
1877
                });
1878
            });
1879
        </script>
1880
    [% END %]
1881
1854
[% END %]
1882
[% END %]
(-)a/misc/cronjobs/mana_send_pairs.pl (+48 lines)
Line 0 Link Here
1
#/!usr/bin/perl
2
use Modern::Perl;
3
4
use C4::Context;
5
use Getopt::Long;
6
use Koha;
7
use C4::Koha;
8
use Koha;
9
use Koha::Util::Normalize q/NormalizeISMN/;
10
11
use JSON;
12
use HTTP::Request;
13
use Koha::SharedContent;
14
15
my $help = 0;
16
17
GetOptions(
18
            'help|?'         => \$help,
19
);
20
21
if ($help){
22
    print "This script is used to send reading pairs to Mana KB.\nReading pairs are automatically extracted from Koha database.\n";
23
    exit;
24
};
25
26
#if mana is activated
27
if (C4::Context->preference("Mana") == 1){
28
    my @reading_pairs = Koha::SharedContent::extract_reading_pairs();
29
    my $content;
30
31
    #informations for mana
32
    my $MANA_IP=C4::Context->config("mana_config");
33
34
    my $securitytoken = C4::Context->preference('ManaToken');
35
    $content->{ securitytoken } = $securitytoken;
36
    $content->{ reading_pairs } = \@reading_pairs;
37
38
    my $url = "$MANA_IP/bulk/reading_pair.json";
39
    my $request = HTTP::Request->new( POST => $url );
40
41
    my $json = to_json( $content, { utf8 => 1 } );
42
    #print $json;
43
44
    #send to mana
45
    $request->content($json);
46
    my $result = Koha::SharedContent::process_request( $request );
47
    #print Data::Dumper::Dumper( $result );
48
}
(-)a/opac/svc/mana/getSuggestion (+103 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2017 BibLibre Baptiste Wojtkowski
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
#
20
21
use Modern::Perl;
22
use Koha::SharedContent;
23
use Koha::Biblioitems;
24
use Koha::Biblioitem;
25
use Koha::Reading_suggestions;
26
use Koha::Reading_suggestion;
27
use Koha::Util::Normalize q/NormalizeISMN/;
28
29
use Koha;
30
use C4::Koha;
31
use C4::Context;
32
use C4::Auth qw(check_cookie_auth), qw(get_template_and_user);
33
34
use List::MoreUtils qw(uniq);
35
36
use CGI;
37
use JSON;
38
39
use DateTime;
40
use DateTime::Format::MySQL;
41
use DateTime::Duration;
42
43
use constant DURATION_BEFORE_REFRESH => DateTime::Duration->new( weeks => 1 );
44
use C4::Output qw( output_with_http_headers );
45
my $input = CGI->new;
46
binmode STDOUT, ":encoding(UTF-8)";
47
48
49
50
51
my $biblionumber = $input->param( "biblionumber" );
52
53
#case we come with the script import_suggestions.pl
54
my $temp_biblionumber;
55
eval { $temp_biblionumber = from_json( $input->param( "POSTDATA" ) )->{biblionumber}; };
56
if ( $temp_biblionumber ){
57
    $biblionumber = $temp_biblionumber;
58
}
59
60
my $local_suggestions;
61
62
my $now;
63
my $timestamp;
64
my $duration;
65
#check it doesn't already have the informations localy stored
66
eval {
67
    $local_suggestions = Koha::Reading_suggestions->find( $biblionumber )->unblessed();
68
    $now = DateTime->now();
69
    $timestamp = DateTime::Format::MySQL->parse_timestamp( $local_suggestions->{timestamp} );
70
    $duration = $now - $timestamp;
71
};
72
my @biblios;
73
my $biblios_ref;
74
if ( $local_suggestions and DateTime::Duration->compare( $duration, DURATION_BEFORE_REFRESH ) == -1 ){
75
        delete $local_suggestions->{timestamp};
76
        delete $local_suggestions->{biblionumber};
77
        foreach my $key ( sort keys %{ $local_suggestions }){
78
            my $biblio = Koha::Biblios->find( $local_suggestions->{ $key } );
79
            push @biblios, $biblio->unblessed() if $biblio;
80
        }
81
        $biblios_ref = \@biblios;
82
}
83
84
else{
85
    my $result = Koha::SharedContent::get_reading_suggestion($biblionumber, $local_suggestions);
86
    if ($result->{code} == 200){
87
        $biblios_ref = $result->{data};
88
    };
89
}
90
91
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
92
    {
93
        template_name   => "mana/mana_suggestions.tt",
94
        query           => $input,
95
        type            => "opac",
96
        authnotrequired => 1,
97
        debug           => 1,
98
    }
99
);
100
$template->param( JacketImage => 1);
101
$template->param( suggestions => $biblios_ref );
102
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