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

(-)a/C4/Biblio.pm (-113 / +74 lines)
Lines 23-28 use Modern::Perl; Link Here
23
use Carp;
23
use Carp;
24
24
25
use Encode qw( decode is_utf8 );
25
use Encode qw( decode is_utf8 );
26
use List::MoreUtils qw( uniq );
26
use MARC::Record;
27
use MARC::Record;
27
use MARC::File::USMARC;
28
use MARC::File::USMARC;
28
use MARC::File::XML;
29
use MARC::File::XML;
Lines 717-723 sub GetBiblioData { Link Here
717
    return ($data);
718
    return ($data);
718
}    # sub GetBiblioData
719
}    # sub GetBiblioData
719
720
720
=head2 &GetBiblioItemData
721
=head2 GetBiblioItemData
721
722
722
  $itemdata = &GetBiblioItemData($biblioitemnumber);
723
  $itemdata = &GetBiblioItemData($biblioitemnumber);
723
724
Lines 728-734 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>. Link Here
728
729
729
=cut
730
=cut
730
731
731
#'
732
sub GetBiblioItemData {
732
sub GetBiblioItemData {
733
    my ($biblioitemnumber) = @_;
733
    my ($biblioitemnumber) = @_;
734
    my $dbh                = C4::Context->dbh;
734
    my $dbh                = C4::Context->dbh;
Lines 2542-2548 sub TransformHtmlToMarc { Link Here
2542
2542
2543
=head2 TransformMarcToKoha
2543
=head2 TransformMarcToKoha
2544
2544
2545
  $result = TransformMarcToKoha( $record, $frameworkcode )
2545
  $result = TransformMarcToKoha( $record, $frameworkcode, $limit )
2546
2546
2547
Extract data from a MARC bib record into a hashref representing
2547
Extract data from a MARC bib record into a hashref representing
2548
Koha biblio, biblioitems, and items fields. 
2548
Koha biblio, biblioitems, and items fields. 
Lines 2554-2664 hash_ref Link Here
2554
2554
2555
sub TransformMarcToKoha {
2555
sub TransformMarcToKoha {
2556
    my ( $record, $frameworkcode, $limit_table ) = @_;
2556
    my ( $record, $frameworkcode, $limit_table ) = @_;
2557
    $frameworkcode //= q{};
2558
    $limit_table //= q{};
2557
2559
2558
    my $result = {};
2560
    my $result = {};
2559
    if (!defined $record) {
2561
    if (!defined $record) {
2560
        carp('TransformMarcToKoha called with undefined record');
2562
        carp('TransformMarcToKoha called with undefined record');
2561
        return $result;
2563
        return $result;
2562
    }
2564
    }
2563
    $limit_table = $limit_table || 0;
2564
    $frameworkcode //= '';
2565
2566
    my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2567
2568
    my %tables = ();
2569
    if ( defined $limit_table && $limit_table eq 'items' ) {
2570
        $tables{'items'} = 1;
2571
    } else {
2572
        $tables{'items'}       = 1;
2573
        $tables{'biblio'}      = 1;
2574
        $tables{'biblioitems'} = 1;
2575
    }
2576
2577
    # traverse through record
2578
  MARCFIELD: foreach my $field ( $record->fields() ) {
2579
        my $tag = $field->tag();
2580
        next MARCFIELD unless exists $inverted_field_map->{$tag};
2581
        if ( $field->is_control_field() ) {
2582
            my $kohafields = $inverted_field_map->{$tag}->{list};
2583
          ENTRY: foreach my $entry ( @{$kohafields} ) {
2584
                my ( $subfield, $table, $column ) = @{$entry};
2585
                my $value = $field->data;
2586
                next ENTRY unless exists $tables{$table};
2587
                next ENTRY if !$value;
2588
                my $key = _disambiguate( $table, $column );
2589
                if ( $result->{$key} ) {
2590
                    $result->{$key} .= " | " . $value
2591
                        unless $result->{$key} eq $value;
2592
                } else {
2593
                    $result->{$key} = $value;
2594
                }
2595
            }
2596
        } else {
2597
2598
            # deal with subfields
2599
          MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2600
                my $code = $sf->[0];
2601
                next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2602
                my $value = $sf->[1];
2603
              SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2604
                    my ( $table, $column ) = @{$entry};
2605
                    next SFENTRY unless exists $tables{$table};
2606
                    next SFENTRY if !$value;
2607
                    my $key = _disambiguate( $table, $column );
2608
                    if ( $result->{$key} ) {
2609
                        $result->{$key} .= " | " . $value
2610
                            unless $result->{$key} eq $value;
2611
                    } else {
2612
                        $result->{$key} = $value;
2613
                    }
2614
                }
2615
            }
2616
        }
2617
    }
2618
2565
2619
    # modify copyrightdate to keep only the 1st year found
2566
    my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2620
    if ( exists $result->{'copyrightdate'} ) {
2567
    if( $limit_table eq 'items' ) {
2621
        my $temp = $result->{'copyrightdate'};
2568
        %tables = ( items => 1 );
2622
        $temp =~ m/c(\d\d\d\d)/;
2623
        if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2624
            $result->{'copyrightdate'} = $1;
2625
        } else {                                       # if no cYYYY, get the 1st date.
2626
            $temp =~ m/(\d\d\d\d)/;
2627
            $result->{'copyrightdate'} = $1;
2628
        }
2629
    }
2630
2631
    # modify publicationyear to keep only the 1st year found
2632
    if ( exists $result->{'publicationyear'} ) {
2633
        my $temp = $result->{'publicationyear'};
2634
        if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2635
            $result->{'publicationyear'} = $1;
2636
        } else {                                       # if no cYYYY, get the 1st date.
2637
            $temp =~ m/(\d\d\d\d)/;
2638
            $result->{'publicationyear'} = $1;
2639
        }
2640
    }
2569
    }
2641
2570
2642
    return $result;
2643
}
2644
2645
sub _get_inverted_marc_field_map {
2646
    my ( $frameworkcode ) = @_;
2647
    my $field_map = {};
2648
    my $mss = GetMarcSubfieldStructure( $frameworkcode );
2571
    my $mss = GetMarcSubfieldStructure( $frameworkcode );
2649
2650
    foreach my $kohafield ( keys %{ $mss } ) {
2572
    foreach my $kohafield ( keys %{ $mss } ) {
2651
        foreach my $fld ( @{ $mss->{$kohafield} } ) {
2573
        my ( $table, $column ) = split /[.]/, $kohafield, 2;
2652
            my $tag = $fld->{tagfield};
2574
        next unless $tables{$table};
2653
            my $subfield = $fld->{tagsubfield};
2575
        my $val = TransformMarcToKohaOneField(
2654
            my ( $table, $column ) = split /[.]/, $kohafield, 2;
2576
            $kohafield, $record, $frameworkcode,
2655
            push @{ $field_map->{$tag}->{list} },
2577
        );
2656
                [ $subfield, $table, $column ];
2578
        next if !defined $val;
2657
            push @{ $field_map->{$tag}->{sfs}->{$subfield} },
2579
        my $key = _disambiguate( $table, $column );
2658
                [ $table, $column ];
2580
        $result->{$key} = $val;
2659
        }
2660
    }
2581
    }
2661
    return $field_map;
2582
    return $result;
2662
}
2583
}
2663
2584
2664
=head2 _disambiguate
2585
=head2 _disambiguate
Lines 2690-2704 more. Link Here
2690
2611
2691
=cut
2612
=cut
2692
2613
2693
sub CountItemsIssued {
2694
    my ($biblionumber) = @_;
2695
    my $dbh            = C4::Context->dbh;
2696
    my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2697
    $sth->execute($biblionumber);
2698
    my $row = $sth->fetchrow_hashref();
2699
    return $row->{'issuedCount'};
2700
}
2701
2702
sub _disambiguate {
2614
sub _disambiguate {
2703
    my ( $table, $column ) = @_;
2615
    my ( $table, $column ) = @_;
2704
    if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2616
    if ( $column eq "cn_sort" or $column eq "cn_source" ) {
Lines 2711-2729 sub _disambiguate { Link Here
2711
2623
2712
=head2 TransformMarcToKohaOneField
2624
=head2 TransformMarcToKohaOneField
2713
2625
2714
    $value = TransformMarcToKohaOneField( 'biblio.title', $record, $frameworkcode );
2626
    $val = TransformMarcToKohaOneField( 'biblio.title', $marc, $frameworkcode );
2715
2627
2716
=cut
2628
=cut
2717
2629
2718
sub TransformMarcToKohaOneField {
2630
sub TransformMarcToKohaOneField {
2719
    my ( $kohafield, $marc, $frameworkcode ) = @_;
2631
    my ( $kohafield, $marc, $frameworkcode ) = @_;
2720
2632
2721
    # It is not really useful to repeat all code from TransformMarcToKoha here.
2633
    my ( @rv, $retval );
2722
    # Since it is fast enough (by caching), we just extract the field.
2634
    my @mss = GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
2723
    my $koharec = TransformMarcToKoha( $marc, $frameworkcode );
2635
    foreach my $fldhash ( @mss ) {
2724
    my @temp = split /\./, $kohafield, 2;
2636
        my $tag = $fldhash->{tagfield};
2725
    $kohafield = _disambiguate( @temp ) if @temp > 1;
2637
        my $sub = $fldhash->{tagsubfield};
2726
    return $koharec ? $koharec->{$kohafield} : undef;
2638
        foreach my $fld ( $marc->field($tag) ) {
2639
            if( $sub eq '@' || $fld->is_control_field ) {
2640
                push @rv, $fld->data if $fld->data;
2641
            } else {
2642
                push @rv, grep { $_ } $fld->subfield($sub);
2643
            }
2644
        }
2645
    }
2646
    return unless @rv;
2647
    $retval = join ' | ', uniq(@rv);
2648
2649
    # Additional polishing for individual kohafields
2650
    if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2651
        $retval = _adjust_pubyear( $retval );
2652
    }
2653
2654
    return $retval;
2655
}
2656
2657
=head2 _adjust_pubyear
2658
2659
    Helper routine for TransformMarcToKohaOneField
2660
2661
=cut
2662
2663
sub _adjust_pubyear {
2664
    my $retval = shift;
2665
    # modify return value to keep only the 1st year found
2666
    if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2667
        $retval = $1;
2668
    } else {
2669
        # if no cYYYY, get the 1st date.
2670
        $retval =~ m/(\d\d\d\d)/;
2671
        $retval = $1;
2672
    }
2673
    return $retval;
2674
}
2675
2676
=head2 CountItemsIssued
2677
2678
    my $count = CountItemsIssued( $biblionumber );
2679
2680
=cut
2681
2682
sub CountItemsIssued {
2683
    my ($biblionumber) = @_;
2684
    my $dbh            = C4::Context->dbh;
2685
    my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2686
    $sth->execute($biblionumber);
2687
    my $row = $sth->fetchrow_hashref();
2688
    return $row->{'issuedCount'};
2727
}
2689
}
2728
2690
2729
=head2 ModZebra
2691
=head2 ModZebra
2730
- 

Return to bug 10306