[Koha-cvs] koha acqui/newordersuggestion.pl C4/Search.pm C... [rel_3_0]
Antoine Farnault
antoine at koha-fr.org
Thu Nov 30 18:22:19 CET 2006
CVSROOT: /sources/koha
Module name: koha
Branch: rel_3_0
Changes by: Antoine Farnault <toins> 06/11/30 17:22:19
Modified files:
acqui : newordersuggestion.pl
C4 : Search.pm Serials.pm
catalogue : detail.pl detailprint.pl MARCdetail.pl
moredetail.pl
cataloguing : addbiblio.pl
opac : opac-basket.pl opac-detail.pl
opac-detailprint.pl opac-moredetail.pl
opac-reserve.pl opac-review.pl
opac-sendbasket.pl opac-shelves.pl
opac-showreviews.pl
Log message:
Cleaning Search.pm
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/newordersuggestion.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.3.2.1&r2=1.3.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Search.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.120.2.32&r2=1.120.2.33
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Serials.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.5.2.12&r2=1.5.2.13
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/detail.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.6.2.7&r2=1.6.2.8
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/detailprint.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.1.2.2&r2=1.1.2.3
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/MARCdetail.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.5.2.4&r2=1.5.2.5
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/moredetail.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.4.2.2&r2=1.4.2.3
http://cvs.savannah.gnu.org/viewcvs/koha/cataloguing/addbiblio.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.14.2.13&r2=1.14.2.14
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-basket.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.8&r2=1.8.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-detail.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.32.2.1&r2=1.32.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-detailprint.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.3.2.1&r2=1.3.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-moredetail.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.9.2.5&r2=1.9.2.6
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-reserve.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.29.2.2&r2=1.29.2.3
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-review.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.2&r2=1.2.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-sendbasket.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.10.2.1&r2=1.10.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-shelves.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.8.2.1&r2=1.8.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-showreviews.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.2&r2=1.2.2.1
Patches:
Index: acqui/newordersuggestion.pl
===================================================================
RCS file: /sources/koha/koha/acqui/newordersuggestion.pl,v
retrieving revision 1.3.2.1
retrieving revision 1.3.2.2
diff -u -b -r1.3.2.1 -r1.3.2.2
--- acqui/newordersuggestion.pl 17 Nov 2006 13:18:58 -0000 1.3.2.1
+++ acqui/newordersuggestion.pl 30 Nov 2006 17:22:18 -0000 1.3.2.2
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: newordersuggestion.pl,v 1.3.2.1 2006/11/17 13:18:58 tipaul Exp $
+# $Id: newordersuggestion.pl,v 1.3.2.2 2006/11/30 17:22:18 toins Exp $
=head1 NAME
newordersuggestion.pl
Index: C4/Search.pm
===================================================================
RCS file: /sources/koha/koha/C4/Search.pm,v
retrieving revision 1.120.2.32
retrieving revision 1.120.2.33
diff -u -b -r1.120.2.32 -r1.120.2.33
--- C4/Search.pm 28 Nov 2006 15:14:28 -0000 1.120.2.32
+++ C4/Search.pm 30 Nov 2006 17:22:18 -0000 1.120.2.33
@@ -1,7 +1,5 @@
package C4::Search;
-# Copyright 2000-2002 Katipo Communications
-# New functions added 22-09-2005 Tumer Garip tgarip at neu.edu.tr
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
@@ -19,2461 +17,119 @@
use strict;
require Exporter;
-use DBI;
use C4::Context;
-use C4::Reserves2;
-use C4::Biblio;
-use C4::Koha;
-use C4::Record;
-use Date::Calc;
-use MARC::File::XML;
-use MARC::File::USMARC;
-use MARC::Record;
-
-use Lingua::Stem;
-
-# FIXME - C4::Search uses C4::Reserves2, which uses C4::Search.
-# So Perl complains that all of the functions here get redefined.
-#use C4::Date;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.120.2.32 $' =~ /\d+/g;
- shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
-};
-
-=head1 NAME
-
-C4::Search - Functions for searching the Koha catalog and other databases
-
-=head1 SYNOPSIS
-
-see opac/search for example of usage
-
-=head1 DESCRIPTION
-
-This module provides the searching facilities for the Koha bibliographic,
-SQL, and other databases.
-
-=head1 FUNCTIONS
-
-=over 2
-
-=cut
-
- at ISA = qw(Exporter);
- at EXPORT = qw(
- &CatSearch
- &SimpleSearch
- &ItemInfo &KeywordSearch
- &subsearch
- &itemdata &bibdata
- &GetItems &borrdata &itemnodata
- &NewBorrowerNumber &borrissues
- &getboracctrecord &ItemType &itemissues &subject &subtitle
- &addauthor &bibitems &barcodes &findguarantees &allissues
- &findseealso &findguarantor
- &getwebsites &getwebbiblioitems &FindDuplicate
- &isbnsearch &getborrowercategory &getborrowercategoryinfo
- &searchResults &getRecords &buildQuery &catalogsearch
- &getMARCnotes &getMARCsubjects &getMARCurls
-);
-
-# make all your functions, whether exported or not;
-
-=item findseealso($dbh,$fields);
-
-C<$dbh> is a link to the DB handler.
-
-use C4::Context;
-my $dbh =C4::Context->dbh;
-
-C<$fields> is a reference to the fields array
-
-This function modify the @$fields array and add related fields to search on.
-
-=cut
-
-sub findseealso {
- my ( $dbh, $fields ) = @_;
- my $tagslib = MARCgettagslib( $dbh, 1 );
- for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
- my ($tag) = substr( @$fields[$i], 1, 3 );
- my ($subfield) = substr( @$fields[$i], 4, 1 );
- @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
- if ( $tagslib->{$tag}->{$subfield}->{seealso} );
- }
-}
-
-=item findguarantees
-
- ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
- $child0_cardno = $children_arrayref->[0]{"cardnumber"};
- $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
-
-C<&findguarantees> takes a borrower number (e.g., that of a patron
-with children) and looks up the borrowers who are guaranteed by that
-borrower (i.e., the patron's children).
-
-C<&findguarantees> returns two values: an integer giving the number of
-borrowers guaranteed by C<$parent_borrno>, and a reference to an array
-of references to hash, which gives the actual results.
-
-=cut
-
-#'
-sub findguarantees {
- my ($borrowernumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?"
- );
- $sth->execute($borrowernumber);
-
- my @dat;
- while ( my $data = $sth->fetchrow_hashref ) {
- push @dat, $data;
- }
- $sth->finish;
- return ( scalar(@dat), \@dat );
-}
-
-=item findguarantor
-
- $guarantor = &findguarantor($borrower_no);
- $guarantor_cardno = $guarantor->{"cardnumber"};
- $guarantor_surname = $guarantor->{"surname"};
- ...
-
-C<&findguarantor> takes a borrower number (presumably that of a child
-patron), finds the guarantor for C<$borrower_no> (the child's parent),
-and returns the record for the guarantor.
-
-C<&findguarantor> returns a reference-to-hash. Its keys are the fields
-from the C<borrowers> database table;
-
-=cut
-
-#'
-sub findguarantor {
- my ($borrowernumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("select guarantor from borrowers where borrowernumber=?");
- $sth->execute($borrowernumber);
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
- $sth->execute( $data->{'guarantor'} );
- $data = $sth->fetchrow_hashref;
- $sth->finish;
- return ($data);
-}
-
-=item NewBorrowerNumber
-
- $num = &NewBorrowerNumber();
-
-Allocates a new, unused borrower number, and returns it.
-
-=cut
-
-#'
-# FIXME - This is identical to C4::Circulation::Borrower::NewBorrowerNumber.
-# Pick one and stick with it. Preferably use the other one. This function
-# doesn't belong in C4::Search.
-sub NewBorrowerNumber {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("Select max(borrowernumber) from borrowers");
- $sth->execute;
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- $data->{'max(borrowernumber)'}++;
- return ( $data->{'max(borrowernumber)'} );
-}
-
-=item catalogsearch
-
- ($count, @results) = &catalogsearch($env, $type, $search, $num, $offset);
-
-This is primarily a front-end to other, more specialized catalog
-search functions: if C<$search-E<gt>{itemnumber}> or
-C<$search-E<gt>{isbn}> is given, C<&catalogsearch> uses a precise
-C<&CatSearch>. If $search->{subject} is given, it runs a subject
-C<&CatSearch>. If C<$search-E<gt>{keyword}> is given, it runs a
-C<&KeywordSearch>. Otherwise, it runs a loose C<&CatSearch>.
-
-If C<$env-E<gt>{itemcount}> is 1, then C<&catalogsearch> also counts
-the items for each result, and adds several keys:
-
-=over 4
-
-=item C<itemcount>
-
-The total number of copies of this book.
-
-=item C<locationhash>
-
-This is a reference-to-hash; the keys are the names of branches where
-this book may be found, and the values are the number of copies at
-that branch.
-
-=item C<location>
-
-A descriptive string saying where the book is located, and how many
-copies there are, if greater than 1.
-
-=item C<subject2>
-
-The book's subject, with spaces replaced with C<%20>, presumably for
-HTML.
-
-=back
-
-=cut
-
-#'
-sub catalogsearch {
- my (
- $dbh, $tags, $and_or, $excluding, $operator,
- $value, $offset, $length, $orderby, $desc_or_asc
- ) = @_;
-
- # used for the new API
- my ( $search_or_scan, $type, $query, $num, $startfrom, $then_sort_by );
-
- $search_or_scan = 'search';
- $then_sort_by = '';
- my $number_of_results = $length; # num of results to return
- $startfrom = $offset; # offset
- my $ccl_query;
- for ( my $i = 0 ; $i <= $#{$value} ; $i++ ) {
- $ccl_query .= @$value[$i];
- }
- my ( $error, $count, $facets, @results ) =
- searchZOOM( 'search', 'ccl', $ccl_query, $number_of_results, $startfrom,
- $then_sort_by );
-
- my @result = ();
- my $subtitle; # Added by JF for Subtitles
-
- # find biblionumber from results
- #put them in @result
- foreach my $rec (@results) {
- my $record = MARC::Record->new_from_usmarc($rec);
-
- #warn "record :=".$record->as_formatted;
- my $oldbiblio = MARCmarc2koha( $dbh, $record, '' );
- push @result, $oldbiblio->{'biblionumber'};
- }
-
-# we have biblionumber list. Now, loads title and author from [offset] to [offset]+[length]
- my $counter = $offset;
-
-# HINT : biblionumber as bn is important. The hash is fills biblionumber with items.biblionumber.
-# so if you dont' has an item, you get a not nice empty value.
- my $sth = $dbh->prepare(
-"SELECT biblio.biblionumber as bn,biblioitems.*,biblio.*, itemtypes.notforloan,itemtypes.description
- FROM biblio
- LEFT JOIN biblioitems on biblio.biblionumber = biblioitems.biblionumber
- LEFT JOIN itemtypes on itemtypes.itemtype=biblioitems.itemtype
- WHERE biblio.biblionumber = ?"
- );
- my $sth_subtitle =
- $dbh->prepare("SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?")
- ; # Added BY JF for Subtitles
- my @finalresult = ();
- my @CNresults = ();
- my $totalitems = 0;
- my $oldline;
- my $sth_itemCN;
- if ( C4::Context->preference('hidelostitems') ) {
- $sth_itemCN =
- $dbh->prepare(
-"select items.* from items where biblionumber=? and (itemlost = 0 or itemlost is NULL) order by homebranch"
- );
- }
- else {
- $sth_itemCN =
- $dbh->prepare(
- "select items.* from items where biblionumber=? order by homebranch"
- );
- }
- my $sth_issue =
- $dbh->prepare(
- "select date_due,returndate from issues where itemnumber=?");
-
-# parse all biblios between start & end.
-#while (($counter <= $#result) && ($counter <= ($offset + $length))) { #FIXME, do all of them
- while ( $counter <= $#result ) {
-
- # search & parse all items & note itemcallnumber
- #warn $result[$counter];
- $sth->execute( $result[$counter] );
- my $continue = 1;
- my $line = $sth->fetchrow_hashref;
- my $biblionumber = $line->{bn};
-
- # Return subtitles first ADDED BY JF
- $sth_subtitle->execute($biblionumber);
- my $subtitle_here .= $sth_subtitle->fetchrow . " ";
- chop $subtitle_here;
- $subtitle = $subtitle_here;
-
- # warn "Here's the Biblionumber ".$biblionumber;
- # warn "and here's the subtitle: ".$subtitle_here;
-
- # /ADDED BY JF
-
- # $continue=0 unless $line->{bn};
- # my $lastitemnumber;
- $sth_itemCN->execute($biblionumber);
- my @CNresults = ();
- my $notforloan =
- 1; # to see if there is at least 1 item that can be issued
- while ( my $item = $sth_itemCN->fetchrow_hashref ) {
-
- # parse the result, putting holdingbranch & itemcallnumber in separate array
- # then all other fields in the main array
-
- # search if item is on loan
- my $date_due;
- $sth_issue->execute( $item->{itemnumber} );
- while ( my $loan = $sth_issue->fetchrow_hashref ) {
- if ( $loan->{date_due} and !$loan->{returndate} ) {
- $date_due = $loan->{date_due};
- }
- }
-
- # store this item
- my %lineCN;
- $lineCN{holdingbranch} = $item->{holdingbranch};
- $lineCN{itemcallnumber} = $item->{itemcallnumber};
- $lineCN{location} = $item->{location};
- $lineCN{date_due} = $date_due; #format_date($date_due);
- #$lineCN{notforloan} = $notforloanstatus{$line->{notforloan}} if ($line->{notforloan}); # setting not forloan if itemtype is not for loan
- #$lineCN{notforloan} = $notforloanstatus{$item->{notforloan}} if ($item->{notforloan}); # setting not forloan it this item is not for loan
- $notforloan = 0
- unless ( $item->{notforloan}
- or $item->{wthdrawn}
- or $item->{itemlost} );
- push @CNresults, \%lineCN;
- $totalitems++;
- }
-
- # save the biblio in the final array, with item and item issue status
- my %newline;
- %newline = %$line;
- $newline{totitem} = $totalitems;
-
- # if $totalitems == 0, check if it's being ordered.
- if ( $totalitems == 0 ) {
- my $sth =
- $dbh->prepare(
-"select count(*) from aqorders where biblionumber=? and datecancellationprinted is NULL"
- );
- $sth->execute($biblionumber);
- my ($ordered) = $sth->fetchrow;
- $newline{onorder} = 1 if $ordered;
- }
- $newline{biblionumber} = $biblionumber;
- $newline{norequests} = 0;
- $newline{norequests} = 1
- if ( $line->{notforloan} ); # itemtype not issuable
- $newline{norequests} = 1
- if ( !$line->{notforloan} && $notforloan )
- ; # itemtype issuable but all items not issuable for instance
- $newline{subtitle} = $subtitle; # put the subtitle in ADDED BY JF
-
- my @CNresults2 = @CNresults;
- $newline{CN} = \@CNresults2;
- $newline{'even'} = 1 if $#finalresult % 2 == 0;
- $newline{'odd'} = 1 if $#finalresult % 2 == 1;
-
- #$newline{'timestamp'} = format_date($newline{timestamp});
- @CNresults = ();
- push @finalresult, \%newline;
- $totalitems = 0;
- $counter++;
- }
- my $nbresults = $#result + 1;
- return ( \@finalresult, $nbresults );
-}
-
-sub add_html_bold_fields {
- my ( $type, $data, $search ) = @_;
-
- my %reference = (
- 'additionalauthors' => 'author',
- 'publishercode' => 'publisher',
- 'subtitle' => 'title'
- );
-
- foreach my $key (
- 'title', 'author',
- 'additionalauthors', 'publishercode',
- 'publicationyear', 'subject',
- 'subtitle'
- )
- {
- my $new_key;
- if ( $key eq 'additionalauthors' ) {
- $new_key = 'additionalauthors';
- }
- else {
- $new_key = 'bold_' . $key;
- $data->{$new_key} = $data->{$key};
- }
-
- my $key1;
- if ( $reference{$key} ) {
- $key1 = $reference{$key};
- }
- else {
- $key1 = $key;
- }
-
- my @keys;
- my $i = 1;
- if ( $type eq 'keyword' ) {
- my $newkey = $search->{'keyword'};
- $newkey =~ s /\++//g;
- @keys = split " ", $newkey;
- }
- else {
- while ( $search->{"field_value$i"} ) {
- my $newkey = $search->{"field_value$i"};
- $newkey =~ s /\++//g;
- push @keys, $newkey;
- $i++;
- }
- }
- my $count = @keys;
- for ( $i = 0 ; $i < $count ; $i++ ) {
- if ( $key eq 'additionalauthors' ) {
- my $j = 0;
- foreach ( @{ $data->{$new_key} } ) {
- if ( !$data->{$new_key}->[$j]->{'bold_value'} ) {
- $data->{$new_key}->[$j]->{'bold_value'} =
- $data->{$new_key}->[$j]->{'value'};
- }
- if (
- (
- $data->{$new_key}->[$j]->{'value'} =~ /($keys[$i])/i
- )
- && ( lc( $keys[$i] ) ne 'b' )
- )
- {
- my $word = $1;
- $data->{$new_key}->[$j]->{'bold_value'} =~
- s/$word/<b>$word<\/b>/;
- }
- $j++;
- }
- }
- else {
- if ( ( $data->{$new_key} =~ /($keys[$i])/i )
- && ( lc( $keys[$i] ) ne 'b' ) )
- {
- my $word = $1;
- $data->{$new_key} =~ s/$word/<b>$word<\/b>/;
- }
- }
- }
- }
-
-}
-
-sub FindDuplicate {
- my ($record) = @_;
- my $dbh = C4::Context->dbh;
- my $result = MARCmarc2koha( $dbh, $record, '' );
- my $sth;
- my $query;
- my $search;
- my $type;
- my ( $biblionumber, $title );
-
- # search duplicate on ISBN, easy and fast..
- #$search->{'avoidquerylog'}=1;
- if ( $result->{isbn} ) {
- $query = "isbn=$result->{isbn}";
- }
- else {
- $result->{title} =~ s /\\//g;
- $result->{title} =~ s /\"//g;
- $result->{title}=~s /\(//g;
- $result->{title}=~s /\)//g;
- $query = "ti,ext=$result->{title}";
- }
- my ($possible_duplicate_record) =
- C4::Biblio::getRecord( "biblioserver", $query, "usmarc" );
- if ($possible_duplicate_record) {
- my $marcrecord =
- MARC::Record->new_from_usmarc($possible_duplicate_record);
- my $result = MARCmarc2koha( $dbh, $marcrecord, '' );
- return $result->{'biblionumber'}, $result->{'biblionumber'},
- $result->{'title'}
- if $result;
- }
-}
-
-=item KeywordSearch
-
- $search = { "keyword" => "One or more keywords",
- "class" => "VID|CD", # Limit search to fiction and CDs
- "dewey" => "813",
- };
- ($count, @results) = &KeywordSearch($env, $type, $search, $num, $offset);
-
-C<&KeywordSearch> searches the catalog by keyword: given a string
-(C<$search-E<gt>{"keyword"}> consisting of a space-separated list of
-keywords, it looks for books that contain any of those keywords in any
-of a number of places.
-
-C<&KeywordSearch> looks for keywords in the book title (and subtitle),
-series name, notes (both C<biblio.notes> and C<biblioitems.notes>),
-and subjects.
-
-C<$search-E<gt>{"class"}> can be set to a C<|> (pipe)-separated list of
-item class codes (e.g., "F" for fiction, "JNF" for junior nonfiction,
-etc.). In this case, the search will be restricted to just those
-classes.
-
-If C<$search-E<gt>{"class"}> is not specified, you may specify
-C<$search-E<gt>{"dewey"}>. This will restrict the search to that
-particular Dewey Decimal Classification category. Setting
-C<$search-E<gt>{"dewey"}> to "513" will return books about arithmetic,
-whereas setting it to "5" will return all books with Dewey code 5I<xx>
-(Science and Mathematics).
-
-C<$env> and C<$type> are ignored.
-
-C<$offset> and C<$num> specify the subset of results to return.
-C<$num> specifies the number of results to return, and C<$offset> is
-the number of the first result. Thus, setting C<$offset> to 100 and
-C<$num> to 5 will return results 100 through 104 inclusive.
-
-=cut
-
-#'
-sub KeywordSearch {
- my ( $env, $type, $search, $num, $offset ) = @_;
- my $dbh = C4::Context->dbh;
- $search->{'keyword'} =~ s/ +$//;
- my @key = split( ' ', $search->{'keyword'} );
-
- # FIXME - Naive users might enter comma-separated
- # words, e.g., "training, animal". Ought to cope with
- # this.
- my $count = @key;
- my $i = 1;
- my %biblionumbers; # Set of biblionumbers returned by the
- # various searches.
-
- # FIXME - Ought to filter the stopwords out of the list of keywords.
- # @key = map { !defined($stopwords{$_}) } @key;
-
- # FIXME - The way this code is currently set up, it looks for all of
- # the keywords first in (title, notes, seriestitle), then in the
- # subtitle, then in the subject. Thus, if you look for keywords
- # "science fiction", this search won't find a book with
- # title = "How to write fiction"
- # subtitle = "A science-based approach"
- # Is this the desired effect? If not, then the first SQL query
- # should look in the biblio, subtitle, and subject tables all at
- # once. The way the first query is built can accomodate this easily.
-
- # Look for keywords in table 'biblio'.
-
- # Build an SQL query that finds each of the keywords in any of the
- # title, biblio.notes, or seriestitle. To do this, we'll build up an
- # array of clauses, one for each keyword.
- my $query; # The SQL query
- my @clauses = (); # The search clauses
- my @bind = (); # The term bindings
-
- $query = <<EOT; # Beginning of the query
- SELECT biblionumber
- FROM biblio
- WHERE
-EOT
- foreach my $keyword (@key) {
- my @subclauses = (); # Subclauses, one for each field we're
- # searching on
-
- # For each field we're searching on, create a subclause that'll
- # match the current keyword in the current field.
- foreach my $field (qw(title notes seriestitle author)) {
- push @subclauses, "$field LIKE ? OR $field LIKE ?";
- push( @bind, "\Q$keyword\E%", "% \Q$keyword\E%" );
- }
-
- # (Yes, this could have been done as
- # @subclauses = map {...} qw(field1 field2 ...)
- # )but I think this way is more readable.
-
- # Construct the current clause by joining the subclauses.
- push @clauses, "(" . join( ")\n\tOR (", @subclauses ) . ")";
- }
-
- # Now join all of the clauses together and append to the query.
- $query .= "(" . join( ")\nAND (", @clauses ) . ")";
-
- # FIXME - Perhaps use $sth->bind_columns() ? Documented as the most
- # efficient way to fetch data.
- my $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- while ( my @res = $sth->fetchrow_array ) {
- for (@res) {
- $biblionumbers{$_} = 1; # Add these results to the set
- }
- }
- $sth->finish;
-
- # Now look for keywords in the 'bibliosubtitle' table.
-
- # Again, we build a list of clauses from the keywords.
- @clauses = ();
- @bind = ();
- $query = "SELECT biblionumber FROM bibliosubtitle WHERE ";
- foreach my $keyword (@key) {
- push @clauses, "subtitle LIKE ? OR subtitle like ?";
- push( @bind, "\Q$keyword\E%", "% \Q$keyword\E%" );
- }
- $query .= "(" . join( ") AND (", @clauses ) . ")";
-
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- while ( my @res = $sth->fetchrow_array ) {
- for (@res) {
- $biblionumbers{$_} = 1; # Add these results to the set
- }
- }
- $sth->finish;
-
- # Look for the keywords in the notes for individual items
- # ('biblioitems.notes')
-
- # Again, we build a list of clauses from the keywords.
- @clauses = ();
- @bind = ();
- $query = "SELECT biblionumber FROM biblioitems WHERE ";
- foreach my $keyword (@key) {
- push @clauses, "notes LIKE ? OR notes like ?";
- push( @bind, "\Q$keyword\E%", "% \Q$keyword\E%" );
- }
- $query .= "(" . join( ") AND (", @clauses ) . ")";
-
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- while ( my @res = $sth->fetchrow_array ) {
- for (@res) {
- $biblionumbers{$_} = 1; # Add these results to the set
- }
- }
- $sth->finish;
-
- # Look for keywords in the 'bibliosubject' table.
-
- # FIXME - The other queries look for words in the desired field that
- # begin with the individual keywords the user entered. This one
- # searches for the literal string the user entered. Is this the
- # desired effect?
- # Note in particular that spaces are retained: if the user typed
- # science fiction
- # (with two spaces), this won't find the subject "science fiction"
- # (one space). Likewise, a search for "%" will return absolutely
- # everything.
- # If this isn't the desired effect, see the previous searches for
- # how to do it.
-
- $sth = $dbh->prepare(
- "Select biblionumber from bibliosubject where subject
- like ? group by biblionumber"
- );
- $sth->execute("%$search->{'keyword'}%");
-
- while ( my @res = $sth->fetchrow_array ) {
- for (@res) {
- $biblionumbers{$_} = 1; # Add these results to the set
- }
- }
- $sth->finish;
-
- my $i2 = 0;
- my $i3 = 0;
- my $i4 = 0;
-
- my @res2;
- my @res = keys %biblionumbers;
- $count = @res;
-
- $i = 0;
-
- # print "count $count";
- if ( $search->{'class'} ne '' ) {
- while ( $i2 < $count ) {
- my $query = "select * from biblio,biblioitems where
- biblio.biblionumber=? and
- biblio.biblionumber=biblioitems.biblionumber ";
- my @bind = ( $res[$i2] );
- if ( $search->{'class'} ne '' ) { # FIXME - Redundant
- my @temp = split( /\|/, $search->{'class'} );
- my $count = @temp;
- $query .= "and ( itemtype=?";
- push( @bind, $temp[0] );
- for ( my $i = 1 ; $i < $count ; $i++ ) {
- $query .= " or itemtype=?";
- push( @bind, $temp[$i] );
- }
- $query .= ")";
- }
- my $sth = $dbh->prepare($query);
-
- # print $query;
- $sth->execute(@bind);
- if ( my $data2 = $sth->fetchrow_hashref ) {
- my $dewey = $data2->{'dewey'};
- my $subclass = $data2->{'subclass'};
-
- # FIXME - This next bit is bogus, because it assumes that the
- # Dewey code is a floating-point number. It isn't. It's
- # actually a string that mainly consists of numbers. In
- # particular, "4" is not a valid Dewey code, although "004"
- # is ("Data processing; Computer science"). Likewise, zeros
- # after the decimal are significant ("575" is not the same as
- # "575.0"; the latter is more specific). And "000" is a
- # perfectly good Dewey code ("General works; computer
- # science") and should not be interpreted to mean "this
- # database entry does not have a Dewey code". That's what
- # NULL is for.
- $dewey =~ s/\.*0*$//;
- ( $dewey == 0 ) && ( $dewey = '' );
- ($dewey) && ( $dewey .= " $subclass" );
- $sth->finish;
- my $end = $offset + $num;
- if ( $i4 <= $offset ) {
- $i4++;
- }
-
- # print $i4;
- if ( $i4 <= $end && $i4 > $offset ) {
- $data2->{'dewey'} = $dewey;
- $res2[$i3] = $data2;
-
-# $res2[$i3]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
- $i3++;
- $i4++;
-
- # print "in here $i3<br>";
- }
- else {
-
- # print $end;
- }
- $i++;
- }
- $i2++;
- }
- $count = $i;
-
- }
- else {
-
- # $search->{'class'} was not specified
-
- # FIXME - This is bogus: it makes a separate query for each
- # biblioitem, and returns results in apparently random order. It'd
- # be much better to combine all of the previous queries into one big
- # one (building it up a little at a time, of course), and have that
- # big query select all of the desired fields, instead of just
- # 'biblionumber'.
-
- while ( $i2 < $num && $i2 < $count ) {
- my $query = "select * from biblio,biblioitems where
- biblio.biblionumber=? and
- biblio.biblionumber=biblioitems.biblionumber ";
- my @bind = ( $res[ $i2 + $offset ] );
-
- if ( $search->{'dewey'} ne '' ) {
- $query .= "and (dewey like ?)";
- push( @bind, "$search->{'dewey'}%" );
- }
-
- my $sth = $dbh->prepare($query);
-
- # print $query;
- $sth->execute(@bind);
- if ( my $data2 = $sth->fetchrow_hashref ) {
- my $dewey = $data2->{'dewey'};
- my $subclass = $data2->{'subclass'};
- $dewey =~ s/\.*0*$//;
- ( $dewey == 0 ) && ( $dewey = '' );
- ($dewey) && ( $dewey .= " $subclass" );
- $sth->finish;
- $data2->{'dewey'} = $dewey;
-
- $res2[$i] = $data2;
-
-# $res2[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey";
- $i++;
- }
- $i2++;
-
- }
- }
-
- #$count=$i;
- return ( $count, @res2 );
-}
-
-=item CatSearch
-
- ($count, @results) = &CatSearch($env, $type, $search, $num, $offset);
-
-C<&CatSearch> searches the Koha catalog. It returns a list whose first
-element is the number of returned results, and whose subsequent
-elements are the results themselves.
-
-Each returned element is a reference-to-hash. Most of the keys are
-simply the fields from the C<biblio> table in the Koha database, but
-the following keys may also be present:
-
-=over 4
-
-=item C<illustrator>
-
-The book's illustrator.
-
-=item C<publisher>
-
-The publisher.
-
-=back
-
-C<$env> is ignored.
-
-C<$type> may be C<subject>, C<loose>, or C<precise>. This controls the
-high-level behavior of C<&CatSearch>, as described below.
-
-In many cases, the description below says that a certain field in the
-database must match the search string. In these cases, it means that
-the beginning of some word in the field must match the search string.
-Thus, an author search for "sm" will return books whose author is
-"John Smith" or "Mike Smalls", but not "Paul Grossman", since the "sm"
-does not occur at the beginning of a word.
-
-Note that within each search mode, the criteria are and-ed together.
-That is, if you perform a loose search on the author "Jerome" and the
-title "Boat", the search will only return books by Jerome containing
-"Boat" in the title.
-
-It is not possible to cross modes, e.g., set the author to "Asimov"
-and the subject to "Math" in hopes of finding books on math by Asimov.
-
-=head2 Loose search
-
-If C<$type> is set to C<loose>, the following search criteria may be
-used:
-
-=over 4
-
-=item C<$search-E<gt>{author}>
-
-The search string is a space-separated list of words. Each word must
-match either the C<author> or C<additionalauthors> field.
-
-=item C<$search-E<gt>{title}>
-
-Each word in the search string must match the book title. If no author
-is specified, the book subtitle will also be searched.
-
-=item C<$search-E<gt>{abstract}>
-
-Searches for the given search string in the book's abstract.
-
-=item C<$search-E<gt>{'date-before'}>
-
-Searches for books whose copyright date matches the search string.
-That is, setting C<$search-E<gt>{'date-before'}> to "1985" will find
-books written in 1985, and setting it to "198" will find books written
-between 1980 and 1989.
-
-=item C<$search-E<gt>{title}>
-
-Searches by title are also affected by the value of
-C<$search-E<gt>{"ttype"}>; if it is set to C<exact>, then the book
-title, (one of) the series titleZ<>(s), or (one of) the unititleZ<>(s) must
-match the search string exactly (the subtitle is not searched).
-
-If C<$search-E<gt>{"ttype"}> is set to anything other than C<exact>,
-each word in the search string must match the title, subtitle,
-unititle, or series title.
-
-=item C<$search-E<gt>{class}>
-
-Restricts the search to certain item classes. The value of
-C<$search-E<gt>{"class"}> is a | (pipe)-separated list of item types.
-Thus, setting it to "F" restricts the search to fiction, and setting
-it to "CD|CAS" will only look in compact disks and cassettes.
-
-=item C<$search-E<gt>{dewey}>
-
-Searches for books whose Dewey Decimal Classification code matches the
-search string. That is, setting C<$search-E<gt>{"dewey"}> to "5" will
-search for all books in 5I<xx> (Science and mathematics), setting it
-to "54" will search for all books in 54I<x> (Chemistry), and setting
-it to "546" will search for books on inorganic chemistry.
-
-=item C<$search-E<gt>{publisher}>
-
-Searches for books whose publisher contains the search string (unlike
-other search criteria, C<$search-E<gt>{publisher}> is a string, not a
-set of words.
-
-=back
-
-=head2 Subject search
-
-If C<$type> is set to C<subject>, the following search criterion may
-be used:
-
-=over 4
-
-=item C<$search-E<gt>{subject}>
-
-The search string is a space-separated list of words, each of which
-must match the book's subject.
-
-Special case: if C<$search-E<gt>{subject}> is set to C<nz>,
-C<&CatSearch> will search for books whose subject is "New Zealand".
-However, setting C<$search-E<gt>{subject}> to C<"nz football"> will
-search for books on "nz" and "football", not books on "New Zealand"
-and "football".
-
-=back
-
-=head2 Precise search
-
-If C<$type> is set to C<precise>, the following search criteria may be
-used:
-
-=over 4
-
-=item C<$search-E<gt>{item}>
-
-Searches for books whose barcode exactly matches the search string.
-
-=item C<$search-E<gt>{isbn}>
-
-Searches for books whose ISBN exactly matches the search string.
-
-=back
-
-For a loose search, if an author was specified, the results are
-ordered by author and title. If no author was specified, the results
-are ordered by title.
-
-For other (non-loose) searches, if a subject was specified, the
-results are ordered alphabetically by subject.
-
-In all other cases (e.g., loose search by keyword), the results are
-not ordered.
-
-=cut
-
-#'
-sub CatSearch {
- my ( $env, $type, $search, $num, $offset ) = @_;
- my $dbh = C4::Context->dbh;
- my $query = '';
- my @bind = ();
- my @results;
-
- my $title = lc( $search->{'title'} );
-
- if ( $type eq 'loose' ) {
- if ( $search->{'author'} ne '' ) {
- my @key = split( ' ', $search->{'author'} );
- my $count = @key;
- my $i = 1;
- $query = "select *,biblio.author,biblio.biblionumber from
- biblio
- left join additionalauthors
- on (additionalauthors.biblionumber =biblio.biblionumber)
- where
- ((biblio.author like ? or biblio.author like ? or
- additionalauthors.author like ? or additionalauthors.author
- like ?
- )";
- @bind = ( "$key[0]%", "% $key[0]%", "$key[0]%", "% $key[0]%" );
- while ( $i < $count ) {
- $query .= " and (
- biblio.author like ? or biblio.author like ? or
- additionalauthors.author like ? or additionalauthors.author like ?
- )";
- push( @bind,
- "$key[$i]%", "% $key[$i]%", "$key[$i]%", "% $key[$i]%" );
- $i++;
- }
- $query .= ")";
- if ( $search->{'title'} ne '' ) {
- my @key = split( ' ', $search->{'title'} );
- my $count = @key;
- my $i = 0;
- $query .= " and (((title like ? or title like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- while ( $i < $count ) {
- $query .= " and (title like ? or title like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- $i++;
- }
- $query .= ") or ((seriestitle like ? or seriestitle like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- for ( $i = 1 ; $i < $count ; $i++ ) {
- $query .= " and (seriestitle like ? or seriestitle like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- }
- $query .= ") or ((unititle like ? or unititle like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- for ( $i = 1 ; $i < $count ; $i++ ) {
- $query .= " and (unititle like ? or unititle like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- }
- $query .= "))";
- }
- if ( $search->{'abstract'} ne '' ) {
- $query .= " and (abstract like ?)";
- push( @bind, "%$search->{'abstract'}%" );
- }
- if ( $search->{'date-before'} ne '' ) {
- $query .= " and (copyrightdate like ?)";
- push( @bind, "%$search->{'date-before'}%" );
- }
- $query .= " group by biblio.biblionumber";
- }
- else {
- if ( $search->{'title'} ne '' ) {
- if ( $search->{'ttype'} eq 'exact' ) {
- $query = "select * from biblio
- where
- (biblio.title=? or (biblio.unititle = ?
- or biblio.unititle like ? or
- biblio.unititle like ? or
- biblio.unititle like ?) or
- (biblio.seriestitle = ? or
- biblio.seriestitle like ? or
- biblio.seriestitle like ? or
- biblio.seriestitle like ?)
- )";
- @bind = (
- $search->{'title'},
- $search->{'title'},
- "$search->{'title'} |%",
- "%| $search->{'title'} |%",
- "%| $search->{'title'}",
- $search->{'title'},
- "$search->{'title'} |%",
- "%| $search->{'title'} |%",
- "%| $search->{'title'}"
- );
- }
- else {
- my @key = split( ' ', $search->{'title'} );
- my $count = @key;
- my $i = 1;
- $query =
-"select biblio.biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp,subtitle from biblio
- left join bibliosubtitle on
- (biblio.biblionumber=bibliosubtitle.biblionumber)
- where
- (((title like ? or title like ?)";
- @bind = ( "$key[0]%", "% $key[0]%" );
- while ( $i < $count ) {
- $query .= " and (title like ? or title like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- $i++;
- }
- $query .= ") or ((subtitle like ? or subtitle like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- for ( $i = 1 ; $i < $count ; $i++ ) {
- $query .= " and (subtitle like ? or subtitle like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- }
- $query .=
- ") or ((seriestitle like ? or seriestitle like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- for ( $i = 1 ; $i < $count ; $i++ ) {
- $query .=
- " and (seriestitle like ? or seriestitle like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- }
- $query .= ") or ((unititle like ? or unititle like ?)";
- push( @bind, "$key[0]%", "% $key[0]%" );
- for ( $i = 1 ; $i < $count ; $i++ ) {
- $query .= " and (unititle like ? or unititle like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%" );
- }
- $query .= "))";
- }
- if ( $search->{'abstract'} ne '' ) {
- $query .= " and (abstract like ?)";
- push( @bind, "%$search->{'abstract'}%" );
- }
- if ( $search->{'date-before'} ne '' ) {
- $query .= " and (copyrightdate like ?)";
- push( @bind, "%$search->{'date-before'}%" );
- }
-
- }
- elsif ( $search->{'dewey'} ne '' ) {
- $query = "select * from biblioitems,biblio
- where biblio.biblionumber=biblioitems.biblionumber
- and biblioitems.dewey like ?";
- @bind = ("$search->{'dewey'}%");
- }
- elsif ( $search->{'illustrator'} ne '' ) {
- $query = "select * from biblioitems,biblio
- where biblio.biblionumber=biblioitems.biblionumber
- and biblioitems.illus like ?";
- @bind = ( "%" . $search->{'illustrator'} . "%" );
- }
- elsif ( $search->{'publisher'} ne '' ) {
- $query =
- "Select * from biblio,biblioitems where biblio.biblionumber
- =biblioitems.biblionumber and (publishercode like ?)";
- @bind = ("%$search->{'publisher'}%");
- }
- elsif ( $search->{'abstract'} ne '' ) {
- $query = "Select * from biblio where abstract like ?";
- @bind = ("%$search->{'abstract'}%");
- }
- elsif ( $search->{'date-before'} ne '' ) {
- $query = "Select * from biblio where copyrightdate like ?";
- @bind = ("%$search->{'date-before'}%");
- }
- elsif ( $search->{'branch'} ne '' ) {
- $query = "Select * from biblio,items where biblio.biblionumber
- =items.biblionumber and holdingbranch like ?";
- @bind = ("$search->{'branch'}");
- }
- elsif ( $search->{'class'} ne '' ) {
- $query =
-"select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber";
-
- $query .= " where itemtype= ?";
- @bind = ("$search->{'class'}");
- }
- $query .= " group by biblio.biblionumber";
- }
- }
- if ( $type eq 'subject' ) {
- my @key = split( ' ', $search->{'subject'} );
- my $count = @key;
- my $i = 1;
- $query = "select * from bibliosubject, biblioitems where
-(bibliosubject.biblionumber = biblioitems.biblionumber) and ( subject like ? or subject like ? or subject like ?)";
- @bind = ( "$key[0]%", "% $key[0]%", "%($key[0])%" );
- while ( $i < $count ) {
- $query .=
- " and (subject like ? or subject like ? or subject like ?)";
- push( @bind, "$key[$i]%", "% $key[$i]%", "%($key[$i])%" );
- $i++;
- }
-
- # FIXME - Wouldn't it be better to fix the database so that if a
- # book has a subject "NZ", then it also gets added the subject
- # "New Zealand"?
- # This can also be generalized by adding a table of subject
- # synonyms to the database: just declare "NZ" to be a synonym for
- # "New Zealand", "SF" a synonym for both "Science fiction" and
- # "Fantastic fiction", etc.
-
- if ( lc( $search->{'subject'} ) eq 'nz' ) {
- $query .=
-" or (subject like 'NEW ZEALAND %' or subject like '% NEW ZEALAND %'
- or subject like '% NEW ZEALAND' or subject like '%(NEW ZEALAND)%' ) ";
- }
- elsif ($search->{'subject'} =~ /^nz /i
- || $search->{'subject'} =~ / nz /i
- || $search->{'subject'} =~ / nz$/i )
- {
- $query =~ s/ nz/ NEW ZEALAND/ig;
- $query =~ s/nz /NEW ZEALAND /ig;
- $query =~ s/\(nz\)/\(NEW ZEALAND\)/gi;
- }
- }
- if ( $type eq 'precise' ) {
- if ( $search->{'itemnumber'} ne '' ) {
- $query = "select * from items,biblio ";
- my $search2 = uc $search->{'itemnumber'};
- $query = $query . " where
- items.biblionumber=biblio.biblionumber
- and barcode=?";
- @bind = ($search2);
-
- # FIXME - .= <<EOT;
- }
- if ( $search->{'isbn'} ne '' ) {
- $query = "Select * from biblio,biblioitems where biblio.biblionumber
- =biblioitems.biblionumber and (isbn like ?)";
- @bind = ("$search->{'isbn'}%");
- }
- }
- if ( $type ne 'precise' && $type ne 'subject' ) {
- if ( $search->{'author'} ne '' ) {
- $query .= " order by biblio.author,title";
- }
- else {
- $query .= " order by title";
- }
- }
- else {
- if ( $type eq 'subject' ) {
- $query .= " group by subject ";
- }
- }
- my $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- my $count = 1;
- my $i = 0;
- my $limit = $num + $offset;
- while ( my $data = $sth->fetchrow_hashref ) {
- my $query =
-"select classification,dewey,subclass,publishercode from biblioitems where biblionumber=?";
- my @bind = ( $data->{'biblionumber'} );
- if ( $search->{'class'} ne '' ) {
- my @temp = split( /\|/, $search->{'class'} );
- my $count = @temp;
- $query .= " and ( itemtype= ?";
- push( @bind, $temp[0] );
- for ( my $i = 1 ; $i < $count ; $i++ ) {
- $query .= " or itemtype=?";
- push( @bind, $temp[$i] );
- }
- $query .= ")";
- }
- if ( $search->{'dewey'} ne '' ) {
- $query .= " and dewey=? ";
- push( @bind, $search->{'dewey'} );
- }
- if ( $search->{'illustrator'} ne '' ) {
- $query .= " and illus like ?";
- push( @bind, "%$search->{'illustrator'}%" );
- }
- if ( $search->{'publisher'} ne '' ) {
- $query .= " and (publishercode like ?)";
- push( @bind, "%$search->{'publisher'}%" );
- }
- my $sti = $dbh->prepare($query);
- $sti->execute(@bind);
- my $classification;
- my $dewey;
- my $subclass;
- my $true = 0;
- my $publishercode;
- my $bibitemdata;
-
- if ( $bibitemdata = $sti->fetchrow_hashref() ) {
- $true = 1;
- $classification = $bibitemdata->{'classification'};
- $dewey = $bibitemdata->{'dewey'};
- $subclass = $bibitemdata->{'subclass'};
- $publishercode = $bibitemdata->{'publishercode'};
- }
-
- # print STDERR "$dewey $subclass $publishercode\n";
- # FIXME - The Dewey code is a string, not a number.
- $dewey =~ s/\.*0*$//;
- ( $dewey == 0 ) && ( $dewey = '' );
- ($dewey) && ( $dewey .= " $subclass" );
- $data->{'classification'} = $classification;
- $data->{'dewey'} = $dewey;
- $data->{'publishercode'} = $publishercode;
- $sti->finish;
-
- if ( $true == 1 ) {
- if ( $count > $offset && $count <= $limit ) {
- $results[$i] = $data;
- $i++;
- }
- $count++;
- }
- }
- $sth->finish;
- $count--;
- return ( $count, @results );
-}
-
-=item ItemInfo
-
- @results = &ItemInfo($env, $biblionumber, $type);
-
-Returns information about books with the given biblionumber.
-
-C<$type> may be either C<intra> or anything else. If it is not set to
-C<intra>, then the search will exclude lost, very overdue, and
-withdrawn items.
-
-C<$env> is ignored.
-
-C<&ItemInfo> returns a list of references-to-hash. Each element
-contains a number of keys. Most of them are table items from the
-C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
-Koha database. Other keys include:
-
-=over 4
-
-=item C<$data-E<gt>{branchname}>
-
-The name (not the code) of the branch to which the book belongs.
-
-=item C<$data-E<gt>{datelastseen}>
-
-This is simply C<items.datelastseen>, except that while the date is
-stored in YYYY-MM-DD format in the database, here it is converted to
-DD/MM/YYYY format. A NULL date is returned as C<//>.
-
-=item C<$data-E<gt>{datedue}>
-
-=item C<$data-E<gt>{class}>
-
-This is the concatenation of C<biblioitems.classification>, the book's
-Dewey code, and C<biblioitems.subclass>.
-
-=item C<$data-E<gt>{ocount}>
-
-I think this is the number of copies of the book available.
-
-=item C<$data-E<gt>{order}>
-
-If this is set, it is set to C<One Order>.
-
-=back
-
-=cut
-
-#'
-sub ItemInfo {
- my ( $env, $biblionumber, $type ) = @_;
- my $dbh = C4::Context->dbh;
- my $query =
-"SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
- left join itemtypes on (biblioitems.itemtype = itemtypes.itemtype)
- WHERE items.biblionumber = ?
- AND biblioitems.biblioitemnumber = items.biblioitemnumber
- AND biblio.biblionumber = items.biblionumber";
- $query .= " order by items.dateaccessioned desc";
- my $sth = $dbh->prepare($query);
- $sth->execute($biblionumber);
- my $i = 0;
- my @results;
- my ( $date_due, $count_reserves );
-
- while ( my $data = $sth->fetchrow_hashref ) {
- my $datedue = '';
- my $isth =
- $dbh->prepare(
-"Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber"
- );
- $isth->execute( $data->{'itemnumber'} );
- if ( my $idata = $isth->fetchrow_hashref ) {
- $data->{borrowernumber} = $idata->{borrowernumber};
- $data->{cardnumber} = $idata->{cardnumber};
- $datedue = $idata->{'date_due'}; #format_date($idata->{'date_due'});
- }
- if ( $datedue eq '' ) {
-
- # $datedue="Available";
- my ( $restype, $reserves ) =
- C4::Reserves2::CheckReserves( $data->{'itemnumber'} );
- if ($restype) {
-
- # $datedue=$restype;
- $count_reserves = $restype;
- }
- }
- $isth->finish;
-
- #get branch information.....
- my $bsth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
- $bsth->execute( $data->{'holdingbranch'} );
- if ( my $bdata = $bsth->fetchrow_hashref ) {
- $data->{'branchname'} = $bdata->{'branchname'};
- }
- my $date =
- $data->{'datelastseen'}; #format_date($data->{'datelastseen'});
- $data->{'datelastseen'} = $date;
- $data->{'datedue'} = $datedue;
- $data->{'count_reserves'} = $count_reserves;
-
- # get notforloan complete status if applicable
- my $sthnflstatus =
- $dbh->prepare(
-'select authorised_value from marc_subfield_structure where kohafield="items.notforloan"'
- );
- $sthnflstatus->execute;
- my ($authorised_valuecode) = $sthnflstatus->fetchrow;
- if ($authorised_valuecode) {
- $sthnflstatus =
- $dbh->prepare(
-"select lib from authorised_values where category=? and authorised_value=?"
- );
- $sthnflstatus->execute( $authorised_valuecode,
- $data->{itemnotforloan} );
- my ($lib) = $sthnflstatus->fetchrow;
- $data->{notforloan} = $lib;
- }
-
- # my stack procedures
-
- my $stackstatus =
- $dbh->prepare(
-'select authorised_value from marc_subfield_structure where kohafield="items.stack"'
- );
- $stackstatus->execute;
-
- ($authorised_valuecode) = $stackstatus->fetchrow;
- if ($authorised_valuecode) {
- $stackstatus =
- $dbh->prepare(
-"select lib from authorised_values where category=? and authorised_value=?"
- );
- $stackstatus->execute( $authorised_valuecode, $data->{stack} );
-
- my ($lib) = $stackstatus->fetchrow;
- $data->{stack} = $lib;
- }
- $results[$i] = $data;
- $i++;
- }
- $sth->finish;
-
- return (@results);
-}
-
-=item GetItems
-
- @results = &GetItems($env, $biblionumber);
-
-Returns information about books with the given biblionumber.
-
-C<$env> is ignored.
-
-C<&GetItems> returns an array of strings. Each element is a
-tab-separated list of values: biblioitemnumber, itemtype,
-classification, Dewey number, subclass, ISBN, volume, number, and
-itemdata.
-
-Itemdata, in turn, is a string of the form
-"I<barcode>C<[>I<holdingbranch>C<[>I<flags>" where I<flags> contains
-the string C<NFL> if the item is not for loan, and C<LOST> if the item
-is lost.
-
-=cut
-
-#'
-sub GetItems {
- my ( $env, $biblionumber ) = @_;
-
- #debug_msg($env,"GetItems");
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("Select * from biblioitems where (biblionumber = ?)");
- $sth->execute($biblionumber);
-
- #debug_msg($env,"executed query");
- my $i = 0;
- my @results;
- while ( my $data = $sth->fetchrow_hashref ) {
- print( $env, $data->{'biblioitemnumber'} );
- my $dewey = $data->{'dewey'};
- $dewey =~ s/0+$//;
- my $isbn = $data->{'isbn'};
-
- my $line = $data->{'biblioitemnumber'} . "\t" . $data->{'itemtype'};
- $line .= "\t$data->{'classification'}\t$dewey";
- $line .= "\t$data->{'subclass'}\t$data->{'isbn'}";
- $line .= "\t$data->{'volume'}\t$data->{number}";
- my $isth =
- $dbh->prepare("select * from items where biblioitemnumber = ?");
- $isth->execute( $data->{'biblioitemnumber'} );
- while ( my $idata = $isth->fetchrow_hashref ) {
- my $iline =
- $idata->{'barcode'} . "[" . $idata->{'holdingbranch'} . "[";
- if ( $idata->{'notforloan'} == 1 ) {
- $iline .= "NFL ";
- }
- if ( $idata->{'itemlost'} == 1 ) {
- $iline .= "LOST ";
- }
- $line .= "\t$iline";
- }
- $isth->finish;
- $results[$i] = $line;
- $i++;
- }
- $sth->finish;
- return (@results);
-}
-
-=item itemdata
-
- $item = &itemdata($barcode);
-
-Looks up the item with the given barcode, and returns a
-reference-to-hash containing information about that item. The keys of
-the hash are the fields from the C<items> and C<biblioitems> tables in
-the Koha database.
-
-=cut
-
-#'
-sub itemdata {
- my ($barcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from items,biblioitems where barcode=?
- and items.biblioitemnumber=biblioitems.biblioitemnumber"
- );
- $sth->execute($barcode);
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- return ($data);
-}
-
-=item bibdata
+use C4::Biblio; # MARCfind_marc_from_kohafield
+use C4::Koha; # getFacets
+use Lingua::Stem;
- $data = &bibdata($biblionumber, $type);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-Returns information about the book with the given biblionumber.
+# set the version for version checking
+$VERSION = do { my @v = '$Revision: 1.120.2.33 $' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
-C<$type> is ignored.
+=head1 NAME
-C<&bibdata> returns a reference-to-hash. The keys are the fields in
-the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
-Koha database.
+C4::Search - Functions for searching the Koha catalog.
-In addition, C<$data-E<gt>{subject}> is the list of the book's
-subjects, separated by C<" , "> (space, comma, space).
+=head1 SYNOPSIS
-If there are multiple biblioitems with the given biblionumber, only
-the first one is considered.
+see opac/opac-search.pl or catalogue/search.pl for example of usage
-=cut
+=head1 DESCRIPTION
-#'
-sub bibdata {
- my ( $bibnum, $type ) = @_;
- my $dbh = C4::Context->dbh;
+This module provides the searching facilities for the Koha into a zebra catalog.
- my $query = "
- SELECT * , biblioitems.notes AS bnotes, biblio.notes
- FROM biblio
- LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
- LEFT JOIN bibliosubtitle ON biblio.biblionumber = bibliosubtitle.biblionumber
- LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
- WHERE biblio.biblionumber = ?
- AND biblioitems.biblionumber = biblio.biblionumber
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute($bibnum);
- my $data;
- $data = $sth->fetchrow_hashref;
- $sth->finish;
-
- # handle management of repeated subtitle
- $sth = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
- $sth->execute($bibnum);
- my @subtitles;
- while ( my $dat = $sth->fetchrow_hashref ) {
- my %line;
- $line{subtitle} = $dat->{subtitle};
- push @subtitles, \%line;
- } # while
- $data->{subtitles} = \@subtitles;
- $sth->finish;
- $sth = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
- $sth->execute($bibnum);
- my @subjects;
- while ( my $dat = $sth->fetchrow_hashref ) {
- my %line;
- $line{subject} = $dat->{'subject'};
- push @subjects, \%line;
- } # while
- $data->{subjects} = \@subjects;
- $sth->finish;
- $sth =
- $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
- $sth->execute($bibnum);
- while ( my $dat = $sth->fetchrow_hashref ) {
- $data->{'additionalauthors'} .= "$dat->{'author'} - ";
- } # while
- chop $data->{'additionalauthors'};
- chop $data->{'additionalauthors'};
- chop $data->{'additionalauthors'};
- $sth->finish;
- return ($data);
-} # sub bibdata
-
-=item subject
-
- ($count, $subjects) = &subject($biblionumber);
-
-Looks up the subjects of the book with the given biblionumber. Returns
-a two-element list. C<$subjects> is a reference-to-array, where each
-element is a subject of the book, and C<$count> is the number of
-elements in C<$subjects>.
+=head1 FUNCTIONS
=cut
-#'
-sub subject {
- my ($bibnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("Select * from bibliosubject where biblionumber=?");
- $sth->execute($bibnum);
- my @results;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$i] = $data;
- $i++;
- }
- $sth->finish;
- return ( $i, \@results );
-}
-
-=item addauthor
-
- ($count, $authors) = &addauthors($biblionumber);
-
-Looks up the additional authors for the book with the given
-biblionumber.
-
-Returns a two-element list. C<$authors> is a reference-to-array, where
-each element is an additional author, and C<$count> is the number of
-elements in C<$authors>.
+ at ISA = qw(Exporter);
+ at EXPORT = qw(
+ &SimpleSearch
+ &findseealso
+ &FindDuplicate
+ &searchResults
+ &getRecords
+ &buildQuery
+);
-=cut
+# make all your functions, whether exported or not;
-#'
-sub addauthor {
- my ($bibnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("Select * from additionalauthors where biblionumber=?");
- $sth->execute($bibnum);
- my @results;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$i] = $data;
- $i++;
- }
- $sth->finish;
- return ( $i, \@results );
-}
+=head2 findseealso($dbh,$fields);
-=item subtitle
+C<$dbh> is a link to the DB handler.
- ($count, $subtitles) = &subtitle($biblionumber);
+use C4::Context;
+my $dbh =C4::Context->dbh;
-Looks up the subtitles for the book with the given biblionumber.
+C<$fields> is a reference to the fields array
-Returns a two-element list. C<$subtitles> is a reference-to-array,
-where each element is a subtitle, and C<$count> is the number of
-elements in C<$subtitles>.
+This function modify the @$fields array and add related fields to search on.
=cut
-#'
-sub subtitle {
- my ($bibnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
- $sth->execute($bibnum);
- my @results;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$i] = $data;
- $i++;
+sub findseealso {
+ my ( $dbh, $fields ) = @_;
+ my $tagslib = MARCgettagslib( $dbh, 1 );
+ for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
+ my ($tag) = substr( @$fields[$i], 1, 3 );
+ my ($subfield) = substr( @$fields[$i], 4, 1 );
+ @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
+ if ( $tagslib->{$tag}->{$subfield}->{seealso} );
}
- $sth->finish;
- return ( $i, \@results );
}
-=item itemissues
-
- @issues = &itemissues($biblioitemnumber, $biblio);
-
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblioitemnumber.
-
-C<$biblio> is ignored.
-
-C<&itemissues> returns an array of references-to-hash. The keys
-include the fields from the C<items> table in the Koha database.
-Additional keys include:
-
-=over 4
-
-=item C<date_due>
-
-If the item is currently on loan, this gives the due date.
-
-If the item is not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
-
-=item C<card>
-
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
-
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
-
-These give the timestamp for the last three times the item was
-borrowed.
-
-=item C<card0>, C<card1>, C<card2>
-
-The card number of the last three patrons who borrowed this item.
-
-=item C<borrower0>, C<borrower1>, C<borrower2>
-
-The borrower number of the last three patrons who borrowed this item.
+=head2 FindDuplicate
-=back
+($biblionumber,$biblionumber,$title) = FindDuplicate($record);
=cut
-#'
-sub itemissues {
- my ( $bibitem, $biblio ) = @_;
+# FIXME :: why 2 $biblionumber ?
+sub FindDuplicate {
+ my ($record) = @_;
my $dbh = C4::Context->dbh;
+ my $result = MARCmarc2koha( $dbh, $record, '' );
+ my $sth;
+ my $query;
+ my $search;
+ my $type;
+ my ( $biblionumber, $title );
- # FIXME - If this function die()s, the script will abort, and the
- # user won't get anything; depending on how far the script has
- # gotten, the user might get a blank page. It would be much better
- # to at least print an error message. The easiest way to do this
- # is to set $SIG{__DIE__}.
- my $sth =
- $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
- || die $dbh->errstr;
- my $i = 0;
- my @results;
-
- $sth->execute($bibitem) || die $sth->errstr;
-
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # Find out who currently has this item.
- # FIXME - Wouldn't it be better to do this as a left join of
- # some sort? Currently, this code assumes that if
- # fetchrow_hashref() fails, then the book is on the shelf.
- # fetchrow_hashref() can fail for any number of reasons (e.g.,
- # database server crash), not just because no items match the
- # search criteria.
- my $sth2 = $dbh->prepare(
- "select * from issues,borrowers
-where itemnumber = ?
-and returndate is NULL
-and issues.borrowernumber = borrowers.borrowernumber"
- );
-
- $sth2->execute( $data->{'itemnumber'} );
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{'date_due'} = $data2->{'date_due'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- }
- else {
- if ( $data->{'wthdrawn'} eq '1' ) {
- $data->{'date_due'} = 'Cancelled';
+ # search duplicate on ISBN, easy and fast..
+ #$search->{'avoidquerylog'}=1;
+ if ( $result->{isbn} ) {
+ $query = "isbn=$result->{isbn}";
}
else {
- $data->{'date_due'} = 'Available';
- } # else
- } # else
-
- $sth2->finish;
-
- # Find the last 3 people who borrowed this item.
- $sth2 = $dbh->prepare(
- "select * from issues, borrowers
- where itemnumber = ?
- and issues.borrowernumber = borrowers.borrowernumber
- and returndate is not NULL
- order by returndate desc,timestamp desc"
- );
-
-# $sth2 = $dbh->prepare("
-# SELECT *
-# FROM issues
-# LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
-# WHERE itemnumber = ?
-# AND returndate is not NULL
-# ORDER BY returndate DESC,timestamp DESC
-# ");
-
- $sth2->execute( $data->{'itemnumber'} );
- for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
- { # FIXME : error if there is less than 3 pple borrowing this item
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{"timestamp$i2"} = $data2->{'timestamp'};
- $data->{"card$i2"} = $data2->{'cardnumber'};
- $data->{"borrower$i2"} = $data2->{'borrowernumber'};
- } # if
- } # for
-
- $sth2->finish;
- $results[$i] = $data;
- $i++;
- }
-
- $sth->finish;
- return (@results);
-}
-
-=item itemnodata
-
- $item = &itemnodata($env, $dbh, $biblioitemnumber);
-
-Looks up the item with the given biblioitemnumber.
-
-C<$env> and C<$dbh> are ignored.
-
-C<&itemnodata> returns a reference-to-hash whose keys are the fields
-from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
-database.
-
-=cut
-
-#'
-sub itemnodata {
- my ( $env, $dbh, $itemnumber ) = @_;
- $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from biblio,items,biblioitems
- where items.itemnumber = ?
- and biblio.biblionumber = items.biblionumber
- and biblioitems.biblioitemnumber = items.biblioitemnumber"
- );
-
- # print $query;
- $sth->execute($itemnumber);
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- return ($data);
-}
-
-=item getboracctrecord
-
- ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
-
-Looks up accounting data for the patron with the given borrowernumber.
-
-C<$env> is ignored.
-
-(FIXME - I'm not at all sure what this is about.)
-
-C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields of the C<accountlines> table in the Koha database.
-C<$count> is the number of elements in C<$acctlines>. C<$total> is the
-total amount outstanding for all of the account lines.
-
-=cut
-
-#'
-sub getboracctrecord {
- my ( $env, $params ) = @_;
- my $dbh = C4::Context->dbh;
- my @acctlines;
- my $numlines = 0;
- my $sth = $dbh->prepare(
- "Select * from accountlines where
-borrowernumber=? order by date desc,timestamp desc"
- );
-
- # print $query;
- $sth->execute( $params->{'borrowernumber'} );
- my $total = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
-
- #FIXME before reinstating: insecure?
- # if ($data->{'itemnumber'} ne ''){
- # $query="Select * from items,biblio where items.itemnumber=
- # '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
- # my $sth2=$dbh->prepare($query);
- # $sth2->execute;
- # my $data2=$sth2->fetchrow_hashref;
- # $sth2->finish;
- # $data=$data2;
- # }
- $acctlines[$numlines] = $data;
- $numlines++;
- $total += $data->{'amountoutstanding'};
+ $result->{title} =~ s /\\//g;
+ $result->{title} =~ s /\"//g;
+ $result->{title} =~ s /\(//g;
+ $result->{title} =~ s /\)//g;
+ $query = "ti,ext=$result->{title}";
}
- $sth->finish;
- return ( $numlines, \@acctlines, $total );
-}
-
-=item bibitems
-
- ($count, @results) = &bibitems($biblionumber);
-
-Given the biblionumber for a book, C<&bibitems> looks up that book's
-biblioitems (different publications of the same book, the audio book
-and film versions, etc.).
-
-C<$count> is the number of elements in C<@results>.
-
-C<@results> is an array of references-to-hash; the keys are the fields
-of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
-addition, C<itemlost> indicates the availability of the item: if it is
-"2", then all copies of the item are long overdue; if it is "1", then
-all copies are lost; otherwise, there is at least one copy available.
-
-=cut
-
-#'
-sub bibitems {
- my ($bibnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "SELECT biblioitems.*,
- itemtypes.*,
- MIN(items.itemlost) as itemlost,
- MIN(items.dateaccessioned) as dateaccessioned
- FROM biblioitems, itemtypes, items
- WHERE biblioitems.biblionumber = ?
- AND biblioitems.itemtype = itemtypes.itemtype
- AND biblioitems.biblioitemnumber = items.biblioitemnumber
- GROUP BY items.biblioitemnumber"
- );
- my $count = 0;
- my @results;
- $sth->execute($bibnum);
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$count] = $data;
- $count++;
- } # while
- $sth->finish;
- return ( $count, @results );
-} # sub bibitems
-
-=item barcodes
-
- @barcodes = &barcodes($biblioitemnumber);
-
-Given a biblioitemnumber, looks up the corresponding items.
-
-Returns an array of references-to-hash; the keys are C<barcode> and
-C<itemlost>.
-
-The returned items include very overdue items, but not lost ones.
-
-=cut
-
-#'
-sub barcodes {
-
- #called from request.pl
- my ($biblioitemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
-"SELECT barcode, itemlost, homebranch, holdingbranch,itemnumber FROM items
- WHERE biblioitemnumber = ?
- AND (wthdrawn <> 1 OR wthdrawn IS NULL)"
- );
- $sth->execute($biblioitemnumber);
- my @barcodes;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $barcodes[$i] = $data;
- $i++;
+ my ($possible_duplicate_record) =
+ C4::Biblio::getRecord( "biblioserver", $query, "usmarc" );
+ if ($possible_duplicate_record) {
+ my $marcrecord =
+ MARC::Record->new_from_usmarc($possible_duplicate_record);
+ my $result = MARCmarc2koha( $dbh, $marcrecord, '' );
+ return $result->{'biblionumber'}, $result->{'biblionumber'},
+ $result->{'title'}
+ if $result;
}
- $sth->finish;
- return (@barcodes);
}
-=item getwebsites
-
- ($count, @websites) = &getwebsites($biblionumber);
-
-Looks up the web sites pertaining to the book with the given
-biblionumber.
-
-C<$count> is the number of elements in C<@websites>.
-
-C<@websites> is an array of references-to-hash; the keys are the
-fields from the C<websites> table in the Koha database.
-
-=cut
-
-#'
-sub getwebsites {
- my ($biblionumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("Select * from websites where biblionumber = ?");
- my $count = 0;
- my @results;
-
- $sth->execute($biblionumber);
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # FIXME - The URL scheme shouldn't be stripped off, at least
- # not here, since it's part of the URL, and will be useful in
- # constructing a link to the site. If you don't want the user
- # to see the "http://" part, strip that off when building the
- # HTML code.
- $data->{'url'} =~ s/^http:\/\///; # FIXME - Leaning toothpick
- # syndrome
- $results[$count] = $data;
- $count++;
- } # while
-
- $sth->finish;
- return ( $count, @results );
-} # sub getwebsites
-
-=item getwebbiblioitems
-
- ($count, @results) = &getwebbiblioitems($biblionumber);
-
-Given a book's biblionumber, looks up the web versions of the book
-(biblioitems with itemtype C<WEB>).
-
-C<$count> is the number of items in C<@results>. C<@results> is an
-array of references-to-hash; the keys are the items from the
-C<biblioitems> table of the Koha database.
-
-=cut
-
-#'
-sub getwebbiblioitems {
- my ($biblionumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from biblioitems where biblionumber = ?
-and itemtype = 'WEB'"
- );
- my $count = 0;
- my @results;
-
- $sth->execute($biblionumber);
- while ( my $data = $sth->fetchrow_hashref ) {
- $data->{'url'} =~ s/^http:\/\///;
- $results[$count] = $data;
- $count++;
- } # while
-
- $sth->finish;
- return ( $count, @results );
-} # sub getwebbiblioitems
-
-=item isbnsearch
-
- ($count, @results) = &isbnsearch($isbn,$title);
-
-Given an isbn and/or a title, returns the biblios having it.
-Used in acqui.simple, isbnsearch.pl only
-
-C<$count> is the number of items in C<@results>. C<@results> is an
-array of references-to-hash; the keys are the items from the
-C<biblioitems> table of the Koha database.
-
-=cut
-
-sub isbnsearch {
- my ( $isbn, $title ) = @_;
- my $dbh = C4::Context->dbh;
- my $count = 0;
- my ( $query, @bind );
- my $sth;
- my @results;
-
- $query =
-"Select distinct biblio.*, biblioitems.classification from biblio, biblioitems where
- biblio.biblionumber = biblioitems.biblionumber";
- @bind = ();
- if ($isbn) {
- $query .= " and isbn like ?";
- @bind = ( uc($isbn) . "%" );
- }
- if ($title) {
- $query .= " and title like ?";
- @bind = ( $title . "%" );
- }
- $sth = $dbh->prepare($query);
-
- $sth->execute(@bind);
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$count] = $data;
- $count++;
- } # while
-
- $sth->finish;
- return ( $count, @results );
-} # sub isbnsearch
-
-=item getborrowercategory
-
- $description = &getborrowercategory($categorycode);
-
-Given the borrower's category code, the function returns the corresponding
-description for a comprehensive information display.
-
-=cut
-
-sub getborrowercategory {
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "SELECT description FROM categories WHERE categorycode = ?");
- $sth->execute($catcode);
- my $description = $sth->fetchrow();
- $sth->finish();
- return $description;
-} # sub getborrowercategory
-
-sub getborrowercategoryinfo {
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?");
- $sth->execute($catcode);
- my $category = $sth->fetchrow_hashref;
- $sth->finish();
- return $category;
-} # sub getborrowercategoryinfo
-
-sub getMARCnotes {
- my ( $dbh, $biblionumber, $marcflavour ) = @_;
- my $scope;
- if ( $marcflavour eq "MARC21" ) {
- $scope = '5..';
- }
- else { # assume unimarc if not marc21
- $scope = '3..';
- }
-
- my $record = MARCgetbiblio( $dbh, $biblionumber );
- my @marcnotes;
- my $note = "";
- my $tag = "";
- my $marcnote;
-
- foreach my $field ( $record->field($scope) ) {
- my $value = $field->as_string();
- if ( $note ne "" ) {
- $marcnote = { marcnote => $note, };
- push @marcnotes, $marcnote;
- $note = $value;
- }
- if ( $note ne $value ) {
- $note = $note . " " . $value;
- }
- }
-
- if ($note) {
- $marcnote = { marcnote => $note };
- push @marcnotes, $marcnote; #load last tag into array
- }
-
- my $marcnotesarray = \@marcnotes;
- return $marcnotesarray;
-} # end getMARCnotes
-
-sub getMARCsubjects {
- my ( $dbh, $biblionumber, $marcflavour ) = @_;
- my ( $mintag, $maxtag );
- if ( $marcflavour eq "MARC21" ) {
- $mintag = "600";
- $maxtag = "699";
- }
- else { # assume unimarc if not marc21
- $mintag = "600";
- $maxtag = "619";
- }
- my $record = MARCgetbiblio( $dbh, $biblionumber );
- my @marcsubjcts;
- my $subjct = "";
- my $subfield = "";
- my $marcsubjct;
-
- foreach my $field ( $record->fields ) {
- next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
- my @subfields_loop;
-
- #my $value = $field->subfield('a');
- #$marcsubjct = {MARCSUBJCT => $value,};
- my @subfields = $field->subfields();
-
- #warn "subfields:".join " ", @$subfields;
- my $counter = 0;
- my @link_loop;
- for my $subject_subfield (@subfields) {
- my $code = $subject_subfield->[0];
- my $value = $subject_subfield->[1];
- my $linkvalue = $value;
- $linkvalue =~ s/(\(|\))//g;
- my $operator = " and " unless $counter == 0;
- push @link_loop, { link => $linkvalue, operator => $operator };
- my $separator = C4::Context->preference("authoritysep")
- unless $counter == 0;
- push @subfields_loop,
- {
- code => $code,
- value => $value,
- link_loop => \@link_loop,
- separator => $separator
- };
- $counter++;
- }
- push @marcsubjcts, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
-
- #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
- #push @marcsubjcts, $marcsubjct;
- #$subjct = $value;
-
- }
- my $marcsubjctsarray = \@marcsubjcts;
- return $marcsubjctsarray;
-} #end getMARCsubjects
-
-sub getMARCurls {
- my ( $dbh, $biblionumber, $marcflavour ) = @_;
- my ( $mintag, $maxtag );
- if ( $marcflavour eq "MARC21" ) {
- $mintag = "856";
- $maxtag = "856";
- }
- else { # assume unimarc if not marc21
- $mintag = "600";
- $maxtag = "619";
- }
-
- my $record = MARCgetbiblio( $dbh, $biblionumber );
- my @marcurls;
- my $url = "";
- my $subfil = "";
- my $marcurl;
- foreach my $field ( $record->field('856') ) {
- my $value = $field->subfield('u');
- if ( $value ne $url ) {
- $marcurl = { MARCURL => $value, };
- push @marcurls, $marcurl;
- $url = $value;
- }
- }
- my $marcurlsarray = \@marcurls;
- return $marcurlsarray;
-} #end getMARCurls
-
-# deprecated
-# sub searchZOOM_deprecated {
-# my ($search_or_scan,$type,$query,$num,$startfrom,$then_sort_by,$expanded_facet) = @_;
-# # establish database connections
-# my $dbh = C4::Context->dbh;
-# my $zconn=C4::Context->Zconn("biblioserver");
-# my $branches = GetBranches();
-# # make sure all is well with the connection
-# if ($zconn eq "error") {
-# return("error with connection",undef); #FIXME: better error handling
-# }
-#
-# my $koha_query_obj;
-#
-# # prepare the query depending on the type
-# if ($type eq 'ccl') {
-# #$query =~ s/(\(|\))//g;
-# eval {
-# $koha_query_obj = new ZOOM::Query::CCL2RPN($query,$zconn);
-# };
-# if ($@) {
-# return ("error: Sorry, there was a problem with your query: $@",undef); #FIXME: better error handling
-# }
-# } elsif ($type eq 'cql') {
-# eval {
-# $koha_query_obj = new ZOOM::Query::CQL2RPN($query,$zconn);
-# };
-# if ($@) {
-# return ("error: Sorry, there was a problem with your query: $@",undef); #FIXME: better error handling
-# }
-# } else {
-# eval {
-# $koha_query_obj = new ZOOM::Query::PQF($query);
-# };
-# if ($@) {
-# return("error with search: $@",undef); #FIXME: better error handling
-# }
-# }
-#
-# # PERFORM THE SEARCH OR SCAN
-# my $result;
-# my @results;
-# my $numresults;
-# if ($search_or_scan =~ /scan/) {
-# eval {
-# $result = $zconn->scan($koha_query_obj);
-# };
-# if ($@) {
-# return ("error with scan: $@",undef);
-# }
-# } else {
-# eval {
-# $result = $zconn->search($koha_query_obj);
-# };
-# if ($@) {
-# return("error with search: $@",undef); #FIXME: better error handling
-# }
-# }
-#
-# #### RESORT RESULT SET
-# if ($then_sort_by) {
-# $result->sort("yaz", "$then_sort_by")
-# }
-# ### New Facets Stuff
-# my $facets_counter = ();
-# my $facets_info = ();
-# my $facets = [ {
-# link_value => 'su',
-# label_value => 'Subject - Topic',
-# tags => ['650', '651',],
-# subfield => 'a',
-# },
-# {
-# link_value => 'au',
-# label_value => 'Authors',
-# tags => ['100','700',],
-# subfield => 'a',
-# },
-# {
-# link_value => 'se',
-# label_value => 'Series',
-# tags => ['440','490',],
-# subfield => 'a',
-# },
-# {
-# link_value => 'branch',
-# label_value => 'Branches',
-# tags => ['952',],
-# subfield => 'b',
-# expanded => '1',
-# },
-# ];
-#
-# #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
-# my @facets_loop; # stores the ref to array of hashes for template
-# #### LOOP THROUGH THE RESULTS
-# $numresults = 0 | $result->size() if ($result);
-# for ( my $i=$startfrom; $i<(($startfrom+$num<=$numresults) ? ($startfrom+$num):$numresults) ; $i++){
-# ## This is just an index scan
-# if ($search_or_scan =~ /scan/) {
-# my ($term,$occ) = $result->term($i);
-# # 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 FIXME: distinguish between MARC21 and UNIMARC
-# use MARC::Record;
-# my $tmprecord = MARC::Record->new();
-# $tmprecord->encoding('UTF-8');
-# my $tmptitle = MARC::Field->new( '245',' ',' ',
-# a => $term,
-# b => $occ);
-# $tmprecord->append_fields($tmptitle);
-# push @results, $tmprecord->as_usmarc();
-# ## This is a real search
-# } else {
-# my $rec = $result->record($i);
-# push(@results,$rec->raw()) if $rec; #FIXME: sometimes this fails
-#
-# ##### BUILD FACETS AND LIMITS ####
-# my $facet_record = MARC::Record->new_from_usmarc($rec->raw());
-#
-# for (my $i=0;$i<=@$facets;$i++) {
-# if ($facets->[$i]) {
-# my @fields;
-# for my $tag (@{$facets->[$i]->{'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->[$i]->{'subfield'}) {
-# $facets_counter->{ $facets->[$i]->{'link_value'} }->{ $data }++;
-# }
-# }
-# }
-# $facets_info->{ $facets->[$i]->{'link_value'} }->{ 'label_value' } = $facets->[$i]->{'label_value'};
-# $facets_info->{ $facets->[$i]->{'link_value'} }->{ 'expanded' } = $facets->[$i]->{'expanded'};
-# }
-# }
-#
-# }
-# }
-# # 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 }} ) {
-# $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;
-# # well, if it's a branch, label by the name, not the code
-# if ($link_value =~/branch/) {
-# #warn "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,
-# },
-# );
-# }
-# }
-# 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,
-# }
-# );
-# }
-#
-# return(undef,$numresults,\@facets_loop, at results);
-# }
-
-=item SimpleSearch
+=head2 SimpleSearch
($error,$results) = SimpleSearch($query, at servers);
this function performs a simple search on the catalog using zoom.
+=over 2
+
=item C<input arg:>
* $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
@@ -2485,6 +141,8 @@
=item C<usage in the script:>
+=back
+
my ($error, $marcresults) = SimpleSearch($query);
if (defined $error) {
@@ -2761,7 +419,8 @@
# BUILD FACETS
for my $link_value (
sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
- keys %$facets_counter )
+ keys %$facets_counter
+ )
{
my $expandable;
my $number_of_facets;
@@ -2836,11 +495,12 @@
# build the query itself
sub buildQuery {
my ( $query, $operators, $operands, $indexes, $limits, $sort_by ) = @_;
- warn "OPERATORS : " . Data::Dumper::Dumper($operators);
- warn "OPERANDS : " . Data::Dumper::Dumper($operands);
- warn "INDEXES : " . Data::Dumper::Dumper($indexes);
- warn "LIMITS : " . Data::Dumper::Dumper($limits);
- warn "SORT BY : " . Data::Dumper::Dumper($sort_by);
+
+ # warn "OPERATORS : " . Data::Dumper::Dumper($operators);
+ # warn "OPERANDS : " . Data::Dumper::Dumper($operands);
+ # warn "INDEXES : " . Data::Dumper::Dumper($indexes);
+ # warn "LIMITS : " . Data::Dumper::Dumper($limits);
+ # warn "SORT BY : " . Data::Dumper::Dumper($sort_by);
my @operators = @$operators if $operators;
my @indexes = @$indexes if $indexes;
my @operands = @$operands if $operands;
@@ -2906,7 +566,7 @@
$stemmed_operand .= "$stem";
$stemmed_operand .= "?"
unless ( $stem =~ /(and$|or$|not$)/ )
- || ( length( $stem ) < 3 );
+ || ( length($stem) < 3 );
$stemmed_operand .= " ";
#warn "STEM: $stemmed_operand";
@@ -3294,62 +954,59 @@
$oldbiblio->{bindingcount} = $itembinding_count;
$oldbiblio->{orderedcount} = $ordered_count;
-=head1 FIXME
-
- Ugh ... this is ugly, I'll re-write it better above then delete it
- my $norequests = 1;
- my $noitems = 1;
- if (@items) {
- $noitems = 0;
- foreach my $itm (@items) {
- $norequests = 0 unless $itm->{'itemnotforloan'};
- }
- }
- $oldbiblio->{'noitems'} = $noitems;
- $oldbiblio->{'norequests'} = $norequests;
- $oldbiblio->{'even'} = $even = not $even;
- $oldbiblio->{'itemcount'} = $counts{'total'};
- my $totalitemcounts = 0;
- foreach my $key (keys %counts){
- if ($key ne 'total'){
- $totalitemcounts+= $counts{$key};
- $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
- }
- }
- my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
- foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
- if ($_ eq 'notavailable') {
- $notavailabletext="Not available";
- my $c=$oldbiblio->{'locationhash'}->{$_};
- $oldbiblio->{'not-available-p'}=$c;
- } else {
- $locationtext.="$_";
- my $c=$oldbiblio->{'locationhash'}->{$_};
- if ($_ eq 'Item Lost') {
- $oldbiblio->{'lost-p'} = $c;
- } elsif ($_ eq 'Withdrawn') {
- $oldbiblio->{'withdrawn-p'} = $c;
- } elsif ($_ eq 'On Loan') {
- $oldbiblio->{'on-loan-p'} = $c;
- } else {
- $locationtextonly.= $_;
- $locationtextonly.= " ($c)<br/> " if $totalitemcounts > 1;
- }
- if ($totalitemcounts>1) {
- $locationtext.=" ($c)<br/> ";
- }
- }
- }
- if ($notavailabletext) {
- $locationtext.= $notavailabletext;
- } else {
- $locationtext=~s/, $//;
- }
- $oldbiblio->{'location'} = $locationtext;
- $oldbiblio->{'location-only'} = $locationtextonly;
- $oldbiblio->{'use-location-flags-p'} = 1;
-
-=cut
+# FIXME
+# Ugh ... this is ugly, I'll re-write it better above then delete it
+# my $norequests = 1;
+# my $noitems = 1;
+# if (@items) {
+# $noitems = 0;
+# foreach my $itm (@items) {
+# $norequests = 0 unless $itm->{'itemnotforloan'};
+# }
+# }
+# $oldbiblio->{'noitems'} = $noitems;
+# $oldbiblio->{'norequests'} = $norequests;
+# $oldbiblio->{'even'} = $even = not $even;
+# $oldbiblio->{'itemcount'} = $counts{'total'};
+# my $totalitemcounts = 0;
+# foreach my $key (keys %counts){
+# if ($key ne 'total'){
+# $totalitemcounts+= $counts{$key};
+# $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
+# }
+# }
+# my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
+# foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
+# if ($_ eq 'notavailable') {
+# $notavailabletext="Not available";
+# my $c=$oldbiblio->{'locationhash'}->{$_};
+# $oldbiblio->{'not-available-p'}=$c;
+# } else {
+# $locationtext.="$_";
+# my $c=$oldbiblio->{'locationhash'}->{$_};
+# if ($_ eq 'Item Lost') {
+# $oldbiblio->{'lost-p'} = $c;
+# } elsif ($_ eq 'Withdrawn') {
+# $oldbiblio->{'withdrawn-p'} = $c;
+# } elsif ($_ eq 'On Loan') {
+# $oldbiblio->{'on-loan-p'} = $c;
+# } else {
+# $locationtextonly.= $_;
+# $locationtextonly.= " ($c)<br/> " if $totalitemcounts > 1;
+# }
+# if ($totalitemcounts>1) {
+# $locationtext.=" ($c)<br/> ";
+# }
+# }
+# }
+# if ($notavailabletext) {
+# $locationtext.= $notavailabletext;
+# } else {
+# $locationtext=~s/, $//;
+# }
+# $oldbiblio->{'location'} = $locationtext;
+# $oldbiblio->{'location-only'} = $locationtextonly;
+# $oldbiblio->{'use-location-flags-p'} = 1;
push( @newresults, $oldbiblio );
}
@@ -3361,8 +1018,6 @@
1;
__END__
-=back
-
=head1 AUTHOR
Koha Developement team <info at koha.org>
Index: C4/Serials.pm
===================================================================
RCS file: /sources/koha/koha/C4/Serials.pm,v
retrieving revision 1.5.2.12
retrieving revision 1.5.2.13
diff -u -b -r1.5.2.12 -r1.5.2.13
--- C4/Serials.pm 27 Nov 2006 14:17:18 -0000 1.5.2.12
+++ C4/Serials.pm 30 Nov 2006 17:22:19 -0000 1.5.2.13
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Serials.pm,v 1.5.2.12 2006/11/27 14:17:18 hdl Exp $
+# $Id: Serials.pm,v 1.5.2.13 2006/11/30 17:22:19 toins Exp $
use strict;
use C4::Date;
@@ -32,7 +32,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.5.2.12 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.5.2.13 $' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
@@ -2501,6 +2501,40 @@
# warn "date: ".$resultdate;
return format_date_in_iso($resultdate);
}
+
+=head2 itemdata
+
+ $item = &itemdata($barcode);
+
+Looks up the item with the given barcode, and returns a
+reference-to-hash containing information about that item. The keys of
+the hash are the fields from the C<items> and C<biblioitems> tables in
+the Koha database.
+
+=cut
+
+#'
+sub itemdata {
+ my ($barcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from items,biblioitems where barcode=?
+ and items.biblioitemnumber=biblioitems.biblioitemnumber"
+ );
+ $sth->execute($barcode);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
+}
+
END { } # module clean-up code here (global destructor)
1;
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info at koha.org>
+
+=cut
Index: catalogue/detail.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/detail.pl,v
retrieving revision 1.6.2.7
retrieving revision 1.6.2.8
diff -u -b -r1.6.2.7 -r1.6.2.8
--- catalogue/detail.pl 22 Nov 2006 11:04:02 -0000 1.6.2.7
+++ catalogue/detail.pl 30 Nov 2006 17:22:19 -0000 1.6.2.8
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: detail.pl,v 1.6.2.7 2006/11/22 11:04:02 toins Exp $
+# $Id: detail.pl,v 1.6.2.8 2006/11/30 17:22:19 toins Exp $
use strict;
require Exporter;
@@ -42,8 +42,6 @@
my @items = &GetItemsInfo($biblionumber, 'intra');
my $dat = &bibdata($biblionumber);
my ($authorcount, $addauthor) = &addauthor($biblionumber);
-my ($webbiblioitemcount, @webbiblioitems) = &getwebbiblioitems($biblionumber);
-my ($websitecount, @websites) = &getwebsites($biblionumber);
my $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber);
$dat->{'count'}=@items;
@@ -78,8 +76,6 @@
$template->param("$_" => $dat->{$_}."");
}
$template->param(ITEM_RESULTS => \@items,
- WEB_RESULTS => \@webbiblioitems,
- SITE_RESULTS => \@websites,
subscriptionsnumber => $subscriptionsnumber,
biblionumber => $biblionumber,
);
Index: catalogue/detailprint.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/detailprint.pl,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -u -b -r1.1.2.2 -r1.1.2.3
--- catalogue/detailprint.pl 17 Nov 2006 13:18:59 -0000 1.1.2.2
+++ catalogue/detailprint.pl 30 Nov 2006 17:22:19 -0000 1.1.2.3
@@ -47,8 +47,6 @@
my $dat=bibdata($biblionumber);
my ($authorcount, $addauthor)= &addauthor($biblionumber);
-my ($webbiblioitemcount, @webbiblioitems) = &getwebbiblioitems($biblionumber);
-my ($websitecount, @websites) = &getwebsites($biblionumber);
$dat->{'count'}=@items;
$dat->{'norequests'} = $norequests;
@@ -64,8 +62,6 @@
my $resultsarray=\@results;
my $itemsarray=\@items;
-my $webarray=\@webbiblioitems;
-my $sitearray=\@websites;
my $startfrom=$query->param('startfrom');
($startfrom) || ($startfrom=0);
@@ -92,8 +88,6 @@
prevstartfrom => $prevstartfrom,
BIBLIO_RESULTS => $resultsarray,
ITEM_RESULTS => $itemsarray,
- WEB_RESULTS => $webarray,
- SITE_RESULTS => $sitearray,
loggedinuser => $loggedinuser,
biblionumber => $biblionumber,
);
Index: catalogue/MARCdetail.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/MARCdetail.pl,v
retrieving revision 1.5.2.4
retrieving revision 1.5.2.5
diff -u -b -r1.5.2.4 -r1.5.2.5
--- catalogue/MARCdetail.pl 17 Nov 2006 13:18:59 -0000 1.5.2.4
+++ catalogue/MARCdetail.pl 30 Nov 2006 17:22:19 -0000 1.5.2.5
@@ -56,8 +56,7 @@
use C4::Biblio;
use C4::Acquisition;
use C4::Serials; #uses getsubscriptionsfrombiblionumber
-use HTML::Template;
-use C4::Search;
+#use HTML::Template;
my $query=new CGI;
@@ -68,7 +67,6 @@
my $popup = $query->param('popup'); # if set to 1, then don't insert links, it's just to show the biblio
my $tagslib = &MARCgettagslib($dbh,1,$itemtype);
-#my $record = C4::Search::get_record($biblionumber);
my $record =MARCgetbiblio($dbh,$biblionumber);
# open template
Index: catalogue/moredetail.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/moredetail.pl,v
retrieving revision 1.4.2.2
retrieving revision 1.4.2.3
diff -u -b -r1.4.2.2 -r1.4.2.3
--- catalogue/moredetail.pl 17 Nov 2006 11:17:30 -0000 1.4.2.2
+++ catalogue/moredetail.pl 30 Nov 2006 17:22:19 -0000 1.4.2.3
@@ -1,7 +1,7 @@
#!/usr/bin/perl
# NOTE: Use standard 8-space tabs for this file (indents are 4 spaces)
-# $Id: moredetail.pl,v 1.4.2.2 2006/11/17 11:17:30 tipaul Exp $
+# $Id: moredetail.pl,v 1.4.2.3 2006/11/30 17:22:19 toins Exp $
# Copyright 2000-2003 Katipo Communications
#
@@ -26,7 +26,7 @@
use C4::Koha;
use CGI;
use C4::Search; # to use &itemissues and maybe others..
-use C4::Biblio; # to use &bibitemdata
+use C4::Biblio; # to use &bibitemdata &itemissues
use C4::Acquisition;
use C4::Output; # contains gettemplate
use C4::Auth;
Index: cataloguing/addbiblio.pl
===================================================================
RCS file: /sources/koha/koha/cataloguing/addbiblio.pl,v
retrieving revision 1.14.2.13
retrieving revision 1.14.2.14
diff -u -b -r1.14.2.13 -r1.14.2.14
--- cataloguing/addbiblio.pl 17 Nov 2006 13:18:59 -0000 1.14.2.13
+++ cataloguing/addbiblio.pl 30 Nov 2006 17:22:19 -0000 1.14.2.14
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: addbiblio.pl,v 1.14.2.13 2006/11/17 13:18:59 tipaul Exp $
+# $Id: addbiblio.pl,v 1.14.2.14 2006/11/30 17:22:19 toins Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -121,7 +121,7 @@
my $auth_fields = C4::Context->preference("z3950AuthorAuthFields");
my @auth_fields= split /,/,$auth_fields;
my $field;
- warn $record->as_formatted;
+ #warn $record->as_formatted;
if ($record->field($tag)){
foreach my $tmpfield ($record->field($tag)->subfields){
# foreach my $subfieldcode ($tmpfield->subfields){
@@ -217,8 +217,11 @@
}
=item create_input
+
builds the <input ...> entry for a subfield.
+
=cut
+
sub create_input () {
my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth) = @_;
# must be encoded as utf-8 before it reaches the editor
Index: opac/opac-basket.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-basket.pl,v
retrieving revision 1.8
retrieving revision 1.8.2.1
diff -u -b -r1.8 -r1.8.2.1
--- opac/opac-basket.pl 21 May 2006 02:11:29 -0000 1.8
+++ opac/opac-basket.pl 30 Nov 2006 17:22:19 -0000 1.8.2.1
@@ -1,4 +1,22 @@
#!/usr/bin/perl
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+# $Id: opac-basket.pl,v 1.8.2.1 2006/11/30 17:22:19 toins Exp $
+
use strict;
require Exporter;
use CGI;
Index: opac/opac-detail.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-detail.pl,v
retrieving revision 1.32.2.1
retrieving revision 1.32.2.2
diff -u -b -r1.32.2.1 -r1.32.2.2
--- opac/opac-detail.pl 17 Nov 2006 13:19:00 -0000 1.32.2.1
+++ opac/opac-detail.pl 30 Nov 2006 17:22:19 -0000 1.32.2.2
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: opac-detail.pl,v 1.32.2.1 2006/11/17 13:19:00 tipaul Exp $
+# $Id: opac-detail.pl,v 1.32.2.2 2006/11/30 17:22:19 toins Exp $
use strict;
require Exporter;
@@ -49,8 +49,6 @@
my @items = &ItemInfo( undef, $biblionumber, 'opac' );
my $dat = &bibdata($biblionumber);
my ( $authorcount, $addauthor ) = &addauthor($biblionumber);
-my ( $webbiblioitemcount, @webbiblioitems ) = &getwebbiblioitems($biblionumber);
-my ( $websitecount, @websites ) = &getwebsites($biblionumber);
#coping with subscriptions
my $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber);
@@ -136,8 +134,6 @@
my @results = ( $dat, );
my $resultsarray = \@results;
my $itemsarray = \@items;
-my $webarray = \@webbiblioitems;
-my $sitearray = \@websites;
my $titlewords = \@title;
my $authorwords = \@author;
@@ -147,7 +143,7 @@
GetSubscriptions( $dat->{title}, $dat->{issn}, $biblionumber );
my @subs;
foreach my $subscription (@subscriptions) {
- warn "subsid :" . $subscription->{subscriptionid};
+ #warn "subsid :" . $subscription->{subscriptionid};
my %cell;
$cell{subscriptionid} = $subscription->{subscriptionid};
$cell{subscriptionnotes} = $subscription->{notes};
@@ -161,8 +157,6 @@
$template->param(
BIBLIO_RESULTS => $resultsarray,
ITEM_RESULTS => $itemsarray,
- WEB_RESULTS => $webarray,
- SITE_RESULTS => $sitearray,
subscriptionsnumber => $subscriptionsnumber,
LibraryName => C4::Context->preference("LibraryName"),
suggestion => C4::Context->preference("suggestion"),
Index: opac/opac-detailprint.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-detailprint.pl,v
retrieving revision 1.3.2.1
retrieving revision 1.3.2.2
diff -u -b -r1.3.2.1 -r1.3.2.2
--- opac/opac-detailprint.pl 17 Nov 2006 13:19:00 -0000 1.3.2.1
+++ opac/opac-detailprint.pl 30 Nov 2006 17:22:19 -0000 1.3.2.2
@@ -36,18 +36,14 @@
my $biblionumber=$query->param('biblionumber');
# change back when ive fixed request.pl
-my @items = ItemInfo(undef, $biblionumber, $type);
+my @items = GetItemInfosOf($biblionumber);
my $norequests = 1;
foreach my $itm (@items) {
$norequests = 0 unless $itm->{'notforloan'};
}
-
-
my $dat=bibdata($biblionumber);
my ($authorcount, $addauthor)= &getaddauthor($biblionumber);
-my ($webbiblioitemcount, @webbiblioitems) = &getwebbiblioitems($biblionumber);
-my ($websitecount, @websites) = &getwebsites($biblionumber);
$dat->{'count'}=@items;
$dat->{'norequests'} = $norequests;
@@ -63,8 +59,6 @@
my $resultsarray=\@results;
my $itemsarray=\@items;
-my $webarray=\@webbiblioitems;
-my $sitearray=\@websites;
my $startfrom=$query->param('startfrom');
($startfrom) || ($startfrom=0);
@@ -80,7 +74,6 @@
# now to get the items into a hash we can use and whack that thru
-
my $nextstartfrom=($startfrom+20<$count-20) ? ($startfrom+20) : ($count-20);
my $prevstartfrom=($startfrom-20>0) ? ($startfrom-20) : (0);
$template->param(startfrom => $startfrom+1,
@@ -90,8 +83,6 @@
prevstartfrom => $prevstartfrom,
BIBLIO_RESULTS => $resultsarray,
ITEM_RESULTS => $itemsarray,
- WEB_RESULTS => $webarray,
- SITE_RESULTS => $sitearray,
loggedinuser => $loggedinuser,
biblionumber => $biblionumber,
);
Index: opac/opac-moredetail.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-moredetail.pl,v
retrieving revision 1.9.2.5
retrieving revision 1.9.2.6
diff -u -b -r1.9.2.5 -r1.9.2.6
--- opac/opac-moredetail.pl 17 Nov 2006 14:57:22 -0000 1.9.2.5
+++ opac/opac-moredetail.pl 30 Nov 2006 17:22:19 -0000 1.9.2.6
@@ -1,10 +1,24 @@
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
#script to display detailed information
#written 8/11/99
use strict;
-#use DBI;
use C4::Search;
use C4::Koha;
use C4::Output;
Index: opac/opac-reserve.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-reserve.pl,v
retrieving revision 1.29.2.2
retrieving revision 1.29.2.3
diff -u -b -r1.29.2.2 -r1.29.2.3
--- opac/opac-reserve.pl 24 Nov 2006 22:43:31 -0000 1.29.2.2
+++ opac/opac-reserve.pl 30 Nov 2006 17:22:19 -0000 1.29.2.3
@@ -1,5 +1,19 @@
#!/usr/bin/perl
-# NOTE: This file uses standard 8-character tabs
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
use strict;
require Exporter;
@@ -85,7 +99,7 @@
#### THIS IS A BIT OF A HACK BECAUSE THE BIBLIOITEMS DATA IS A LITTLE MESSED UP!
# get the itemtype data....
-my @items = ItemInfo(undef, $biblionumber, 'opac');
+my @items = GetItemInfosOf($biblionumber);
#######################################################
# old version, add so that old templates still work
Index: opac/opac-review.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-review.pl,v
retrieving revision 1.2
retrieving revision 1.2.2.1
diff -u -b -r1.2 -r1.2.2.1
--- opac/opac-review.pl 17 Jun 2006 03:18:32 -0000 1.2
+++ opac/opac-review.pl 30 Nov 2006 17:22:19 -0000 1.2.2.1
@@ -87,4 +87,3 @@
}
output_html_with_http_headers $query, $cookie, $template->output;
-
Index: opac/opac-sendbasket.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-sendbasket.pl,v
retrieving revision 1.10.2.1
retrieving revision 1.10.2.2
diff -u -b -r1.10.2.1 -r1.10.2.2
--- opac/opac-sendbasket.pl 17 Nov 2006 13:19:00 -0000 1.10.2.1
+++ opac/opac-sendbasket.pl 30 Nov 2006 17:22:19 -0000 1.10.2.2
@@ -1,4 +1,20 @@
#!/usr/bin/perl
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
require Exporter;
use CGI;
Index: opac/opac-shelves.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-shelves.pl,v
retrieving revision 1.8.2.1
retrieving revision 1.8.2.2
diff -u -b -r1.8.2.1 -r1.8.2.2
--- opac/opac-shelves.pl 30 Aug 2006 16:03:22 -0000 1.8.2.1
+++ opac/opac-shelves.pl 30 Nov 2006 17:22:19 -0000 1.8.2.2
@@ -2,7 +2,7 @@
#script to provide bookshelf management
# WARNING: This file uses 4-character tabs!
#
-# $Header: /sources/koha/koha/opac/opac-shelves.pl,v 1.8.2.1 2006/08/30 16:03:22 toins Exp $
+# $Header: /sources/koha/koha/opac/opac-shelves.pl,v 1.8.2.2 2006/11/30 17:22:19 toins Exp $
#
# Copyright 2000-2002 Katipo Communications
#
@@ -23,6 +23,7 @@
use strict;
use C4::Search;
+use C4::Koha;
use CGI;
use C4::Output;
use C4::BookShelves;
@@ -41,6 +42,12 @@
authnotrequired => 1,
});
+# load the languages
+my @languages_options = displayLanguages($query);
+my $languages_count = @languages_options;
+if($languages_count > 1){
+ $template->param(languages => \@languages_options);
+}
if ($query->param('modifyshelfcontents')) {
my $shelfnumber=$query->param('shelfnumber');
my $barcode=$query->param('addbarcode');
@@ -83,13 +90,23 @@
}
}
+ # set the default tab, etc.
+ my $shelf_type = $query->param('display');
+ if ((!$shelf_type) || ($shelf_type eq 'privateshelves')) {
+ $template->param(showprivateshelves => 1);
+ } elsif ($shelf_type eq 'publicshelves') {
+ $template->param(showpublicshelves => 1);
+ }
($shelflist) = GetShelves($loggedinuser,2); # rebuild shelflist in case a shelf has been added
my $color='';
my @shelvesloop;
+my @shelveslooppriv;
foreach my $element (sort keys %$shelflist) {
my %line;
+ my %linepriv;
($color eq 0) ? ($color=1) : ($color=0);
+ if ($shelflist->{$element}->{'category'} eq 2) {
$line{'color'}= $color;
$line{'shelf'}=$element;
$line{'shelfname'}=$shelflist->{$element}->{'shelfname'};
@@ -99,10 +116,22 @@
$line{'canmanage'} = ShelfPossibleAction($loggedinuser,$element,'manage');
$line{'firstname'}=$shelflist->{$element}->{'firstname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
$line{'surname'}=$shelflist->{$element}->{'surname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
-;
push (@shelvesloop, \%line);
+ } elsif ($shelflist->{$element}->{'category'} eq 1) {
+ $linepriv{'color'}= $color;
+ $linepriv{'shelf'}=$element;
+ $linepriv{'shelfname'}=$shelflist->{$element}->{'shelfname'};
+ $linepriv{"category".$shelflist->{$element}->{'category'}} = 1;
+ $linepriv{'mine'} = 1 if $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ $linepriv{'shelfbookcount'}=$shelflist->{$element}->{'count'};
+ $linepriv{'canmanage'} = ShelfPossibleAction($loggedinuser,$element,'manage');
+ $linepriv{'firstname'}=$shelflist->{$element}->{'firstname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ $linepriv{'surname'}=$shelflist->{$element}->{'surname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ push (@shelveslooppriv, \%linepriv);
+ }
}
-$template->param(shelvesloop => \@shelvesloop);
+$template->param(shelveslooppriv => \@shelveslooppriv,
+ shelvesloop => \@shelvesloop);
output_html_with_http_headers $query, $cookie, $template->output;
@@ -163,17 +192,28 @@
my @itemsloop;
foreach $item (sort {$a->{'barcode'} cmp $b->{'barcode'}} @$itemlist) {
my %line;
+ if ($item->{'itemnumber'}) {
($color eq 0) ? ($color=1) : ($color=0);
$line{'color'}=$color;
$line{'itemnumber'}=$item->{'itemnumber'};
$line{'barcode'}=$item->{'barcode'};
$line{'title'}=$item->{'title'};
+ $line{'isbn'}=$item->{'isbn'};
+ $line{'subtitle'}=$item->{'subtitle'};
$line{'author'}=$item->{'author'};
+ $line{'publicationyear'}=$item->{'publicationyear'};
+ $line{'publishercode'}=$item->{'publishercode'};
+ $line{'place'}=$item->{'place'};
+ $line{'pages'}=$item->{'pages'};
+ $line{'notes'}=$item->{'notes'};
+ $line{'size'}=$item->{'size'};
$line{'classification'}=$item->{'classification'};
$line{'itemtype'}=$item->{'itemtype'};
+ $line{'ccode'}=$item->{'ccode'};
$line{biblionumber} = $item->{biblionumber};
push(@itemsloop, \%line);
}
+ }
$template->param( itemsloop => \@itemsloop,
shelfname => $shelflist->{$shelfnumber}->{'shelfname'},
shelfnumber => $shelfnumber,
@@ -184,6 +224,9 @@
#
# $Log: opac-shelves.pl,v $
+# Revision 1.8.2.2 2006/11/30 17:22:19 toins
+# Cleaning Search.pm
+#
# Revision 1.8.2.1 2006/08/30 16:03:22 toins
# Code cleaned according to coding guide lines.
#
Index: opac/opac-showreviews.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-showreviews.pl,v
retrieving revision 1.2
retrieving revision 1.2.2.1
diff -u -b -r1.2 -r1.2.2.1
--- opac/opac-showreviews.pl 17 Jun 2006 03:50:50 -0000 1.2
+++ opac/opac-showreviews.pl 30 Nov 2006 17:22:19 -0000 1.2.2.1
@@ -1,4 +1,20 @@
#!/usr/bin/perl
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
require Exporter;
use CGI;
More information about the Koha-cvs
mailing list