Bug 32824: Fix cataloguing/value_builder/unimarc_field_100.pl
[koha-ffzg.git] / Koha / Biblio.pm
index 69fd30f..5bf369c 100644 (file)
@@ -24,7 +24,6 @@ use URI;
 use URI::Escape qw( uri_escape_utf8 );
 
 use C4::Koha qw( GetNormalizedISBN );
-use C4::XSLT qw( transformMARCXML4XSLT );
 
 use Koha::Database;
 use Koha::DateUtils qw( dt_from_string );
@@ -34,16 +33,21 @@ use base qw(Koha::Object);
 use Koha::Acquisition::Orders;
 use Koha::ArticleRequests;
 use Koha::Biblio::Metadatas;
+use Koha::Biblio::ItemGroups;
 use Koha::Biblioitems;
+use Koha::Checkouts;
 use Koha::CirculationRules;
 use Koha::Item::Transfer::Limits;
 use Koha::Items;
 use Koha::Libraries;
+use Koha::Old::Checkouts;
+use Koha::Recalls;
+use Koha::RecordProcessor;
 use Koha::Suggestions;
 use Koha::Subscriptions;
 use Koha::SearchEngine;
 use Koha::SearchEngine::Search;
-use Koha::Util::Search;
+use Koha::SearchEngine::QueryBuilder;
 
 =head1 NAME
 
@@ -115,6 +119,21 @@ sub active_orders {
     return $self->orders->search({ datecancellationprinted => undef });
 }
 
+=head3 item_groups
+
+my $item_groups = $biblio->item_groups();
+
+Returns a Koha::Biblio::ItemGroups object
+
+=cut
+
+sub item_groups {
+    my ( $self ) = @_;
+
+    my $item_groups = $self->_result->item_groups;
+    return Koha::Biblio::ItemGroups->_new_from_dbic($item_groups);
+}
+
 =head3 can_article_request
 
 my $bool = $biblio->can_article_request( $borrower );
@@ -356,6 +375,36 @@ sub article_requests {
     return Koha::ArticleRequests->_new_from_dbic( scalar $self->_result->article_requests );
 }
 
+=head3 current_checkouts
+
+    my $current_checkouts = $biblio->current_checkouts
+
+Returns the current checkouts associated with this biblio
+
+=cut
+
+sub current_checkouts {
+    my ($self) = @_;
+
+    return Koha::Checkouts->search( { "item.biblionumber" => $self->id },
+        { join => 'item' } );
+}
+
+=head3 old_checkouts
+
+    my $old_checkouts = $biblio->old_checkouts
+
+Returns the past checkouts associated with this biblio
+
+=cut
+
+sub old_checkouts {
+    my ( $self ) = @_;
+
+    return Koha::Old::Checkouts->search( { "item.biblionumber" => $self->id },
+        { join => 'item' } );
+}
+
 =head3 items
 
 my $items = $biblio->items();
@@ -479,29 +528,101 @@ sub suggestions {
     return Koha::Suggestions->_new_from_dbic( $suggestions_rs );
 }
 
-=head3 components
+=head3 get_marc_components
 
-my $components = $self->components();
+  my $components = $self->get_marc_components();
 
-Returns an array of MARCXML data, which are component parts of
-this object (MARC21 773$w points to this)
+Returns an array of search results data, which are component parts of
+this object (MARC21 773 points to this)
 
 =cut
 
-sub components {
+sub get_marc_components {
     my ($self, $max_results) = @_;
 
-    return if (C4::Context->preference('marcflavour') ne 'MARC21');
+    return [] if (C4::Context->preference('marcflavour') ne 'MARC21');
 
-    my $searchstr = Koha::Util::Search::get_component_part_query($self->id);
+    my ( $searchstr, $sort ) = $self->get_components_query;
 
+    my $components;
     if (defined($searchstr)) {
         my $searcher = Koha::SearchEngine::Search->new({index => $Koha::SearchEngine::BIBLIOS_INDEX});
-        my ( $errors, $results, $total_hits ) = $searcher->simple_search_compat( $searchstr, 0, $max_results );
-        $self->{_components} = $results if ( defined($results) && scalar(@$results) );
+        my ( $error, $results, $facets );
+        eval {
+            ( $error, $results, $facets ) = $searcher->search_compat( $searchstr, undef, [$sort], ['biblioserver'], $max_results, 0, undef, undef, 'ccl', 0 );
+        };
+        if( $error || $@ ) {
+            $error //= q{};
+            $error .= $@ if $@;
+            warn "Warning from search_compat: '$error'";
+            $self->add_message(
+                {
+                    type    => 'error',
+                    message => 'component_search',
+                    payload => $error,
+                }
+            );
+        }
+        $components = $results->{biblioserver}->{RECORDS} if defined($results) && $results->{biblioserver}->{hits};
     }
 
-    return $self->{_components} || ();
+    return $components // [];
+}
+
+=head2 get_components_query
+
+Returns a query which can be used to search for all component parts of MARC21 biblios
+
+=cut
+
+sub get_components_query {
+    my ($self) = @_;
+
+    my $builder = Koha::SearchEngine::QueryBuilder->new(
+        { index => $Koha::SearchEngine::BIBLIOS_INDEX } );
+    my $marc = $self->metadata->record;
+    my $component_sort_field = C4::Context->preference('ComponentSortField') // "title";
+    my $component_sort_order = C4::Context->preference('ComponentSortOrder') // "asc";
+    my $sort = $component_sort_field . "_" . $component_sort_order;
+
+    my $searchstr;
+    if ( C4::Context->preference('UseControlNumber') ) {
+        my $pf001 = $marc->field('001') || undef;
+
+        if ( defined($pf001) ) {
+            $searchstr = "(";
+            my $pf003 = $marc->field('003') || undef;
+
+            if ( !defined($pf003) ) {
+                # search for 773$w='Host001'
+                $searchstr .= "rcn:\"" . $pf001->data()."\"";
+            }
+            else {
+                $searchstr .= "(";
+                # search for (773$w='Host001' and 003='Host003') or 773$w='(Host003)Host001'
+                $searchstr .= "(rcn:\"" . $pf001->data() . "\" AND cni:\"" . $pf003->data() . "\")";
+                $searchstr .= " OR rcn:\"" . $pf003->data() . " " . $pf001->data() . "\"";
+                $searchstr .= ")";
+            }
+
+            # limit to monograph and serial component part records
+            $searchstr .= " AND (bib-level:a OR bib-level:b)";
+            $searchstr .= ")";
+        }
+    }
+    else {
+        my $cleaned_title = $marc->subfield('245', "a");
+        $cleaned_title =~ tr|/||;
+        $cleaned_title = $builder->clean_search_term($cleaned_title);
+        $searchstr = qq#Host-item:("$cleaned_title")#;
+    }
+    my ($error, $query ,$query_str) = $builder->build_query_compat( undef, [$searchstr], undef, undef, [$sort], 0 );
+    if( $error ){
+        warn $error;
+        return;
+    }
+
+    return ($query, $query_str, $sort);
 }
 
 =head3 subscriptions
@@ -816,7 +937,7 @@ sub cover_images {
 
 =head3 get_marc_notes
 
-    $marcnotesarray = $biblio->get_marc_notes({ marcflavour => $marcflavour });
+    $marcnotesarray = $biblio->get_marc_notes({ opac => 1 });
 
 Get all notes from the MARC record and returns them in an array.
 The notes are stored in different fields depending on MARC flavour.
@@ -827,12 +948,23 @@ MARC21 5XX $u subfields receive special attention as they are URIs.
 sub get_marc_notes {
     my ( $self, $params ) = @_;
 
-    my $marcflavour = $params->{marcflavour};
-    my $opac = $params->{opac};
+    my $marcflavour = C4::Context->preference('marcflavour');
+    my $opac = $params->{opac} // '0';
+    my $interface = $params->{opac} ? 'opac' : 'intranet';
 
-    my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
-    my @marcnotes;
+    my $record = $params->{record} // $self->metadata->record;
+    my $record_processor = Koha::RecordProcessor->new(
+        {
+            filters => [ 'ViewPolicy', 'ExpandCodedFields' ],
+            options => {
+                interface     => $interface,
+                frameworkcode => $self->frameworkcode
+            }
+        }
+    );
+    $record_processor->process($record);
 
+    my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
     #MARC21 specs indicate some notes should be private if first indicator 0
     my %maybe_private = (
         541 => 1,
@@ -844,9 +976,8 @@ sub get_marc_notes {
 
     my %hiddenlist = map { $_ => 1 }
         split( /,/, C4::Context->preference('NotesToHide'));
-    my $record = $self->metadata->record;
-    $record = transformMARCXML4XSLT( $self->biblionumber, $record, $opac );
 
+    my @marcnotes;
     foreach my $field ( $record->field($scope) ) {
         my $tag = $field->tag();
         next if $hiddenlist{ $tag };
@@ -870,6 +1001,168 @@ sub get_marc_notes {
     return \@marcnotes;
 }
 
+=head3 _get_marc_authors
+
+Private method to return the list of authors contained in the MARC record.
+See get get_marc_contributors and get_marc_authors for the public methods.
+
+=cut
+
+sub _get_marc_authors {
+    my ( $self, $params ) = @_;
+
+    my $fields_filter = $params->{fields_filter};
+    my $mintag        = $params->{mintag};
+    my $maxtag        = $params->{maxtag};
+
+    my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
+    my $marcflavour        = C4::Context->preference('marcflavour');
+
+    # tagslib useful only for UNIMARC author responsibilities
+    my $tagslib = $marcflavour eq "UNIMARC"
+      ? C4::Biblio::GetMarcStructure( 1, $self->frameworkcode, { unsafe => 1 } )
+      : undef;
+
+    my @marcauthors;
+    foreach my $field ( $self->metadata->record->field($fields_filter) ) {
+
+        next
+          if $mintag && $field->tag() < $mintag
+          || $maxtag && $field->tag() > $maxtag;
+
+        my @subfields_loop;
+        my @link_loop;
+        my @subfields  = $field->subfields();
+        my $count_auth = 0;
+
+        # if there is an authority link, build the link with Koha-Auth-Number: subfield9
+        my $subfield9 = $field->subfield('9');
+        if ($subfield9) {
+            my $linkvalue = $subfield9;
+            $linkvalue =~ s/(\(|\))//g;
+            @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
+        }
+
+        # other subfields
+        my $unimarc3;
+        for my $authors_subfield (@subfields) {
+            next if ( $authors_subfield->[0] eq '9' );
+
+            # unimarc3 contains the $3 of the author for UNIMARC.
+            # For french academic libraries, it's the "ppn", and it's required for idref webservice
+            $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
+
+            # don't load unimarc subfields 3, 5
+            next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
+
+            my $code = $authors_subfield->[0];
+            my $value        = $authors_subfield->[1];
+            my $linkvalue    = $value;
+            $linkvalue =~ s/(\(|\))//g;
+            # UNIMARC author responsibility
+            if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
+                $value = C4::Biblio::GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
+                $linkvalue = "($value)";
+            }
+            # if no authority link, build a search query
+            unless ($subfield9) {
+                push @link_loop, {
+                    limit    => 'au',
+                    'link'   => $linkvalue,
+                    operator => (scalar @link_loop) ? ' AND ' : undef
+                };
+            }
+            my @this_link_loop = @link_loop;
+            # do not display $0
+            unless ( $code eq '0') {
+                push @subfields_loop, {
+                    tag       => $field->tag(),
+                    code      => $code,
+                    value     => $value,
+                    link_loop => \@this_link_loop,
+                    separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
+                };
+            }
+        }
+        push @marcauthors, {
+            MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
+            authoritylink => $subfield9,
+            unimarc3 => $unimarc3
+        };
+    }
+    return \@marcauthors;
+}
+
+=head3 get_marc_contributors
+
+    my $contributors = $biblio->get_marc_contributors;
+
+Get all contributors (but first author) from the MARC record and returns them in an array.
+They are stored in different fields depending on MARC flavour (700..720 for MARC21)
+
+=cut
+
+sub get_marc_contributors {
+    my ( $self, $params ) = @_;
+
+    my ( $mintag, $maxtag, $fields_filter );
+    my $marcflavour = C4::Context->preference('marcflavour');
+
+    if ( $marcflavour eq "UNIMARC" ) {
+        $mintag = "700";
+        $maxtag = "712";
+        $fields_filter = '7..';
+    } else { # marc21/normarc
+        $mintag = "700";
+        $maxtag = "720";
+        $fields_filter = '7..';
+    }
+
+    return $self->_get_marc_authors(
+        {
+            fields_filter => $fields_filter,
+            mintag       => $mintag,
+            maxtag       => $maxtag
+        }
+    );
+}
+
+=head3 get_marc_authors
+
+    my $authors = $biblio->get_marc_authors;
+
+Get all authors from the MARC record and returns them in an array.
+They are stored in different fields depending on MARC flavour
+(main author from 100 then secondary authors from 700..720).
+
+=cut
+
+sub get_marc_authors {
+    my ( $self, $params ) = @_;
+
+    my ( $mintag, $maxtag, $fields_filter );
+    my $marcflavour = C4::Context->preference('marcflavour');
+
+    if ( $marcflavour eq "UNIMARC" ) {
+        $fields_filter = '200';
+    } else { # marc21/normarc
+        $fields_filter = '100';
+    }
+
+    my @first_authors = @{$self->_get_marc_authors(
+        {
+            fields_filter => $fields_filter,
+            mintag       => $mintag,
+            maxtag       => $maxtag
+        }
+    )};
+
+    my @other_authors = @{$self->get_marc_contributors};
+
+    return [@first_authors, @other_authors];
+}
+
+
 =head3 to_api
 
     my $json = $biblio->to_api;
@@ -903,7 +1196,8 @@ sub to_api_mapping {
         unititle         => 'uniform_title',
         seriestitle      => 'series_title',
         copyrightdate    => 'copyright_date',
-        datecreated      => 'creation_date'
+        datecreated      => 'creation_date',
+        deleted_on       => undef,
     };
 }
 
@@ -911,7 +1205,7 @@ sub to_api_mapping {
 
     $host = $biblio->get_marc_host;
     # OR:
-    ( $host, $relatedparts ) = $biblio->get_marc_host;
+    ( $host, $relatedparts, $hostinfo ) = $biblio->get_marc_host;
 
     Returns host biblio record from MARC21 773 (undef if no 773 present).
     It looks at the first 773 field with MARCorgCode or only a control
@@ -920,6 +1214,12 @@ sub to_api_mapping {
     If there are, the sub returns undef.
     Called in list context, it also returns 773$g (related parts).
 
+    If there is no $w, we use $0 (host biblionumber) or $9 (host itemnumber)
+    to search for the host record. If there is also no $0 and no $9, we search
+    using author and title. Failing all of that, we return an undef host and
+    form a concatenation of strings with 773$agt for host information,
+    returned when called in list context.
+
 =cut
 
 sub get_marc_host {
@@ -943,12 +1243,35 @@ sub get_marc_host {
             last;
         }
     }
+
+    my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
+    my $bibno;
+    if ( !$hostfld and $record->subfield('773','t') ) {
+        # not linked using $w
+        my $unlinkedf = $record->field('773');
+        my $host;
+        if ( C4::Context->preference("EasyAnalyticalRecords") ) {
+            if ( $unlinkedf->subfield('0') ) {
+                # use 773$0 host biblionumber
+                $bibno = $unlinkedf->subfield('0');
+            } elsif ( $unlinkedf->subfield('9') ) {
+                # use 773$9 host itemnumber
+                my $linkeditemnumber = $unlinkedf->subfield('9');
+                $bibno = Koha::Items->find( $linkeditemnumber )->biblionumber;
+            }
+        }
+        if ( $bibno ) {
+            my $host = Koha::Biblios->find($bibno) or return;
+            return wantarray ? ( $host, $unlinkedf->subfield('g') ) : $host;
+        }
+        # just return plaintext and no host record
+        my $hostinfo = join( ", ", $unlinkedf->subfield('a'), $unlinkedf->subfield('t'), $unlinkedf->subfield('g') );
+        return wantarray ? ( undef, $unlinkedf->subfield('g'), $hostinfo ) : undef;
+    }
     return if !$hostfld;
     my $rcn = $hostfld->subfield('w');
 
     # Look for control number with/without orgcode
-    my $engine = Koha::SearchEngine::Search->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
-    my $bibno;
     for my $try (1..2) {
         my ( $error, $results, $total_hits ) = $engine->simple_search_compat( 'Control-number='.$rcn, 0,1 );
         if( !$error and $total_hits == 1 ) {
@@ -970,6 +1293,115 @@ sub get_marc_host {
     }
 }
 
+=head3 recalls
+
+    my $recalls = $biblio->recalls;
+
+Return recalls linked to this biblio
+
+=cut
+
+sub recalls {
+    my ( $self ) = @_;
+    return Koha::Recalls->_new_from_dbic( scalar $self->_result->recalls );
+}
+
+=head3 can_be_recalled
+
+    my @items_for_recall = $biblio->can_be_recalled({ patron => $patron_object });
+
+Does biblio-level checks and returns the items attached to this biblio that are available for recall
+
+=cut
+
+sub can_be_recalled {
+    my ( $self, $params ) = @_;
+
+    return 0 if !( C4::Context->preference('UseRecalls') );
+
+    my $patron = $params->{patron};
+
+    my $branchcode = C4::Context->userenv->{'branch'};
+    if ( C4::Context->preference('CircControl') eq 'PatronLibrary' and $patron ) {
+        $branchcode = $patron->branchcode;
+    }
+
+    my @all_items = Koha::Items->search({ biblionumber => $self->biblionumber })->as_list;
+
+    # if there are no available items at all, no recall can be placed
+    return 0 if ( scalar @all_items == 0 );
+
+    my @itemtypes;
+    my @itemnumbers;
+    my @items;
+    my @all_itemnumbers;
+    foreach my $item ( @all_items ) {
+        push( @all_itemnumbers, $item->itemnumber );
+        if ( $item->can_be_recalled({ patron => $patron }) ) {
+            push( @itemtypes, $item->effective_itemtype );
+            push( @itemnumbers, $item->itemnumber );
+            push( @items, $item );
+        }
+    }
+
+    # if there are no recallable items, no recall can be placed
+    return 0 if ( scalar @items == 0 );
+
+    # Check the circulation rule for each relevant itemtype for this biblio
+    my ( @recalls_allowed, @recalls_per_record, @on_shelf_recalls );
+    foreach my $itemtype ( @itemtypes ) {
+        my $rule = Koha::CirculationRules->get_effective_rules({
+            branchcode => $branchcode,
+            categorycode => $patron ? $patron->categorycode : undef,
+            itemtype => $itemtype,
+            rules => [
+                'recalls_allowed',
+                'recalls_per_record',
+                'on_shelf_recalls',
+            ],
+        });
+        push( @recalls_allowed, $rule->{recalls_allowed} ) if $rule;
+        push( @recalls_per_record, $rule->{recalls_per_record} ) if $rule;
+        push( @on_shelf_recalls, $rule->{on_shelf_recalls} ) if $rule;
+    }
+    my $recalls_allowed = (sort {$b <=> $a} @recalls_allowed)[0]; # take highest
+    my $recalls_per_record = (sort {$b <=> $a} @recalls_per_record)[0]; # take highest
+    my %on_shelf_recalls_count = ();
+    foreach my $count ( @on_shelf_recalls ) {
+        $on_shelf_recalls_count{$count}++;
+    }
+    my $on_shelf_recalls = (sort {$on_shelf_recalls_count{$b} <=> $on_shelf_recalls_count{$a}} @on_shelf_recalls)[0]; # take most common
+
+    # check recalls allowed has been set and is not zero
+    return 0 if ( !defined($recalls_allowed) || $recalls_allowed == 0 );
+
+    if ( $patron ) {
+        # check borrower has not reached open recalls allowed limit
+        return 0 if ( $patron->recalls->filter_by_current->count >= $recalls_allowed );
+
+        # check borrower has not reached open recalls allowed per record limit
+        return 0 if ( $patron->recalls->filter_by_current->search({ biblio_id => $self->biblionumber })->count >= $recalls_per_record );
+
+        # check if any of the items under this biblio are already checked out by this borrower
+        return 0 if ( Koha::Checkouts->search({ itemnumber => [ @all_itemnumbers ], borrowernumber => $patron->borrowernumber })->count > 0 );
+    }
+
+    # check item availability
+    my $checked_out_count = 0;
+    foreach (@items) {
+        if ( Koha::Checkouts->search({ itemnumber => $_->itemnumber })->count > 0 ){ $checked_out_count++; }
+    }
+
+    # can't recall if on shelf recalls only allowed when all unavailable, but items are still available for checkout
+    return 0 if ( $on_shelf_recalls eq 'all' && $checked_out_count < scalar @items );
+
+    # can't recall if no items have been checked out
+    return 0 if ( $checked_out_count == 0 );
+
+    # can recall
+    return @items;
+}
+
 =head2 Internal methods
 
 =head3 type