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