From cd6a34c3434e79c595c44e95aad7f06a50afeb3e Mon Sep 17 00:00:00 2001 From: kados Date: Sat, 1 Apr 2006 22:03:33 +0000 Subject: [PATCH] plugin directory for hybrid plugin files to ease installation. --- misc/plugin/Search.pm | 2667 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2667 insertions(+) create mode 100755 misc/plugin/Search.pm diff --git a/misc/plugin/Search.pm b/misc/plugin/Search.pm new file mode 100755 index 0000000000..1d9c910a68 --- /dev/null +++ b/misc/plugin/Search.pm @@ -0,0 +1,2667 @@ +package C4::Search; + +# Copyright 2000-2002 Katipo Communications +# +# 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 DBI; +use C4::Context; +use C4::Reserves2; + # 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 C4::Biblio; + +use ZOOM; +use Smart::Comments; +use MARC::Record; +use MARC::File::XML; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + +# set the version for version checking +$VERSION = do { my @v = '$Revision$' =~ /\d+/g; + shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); }; + +=head1 NAME + +C4::Search - Functions for searching the Koha catalog and other databases + +=head1 SYNOPSIS + + use C4::Search; + + my ($count, @results) = catalogsearch($env, $type, $search, $num, $offset); + +=head1 DESCRIPTION + +This module provides the searching facilities for the Koha catalog and +other databases. + +C<&catalogsearch> is a front end to all the other searches. Depending +on what is passed to it, it calls the appropriate search function. + +=head1 FUNCTIONS + +=over 2 + +=cut + +@ISA = qw(Exporter); +@EXPORT = qw( +&CatSearch &BornameSearch &ItemInfo &KeywordSearch &subsearch +&itemdata &bibdata &GetItems &borrdata &itemnodata &itemcount +&borrdata2 &NewBorrowerNumber &bibitemdata &borrissues +&getboracctrecord &ItemType &itemissues &subject &subtitle +&addauthor &bibitems &barcodes &findguarantees &allissues +&findguarantor &getwebsites &getwebbiblioitems &catalogsearch &itemcount2 +&isbnsearch &getbranchname &getborrowercategory +search get_record get_xml_record +); +# make all your functions, whether exported or not; + + +# new subs +sub search { + my ( $search, $type, $number ) = @_; + my $dbh = C4::Context->dbh(); + my $q; + my $Zconn = C4::Context->Zconn; + my $raw; + + if ( $type eq 'CQL' ) { + my $string; + if ( $search->{'cql'} ) { + $string = $search->{'cql'}; + } + else { + foreach my $var ( keys %$search ) { + $string .= "$var=\"$search->{$var}\" "; + } + } + $q = new ZOOM::Query::CQL2RPN( $string, $Zconn ); + } + my $rs; + my $n; + eval { + $rs = $Zconn->search($q); + $n = $rs->size(); + }; + if ($@) { + print "Error ", $@->code(), ": ", $@->message(), "\n"; + } + my $i = 0; + my @results; + while ( $i < $n && $i < $number ) { + $raw = $rs->record($i)->raw(); + my $record = MARC::Record->new_from_xml($raw, 'UTF-8'); + my $line = MARCmarc2koha( $dbh, $record ); + push @results, $line; + # push @results,$raw; + $i++; + } + return ( \@results ); +} + +sub get_record { + + # pass in an id (biblionumber at this stage) and get back a MARC record + my ($id) = @_; + my $q; + my $Zconn = C4::Context->Zconn; + my $raw; + my $string = "identifier=$id"; + # my $string = "title=delete"; + # warn $string; + + $q = new ZOOM::Query::CQL2RPN( $string, $Zconn); + eval { + # my $rs = $Zconn->search_pqf("\@attr 1=12 $id"); + my $rs = $Zconn->search($q); + my $n = $rs->size(); + if ( $n > 0 ) { + $raw = $rs->record(0)->raw(); + } + }; + if ($@) { + + warn "Error ", $@->code(), ": ", $@->message(), "\n"; + } + ###$raw + my $record = MARC::Record->new_from_xml($raw, 'UTF-8'); + ###$record + return ($record); + } + +sub get_xml_record { + # pass in an id (biblionumber at this stage) and get back a MARC record + my ($id) = @_; + my $q; + my $Zconn = C4::Context->Zconn; + my $raw; + my $string = "identifier=$id"; + # my $string = "title=delete"; + # warn $string; + + $q = new ZOOM::Query::CQL2RPN( $string, $Zconn); + eval { + # my $rs = $Zconn->search_pqf("\@attr 1=12 $id"); + my $rs = $Zconn->search($q); + my $n = $rs->size(); + if ( $n > 0 ) { + $raw = $rs->record(0)->raw(); + } + }; + if ($@) { + + warn "Error ", $@->code(), ": ", $@->message(), "\n"; + } + ### $raw + my $record = $raw; + ###$record + return ($record); + } + +=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 ($bornum)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?"); + $sth->execute($bornum); + + 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 database table; + +=cut +#' +sub findguarantor{ + my ($bornum)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?"); + $sth->execute($bornum); + 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{itemnumber}> or +C<$search-E{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{keyword}> is given, it runs a +C<&KeywordSearch>. Otherwise, it runs a loose C<&CatSearch>. + +If C<$env-E{itemcount}> is 1, then C<&catalogsearch> also counts +the items for each result, and adds several keys: + +=over 4 + +=item C + +The total number of copies of this book. + +=item C + +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 + +A descriptive string saying where the book is located, and how many +copies there are, if greater than 1. + +=item C + +The book's subject, with spaces replaced with C<%20>, presumably for +HTML. + +=back + +=cut +#' +sub catalogsearch { + my ($env,$type,$search,$num,$offset)=@_; + my $dbh = C4::Context->dbh; + # foreach my $key (%$search){ + # $search->{$key}=$dbh->quote($search->{$key}); + # } + my ($count,@results); + if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''){ + print STDERR "Doing a precise search\n"; + ($count,@results)=CatSearch($env,'precise',$search,$num,$offset); + } elsif ($search->{'subject'} ne ''){ + ($count,@results)=CatSearch($env,'subject',$search,$num,$offset); + } elsif ($search->{'keyword'} ne ''){ + ($count,@results)=&KeywordSearch($env,'keyword',$search,$num,$offset); + } else { + ($count,@results)=CatSearch($env,'loose',$search,$num,$offset); + + } + if ($env->{itemcount} eq '1') { + foreach my $data (@results){ + my ($counts) = itemcount2($env, $data->{'biblionumber'}, 'intra'); + my $subject2=$data->{'subject'}; + $subject2=~ s/ /%20/g; + $data->{'itemcount'}=$counts->{'total'}; + my $totalitemcounts=0; + foreach my $key (keys %$counts){ + if ($key ne 'total'){ # FIXME - Should ignore 'order', too. + #$data->{'location'}.="$key $counts->{$key} "; + $totalitemcounts+=$counts->{$key}; + $data->{'locationhash'}->{$key}=$counts->{$key}; + } + } + my $locationtext=''; + my $locationtextonly=''; + my $notavailabletext=''; + foreach (sort keys %{$data->{'locationhash'}}) { + if ($_ eq 'notavailable') { + $notavailabletext="Not available"; + my $c=$data->{'locationhash'}->{$_}; + $data->{'not-available-p'}=$totalitemcounts; + if ($totalitemcounts>1) { + $notavailabletext.=" ($c)"; + $data->{'not-available-plural-p'}=1; + } + } else { + $locationtext.="$_"; + my $c=$data->{'locationhash'}->{$_}; + if ($_ eq 'Item Lost') { + $data->{'lost-p'}=$totalitemcounts; + $data->{'lost-plural-p'}=1 + if $totalitemcounts > 1; + } elsif ($_ eq 'Withdrawn') { + $data->{'withdrawn-p'}=$totalitemcounts; + $data->{'withdrawn-plural-p'}=1 + if $totalitemcounts > 1; + } elsif ($_ eq 'On Loan') { + $data->{'on-loan-p'}=$totalitemcounts; + $data->{'on-loan-plural-p'}=1 + if $totalitemcounts > 1; + } else { + $locationtextonly.=$_; + $locationtextonly.=" ($c), " + if $totalitemcounts>1; + } + if ($totalitemcounts>1) { + $locationtext.=" ($c), "; + } + } + } + if ($notavailabletext) { + $locationtext.=$notavailabletext; + } else { + $locationtext=~s/, $//; + } + $data->{'location'}=$locationtext; + $data->{'location-only'}=$locationtextonly; + $data->{'subject2'}=$subject2; + $data->{'use-location-flags-p'}=1; # XXX + } + } + return ($count,@results); +} + +=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{"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 and C), +and subjects. + +C<$search-E{"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{"class"}> is not specified, you may specify +C<$search-E{"dewey"}>. This will restrict the search to that +particular Dewey Decimal Classification category. Setting +C<$search-E{"dewey"}> to "513" will return books about arithmetic, +whereas setting it to "5" will return all books with Dewey code 5I +(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 = <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
"; + } 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); +} + +sub KeywordSearch2 { + my ($env,$type,$search,$num,$offset)=@_; + my $dbh = C4::Context->dbh; + $search->{'keyword'}=~ s/ +$//; + my @key=split(' ',$search->{'keyword'}); + my $count=@key; + my $i=1; + my @results; + my $query ="Select * from biblio,bibliosubtitle,biblioitems where + biblio.biblionumber=biblioitems.biblionumber and + biblio.biblionumber=bibliosubtitle.biblionumber and + (((title like ? or title like ?)"; + my @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 ((biblio.notes like ? or biblio.notes like ?)"; + push(@bind,"$key[0]%","% $key[0]%"); + for ($i=1;$i<$count;$i++){ + $query.=" and (biblio.notes like ? or biblio.notes like ?)"; + push(@bind,"$key[$i]%","% $key[$i]%"); + } + $query.= ") or ((biblioitems.notes like ? or biblioitems.notes like ?)"; + push(@bind,"$key[0]%","% $key[0]%"); + for ($i=1;$i<$count;$i++){ + $query.=" and (biblioitems.notes like ? or biblioitems.notes like ?)"; + push(@bind,"$key[$i]%","% $key[$i]%"); + } + if ($search->{'keyword'} =~ /new zealand/i){ + $query.= "or (title like 'nz%' or title like '% nz %' or title like '% nz' or subtitle like 'nz%' + or subtitle like '% nz %' or subtitle like '% nz' or author like 'nz %' + or author like '% nz %' or author like '% nz')" + } + if ($search->{'keyword'} eq 'nz' || $search->{'keyword'} eq 'NZ' || + $search->{'keyword'} =~ /nz /i || $search->{'keyword'} =~ / nz /i || + $search->{'keyword'} =~ / nz/i){ + $query.= "or (title like 'new zealand%' or title like '% new zealand %' + or title like '% new zealand' or subtitle like 'new zealand%' or + subtitle like '% new zealand %' + or subtitle like '% new zealand' or author like 'new zealand%' + or author like '% new zealand %' or author like '% new zealand' or + seriestitle like 'new zealand%' or seriestitle like '% new zealand %' + or seriestitle like '% new zealand')" + } + $query .= "))"; + 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 like '$search->{'dewey'}%') "; + } + $query.="group by biblio.biblionumber"; + #$query.=" order by author,title"; +# print $query; + my $sth=$dbh->prepare($query); + $sth->execute(@bind); + $i=0; + while (my $data=$sth->fetchrow_hashref){ +#FIXME: rewrite to use ? before uncomment +# my $sti=$dbh->prepare("select dewey,subclass from biblioitems where biblionumber=$data->{'biblionumber'} +# "); +# $sti->execute; +# my ($dewey, $subclass) = $sti->fetchrow; + my $dewey=$data->{'dewey'}; + my $subclass=$data->{'subclass'}; + $dewey=~s/\.*0*$//; + ($dewey == 0) && ($dewey=''); + ($dewey) && ($dewey.=" $subclass"); +# $sti->finish; + $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey"; +# print $results[$i]; + $i++; + } + $sth->finish; + $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject + like ? group by biblionumber"); + $sth->execute("%".$search->{'keyword'}."%"); + while (my $data=$sth->fetchrow_hashref){ + $query="Select * from biblio,biblioitems where + biblio.biblionumber=? and + biblio.biblionumber=biblioitems.biblionumber "; + @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 like ?)"; + push(@bind,"$search->{'dewey'}%"); + } + my $sth2=$dbh->prepare($query); + $sth2->execute(@bind); +# print $query; + while (my $data2=$sth2->fetchrow_hashref){ + my $dewey= $data2->{'dewey'}; + my $subclass=$data2->{'subclass'}; + $dewey=~s/\.*0*$//; + ($dewey == 0) && ($dewey=''); + ($dewey) && ($dewey.=" $subclass") ; +# $sti->finish; + $results[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}\t$dewey"; +# print $results[$i]; + $i++; + } + $sth2->finish; + } + my $i2=1; + @results=sort @results; + my @res; + $count=@results; + $i=1; + if ($count > 0){ + $res[0]=$results[0]; + } + while ($i2 < $count){ + if ($results[$i2] ne $res[$i-1]){ + $res[$i]=$results[$i2]; + $i++; + } + $i2++; + } + $i2=0; + my @res2; + $count=@res; + while ($i2 < $num && $i2 < $count){ + $res2[$i2]=$res[$i2+$offset]; +# print $res2[$i2]; + $i2++; + } + $sth->finish; +# $i--; +# $i++; + return($i,@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 table in the Koha database, but +the following keys may also be present: + +=over 4 + +=item C + +The book's illustrator. + +=item C + +The publisher. + +=back + +C<$env> is ignored. + +C<$type> may be C, C, or C. 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, the following search criteria may be +used: + +=over 4 + +=item C<$search-E{author}> + +The search string is a space-separated list of words. Each word must +match either the C or C field. + +=item C<$search-E{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{abstract}> + +Searches for the given search string in the book's abstract. + +=item C<$search-E{'date-before'}> + +Searches for books whose copyright date matches the search string. +That is, setting C<$search-E{'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{title}> + +Searches by title are also affected by the value of +C<$search-E{"ttype"}>; if it is set to C, 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{"ttype"}> is set to anything other than C, +each word in the search string must match the title, subtitle, +unititle, or series title. + +=item C<$search-E{class}> + +Restricts the search to certain item classes. The value of +C<$search-E{"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{dewey}> + +Searches for books whose Dewey Decimal Classification code matches the +search string. That is, setting C<$search-E{"dewey"}> to "5" will +search for all books in 5I (Science and mathematics), setting it +to "54" will search for all books in 54I (Chemistry), and setting +it to "546" will search for books on inorganic chemistry. + +=item C<$search-E{publisher}> + +Searches for books whose publisher contains the search string (unlike +other search criteria, C<$search-E{publisher}> is a string, not a +set of words. + +=back + +=head2 Subject search + +If C<$type> is set to C, the following search criterion may +be used: + +=over 4 + +=item C<$search-E{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{subject}> is set to C, +C<&CatSearch> will search for books whose subject is "New Zealand". +However, setting C<$search-E{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, the following search criteria may be +used: + +=over 4 + +=item C<$search-E{item}> + +Searches for books whose barcode exactly matches the search string. + +=item C<$search-E{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->{'class'} ne ''){ + $query="select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber"; + my @temp=split(/\|/,$search->{'class'}); + my $count=@temp; + $query.= " and ( itemtype= ?)"; + @bind=($temp[0]); + for (my $i=1;$i<$count;$i++){ + $query.=" or itemtype=?"; + push(@bind,$temp[$i]); + } + $query.=")"; + if ($search->{'illustrator'} ne ''){ + $query.=" and illus like ?"; + push(@bind,"%".$search->{'illustrator'}."%"); + } + if ($search->{'dewey'} ne ''){ + $query.=" and biblioitems.dewey like ?"; + push(@bind,"$search->{'dewey'}%"); + } + } 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'}%"); + } + $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 - .= <{'isbn'} ne ''){ + my $search2=uc $search->{'isbn'}; + my $sth1=$dbh->prepare("select * from biblioitems where isbn=?"); + $sth1->execute($search2); + my $i2=0; + while (my $data=$sth1->fetchrow_hashref) { + my $sth=$dbh->prepare("select * from biblioitems,biblio where + biblio.biblionumber = ? + and biblioitems.biblionumber = biblio.biblionumber"); + $sth->execute($data->{'biblionumber'}); + # FIXME - There's already a $data in this scope. + my $data=$sth->fetchrow_hashref; + my ($dewey, $subclass) = ($data->{'dewey'}, $data->{'subclass'}); + # FIXME - The following assumes that the Dewey code is a + # floating-point number. It isn't: it's a string. + $dewey=~s/\.*0*$//; + ($dewey == 0) && ($dewey=''); + ($dewey) && ($dewey.=" $subclass"); + $data->{'dewey'}=$dewey; + $results[$i2]=$data; + # $results[$i2]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$dewey\t$data->{'isbn'}\t$data->{'itemtype'}"; + $i2++; + $sth->finish; + } + $sth1->finish; + } + } + 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); +} + +sub updatesearchstats{ + my ($dbh,$query)=@_; + +} + +=item subsearch + + @results = &subsearch($env, $subject); + +Searches for books that have a subject that exactly matches +C<$subject>. + +C<&subsearch> returns an array of results. Each element of this array +is a string, containing the book's title, author, and biblionumber, +separated by tabs. + +C<$env> is ignored. + +=cut +#' +sub subsearch { + my ($env,$subject)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select * from biblio,bibliosubject where + biblio.biblionumber=bibliosubject.biblionumber and + bibliosubject.subject=? group by biblio.biblionumber + order by biblio.title"); + $sth->execute($subject); + my $i=0; + my @results; + while (my $data=$sth->fetchrow_hashref){ + push @results, $data; + $i++; + } + $sth->finish; + return(@results); +} + +=item ItemInfo + + @results = &ItemInfo($env, $biblionumber, $type); + +Returns information about books with the given biblionumber. + +C<$type> may be either C or anything else. If it is not set to +C, 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, C, C, and C tables in the +Koha database. Other keys include: + +=over 4 + +=item C<$data-E{branchname}> + +The name (not the code) of the branch to which the book belongs. + +=item C<$data-E{datelastseen}> + +This is simply C, 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{datedue}> + +=item C<$data-E{class}> + +This is the concatenation of C, the book's +Dewey code, and C. + +=item C<$data-E{ocount}> + +I think this is the number of copies of the book available. + +=item C<$data-E{order}> + +If this is set, it is set to C. + +=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"; +# buggy : opac & librarian interface can show the same info level & itemstatus should not be hardcoded +# if ($type ne 'intra'){ +# $query .= " and ((items.itemlost<>1 and items.itemlost <> 2) +# or items.itemlost is NULL) +# and (wthdrawn <> 1 or wthdrawn is NULL)"; +# } + $query .= " order by items.homebranch, items.dateaccessioned desc"; + my $sth=$dbh->prepare($query); + $sth->execute($biblionumber); + my $i=0; + my @results; + 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 = format_date($idata->{'date_due'}); + } +# buggy : hardcoded & non-translatable +# more : why don't you want to show the datedue if it's very very overdue ? +# if ($data->{'itemlost'} eq '2'){ +# $datedue='Very Overdue'; +# } +# if ($data->{'itemlost'} eq '1'){ +# $datedue='Lost'; +# } +# if ($data->{'wthdrawn'} eq '1'){ +# $datedue="Cancelled"; +# } + if ($datedue eq ''){ + # $datedue="Available"; + my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'}); + if ($restype) { + $datedue=$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=format_date($data->{'datelastseen'}); + $data->{'datelastseen'}=$date; + $data->{'datedue'}=$datedue; + # 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->{notforloantext} = $lib; + } + $results[$i]=$data; + $i++; + } + $sth->finish; + #FIXME: ordering/indentation here looks wrong +# buggy : count in $i+1 the info on qty ordered for $i : total shown is real total +1 +# useless : Koha 2.2.2 now automatically show the existing number of items +# and if there is no items, and at least one is on order, show "on order". +# my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?"); +# $sth2->execute($biblionumber); +# my $data; +# my $ocount; +# if ($data=$sth2->fetchrow_hashref){ +# $ocount=$data->{'quantity'} - $data->{'quantityreceived'}; +# if ($ocount > 0){ +# $data->{'ocount'}=$ocount; +# $data->{'order'}="One Order"; +# $results[$i]=$data; +# } +# } +# $sth2->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 +"IC<[>IC<[>I" where I contains +the string C if the item is not for loan, and C 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) { + #debug_msg($env,$data->{'biblioitemnumber'}); + my $dewey = $data->{'dewey'}; + $dewey =~ s/0+$//; + 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 and C 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 + + $data = &bibdata($biblionumber, $type); + +Returns information about the book with the given biblionumber. + +C<$type> is ignored. + +C<&bibdata> returns a reference-to-hash. The keys are the fields in +the C, C, and C tables in the +Koha database. + +In addition, C<$data-E{subject}> is the list of the book's +subjects, separated by C<" , "> (space, comma, space). + +If there are multiple biblioitems with the given biblionumber, only +the first one is considered. + +=cut +#' +sub bibdata { + my ($bibnum, $type) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes + from biblio, biblioitems + left join bibliosubtitle on + biblio.biblionumber = bibliosubtitle.biblionumber + left join itemtypes on biblioitems.itemtype=itemtypes.itemtype + where biblio.biblionumber = ? + and biblioitems.biblionumber = biblio.biblionumber"); + $sth->execute($bibnum); + my $data; + $data = $sth->fetchrow_hashref; + $sth->finish; + # move url to an array, splitting it on every | + my @URLS; + foreach (split /\|/,$data->{url}) { + my %url; + $url{url} = $_; + push @URLS,\%url; + } + $data->{URLS} = \@URLS; + # 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); + # handle subjects : DEPRECATED ? + my @subjects; + while (my $dat = $sth->fetchrow_hashref){ + my %line; + $line{subject} = $dat->{'subject'}; + push @subjects, \%line; + } # while + $data->{subjects} = \@subjects; + $sth->finish; + # handle additional authors + $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'}; + # handle ISBN : reintroduce - if there are none + $data->{'isbn'} = DisplayISBN($data->{'isbn'}); + $sth->finish; + return($data); +} # sub bibdata + +=item bibitemdata + + $itemdata = &bibitemdata($biblioitemnumber); + +Looks up the biblioitem with the given biblioitemnumber. Returns a +reference-to-hash. The keys are the fields from the C, +C, and C tables in the Koha database, except +that C is given as C<$itemdata-E{bnotes}>. + +=cut +#' +sub bibitemdata { + my ($bibitem) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"); + my $data; + + $sth->execute($bibitem); + + $data = $sth->fetchrow_hashref; + + $sth->finish; + return($data); +} # sub bibitemdata + +=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>. + +=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>. + +=cut +#' +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); +} + +=item subtitle + + ($count, $subtitles) = &subtitle($biblionumber); + +Looks up the subtitles for the book with the given biblionumber. + +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>. + +=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++; + } + $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 table in the Koha database. +Additional keys include: + +=over 4 + +=item C + +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 + +If the item is currently on loan, this gives the card number of the +patron who currently has the item. + +=item C, C, C + +These give the timestamp for the last three times the item was +borrowed. + +=item C, C, C + +The card number of the last three patrons who borrowed this item. + +=item C, C, C + +The borrower number of the last three patrons who borrowed this item. + +=back + +=cut +#' +sub itemissues { + my ($bibitem, $biblio)=@_; + my $dbh = C4::Context->dbh; + # 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'; + } 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") || die $dbh->errstr; + $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr; + 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, C, and C 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 BornameSearch + + ($count, $borrowers) = &BornameSearch($env, $searchstring, $type); + +Looks up patrons (borrowers) by name. + +C<$env> is ignored. + +BUGFIX 499: C<$type> is now used to determine type of search. +if $type is "simple", search is performed on the first letter of the +surname only. + +C<$searchstring> is a space-separated list of search terms. Each term +must match the beginning a borrower's surname, first name, or other +name. + +C<&BornameSearch> returns a two-element list. C<$borrowers> is a +reference-to-array; each element is a reference-to-hash, whose keys +are the fields of the C table in the Koha database. +C<$count> is the number of elements in C<$borrowers>. + +=cut +#' +#used by member enquiries from the intranet +#called by member.pl +sub BornameSearch { + my ($env,$searchstring,$orderby,$type)=@_; + my $dbh = C4::Context->dbh; + my $query = ""; my $count; my @data; + my @bind=(); + + if($type eq "simple") # simple search for one letter only + { + $query="Select * from borrowers where surname like ? order by $orderby"; + @bind=("$searchstring%"); + } + else # advanced search looking in surname, firstname and othernames + { + @data=split(' ',$searchstring); + $count=@data; + $query="Select * from borrowers + where ((surname like ? or surname like ? + or firstname like ? or firstname like ? + or othernames like ? or othernames like ?) + "; + @bind=("$data[0]%","% $data[0]%","$data[0]%","% $data[0]%","$data[0]%","% $data[0]%"); + for (my $i=1;$i<$count;$i++){ + $query=$query." and (". + " surname like ? or surname like ? + or firstname like ? or firstname like ? + or othernames like ? or othernames like ?)"; + push(@bind,"$data[$i]%","% $data[$i]%","$data[$i]%","% $data[$i]%","$data[$i]%","% $data[$i]%"); + # FIXME - .= <prepare($query); + $sth->execute(@bind); + my @results; + my $cnt=$sth->rows; + while (my $data=$sth->fetchrow_hashref){ + push(@results,$data); + } + # $sth->execute; + $sth->finish; + return ($cnt,\@results); +} + +=item borrdata + + $borrower = &borrdata($cardnumber, $borrowernumber); + +Looks up information about a patron (borrower) by either card number +or borrower number. If $borrowernumber is specified, C<&borrdata> +searches by borrower number; otherwise, it searches by card number. + +C<&borrdata> returns a reference-to-hash whose keys are the fields of +the C table in the Koha database. + +=cut +#' +sub borrdata { + my ($cardnumber,$bornum)=@_; + $cardnumber = uc $cardnumber; + my $dbh = C4::Context->dbh; + my $sth; + if ($bornum eq ''){ + $sth=$dbh->prepare("Select * from borrowers where cardnumber=?"); + $sth->execute($cardnumber); + } else { + $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?"); + $sth->execute($bornum); + } + my $data=$sth->fetchrow_hashref; + $sth->finish; + if ($data) { + return($data); + } else { # try with firstname + if ($cardnumber) { + my $sth=$dbh->prepare("select * from borrowers where firstname=?"); + $sth->execute($cardnumber); + my $data=$sth->fetchrow_hashref; + $sth->finish; + return($data); + } + } + return undef; +} + +=item borrissues + + ($count, $issues) = &borrissues($borrowernumber); + +Looks up what the patron with the given borrowernumber has borrowed. + +C<&borrissues> returns a two-element array. C<$issues> is a +reference-to-array, where each element is a reference-to-hash; the +keys are the fields from the C, C, and C tables +in the Koha database. C<$count> is the number of elements in +C<$issues>. + +=cut +#' +sub borrissues { + my ($bornum)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=? + and items.itemnumber=issues.itemnumber + and items.biblionumber=biblio.biblionumber + and issues.returndate is NULL order by date_due"); + $sth->execute($bornum); + my @result; + while (my $data = $sth->fetchrow_hashref) { + push @result, $data; + } + $sth->finish; + return(scalar(@result), \@result); +} + +=item allissues + + ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit); + +Looks up what the patron with the given borrowernumber has borrowed, +and sorts the results. + +C<$sortkey> is the name of a field on which to sort the results. This +should be the name of a field in the C, C, +C, or C table in the Koha database. + +C<$limit> is the maximum number of results to return. + +C<&allissues> returns a two-element array. C<$issues> is a +reference-to-array, where each element is a reference-to-hash; the +keys are the fields from the C, C, C, and +C tables of the Koha database. C<$count> is the number of +elements in C<$issues> + +=cut +#' +sub allissues { + my ($bornum,$order,$limit)=@_; + #FIXME: sanity-check order and limit + my $dbh = C4::Context->dbh; + my $query="Select * from issues,biblio,items,biblioitems + where borrowernumber=? and + items.biblioitemnumber=biblioitems.biblioitemnumber and + items.itemnumber=issues.itemnumber and + items.biblionumber=biblio.biblionumber order by $order"; + if ($limit !=0){ + $query.=" limit $limit"; + } + #print $query; + my $sth=$dbh->prepare($query); + $sth->execute($bornum); + my @result; + my $i=0; + while (my $data=$sth->fetchrow_hashref){ + $result[$i]=$data;; + $i++; + } + $sth->finish; + return($i,\@result); +} + +=item borrdata2 + + ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber); + +Returns aggregate data about items borrowed by the patron with the +given borrowernumber. + +C<$env> is ignored. + +C<&borrdata2> returns a three-element array. C<$borrowed> is the +number of books the patron currently has borrowed. C<$due> is the +number of overdue items the patron currently has borrowed. C<$fine> is +the total fine currently due by the borrower. + +=cut +#' +sub borrdata2 { + my ($env,$bornum)=@_; + my $dbh = C4::Context->dbh; + my $query="Select count(*) from issues where borrowernumber='$bornum' and + returndate is NULL"; + # print $query; + my $sth=$dbh->prepare($query); + $sth->execute; + my $data=$sth->fetchrow_hashref; + $sth->finish; + $sth=$dbh->prepare("Select count(*) from issues where + borrowernumber='$bornum' and date_due < now() and returndate is NULL"); + $sth->execute; + my $data2=$sth->fetchrow_hashref; + $sth->finish; + $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where + borrowernumber='$bornum'"); + $sth->execute; + my $data3=$sth->fetchrow_hashref; + $sth->finish; + +return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'}); +} + +=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 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'}; + } + $sth->finish; + return ($numlines,\@acctlines,$total); +} + +=item itemcount + + ($count, $lcount, $nacount, $fcount, $scount, $lostcount, + $mending, $transit,$ocount) = + &itemcount($env, $biblionumber, $type); + +Counts the number of items with the given biblionumber, broken down by +category. + +C<$env> is ignored. + +If C<$type> is not set to C, lost, very overdue, and withdrawn +items will not be counted. + +C<&itemcount> returns a nine-element list: + +C<$count> is the total number of items with the given biblionumber. + +C<$lcount> is the number of items at the Levin branch. + +C<$nacount> is the number of items that are neither borrowed, lost, +nor withdrawn (and are therefore presumably on a shelf somewhere). + +C<$fcount> is the number of items at the Foxton branch. + +C<$scount> is the number of items at the Shannon branch. + +C<$lostcount> is the number of lost and very overdue items. + +C<$mending> is the number of items at the Mending branch (being +mended?). + +C<$transit> is the number of items at the Transit branch (in transit +between branches?). + +C<$ocount> is the number of items that haven't arrived yet +(aqorders.quantity - aqorders.quantityreceived). + +=cut +#' + +# FIXME - There's also a &C4::Biblio::itemcount. +# Since they're all exported, acqui/acquire.pl doesn't compile with -w. +sub itemcount { + my ($env,$bibnum,$type)=@_; + my $dbh = C4::Context->dbh; + my $query="Select * from items where + biblionumber=? "; + if ($type ne 'intra'){ + $query.=" and ((itemlost <>1 and itemlost <> 2) or itemlost is NULL) and + (wthdrawn <> 1 or wthdrawn is NULL)"; + } + my $sth=$dbh->prepare($query); + # print $query; + $sth->execute($bibnum); + my $count=0; + my $lcount=0; + my $nacount=0; + my $fcount=0; + my $scount=0; + my $lostcount=0; + my $mending=0; + my $transit=0; + my $ocount=0; + while (my $data=$sth->fetchrow_hashref){ + $count++; + + my $sth2=$dbh->prepare("select * from issues,items where issues.itemnumber= + ? and returndate is NULL + and items.itemnumber=issues.itemnumber and ((items.itemlost <>1 and + items.itemlost <> 2) or items.itemlost is NULL) + and (wthdrawn <> 1 or wthdrawn is NULL)"); + $sth2->execute($data->{'itemnumber'}); + if (my $data2=$sth2->fetchrow_hashref){ + $nacount++; + } else { + if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){ + $lcount++; + } + if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){ + $fcount++; + } + if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){ + $scount++; + } + if ($data->{'itemlost'} eq '1'){ + $lostcount++; + } + if ($data->{'itemlost'} eq '2'){ + $lostcount++; + } + if ($data->{'holdingbranch'} eq 'FM'){ + $mending++; + } + if ($data->{'holdingbranch'} eq 'TR'){ + $transit++; + } + } + $sth2->finish; + } +# if ($count == 0){ + my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?"); + $sth2->execute($bibnum); + if (my $data=$sth2->fetchrow_hashref){ + $ocount=$data->{'quantity'} - $data->{'quantityreceived'}; + } +# $count+=$ocount; + $sth2->finish; + $sth->finish; + return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount); +} + +=item itemcount2 + + $counts = &itemcount2($env, $biblionumber, $type); + +Counts the number of items with the given biblionumber, broken down by +category. + +C<$env> is ignored. + +C<$type> may be either C or anything else. If it is not set to +C, then the search will exclude lost, very overdue, and +withdrawn items. + +C<$&itemcount2> returns a reference-to-hash, with the following fields: + +=over 4 + +=item C + +The total number of items with this biblionumber. + +=item C + +The number of items on order (aqorders.quantity - +aqorders.quantityreceived). + +=item I + +For each branch that has at least one copy of the book, C<$counts> +will have a key with the branch name, giving the number of copies at +that branch. + +=back + +=cut +#' +sub itemcount2 { + my ($env,$bibnum,$type)=@_; + my $dbh = C4::Context->dbh; + my $query="Select * from items,branches where + biblionumber=? and items.holdingbranch=branches.branchcode"; + if ($type ne 'intra'){ + $query.=" and ((itemlost <>1 and itemlost <> 2) or itemlost is NULL) and + (wthdrawn <> 1 or wthdrawn is NULL)"; + } + my $sth=$dbh->prepare($query); + # print $query; + $sth->execute($bibnum); + my %counts; + $counts{'total'}=0; + while (my $data=$sth->fetchrow_hashref){ + $counts{'total'}++; + + my $status; + for my $test ( + [ + 'Item Lost', + 'select * from items + where itemnumber=? + and not ((items.itemlost <>1 and items.itemlost <> 2) + or items.itemlost is NULL)' + ], [ + 'Withdrawn', + 'select * from items + where itemnumber=? and not (wthdrawn <> 1 or wthdrawn is NULL)' + ], [ + 'On Loan', "select * from issues,items + where issues.itemnumber=? and returndate is NULL + and items.itemnumber=issues.itemnumber" + ], + ) { + my($testlabel, $query2) = @$test; + + my $sth2=$dbh->prepare($query2); + $sth2->execute($data->{'itemnumber'}); + + # FIXME - fetchrow_hashref() can fail for any number of reasons + # (e.g., a database server crash). Perhaps use a left join of some + # sort for this? + $status = $testlabel if $sth2->fetchrow_hashref; + $sth2->finish; + last if defined $status; + } + $status = $data->{'branchname'} unless defined $status; + $counts{$status}++; + } + my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=? and + datecancellationprinted is NULL and quantity > quantityreceived"); + $sth2->execute($bibnum); + if (my $data=$sth2->fetchrow_hashref){ + $counts{'order'}=$data->{'quantity'} - $data->{'quantityreceived'}; + } + $sth2->finish; + $sth->finish; + return (\%counts); +} + +=item ItemType + + $description = &ItemType($itemtype); + +Given an item type code, returns the description for that type. + +=cut +#' + +# FIXME - I'm pretty sure that after the initial setup, the list of +# item types doesn't change very often. Hence, it seems slow and +# inefficient to make yet another database call to look up information +# that'll only change every few months or years. +# +# Much better, I think, to automatically build a Perl file that can be +# included in those scripts that require it, e.g.: +# @itemtypes = qw( ART BCD CAS CD F ... ); +# %itemtypedesc = ( +# ART => "Art Prints", +# BCD => "CD-ROM from book", +# CD => "Compact disc (WN)", +# F => "Free Fiction", +# ... +# ); +# The web server can then run a cron job to rebuild this file from the +# database every hour or so. +# +# The same thing goes for branches, book funds, book sellers, currency +# rates, printers, stopwords, and perhaps others. +sub ItemType { + my ($type)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select description from itemtypes where itemtype=?"); + $sth->execute($type); + my $dat=$sth->fetchrow_hashref; + $sth->finish; + return ($dat->{'description'}); +} + +=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 and C tables of the Koha database. In +addition, C 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 and +C. + +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, holdingbranch 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++; + } + $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 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). + +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 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 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 getbranchname + + $branchname = &getbranchname($branchcode); + +Given the branch code, the function returns the corresponding +branch name for a comprehensive information display + +=cut + +sub getbranchname +{ + my ($branchcode) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT branchname FROM branches WHERE branchcode = ?"); + $sth->execute($branchcode); + my $branchname = $sth->fetchrow(); + $sth->finish(); + return $branchname; +} # sub getbranchname + +=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 + + +END { } # module clean-up code here (global destructor) + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=cut -- 2.39.2