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