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                         #if (!$fordisplay){
 176                         ### Turn into hash of xml
 177                          $xmlrecord=XML_xml2hash($xmlrecord);
 178                         ##}
 179                         $z++;
 180                         push @results,$xmlrecord;
 181                         last if ($number_of_results &&  $z>=$number_of_results);
 182
 183
 184                 }## for #numresults
 185                         if ($fordisplay){
 186                         my (@parsed)=parsefields($dbh,$searchfrom,@results);
 187                         return ($numresults,@parsed)  ;
 188                         }
 189     }# if numresults
 190
 191 $oResult->destroy();
 192 $oConnection[0]->destroy();
 193 return ($numresults,@results)  ;
 194 #return (0,undef);
 195 }
 196
 197 =item add_bold_fields
 198 After a search the searched keyword is <b>boldened</b> in the displayed search results if it exists in the title or author
 199 It is now depreceated
 200 =cut
 201 sub add_html_bold_fields {
 202         my ($type, $data, $search) = @_;
 203         foreach my $key ('title', 'author') {
 204                 my $new_key;
 205
 206                         $new_key = 'bold_' . $key;
 207                         $data->{$new_key} = $data->{$key};
 208
 209
 210                 my $key1;
 211
 212                         $key1 = $key;
 213
 214
 215                 my @keys;
 216                 my $i = 1;
 217                 if ($type eq 'keyword') {
 218                 my $newkey=$search->{'keyword'};
 219                 $newkey=~s /\++//g;
 220                 @keys = split " ", $newkey;
 221                 }
 222                 my $count = @keys;
 223                 for ($i = 0; $i < $count ; $i++) {
 224
 225                                 if (($data->{$new_key} =~ /($keys[$i])/i) && (lc($keys[$i]) ne 'b') ) {
 226                                         my $word = $1;
 227                                         $data->{$new_key} =~ s/$word/<b>$word<\/b>/;
 228                                 }
 229
 230                 }
 231         }
 232
 233
 234 }
 235  sub sqlsearch{
 236 ## This searches the SQL database only for biblionumber,itemnumber,barcode
 237 ### Not very useful on production but as a debug tool useful during system maturing for ZEBRA operations
 238
 239 my ($dbh,$search)=@_;
 240 my $sth;
 241 if ($search->{'barcode'} ne '') {
 242         $sth=$dbh->prepare("SELECT biblionumber from items  where  barcode=?");
 243         $sth->execute($search->{'barcode'});
 244 }elsif ($search->{'itemnumber'} ne '') {
 245         $sth=$dbh->prepare("SELECT biblionumber from items  where itemnumber=?");
 246         $sth->execute($search->{'itemnumber'});
 247 }elsif ($search->{'biblionumber'} ne '') {
 248         $sth=$dbh->prepare("SELECT biblionumber from biblio where biblionumber=?");
 249         $sth->execute($search->{'biblionumber'});
 250 }else{
 251 return (undef,undef);
 252 }
 253
 254  my $result=$sth->fetchrow_hashref;
 255 return (1,$result) if $result;
 256 }
 257
 258 sub cataloguing_search{
 259 ## This is an SQL based search designed to be used when adding a new biblio incase library sets
 260 ## preference zebraorsql to sql when adding a new biblio
 261 my ($search,$num,$offset) = @_;
 262         my ($count,@results);
 263 my $dbh=C4::Context->dbh;
 264 #Prepare search
 265 my $query;
 266 my $condition="select SQL_CALC_FOUND_ROWS marcxml from biblio where ";
 267 if ($search->{'isbn'} ne''){
 268 $search->{'isbn'}=$search->{'isbn'}."%";
 269 $query=$search->{'isbn'};
 270 $condition.= "  isbn like ?  ";
 271 }else{
 272 return (0,undef) unless $search->{title};
 273 $query=$search->{'title'};
 274 $condition.= "  MATCH (title) AGAINST(? in BOOLEAN MODE )  ";
 275 }
 276 my $sth=$dbh->prepare($condition);
 277 $sth->execute($query);
 278  my $nbresult=$dbh->prepare("SELECT FOUND_ROWS()");
 279  $nbresult->execute;
 280  my $count=$nbresult->fetchrow;
 281 my $limit = $num + $offset;
 282 my $startfrom = $offset;
 283 my $i=0;
 284 my @results;
 285 while (my $marc=$sth->fetchrow){
 286         if (($i >= $startfrom) && ($i < $limit)) {
 287         my $record=XML_xml2hash_onerecord($marc);
 288         my $data=XMLmarc2koha_onerecord($dbh,$record,"biblios");
 289         push @results,$data;
 290         }
 291 $i++;
 292 last if $i==$limit;
 293 }
 294 return ($count,@results);
 295 }
 296
 297
 298
 299 sub FindDuplicate {
 300         my ($xml)=@_;
 301 my $dbh=C4::Context->dbh;
 302         my ($result) = XMLmarc2koha_onerecord($dbh,$xml,"biblios");
 303         my @kohafield;
 304         my @value;
 305         my @relation;
 306         my  @and_or;
 307
 308         # search duplicate on ISBN, easy and fast..
 309
 310         if ($result->{isbn}) {
 311         push @kohafield,"isbn";
 312 ###Temporary fix for ISBN
 313 my $isbn=$result->{isbn};
 314 $isbn=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|\'|,|\-|\"|\*|\(|\)|\[|\]|\{|\}|\/)//g;
 315                 push @value,$isbn;
 316                         }else{
 317 $result->{title}=~s /\\//g;
 318 $result->{title}=~s /\"//g;
 319 $result->{title}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\-|\(|\)|\[|\]|\{|\}|\/)/ /g;
 320
 321         push @kohafield,"title";
 322         push @value,$result->{title};
 323         push @relation,"\@attr 6=3 \@attr 4=1 \@attr 5=1"; ## right truncated,phrase,whole field
 324
 325         }
 326         my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value,\@relation,"",\@and_or,0,"",0,1);
 327 if ($total){
 328 my $title=XML_readline($result[0],"title","biblios") ;
 329 my $biblionumber=XML_readline($result[0],"biblionumber","biblios") ;
 330                 return $biblionumber,$title ;
 331 }
 332
 333 }
 334
 335
 336 sub add_query_line {
 337
 338         my ($type,$search,$results)=@_;
 339         my $dbh = C4::Context->dbh;
 340         my $searchdesc = '';
 341         my $from;
 342         my $borrowernumber = $search->{'borrowernumber'};
 343         my $remote_IP = $search->{'remote_IP'};
 344         my $remote_URL= $search->{'remote_URL'};
 345         my $searchdesc = $search->{'searchdesc'};
 346
 347 my $sth = $dbh->prepare("INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip,user,actual) VALUES(?,?,?,?,?)");
 348
 349
 350 $sth->execute($searchdesc,$results,$remote_IP,$borrowernumber,$remote_URL);
 351 $sth->finish;
 352
 353 }
 354
 355
 356 =item ItemInfo
 357
 358   @results = &ItemInfo($env, $biblionumber, $type);
 359
 360 Returns information about books with the given biblionumber.
 361
 362 C<$type> may be either C<intra> or anything else. If it is not set to
 363 C<intra>, then the search will exclude lost, very overdue, and
 364 withdrawn items.
 365
 366 C<$env> is ignored.
 367
 368 C<&ItemInfo> returns a list of references-to-hash. Each element
 369 contains a number of keys. Most of them are table items from the
 370 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 371 Koha database. Other keys include:
 372
 373 =over 4
 374
 375 =item C<$data-E<gt>{branchname}>
 376
 377 The name (not the code) of the branch to which the book belongs.
 378
 379 =item C<$data-E<gt>{datelastseen}>
 380
 381 This is simply C<items.datelastseen>, except that while the date is
 382 stored in YYYY-MM-DD format in the database, here it is converted to
 383 DD/MM/YYYY format. A NULL date is returned as C<//>.
 384
 385 =item C<$data-E<gt>{datedue}>
 386
 387 =item C<$data-E<gt>{class}>
 388
 389 This is the concatenation of C<biblioitems.classification>, the book's
 390 Dewey code, and C<biblioitems.subclass>.
 391
 392 =item C<$data-E<gt>{ocount}>
 393
 394 I think this is the number of copies of the book available.
 395
 396 =item C<$data-E<gt>{order}>
 397
 398 If this is set, it is set to C<One Order>.
 399
 400 =back
 401
 402 =cut
 403 #'
 404 sub ItemInfo {
 405         my ($dbh,$data) = @_;
 406         my $i=0;
 407         my @results;
 408 my ($date_due, $count_reserves);
 409                 my $datedue = '';
 410                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
 411                 $isth->execute($data->{'itemnumber'});
 412                 if (my $idata=$isth->fetchrow_hashref){
 413                 $data->{borrowernumber} = $idata->{borrowernumber};
 414                 $data->{cardnumber} = $idata->{cardnumber};
 415                 $datedue = format_date($idata->{'date_due'});
 416                 }
 417                 if ($datedue eq '' || $datedue eq "0000-00-00"){
 418                 $datedue="";
 419                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
 420                         if ($restype) {
 421                                 $count_reserves = $restype;
 422                         }
 423                 }
 424                 $isth->finish;
 425         #get branch information.....
 426                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
 427                 $bsth->execute($data->{'holdingbranch'});
 428                 if (my $bdata=$bsth->fetchrow_hashref){
 429                         $data->{'branchname'} = $bdata->{'branchname'};
 430                 }
 431                 my $date=substr($data->{'datelastseen'},0,8);
 432                 $data->{'datelastseen'}=format_date($date);
 433                 $data->{'datedue'}=$datedue;
 434                 $data->{'count_reserves'} = $count_reserves;
 435         # get notforloan complete status if applicable
 436                 my ($tagfield,$tagsub)=MARCfind_marc_from_kohafield("notforloan","holdings");
 437                 my $sthnflstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsub'");
 438                 $sthnflstatus->execute;
 439                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 440                 if ($authorised_valuecode) {
 441                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
 442                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
 443                         my ($lib) = $sthnflstatus->fetchrow;
 444                         $data->{notforloan} = $lib;
 445                 }
 446
 447 # my shelf procedures
 448                 my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
 449
 450                 my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
 451 $shelfstatus->execute;
 452                 $authorised_valuecode = $shelfstatus->fetchrow;
 453                 if ($authorised_valuecode) {
 454                         $shelfstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
 455                         $shelfstatus->execute($authorised_valuecode,$data->{shelf});
 456
 457                         my ($lib) = $shelfstatus->fetchrow;
 458                         $data->{shelf} = $lib;
 459                 }
 460
 461
 462
 463         return($data);
 464 }
 465
 466
 467
 468
 469
 470 =item barcodes
 471
 472   @barcodes = &barcodes($biblioitemnumber);
 473
 474 Given a biblioitemnumber, looks up the corresponding items.
 475
 476 Returns an array of references-to-hash; the keys are C<barcode> and
 477 C<itemlost>.
 478
 479 The returned items include very overdue items, but not lost ones.
 480
 481 =cut
 482 #'
 483 sub barcodes{
 484     #called from request.pl
 485     my ($biblionumber)=@_;
 486 #warn $biblionumber;
 487     my $dbh = C4::Context->dbh;
 488         my @kohafields;
 489         my @values;
 490         my @relations;
 491         my $sort;
 492         my @and_or;
 493         my @fields;
 494         push @kohafields, "biblionumber";
 495         push @values,$biblionumber;
 496         push @relations, " "," \@attr 2=1"; ## selecting wthdrawn less then 1
 497         push @and_or, "\@and";
 498                 $sort="";
 499         my ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,"","");
 500 push  @fields,"barcode","itemlost","itemnumber","date_due","wthdrawn","notforloan";
 501         my ($biblio,@items)=XMLmarc2koha($dbh,$results[0],"holdings", @fields);
 502 return(@items);
 503 }
 504
 505 sub XML_repeated_read{
 506 my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
 507 #$xml represents one record of MARCXML as perlhashed
 508 ## returns an array of read fields--useful for readind repeated fields
 509 ### $recordtype is needed for mapping the correct field if supplied
 510 my @value;
 511  ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
 512 if ($tag){
 513 my $biblio=$xml->{'datafield'};
 514 my $controlfields=$xml->{'controlfield'};
 515 my $leader=$xml->{'leader'};
 516  if ($tag>9){
 517         foreach my $data (@$biblio){
 518             if ($data->{'tag'} eq $tag){
 519                 foreach my $subfield ( $data->{'subfield'}){
 520                     foreach my $code ( @$subfield){
 521                         if ($code->{'code'} eq $subf || !$subf){
 522                         push @value, $code->{'content'};
 523                         }
 524                    }
 525                 }
 526            }
 527         }
 528   }else{
 529         if ($tag eq "000" || $tag eq "LDR"){
 530                 push @value,  $leader->[0] if $leader->[0];
 531         }else{
 532              foreach my $control (@$controlfields){
 533                 if ($control->{'tag'} eq $tag){
 534                 push @value,    $control->{'content'} if $control->{'content'};
 535
 536                 }
 537             }
 538         }
 539    }##tag
 540 return @value;
 541 }## if tag is mapped
 542 return "";
 543 }
 544
 545
 546
 547 sub getMARCnotes {
 548 ##Requires a MARCXML as $record
 549         my ($dbh, $record, $marcflavour) = @_;
 550
 551         my ($mintag, $maxtag);
 552         if ($marcflavour eq "MARC21") {
 553                 $mintag = "500";
 554                 $maxtag = "599";
 555         } else {           # assume unimarc if not marc21
 556                 $mintag = "300";
 557                 $maxtag = "399";
 558         }
 559         my @marcnotes;
 560         foreach my $field ($mintag..$maxtag) {
 561         my @value=XML_repeated_read($record,"","",$field,"");
 562         push @marcnotes, \@value;
 563         }
 564
 565
 566
 567         my $marcnotesarray=\@marcnotes;
 568         return $marcnotesarray;
 569 }  # end getMARCnotes
 570
 571
 572 sub getMARCsubjects {
 573
 574     my ($dbh, $record, $marcflavour) = @_;
 575         my ($mintag, $maxtag);
 576         if ($marcflavour eq "MARC21") {
 577                 $mintag = "600";
 578                 $maxtag = "699";
 579         } else {           # assume unimarc if not marc21
 580                 $mintag = "600";
 581                 $maxtag = "619";
 582         }
 583         my @marcsubjcts;
 584         my $subjct = "";
 585         my $subfield = "";
 586         my $marcsubjct;
 587
 588         foreach my $field ($mintag..$maxtag) {
 589                 my @value =XML_repeated_read($record,"","",$field,"a");
 590                         foreach my $subject (@value){
 591                         $marcsubjct = {MARCSUBJCT => $subject,};
 592                         push @marcsubjcts, $marcsubjct;
 593                         }
 594
 595         }
 596         my $marcsubjctsarray=\@marcsubjcts;
 597         return $marcsubjctsarray;
 598 }  #end getMARCsubjects
 599
 600
 601 sub getMARCurls {
 602 ### This code is wrong only works with MARC21
 603     my ($dbh, $record, $marcflavour) = @_;
 604         my ($mintag, $maxtag);
 605         if ($marcflavour eq "MARC21") {
 606                 $mintag = "856";
 607                 $maxtag = "856";
 608         } else {           # assume unimarc if not marc21
 609                 $mintag = "600";
 610                 $maxtag = "619";
 611         }
 612
 613         my @marcurls;
 614         my $url = "";
 615         my $subfil = "";
 616         my $marcurl;
 617         my $value;
 618         foreach my $field ($mintag..$maxtag) {
 619                 my @value =XML_repeated_read($record,"","",$field,"a");
 620                         foreach my $url (@value){
 621                                 if ( $value ne $url) {
 622                                  $marcurl = {MARCURL => $url,};
 623                                 push @marcurls, $marcurl;
 624                                  $value=$url;
 625                                 }
 626                         }
 627         }
 628
 629
 630         my $marcurlsarray=\@marcurls;
 631         return $marcurlsarray;
 632 }  #end getMARCurls
 633
 634
 635
 636 sub parsefields{
 637 #pass this a  MARC record and it will parse it for display purposes
 638 my ($dbh,$intranet,@marcrecords)=@_;
 639 my @results;
 640 my @items;
 641 my $retrieve_from=C4::Context->preference('retrieve_from');
 642 #Build brancnames hash  for displaying in OPAC - more user friendly
 643 #find branchname
 644 #get branch information.....
 645 my %branches;
 646                 my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches");
 647                 $bsth->execute();
 648                 while (my $bdata=$bsth->fetchrow_hashref){
 649                         $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'};
 650                 }
 651
 652 #Building shelving hash if library has shelves defined like junior section, non-fiction, audio-visual room etc
 653 my %shelves;
 654 #find shelvingname
 655 my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
 656 my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
 657                 $shelfstatus->execute;
 658                 my ($authorised_valuecode) = $shelfstatus->fetchrow;
 659                 if ($authorised_valuecode) {
 660                         $shelfstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? ");
 661                         $shelfstatus->execute($authorised_valuecode);
 662                         while (my $lib = $shelfstatus->fetchrow_hashref){
 663                         $shelves{$lib->{'authorised_value'}} = $lib->{'lib'};
 664                         }
 665                 }
 666 my $even=1;
 667 foreach my $xml(@marcrecords){
 668 #my $xml=XML_xml2hash($xmlrecord);
 669 my @kohafields; ## just name those necessary for the result page
 670 push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn";
 671 my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields);
 672 my $bibliorecord;
 673
 674 my %counts;
 675
 676 $counts{'total'}=0;
 677 my $noitems    = 1;
 678 my $norequests = 1;
 679                 ##Loop for each item field
 680
 681                         foreach my $item (@itemrecords) {
 682                                 $norequests = 0 unless $item->{'itemnotforloan'};
 683                                 $noitems = 0;
 684                                 my $status;
 685                                 #renaming some fields according to templates
 686                                 $item->{'branchname'}=$branches{$item->{'holdingbranch'}};
 687                                 $item->{'shelves'}=$shelves{$item->{'shelf'}};
 688                                 $status="Lost" if ($item->{'itemlost'}>0);
 689                                 $status="Withdrawn" if ($item->{'wthdrawn'}>0);
 690                                 if ($intranet eq "intranet"){ ## we give full itemcallnumber detail in intranet
 691                                 $status="Due:".format_date($item->{'date_due'}) if ($item->{'date_due'} gt "0000-00-00");
 692                                 $status = $item->{'holdingbranch'}."-".$item->{'shelf'}."[".$item->{'itemcallnumber'}."]" unless defined $status;
 693                                 }else{
 694                                 $status="On Loan" if ($item->{'date_due'} gt "0000-00-00");
 695                                   $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status;
 696                                 }
 697
 698                                 $counts{$status}++;
 699                                 $counts{'total'}++;
 700                         }
 701                 $oldbiblio->{'noitems'} = $noitems;
 702                 $oldbiblio->{'norequests'} = $norequests;
 703                 $oldbiblio->{'even'} = $even;
 704                 $even= not $even;
 705                         if ($even){
 706                         $oldbiblio->{'toggle'}="#ffffcc";
 707                         } else {
 708                         $oldbiblio->{'toggle'}="white";
 709                         } ; ## some forms seems to use toggle
 710
 711                 $oldbiblio->{'itemcount'} = $counts{'total'};
 712                 my $totalitemcounts = 0;
 713                 foreach my $key (keys %counts){
 714                         if ($key ne 'total'){
 715                                 $totalitemcounts+= $counts{$key};
 716                                 $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
 717
 718                         }
 719                 }
 720                 my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
 721                 foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
 722
 723                         if ($_ eq 'notavailable') {
 724                                 $notavailabletext="Not available";
 725                                 my $c=$oldbiblio->{'locationhash'}->{$_};
 726                                 $oldbiblio->{'not-available-p'}=$c;
 727                         } else {
 728                                 $locationtext.="$_";
 729                                 my $c=$oldbiblio->{'locationhash'}->{$_};
 730                                 if ($_ eq 'Lost') {
 731                                         $oldbiblio->{'lost-p'} = $c;
 732                                 } elsif ($_ eq 'Withdrawn') {
 733                                         $oldbiblio->{'withdrawn-p'} = $c;
 734                                 } elsif ($_  =~/\^Due:/) {
 735
 736                                         $oldbiblio->{'on-loan-p'} = $c;
 737                                 } else {
 738                                         $locationtextonly.= $_;
 739                                         $locationtextonly.= " ($c)<br> " if $totalitemcounts > 1;
 740                                 }
 741                                 if ($totalitemcounts>1) {
 742                                         $locationtext.=" ($c)<br> ";
 743                                 }
 744                         }
 745                 }
 746                 if ($notavailabletext) {
 747                         $locationtext.= $notavailabletext;
 748                 } else {
 749                         $locationtext=~s/, $//;
 750                 }
 751                 $oldbiblio->{'location'} = $locationtext;
 752                 $oldbiblio->{'location-only'} = $locationtextonly;
 753                 $oldbiblio->{'use-location-flags-p'} = 1;
 754         push @results,$oldbiblio;
 755
 756 }## For each record received
 757         return(@results);
 758 }
 759
 760 sub getcoverPhoto {
 761 ## return the address of a cover image if defined otherwise the amazon cover images
 762         my $record =shift  ;
 763
 764         my $image=XML_readline_onerecord($record,"coverphoto","biblios");
 765         if ($image){
 766         return $image;
 767         }
 768 # if there is no image put the amazon cover image adress
 769
 770 my $isbn=XML_readline_onerecord($record,"isbn","biblios");
 771 return "http://images.amazon.com/images/P/".$isbn.".01.MZZZZZZZ.jpg";
 772 }
 773
 774 =item itemcount
 775
 776   ($count, $lcount, $nacount, $fcount, $scount, $lostcount,
 777   $mending, $transit,$ocount) =
 778     &itemcount($env, $biblionumber, $type);
 779
 780 Counts the number of items with the given biblionumber, broken down by
 781 category.
 782
 783 C<$env> is ignored.
 784
 785 If C<$type> is not set to C<intra>, lost, very overdue, and withdrawn
 786 items will not be counted.
 787
 788 C<&itemcount> returns a nine-element list:
 789
 790 C<$count> is the total number of items with the given biblionumber.
 791
 792 C<$lcount> is the number of items at the Levin branch.
 793
 794 C<$nacount> is the number of items that are neither borrowed, lost,
 795 nor withdrawn (and are therefore presumably on a shelf somewhere).
 796
 797 C<$fcount> is the number of items at the Foxton branch.
 798
 799 C<$scount> is the number of items at the Shannon branch.
 800
 801 C<$lostcount> is the number of lost and very overdue items.
 802
 803 C<$mending> is the number of items at the Mending branch (being
 804 mended?).
 805
 806 C<$transit> is the number of items at the Transit branch (in transit
 807 between branches?).
 808
 809 C<$ocount> is the number of items that haven't arrived yet
 810 (aqorders.quantity - aqorders.quantityreceived).
 811
 812 =cut
 813 #'
 814
 815
 816
 817 sub itemcount {
 818   my ($env,$bibnum,$type)=@_;
 819   my $dbh = C4::Context->dbh;
 820 my @kohafield;
 821 my @value;
 822 my @relation;
 823 my @and_or;
 824 my $sort;
 825   my $query="Select * from items where
 826   biblionumber=? ";
 827 push @kohafield,"biblionumber";
 828 push @value,$bibnum;
 829
 830 my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value, \@relation,"", \@and_or, 0);## there is only one record no need for $num or $offset
 831 my @fields;## extract only the fields required
 832 push @fields,"itemnumber","itemlost","wthdrawn","holdingbranch","date_due";
 833 my ($biblio,@items)=XMLmarc2koha ($dbh,$result[0],"holdings",\@fields);
 834   my $count=0;
 835   my $lcount=0;
 836   my $nacount=0;
 837   my $fcount=0;
 838   my $scount=0;
 839   my $lostcount=0;
 840   my $mending=0;
 841   my $transit=0;
 842   my $ocount=0;
 843  foreach my $data(@items){
 844     if ($type ne "intra"){
 845   next if ($data->{itemlost} || $data->{wthdrawn});
 846     }  ## Probably trying to hide lost item from opac ?
 847     $count++;
 848
 849 ## Now it seems we want to find those which are onloan
 850
 851
 852     if ( $data->{date_due} gt "0000-00-00"){
 853        $nacount++;
 854         next;
 855     }
 856 ### The rest of this code is hardcoded for Foxtrot Shanon etc. We urgently need a global understanding of these terms--TG
 857       if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){
 858         $lcount++;
 859       }
 860       if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){
 861         $fcount++;
 862       }
 863       if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){
 864         $scount++;
 865       }
 866       if ($data->{'itemlost'} eq '1'){
 867         $lostcount++;
 868       }
 869       if ($data->{'itemlost'} eq '2'){
 870         $lostcount++;
 871       }
 872       if ($data->{'holdingbranch'} eq 'FM'){
 873         $mending++;
 874       }
 875       if ($data->{'holdingbranch'} eq 'TR'){
 876         $transit++;
 877       }
 878
 879   }
 880 #  if ($count == 0){
 881     my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?");
 882     $sth2->execute($bibnum);
 883     if (my $data=$sth2->fetchrow_hashref){
 884       $ocount=$data->{'quantity'} - $data->{'quantityreceived'};
 885     }
 886 #    $count+=$ocount;
 887
 888   return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount);
 889 }
 890
 891 END { }       # module clean-up code here (global destructor)
 892
 893 1;
 894 __END__
 895
 896 =back
 897
 898 =head1 AUTHOR
 899
 900 Koha Developement team <info@koha.org>
 901 # New functions to comply with ZEBRA search and new KOHA 3 API added 2006 Tumer Garip tgarip@neu.edu.tr
 902
 903 =cut