X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FSearch.pm;h=16c6a559af3b5f217674c60182743496fef255e7;hb=5429c5f497fe426b6905b5ef9693f4e42afff5d7;hp=30e9553f1a138ed6e2eb0ff3103916f3057d1111;hpb=aeb0e1988b919119716862e2df7a9d9cc58dc979;p=koha_fer diff --git a/C4/Search.pm b/C4/Search.pm index 30e9553f1a..16c6a559af 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -16,14 +16,20 @@ package C4::Search; # Suite 330, Boston, MA 02111-1307 USA use strict; +# use warnings; # FIXME require Exporter; use C4::Context; -use C4::Biblio; # GetMarcFromKohaField +use C4::Biblio; # GetMarcFromKohaField, GetBiblioData use C4::Koha; # getFacets use Lingua::Stem; use C4::Search::PazPar2; use XML::Simple; use C4::Dates qw(format_date); +use C4::XSLT; +use C4::Branch; +use C4::Debug; +use YAML; +use URI::Escape; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG); @@ -51,44 +57,20 @@ This module provides searching functions for Koha's bibliographic databases @ISA = qw(Exporter); @EXPORT = qw( - &findseealso &FindDuplicate &SimpleSearch &searchResults &getRecords &buildQuery &NZgetRecords - &ModBiblios + &AddSearchHistory + &GetDistinctValues + &BiblioAddAuthorities ); +#FIXME: i had to add BiblioAddAuthorities here because in Biblios.pm it caused circular dependencies (C4::Search uses C4::Biblio, and BiblioAddAuthorities uses SimpleSearch from C4::Search) # make all your functions, whether exported or not; -=head2 findseealso($dbh,$fields); - -C<$dbh> is a link to the DB handler. - -use C4::Context; -my $dbh =C4::Context->dbh; - -C<$fields> is a reference to the fields array - -This function modifies the @$fields array and adds related fields to search on. - -FIXME: this function is probably deprecated in Koha 3 - -=cut - -sub findseealso { - my ( $dbh, $fields ) = @_; - my $tagslib = GetMarcStructure(1); - for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) { - my ($tag) = substr( @$fields[$i], 1, 3 ); - my ($subfield) = substr( @$fields[$i], 4, 1 ); - @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso} - if ( $tagslib->{$tag}->{$subfield}->{seealso} ); - } -} - =head2 FindDuplicate ($biblionumber,$biblionumber,$title) = FindDuplicate($record); @@ -157,7 +139,7 @@ sub FindDuplicate { =head2 SimpleSearch -($error,$results) = SimpleSearch($query,@servers); +( $error, $results, $total_hits ) = SimpleSearch( $query, $offset, $max_results, [@servers] ); This function provides a simple search API on the bibliographic catalog @@ -167,16 +149,21 @@ This function provides a simple search API on the bibliographic catalog * $query can be a simple keyword or a complete CCL query * @servers is optional. Defaults to biblioserver as found in koha-conf.xml + * $offset - If present, represents the number of records at the beggining to omit. Defaults to 0 + * $max_results - if present, determines the maximum number of records to fetch. undef is All. defaults to undef. + + +=item C -=item C * $error is a empty unless an error is detected * \@results is an array of records. + * $total_hits is the number of hits that would have been returned with no limit =item C =back -my ($error, $marcresults) = SimpleSearch($query); +my ( $error, $marcresults, $total_hits ) = SimpleSearch($query); if (defined $error) { $template->param(query_error => $error); @@ -188,13 +175,12 @@ if (defined $error) { my $hits = scalar @$marcresults; my @results; -for(my $i=0;$i<$hits;$i++) { +for my $i (0..$hits) { my %resultsloop; my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]); my $biblio = TransformMarcToKoha(C4::Context->dbh,$marcrecord,''); #build the hash for the template. - $resultsloop{highlight} = ($i % 2)?(1):(0); $resultsloop{title} = $biblio->{'title'}; $resultsloop{subtitle} = $biblio->{'subtitle'}; $resultsloop{biblionumber} = $biblio->{'biblionumber'}; @@ -210,31 +196,31 @@ $template->param(result=>\@results); =cut sub SimpleSearch { - my $query = shift; + my ( $query, $offset, $max_results, $servers ) = @_; + if ( C4::Context->preference('NoZebra') ) { my $result = NZorder( NZanalyse($query) )->{'biblioserver'}; my $search_result = ( $result->{hits} && $result->{hits} > 0 ? $result->{'RECORDS'} : [] ); - return ( undef, $search_result ); + return ( undef, $search_result, scalar($result->{hits}) ); } else { - my @servers = @_; + # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too. + my @servers = defined ( $servers ) ? @$servers : ( "biblioserver" ); my @results; + my @zoom_queries; my @tmpresults; my @zconns; - return ( "No query entered", undef ) unless $query; - - # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too. - @servers = ("biblioserver") unless @servers; + my $total_hits; + return ( "No query entered", undef, undef ) unless $query; # Initialize & Search Zebra for ( my $i = 0 ; $i < @servers ; $i++ ) { eval { $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 ); - $tmpresults[$i] = - $zconns[$i] - ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) ); + $zoom_queries[$i] = new ZOOM::Query::CCL2RPN( $query, $zconns[$i]); + $tmpresults[$i] = $zconns[$i]->search( $zoom_queries[$i] ); # error handling my $error = @@ -243,7 +229,7 @@ sub SimpleSearch { . $zconns[$i]->addinfo() . " " . $zconns[$i]->diagset(); - return ( $error, undef ) if $zconns[$i]->errcode(); + return ( $error, undef, undef ) if $zconns[$i]->errcode(); }; if ($@) { @@ -254,25 +240,36 @@ sub SimpleSearch { . $@->addinfo() . " " . $@->diagset(); warn $error; - return ( $error, undef ); + return ( $error, undef, undef ); } } - my $hits = 0; - my $ev; while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) { - $ev = $zconns[ $i - 1 ]->last_event(); - if ( $ev == ZOOM::Event::ZEND ) { - $hits = $tmpresults[ $i - 1 ]->size(); - } - if ( $hits > 0 ) { - for ( my $j = 0 ; $j < $hits ; $j++ ) { - my $record = $tmpresults[ $i - 1 ]->record($j)->raw(); + my $event = $zconns[ $i - 1 ]->last_event(); + if ( $event == ZOOM::Event::ZEND ) { + + my $first_record = defined( $offset ) ? $offset+1 : 1; + my $hits = $tmpresults[ $i - 1 ]->size(); + $total_hits += $hits; + my $last_record = $hits; + if ( defined $max_results && $offset + $max_results < $hits ) { + $last_record = $offset + $max_results; + } + + for my $j ( $first_record..$last_record ) { + my $record = $tmpresults[ $i - 1 ]->record( $j-1 )->raw(); # 0 indexed push @results, $record; } } - $hits = 0; } - return ( undef, \@results ); + + foreach my $result (@tmpresults) { + $result->destroy(); + } + foreach my $zoom_query (@zoom_queries) { + $zoom_query->destroy(); + } + + return ( undef, \@results, $total_hits ); } } @@ -286,7 +283,7 @@ sub SimpleSearch { ); The all singing, all dancing, multi-server, asynchronous, scanning, -searching, record nabbing, facet-building +searching, record nabbing, facet-building See verbse embedded documentation. @@ -313,8 +310,7 @@ sub getRecords { my $facets_info = (); my $facets = getFacets(); - my @facets_loop - ; # stores the ref to array of hashes for template facets loop + my @facets_loop; # stores the ref to array of hashes for template facets loop ### LOOP THROUGH THE SERVERS for ( my $i = 0 ; $i < @servers ; $i++ ) { @@ -322,53 +318,28 @@ sub getRecords { # perform the search, create the results objects # if this is a local search, use the $koha-query, if it's a federated one, use the federated-query - my $query_to_use; - if ( $servers[$i] =~ /biblioserver/ ) { - $query_to_use = $koha_query; - } - else { - $query_to_use = $simple_query; - } + my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query; #$query_to_use = $simple_query if $scan; warn $simple_query if ( $scan and $DEBUG ); # Check if we've got a query_type defined, if so, use it eval { - if ($query_type) - { - if ( $query_type =~ /^ccl/ ) { - $query_to_use =~ - s/\:/\=/g; # change : to = last minute (FIXME) - $results[$i] = - $zconns[$i]->search( - new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] ) - ); - } - elsif ( $query_type =~ /^cql/ ) { - $results[$i] = - $zconns[$i]->search( - new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) ); - } - elsif ( $query_type =~ /^pqf/ ) { - $results[$i] = - $zconns[$i]->search( - new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) ); - } - } - else { - if ($scan) { - $results[$i] = - $zconns[$i]->scan( - new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] ) - ); - } - else { - $results[$i] = - $zconns[$i]->search( - new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] ) - ); + if ($query_type) { + if ($query_type =~ /^ccl/) { + $query_to_use =~ s/\:/\=/g; # change : to = last minute (FIXME) + $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i])); + } elsif ($query_type =~ /^cql/) { + $results[$i] = $zconns[$i]->search(new ZOOM::Query::CQL($query_to_use, $zconns[$i])); + } elsif ($query_type =~ /^pqf/) { + $results[$i] = $zconns[$i]->search(new ZOOM::Query::PQF($query_to_use, $zconns[$i])); + } else { + warn "Unknown query_type '$query_type'. Results undetermined."; } + } elsif ($scan) { + $results[$i] = $zconns[$i]->scan( new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i])); + } else { + $results[$i] = $zconns[$i]->search(new ZOOM::Query::CCL2RPN($query_to_use, $zconns[$i])); } }; if ($@) { @@ -415,6 +386,9 @@ sub getRecords { elsif ( $sort eq "title_za" ) { $sort_by .= "1=4 >i "; } + else { + warn "Ignoring unrecognized sort '$sort' requested" if $sort_by; + } } if ($sort_by) { if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) { @@ -459,26 +433,16 @@ sub getRecords { my $tmpauthor; # the minimal record in author/title (depending on MARC flavour) - if ( C4::Context->preference("marcflavour") eq - "UNIMARC" ) - { - $tmptitle = MARC::Field->new( - '200', ' ', ' ', - a => $term, - f => $occ - ); + if (C4::Context->preference("marcflavour") eq "UNIMARC") { + $tmptitle = MARC::Field->new('200',' ',' ', a => $term, f => $occ); $tmprecord->append_fields($tmptitle); - } - else { - $tmptitle = - MARC::Field->new( '245', ' ', ' ', a => $term, ); - $tmpauthor = - MARC::Field->new( '100', ' ', ' ', a => $occ, ); + } else { + $tmptitle = MARC::Field->new('245',' ',' ', a => $term,); + $tmpauthor = MARC::Field->new('100',' ',' ', a => $occ,); $tmprecord->append_fields($tmptitle); $tmprecord->append_fields($tmpauthor); } - $results_hash->{'RECORDS'}[$j] = - $tmprecord->as_usmarc(); + $results_hash->{'RECORDS'}[$j] = $tmprecord->as_usmarc(); } # not an index scan @@ -495,34 +459,20 @@ sub getRecords { #warn $servers[$i-1]."\n".$record; #.$facet_record->title(); if ($facet_record) { for ( my $k = 0 ; $k <= @$facets ; $k++ ) { - - if ( $facets->[$k] ) { - my @fields; - for my $tag ( @{ $facets->[$k]->{'tags'} } ) - { - push @fields, - $facet_record->field($tag); + ($facets->[$k]) or next; + my @fields = map {$facet_record->field($_)} @{$facets->[$k]->{'tags'}} ; + for my $field (@fields) { + my @subfields = $field->subfields(); + for my $subfield (@subfields) { + my ( $code, $data ) = @$subfield; + ($code eq $facets->[$k]->{'subfield'}) or next; + $facets_counter->{ $facets->[$k]->{'link_value'} }->{$data}++; } - for my $field (@fields) { - my @subfields = $field->subfields(); - for my $subfield (@subfields) { - my ( $code, $data ) = @$subfield; - if ( $code eq - $facets->[$k]->{'subfield'} ) - { - $facets_counter->{ $facets->[$k] - ->{'link_value'} } - ->{$data}++; - } - } - } - $facets_info->{ $facets->[$k] - ->{'link_value'} }->{'label_value'} = - $facets->[$k]->{'label_value'}; - $facets_info->{ $facets->[$k] - ->{'link_value'} }->{'expanded'} = - $facets->[$k]->{'expanded'}; } + $facets_info->{ $facets->[$k]->{'link_value'} }->{'label_value'} = + $facets->[$k]->{'label_value'}; + $facets_info->{ $facets->[$k]->{'link_value'} }->{'expanded'} = + $facets->[$k]->{'expanded'}; } } } @@ -537,15 +487,15 @@ sub getRecords { if ( $servers[ $i - 1 ] =~ /biblioserver/ ) { for my $link_value ( sort { $facets_counter->{$b} <=> $facets_counter->{$a} } - keys %$facets_counter ) + keys %$facets_counter ) { my $expandable; my $number_of_facets; my @this_facets_array; for my $one_facet ( sort { - $facets_counter->{$link_value} - ->{$b} <=> $facets_counter->{$link_value}->{$a} + $facets_counter->{$link_value}->{$b} + <=> $facets_counter->{$link_value}->{$a} } keys %{ $facets_counter->{$link_value} } ) { @@ -567,25 +517,27 @@ sub getRecords { # if it's a branch, label by the name, not the code, if ( $link_value =~ /branch/ ) { - $facet_label_value = - $branches->{$one_facet}->{'branchname'}; + if (defined $branches + && ref($branches) eq "HASH" + && defined $branches->{$one_facet} + && ref ($branches->{$one_facet}) eq "HASH") + { + $facet_label_value = + $branches->{$one_facet}->{'branchname'}; + } + else { + $facet_label_value = "*"; + } } - # but we're down with the whole label being in the link's title. - my $facet_title_value = $one_facet; - - push @this_facets_array, - ( - { - facet_count => - $facets_counter->{$link_value} - ->{$one_facet}, - facet_label_value => $facet_label_value, - facet_title_value => $facet_title_value, - facet_link_value => $facet_link_value, - type_link_value => $link_value, - }, - ); + # but we're down with the whole label being in the link's title. + push @this_facets_array, { + facet_count => $facets_counter->{$link_value}->{$one_facet}, + facet_label_value => $facet_label_value, + facet_title_value => $one_facet, + facet_link_value => $facet_link_value, + type_link_value => $link_value, + }; } } @@ -595,18 +547,14 @@ sub getRecords { if ( ( $number_of_facets > 6 ) && ( $expanded_facet ne $link_value ) ); } - push @facets_loop, - ( - { - type_link_value => $link_value, - type_id => $link_value . "_id", - type_label => - $facets_info->{$link_value}->{'label_value'}, - facets => \@this_facets_array, - expandable => $expandable, - expand => $link_value, - } - ); + push @facets_loop, { + type_link_value => $link_value, + type_id => $link_value . "_id", + "type_label_" . $facets_info->{$link_value}->{'label_value'} => 1, + facets => \@this_facets_array, + expandable => $expandable, + expand => $link_value, + } unless ( ($facets_info->{$link_value}->{'label_value'} =~ /Libraries/) and (C4::Context->preference('singleBranchMode')) ); } } } @@ -624,16 +572,16 @@ sub pazGetRecords { my $paz = C4::Search::PazPar2->new(C4::Context->config('pazpar2url')); $paz->init(); $paz->search($simple_query); - sleep 1; + sleep 1; # FIXME: WHY? # do results my $results_hashref = {}; my $stats = XMLin($paz->stat); my $results = XMLin($paz->show($offset, $results_per_page, 'work-title:1'), forcearray => 1); - + # for a grouped search result, the number of hits # is the number of groups returned; 'bib_hits' will have - # the total number of bibs. + # the total number of bibs. $results_hashref->{'biblioserver'}->{'hits'} = $results->{'merged'}->[0]; $results_hashref->{'biblioserver'}->{'bib_hits'} = $stats->{'hits'}; @@ -665,7 +613,7 @@ sub pazGetRecords { push @{ $results_hashref->{'biblioserver'}->{'GROUPS'} }, $result_group; } - + # pass through facets my $termlist_xml = $paz->termlist('author,subject'); my $terms = XMLin($termlist_xml, forcearray => 1); @@ -699,18 +647,18 @@ sub _remove_stopwords { # we use IsAlpha unicode definition, to deal correctly with diacritics. # otherwise, a French word like "leçon" woudl be split into "le" "çon", "le" # is a stopword, we'd get "çon" and wouldn't find anything... - foreach ( keys %{ C4::Context->stopwords } ) { - next if ( $_ =~ /(and|or|not)/ ); # don't remove operators - if ( $operand =~ - /(\P{IsAlpha}$_\P{IsAlpha}|^$_\P{IsAlpha}|\P{IsAlpha}$_$)/ ) - { - $operand =~ s/\P{IsAlpha}$_\P{IsAlpha}/ /gi; - $operand =~ s/^$_\P{IsAlpha}/ /gi; - $operand =~ s/\P{IsAlpha}$_$/ /gi; - push @stopwords_removed, $_; - } - } - } +# + foreach ( keys %{ C4::Context->stopwords } ) { + next if ( $_ =~ /(and|or|not)/ ); # don't remove operators + $debug && warn "$_ Dump($operand)"; + if ( my ($matched) = ($operand =~ + /([^\X\p{isAlnum}]\Q$_\E[^\X\p{isAlnum}]|[^\X\p{isAlnum}]\Q$_\E$|^\Q$_\E[^\X\p{isAlnum}])/gi)) + { + $operand =~ s/\Q$matched\E/ /gi; + push @stopwords_removed, $_; + } + } + } return ( $operand, \@stopwords_removed ); } @@ -746,23 +694,25 @@ sub _detect_truncation { # STEMMING sub _build_stemmed_operand { - my ($operand) = @_; + my ($operand,$lang) = @_; + require Lingua::Stem::Snowball ; my $stemmed_operand; + # If operand contains a digit, it is almost certainly an identifier, and should + # not be stemmed. This is particularly relevant for ISBNs and ISSNs, which + # can contain the letter "X" - for example, _build_stemmend_operand would reduce + # "014100018X" to "x ", which for a MARC21 database would bring up irrelevant + # results (e.g., "23 x 29 cm." from the 300$c). Bug 2098. + return $operand if $operand =~ /\d/; + # FIXME: the locale should be set based on the user's language and/or search choice - my $stemmer = Lingua::Stem->new( -locale => 'EN-US' ); + #warn "$lang"; + my $stemmer = Lingua::Stem::Snowball->new( lang => $lang, + encoding => "UTF-8" ); -# FIXME: these should be stored in the db so the librarian can modify the behavior - $stemmer->add_exceptions( - { - 'and' => 'and', - 'or' => 'or', - 'not' => 'not', - } - ); my @words = split( / /, $operand ); - my $stems = $stemmer->stem(@words); - for my $stem (@$stems) { + my @stems = $stemmer->stem(\@words); + for my $stem (@stems) { $stemmed_operand .= "$stem"; $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 ); @@ -833,13 +783,201 @@ sub _build_weighted_query { return $weighted_query; } +=head2 getIndexes + +Return an array with available indexes. + +=cut + +sub getIndexes{ + my @indexes = ( + # biblio indexes + 'ab', + 'Abstract', + 'acqdate', + 'allrecords', + 'an', + 'Any', + 'at', + 'au', + 'aub', + 'aud', + 'audience', + 'auo', + 'aut', + 'Author', + 'Author-in-order ', + 'Author-personal-bibliography', + 'Authority-Number', + 'authtype', + 'bc', + 'biblionumber', + 'bio', + 'biography', + 'callnum', + 'cfn', + 'Chronological-subdivision', + 'cn-bib-source', + 'cn-bib-sort', + 'cn-class', + 'cn-item', + 'cn-prefix', + 'cn-suffix', + 'cpn', + 'Code-institution', + 'Conference-name', + 'Conference-name-heading', + 'Conference-name-see', + 'Conference-name-seealso', + 'Content-type', + 'Control-number', + 'copydate', + 'Corporate-name', + 'Corporate-name-heading', + 'Corporate-name-see', + 'Corporate-name-seealso', + 'ctype', + 'date-entered-on-file', + 'Date-of-acquisition', + 'Date-of-publication', + 'Dewey-classification', + 'extent', + 'fic', + 'fiction', + 'Form-subdivision', + 'format', + 'Geographic-subdivision', + 'he', + 'Heading', + 'Heading-use-main-or-added-entry', + 'Heading-use-series-added-entry ', + 'Heading-use-subject-added-entry', + 'Host-item', + 'id-other', + 'Illustration-code', + 'ISBN', + 'ISSN', + 'itemtype', + 'kw', + 'Koha-Auth-Number', + 'l-format', + 'language', + 'lc-card', + 'LC-card-number', + 'lcn', + 'llength', + 'ln', + 'Local-classification', + 'Local-number', + 'Match-heading', + 'Match-heading-see-from', + 'Material-type', + 'mc-itemtype', + 'mc-rtype', + 'mus', + 'Name-geographic', + 'Name-geographic-heading', + 'Name-geographic-see', + 'Name-geographic-seealso', + 'nb', + 'Note', + 'ns', + 'nt', + 'pb', + 'Personal-name', + 'Personal-name-heading', + 'Personal-name-see', + 'Personal-name-seealso', + 'pl', + 'Place-publication', + 'pn', + 'popularity', + 'pubdate', + 'Publisher', + 'Record-type', + 'rtype', + 'se', + 'See', + 'See-also', + 'sn', + 'Stock-number', + 'su', + 'Subject', + 'Subject-heading-thesaurus', + 'Subject-name-personal', + 'Subject-subdivision', + 'Summary', + 'Suppress', + 'su-geo', + 'su-na', + 'su-to', + 'su-ut', + 'ut', + 'Term-genre-form', + 'Term-genre-form-heading', + 'Term-genre-form-see', + 'Term-genre-form-seealso', + 'ti', + 'Title', + 'Title-cover', + 'Title-series', + 'Title-uniform', + 'Title-uniform-heading', + 'Title-uniform-see', + 'Title-uniform-seealso', + 'totalissues', + 'yr', + + # items indexes + 'acqsource', + 'barcode', + 'bc', + 'branch', + 'ccode', + 'classification-source', + 'cn-sort', + 'coded-location-qualifier', + 'copynumber', + 'damaged', + 'datelastborrowed', + 'datelastseen', + 'holdingbranch', + 'homebranch', + 'issues', + 'itemnumber', + 'itype', + 'Local-classification', + 'location', + 'lost', + 'materials-specified', + 'mc-ccode', + 'mc-itype', + 'mc-loc', + 'notforloan', + 'onloan', + 'price', + 'renewals', + 'replacementprice', + 'replacementpricedate', + 'reserves', + 'restricted', + 'stack', + 'uri', + 'withdrawn', + + # subject related + ); + + return \@indexes; +} + =head2 buildQuery ( $error, $query, $simple_query, $query_cgi, $query_desc, $limit, $limit_cgi, $limit_desc, -$stopwords_removed, $query_type ) = getRecords ( $operators, $operands, $indexes, $limits, $sort_by, $scan); +$stopwords_removed, $query_type ) = buildQuery ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang); Build queries and limits in CCL, CGI, Human, handle truncation, stemming, field weighting, stopwords, fuzziness, etc. @@ -850,18 +988,16 @@ See verbose embedded documentation. =cut sub buildQuery { - my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_; + my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_; - warn "---------" if $DEBUG; - warn "Enter buildQuery" if $DEBUG; - warn "---------" if $DEBUG; + warn "---------\nEnter buildQuery\n---------" if $DEBUG; # dereference - my @operators = @$operators if $operators; - my @indexes = @$indexes if $indexes; - my @operands = @$operands if $operands; - my @limits = @$limits if $limits; - my @sort_by = @$sort_by if $sort_by; + my @operators = $operators ? @$operators : (); + my @indexes = $indexes ? @$indexes : (); + my @operands = $operands ? @$operands : (); + my @limits = $limits ? @$limits : (); + my @sort_by = $sort_by ? @$sort_by : (); my $stemming = C4::Context->preference("QueryStemming") || 0; my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0; @@ -871,9 +1007,10 @@ sub buildQuery { # no stemming/weight/fuzzy in NoZebra if ( C4::Context->preference("NoZebra") ) { - $stemming = 0; - $weight_fields = 0; - $fuzzy_enabled = 0; + $stemming = 0; + $weight_fields = 0; + $fuzzy_enabled = 0; + $auto_truncation = 0; } my $query = $operands[0]; @@ -890,27 +1027,40 @@ sub buildQuery { my $stopwords_removed; # flag to determine if stopwords have been removed + my $cclq; + my $cclindexes = getIndexes(); + if( $query !~ /\s*ccl=/ ){ + for my $index (@$cclindexes){ + if($query =~ /($index)(,?\w)*[:=]/){ + $cclq = 1; + } + } + $query = "ccl=$query" if($cclq); + } + # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps # DIAGNOSTIC ONLY!! if ( $query =~ /^ccl=/ ) { - return ( undef, $', $', $', $', '', '', '', '', 'ccl' ); + return ( undef, $', $', "q=ccl=$'", $', '', '', '', '', 'ccl' ); } if ( $query =~ /^cql=/ ) { - return ( undef, $', $', $', $', '', '', '', '', 'cql' ); + return ( undef, $', $', "q=cql=$'", $', '', '', '', '', 'cql' ); } if ( $query =~ /^pqf=/ ) { - return ( undef, $', $', $', $', '', '', '', '', 'pqf' ); + return ( undef, $', $', "q=pqf=$'", $', '', '', '', '', 'pqf' ); } # pass nested queries directly # FIXME: need better handling of some of these variables in this case - if ( $query =~ /(\(|\))/ ) { - return ( - undef, $query, $simple_query, $query_cgi, - $query, $limit, $limit_cgi, $limit_desc, - $stopwords_removed, 'ccl' - ); - } + # Nested queries aren't handled well and this implementation is flawed and causes users to be + # unable to search for anything containing () commenting out, will be rewritten for 3.4.0 +# if ( $query =~ /(\(|\))/ ) { +# return ( +# undef, $query, $simple_query, $query_cgi, +# $query, $limit, $limit_cgi, $limit_desc, +# $stopwords_removed, 'ccl' +# ); +# } # Form-based queries are non-nested and fixed depth, so we can easily modify the incoming # query operands and indexes and add stemming, truncation, field weighting, etc. @@ -945,27 +1095,33 @@ sub buildQuery { if ( $index eq 'yr' ) { $index .= ",st-numeric"; $indexes_set++; - ( - $stemming, $auto_truncation, - $weight_fields, $fuzzy_enabled, - $remove_stopwords - ) = ( 0, 0, 0, 0, 0 ); + $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0; } # Date of Acquisition elsif ( $index eq 'acqdate' ) { $index .= ",st-date-normalized"; $indexes_set++; + $stemming = $auto_truncation = $weight_fields = $fuzzy_enabled = $remove_stopwords = 0; + } + # ISBN,ISSN,Standard Number, don't need special treatment + elsif ( $index eq 'nb' || $index eq 'ns' ) { + $indexes_set++; ( $stemming, $auto_truncation, $weight_fields, $fuzzy_enabled, $remove_stopwords ) = ( 0, 0, 0, 0, 0 ); - } + } + + if(not $index){ + $index = 'kw'; + } + # Set default structure attribute (word list) my $struct_attr; - unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) { + unless ( $indexes_set || !$index || $index =~ /(st-|phr|ext|wrdl)/ ) { $struct_attr = ",wrdl"; } @@ -982,12 +1138,19 @@ sub buildQuery { if ( $stopwords_removed && $DEBUG ); } + if ($auto_truncation){ + unless ( $index =~ /(st-|phr|ext)/ ) { + #FIXME only valid with LTR scripts + $operand=join(" ",map{ + (index($_,"*")>0?"$_":"$_*") + }split (/\s+/,$operand)); + warn $operand if $DEBUG; + } + } + # Detect Truncation - my ( $nontruncated, $righttruncated, $lefttruncated, - $rightlefttruncated, $regexpr ); my $truncated_operand; - ( - $nontruncated, $righttruncated, $lefttruncated, + my( $nontruncated, $righttruncated, $lefttruncated, $rightlefttruncated, $regexpr ) = _detect_truncation( $operand, $index ); warn @@ -1004,29 +1167,23 @@ sub buildQuery { $indexes_set = 1; undef $weight_fields; my $previous_truncation_operand; - if ( scalar(@$nontruncated) > 0 ) { + if (scalar @$nontruncated) { $truncated_operand .= "$index_plus @$nontruncated "; $previous_truncation_operand = 1; } - if ( scalar(@$righttruncated) > 0 ) { - $truncated_operand .= "and " - if $previous_truncation_operand; - $truncated_operand .= - "$index_plus_comma" . "rtrn:@$righttruncated "; + if (scalar @$righttruncated) { + $truncated_operand .= "and " if $previous_truncation_operand; + $truncated_operand .= $index_plus_comma . "rtrn:@$righttruncated "; $previous_truncation_operand = 1; } - if ( scalar(@$lefttruncated) > 0 ) { - $truncated_operand .= "and " - if $previous_truncation_operand; - $truncated_operand .= - "$index_plus_comma" . "ltrn:@$lefttruncated "; + if (scalar @$lefttruncated) { + $truncated_operand .= "and " if $previous_truncation_operand; + $truncated_operand .= $index_plus_comma . "ltrn:@$lefttruncated "; $previous_truncation_operand = 1; } - if ( scalar(@$rightlefttruncated) > 0 ) { - $truncated_operand .= "and " - if $previous_truncation_operand; - $truncated_operand .= - "$index_plus_comma" . "rltrn:@$rightlefttruncated "; + if (scalar @$rightlefttruncated) { + $truncated_operand .= "and " if $previous_truncation_operand; + $truncated_operand .= $index_plus_comma . "rltrn:@$rightlefttruncated "; $previous_truncation_operand = 1; } } @@ -1035,18 +1192,20 @@ sub buildQuery { # Handle Stemming my $stemmed_operand; - $stemmed_operand = _build_stemmed_operand($operand) - if $stemming; + $stemmed_operand = _build_stemmed_operand($operand, $lang) + if $stemming; + warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG; # Handle Field Weighting my $weighted_operand; - $weighted_operand = - _build_weighted_query( $operand, $stemmed_operand, $index ) - if $weight_fields; + if ($weight_fields) { + $weighted_operand = _build_weighted_query( $operand, $stemmed_operand, $index ); + $operand = $weighted_operand; + $indexes_set = 1; + } + warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG; - $operand = $weighted_operand if $weight_fields; - $indexes_set = 1 if $weight_fields; # If there's a previous operand, we need to add an operator if ($previous_operand) { @@ -1094,20 +1253,21 @@ sub buildQuery { my $group_OR_limits; my $availability_limit; foreach my $this_limit (@limits) { - if ( $this_limit =~ /available/ ) { - -# 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0) -# In English: -# all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0 - $availability_limit .= -"( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )"; - $limit_cgi .= "&limit=available"; - $limit_desc .= ""; - } - +# if ( $this_limit =~ /available/ ) { +# +## 'available' is defined as (items.onloan is NULL) and (items.itemlost = 0) +## In English: +## all records not indexed in the onloan register (zebra) and all records with a value of lost equal to 0 +# $availability_limit .= +#"( ( allrecords,AlwaysMatches='' not onloan,AlwaysMatches='') and (lost,st-numeric=0) )"; #or ( allrecords,AlwaysMatches='' not lost,AlwaysMatches='')) )"; +# $limit_cgi .= "&limit=available"; +# $limit_desc .= ""; +# } +# # group_OR_limits, prefixed by mc- # OR every member of the group - elsif ( $this_limit =~ /mc/ ) { +# elsif ( $this_limit =~ /mc/ ) { + if ( $this_limit =~ /mc/ ) { $group_OR_limits .= " or " if $group_OR_limits; $limit_desc .= " or " if $group_OR_limits; $group_OR_limits .= "$this_limit"; @@ -1120,7 +1280,17 @@ sub buildQuery { $limit .= " and " if $limit || $query; $limit .= "$this_limit"; $limit_cgi .= "&limit=$this_limit"; - $limit_desc .= " $this_limit"; + if ($this_limit =~ /^branch:(.+)/) { + my $branchcode = $1; + my $branchname = GetBranchName($branchcode); + if (defined $branchname) { + $limit_desc .= " branch:$branchname"; + } else { + $limit_desc .= " $this_limit"; + } + } else { + $limit_desc .= " $this_limit"; + } } } if ($group_OR_limits) { @@ -1133,18 +1303,20 @@ sub buildQuery { } # Normalize the query and limit strings + # This is flawed , means we can't search anything with : in it + # if user wants to do ccl or cql, start the query with that $query =~ s/:/=/g; $limit =~ s/:/=/g; for ( $query, $query_desc, $limit, $limit_desc ) { - $_ =~ s/ / /g; # remove extra spaces - $_ =~ s/^ //g; # remove any beginning spaces - $_ =~ s/ $//g; # remove any ending spaces - $_ =~ s/==/=/g; # remove double == from query + s/ / /g; # remove extra spaces + s/^ //g; # remove any beginning spaces + s/ $//g; # remove any ending spaces + s/==/=/g; # remove double == from query } $query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi for ($query_cgi,$simple_query) { - $_ =~ s/"//g; + s/"//g; } # append the limit to the query $query .= " " . $limit; @@ -1157,9 +1329,7 @@ sub buildQuery { warn "LIMIT:" . $limit; warn "LIMIT CGI:" . $limit_cgi; warn "LIMIT DESC:" . $limit_desc; - warn "---------"; - warn "Leave buildQuery"; - warn "---------"; + warn "---------\nLeave buildQuery\n---------"; } return ( undef, $query, $simple_query, $query_cgi, @@ -1177,39 +1347,26 @@ Format results in a form suitable for passing to the template # IMO this subroutine is pretty messy still -- it's responsible for # building the HTML output for the template sub searchResults { - my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_; + my ( $searchdesc, $hits, $results_per_page, $offset, $scan, @marcresults, $hidelostitems ) = @_; my $dbh = C4::Context->dbh; - my $toggle; - my $even = 1; my @newresults; - # add search-term highlighting via s on the search terms - my $span_terms_hashref; - for my $span_term ( split( / /, $searchdesc ) ) { - $span_term =~ s/(.*=|\)|\(|\+|\.|\*)//g; - $span_terms_hashref->{$span_term}++; - } - #Build branchnames hash #find branchname #get branch information..... my %branches; - my $bsth = - $dbh->prepare("SELECT branchcode,branchname FROM branches") - ; # FIXME : use C4::Koha::GetBranches + my $bsth =$dbh->prepare("SELECT branchcode,branchname FROM branches"); # FIXME : use C4::Branch::GetBranches $bsth->execute(); while ( my $bdata = $bsth->fetchrow_hashref ) { $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'}; } - my %locations; - my $lsch = - $dbh->prepare( -"SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'" - ); - $lsch->execute(); - while ( my $ldata = $lsch->fetchrow_hashref ) { - $locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'}; - } +# FIXME - We build an authorised values hash here, using the default framework +# though it is possible to have different authvals for different fws. + + my $shelflocations =GetKohaAuthorisedValues('items.location',''); + + # get notforloan authorised value list (see $shelflocations FIXME) + my $notforloan_authorised_value = GetAuthValCode('items.notforloan',''); #Build itemtype hash #find itemtype & itemtype image @@ -1220,12 +1377,9 @@ sub searchResults { ); $bsth->execute(); while ( my $bdata = $bsth->fetchrow_hashref ) { - $itemtypes{ $bdata->{'itemtype'} }->{description} = - $bdata->{'description'}; - $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'}; - $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'}; - $itemtypes{ $bdata->{'itemtype'} }->{notforloan} = - $bdata->{'notforloan'}; + foreach (qw(description imageurl summary notforloan)) { + $itemtypes{ $bdata->{'itemtype'} }->{$_} = $bdata->{$_}; + } } #search item field code @@ -1236,14 +1390,6 @@ sub searchResults { $sth->execute; my ($itemtag) = $sth->fetchrow; - # get notforloan authorised value list - $sth = - $dbh->prepare( -"SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''" - ); - $sth->execute; - my ($notforloan_authorised_value) = $sth->fetchrow; - ## find column names of items related to MARC my $sth2 = $dbh->prepare("SHOW COLUMNS FROM items"); $sth2->execute; @@ -1260,119 +1406,89 @@ sub searchResults { $times = $offset + $results_per_page; } else { - $times = $hits; + $times = $hits; # FIXME: if $hits is undefined, why do we want to equal it? } + my $marcflavour = C4::Context->preference("marcflavour"); + # We get the biblionumber position in MARC + my ($bibliotag,$bibliosubf)=GetMarcFromKohaField('biblio.biblionumber',''); + my $fw; + # loop through all of the records we've retrieved for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) { - my $marcrecord; - $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] ); - my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' ); + my $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] ); + if ($bibliotag<10){ + $fw = GetFrameworkCode($marcrecord->field($bibliotag)->data); + }else{ + $fw = GetFrameworkCode($marcrecord->subfield($bibliotag,$bibliosubf)); + } + + my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, $fw ); + $oldbiblio->{subtitle} = GetRecordValue('subtitle', $marcrecord, $fw); $oldbiblio->{result_number} = $i + 1; # add imageurl to itemtype if there is one - if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) { - $oldbiblio->{imageurl} = - $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}; - $oldbiblio->{description} = - $itemtypes{ $oldbiblio->{itemtype} }->{description}; - } - else { - $oldbiblio->{imageurl} = - getitemtypeimagesrc() . "/" - . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} - if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} ); - $oldbiblio->{description} = - $itemtypes{ $oldbiblio->{itemtype} }->{description}; - } - + $oldbiblio->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} ); + + $oldbiblio->{'authorised_value_images'} = C4::Items::get_authorised_value_images( C4::Biblio::get_biblio_authorised_values( $oldbiblio->{'biblionumber'}, $marcrecord ) ); + $oldbiblio->{normalized_upc} = GetNormalizedUPC( $marcrecord,$marcflavour); + $oldbiblio->{normalized_ean} = GetNormalizedEAN( $marcrecord,$marcflavour); + $oldbiblio->{normalized_oclc} = GetNormalizedOCLCNumber($marcrecord,$marcflavour); + $oldbiblio->{normalized_isbn} = GetNormalizedISBN(undef,$marcrecord,$marcflavour); + $oldbiblio->{content_identifier_exists} = 1 if ($oldbiblio->{normalized_isbn} or $oldbiblio->{normalized_oclc} or $oldbiblio->{normalized_ean} or $oldbiblio->{normalized_upc}); + + # edition information, if any + $oldbiblio->{edition} = $oldbiblio->{editionstatement}; + $oldbiblio->{description} = $itemtypes{ $oldbiblio->{itemtype} }->{description}; # Build summary if there is one (the summary is defined in the itemtypes table) # FIXME: is this used anywhere, I think it can be commented out? -- JF if ( $itemtypes{ $oldbiblio->{itemtype} }->{summary} ) { my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary}; my @fields = $marcrecord->fields(); - foreach my $field (@fields) { - my $tag = $field->tag(); - my $tagvalue = $field->as_string(); - $summary =~ - s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g; - unless ( $tag < 10 ) { - my @subf = $field->subfields; - for my $i ( 0 .. $#subf ) { - my $subfieldcode = $subf[$i][0]; - my $subfieldvalue = $subf[$i][1]; - my $tagsubf = $tag . $subfieldcode; - $summary =~ -s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; + + my $newsummary; + foreach my $line ( "$summary\n" =~ /(.*)\n/g ){ + my $tags = {}; + foreach my $tag ( $line =~ /\[(\d{3}[\w|\d])\]/ ) { + $tag =~ /(.{3})(.)/; + if($marcrecord->field($1)){ + my @abc = $marcrecord->field($1)->subfield($2); + $tags->{$tag} = $#abc + 1 ; } } - } - # FIXME: yuk - $summary =~ s/\[(.*?)]//g; - $summary =~ s/\n/
/g; - $oldbiblio->{summary} = $summary; - } -# Add search-term highlighting to the whole record where they match using s - if (C4::Context->preference("OpacHighlightedWords")){ - my $searchhighlightblob; - for my $highlight_field ( $marcrecord->fields ) { - - # FIXME: need to skip title, subtitle, author, etc., as they are handled below - next if $highlight_field->tag() =~ /(^00)/; # skip fixed fields - for my $subfield ($highlight_field->subfields()) { - my $match; - next if $subfield->[0] eq '9'; - my $field = $subfield->[1]; - for my $term ( keys %$span_terms_hashref ) { - if ( ( $field =~ /$term/i ) && (( length($term) > 3 ) || ($field =~ / $term /i)) ) { - $field =~ s/$term/$&<\/span>/gi; - $match++; + # We catch how many times to repeat this line + my $max = 0; + foreach my $tag (keys(%$tags)){ + $max = $tags->{$tag} if($tags->{$tag} > $max); + } + + # we replace, and repeat each line + for (my $i = 0 ; $i < $max ; $i++){ + my $newline = $line; + + foreach my $tag ( $newline =~ /\[(\d{3}[\w|\d])\]/g ) { + $tag =~ /(.{3})(.)/; + + if($marcrecord->field($1)){ + my @repl = $marcrecord->field($1)->subfield($2); + my $subfieldvalue = $repl[$i]; + + if (! utf8::is_utf8($subfieldvalue)) { + utf8::decode($subfieldvalue); + } + + $newline =~ s/\[$tag\]/$subfieldvalue/g; } } - $searchhighlightblob .= $field . " ... " if $match; + $newsummary .= "$newline\n"; } - - } - $searchhighlightblob = ' ... '.$searchhighlightblob if $searchhighlightblob; - $oldbiblio->{'searchhighlightblob'} = $searchhighlightblob; - } -# save an author with no tag, for the > link - $oldbiblio->{'author_nospan'} = $oldbiblio->{'author'}; - - # Add search-term highlighting to the title, subtitle, etc. fields - for my $term ( keys %$span_terms_hashref ) { - my $old_term = $term; - if ( length($term) > 3 ) { - $term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g; - $oldbiblio->{'title'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'subtitle'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'author'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'publishercode'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'place'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'pages'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'notes'} =~ - s/$term/$&<\/span>/gi; - $oldbiblio->{'size'} =~ - s/$term/$&<\/span>/gi; } - } - # FIXME: - # surely there's a better way to handle this - if ( $i % 2 ) { - $toggle = "#ffffcc"; - } - else { - $toggle = "white"; + $newsummary =~ s/\[(.*?)]//g; + $newsummary =~ s/\n//g; + $oldbiblio->{summary} = $newsummary; } - $oldbiblio->{'toggle'} = $toggle; # Pull out the items fields my @fields = $marcrecord->field($itemtag); @@ -1386,18 +1502,18 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; my $onloan_items; my $other_items; - my $ordered_count = 0; - my $available_count = 0; - my $onloan_count = 0; - my $longoverdue_count = 0; - my $other_count = 0; - my $wthdrawn_count = 0; - my $itemlost_count = 0; - my $itembinding_count = 0; - my $itemdamaged_count = 0; - my $can_place_holds = 0; - my $items_count = scalar(@fields); - my $items_counter; + my $ordered_count = 0; + my $available_count = 0; + my $onloan_count = 0; + my $longoverdue_count = 0; + my $other_count = 0; + my $wthdrawn_count = 0; + my $itemlost_count = 0; + my $itembinding_count = 0; + my $itemdamaged_count = 0; + my $item_in_transit_count = 0; + my $can_place_holds = 0; + my $items_count = scalar(@fields); my $maxitems = ( C4::Context->preference('maxItemsinSearchResults') ) ? C4::Context->preference('maxItemsinSearchResults') - 1 @@ -1406,39 +1522,38 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; # loop through every item foreach my $field (@fields) { my $item; - $items_counter++; # populate the items hash foreach my $code ( keys %subfieldstosearch ) { $item->{$code} = $field->subfield( $subfieldstosearch{$code} ); } + my $hbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'homebranch' : 'holdingbranch'; + my $otherbranch = C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch' ? 'holdingbranch' : 'homebranch'; # set item's branch name, use HomeOrHoldingBranch syspref first, fall back to the other one - if ( $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} ) { - $item->{'branchname'} = $branches{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} }; + if ($item->{$hbranch}) { + $item->{'branchname'} = $branches{$item->{$hbranch}}; } - # Last resort - elsif ( $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'holdingbranch':'homebranch'} ) { - $item->{'branchname'} = $branches{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'holdingbranch':'homebranch'} }; + elsif ($item->{$otherbranch}) { # Last resort + $item->{'branchname'} = $branches{$item->{$otherbranch}}; } + my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item if ( $item->{onloan} ) { $onloan_count++; - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{due_date} = format_date( $item->{onloan} ); - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{count}++ if $item->{'homebranch'}; - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{branchname} = $item->{'branchname'}; - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{location} = $locations{ $item->{location} }; - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{itemcallnumber} = $item->{itemcallnumber}; - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl}; + my $key = $prefix . $item->{onloan} . $item->{barcode}; + $onloan_items->{$key}->{due_date} = format_date($item->{onloan}); + $onloan_items->{$key}->{count}++ if $item->{$hbranch}; + $onloan_items->{$key}->{branchname} = $item->{branchname}; + $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber}; + $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} ); # if something's checked out and lost, mark it as 'long overdue' if ( $item->{itemlost} ) { - $onloan_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{due_date} }->{longoverdue}++; + $onloan_items->{$prefix}->{longoverdue}++; $longoverdue_count++; - } - - # can place holds as long as this item isn't lost - else { + } else { # can place holds as long as item isn't lost $can_place_holds = 1; } } @@ -1451,38 +1566,65 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; $ordered_count++; } + # is item in transit? + my $transfertwhen = ''; + my ($transfertfrom, $transfertto); + + unless ($item->{wthdrawn} + || $item->{itemlost} + || $item->{damaged} + || $item->{notforloan} + || $items_count > 20) { + + # A couple heuristics to limit how many times + # we query the database for item transfer information, sacrificing + # accuracy in some cases for speed; + # + # 1. don't query if item has one of the other statuses + # 2. don't check transit status if the bib has + # more than 20 items + # + # FIXME: to avoid having the query the database like this, and to make + # the in transit status count as unavailable for search limiting, + # should map transit status to record indexed in Zebra. + # + ($transfertwhen, $transfertfrom, $transfertto) = C4::Circulation::GetTransfers($item->{itemnumber}); + } + # item is withdrawn, lost or damaged if ( $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} - || $item->{notforloan} ) + || $item->{notforloan} + || ($transfertwhen ne '')) { - $wthdrawn_count++ if $item->{wthdrawn}; - $itemlost_count++ if $item->{itemlost}; - $itemdamaged_count++ if $item->{damaged}; + $wthdrawn_count++ if $item->{wthdrawn}; + $itemlost_count++ if $item->{itemlost}; + $itemdamaged_count++ if $item->{damaged}; + $item_in_transit_count++ if $transfertwhen ne ''; $item->{status} = $item->{wthdrawn} . "-" . $item->{itemlost} . "-" . $item->{damaged} . "-" . $item->{notforloan}; $other_count++; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{wthdrawn} = $item->{wthdrawn}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemlost} = $item->{itemlost}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{damaged} = $item->{damaged}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{notforloan} = GetAuthorisedValueDesc( '', '', $item->{notforloan}, '', '', $notforloan_authorised_value ) if $notforloan_authorised_value; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{count}++ if $item->{'homebranch'}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{branchname} = $item->{'branchname'}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{location} = $locations{ $item->{location} }; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{itemcallnumber} = $item->{itemcallnumber}; - $other_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} . $item->{status} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl}; + my $key = $prefix . $item->{status}; + foreach (qw(wthdrawn itemlost damaged branchname itemcallnumber)) { + $other_items->{$key}->{$_} = $item->{$_}; + } + $other_items->{$key}->{intransit} = ($transfertwhen ne '') ? 1 : 0; + $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value; + $other_items->{$key}->{count}++ if $item->{$hbranch}; + $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $other_items->{$key}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} ); } - # item is available else { $can_place_holds = 1; $available_count++; - $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{count}++ if $item->{'homebranch'}; - $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{branchname} = $item->{'branchname'}; - $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{location} = $locations{ $item->{location} }; - $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber}; - $available_items->{ $item->{C4::Context->preference('HomeOrHoldingBranch') eq 'homebranch'?'homebranch':'holdingbranch'} . '--' . $item->{location} . $item->{'itype'} . $item->{'itemcallnumber'} }->{imageurl} = getitemtypeimagesrc() . "/" . $itemtypes{ $item->{itype} }->{imageurl}; + $available_items->{$prefix}->{count}++ if $item->{$hbranch}; + foreach (qw(branchname itemcallnumber)) { + $available_items->{$prefix}->{$_} = $item->{$_}; + } + $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; + $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( 'opac', $itemtypes{ $item->{itype} }->{imageurl} ); } } } # notforloan, item level and biblioitem level @@ -1492,22 +1634,29 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; ? C4::Context->preference('maxItemsinSearchResults') - 1 : 1; for my $key ( sort keys %$onloan_items ) { - $onloanitemscount++; - push @onloan_items_loop, $onloan_items->{$key} - unless $onloanitemscount > $maxitems; + (++$onloanitemscount > $maxitems) and last; + push @onloan_items_loop, $onloan_items->{$key}; } for my $key ( sort keys %$other_items ) { - $otheritemscount++; - push @other_items_loop, $other_items->{$key} - unless $otheritemscount > $maxitems; + (++$otheritemscount > $maxitems) and last; + push @other_items_loop, $other_items->{$key}; } for my $key ( sort keys %$available_items ) { - $availableitemscount++; + (++$availableitemscount > $maxitems) and last; push @available_items_loop, $available_items->{$key} - unless $availableitemscount > $maxitems; } -# last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items + # XSLT processing of some stuff + my $debug=1; + use C4::Charset; + SetUTF8Flag($marcrecord); + $debug && warn $marcrecord->as_formatted; + if (C4::Context->preference("XSLTResultsDisplay") && !$scan) { + $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display( + $oldbiblio->{biblionumber}, $marcrecord, 'Results' ); + } + + # last check for norequest : if itemtype is notforloan, it can't be reserved either, whatever the items $can_place_holds = 0 if $itemtypes{ $oldbiblio->{itemtype} }->{notforloan}; $oldbiblio->{norequests} = 1 unless $can_place_holds; @@ -1525,14 +1674,107 @@ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; $oldbiblio->{wthdrawncount} = $wthdrawn_count; $oldbiblio->{itemlostcount} = $itemlost_count; $oldbiblio->{damagedcount} = $itemdamaged_count; + $oldbiblio->{intransitcount} = $item_in_transit_count; $oldbiblio->{orderedcount} = $ordered_count; $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content - push( @newresults, $oldbiblio ); + push( @newresults, $oldbiblio ) + if(not $hidelostitems + or (($items_count > $itemlost_count ) + && $hidelostitems)); } + return @newresults; } +=head2 SearchAcquisitions + Search for acquisitions +=cut + +sub SearchAcquisitions{ + my ($datebegin, $dateend, $itemtypes,$criteria, $orderby) = @_; + + my $dbh=C4::Context->dbh; + # Variable initialization + my $str=qq| + SELECT marcxml + FROM biblio + LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber + LEFT JOIN items ON items.biblionumber=biblio.biblionumber + WHERE dateaccessioned BETWEEN ? AND ? + |; + + my (@params,@loopcriteria); + + push @params, $datebegin->output("iso"); + push @params, $dateend->output("iso"); + + if (scalar(@$itemtypes)>0 and $criteria ne "itemtype" ){ + if(C4::Context->preference("item-level_itypes")){ + $str .= "AND items.itype IN (?".( ',?' x scalar @$itemtypes - 1 ).") "; + }else{ + $str .= "AND biblioitems.itemtype IN (?".( ',?' x scalar @$itemtypes - 1 ).") "; + } + push @params, @$itemtypes; + } + + if ($criteria =~/itemtype/){ + if(C4::Context->preference("item-level_itypes")){ + $str .= "AND items.itype=? "; + }else{ + $str .= "AND biblioitems.itemtype=? "; + } + + if(scalar(@$itemtypes) == 0){ + my $itypes = GetItemTypes(); + for my $key (keys %$itypes){ + push @$itemtypes, $key; + } + } + + @loopcriteria= @$itemtypes; + }elsif ($criteria=~/itemcallnumber/){ + $str .= "AND (items.itemcallnumber LIKE CONCAT(?,'%') + OR items.itemcallnumber is NULL + OR items.itemcallnumber = '')"; + + @loopcriteria = ("AA".."ZZ", "") unless (scalar(@loopcriteria)>0); + }else { + $str .= "AND biblio.title LIKE CONCAT(?,'%') "; + @loopcriteria = ("A".."z") unless (scalar(@loopcriteria)>0); + } + + if ($orderby =~ /date_desc/){ + $str.=" ORDER BY dateaccessioned DESC"; + } else { + $str.=" ORDER BY title"; + } + + my $qdataacquisitions=$dbh->prepare($str); + + my @loopacquisitions; + foreach my $value(@loopcriteria){ + push @params,$value; + my %cell; + $cell{"title"}=$value; + $cell{"titlecode"}=$value; + + eval{$qdataacquisitions->execute(@params);}; + + if ($@){ warn "recentacquisitions Error :$@";} + else { + my @loopdata; + while (my $data=$qdataacquisitions->fetchrow_hashref){ + push @loopdata, {"summary"=>GetBiblioSummary( $data->{'marcxml'} ) }; + } + $cell{"loopdata"}=\@loopdata; + } + push @loopacquisitions,\%cell if (scalar(@{$cell{loopdata}})>0); + pop @params; + } + $qdataacquisitions->finish; + return \@loopacquisitions; +} #---------------------------------------------------------------------- # # Non-Zebra GetRecords# @@ -1608,7 +1850,7 @@ sub NZanalyse { # depending of operand, intersect, union or exclude both lists # to get a result list if ( $operator eq ' and ' ) { - return NZoperatorAND($leftresult,$rightresult); + return NZoperatorAND($leftresult,$rightresult); } elsif ( $operator eq ' or ' ) { @@ -1616,19 +1858,23 @@ sub NZanalyse { return $leftresult . $rightresult; } elsif ( $operator eq ' not ' ) { - return NZoperatorNOT($leftresult,$rightresult); + return NZoperatorNOT($leftresult,$rightresult); } - } + } else { # this error is impossible, because of the regexp that isolate the operand, but just in case... return $leftresult; - } + } } warn "string :" . $string if $DEBUG; - $string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/; - my $left = $1; - my $right = $3; - my $operator = lc($2); # FIXME: and/or/not are operators, not operands + my $left = ""; + my $right = ""; + my $operator = ""; + if ($string =~ /(.*?)( and | or | not | AND | OR | NOT )(.*)/) { + $left = $1; + $right = $3; + $operator = lc($2); # FIXME: and/or/not are operators, not operands + } warn "no parenthesis. left : $left operator: $operator right: $right" if $DEBUG; @@ -1669,28 +1915,39 @@ sub NZanalyse { else { $string =~ s/__X__/"$commacontent"/ if $commacontent; $string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g; + #remove trailing blank at the beginning + $string =~ s/^ //g; warn "leaf:$string" if $DEBUG; # parse the string in in operator/operand/value again - $string =~ /(.*)(>=|<=)(.*)/; - my $left = $1; - my $operator = $2; - my $right = $3; -# warn "handling leaf... left:$left operator:$operator right:$right" -# if $DEBUG; - unless ($operator) { - $string =~ /(.*)(>|<|=)(.*)/; + my $left = ""; + my $operator = ""; + my $right = ""; + if ($string =~ /(.*)(>=|<=)(.*)/) { $left = $1; $operator = $2; $right = $3; -# warn -# "handling unless (operator)... left:$left operator:$operator right:$right" -# if $DEBUG; + } else { + $left = $string; + } +# warn "handling leaf... left:$left operator:$operator right:$right" +# if $DEBUG; + unless ($operator) { + if ($string =~ /(.*)(>|<|=)(.*)/) { + $left = $1; + $operator = $2; + $right = $3; + warn + "handling unless (operator)... left:$left operator:$operator right:$right" + if $DEBUG; + } else { + $left = $string; + } } my $results; # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr... - $left =~ s/[, ].*$//; + $left =~ s/ .*$//; # automatic replace for short operators $left = 'title' if $left =~ '^ti$'; @@ -1699,17 +1956,16 @@ sub NZanalyse { $left = 'subject' if $left =~ '^su$'; $left = 'koha-Auth-Number' if $left =~ '^an$'; $left = 'keyword' if $left =~ '^kw$'; - warn "handling leaf... left:$left operator:$operator right:$right"; + $left = 'itemtype' if $left =~ '^mc$'; # Fix for Bug 2599 - Search limits not working for NoZebra + warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG; + my $dbh = C4::Context->dbh; if ( $operator && $left ne 'keyword' ) { - #do a specific search - my $dbh = C4::Context->dbh; $operator = 'LIKE' if $operator eq '=' and $right =~ /%/; - my $sth = - $dbh->prepare( + my $sth = $dbh->prepare( "SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?" - ); - warn "$left / $operator / $right\n"; + ); + warn "$left / $operator / $right\n" if $DEBUG; # split each word, query the DB and build the biblionumbers result #sanitizing leftpart @@ -1718,7 +1974,7 @@ sub NZanalyse { my $biblionumbers; $_ =~ s/^\s+|\s+$//; next unless $_; - warn "EXECUTE : $server, $left, $_"; + warn "EXECUTE : $server, $left, $_" if $DEBUG; $sth->execute( $server, $left, $_ ) or warn "execute failed: $!"; while ( my ( $line, $value ) = $sth->fetchrow ) { @@ -1729,27 +1985,23 @@ sub NZanalyse { unless ( $right =~ /^\d+$/ && $value =~ /\D/ ); warn "result : $value " . ( $right =~ /\d/ ) . "==" - . ( $value =~ /\D/?$line:"" ); #= $line"; + . ( $value =~ /\D/?$line:"" ) if $DEBUG; #= $line"; } # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list if ($results) { - warn "NZAND"; + warn "NZAND" if $DEBUG; $results = NZoperatorAND($biblionumbers,$results); - } - else { + } else { $results = $biblionumbers; } } } else { - #do a complete search (all indexes), if index='kw' do complete search too. - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( + my $sth = $dbh->prepare( "SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?" - ); + ); # split each word, query the DB and build the biblionumbers result foreach ( split / /, $string ) { @@ -1775,17 +2027,15 @@ sub NZanalyse { warn "return : $results for LEAF : $string" if $DEBUG; return $results; } - warn "---------" if $DEBUG; - warn "Leave NZanalyse" if $DEBUG; - warn "---------" if $DEBUG; + warn "---------\nLeave NZanalyse\n---------" if $DEBUG; } sub NZoperatorAND{ my ($rightresult, $leftresult)=@_; - + my @leftresult = split /;/, $leftresult; warn " @leftresult / $rightresult \n" if $DEBUG; - + # my @rightresult = split /;/,$leftresult; my $finalresult; @@ -1797,24 +2047,24 @@ sub NZoperatorAND{ my $value = $_; my $countvalue; ( $value, $countvalue ) = ( $1, $2 ) if ($value=~/(.*)-(\d+)$/); - if ( $rightresult =~ /$value-(\d+);/ ) { + if ( $rightresult =~ /\Q$value\E-(\d+);/ ) { $countvalue = ( $1 > $countvalue ? $countvalue : $1 ); $finalresult .= "$value-$countvalue;$value-$countvalue;"; } } - warn " $finalresult \n" if $DEBUG; + warn "NZAND DONE : $finalresult \n" if $DEBUG; return $finalresult; } - + sub NZoperatorOR{ my ($rightresult, $leftresult)=@_; return $rightresult.$leftresult; } sub NZoperatorNOT{ - my ($rightresult, $leftresult)=@_; - + my ($leftresult, $rightresult)=@_; + my @leftresult = split /;/, $leftresult; # my @rightresult = split /;/,$leftresult; @@ -1832,7 +2082,7 @@ sub NZoperatorNOT{ =head2 NZorder $finalresult = NZorder($biblionumbers, $ordering,$results_per_page,$offset); - + TODO :: Description =cut @@ -1864,7 +2114,7 @@ sub NZorder { my $popularity = $sth->fetchrow || 0; # hint : the key is popularity.title because we can have -# many results with the same popularity. In this cas, sub-ordering is done by title +# many results with the same popularity. In this case, sub-ordering is done by title # we also have biblionumber to avoid bug for 2 biblios with the same title & popularity # (un-frequent, I agree, but we won't forget anything that way ;-) $popularity{ sprintf( "%10d", $popularity ) . $title @@ -1944,15 +2194,13 @@ sub NZorder { my ( $biblionumber, $title ) = split /,/, $_; my $record = GetMarcBiblio($biblionumber); my $callnumber; - my ( $callnumber_tag, $callnumber_subfield ) = - GetMarcFromKohaField( $dbh, 'items.itemcallnumber' ); - ( $callnumber_tag, $callnumber_subfield ) = - GetMarcFromKohaField('biblioitems.callnumber') - unless $callnumber_tag; + my $frameworkcode = GetFrameworkCode($biblionumber); + my ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField( 'items.itemcallnumber', $frameworkcode); + ( $callnumber_tag, $callnumber_subfield ) = GetMarcFromKohaField('biblioitems.callnumber', $frameworkcode) + unless $callnumber_tag; if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) { $callnumber = $record->subfield( '200', 'f' ); - } - else { + } else { $callnumber = $record->subfield( '100', 'a' ); } @@ -2125,130 +2373,264 @@ sub NZorder { } } -=head2 ModBiblios +=head2 enabled_staff_search_views -($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test); +%hash = enabled_staff_search_views() -this function changes all the values $initvalue in subfield $tag$subfield in any record in $listbiblios -test parameter if set donot perform change to records in database. +This function returns a hash that contains three flags obtained from the system +preferences, used to determine whether a particular staff search results view +is enabled. =over 2 -=item C +=item C + + * $hash{can_view_MARC} is true only if the MARC view is enabled + * $hash{can_view_ISBD} is true only if the ISBD view is enabled + * $hash{can_view_labeledMARC} is true only if the Labeled MARC view is enabled + +=item C + +=back + +$template->param ( C4::Search::enabled_staff_search_views ); + +=cut + +sub enabled_staff_search_views +{ + return ( + can_view_MARC => C4::Context->preference('viewMARC'), # 1 if the staff search allows the MARC view + can_view_ISBD => C4::Context->preference('viewISBD'), # 1 if the staff search allows the ISBD view + can_view_labeledMARC => C4::Context->preference('viewLabeledMARC'), # 1 if the staff search allows the Labeled MARC view + ); +} + +sub AddSearchHistory{ + my ($borrowernumber,$session,$query_desc,$query_cgi, $total)=@_; + my $dbh = C4::Context->dbh; + + # Add the request the user just made + my $sql = "INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time) VALUES(?, ?, ?, ?, ?, NOW())"; + my $sth = $dbh->prepare($sql); + $sth->execute($borrowernumber, $session, $query_desc, $query_cgi, $total); + return $dbh->last_insert_id(undef, 'search_history', undef,undef,undef); +} + +sub GetSearchHistory{ + my ($borrowernumber,$session)=@_; + my $dbh = C4::Context->dbh; + + # Add the request the user just made + my $query = "SELECT FROM search_history WHERE (userid=? OR sessionid=?)"; + my $sth = $dbh->prepare($query); + $sth->execute($borrowernumber, $session); + return $sth->fetchall_hashref({}); +} + +=head2 z3950_search_args + +$arrayref = z3950_search_args($matchpoints) + +This function returns an array reference that contains the search parameters to be +passed to the Z39.50 search script (z3950_search.pl). The array elements +are hash refs whose keys are name, value and encvalue, and whose values are the +name of a search parameter, the value of that search parameter and the URL encoded +value of that parameter. + +The search parameter names are lccn, isbn, issn, title, author, dewey and subject. - * $listbiblios is an array ref to marcrecords to be changed - * $tagsubfield is the reference of the subfield to change. - * $initvalue is the value to search the record for - * $targetvalue is the value to set the subfield to - * $test is to be set only not to perform changes in database. +The search parameter values are obtained from the bibliographic record whose +data is in a hash reference in $matchpoints, as returned by Biblio::GetBiblioData(). + +If $matchpoints is a scalar, it is assumed to be an unnamed query descriptor, e.g. +a general purpose search argument. In this case, the returned array contains only +entry: the key is 'title' and the value and encvalue are derived from $matchpoints. + +If a search parameter value is undefined or empty, it is not included in the returned +array. + +The returned array reference may be passed directly to the template parameters. + +=over 2 =item C - * $countchanged counts all the changes performed. - * $listunchanged contains the list of all the biblionumbers of records unchanged. + + * $array containing hash refs as described above =item C =back -my ($countchanged, $listunchanged) = EditBiblios($results->{RECORD}, $tagsubfield,$initvalue,$targetvalue);; -#If one wants to display unchanged records, you should get biblios foreach @$listunchanged -$template->param(countchanged => $countchanged, loopunchanged=>$listunchanged); +$data = Biblio::GetBiblioData($bibno); +$template->param ( MYLOOP => C4::Search::z3950_search_args($data) ) + +*OR* + +$template->param ( MYLOOP => C4::Search::z3950_search_args($searchscalar) ) =cut -sub ModBiblios { - my ( $listbiblios, $tagsubfield, $initvalue, $targetvalue, $test ) = @_; - my $countmatched; - my @unmatched; - my ( $tag, $subfield ) = ( $1, $2 ) - if ( $tagsubfield =~ /^(\d{1,3})([a-z0-9A-Z@])?$/ ); - if ( ( length($tag) < 3 ) && $subfield =~ /0-9/ ) { - $tag = $tag . $subfield; - undef $subfield; +sub z3950_search_args { + my $bibrec = shift; + $bibrec = { title => $bibrec } if !ref $bibrec; + my $array = []; + for my $field (qw/ lccn isbn issn title author dewey subject /) + { + my $encvalue = URI::Escape::uri_escape_utf8($bibrec->{$field}); + push @$array, { name=>$field, value=>$bibrec->{$field}, encvalue=>$encvalue } if defined $bibrec->{$field}; } - my ( $bntag, $bnsubf ) = GetMarcFromKohaField('biblio.biblionumber'); - my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber'); - if ($tag eq $itemtag) { - # do not allow the embedded item tag to be - # edited from here - warn "Attempting to edit item tag via C4::Search::ModBiblios -- not allowed"; - return (0, []); - } - foreach my $usmarc (@$listbiblios) { - my $record; - $record = eval { MARC::Record->new_from_usmarc($usmarc) }; - my $biblionumber; - if ($@) { + return $array; +} - # usmarc is not a valid usmarc May be a biblionumber - # FIXME - sorry, please let's figure out whether - # this function is to be passed a list of - # record numbers or a list of MARC::Record - # objects. The former is probably better - # because the MARC records supplied by Zebra - # may be not current. - $record = GetMarcBiblio($usmarc); - $biblionumber = $usmarc; - } - else { - if ( $bntag >= 010 ) { - $biblionumber = $record->subfield( $bntag, $bnsubf ); - } - else { - $biblionumber = $record->field($bntag)->data; - } - } +=head2 BiblioAddAuthorities - #GetBiblionumber is to be written. - #Could be replaced by TransformMarcToKoha (But Would be longer) - if ( $record->field($tag) ) { - my $modify = 0; - foreach my $field ( $record->field($tag) ) { - if ($subfield) { - if ( - $field->delete_subfield( - 'code' => $subfield, - 'match' => qr($initvalue) - ) - ) - { - $countmatched++; - $modify = 1; - $field->update( $subfield, $targetvalue ) - if ($targetvalue); - } - } - else { - if ( $tag >= 010 ) { - if ( $field->delete_field($field) ) { - $countmatched++; - $modify = 1; - } - } - else { - $field->data = $targetvalue - if ( $field->data =~ qr($initvalue) ); - } - } - } +( $countlinked, $countcreated ) = BiblioAddAuthorities($record, $frameworkcode); - # warn $record->as_formatted; - if ($modify) { - ModBiblio( $record, $biblionumber, - GetFrameworkCode($biblionumber) ) - unless ($test); - } - else { - push @unmatched, $biblionumber; - } - } - else { - push @unmatched, $biblionumber; - } +this function finds the authorities linked to the biblio + * search in the authority DB for the same authid (in $9 of the biblio) + * search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC) + * search in the authority DB for the same values (exactly) (in all subfields of the biblio) +OR adds a new authority record + +=over 2 + +=item C + + * $record is the MARC record in question (marc blob) + * $frameworkcode is the bibliographic framework to use (if it is "" it uses the default framework) + +=item C + + * $countlinked is the number of authorities records that are linked to this authority + * $countcreated + +=item C + * I had to add this to Search.pm (instead of the logical Biblio.pm) because of a circular dependency (this sub uses SimpleSearch, and Search.pm uses Biblio.pm) +=back + +=cut + + +sub BiblioAddAuthorities{ + my ( $record, $frameworkcode ) = @_; + my $dbh=C4::Context->dbh; + my $query=$dbh->prepare(qq| +SELECT authtypecode,tagfield +FROM marc_subfield_structure +WHERE frameworkcode=? +AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|); +# SELECT authtypecode,tagfield +# FROM marc_subfield_structure +# WHERE frameworkcode=? +# AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|); + $query->execute($frameworkcode); + my ($countcreated,$countlinked); + while (my $data=$query->fetchrow_hashref){ + foreach my $field ($record->field($data->{tagfield})){ + next if ($field->subfield('3')||$field->subfield('9')); + # No authorities id in the tag. + # Search if there is any authorities to link to. + my $query='at='.$data->{authtypecode}.' '; + map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields(); + my ($error, $results, $total_hits)=SimpleSearch( $query, undef, undef, [ "authorityserver" ] ); + # there is only 1 result + if ( $error ) { + warn "BIBLIOADDSAUTHORITIES: $error"; + return (0,0) ; + } + if ($results && scalar(@$results)==1) { + my $marcrecord = MARC::File::USMARC::decode($results->[0]); + $field->add_subfields('9'=>$marcrecord->field('001')->data); + $countlinked++; + } elsif (scalar(@$results)>1) { + #More than One result + #This can comes out of a lack of a subfield. +# my $marcrecord = MARC::File::USMARC::decode($results->[0]); +# $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data); + $countlinked++; + } else { + #There are no results, build authority record, add it to Authorities, get authid and add it to 9 + ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode + ###NOTICE : This can be a problem. We should also look into other types and rejected forms. + my $authtypedata=C4::AuthoritiesMarc->GetAuthType($data->{authtypecode}); + next unless $authtypedata; + my $marcrecordauth=MARC::Record->new(); + my $authfield=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$field->subfield('a')); + map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )} $field->subfields(); + $marcrecordauth->insert_fields_ordered($authfield); + + # bug 2317: ensure new authority knows it's using UTF-8; currently + # only need to do this for MARC21, as MARC::Record->as_xml_record() handles + # automatically for UNIMARC (by not transcoding) + # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record + # use UTF-8, but as of 2008-08-05, did not want to introduce that kind + # of change to a core API just before the 3.0 release. + if (C4::Context->preference('marcflavour') eq 'MARC21') { + SetMarcUnicodeFlag($marcrecordauth, 'MARC21'); + } + +# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; + + my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode}); + $countcreated++; + $field->add_subfields('9'=>$authid); + } } - return ( $countmatched, \@unmatched ); + } + return ($countlinked,$countcreated); +} + +=head2 GetDistinctValues($field); + +C<$field> is a reference to the fields array + +=cut + +sub GetDistinctValues { + my ($fieldname,$string)=@_; + # returns a reference to a hash of references to branches... + if ($fieldname=~/\./){ + my ($table,$column)=split /\./, $fieldname; + my $dbh = C4::Context->dbh; + warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column "; + my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column "); + $sth->execute; + my $elements=$sth->fetchall_arrayref({}); + return $elements; + } + else { + $string||= qq(""); + my @servers=qw; + my (@zconns,@results); + for ( my $i = 0 ; $i < @servers ; $i++ ) { + $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 ); + $results[$i] = + $zconns[$i]->scan( + ZOOM::Query::CCL2RPN->new( qq"$fieldname $string", $zconns[$i]) + ); + } + # The big moment: asynchronously retrieve results from all servers + my @elements; + while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) { + my $ev = $zconns[ $i - 1 ]->last_event(); + if ( $ev == ZOOM::Event::ZEND ) { + next unless $results[ $i - 1 ]; + my $size = $results[ $i - 1 ]->size(); + if ( $size > 0 ) { + for (my $j=0;$j<$size;$j++){ + my %hashscan; + @hashscan{qw(value cnt)}=$results[ $i - 1 ]->display_term($j); + push @elements, \%hashscan; + } + } + } + } + return \@elements; + } } + END { } # module clean-up code here (global destructor) 1;