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