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