C4/Search.pm

   1 package C4::Search;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it under the
   7 # terms of the GNU General Public License as published by the Free Software
   8 # Foundation; either version 2 of the License, or (at your option) any later
   9 # version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  17 # Suite 330, Boston, MA  02111-1307 USA
  18
  19 use strict;
  20 require Exporter;
  21 use C4::Context;
  22 use C4::Reserves2;
  23 use C4::Biblio;
  24 use Date::Calc;
  25 use Encode;
  26         # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search.
  27         # So Perl complains that all of the functions here get redefined.
  28 use C4::Date;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31
  32 # set the version for version checking
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  34           shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  35
  36 =head1 NAME
  37
  38 C4::Search - Functions for searching the Koha catalog and other databases
  39
  40 =head1 SYNOPSIS
  41
  42   use C4::Search;
  43
  44   my ($count, @results) = catalogsearch4($env, $type, $search, $num, $offset);
  45
  46 =head1 DESCRIPTION
  47
  48 This module provides the searching facilities for the Koha catalog and
  49 ZEBRA databases.
  50
  51
  52
  53 =head1 FUNCTIONS
  54
  55 =over 2
  56
  57 =cut
  58
  59 @ISA = qw(Exporter);
  60 @EXPORT = qw(
  61  &barcodes   &ItemInfo &itemcount
  62  &getcoverPhoto &add_query_line
  63  &FindDuplicate   &ZEBRAsearch_kohafields &sqlsearch &cataloguing_search
  64 &getMARCnotes &getMARCsubjects &getMARCurls &parsefields);
  65 # make all your functions, whether exported or not;
  66
  67 =item
  68 ZEBRAsearchkohafields is the underlying API for searching zebra for KOHA internal use
  69 its kept similar to earlier version Koha Marc searches. instead of passing marc tags to the routine
  70 you pass named kohafields
  71 So you give an array of @kohafieldnames,@values, what relation they have @relations (equal, truncation etc) @and_or and
  72 you receive an array of XML records.
  73 The routine also has a flag $fordisplay and if it is set to 1 it will return the @results as an array of Perl hashes so that your previous
  74 search results templates do actually work.
  75 However more advanced search frontends will be available and this routine can serve as the connecting API for circulation and serials management
  76 See sub FindDuplicates for an example;
  77 =cut
  78
  79
  80
  81
  82 sub ZEBRAsearch_kohafields{
  83 my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom)=@_;
  84 return (0,undef) unless (@$value[0]);
  85 my $server="biblioserver";
  86 my @results;
  87 my $attr;
  88 my $query;
  89
  90
  91 my $i;
  92         for ( $i=0; $i<=$#{$value}; $i++){
  93         last if (@$value[$i] eq "");
  94
  95         my $keyattr=MARCfind_attr_from_kohafield(@$kohafield[$i]) if (@$kohafield[$i]);
  96         if (!$keyattr){$keyattr=" \@attr 1=any";}
  97         @$value[$i]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)/ /g;
  98         $query.=@$relation[$i]." ".$keyattr." \"".@$value[$i]."\" " if @$value[$i];
  99         }
 100         for (my $z= 0;$z<=$#{$and_or};$z++){
 101         $query=@$and_or[$z]." ".$query if (@$value[$z+1] ne "");
 102         }
 103
 104
 105 #warn $query;
 106 my @oConnection;
 107 ($oConnection[0])=C4::Context->Zconn($server);
 108
 109
 110
 111 if ($reorder){
 112 my (@sortpart)=split /,/,$reorder;
 113         if (@sortpart<2){
 114         push @sortpart,1; ##
 115         }
 116 my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]);
 117 my @sortfield=split /@/,$sortattr; ## incase our $sortattr contains type modifiers
 118         $query.=" \@attr 7=".$sortpart[1]." \@".$sortfield[1]." 0";##
 119         $query= "\@or ".$query;
 120 }elsif ($sort){
 121 my (@sortpart)=split /,/,$sort;
 122         if (@sortpart<2){
 123         push @sortpart,1; ## Ascending by default
 124         }
 125 my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]);
 126  my @sortfield=split /@/,$sortattr; ## incase our $sortattr contains type modifiers
 127         $query.=" \@attr 7=".$sortpart[1]." \@".$sortfield[1]." 0";## fix to accept secondary sort as well
 128         $query= "\@or ".$query;
 129 }else{
 130  unless($query=~/4=109/){ ###ranked sort not valid for numeric fields
 131 ##Use Ranked sort
 132 $query="\@attr 2=102 ".$query;
 133 }
 134 }
 135 #warn $query;
 136 my $oResult;
 137
 138 my $tried=0;
 139
 140 my $numresults;
 141
 142 retry:
 143 $oResult= $oConnection[0]->search_pqf($query);
 144 my $i;
 145 my $event;
 146    while (($i = ZOOM::event(\@oConnection)) != 0) {
 147         $event = $oConnection[$i-1]->last_event();
 148         last if $event == ZOOM::Event::ZEND;
 149    }# while
 150
 151          my($error, $errmsg, $addinfo, $diagset) = $oConnection[0]->error_x();
 152         if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
 153                 $tried=$tried+1;
 154                 goto "retry";
 155         }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
 156                 $tried=$tried+1;
 157                 goto "retry";
 158         }elsif ($error){
 159                 warn "Error-$server    /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
 160                 $oResult->destroy();
 161                 $oConnection[0]->destroy();
 162                 return (undef,undef);
 163         }
 164 my $dbh=C4::Context->dbh;
 165  $numresults=$oResult->size() ;
 166
 167    if ($numresults>0){
 168         my $ri=0;
 169         my $z=0;
 170
 171         $ri=$startfrom if $startfrom;
 172                 for ( $ri; $ri<$numresults ; $ri++){
 173                 my $xmlrecord=$oResult->record($ri)->raw();
 174                 $xmlrecord=Encode::decode("utf8",$xmlrecord);
 175                          $xmlrecord=XML_xml2hash($xmlrecord);
 176                         $z++;
 177                         push @results,$xmlrecord;
 178                         last if ($number_of_results &&  $z>=$number_of_results);
 179
 180
 181                 }## for #numresults
 182                         if ($fordisplay){
 183                         my (@parsed)=parsefields($dbh,$searchfrom,@results);
 184                         return ($numresults,@parsed)  ;
 185                         }
 186     }# if numresults
 187
 188 $oResult->destroy();
 189 $oConnection[0]->destroy();
 190 return ($numresults,@results)  ;
 191 #return (0,undef);
 192 }
 193
 194 =item add_bold_fields
 195 After a search the searched keyword is <b>boldened</b> in the displayed search results if it exists in the title or author
 196 It is now depreceated
 197 =cut
 198 sub add_html_bold_fields {
 199         my ($type, $data, $search) = @_;
 200         foreach my $key ('title', 'author') {
 201                 my $new_key;
 202
 203                         $new_key = 'bold_' . $key;
 204                         $data->{$new_key} = $data->{$key};
 205
 206
 207                 my $key1;
 208
 209                         $key1 = $key;
 210
 211
 212                 my @keys;
 213                 my $i = 1;
 214                 if ($type eq 'keyword') {
 215                 my $newkey=$search->{'keyword'};
 216                 $newkey=~s /\++//g;
 217                 @keys = split " ", $newkey;
 218                 }
 219                 my $count = @keys;
 220                 for ($i = 0; $i < $count ; $i++) {
 221
 222                                 if (($data->{$new_key} =~ /($keys[$i])/i) && (lc($keys[$i]) ne 'b') ) {
 223                                         my $word = $1;
 224                                         $data->{$new_key} =~ s/$word/<b>$word<\/b>/;
 225                                 }
 226
 227                 }
 228         }
 229
 230
 231 }
 232  sub sqlsearch{
 233 ## This searches the SQL database only for biblionumber,itemnumber,barcode
 234 ### Not very useful on production but as a debug tool useful during system maturing for ZEBRA operations
 235
 236 my ($dbh,$search)=@_;
 237 my $sth;
 238 if ($search->{'barcode'} ne '') {
 239         $sth=$dbh->prepare("SELECT biblionumber from items  where  barcode=?");
 240         $sth->execute($search->{'barcode'});
 241 }elsif ($search->{'itemnumber'} ne '') {
 242         $sth=$dbh->prepare("SELECT biblionumber from items  where itemnumber=?");
 243         $sth->execute($search->{'itemnumber'});
 244 }elsif ($search->{'biblionumber'} ne '') {
 245         $sth=$dbh->prepare("SELECT biblionumber from biblio where biblionumber=?");
 246         $sth->execute($search->{'biblionumber'});
 247 }else{
 248 return (undef,undef);
 249 }
 250
 251  my $result=$sth->fetchrow_hashref;
 252 return (1,$result) if $result;
 253 }
 254
 255 sub cataloguing_search{
 256 ## This is an SQL based search designed to be used when adding a new biblio incase library sets
 257 ## preference zebraorsql to sql when adding a new biblio
 258 my ($search,$num,$offset) = @_;
 259         my ($count,@results);
 260 my $dbh=C4::Context->dbh;
 261 #Prepare search
 262 my $query;
 263 my $condition="select SQL_CALC_FOUND_ROWS marcxml from biblio where ";
 264 if ($search->{'isbn'} ne''){
 265 $search->{'isbn'}=$search->{'isbn'}."%";
 266 $query=$search->{'isbn'};
 267 $condition.= "  isbn like ?  ";
 268 }else{
 269 return (0,undef) unless $search->{title};
 270 $query=$search->{'title'};
 271 $condition.= "  MATCH (title) AGAINST(? in BOOLEAN MODE )  ";
 272 }
 273 my $sth=$dbh->prepare($condition);
 274 $sth->execute($query);
 275  my $nbresult=$dbh->prepare("SELECT FOUND_ROWS()");
 276  $nbresult->execute;
 277  my $count=$nbresult->fetchrow;
 278 my $limit = $num + $offset;
 279 my $startfrom = $offset;
 280 my $i=0;
 281 my @results;
 282 while (my $marc=$sth->fetchrow){
 283         if (($i >= $startfrom) && ($i < $limit)) {
 284         my $record=XML_xml2hash_onerecord($marc);
 285         my $data=XMLmarc2koha_onerecord($dbh,$record,"biblios");
 286         push @results,$data;
 287         }
 288 $i++;
 289 last if $i==$limit;
 290 }
 291 return ($count,@results);
 292 }
 293
 294
 295
 296 sub FindDuplicate {
 297         my ($xml)=@_;
 298 my $dbh=C4::Context->dbh;
 299         my ($result) = XMLmarc2koha_onerecord($dbh,$xml,"biblios");
 300         my @kohafield;
 301         my @value;
 302         my @relation;
 303         my  @and_or;
 304
 305         # search duplicate on ISBN, easy and fast..
 306
 307         if ($result->{isbn}) {
 308         push @kohafield,"isbn";
 309 ###Temporary fix for ISBN
 310 my $isbn=$result->{isbn};
 311 $isbn=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|\'|,|\-|\"|\*|\(|\)|\[|\]|\{|\}|\/)//g;
 312                 push @value,$isbn;
 313                         }else{
 314 $result->{title}=~s /\\//g;
 315 $result->{title}=~s /\"//g;
 316 $result->{title}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\-|\(|\)|\[|\]|\{|\}|\/)/ /g;
 317
 318         push @kohafield,"title";
 319         push @value,$result->{title};
 320         push @relation,"\@attr 6=3 \@attr 4=1 \@attr 5=1"; ## right truncated,phrase,whole field
 321
 322         }
 323         my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value,\@relation,"",\@and_or,0,"",0,1);
 324 if ($total){
 325 my $title=XML_readline($result[0],"title","biblios") ;
 326 my $biblionumber=XML_readline($result[0],"biblionumber","biblios") ;
 327                 return $biblionumber,$title ;
 328 }
 329
 330 }
 331
 332
 333 sub add_query_line {
 334
 335         my ($type,$search,$results)=@_;
 336         my $dbh = C4::Context->dbh;
 337         my $searchdesc = '';
 338         my $from;
 339         my $borrowernumber = $search->{'borrowernumber'};
 340         my $remote_IP = $search->{'remote_IP'};
 341         my $remote_URL= $search->{'remote_URL'};
 342         my $searchdesc = $search->{'searchdesc'};
 343
 344 my $sth = $dbh->prepare("INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip,user,actual) VALUES(?,?,?,?,?)");
 345
 346
 347 $sth->execute($searchdesc,$results,$remote_IP,$borrowernumber,$remote_URL);
 348 $sth->finish;
 349
 350 }
 351
 352
 353 =item ItemInfo
 354
 355   @results = &ItemInfo($env, $biblionumber, $type);
 356
 357 Returns information about books with the given biblionumber.
 358
 359 C<$type> may be either C<intra> or anything else. If it is not set to
 360 C<intra>, then the search will exclude lost, very overdue, and
 361 withdrawn items.
 362
 363 C<$env> is ignored.
 364
 365 C<&ItemInfo> returns a list of references-to-hash. Each element
 366 contains a number of keys. Most of them are table items from the
 367 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 368 Koha database. Other keys include:
 369
 370 =over 4
 371
 372 =item C<$data-E<gt>{branchname}>
 373
 374 The name (not the code) of the branch to which the book belongs.
 375
 376 =item C<$data-E<gt>{datelastseen}>
 377
 378 This is simply C<items.datelastseen>, except that while the date is
 379 stored in YYYY-MM-DD format in the database, here it is converted to
 380 DD/MM/YYYY format. A NULL date is returned as C<//>.
 381
 382 =item C<$data-E<gt>{datedue}>
 383
 384 =item C<$data-E<gt>{class}>
 385
 386 This is the concatenation of C<biblioitems.classification>, the book's
 387 Dewey code, and C<biblioitems.subclass>.
 388
 389 =item C<$data-E<gt>{ocount}>
 390
 391 I think this is the number of copies of the book available.
 392
 393 =item C<$data-E<gt>{order}>
 394
 395 If this is set, it is set to C<One Order>.
 396
 397 =back
 398
 399 =cut
 400 #'
 401 sub ItemInfo {
 402         my ($dbh,$data) = @_;
 403         my $i=0;
 404         my @results;
 405 my ($date_due, $count_reserves);
 406                 my $datedue = '';
 407                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
 408                 $isth->execute($data->{'itemnumber'});
 409                 if (my $idata=$isth->fetchrow_hashref){
 410                 $data->{borrowernumber} = $idata->{borrowernumber};
 411                 $data->{cardnumber} = $idata->{cardnumber};
 412                 $datedue = format_date($idata->{'date_due'});
 413                 }
 414                 if ($datedue eq '' || $datedue eq "0000-00-00"){
 415                 $datedue="";
 416                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
 417                         if ($restype) {
 418                                 $count_reserves = $restype;
 419                         }
 420                 }
 421                 $isth->finish;
 422         #get branch information.....
 423                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 424                 $bsth->execute($data->{'holdingbranch'});
 425                 if (my $bdata=$bsth->fetchrow_hashref){
 426                         $data->{'branchname'} = $bdata->{'branchname'};
 427                 }
 428                 my $date=substr($data->{'datelastseen'},0,8);
 429                 $data->{'datelastseen'}=format_date($date);
 430                 $data->{'datedue'}=$datedue;
 431                 $data->{'count_reserves'} = $count_reserves;
 432         # get notforloan complete status if applicable
 433                 my ($tagfield,$tagsub)=MARCfind_marc_from_kohafield("notforloan","holdings");
 434                 my $sthnflstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsub'");
 435                 $sthnflstatus->execute;
 436                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 437                 if ($authorised_valuecode) {
 438                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
 439                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
 440                         my ($lib) = $sthnflstatus->fetchrow;
 441                         $data->{notforloan} = $lib;
 442                 }
 443
 444 # my shelf procedures
 445                 my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
 446
 447                 my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
 448 $shelfstatus->execute;
 449                 $authorised_valuecode = $shelfstatus->fetchrow;
 450                 if ($authorised_valuecode) {
 451                         $shelfstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
 452                         $shelfstatus->execute($authorised_valuecode,$data->{shelf});
 453
 454                         my ($lib) = $shelfstatus->fetchrow;
 455                         $data->{shelf} = $lib;
 456                 }
 457
 458
 459
 460         return($data);
 461 }
 462
 463
 464
 465
 466
 467 =item barcodes
 468
 469   @barcodes = &barcodes($biblioitemnumber);
 470
 471 Given a biblioitemnumber, looks up the corresponding items.
 472
 473 Returns an array of references-to-hash; the keys are C<barcode> and
 474 C<itemlost>.
 475
 476 The returned items include very overdue items, but not lost ones.
 477
 478 =cut
 479 #'
 480 sub barcodes{
 481     #called from request.pl
 482     my ($biblionumber)=@_;
 483 #warn $biblionumber;
 484     my $dbh = C4::Context->dbh;
 485         my @kohafields;
 486         my @values;
 487         my @relations;
 488         my $sort;
 489         my @and_or;
 490         my @fields;
 491         push @kohafields, "biblionumber";
 492         push @values,$biblionumber;
 493         push @relations, " "," \@attr 2=1"; ## selecting wthdrawn less then 1
 494         push @and_or, "\@and";
 495                 $sort="";
 496         my ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,"","");
 497 push  @fields,"barcode","itemlost","itemnumber","date_due","wthdrawn","notforloan";
 498         my ($biblio,@items)=XMLmarc2koha($dbh,$results[0],"holdings", @fields);
 499 return(@items);
 500 }
 501
 502
 503
 504
 505
 506 sub getMARCnotes {
 507 ##Requires a MARCXML as $record
 508         my ($dbh, $record, $marcflavour) = @_;
 509
 510         my ($mintag, $maxtag);
 511         if ($marcflavour eq "MARC21") {
 512                 $mintag = "500";
 513                 $maxtag = "599";
 514         } else {           # assume unimarc if not marc21
 515                 $mintag = "300";
 516                 $maxtag = "399";
 517         }
 518         my @marcnotes;
 519         foreach my $field ($mintag..$maxtag) {
 520         my @value=XML_readline_asarray($record,"","",$field,"");
 521         push @marcnotes, \@value;
 522         }
 523
 524
 525
 526         my $marcnotesarray=\@marcnotes;
 527         return $marcnotesarray;
 528 }  # end getMARCnotes
 529
 530
 531 sub getMARCsubjects {
 532
 533     my ($dbh, $record, $marcflavour) = @_;
 534         my ($mintag, $maxtag);
 535         if ($marcflavour eq "MARC21") {
 536                 $mintag = "600";
 537                 $maxtag = "699";
 538         } else {           # assume unimarc if not marc21
 539                 $mintag = "600";
 540                 $maxtag = "619";
 541         }
 542         my @marcsubjcts;
 543         my $subjct = "";
 544         my $subfield = "";
 545         my $marcsubjct;
 546
 547         foreach my $field ($mintag..$maxtag) {
 548                 my @value =XML_readline_asarray($record,"","",$field,"a");
 549                         foreach my $subject (@value){
 550                         $marcsubjct = {MARCSUBJCT => $subject,};
 551                         push @marcsubjcts, $marcsubjct;
 552                         }
 553
 554         }
 555         my $marcsubjctsarray=\@marcsubjcts;
 556         return $marcsubjctsarray;
 557 }  #end getMARCsubjects
 558
 559
 560 sub getMARCurls {
 561 ### This code is wrong only works with MARC21
 562     my ($dbh, $record, $marcflavour) = @_;
 563         my ($mintag, $maxtag);
 564         if ($marcflavour eq "MARC21") {
 565                 $mintag = "856";
 566                 $maxtag = "856";
 567         } else {           # assume unimarc if not marc21
 568                 $mintag = "600";
 569                 $maxtag = "619";
 570         }
 571
 572         my @marcurls;
 573         my $url = "";
 574         my $subfil = "";
 575         my $marcurl;
 576         my $value;
 577         foreach my $field ($mintag..$maxtag) {
 578                 my @value =XML_readline_asarray($record,"","",$field,"a");
 579                         foreach my $url (@value){
 580                                 if ( $value ne $url) {
 581                                  $marcurl = {MARCURL => $url,};
 582                                 push @marcurls, $marcurl;
 583                                  $value=$url;
 584                                 }
 585                         }
 586         }
 587
 588
 589         my $marcurlsarray=\@marcurls;
 590         return $marcurlsarray;
 591 }  #end getMARCurls
 592
 593
 594
 595 sub parsefields{
 596 #pass this a  MARC record and it will parse it for display purposes
 597 my ($dbh,$intranet,@marcrecords)=@_;
 598 my @results;
 599 my @items;
 600 my $retrieve_from=C4::Context->preference('retrieve_from');
 601 #Build brancnames hash  for displaying in OPAC - more user friendly
 602 #find branchname
 603 #get branch information.....
 604 my %branches;
 605                 my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches");
 606                 $bsth->execute();
 607                 while (my $bdata=$bsth->fetchrow_hashref){
 608                         $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'};
 609                 }
 610
 611 #Building shelving hash if library has shelves defined like junior section, non-fiction, audio-visual room etc
 612 my %shelves;
 613 #find shelvingname
 614 my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
 615 my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
 616                 $shelfstatus->execute;
 617                 my ($authorised_valuecode) = $shelfstatus->fetchrow;
 618                 if ($authorised_valuecode) {
 619                         $shelfstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? ");
 620                         $shelfstatus->execute($authorised_valuecode);
 621                         while (my $lib = $shelfstatus->fetchrow_hashref){
 622                         $shelves{$lib->{'authorised_value'}} = $lib->{'lib'};
 623                         }
 624                 }
 625 my $even=1;
 626 foreach my $xml(@marcrecords){
 627 #my $xml=XML_xml2hash($xmlrecord);
 628 my @kohafields; ## just name those necessary for the result page
 629 push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn";
 630 my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields);
 631 my $bibliorecord;
 632
 633 my %counts;
 634
 635 $counts{'total'}=0;
 636 my $noitems    = 1;
 637 my $norequests = 1;
 638                 ##Loop for each item field
 639
 640                         foreach my $item (@itemrecords) {
 641                                 $norequests = 0 unless $item->{'itemnotforloan'};
 642                                 $noitems = 0;
 643                                 my $status;
 644                                 #renaming some fields according to templates
 645                                 $item->{'branchname'}=$branches{$item->{'holdingbranch'}};
 646                                 $item->{'shelves'}=$shelves{$item->{'shelf'}};
 647                                 $status="Lost" if ($item->{'itemlost'}>0);
 648                                 $status="Withdrawn" if ($item->{'wthdrawn'}>0);
 649                                 if ($intranet eq "intranet"){ ## we give full itemcallnumber detail in intranet
 650                                 $status="Due:".format_date($item->{'date_due'}) if ($item->{'date_due'} gt "0000-00-00");
 651                                 $status = $item->{'holdingbranch'}."-".$item->{'shelf'}."[".$item->{'itemcallnumber'}."]" unless defined $status;
 652                                 }else{
 653                                 $status="On Loan" if ($item->{'date_due'} gt "0000-00-00");
 654                                   $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status;
 655                                 }
 656
 657                                 $counts{$status}++;
 658                                 $counts{'total'}++;
 659                         }
 660                 $oldbiblio->{'noitems'} = $noitems;
 661                 $oldbiblio->{'norequests'} = $norequests;
 662                 $oldbiblio->{'even'} = $even;
 663                 $even= not $even;
 664                         if ($even){
 665                         $oldbiblio->{'toggle'}="#ffffcc";
 666                         } else {
 667                         $oldbiblio->{'toggle'}="white";
 668                         } ; ## some forms seems to use toggle
 669
 670                 $oldbiblio->{'itemcount'} = $counts{'total'};
 671                 my $totalitemcounts = 0;
 672                 foreach my $key (keys %counts){
 673                         if ($key ne 'total'){
 674                                 $totalitemcounts+= $counts{$key};
 675                                 $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
 676
 677                         }
 678                 }
 679                 my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
 680                 foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
 681
 682                         if ($_ eq 'notavailable') {
 683                                 $notavailabletext="Not available";
 684                                 my $c=$oldbiblio->{'locationhash'}->{$_};
 685                                 $oldbiblio->{'not-available-p'}=$c;
 686                         } else {
 687                                 $locationtext.="$_";
 688                                 my $c=$oldbiblio->{'locationhash'}->{$_};
 689                                 if ($_ eq 'Lost') {
 690                                         $oldbiblio->{'lost-p'} = $c;
 691                                 } elsif ($_ eq 'Withdrawn') {
 692                                         $oldbiblio->{'withdrawn-p'} = $c;
 693                                 } elsif ($_  =~/\^Due:/) {
 694
 695                                         $oldbiblio->{'on-loan-p'} = $c;
 696                                 } else {
 697                                         $locationtextonly.= $_;
 698                                         $locationtextonly.= " ($c)<br> " if $totalitemcounts > 1;
 699                                 }
 700                                 if ($totalitemcounts>1) {
 701                                         $locationtext.=" ($c)<br> ";
 702                                 }
 703                         }
 704                 }
 705                 if ($notavailabletext) {
 706                         $locationtext.= $notavailabletext;
 707                 } else {
 708                         $locationtext=~s/, $//;
 709                 }
 710                 $oldbiblio->{'location'} = $locationtext;
 711                 $oldbiblio->{'location-only'} = $locationtextonly;
 712                 $oldbiblio->{'use-location-flags-p'} = 1;
 713         push @results,$oldbiblio;
 714
 715 }## For each record received
 716         return(@results);
 717 }
 718
 719 sub getcoverPhoto {
 720 ## return the address of a cover image if defined otherwise the amazon cover images
 721         my $record =shift  ;
 722
 723         my $image=XML_readline_onerecord($record,"coverphoto","biblios");
 724         if ($image){
 725         return $image;
 726         }
 727 # if there is no image put the amazon cover image adress
 728
 729 my $isbn=XML_readline_onerecord($record,"isbn","biblios");
 730 return "http://images.amazon.com/images/P/".$isbn.".01.MZZZZZZZ.jpg";
 731 }
 732
 733 =item itemcount
 734
 735   ($count, $lcount, $nacount, $fcount, $scount, $lostcount,
 736   $mending, $transit,$ocount) =
 737     &itemcount($env, $biblionumber, $type);
 738
 739 Counts the number of items with the given biblionumber, broken down by
 740 category.
 741
 742 C<$env> is ignored.
 743
 744 If C<$type> is not set to C<intra>, lost, very overdue, and withdrawn
 745 items will not be counted.
 746
 747 C<&itemcount> returns a nine-element list:
 748
 749 C<$count> is the total number of items with the given biblionumber.
 750
 751 C<$lcount> is the number of items at the Levin branch.
 752
 753 C<$nacount> is the number of items that are neither borrowed, lost,
 754 nor withdrawn (and are therefore presumably on a shelf somewhere).
 755
 756 C<$fcount> is the number of items at the Foxton branch.
 757
 758 C<$scount> is the number of items at the Shannon branch.
 759
 760 C<$lostcount> is the number of lost and very overdue items.
 761
 762 C<$mending> is the number of items at the Mending branch (being
 763 mended?).
 764
 765 C<$transit> is the number of items at the Transit branch (in transit
 766 between branches?).
 767
 768 C<$ocount> is the number of items that haven't arrived yet
 769 (aqorders.quantity - aqorders.quantityreceived).
 770
 771 =cut
 772 #'
 773
 774
 775
 776 sub itemcount {
 777   my ($env,$bibnum,$type)=@_;
 778   my $dbh = C4::Context->dbh;
 779 my @kohafield;
 780 my @value;
 781 my @relation;
 782 my @and_or;
 783 my $sort;
 784   my $query="Select * from items where
 785   biblionumber=? ";
 786 push @kohafield,"biblionumber";
 787 push @value,$bibnum;
 788
 789 my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value, \@relation,"", \@and_or, 0);## there is only one record no need for $num or $offset
 790 my @fields;## extract only the fields required
 791 push @fields,"itemnumber","itemlost","wthdrawn","holdingbranch","date_due";
 792 my ($biblio,@items)=XMLmarc2koha ($dbh,$result[0],"holdings",\@fields);
 793   my $count=0;
 794   my $lcount=0;
 795   my $nacount=0;
 796   my $fcount=0;
 797   my $scount=0;
 798   my $lostcount=0;
 799   my $mending=0;
 800   my $transit=0;
 801   my $ocount=0;
 802  foreach my $data(@items){
 803     if ($type ne "intra"){
 804   next if ($data->{itemlost} || $data->{wthdrawn});
 805     }  ## Probably trying to hide lost item from opac ?
 806     $count++;
 807
 808 ## Now it seems we want to find those which are onloan
 809
 810
 811     if ( $data->{date_due} gt "0000-00-00"){
 812        $nacount++;
 813         next;
 814     }
 815 ### The rest of this code is hardcoded for Foxtrot Shanon etc. We urgently need a global understanding of these terms--TG
 816       if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){
 817         $lcount++;
 818       }
 819       if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){
 820         $fcount++;
 821       }
 822       if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){
 823         $scount++;
 824       }
 825       if ($data->{'itemlost'} eq '1'){
 826         $lostcount++;
 827       }
 828       if ($data->{'itemlost'} eq '2'){
 829         $lostcount++;
 830       }
 831       if ($data->{'holdingbranch'} eq 'FM'){
 832         $mending++;
 833       }
 834       if ($data->{'holdingbranch'} eq 'TR'){
 835         $transit++;
 836       }
 837
 838   }
 839 #  if ($count == 0){
 840     my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?");
 841     $sth2->execute($bibnum);
 842     if (my $data=$sth2->fetchrow_hashref){
 843       $ocount=$data->{'quantity'} - $data->{'quantityreceived'};
 844     }
 845 #    $count+=$ocount;
 846
 847   return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount);
 848 }
 849
 850 END { }       # module clean-up code here (global destructor)
 851
 852 1;
 853 __END__
 854
 855 =back
 856
 857 =head1 AUTHOR
 858
 859 Koha Developement team <info@koha.org>
 860 # New functions to comply with ZEBRA search and new KOHA 3 API added 2006 Tumer Garip tgarip@neu.edu.tr
 861
 862 =cut