# set the version for version checking
BEGIN {
$VERSION = 3.01;
- $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
+ $DEBUG = ( $ENV{DEBUG} ) ? 1 : 0;
}
=head1 NAME
=head1 SYNOPSIS
-see opac/opac-search.pl or catalogue/search.pl for example of usage
+See opac/opac-search.pl or catalogue/search.pl for example of usage
=head1 DESCRIPTION
C<$fields> is a reference to the fields array
-This function modify the @$fields array and add related fields to search on.
+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 );
+ 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 );
($biblionumber,$biblionumber,$title) = FindDuplicate($record);
+This function attempts to find duplicate records using a hard-coded, fairly simplistic algorithm
+
=cut
sub FindDuplicate {
# ... normalize first
if ( $result->{isbn} ) {
$result->{isbn} =~ s/\(.*$//;
- $result->{isbn} =~ s/\s+$//;
- }
- #$search->{'avoidquerylog'}=1;
- if ( $result->{isbn} ) {
+ $result->{isbn} =~ s/\s+$//;
$query = "isbn=$result->{isbn}";
}
else {
$result->{title} =~ s /\"//g;
$result->{title} =~ s /\(//g;
$result->{title} =~ s /\)//g;
- # remove valid operators
+
+ # FIXME: instead of removing operators, could just do
+ # quotes around the value
$result->{title} =~ s/(and|or|not)//g;
$query = "ti,ext=$result->{title}";
- $query .= " and itemtype=$result->{itemtype}" if ($result->{itemtype});
- if ($result->{author}){
- $result->{author} =~ s /\\//g;
- $result->{author} =~ s /\"//g;
- $result->{author} =~ s /\(//g;
- $result->{author} =~ s /\)//g;
- # remove valid operators
- $result->{author} =~ s/(and|or|not)//g;
- $query .= " and au,ext=$result->{author}";
- }
+ $query .= " and itemtype=$result->{itemtype}"
+ if ( $result->{itemtype} );
+ if ( $result->{author} ) {
+ $result->{author} =~ s /\\//g;
+ $result->{author} =~ s /\"//g;
+ $result->{author} =~ s /\(//g;
+ $result->{author} =~ s /\)//g;
+
+ # remove valid operators
+ $result->{author} =~ s/(and|or|not)//g;
+ $query .= " and au,ext=$result->{author}";
+ }
}
- my ($error,$searchresults) =
- SimpleSearch($query); # FIXME :: hardcoded !
+
+ # FIXME: add error handling
+ my ( $error, $searchresults ) = SimpleSearch($query); # FIXME :: hardcoded !
my @results;
foreach my $possible_duplicate_record (@$searchresults) {
my $marcrecord =
MARC::Record->new_from_usmarc($possible_duplicate_record);
my $result = TransformMarcToKoha( $dbh, $marcrecord, '' );
-
+
# FIXME :: why 2 $biblionumber ?
- if ($result){
- push @results, $result->{'biblionumber'};
- push @results, $result->{'title'};
+ if ($result) {
+ push @results, $result->{'biblionumber'};
+ push @results, $result->{'title'};
}
}
- return @results;
+ return @results;
}
=head2 SimpleSearch
=item C<input arg:>
- * $query can be a simple keyword or a complete CCL query configured with your ccl.properties
+ * $query can be a simple keyword or a complete CCL query
* @servers is optional. Defaults to biblioserver as found in koha-conf.xml
=item C<Output arg:>
push @results, \%resultsloop;
}
+
$template->param(result=>\@results);
=cut
sub SimpleSearch {
- my $query = shift;
- 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);
- } else {
+ my $query = shift;
+ 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 );
+ }
+ else {
my @servers = @_;
my @results;
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;
-
+ # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
+ @servers = ("biblioserver") unless @servers;
+
# 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] ) );
-
+ $tmpresults[$i] =
+ $zconns[$i]
+ ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
+
# error handling
my $error =
- $zconns[$i]->errmsg() . " ("
- . $zconns[$i]->errcode() . ") "
- . $zconns[$i]->addinfo() . " "
- . $zconns[$i]->diagset();
-
+ $zconns[$i]->errmsg() . " ("
+ . $zconns[$i]->errcode() . ") "
+ . $zconns[$i]->addinfo() . " "
+ . $zconns[$i]->diagset();
+
return ( $error, undef ) if $zconns[$i]->errcode();
};
if ($@) {
+
# caught a ZOOM::Exception
- my $error =
- $@->message() . " ("
- . $@->code() . ") "
- . $@->addinfo() . " "
- . $@->diagset();
+ my $error =
+ $@->message() . " ("
+ . $@->code() . ") "
+ . $@->addinfo() . " "
+ . $@->diagset();
warn $error;
return ( $error, undef );
}
=head2 getRecords
-($error,$results) = getRecords($query,@servers);
+( undef, $results_hashref, \@facets_loop ) = getRecords (
+
+ $koha_query, $simple_query, $sort_by_ref, $servers_ref,
+ $results_per_page, $offset, $expanded_facet, $branches,
+ $query_type, $scan
+ );
The all singing, all dancing, multi-server, asynchronous, scanning,
-searching, record nabbing, facet-building function
+searching, record nabbing, facet-building
See verbse embedded documentation.
=cut
-
sub getRecords {
my (
- $koha_query, $simple_query, $sort_by_ref,
- $servers_ref, $results_per_page, $offset,
- $expanded_facet, $branches, $query_type,
- $scan
+ $koha_query, $simple_query, $sort_by_ref, $servers_ref,
+ $results_per_page, $offset, $expanded_facet, $branches,
+ $query_type, $scan
) = @_;
my @servers = @$servers_ref;
my @sort_by = @$sort_by_ref;
- # Create the zoom connection and query object
+ # Initialize variables for the ZOOM connection and results object
my $zconn;
my @zconns;
my @results;
my $results_hashref = ();
- ### FACETED RESULTS
+ # Initialize variables for the faceted results objects
my $facets_counter = ();
my $facets_info = ();
my $facets = getFacets();
- #### INITIALIZE SOME VARS USED FOR FACETED RESULTS
- 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++ ) {
$zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
- # 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
+# 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;
}
#$query_to_use = $simple_query if $scan;
- warn $simple_query if ($scan and $DEBUG);
+ 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] ) );
+ $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] ) );
+ $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] ) );
+ $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] ) );
+ $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] ));
+ $results[$i] =
+ $zconns[$i]->search(
+ new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
+ );
}
}
};
# Note: sort will override rank
my $sort_by;
foreach my $sort (@sort_by) {
- if ($sort eq "author_az") {
- $sort_by.="1=1003 <i ";
+ if ( $sort eq "author_az" ) {
+ $sort_by .= "1=1003 <i ";
}
- elsif ($sort eq "author_za") {
- $sort_by.="1=1003 >i ";
+ elsif ( $sort eq "author_za" ) {
+ $sort_by .= "1=1003 >i ";
}
- elsif ($sort eq "popularity_asc") {
- $sort_by.="1=9003 <i ";
+ elsif ( $sort eq "popularity_asc" ) {
+ $sort_by .= "1=9003 <i ";
}
- elsif ($sort eq "popularity_dsc") {
- $sort_by.="1=9003 >i ";
+ elsif ( $sort eq "popularity_dsc" ) {
+ $sort_by .= "1=9003 >i ";
}
- elsif ($sort eq "call_number_asc") {
- $sort_by.="1=20 <i ";
+ elsif ( $sort eq "call_number_asc" ) {
+ $sort_by .= "1=20 <i ";
}
- elsif ($sort eq "call_number_dsc") {
- $sort_by.="1=20 >i ";
+ elsif ( $sort eq "call_number_dsc" ) {
+ $sort_by .= "1=20 >i ";
}
- elsif ($sort eq "pubdate_asc") {
- $sort_by.="1=31 <i ";
+ elsif ( $sort eq "pubdate_asc" ) {
+ $sort_by .= "1=31 <i ";
}
- elsif ($sort eq "pubdate_dsc") {
- $sort_by.="1=31 >i ";
+ elsif ( $sort eq "pubdate_dsc" ) {
+ $sort_by .= "1=31 >i ";
}
- elsif ($sort eq "acqdate_asc") {
- $sort_by.="1=32 <i ";
+ elsif ( $sort eq "acqdate_asc" ) {
+ $sort_by .= "1=32 <i ";
}
- elsif ($sort eq "acqdate_dsc") {
- $sort_by.="1=32 >i ";
+ elsif ( $sort eq "acqdate_dsc" ) {
+ $sort_by .= "1=32 >i ";
}
- elsif ($sort eq "title_az") {
- $sort_by.="1=4 <i ";
+ elsif ( $sort eq "title_az" ) {
+ $sort_by .= "1=4 <i ";
}
- elsif ($sort eq "title_za") {
- $sort_by.="1=4 >i ";
+ elsif ( $sort eq "title_za" ) {
+ $sort_by .= "1=4 >i ";
}
}
if ($sort_by) {
- if ( $results[$i]->sort( "yaz", $sort_by ) < 0) {
+ if ( $results[$i]->sort( "yaz", $sort_by ) < 0 ) {
warn "WARNING sort $sort_by failed";
}
}
- }
+ } # finished looping through servers
# The big moment: asynchronously retrieve results from all servers
while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
my $ev = $zconns[ $i - 1 ]->last_event();
if ( $ev == ZOOM::Event::ZEND ) {
- next unless $results[ $i - 1 ];
+ next unless $results[ $i - 1 ];
my $size = $results[ $i - 1 ]->size();
if ( $size > 0 ) {
my $results_hash;
- #$results_hash->{'server'} = $servers[$i-1];
# loop through the results
$results_hash->{'hits'} = $size;
else {
$times = $size;
}
- for ( my $j = $offset ; $j < $times ; $j++ )
- { #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
+ for ( my $j = $offset ; $j < $times ; $j++ ) {
my $records_hash;
my $record;
my $facet_record;
- ## This is just an index scan
+ ## Check if it's an index scan
if ($scan) {
my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
- # here we create a minimal MARC record and hand it off to the
- # template just like a normal result ... perhaps not ideal, but
- # it works for now
+
+ # here we create a minimal MARC record and hand it off to the
+ # template just like a normal result ... perhaps not ideal, but
+ # it works for now
my $tmprecord = MARC::Record->new();
$tmprecord->encoding('UTF-8');
my $tmptitle;
my $tmpauthor;
- # the minimal record in author/title (depending on MARC flavour)
+
+ # the minimal record in author/title (depending on MARC flavour)
if ( C4::Context->preference("marcflavour") eq
"UNIMARC" )
{
);
}
else {
- $tmptitle = MARC::Field->new('245', ' ', ' ',a => $term,);
- $tmpauthor = MARC::Field->new('100', ' ', ' ',a => $occ,);
+ $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
else {
$record = $results[ $i - 1 ]->record($j)->raw();
+
# warn "RECORD $j:".$record;
- $results_hash->{'RECORDS'}[$j] =
- $record; # making a reference to a hash
- # Fill the facets while we're looping
- $facet_record = MARC::Record->new_from_usmarc($record);
-
- # warn $servers[$i-1].$facet_record->title();
- for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
- if ( $facets->[$k] ) {
- my @fields;
- for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
- push @fields, $facet_record->field($tag);
- }
- 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}++;
+ $results_hash->{'RECORDS'}[$j] = $record;
+
+ # Fill the facets while we're looping, but only for the biblioserver
+ $facet_record = MARC::Record->new_from_usmarc($record)
+ if $servers[ $i - 1 ] =~ /biblioserver/;
+
+ #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);
+ }
+ 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'};
}
}
}
# warn $results[$i-1]->record(0)->render() if $size > 0;
# BUILD FACETS
- for my $link_value (
- sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
- 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}
- } keys %{ $facets_counter->{$link_value} }
- )
+ if ( $servers[ $i - 1 ] =~ /biblioserver/ ) {
+ for my $link_value (
+ sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
+ keys %$facets_counter )
{
- $number_of_facets++;
- if ( ( $number_of_facets < 6 )
- || ( $expanded_facet eq $link_value )
- || ( $facets_info->{$link_value}->{'expanded'} ) )
+ 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}
+ } keys %{ $facets_counter->{$link_value} }
+ )
{
+ $number_of_facets++;
+ if ( ( $number_of_facets < 6 )
+ || ( $expanded_facet eq $link_value )
+ || ( $facets_info->{$link_value}->{'expanded'} ) )
+ {
- # Sanitize the link value ), ( will cause errors with CCL,
- my $facet_link_value = $one_facet;
- $facet_link_value =~ s/(\(|\))/ /g;
-
- # fix the length that will display in the label,
- my $facet_label_value = $one_facet;
- $facet_label_value = substr( $one_facet, 0, 20 ) . "..."
- unless length($facet_label_value) <= 20;
+ # Sanitize the link value ), ( will cause errors with CCL,
+ my $facet_link_value = $one_facet;
+ $facet_link_value =~ s/(\(|\))/ /g;
- # if it's a branch, label by the name, not the code,
- if ( $link_value =~ /branch/ ) {
+ # fix the length that will display in the label,
+ my $facet_label_value = $one_facet;
$facet_label_value =
- $branches->{$one_facet}->{'branchname'};
- }
+ substr( $one_facet, 0, 20 ) . "..."
+ unless length($facet_label_value) <= 20;
- # 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,
- },
- );
+ # if it's a branch, label by the name, not the code,
+ if ( $link_value =~ /branch/ ) {
+ $facet_label_value =
+ $branches->{$one_facet}->{'branchname'};
+ }
+
+ # 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,
+ },
+ );
+ }
}
- }
- # handle expanded option
- unless ( $facets_info->{$link_value}->{'expanded'} ) {
- $expandable = 1
- 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,
+ # handle expanded option
+ unless ( $facets_info->{$link_value}->{'expanded'} ) {
+ $expandable = 1
+ 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,
+ }
+ );
+ }
}
}
}
# STOPWORDS
sub _remove_stopwords {
- my ($operand,$index) = @_;
+ my ( $operand, $index ) = @_;
my @stopwords_removed;
# phrase and exact-qualified indexes shouldn't have stopwords removed
- if ($index!~m/phr|ext/){
-
- # remove stopwords from operand : parse all stopwords & remove them (case insensitive)
- # 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;
+ if ( $index !~ m/phr|ext/ ) {
+
+# remove stopwords from operand : parse all stopwords & remove them (case insensitive)
+# 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, $_;
}
}
}
- return ($operand, \@stopwords_removed);
+ return ( $operand, \@stopwords_removed );
}
# TRUNCATION
sub _detect_truncation {
- my ($operand,$index) = @_;
- my (@nontruncated,@righttruncated,@lefttruncated,@rightlefttruncated,@regexpr);
- $operand =~s/^ //g;
- my @wordlist= split (/\s/,$operand);
- foreach my $word (@wordlist){
- if ($word=~s/^\*([^\*]+)\*$/$1/){
- push @rightlefttruncated,$word;
- }
- elsif($word=~s/^\*([^\*]+)$/$1/){
- push @lefttruncated,$word;
- }
- elsif ($word=~s/^([^\*]+)\*$/$1/){
- push @righttruncated,$word;
- }
- elsif (index($word,"*")<0){
- push @nontruncated,$word;
+ my ( $operand, $index ) = @_;
+ my ( @nontruncated, @righttruncated, @lefttruncated, @rightlefttruncated,
+ @regexpr );
+ $operand =~ s/^ //g;
+ my @wordlist = split( /\s/, $operand );
+ foreach my $word (@wordlist) {
+ if ( $word =~ s/^\*([^\*]+)\*$/$1/ ) {
+ push @rightlefttruncated, $word;
+ }
+ elsif ( $word =~ s/^\*([^\*]+)$/$1/ ) {
+ push @lefttruncated, $word;
+ }
+ elsif ( $word =~ s/^([^\*]+)\*$/$1/ ) {
+ push @righttruncated, $word;
+ }
+ elsif ( index( $word, "*" ) < 0 ) {
+ push @nontruncated, $word;
}
else {
- push @regexpr,$word;
+ push @regexpr, $word;
}
}
- return (\@nontruncated,\@righttruncated,\@lefttruncated,\@rightlefttruncated,\@regexpr);
+ return (
+ \@nontruncated, \@righttruncated, \@lefttruncated,
+ \@rightlefttruncated, \@regexpr
+ );
}
# STEMMING
sub _build_stemmed_operand {
my ($operand) = @_;
my $stemmed_operand;
- # FIXME: the locale should be set based on the user's language and/or search choice
+
+# FIXME: the locale should be set based on the user's language and/or search choice
my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
- # FIXME: these should be stored in the db so the librarian can modify the behavior
+
+# FIXME: these should be stored in the db so the librarian can modify the behavior
$stemmer->add_exceptions(
- {
- 'and' => 'and',
- 'or' => 'or',
- 'not' => 'not',
- }
- );
+ {
+ 'and' => 'and',
+ 'or' => 'or',
+ 'not' => 'not',
+ }
+ );
my @words = split( / /, $operand );
my $stems = $stemmer->stem(@words);
for my $stem (@$stems) {
- $stemmed_operand .= "$stem";
- $stemmed_operand .= "?" unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
- $stemmed_operand .= " ";
+ $stemmed_operand .= "$stem";
+ $stemmed_operand .= "?"
+ unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
+ $stemmed_operand .= " ";
}
warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
return $stemmed_operand;
# FIELD WEIGHTING
sub _build_weighted_query {
- # FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
- # pretty well but could work much better if we had a smarter query parser
- my ($operand,$stemmed_operand,$index) = @_;
+
+# FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
+# pretty well but could work much better if we had a smarter query parser
+ my ( $operand, $stemmed_operand, $index ) = @_;
my $stemming = C4::Context->preference("QueryStemming") || 0;
my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
- my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
+ my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
- my $weighted_query .= "(rk=("; # Specifies that we're applying rank
+ my $weighted_query .= "(rk=("; # Specifies that we're applying rank
# Keyword, or, no index specified
if ( ( $index eq 'kw' ) || ( !$index ) ) {
- $weighted_query .= "Title-cover,ext,r1=\"$operand\""; # exact title-cover
- $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
- $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
- #$weighted_query .= " or any,ext,r4=$operand"; # exact any
- #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
- $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\"" if $fuzzy_enabled; # add fuzzy, word list
- $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\"" if ($stemming and $stemmed_operand); # add stemming, right truncation
- $weighted_query .= " or wrdl,r9=\"$operand\"";
- # embedded sorting: 0 a-z; 1 z-a
- # $weighted_query .= ") or (sort1,aut=1";
+ $weighted_query .=
+ "Title-cover,ext,r1=\"$operand\""; # exact title-cover
+ $weighted_query .= " or ti,ext,r2=\"$operand\""; # exact title
+ $weighted_query .= " or ti,phr,r3=\"$operand\""; # phrase title
+ #$weighted_query .= " or any,ext,r4=$operand"; # exact any
+ #$weighted_query .=" or kw,wrdl,r5=\"$operand\""; # word list any
+ $weighted_query .= " or wrdl,fuzzy,r8=\"$operand\""
+ if $fuzzy_enabled; # add fuzzy, word list
+ $weighted_query .= " or wrdl,right-Truncation,r9=\"$stemmed_operand\""
+ if ( $stemming and $stemmed_operand )
+ ; # add stemming, right truncation
+ $weighted_query .= " or wrdl,r9=\"$operand\"";
+
+ # embedded sorting: 0 a-z; 1 z-a
+ # $weighted_query .= ") or (sort1,aut=1";
}
# Barcode searches should skip this process
$weighted_query .= "bc=\"$operand\"";
}
- # if the index already has more than one qualifier, wrap the operand
+ # Authority-number searches should skip this process
+ elsif ( $index eq 'an' ) {
+ $weighted_query .= "an=\"$operand\"";
+ }
+
+ # If the index already has more than one qualifier, wrap the operand
# in quotes and pass it back (assumption is that the user knows what they
# are doing and won't appreciate us mucking up their query
- elsif ($index =~ ',') {
- $weighted_query .=" $index=\"$operand\"";
+ elsif ( $index =~ ',' ) {
+ $weighted_query .= " $index=\"$operand\"";
}
#TODO: build better cases based on specific search indexes
else {
- $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
- #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
- $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
- $weighted_query .= " or $index,rt,wrdl,r3=\"$operand\""; # word list index
+ $weighted_query .= " $index,ext,r1=\"$operand\""; # exact index
+ #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
+ $weighted_query .= " or $index,phr,r3=\"$operand\""; # phrase index
+ $weighted_query .=
+ " or $index,rt,wrdl,r3=\"$operand\""; # word list index
}
- $weighted_query .= "))"; # close rank specification
+ $weighted_query .= "))"; # close rank specification
return $weighted_query;
}
=cut
sub buildQuery {
- my ( $operators, $operands, $indexes, $limits, $sort_by, $scan) = @_;
+ my ( $operators, $operands, $indexes, $limits, $sort_by, $scan ) = @_;
- warn "---------" if $DEBUG;
+ warn "---------" if $DEBUG;
warn "Enter buildQuery" if $DEBUG;
- warn "---------" if $DEBUG;
+ warn "---------" if $DEBUG;
# dereference
my @operators = @$operators if $operators;
my @limits = @$limits if $limits;
my @sort_by = @$sort_by if $sort_by;
- my $stemming = C4::Context->preference("QueryStemming") || 0;
- my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
- my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
- my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
- my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
+ my $stemming = C4::Context->preference("QueryStemming") || 0;
+ my $auto_truncation = C4::Context->preference("QueryAutoTruncate") || 0;
+ my $weight_fields = C4::Context->preference("QueryWeightFields") || 0;
+ my $fuzzy_enabled = C4::Context->preference("QueryFuzzy") || 0;
+ my $remove_stopwords = C4::Context->preference("QueryRemoveStopwords") || 0;
# no stemming/weight/fuzzy in NoZebra
- if (C4::Context->preference("NoZebra")) {
- $stemming =0;
- $weight_fields=0;
- $fuzzy_enabled=0;
+ if ( C4::Context->preference("NoZebra") ) {
+ $stemming = 0;
+ $weight_fields = 0;
+ $fuzzy_enabled = 0;
}
- my $query = $operands[0];
+ my $query = $operands[0];
my $simple_query = $operands[0];
# initialize the variables we're passing back
my $limit_cgi;
my $limit_desc;
- my $stopwords_removed; # flag to determine if stopwords have been removed
+ my $stopwords_removed; # flag to determine if stopwords have been removed
- # for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
- # DIAGNOSTIC ONLY!!
+# for handling ccl, cql, pqf queries in diagnostic mode, skip the rest of the steps
+# DIAGNOSTIC ONLY!!
if ( $query =~ /^ccl=/ ) {
return ( undef, $', $', $', $', '', '', '', '', 'ccl' );
}
# 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' );
+ 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.
- # Once we do so, we'll end up with a value in $query, just like if we had an
- # incoming $query from the user
+# 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.
+# Once we do so, we'll end up with a value in $query, just like if we had an
+# incoming $query from the user
else {
- $query = ""; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
- my $previous_operand; # a flag used to keep track if there was a previous query
- # if there was, we can apply the current operator
- # for every operand
+ $query = ""
+ ; # clear it out so we can populate properly with field-weighted, stemmed, etc. query
+ my $previous_operand
+ ; # a flag used to keep track if there was a previous query
+ # if there was, we can apply the current operator
+ # for every operand
for ( my $i = 0 ; $i <= @operands ; $i++ ) {
# COMBINE OPERANDS, INDEXES AND OPERATORS
if ( $operands[$i] ) {
- # A flag to determine whether or not to add the index to the query
+ # A flag to determine whether or not to add the index to the query
my $indexes_set;
- # If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
- if ($operands[$i] =~ /(:|=)/ || $scan) {
- $weight_fields = 0;
- $stemming = 0;
+# If the user is sophisticated enough to specify an index, turn off field weighting, stemming, and stopword handling
+ if ( $operands[$i] =~ /(:|=)/ || $scan ) {
+ $weight_fields = 0;
+ $stemming = 0;
$remove_stopwords = 0;
}
my $operand = $operands[$i];
my $index = $indexes[$i];
- # Add index-specific attributes
+ # Add index-specific attributes
# Date of Publication
- if ($index eq 'yr') {
- $index .=",st-numeric";
+ 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, 0, 0, 0, 0 );
}
+
# Date of Acquisition
- elsif ($index eq 'acqdate') {
- $index.=",st-date-normalized";
+ elsif ( $index eq 'acqdate' ) {
+ $index .= ",st-date-normalized";
$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, 0, 0, 0, 0 );
}
# Set default structure attribute (word list)
my $struct_attr;
- unless (!$index || $index =~ /(st-|phr|ext|wrdl)/) {
+ unless ( !$index || $index =~ /(st-|phr|ext|wrdl)/ ) {
$struct_attr = ",wrdl";
}
# Some helpful index variants
- my $index_plus = $index.$struct_attr.":" if $index;
- my $index_plus_comma=$index.$struct_attr."," if $index;
+ my $index_plus = $index . $struct_attr . ":" if $index;
+ my $index_plus_comma = $index . $struct_attr . "," if $index;
# Remove Stopwords
if ($remove_stopwords) {
- ($operand, $stopwords_removed) = _remove_stopwords($operand,$index);
+ ( $operand, $stopwords_removed ) =
+ _remove_stopwords( $operand, $index );
warn "OPERAND w/out STOPWORDS: >$operand<" if $DEBUG;
- warn "REMOVED STOPWORDS: @$stopwords_removed" if ($stopwords_removed && $DEBUG);
+ warn "REMOVED STOPWORDS: @$stopwords_removed"
+ if ( $stopwords_removed && $DEBUG );
}
# Detect Truncation
- my ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr);
+ my ( $nontruncated, $righttruncated, $lefttruncated,
+ $rightlefttruncated, $regexpr );
my $truncated_operand;
- ($nontruncated,$righttruncated,$lefttruncated,$rightlefttruncated,$regexpr) = _detect_truncation($operand,$index);
- warn "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<" if $DEBUG;
+ (
+ $nontruncated, $righttruncated, $lefttruncated,
+ $rightlefttruncated, $regexpr
+ ) = _detect_truncation( $operand, $index );
+ warn
+"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
+ if $DEBUG;
# Apply Truncation
- if (scalar(@$righttruncated)+scalar(@$lefttruncated)+scalar(@$rightlefttruncated)>0){
- # Don't field weight or add the index to the query, we do it here
+ if (
+ scalar(@$righttruncated) + scalar(@$lefttruncated) +
+ scalar(@$rightlefttruncated) > 0 )
+ {
+
+ # Don't field weight or add the index to the query, we do it here
$indexes_set = 1;
undef $weight_fields;
my $previous_truncation_operand;
- if (scalar(@$nontruncated)>0) {
- $truncated_operand.= "$index_plus @$nontruncated ";
+ if ( scalar(@$nontruncated) > 0 ) {
+ $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) > 0 ) {
+ $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) > 0 ) {
+ $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) > 0 ) {
+ $truncated_operand .= "and "
+ if $previous_truncation_operand;
+ $truncated_operand .=
+ "$index_plus_comma" . "rltrn:@$rightlefttruncated ";
$previous_truncation_operand = 1;
}
}
# Handle Stemming
my $stemmed_operand;
- $stemmed_operand = _build_stemmed_operand($operand) if $stemming;
+ $stemmed_operand = _build_stemmed_operand($operand)
+ 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;
+ $weighted_operand =
+ _build_weighted_query( $operand, $stemmed_operand, $index )
+ if $weight_fields;
warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
$operand = $weighted_operand if $weight_fields;
$indexes_set = 1 if $weight_fields;
if ($previous_operand) {
# User-specified operator
- if ( $operators[$i-1] ) {
- $query .= " $operators[$i-1] ";
- $query .= " $index_plus " unless $indexes_set;
- $query .= " $operand";
- $query_cgi .="&op=$operators[$i-1]";
- $query_cgi .="&idx=$index" if $index;
- $query_cgi .="&q=$operands[$i]" if $operands[$i];
- $query_desc .=" $operators[$i-1] $index_plus $operands[$i]";
+ if ( $operators[ $i - 1 ] ) {
+ $query .= " $operators[$i-1] ";
+ $query .= " $index_plus " unless $indexes_set;
+ $query .= " $operand";
+ $query_cgi .= "&op=$operators[$i-1]";
+ $query_cgi .= "&idx=$index" if $index;
+ $query_cgi .= "&q=$operands[$i]" if $operands[$i];
+ $query_desc .=
+ " $operators[$i-1] $index_plus $operands[$i]";
}
# Default operator is and
else {
- $query .= " and ";
- $query .= "$index_plus " unless $indexes_set;
- $query .= "$operand";
- $query_cgi .="&op=and&idx=$index" if $index;
- $query_cgi .="&q=$operands[$i]" if $operands[$i];
+ $query .= " and ";
+ $query .= "$index_plus " unless $indexes_set;
+ $query .= "$operand";
+ $query_cgi .= "&op=and&idx=$index" if $index;
+ $query_cgi .= "&q=$operands[$i]" if $operands[$i];
$query_desc .= " and $index_plus $operands[$i]";
}
}
# There isn't a pervious operand, don't need an operator
- else {
+ else {
+
# Field-weighted queries already have indexes set
- $query .=" $index_plus " unless $indexes_set;
+ $query .= " $index_plus " unless $indexes_set;
$query .= $operand;
$query_desc .= " $index_plus $operands[$i]";
- $query_cgi.="&idx=$index" if $index;
- $query_cgi.="&q=$operands[$i]" if $operands[$i];
+ $query_cgi .= "&idx=$index" if $index;
+ $query_cgi .= "&q=$operands[$i]" if $operands[$i];
$previous_operand = 1;
}
} #/if $operands
my $availability_limit;
foreach my $this_limit (@limits) {
if ( $this_limit =~ /available/ ) {
- # available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
- # all records not indexed in the onloan register and allrecords not indexed in the lost register, or where the value of lost is equal to or less than 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 .="";
+
+# available is defined as (items.notloan is NULL) and (items.itemlost > 0 or NULL) (last clause handles NULL values for lost in zebra)
+# all records not indexed in the onloan register and allrecords not indexed in the lost register, or where the value of lost is equal to or less than 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/ ) {
$group_OR_limits .= " or " if $group_OR_limits;
- $limit_desc .=" or " if $group_OR_limits;
+ $limit_desc .= " or " if $group_OR_limits;
$group_OR_limits .= "$this_limit";
- $limit_cgi .="&limit=$this_limit";
- $limit_desc .= " $this_limit";
+ $limit_cgi .= "&limit=$this_limit";
+ $limit_desc .= " $this_limit";
}
# Regular old limits
else {
$limit .= " and " if $limit || $query;
- $limit .= "$this_limit";
- $limit_cgi .="&limit=$this_limit";
- $limit_desc .=" $this_limit";
+ $limit .= "$this_limit";
+ $limit_cgi .= "&limit=$this_limit";
+ $limit_desc .= " $this_limit";
}
}
if ($group_OR_limits) {
- $limit.=" and " if ($query || $limit );
- $limit.="($group_OR_limits)";
- }
+ $limit .= " and " if ( $query || $limit );
+ $limit .= "($group_OR_limits)";
+ }
if ($availability_limit) {
- $limit.=" and " if ($query || $limit );
- $limit.="($availability_limit)";
+ $limit .= " and " if ( $query || $limit );
+ $limit .= "($availability_limit)";
}
# Normalize the query and limit strings
$query =~ s/:/=/g;
$limit =~ s/:/=/g;
- for ($query, $query_desc, $limit, $limit_desc) {
+ for ( $query, $query_desc, $limit, $limit_desc ) {
$_ =~ s/ / /g; # remove extra spaces
$_ =~ s/^ //g; # remove any beginning spaces
$_ =~ s/ $//g; # remove any ending spaces
$query_cgi =~ s/^&//; # remove unnecessary & from beginning of the query cgi
# append the limit to the query
- $query .=" ".$limit;
+ $query .= " " . $limit;
# Warnings if DEBUG
if ($DEBUG) {
- warn "QUERY:".$query;
- warn "QUERY CGI:".$query_cgi;
- warn "QUERY DESC:".$query_desc;
- warn "LIMIT:".$limit;
- warn "LIMIT CGI:".$limit_cgi;
- warn "LIMIT DESC:".$limit_desc;
+ warn "QUERY:" . $query;
+ warn "QUERY CGI:" . $query_cgi;
+ warn "QUERY DESC:" . $query_desc;
+ warn "LIMIT:" . $limit;
+ warn "LIMIT CGI:" . $limit_cgi;
+ warn "LIMIT DESC:" . $limit_desc;
warn "---------";
warn "Leave buildQuery";
warn "---------";
}
- return ( undef, $query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$stopwords_removed,$query_type );
+ return (
+ undef, $query, $simple_query, $query_cgi,
+ $query_desc, $limit, $limit_cgi, $limit_desc,
+ $stopwords_removed, $query_type
+ );
}
=head2 searchResults
$branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
}
my %locations;
- my $lsch = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'");
+ my $lsch =
+ $dbh->prepare(
+"SELECT authorised_value,lib FROM authorised_values WHERE category = 'LOC'"
+ );
$lsch->execute();
- while (my $ldata = $lsch->fetchrow_hashref ) {
+ while ( my $ldata = $lsch->fetchrow_hashref ) {
$locations{ $ldata->{'authorised_value'} } = $ldata->{'lib'};
}
#find itemtype & itemtype image
my %itemtypes;
$bsth =
- $dbh->prepare("SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes");
+ $dbh->prepare(
+ "SELECT itemtype,description,imageurl,summary,notforloan FROM itemtypes"
+ );
$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'};
+ $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
+ $itemtypes{ $bdata->{'itemtype'} }->{notforloan} =
+ $bdata->{'notforloan'};
}
#search item field code
- my $sth = $dbh->prepare("SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'");
+ my $sth =
+ $dbh->prepare(
+"SELECT tagfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
+ );
$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 =
+ $dbh->prepare(
+"SELECT authorised_value FROM `marc_subfield_structure` WHERE kohafield = 'items.notforloan' AND frameworkcode=''"
+ );
$sth->execute;
my ($notforloan_authorised_value) = $sth->fetchrow;
my $marcrecord;
$marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
my $oldbiblio = TransformMarcToKoha( $dbh, $marcrecord, '' );
- $oldbiblio->{result_number} = $i+1;
+ $oldbiblio->{result_number} = $i + 1;
# add imageurl to itemtype if there is one
if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
$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}) {
+ # 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();
+ my @fields = $marcrecord->fields();
foreach my $field (@fields) {
- my $tag = $field->tag();
+ my $tag = $field->tag();
my $tagvalue = $field->as_string();
- $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
- unless ($tag<10) {
+ $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];
+ 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 $tagsubf = $tag . $subfieldcode;
+ $summary =~
+s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
}
}
}
+ # FIXME: yuk
$summary =~ s/\[(.*?)]//g;
$summary =~ s/\n/<br>/g;
$oldbiblio->{summary} = $summary;
}
- # Add search-term highlighting to the whole record where they match using <span>s
+# Add search-term highlighting to the whole record where they match using <span>s
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 $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
my $match;
my $field = $highlight_field->as_string();
for my $term ( keys %$span_terms_hashref ) {
- if (($field =~ /$term/i) && (length($term) > 3)) {
+ if ( ( $field =~ /$term/i ) && ( length($term) > 3 ) ) {
$field =~ s/$term/<span class=\"term\">$&<\/span>/gi;
$match++;
}
}
+
# FIXME: we might want to limit the size of these fields if we
# want to get fancy
- $searchhighlightblob .= $field." ... " if $match;
+ $searchhighlightblob .= $field . " ... " if $match;
}
$oldbiblio->{'searchhighlightblob'} = $searchhighlightblob;
-
# save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
+# save an author with no <span> tag, for the <a href=search.pl?q=<!--tmpl_var name="author"-->> link
$oldbiblio->{'author_nospan'} = $oldbiblio->{'author'};
# Add search-term highlighting to the title, subtitle, etc. fields
my $old_term = $term;
if ( length($term) > 3 ) {
$term =~ s/(.*=|\)|\(|\+|\.|\?|\[|\]|\\|\*)//g;
- $oldbiblio->{'title'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'subtitle'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'author'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'publishercode'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'place'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'pages'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'notes'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
- $oldbiblio->{'size'} =~ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'title'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'subtitle'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'author'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'publishercode'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'place'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'pages'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'notes'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
+ $oldbiblio->{'size'} =~
+ s/$term/<span class=\"term\">$&<\/span>/gi;
}
}
my $itembinding_count = 0;
my $itemdamaged_count = 0;
my $can_place_holds = 0;
- my $items_count=scalar(@fields);
+ my $items_count = scalar(@fields);
my $items_counter;
- my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
+ my $maxitems =
+ ( C4::Context->preference('maxItemsinSearchResults') )
+ ? C4::Context->preference('maxItemsinSearchResults') - 1
+ : 1;
# loop through every item
foreach my $field (@fields) {
my $item;
$items_counter++;
- # populate the items hash
+ # populate the items hash
foreach my $code ( keys %subfieldstosearch ) {
$item->{$code} = $field->subfield( $subfieldstosearch{$code} );
}
- # set item's branch name, use homebranch first, fall back to holdingbranch
- if ($item->{'homebranch'}) {
- $item->{'branchname'} = $branches{$item->{homebranch}};
+
+ # set item's branch name, use homebranch first, fall back to holdingbranch
+ if ( $item->{'homebranch'} ) {
+ $item->{'branchname'} = $branches{ $item->{homebranch} };
}
+
# Last resort
- elsif ($item->{'holdingbranch'}) {
- $item->{'branchname'} = $branches{$item->{holdingbranch}};
+ elsif ( $item->{'holdingbranch'} ) {
+ $item->{'branchname'} = $branches{ $item->{holdingbranch} };
}
- # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item
- if ($item->{onloan}) {
+# 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->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{due_date} = format_date($item->{onloan});
- $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{count}++ if $item->{'homebranch'};
- $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{branchname} = $item->{'branchname'};
- $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{location} = $locations{$item->{location}};
- $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{itemcallnumber} = $item->{itemcallnumber};
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{due_date} =
+ format_date( $item->{onloan} );
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{count}++
+ if $item->{'homebranch'};
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{branchname} =
+ $item->{'branchname'};
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{location} =
+ $locations{ $item->{location} };
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{itemcallnumber} =
+ $item->{itemcallnumber};
# if something's checked out and lost, mark it as 'long overdue'
if ( $item->{itemlost} ) {
- $onloan_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{due_date} }->{longoverdue}++;
+ $onloan_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{due_date} }->{longoverdue}++;
$longoverdue_count++;
}
+
# can place holds as long as this item isn't lost
else {
$can_place_holds = 1;
}
}
- # items not on loan, but still unavailable ( lost, withdrawn, damaged )
- else {
+ # items not on loan, but still unavailable ( lost, withdrawn, damaged )
+ else {
+
# item is on order
- if ( $item->{notforloan} == -1) {
+ if ( $item->{notforloan} == -1 ) {
$ordered_count++;
}
# item is withdrawn, lost or damaged
- if ( $item->{wthdrawn} || $item->{itemlost} || $item->{damaged} || $item->{notforloan} ) {
- $wthdrawn_count++ if $item->{wthdrawn};
- $itemlost_count++ if $item->{itemlost};
+ if ( $item->{wthdrawn}
+ || $item->{itemlost}
+ || $item->{damaged}
+ || $item->{notforloan} )
+ {
+ $wthdrawn_count++ if $item->{wthdrawn};
+ $itemlost_count++ if $item->{itemlost};
$itemdamaged_count++ if $item->{damaged};
- $item->{status} = $item->{wthdrawn}."-".$item->{itemlost}."-".$item->{damaged}."-".$item->{notforloan};
+ $item->{status} =
+ $item->{wthdrawn} . "-"
+ . $item->{itemlost} . "-"
+ . $item->{damaged} . "-"
+ . $item->{notforloan};
$other_count++;
-
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{wthdrawn} = $item->{wthdrawn};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{itemlost} = $item->{itemlost};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{damaged} = $item->{damaged};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value;
-
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{count}++ if $item->{'homebranch'};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{branchname} = $item->{'branchname'};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{location} = $locations{$item->{location}};
- $other_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'}.$item->{status} }->{itemcallnumber} = $item->{itemcallnumber};
+
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{wthdrawn} = $item->{wthdrawn};
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{itemlost} = $item->{itemlost};
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{damaged} = $item->{damaged};
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{notforloan} =
+ GetAuthorisedValueDesc( '', '', $item->{notforloan}, '',
+ '', $notforloan_authorised_value )
+ if $notforloan_authorised_value;
+
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{count}++
+ if $item->{'homebranch'};
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{branchname} =
+ $item->{'branchname'};
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{location} =
+ $locations{ $item->{location} };
+ $other_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'}
+ . $item->{status} }->{itemcallnumber} =
+ $item->{itemcallnumber};
}
# item is available
else {
$can_place_holds = 1;
$available_count++;
- $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{count}++ if $item->{'homebranch'};
- $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{branchname} = $item->{'branchname'};
- $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{location} = $locations{$item->{location}};
- $available_items->{ $item->{'homebranch'}.'--'.$item->{location}.$item->{'itemcallnumber'} }->{itemcallnumber} = $item->{itemcallnumber};
+ $available_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'} }->{count}++
+ if $item->{'homebranch'};
+ $available_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'} }->{branchname} =
+ $item->{'branchname'};
+ $available_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'} }->{location} =
+ $locations{ $item->{location} };
+ $available_items->{ $item->{'homebranch'} . '--'
+ . $item->{location}
+ . $item->{'itemcallnumber'} }->{itemcallnumber} =
+ $item->{itemcallnumber};
}
}
- } # notforloan, item level and biblioitem level
- my ($availableitemscount, $onloanitemscount, $otheritemscount);
- my $maxitems = (C4::Context->preference('maxItemsinSearchResults')) ? C4::Context->preference('maxItemsinSearchResults')- 1 : 1;
+ } # notforloan, item level and biblioitem level
+ my ( $availableitemscount, $onloanitemscount, $otheritemscount );
+ my $maxitems =
+ ( C4::Context->preference('maxItemsinSearchResults') )
+ ? C4::Context->preference('maxItemsinSearchResults') - 1
+ : 1;
for my $key ( sort keys %$onloan_items ) {
$onloanitemscount++;
- push @onloan_items_loop, $onloan_items->{$key} unless $onloanitemscount > $maxitems;
+ push @onloan_items_loop, $onloan_items->{$key}
+ unless $onloanitemscount > $maxitems;
}
for my $key ( sort keys %$other_items ) {
$otheritemscount++;
- push @other_items_loop, $other_items->{$key} unless $otheritemscount > $maxitems;
+ push @other_items_loop, $other_items->{$key}
+ unless $otheritemscount > $maxitems;
}
for my $key ( sort keys %$available_items ) {
$availableitemscount++;
- push @available_items_loop, $available_items->{$key} unless $availableitemscount > $maxitems;
+ 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
- $can_place_holds = 0 if $itemtypes{$oldbiblio->{itemtype}}->{notforloan};
- $oldbiblio->{norequests} = 1 unless $can_place_holds;
- $oldbiblio->{itemsplural} = 1 if $items_count>1;
- $oldbiblio->{items_count} = $items_count;
- $oldbiblio->{available_items_loop} = \@available_items_loop;
- $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
- $oldbiblio->{other_items_loop} = \@other_items_loop;
- $oldbiblio->{availablecount} = $available_count;
- $oldbiblio->{availableplural} = 1 if $available_count>1;
- $oldbiblio->{onloancount} = $onloan_count;
- $oldbiblio->{onloanplural} = 1 if $onloan_count>1;
- $oldbiblio->{othercount} = $other_count;
- $oldbiblio->{otherplural} = 1 if $other_count>1;
- $oldbiblio->{wthdrawncount} = $wthdrawn_count;
- $oldbiblio->{itemlostcount} = $itemlost_count;
- $oldbiblio->{damagedcount} = $itemdamaged_count;
- $oldbiblio->{orderedcount} = $ordered_count;
- $oldbiblio->{isbn} =~ s/-//g; # deleting - in isbn to enable amazon content
+# 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;
+ $oldbiblio->{itemsplural} = 1 if $items_count > 1;
+ $oldbiblio->{items_count} = $items_count;
+ $oldbiblio->{available_items_loop} = \@available_items_loop;
+ $oldbiblio->{onloan_items_loop} = \@onloan_items_loop;
+ $oldbiblio->{other_items_loop} = \@other_items_loop;
+ $oldbiblio->{availablecount} = $available_count;
+ $oldbiblio->{availableplural} = 1 if $available_count > 1;
+ $oldbiblio->{onloancount} = $onloan_count;
+ $oldbiblio->{onloanplural} = 1 if $onloan_count > 1;
+ $oldbiblio->{othercount} = $other_count;
+ $oldbiblio->{otherplural} = 1 if $other_count > 1;
+ $oldbiblio->{wthdrawncount} = $wthdrawn_count;
+ $oldbiblio->{itemlostcount} = $itemlost_count;
+ $oldbiblio->{damagedcount} = $itemdamaged_count;
+ $oldbiblio->{orderedcount} = $ordered_count;
+ $oldbiblio->{isbn} =~
+ s/-//g; # deleting - in isbn to enable amazon content
push( @newresults, $oldbiblio );
}
return @newresults;
}
-
-
#----------------------------------------------------------------------
#
# Non-Zebra GetRecords#
NZgetRecords has the same API as zera getRecords, even if some parameters are not managed
=cut
+
sub NZgetRecords {
- my ($query,$simple_query,$sort_by_ref,$servers_ref,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan) = @_;
+ my (
+ $query, $simple_query, $sort_by_ref, $servers_ref,
+ $results_per_page, $offset, $expanded_facet, $branches,
+ $query_type, $scan
+ ) = @_;
warn "query =$query" if $DEBUG;
my $result = NZanalyse($query);
warn "results =$result" if $DEBUG;
- return (undef,NZorder($result,@$sort_by_ref[0],$results_per_page,$offset),undef);
+ return ( undef,
+ NZorder( $result, @$sort_by_ref[0], $results_per_page, $offset ),
+ undef );
}
=head2 NZanalyse
=cut
sub NZanalyse {
- my ($string,$server) = @_;
- warn "---------" if $DEBUG;
+ my ( $string, $server ) = @_;
+ warn "---------" if $DEBUG;
warn "Enter NZanalyse" if $DEBUG;
- warn "---------" if $DEBUG;
+ warn "---------" if $DEBUG;
- # $server contains biblioserver or authorities, depending on what we search on.
- #warn "querying : $string on $server";
- $server='biblioserver' unless $server;
+ # $server contains biblioserver or authorities, depending on what we search on.
+ #warn "querying : $string on $server";
+ $server = 'biblioserver' unless $server;
- # if we have a ", replace the content to discard temporarily any and/or/not inside
+# if we have a ", replace the content to discard temporarily any and/or/not inside
my $commacontent;
- if ($string =~/"/) {
+ if ( $string =~ /"/ ) {
$string =~ s/"(.*?)"/__X__/;
$commacontent = $1;
warn "commacontent : $commacontent" if $DEBUG;
}
- # split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
- # then, call again NZanalyse with $left and $right
- # (recursive until we find a leaf (=> something without and/or/not)
- # delete repeated operator... Would then go in infinite loop
- while ($string =~s/( and| or| not| AND| OR| NOT)\1/$1/g){
+
+# split the query string in 3 parts : X AND Y means : $left="X", $operand="AND" and $right="Y"
+# then, call again NZanalyse with $left and $right
+# (recursive until we find a leaf (=> something without and/or/not)
+# delete repeated operator... Would then go in infinite loop
+ while ( $string =~ s/( and| or| not| AND| OR| NOT)\1/$1/g ) {
}
- #process parenthesis before.
- if ($string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/){
- my $left = $1;
- my $right = $4;
- my $operator = lc($3); # FIXME: and/or/not are operators, not operands
- warn "dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right" if $DEBUG;
- my $leftresult = NZanalyse($left,$server);
- if ($operator) {
- my $rightresult = NZanalyse($right,$server);
- # OK, we have the results for right and left part of the query
- # depending of operand, intersect, union or exclude both lists
- # to get a result list
- if ($operator eq ' and ') {
- my @leftresult = split /;/, $leftresult;
- warn " @leftresult / $rightresult \n" if $DEBUG;
-# my @rightresult = split /;/,$leftresult;
- my $finalresult;
- # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
- # the result is stored twice, to have the same weight for AND than OR.
- # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
- # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
- foreach (@leftresult) {
- my $value=$_;
- my $countvalue;
- ($value,$countvalue)=($1,$2) if $value=~m/(.*)-(\d+)$/;
- if ($rightresult =~ /$value-(\d+);/) {
- $countvalue=($1>$countvalue?$countvalue:$1);
- $finalresult .= "$value-$countvalue;$value-$countvalue;";
+
+ #process parenthesis before.
+ if ( $string =~ /^\s*\((.*)\)(( and | or | not | AND | OR | NOT )(.*))?/ ) {
+ my $left = $1;
+ my $right = $4;
+ my $operator = lc($3); # FIXME: and/or/not are operators, not operands
+ warn
+"dealing w/parenthesis before recursive sub call. left :$left operator:$operator right:$right"
+ if $DEBUG;
+ my $leftresult = NZanalyse( $left, $server );
+ if ($operator) {
+ my $rightresult = NZanalyse( $right, $server );
+
+ # OK, we have the results for right and left part of the query
+ # depending of operand, intersect, union or exclude both lists
+ # to get a result list
+ if ( $operator eq ' and ' ) {
+ my @leftresult = split /;/, $leftresult;
+ warn " @leftresult / $rightresult \n" if $DEBUG;
+
+ # my @rightresult = split /;/,$leftresult;
+ my $finalresult;
+
+# parse the left results, and if the biblionumber exist in the right result, save it in finalresult
+# the result is stored twice, to have the same weight for AND than OR.
+# example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
+# result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
+ foreach (@leftresult) {
+ my $value = $_;
+ my $countvalue;
+ ( $value, $countvalue ) = ( $1, $2 )
+ if $value =~ m/(.*)-(\d+)$/;
+ if ( $rightresult =~ /$value-(\d+);/ ) {
+ $countvalue = ( $1 > $countvalue ? $countvalue : $1 );
+ $finalresult .=
+ "$value-$countvalue;$value-$countvalue;";
+ }
}
+ warn " $finalresult \n" if $DEBUG;
+ return $finalresult;
}
- warn " $finalresult \n" if $DEBUG;
- return $finalresult;
- } elsif ($operator eq ' or ') {
- # just merge the 2 strings
- return $leftresult.$rightresult;
- } elsif ($operator eq ' not ') {
- my @leftresult = split /;/, $leftresult;
-# my @rightresult = split /;/,$leftresult;
- my $finalresult;
- foreach (@leftresult) {
- my $value=$_;
- $value=$1 if $value=~m/(.*)-\d+$/;
- unless ($rightresult =~ "$value-") {
+ elsif ( $operator eq ' or ' ) {
+
+ # just merge the 2 strings
+ return $leftresult . $rightresult;
+ }
+ elsif ( $operator eq ' not ' ) {
+ my @leftresult = split /;/, $leftresult;
+
+ # my @rightresult = split /;/,$leftresult;
+ my $finalresult;
+ foreach (@leftresult) {
+ my $value = $_;
+ $value = $1 if $value =~ m/(.*)-\d+$/;
+ unless ( $rightresult =~ "$value-" ) {
+ }
}
+ return $finalresult;
+ }
+ else {
+
+# this error is impossible, because of the regexp that isolate the operand, but just in case...
+ return $leftresult;
+ exit;
}
- return $finalresult;
- } else {
- # this error is impossible, because of the regexp that isolate the operand, but just in case...
- return $leftresult;
- exit;
}
- }
- }
- warn "string :".$string if $DEBUG;
+ }
+ 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
- warn "dealing w/parenthesis. left :$left operator:$operator right:$right" if $DEBUG;
+ my $left = $1;
+ my $right = $3;
+ my $operator = lc($2); # FIXME: and/or/not are operators, not operands
+ warn "dealing w/parenthesis. left :$left operator:$operator right:$right"
+ if $DEBUG;
+
# it's not a leaf, we have a and/or/not
if ($operator) {
+
# reintroduce comma content if needed
$right =~ s/__X__/"$commacontent"/ if $commacontent;
- $left =~ s/__X__/"$commacontent"/ if $commacontent;
+ $left =~ s/__X__/"$commacontent"/ if $commacontent;
warn "node : $left / $operator / $right\n" if $DEBUG;
- my $leftresult = NZanalyse($left,$server);
- my $rightresult = NZanalyse($right,$server);
+ my $leftresult = NZanalyse( $left, $server );
+ my $rightresult = NZanalyse( $right, $server );
+
# OK, we have the results for right and left part of the query
# depending of operand, intersect, union or exclude both lists
# to get a result list
- if ($operator eq ' and ') {
+ if ( $operator eq ' and ' ) {
my @leftresult = split /;/, $leftresult;
-# my @rightresult = split /;/,$leftresult;
+
+ # my @rightresult = split /;/,$leftresult;
my $finalresult;
- # parse the left results, and if the biblionumber exist in the right result, save it in finalresult
- # the result is stored twice, to have the same weight for AND than OR.
- # example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
- # result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
+
+# parse the left results, and if the biblionumber exist in the right result, save it in finalresult
+# the result is stored twice, to have the same weight for AND than OR.
+# example : TWO : 61,61,64,121 (two is twice in the biblio #61) / TOWER : 61,64,130
+# result : 61,61,61,61,64,64 for two AND tower : 61 has more weight than 64
foreach (@leftresult) {
- if ($rightresult =~ "$_;") {
+ if ( $rightresult =~ "$_;" ) {
$finalresult .= "$_;$_;";
}
}
return $finalresult;
- } elsif ($operator eq ' or ') {
+ }
+ elsif ( $operator eq ' or ' ) {
+
# just merge the 2 strings
- return $leftresult.$rightresult;
- } elsif ($operator eq ' not ') {
+ return $leftresult . $rightresult;
+ }
+ elsif ( $operator eq ' not ' ) {
my @leftresult = split /;/, $leftresult;
-# my @rightresult = split /;/,$leftresult;
+
+ # my @rightresult = split /;/,$leftresult;
my $finalresult;
foreach (@leftresult) {
- unless ($rightresult =~ "$_;") {
+ unless ( $rightresult =~ "$_;" ) {
$finalresult .= "$_;";
}
}
return $finalresult;
- } else {
- # this error is impossible, because of the regexp that isolate the operand, but just in case...
+ }
+ else {
+
+# this error is impossible, because of the regexp that isolate the operand, but just in case...
die "error : operand unknown : $operator for $string";
}
- # it's a leaf, do the real SQL query and return the result
- } else {
- $string =~ s/__X__/"$commacontent"/ if $commacontent;
+
+ # it's a leaf, do the real SQL query and return the result
+ }
+ else {
+ $string =~ s/__X__/"$commacontent"/ if $commacontent;
$string =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|&|\+|\*|\// /g;
warn "leaf:$string" if $DEBUG;
+
# parse the string in in operator/operand/value again
$string =~ /(.*)(>=|<=)(.*)/;
- my $left = $1;
+ my $left = $1;
my $operator = $2;
- my $right = $3;
- warn "handling leaf... left:$left operator:$operator right:$right" if $DEBUG;
+ my $right = $3;
+ warn "handling leaf... left:$left operator:$operator right:$right"
+ if $DEBUG;
unless ($operator) {
$string =~ /(.*)(>|<|=)(.*)/;
- $left = $1;
+ $left = $1;
$operator = $2;
- $right = $3;
- warn "handling unless (operator)... left:$left operator:$operator right:$right" if $DEBUG;
+ $right = $3;
+ warn
+"handling unless (operator)... left:$left operator:$operator right:$right"
+ if $DEBUG;
}
my $results;
- # strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
+
+# strip adv, zebra keywords, currently not handled in nozebra: wrdl, ext, phr...
$left =~ s/[ ,].*$//;
+
# automatic replace for short operators
- $left='title' if $left =~ '^ti$';
- $left='author' if $left =~ '^au$';
- $left='publisher' if $left =~ '^pb$';
- $left='subject' if $left =~ '^su$';
- $left='koha-Auth-Number' if $left =~ '^an$';
- $left='keyword' if $left =~ '^kw$';
- if ($operator && $left ne 'keyword' ) {
+ $left = 'title' if $left =~ '^ti$';
+ $left = 'author' if $left =~ '^au$';
+ $left = 'publisher' if $left =~ '^pb$';
+ $left = 'subject' if $left =~ '^su$';
+ $left = 'koha-Auth-Number' if $left =~ '^an$';
+ $left = 'keyword' if $left =~ '^kw$';
+ 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("SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?");
+ $operator = 'LIKE' if $operator eq '=' and $right =~ /%/;
+ my $sth =
+ $dbh->prepare(
+"SELECT biblionumbers,value FROM nozebra WHERE server=? AND indexname=? AND value $operator ?"
+ );
warn "$left / $operator / $right\n";
+
# split each word, query the DB and build the biblionumbers result
- #sanitizing leftpart
- $left=~s/^\s+|\s+$//;
- foreach (split / /,$right) {
+ #sanitizing leftpart
+ $left =~ s/^\s+|\s+$//;
+ foreach ( split / /, $right ) {
my $biblionumbers;
- $_=~s/^\s+|\s+$//;
+ $_ =~ s/^\s+|\s+$//;
next unless $_;
warn "EXECUTE : $server, $left, $_";
- $sth->execute($server, $left, $_) or warn "execute failed: $!";
- while (my ($line,$value) = $sth->fetchrow) {
- # if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
- # otherwise, fill the result
- $biblionumbers .= $line unless ($right =~ /^\d+$/ && $value =~ /\D/);
- warn "result : $value ". ($right =~ /\d/) . "==".(!$value =~ /\d/) ;#= $line";
+ $sth->execute( $server, $left, $_ )
+ or warn "execute failed: $!";
+ while ( my ( $line, $value ) = $sth->fetchrow ) {
+
+# if we are dealing with a numeric value, use only numeric results (in case of >=, <=, > or <)
+# otherwise, fill the result
+ $biblionumbers .= $line
+ unless ( $right =~ /^\d+$/ && $value =~ /\D/ );
+ warn "result : $value "
+ . ( $right =~ /\d/ ) . "=="
+ . ( !$value =~ /\d/ ); #= $line";
}
- # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
+
+# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
if ($results) {
my @leftresult = split /;/, $biblionumbers;
my $temp;
- foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
- # remove weight at the end
+ foreach my $entry (@leftresult)
+ { # $_ contains biblionumber,title-weight
+ # remove weight at the end
my $cleaned = $entry;
$cleaned =~ s/-\d*$//;
- # if the entry already in the hash, take it & increase weight
+
+ # if the entry already in the hash, take it & increase weight
warn "===== $cleaned =====" if $DEBUG;
- if ($results =~ "$cleaned") {
+ if ( $results =~ "$cleaned" ) {
$temp .= "$entry;$entry;";
warn "INCLUDING $entry" if $DEBUG;
}
}
$results = $temp;
- } else {
+ }
+ else {
$results = $biblionumbers;
}
}
- } else {
- #do a complete search (all indexes), if index='kw' do complete search too.
+ }
+ else {
+
+ #do a complete search (all indexes), if index='kw' do complete search too.
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT biblionumbers FROM nozebra WHERE server=? AND value LIKE ?");
+ 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) {
- next if C4::Context->stopwords->{uc($_)}; # skip if stopword
+ foreach ( split / /, $string ) {
+ next if C4::Context->stopwords->{ uc($_) }; # skip if stopword
warn "search on all indexes on $_" if $DEBUG;
my $biblionumbers;
next unless $_;
- $sth->execute($server, $_);
- while (my $line = $sth->fetchrow) {
+ $sth->execute( $server, $_ );
+ while ( my $line = $sth->fetchrow ) {
$biblionumbers .= $line;
}
- # do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
+
+# do a AND with existing list if there is one, otherwise, use the biblionumbers list as 1st result list
if ($results) {
- warn "RES for $_ = $biblionumbers" if $DEBUG;
+ warn "RES for $_ = $biblionumbers" if $DEBUG;
my @leftresult = split /;/, $biblionumbers;
my $temp;
- foreach my $entry (@leftresult) { # $_ contains biblionumber,title-weight
- # remove weight at the end
+ foreach my $entry (@leftresult)
+ { # $_ contains biblionumber,title-weight
+ # remove weight at the end
my $cleaned = $entry;
$cleaned =~ s/-\d*$//;
- # if the entry already in the hash, take it & increase weight
-# warn "===== $cleaned =====" if $DEBUG;
- if ($results =~ "$cleaned") {
+
+ # if the entry already in the hash, take it & increase weight
+ # warn "===== $cleaned =====" if $DEBUG;
+ if ( $results =~ "$cleaned" ) {
$temp .= "$entry;$entry;";
-# warn "INCLUDING $entry" if $DEBUG;
+
+ # warn "INCLUDING $entry" if $DEBUG;
}
}
$results = $temp;
- } else {
- warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
+ }
+ else {
+ warn "NEW RES for $_ = $biblionumbers" if $DEBUG;
$results = $biblionumbers;
}
}
}
- warn "return : $results for LEAF : $string" if $DEBUG;
+ warn "return : $results for LEAF : $string" if $DEBUG;
return $results;
}
- warn "---------" if $DEBUG;
+ warn "---------" if $DEBUG;
warn "Leave NZanalyse" if $DEBUG;
- warn "---------" if $DEBUG;
+ warn "---------" if $DEBUG;
}
=head2 NZorder
=cut
-
sub NZorder {
- my ($biblionumbers, $ordering,$results_per_page,$offset) = @_;
+ my ( $biblionumbers, $ordering, $results_per_page, $offset ) = @_;
warn "biblionumbers = $biblionumbers and ordering = $ordering\n" if $DEBUG;
+
# order title asc by default
-# $ordering = '1=36 <i' unless $ordering;
- $results_per_page=20 unless $results_per_page;
- $offset = 0 unless $offset;
+ # $ordering = '1=36 <i' unless $ordering;
+ $results_per_page = 20 unless $results_per_page;
+ $offset = 0 unless $offset;
my $dbh = C4::Context->dbh;
+
#
# order by POPULARITY
#
- if ($ordering =~ /popularity/) {
+ if ( $ordering =~ /popularity/ ) {
my %result;
my %popularity;
+
# popularity is not in MARC record, it's builded from a specific query
- my $sth = $dbh->prepare("select sum(issues) from items where biblionumber=?");
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
- $result{$biblionumber}=GetMarcBiblio($biblionumber);
+ my $sth =
+ $dbh->prepare("select sum(issues) from items where biblionumber=?");
+ foreach ( split /;/, $biblionumbers ) {
+ my ( $biblionumber, $title ) = split /,/, $_;
+ $result{$biblionumber} = GetMarcBiblio($biblionumber);
$sth->execute($biblionumber);
- 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
- # 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.$biblionumber} = $biblionumber;
+ 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
+# 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
+ . $biblionumber } = $biblionumber;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- if ($ordering eq 'popularity_dsc') { # sort popularity DESC
- foreach my $key (sort {$b cmp $a} (keys %popularity)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
+ my $numbers = 0;
+ if ( $ordering eq 'popularity_dsc' ) { # sort popularity DESC
+ foreach my $key ( sort { $b cmp $a } ( keys %popularity ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{ $popularity{$key} }->as_usmarc();
}
- } else { # sort popularity ASC
- foreach my $key (sort (keys %popularity)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$popularity{$key}}->as_usmarc();
+ }
+ else { # sort popularity ASC
+ foreach my $key ( sort ( keys %popularity ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{ $popularity{$key} }->as_usmarc();
}
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
- #
- # ORDER BY author
- #
- } elsif ($ordering =~/author/){
+
+ #
+ # ORDER BY author
+ #
+ }
+ elsif ( $ordering =~ /author/ ) {
my %result;
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
- my $record=GetMarcBiblio($biblionumber);
+ foreach ( split /;/, $biblionumbers ) {
+ my ( $biblionumber, $title ) = split /,/, $_;
+ my $record = GetMarcBiblio($biblionumber);
my $author;
- if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
- $author=$record->subfield('200','f');
- $author=$record->subfield('700','a') unless $author;
- } else {
- $author=$record->subfield('100','a');
+ if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
+ $author = $record->subfield( '200', 'f' );
+ $author = $record->subfield( '700', 'a' ) unless $author;
+ }
+ else {
+ $author = $record->subfield( '100', 'a' );
}
- # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
- # and we don't want to get only 1 result for each of them !!!
- $result{$author.$biblionumber}=$record;
+
+# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
+# and we don't want to get only 1 result for each of them !!!
+ $result{ $author . $biblionumber } = $record;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- if ($ordering eq 'author_za') { # sort by author desc
- foreach my $key (sort { $b cmp $a } (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ my $numbers = 0;
+ if ( $ordering eq 'author_za' ) { # sort by author desc
+ foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
- } else { # sort by author ASC
- foreach my $key (sort (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ }
+ else { # sort by author ASC
+ foreach my $key ( sort ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
- #
- # ORDER BY callnumber
- #
- } elsif ($ordering =~/callnumber/){
+
+ #
+ # ORDER BY callnumber
+ #
+ }
+ elsif ( $ordering =~ /callnumber/ ) {
my %result;
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
- my $record=GetMarcBiblio($biblionumber);
+ foreach ( split /;/, $biblionumbers ) {
+ 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;
- if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
- $callnumber=$record->subfield('200','f');
- } else {
- $callnumber=$record->subfield('100','a');
+ my ( $callnumber_tag, $callnumber_subfield ) =
+ GetMarcFromKohaField( $dbh, 'items.itemcallnumber' );
+ ( $callnumber_tag, $callnumber_subfield ) =
+ GetMarcFromKohaField('biblioitems.callnumber')
+ unless $callnumber_tag;
+ if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
+ $callnumber = $record->subfield( '200', 'f' );
}
- # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
- # and we don't want to get only 1 result for each of them !!!
- $result{$callnumber.$biblionumber}=$record;
+ else {
+ $callnumber = $record->subfield( '100', 'a' );
+ }
+
+# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
+# and we don't want to get only 1 result for each of them !!!
+ $result{ $callnumber . $biblionumber } = $record;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- if ($ordering eq 'call_number_dsc') { # sort by title desc
- foreach my $key (sort { $b cmp $a } (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ my $numbers = 0;
+ if ( $ordering eq 'call_number_dsc' ) { # sort by title desc
+ foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
- } else { # sort by title ASC
- foreach my $key (sort { $a cmp $b } (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ }
+ else { # sort by title ASC
+ foreach my $key ( sort { $a cmp $b } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
- } elsif ($ordering =~ /pubdate/){ #pub year
+ }
+ elsif ( $ordering =~ /pubdate/ ) { #pub year
my %result;
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
- my $record=GetMarcBiblio($biblionumber);
- my ($publicationyear_tag,$publicationyear_subfield)=GetMarcFromKohaField('biblioitems.publicationyear','');
- my $publicationyear=$record->subfield($publicationyear_tag,$publicationyear_subfield);
- # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
- # and we don't want to get only 1 result for each of them !!!
- $result{$publicationyear.$biblionumber}=$record;
+ foreach ( split /;/, $biblionumbers ) {
+ my ( $biblionumber, $title ) = split /,/, $_;
+ my $record = GetMarcBiblio($biblionumber);
+ my ( $publicationyear_tag, $publicationyear_subfield ) =
+ GetMarcFromKohaField( 'biblioitems.publicationyear', '' );
+ my $publicationyear =
+ $record->subfield( $publicationyear_tag,
+ $publicationyear_subfield );
+
+# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
+# and we don't want to get only 1 result for each of them !!!
+ $result{ $publicationyear . $biblionumber } = $record;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- if ($ordering eq 'pubdate_dsc') { # sort by pubyear desc
- foreach my $key (sort { $b cmp $a } (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ my $numbers = 0;
+ if ( $ordering eq 'pubdate_dsc' ) { # sort by pubyear desc
+ foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
- } else { # sort by pub year ASC
- foreach my $key (sort (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key}->as_usmarc();
+ }
+ else { # sort by pub year ASC
+ foreach my $key ( sort ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] =
+ $result{$key}->as_usmarc();
}
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
- #
- # ORDER BY title
- #
- } elsif ($ordering =~ /title/) {
- # the title is in the biblionumbers string, so we just need to build a hash, sort it and return
+
+ #
+ # ORDER BY title
+ #
+ }
+ elsif ( $ordering =~ /title/ ) {
+
+# the title is in the biblionumbers string, so we just need to build a hash, sort it and return
my %result;
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
- # hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
- # and we don't want to get only 1 result for each of them !!!
- # hint & speed improvement : we can order without reading the record
- # so order, and read records only for the requested page !
- $result{$title.$biblionumber}=$biblionumber;
+ foreach ( split /;/, $biblionumbers ) {
+ my ( $biblionumber, $title ) = split /,/, $_;
+
+# hint : the result is sorted by title.biblionumber because we can have X biblios with the same title
+# and we don't want to get only 1 result for each of them !!!
+# hint & speed improvement : we can order without reading the record
+# so order, and read records only for the requested page !
+ $result{ $title . $biblionumber } = $biblionumber;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- if ($ordering eq 'title_az') { # sort by title desc
- foreach my $key (sort (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
+ my $numbers = 0;
+ if ( $ordering eq 'title_az' ) { # sort by title desc
+ foreach my $key ( sort ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
}
- } else { # sort by title ASC
- foreach my $key (sort { $b cmp $a } (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
+ }
+ else { # sort by title ASC
+ foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
}
}
+
# limit the $results_per_page to result size if it's more
- $results_per_page = $numbers-1 if $numbers < $results_per_page;
+ $results_per_page = $numbers - 1 if $numbers < $results_per_page;
+
# for the requested page, replace biblionumber by the complete record
# speed improvement : avoid reading too much things
- for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
- $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc;
+ for (
+ my $counter = $offset ;
+ $counter <= $offset + $results_per_page ;
+ $counter++
+ )
+ {
+ $result_hash->{'RECORDS'}[$counter] =
+ GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc;
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
- } else {
- #
- # order by ranking
- #
- # we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
+ }
+ else {
+
+#
+# order by ranking
+#
+# we need 2 hashes to order by ranking : the 1st one to count the ranking, the 2nd to order by ranking
my %result;
my %count_ranking;
- foreach (split /;/,$biblionumbers) {
- my ($biblionumber,$title) = split /,/,$_;
+ foreach ( split /;/, $biblionumbers ) {
+ my ( $biblionumber, $title ) = split /,/, $_;
$title =~ /(.*)-(\d)/;
- # get weight
- my $ranking =$2;
- # note that we + the ranking because ranking is calculated on weight of EACH term requested.
- # if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
- # biblio N has ranking = 6
+
+ # get weight
+ my $ranking = $2;
+
+# note that we + the ranking because ranking is calculated on weight of EACH term requested.
+# if we ask for "two towers", and "two" has weight 2 in biblio N, and "towers" has weight 4 in biblio N
+# biblio N has ranking = 6
$count_ranking{$biblionumber} += $ranking;
}
- # build the result by "inverting" the count_ranking hash
- # hing : as usual, we don't order by ranking only, to avoid having only 1 result for each rank. We build an hash on concat(ranking,biblionumber) instead
+
+# build the result by "inverting" the count_ranking hash
+# hing : as usual, we don't order by ranking only, to avoid having only 1 result for each rank. We build an hash on concat(ranking,biblionumber) instead
# warn "counting";
- foreach (keys %count_ranking) {
- $result{sprintf("%10d",$count_ranking{$_}).'-'.$_} = $_;
+ foreach ( keys %count_ranking ) {
+ $result{ sprintf( "%10d", $count_ranking{$_} ) . '-' . $_ } = $_;
}
- # sort the hash and return the same structure as GetRecords (Zebra querying)
+
+ # sort the hash and return the same structure as GetRecords (Zebra querying)
my $result_hash;
- my $numbers=0;
- foreach my $key (sort {$b cmp $a} (keys %result)) {
- $result_hash->{'RECORDS'}[$numbers++] = $result{$key};
- }
+ my $numbers = 0;
+ foreach my $key ( sort { $b cmp $a } ( keys %result ) ) {
+ $result_hash->{'RECORDS'}[ $numbers++ ] = $result{$key};
+ }
+
# limit the $results_per_page to result size if it's more
- $results_per_page = $numbers-1 if $numbers < $results_per_page;
+ $results_per_page = $numbers - 1 if $numbers < $results_per_page;
+
# for the requested page, replace biblionumber by the complete record
# speed improvement : avoid reading too much things
- for (my $counter=$offset;$counter<=$offset+$results_per_page;$counter++) {
- $result_hash->{'RECORDS'}[$counter] = GetMarcBiblio($result_hash->{'RECORDS'}[$counter])->as_usmarc if $result_hash->{'RECORDS'}[$counter];
+ for (
+ my $counter = $offset ;
+ $counter <= $offset + $results_per_page ;
+ $counter++
+ )
+ {
+ $result_hash->{'RECORDS'}[$counter] =
+ GetMarcBiblio( $result_hash->{'RECORDS'}[$counter] )->as_usmarc
+ if $result_hash->{'RECORDS'}[$counter];
}
- my $finalresult=();
- $result_hash->{'hits'} = $numbers;
+ my $finalresult = ();
+ $result_hash->{'hits'} = $numbers;
$finalresult->{'biblioserver'} = $result_hash;
return $finalresult;
}
}
+
=head2 ModBiblios
($countchanged,$listunchanged) = ModBiblios($listbiblios, $tagsubfield,$initvalue,$targetvalue,$test);
=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;
- }
- my ($bntag,$bnsubf) = GetMarcFromKohaField('biblio.biblionumber');
- my ($itemtag,$itemsubf) = GetMarcFromKohaField('items.itemnumber');
- foreach my $usmarc (@$listbiblios){
- my $record;
- $record=eval{MARC::Record->new_from_usmarc($usmarc)};
- my $biblionumber;
- if ($@){
- # usmarc is not a valid usmarc May be a biblionumber
- if ($tag eq $itemtag){
- my $bib=GetBiblioFromItemNumber($usmarc);
- $record=GetMarcItem($bib->{'biblionumber'},$usmarc) ;
- $biblionumber=$bib->{'biblionumber'};
- } else {
- $record=GetMarcBiblio($usmarc);
- $biblionumber=$usmarc;
- }
- } else {
- if ($bntag >= 010){
- $biblionumber = $record->subfield($bntag,$bnsubf);
- }else {
- $biblionumber=$record->field($bntag)->data;
- }
- }
- #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;
+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;
+ }
+ my ( $bntag, $bnsubf ) = GetMarcFromKohaField('biblio.biblionumber');
+ my ( $itemtag, $itemsubf ) = GetMarcFromKohaField('items.itemnumber');
+ foreach my $usmarc (@$listbiblios) {
+ my $record;
+ $record = eval { MARC::Record->new_from_usmarc($usmarc) };
+ my $biblionumber;
+ if ($@) {
+
+ # usmarc is not a valid usmarc May be a biblionumber
+ if ( $tag eq $itemtag ) {
+ my $bib = GetBiblioFromItemNumber($usmarc);
+ $record = GetMarcItem( $bib->{'biblionumber'}, $usmarc );
+ $biblionumber = $bib->{'biblionumber'};
}
- } else {
- $field->data=$targetvalue if ($field->data=~qr($initvalue));
- }
- }
- }
-# warn $record->as_formatted;
- if ($modify){
- ModBiblio($record,$biblionumber,GetFrameworkCode($biblionumber)) unless ($test);
- } else {
- push @unmatched, $biblionumber;
- }
- } else {
- push @unmatched, $biblionumber;
+ else {
+ $record = GetMarcBiblio($usmarc);
+ $biblionumber = $usmarc;
+ }
+ }
+ else {
+ if ( $bntag >= 010 ) {
+ $biblionumber = $record->subfield( $bntag, $bnsubf );
+ }
+ else {
+ $biblionumber = $record->field($bntag)->data;
+ }
+ }
+
+ #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) );
+ }
+ }
+ }
+
+ # warn $record->as_formatted;
+ if ($modify) {
+ ModBiblio( $record, $biblionumber,
+ GetFrameworkCode($biblionumber) )
+ unless ($test);
+ }
+ else {
+ push @unmatched, $biblionumber;
+ }
+ }
+ else {
+ push @unmatched, $biblionumber;
+ }
}
- }
- return ($countmatched,\@unmatched);
+ return ( $countmatched, \@unmatched );
}
END { } # module clean-up code here (global destructor)
=head1 NAME
-search - a search script for finding records in a Koha system (Version 3.0)
+search - a search script for finding records in a Koha system (Version 3)
=head1 OVERVIEW
-This script contains a new search API for Koha 3.0. It is designed to be
+This script utilizes a new search API for Koha 3. It is designed to be
simple to use and configure, yet capable of performing feats like stemming,
field weighting, relevance ranking, support for multiple query language
-formats (CCL, CQL, PQF), full or nearly full support for the
-bib1 attribute set, extended attribute sets defined in Zebra profiles, access
-to the full range of Z39.50 query options, federated searches on Z39.50
-targets, etc.
+formats (CCL, CQL, PQF), full support for the bib1 attribute set, extended
+attribute sets defined in Zebra profiles, access to the full range of Z39.50
+and SRU query options, federated searches on Z39.50/SRU targets, etc.
-I believe the API as represented in this script is mostly sound, even if the
-individual functions in Search.pm and Koha.pm need to be cleaned up. Of course,
-you are free to disagree :-)
+The API as represented in this script is mostly sound, even if the individual
+functions in Search.pm and Koha.pm need to be cleaned up. Of course, you are
+free to disagree :-)
I will attempt to describe what is happening at each part of this script.
--- JF
+-- Joshua Ferraro <jmf AT liblime DOT com>
=head2 INTRO
Once determined, proceed to only load the variables and procedures necessary
for that function.
-=head2 THE ADVANCED SEARCH PAGE
+=head2 LOADING ADVANCED SEARCH PAGE
-If we're loading the advanced search page this script will call a number of
-display* routines which populate objects that are sent to the template for
-display of things like search indexes, languages, search limits, branches,
-etc. These are not stored in the template for two reasons:
-
-=over
-
-=item 1. Efficiency - we have more control over objects inside the script,
-and it's possible to not duplicate things like indexes (if the search indexes
-were stored in the template they would need to be repeated)
-
-=item 2. Customization - if these elements were moved to the sql database it
-would allow a simple librarian to determine which fields to display on the page
-without editing any html (also how the fields should behave when being searched).
-
-=back
-
-However, they create one problem : the strings aren't translated. I have an idea
-for how to do this that I will purusue soon.
+This is fairly straightforward, and I won't go into detail ;-)
=head2 PERFORMING A SEARCH
=over
-=item 1 Koha query - the query that is passed to Zebra
+=item 1 $query - the fully-built query passed to zebra
This is the most complex query that needs to be built. The original design goal
was to use a custom CCL2PQF query parser to translate an incoming CCL query into
weighting, koha-specific relevance ranking, and stemming. When I have a chance
I'll try to flesh out this section to better explain.
-This query incorporates query profiles that aren't compatible with non-Zebra
+This query incorporates query profiles that aren't compatible with most non-Zebra
Z39.50 targets to acomplish the field weighting and relevance ranking.
-=item 2 Federated query - the query that is passed to other Z39.50 targets
+=item 2 $simple_query - a simple query that doesn't contain the field weighting,
+stemming, etc., suitable to pass off to other search targets
This query is just the user's query expressed in CCL CQL, or PQF for passing to a
non-zebra Z39.50 target (one that doesn't support the extended profile that Zebra does).
-=item 3 Search description - passed to the template / saved for future refinements of
+=item 3 $query_cgi - passed to the template / saved for future refinements of
the query (by user)
-This is a simple string that completely expresses the query in a way that can be parsed
-by Koha for future refinements of the query or as a part of a history feature. It differs
-from the human search description:
-
-1. it does not contain commas or = signs
+This is a simple string that completely expresses the query as a CGI string that
+can be used for future refinements of the query or as a part of a history feature.
-=item 4 Human search description - what the user sees in the search_desc area
+=item 4 $query_desc - Human search description - what the user sees in search
+feedback area
-This is a simple string nearly identical to the Search description, but more human
-readable. It will contain = signs or commas, etc.
+This is a simple string that is human readable. It will contain '=', ',', etc.
=back
=head3 2. Perform the Search
-This section takes the query strings and performs searches on the named servers, including
-the Koha Zebra server, stores the results in a deeply nested object, builds 'faceted results',
-and returns these objects.
+This section takes the query strings and performs searches on the named servers,
+including the Koha Zebra server, stores the results in a deeply nested object,
+builds 'faceted results', and returns these objects.
=head3 3. Build HTML
-The final major section of this script takes the objects collected thusfar and builds the
-HTML for output to the template and user.
+The final major section of this script takes the objects collected thusfar and
+builds the HTML for output to the template and user.
=head3 Additional Notes
## STEP 1. Load things that are used in both search page and
# results page and decide which template to load, operations
# to perform, etc.
+
## load Koha modules
use C4::Context;
use C4::Output;
use C4::Koha;
use POSIX qw(ceil floor);
use C4::Branch; # GetBranches
+
# create a new CGI object
-# not sure undef_params option is working, need to test
+# FIXME: no_undef_params needs to be tested
use CGI qw('-no_undef_params');
my $cgi = new CGI;
}
else {
$template_name = 'catalogue/advsearch.tmpl';
- $template_type = 'advsearch';
+ $template_type = 'advsearch';
}
# load the template
($template, $borrowernumber, $cookie) = get_template_and_user({
}
);
if (C4::Context->preference("marcflavour") eq "UNIMARC" ) {
- $template->param('UNIMARC' => 1);
+ $template->param('UNIMARC' => 1);
}
-=head1 BUGS and FIXMEs
-
-There are many, most are documented in the code. The one that
-isn't fully documented, but referred to is the need for a full
-query parser.
-
-=cut
-
## URI Re-Writing
# Deprecated, but preserved because it's interesting :-)
+# The same thing can be accomplished with mod_rewrite in
+# a more elegant way
+#
#my $rewrite_flag;
#my $uri = $cgi->url(-base => 1);
#my $relative_url = $cgi->url(-relative=>1);
# load the branches
my $branches = GetBranches();
my @branch_loop;
-#push @branch_loop, {value => "", branchname => "All Branches", };
+
for my $branch_hash (sort keys %$branches) {
push @branch_loop, {value => "$branch_hash" , branchname => $branches->{$branch_hash}->{'branchname'}, };
}
}
$template->param(itemtypeloop => \@itemtypesloop);
-# # load the itypes (Called item types in the template -- just authorized values for searching)
-# my ($itypecount,@itype_loop) = GetCcodes();
-# $template->param(itypeloop=>\@itype_loop,);
+# load the ccodes
+# my ($ccodecount,@ccode_loop) = GetCcodes();
+# $template->param(ccodeloop=>\@ccode_loop,);
# load the languages ( for switching from one template to another )
$template->param(languages_loop => getTranslatedLanguages('intranet','prog'));
# The following should only be loaded if we're bringing up the advanced search template
if ( $template_type eq 'advsearch' ) {
+
# load the servers (used for searching -- to do federated searching, etc.)
my $primary_servers_loop;# = displayPrimaryServers();
$template->param(outer_servers_loop => $primary_servers_loop,);
my @search_boxes_array;
my $search_boxes_count = C4::Context->preference("OPACAdvSearchInputCount") | 3; # FIXME: should be a syspref
for (my $i=1;$i<=$search_boxes_count;$i++) {
- # if it's the first one, don't display boolean option, but show scan indexes
+ # if it's the first one, don't display boolean option, but show scan indexes
if ($i==1) {
push @search_boxes_array,
{
};
}
- # if it's the last one, show the 'add field' box
+ # if it's the last one, show the 'add field' box
elsif ($i==$search_boxes_count) {
push @search_boxes_array,
{
- boolean => 1,
+ boolean => 1,
add_field => 1,
- };
+ };
+ }
+ else {
+ push @search_boxes_array,
+ {
+ boolean => 1,
+ };
}
- else {
- push @search_boxes_array,
- {
- boolean => 1,
- };
- }
}
$template->param(uc(C4::Context->preference("marcflavour")) => 1,
my $languages_limit_loop = getAllLanguages();
$template->param(search_languages_loop => $languages_limit_loop,);
- # use the global setting by default
- if ( C4::Context->preference("expandedSearchOption") == 1) {
- $template->param( expanded_options => C4::Context->preference("expandedSearchOption") );
- }
- # but let the user override it
- if ( ($cgi->param('expanded_options') == 0) || ($cgi->param('expanded_options') == 1 ) ) {
- $template->param( expanded_options => $cgi->param('expanded_options'));
- }
+ # use the global setting by default
+ if ( C4::Context->preference("expandedSearchOption") == 1) {
+ $template->param( expanded_options => C4::Context->preference("expandedSearchOption") );
+ }
+ # but let the user override it
+ if ( ($cgi->param('expanded_options') == 0) || ($cgi->param('expanded_options') == 1 ) ) {
+ $template->param( expanded_options => $cgi->param('expanded_options'));
+ }
output_html_with_http_headers $cgi, $cookie, $template->output;
exit;
}
-### OK, if we're this far, we're performing an actual search
+### OK, if we're this far, we're performing a search, not just loading the advanced search page
# Fetch the paramater list as a hash in scalar context:
# * returns paramater list as tied hash ref
# in theory can have more than one but generally there's just one
my @sort_by;
my $default_sort_by = C4::Context->preference('defaultSortField')."_".C4::Context->preference('defaultSortOrder')
- if (C4::Context->preference('defaultSortField') && C4::Context->preference('defaultSortOrder'));
+ if (C4::Context->preference('defaultSortField') && C4::Context->preference('defaultSortOrder'));
@sort_by = split("\0",$params->{'sort_by'}) if $params->{'sort_by'};
$sort_by[0] = $default_sort_by unless $sort_by[0];
foreach my $sort (@sort_by) {
- $template->param($sort => 1);
+ $template->param($sort => 1);
}
$template->param('sort_by' => $sort_by[0]);
@servers = ("biblioserver");
# @servers = C4::Context->config("biblioserver");
}
-
# operators include boolean and proximity operators and are used
# to evaluate multiple operands
my @operators;
my $limit_yr;
my $limit_yr_value;
if ($params->{'limit-yr'}) {
- if ($params->{'limit-yr'} =~ /\d{4}-\d{4}/) {
- my ($yr1,$yr2) = split(/-/, $params->{'limit-yr'});
- $limit_yr = "yr,st-numeric,ge=$yr1 and yr,st-numeric,le=$yr2";
- $limit_yr_value = "$yr1-$yr2";
- }
- elsif ($params->{'limit-yr'} =~ /\d{4}/) {
- $limit_yr = "yr,st-numeric=$params->{'limit-yr'}";
- $limit_yr_value = $params->{'limit-yr'};
- }
- push @limits,$limit_yr;
- #FIXME: Should return a error to the user, incorect date format specified
+ if ($params->{'limit-yr'} =~ /\d{4}-\d{4}/) {
+ my ($yr1,$yr2) = split(/-/, $params->{'limit-yr'});
+ $limit_yr = "yr,st-numeric,ge=$yr1 and yr,st-numeric,le=$yr2";
+ $limit_yr_value = "$yr1-$yr2";
+ }
+ elsif ($params->{'limit-yr'} =~ /\d{4}/) {
+ $limit_yr = "yr,st-numeric=$params->{'limit-yr'}";
+ $limit_yr_value = $params->{'limit-yr'};
+ }
+ push @limits,$limit_yr;
+ #FIXME: Should return a error to the user, incorect date format specified
}
# Params that can only have one value
## parse the query_cgi string and put it into a form suitable for <input>s
my @query_inputs;
for my $this_cgi ( split('&',$query_cgi) ) {
- next unless $this_cgi;
- $this_cgi =~ m/(.*=)(.*)/;
- my $input_name = $1;
- my $input_value = $2;
- $input_name =~ s/=$//;
- push @query_inputs, { input_name => $input_name, input_value => $input_value };
+ next unless $this_cgi;
+ $this_cgi =~ m/(.*=)(.*)/;
+ my $input_name = $1;
+ my $input_value = $2;
+ $input_name =~ s/=$//;
+ push @query_inputs, { input_name => $input_name, input_value => $input_value };
}
$template->param ( QUERY_INPUTS => \@query_inputs );
## parse the limit_cgi string and put it into a form suitable for <input>s
my @limit_inputs;
for my $this_cgi ( split('&',$limit_cgi) ) {
- next unless $this_cgi;
- # handle special case limit-yr
- if ($this_cgi =~ /yr,st-numeric/) {
- push @limit_inputs, { input_name => 'limit-yr', input_value => $limit_yr_value };
- next;
- }
+ next unless $this_cgi;
+ # handle special case limit-yr
+ if ($this_cgi =~ /yr,st-numeric/) {
+ push @limit_inputs, { input_name => 'limit-yr', input_value => $limit_yr_value };
+ next;
+ }
$this_cgi =~ m/(.*=)(.*)/;
my $input_name = $1;
my $input_value = $2;
# FIXME: This belongs in tools/ not in the primary search results page
my $op=$cgi->param("operation");
if ($op eq "bulkedit"){
- my ($countchanged,$listunchanged)=
- ModBiblios($results_hashref->{'biblioserver'}->{"RECORDS"},
+ my ($countchanged,$listunchanged)=
+ ModBiblios($results_hashref->{'biblioserver'}->{"RECORDS"},
$params->{"tagsubfield"},
$params->{"inputvalue"},
$params->{"targetvalue"},
$params->{"test"}
);
- $template->param(bulkeditresults=>1,
+ $template->param(bulkeditresults=>1,
tagsubfield=>$params->{"tagsubfield"},
inputvalue=>$params->{"inputvalue"},
targetvalue=>$params->{"targetvalue"},
countunchanged=>scalar(@$listunchanged),
listunchanged=>$listunchanged);
- if (C4::Context->userenv->{'flags'}==1 ||(C4::Context->userenv->{'flags'} & ( 2**9 ) )){
- #Edit Catalogue Permissions
- $template->param(bulkedit => 1);
- $template->param(tagsubfields=>GetManagedTagSubfields());
- }
+ if (C4::Context->userenv->{'flags'}==1 ||(C4::Context->userenv->{'flags'} & ( 2**9 ) )){
+ #Edit Catalogue Permissions
+ $template->param(bulkedit => 1);
+ $template->param(tagsubfields=>GetManagedTagSubfields());
+ }
}
+
# At this point, each server has given us a result set
# now we build that set for template display
my @sup_results_array;
-for (my $i=0;$i<=@servers;$i++) {
+for (my $i=0;$i<@servers;$i++) {
my $server = $servers[$i];
if ($server =~/biblioserver/) { # this is the local bibliographic server
$hits = $results_hashref->{$server}->{"hits"};
$total = $total + $results_hashref->{$server}->{"hits"};
if ($hits) {
$template->param(total => $hits);
- my $limit_cgi_not_availablity = $limit_cgi;
+ my $limit_cgi_not_availablity = $limit_cgi;
$limit_cgi_not_availablity =~ s/&limit=available//g;
$template->param(limit_cgi_not_availablity => $limit_cgi_not_availablity);
- $template->param(limit_cgi => $limit_cgi);
- $template->param(query_cgi => $query_cgi);
- $template->param(query_desc => $query_desc);
- $template->param(limit_desc => $limit_desc);
- if ($query_desc || $limit_desc) {
- $template->param(searchdesc => 1);
- }
- $template->param(stopwords_removed => "@$stopwords_removed") if $stopwords_removed;
+ $template->param(limit_cgi => $limit_cgi);
+ $template->param(query_cgi => $query_cgi);
+ $template->param(query_desc => $query_desc);
+ $template->param(limit_desc => $limit_desc);
+ if ($query_desc || $limit_desc) {
+ $template->param(searchdesc => 1);
+ }
+ $template->param(stopwords_removed => "@$stopwords_removed") if $stopwords_removed;
$template->param(results_per_page => $results_per_page);
$template->param(SEARCH_RESULTS => \@newresults);
- ## Build the page numbers on the bottom of the page
- my @page_numbers;
- # total number of pages there will be
- my $pages = ceil($hits / $results_per_page);
- # default page number
- my $current_page_number = 1;
- $current_page_number = ($offset / $results_per_page + 1) if $offset;
- my $previous_page_offset = $offset - $results_per_page unless ($offset - $results_per_page <0);
- my $next_page_offset = $offset + $results_per_page;
- # If we're within the first 10 pages, keep it simple
- #warn "current page:".$current_page_number;
- if ($current_page_number < 10) {
- # just show the first 10 pages
- # Loop through the pages
- my $pages_to_show = 10;
- $pages_to_show = $pages if $pages<10;
- for ($i=1; $i<=$pages_to_show;$i++) {
- # the offset for this page
- my $this_offset = (($i*$results_per_page)-$results_per_page);
- # the page number for this page
- my $this_page_number = $i;
- # it should only be highlighted if it's the current page
- my $highlight = 1 if ($this_page_number == $current_page_number);
- # put it in the array
- push @page_numbers, { offset => $this_offset, pg => $this_page_number, highlight => $highlight, sort_by => join " ",@sort_by };
+
+ ## FIXME: add a global function for this, it's better than the current global one
+ ## Build the page numbers on the bottom of the page
+ my @page_numbers;
+ # total number of pages there will be
+ my $pages = ceil($hits / $results_per_page);
+ # default page number
+ my $current_page_number = 1;
+ $current_page_number = ($offset / $results_per_page + 1) if $offset;
+ my $previous_page_offset = $offset - $results_per_page unless ($offset - $results_per_page <0);
+ my $next_page_offset = $offset + $results_per_page;
+ # If we're within the first 10 pages, keep it simple
+ #warn "current page:".$current_page_number;
+ if ($current_page_number < 10) {
+ # just show the first 10 pages
+ # Loop through the pages
+ my $pages_to_show = 10;
+ $pages_to_show = $pages if $pages<10;
+ for (my $i=1; $i<=$pages_to_show;$i++) {
+ # the offset for this page
+ my $this_offset = (($i*$results_per_page)-$results_per_page);
+ # the page number for this page
+ my $this_page_number = $i;
+ # it should only be highlighted if it's the current page
+ my $highlight = 1 if ($this_page_number == $current_page_number);
+ # put it in the array
+ push @page_numbers, { offset => $this_offset, pg => $this_page_number, highlight => $highlight, sort_by => join " ",@sort_by };
- }
+ }
- }
- # now, show twenty pages, with the current one smack in the middle
- else {
- for ($i=$current_page_number; $i<=($current_page_number + 20 );$i++) {
+ }
+ # now, show twenty pages, with the current one smack in the middle
+ else {
+ for (my $i=$current_page_number; $i<=($current_page_number + 20 );$i++) {
my $this_offset = ((($i-9)*$results_per_page)-$results_per_page);
my $this_page_number = $i-9;
my $highlight = 1 if ($this_page_number == $current_page_number);
- if ($this_page_number <= $pages) {
- push @page_numbers, { offset => $this_offset, pg => $this_page_number, highlight => $highlight, sort_by => join " ",@sort_by };
- }
+ if ($this_page_number <= $pages) {
+ push @page_numbers, { offset => $this_offset, pg => $this_page_number, highlight => $highlight, sort_by => join " ",@sort_by };
+ }
}
- }
- $template->param( PAGE_NUMBERS => \@page_numbers,
- previous_page_offset => $previous_page_offset) unless $pages < 2;
- $template->param(next_page_offset => $next_page_offset) unless $pages eq $current_page_number;
- }
- # no hits
- else {
- $template->param(searchdesc => 1,query_desc => $query_desc,limit_desc => $limit_desc);
- }
- } # end of the if local
- else {
- # check if it's a z3950 or opensearch source
- my $zed3950 = 0; # FIXME :: Hardcoded value.
- if ($zed3950) {
- my @inner_sup_results_array;
- for my $sup_record ( @{$results_hashref->{$server}->{"RECORDS"}} ) {
- my $marc_record_object = MARC::Record->new_from_usmarc($sup_record);
- my $control_number = $marc_record_object->field('010')->subfield('a') if $marc_record_object->field('010');
- $control_number =~ s/^ //g;
- my $link = "http://catalog.loc.gov/cgi-bin/Pwebrecon.cgi?SAB1=".$control_number."&BOOL1=all+of+these&FLD1=LC+Control+Number+LCCN+%28K010%29+%28K010%29&GRP1=AND+with+next+set&SAB2=&BOOL2=all+of+these&FLD2=Keyword+Anywhere+%28GKEY%29+%28GKEY%29&PID=6211&SEQ=20060816121838&CNT=25&HIST=1";
- my $title = $marc_record_object->title();
- push @inner_sup_results_array, {
- 'title' => $title,
- 'link' => $link,
- };
}
- my $servername = $server;
- push @sup_results_array, { servername => $servername, inner_sup_results_loop => \@inner_sup_results_array};
- $template->param(outer_sup_results_loop => \@sup_results_array);
+ # FIXME: no previous_page_offset when pages < 2
+ $template->param( PAGE_NUMBERS => \@page_numbers,
+ previous_page_offset => $previous_page_offset) unless $pages < 2;
+ $template->param( next_page_offset => $next_page_offset) unless $pages eq $current_page_number;
}
- }
+ # no hits
+ else {
+ $template->param(searchdesc => 1,query_desc => $query_desc,limit_desc => $limit_desc);
+ }
+ } # end of the if local
+ # asynchronously search the authority server
+ elsif ($server =~/authorityserver/) { # this is the local authority server
+ my @inner_sup_results_array;
+ for my $sup_record ( @{$results_hashref->{$server}->{"RECORDS"}} ) {
+ my $marc_record_object = MARC::Record->new_from_usmarc($sup_record);
+ # warn "Authority Found: ".$marc_record_object->as_formatted();
+ push @inner_sup_results_array, {
+ 'title' => $marc_record_object->field(100)->subfield('a'),
+ 'link' => "&idx=an&q=".$marc_record_object->field('001')->as_string(),
+ };
+ }
+ my $servername = $server;
+ push @sup_results_array, { servername => $servername,
+ inner_sup_results_loop => \@inner_sup_results_array} if @inner_sup_results_array;
+ }
+ # FIXME: can add support for other targets as needed here
+ $template->param( outer_sup_results_loop => \@sup_results_array);
} #/end of the for loop
#$template->param(FEDERATED_RESULTS => \@results_array);
);
if ($query_desc || $limit_desc) {
- $template->param(searchdesc => 1);
+ $template->param(searchdesc => 1);
}
## Now let's find out if we have any supplemental data to show the user
my $ipaddress;
if ( C4::Context->preference("kohaspsuggest") ) {
- my ($suggest_host, $suggest_dbname, $suggest_user, $suggest_pwd) = split(':', C4::Context->preference("kohaspsuggest"));
+ my ($suggest_host, $suggest_dbname, $suggest_user, $suggest_pwd) = split(':', C4::Context->preference("kohaspsuggest"));
eval {
my $koha_spsuggest_dbh;
# FIXME: this needs to be moved to Context.pm
projects / koha_ffzg / commitdiff