| 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 | -  |  |  |