From 9b266b13ee30eedc06420d87851d09527de06d0f Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Wed, 27 Sep 2006 19:53:52 +0000 Subject: [PATCH] Finalizing main components. All koha modules are now working with the new XML API --- C4/Accounts2.pm | 169 +++++++++--------------------- C4/AuthoritiesMarc.pm | 28 +++-- C4/Biblio.pm | 13 ++- C4/Circulation/Circ2.pm | 6 +- C4/Circulation/Fines.pm | 14 +-- C4/Context.pm | 15 +-- C4/Koha.pm | 76 ++++++-------- C4/Search.pm | 225 +++++++++++++++++++++++++++++++--------- 8 files changed, 306 insertions(+), 240 deletions(-) diff --git a/C4/Accounts2.pm b/C4/Accounts2.pm index 424ae16271..a6d5286770 100755 --- a/C4/Accounts2.pm +++ b/C4/Accounts2.pm @@ -142,16 +142,11 @@ sub recordpayment{ $newamtos = $accdata->{'amountoutstanding'} - $amountleft; $amountleft = 0; } - my $thisacct = $accdata->{accountno}; + my $thisacct = $accdata->{accountid}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? - where (borrowernumber = ?) and (accountno=?)"); - $usth->execute($newamtos,$bornumber,$thisacct); + where accountid=?"); + $usth->execute($newamtos,$thisacct); $usth->finish; - # $usth = $dbh->prepare("insert into accountoffsets - # (borrowernumber, accountno, offsetaccount, offsetamount) - # values (?,?,?,?)"); - # $usth->execute($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos); - # $usth->finish; } # create new line my $usth = $dbh->prepare("insert into accountlines @@ -167,13 +162,12 @@ sub recordpayment{ &makepayment($borrowernumber, $acctnumber, $amount, $branchcode); -Records the fact that a patron has paid off the entire amount he or +Records the fact that a patron has paid off the an amount he or she owes. C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is the account that was credited. C<$amount> is the amount paid (this is -only used to record the payment. It is assumed to be equal to the -amount owed). C<$branchcode> is the code of the branch where payment +only used to record the payment. C<$branchcode> is the code of the branch where payment was made. =cut @@ -212,13 +206,7 @@ if ($type eq "Pay"){ AND accountno = $accountno EOT -# print $updquery; -# $dbh->do(<dbh; @@ -317,34 +305,26 @@ sub returnlost{ borrowernumber=? and itemnumber=? and returndate is null"); $sth->execute($borrnum,$itemnum); $sth->finish; - my @datearr = localtime(time); - my $date = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; - my $bor="$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}"; - $sth=$dbh->prepare("Update items set paidfor=? where itemnumber=?"); - $sth->execute("Paid for by $bor $date",$itemnum); - $sth->finish; } =item manualinvoice - &manualinvoice($borrowernumber, $itemnumber, $description, $type, + &manualinvoice($borrowernumber, $description, $type, $amount, $user); C<$borrowernumber> is the patron's borrower number. C<$description> is a description of the transaction. C<$type> may be one of C, C, C, C, C, C, C, or C. -C<$itemnumber> is the item involved, if pertinent; otherwise, it -should be the empty string. + =cut #' -# FIXME - Okay, so what does this function do, really? + sub manualinvoice{ - my ($bornum,$itemnum,$desc,$type,$amount,$user)=@_; + my ($bornum,$desc,$type,$amount,$user)=@_; my $dbh = C4::Context->dbh; my $insert; - $itemnum=~ s/ //g; my %env; my $accountno=getnextacctno('',$bornum,$dbh); my $amountleft=$amount; @@ -359,67 +339,42 @@ sub manualinvoice{ } if ($type eq 'REF'){ $desc="Cash refund"; - $amountleft=refund('',$bornum,$amount); } - if ($itemnum ne ''){ - - $desc.=" ".$itemnum; - my $sth=$dbh->prepare("INSERT INTO accountlines - (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber) - VALUES (?, ?, now(), ?,?, ?,?,?)"); - $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum); - } else { - $desc=$dbh->quote($desc); + $amountleft=refund('',$bornum,$amount); my $sth=$dbh->prepare("INSERT INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding) VALUES (?, ?, now(), ?, ?, ?, ?)"); $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft); - } + } + sub manualcredit{ - my ($bornum,$itemnum,$desc,$type,$amount,$user,$oldaccount)=@_; + my ($bornum,$accountid,$desc,$type,$amount,$user,$oldaccount)=@_; my $dbh = C4::Context->dbh; my $insert; - $itemnum=~ s/ //g; - my $accountno=getnextacctno('',$bornum,$dbh); # my $amountleft=$amount; my $amountleft; my $noerror; if ($type eq 'CN' || $type eq 'CA' || $type eq 'CR' || $type eq 'CF' || $type eq 'CL' || $type eq 'CM'){ - my $amount2=$amount*-1; # FIXME - $amount2 = -$amount - ( $amountleft, $noerror,$oldaccount)=fixcredit($dbh,$bornum,$amount2,$itemnum,$type,$user); + my $amount2=$amount*-1; + ( $amountleft, $noerror,$oldaccount)=fixcredit($dbh,$bornum,$amount2,$accountid,$type,$user); } if ($noerror>0){ - if ($type eq 'CN'){ - $desc.="Card fee credited by:".$user; - } - if ($type eq 'CM'){ - $desc.="Other fees credited by:".$user; - } - if ($type eq 'CR'){ - $desc.="Resrvation fee credited by:".$user; - } - if ($type eq 'CA'){ - $desc.="Managenent fee credited by:".$user; - } - if ($type eq 'CL' && $desc eq ''){ - $desc="Lost Item credited by:".$user; - } - - if ($itemnum ne ''){ - $desc.=" Credited for overdue item:".$itemnum. " by:".$user; - my $sth=$dbh->prepare("INSERT INTO accountlines - (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,offset) - VALUES (?, ?, now(), ?,?, ?,?,?,?)"); - $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$oldaccount); - } else { - my $sth=$dbh->prepare("INSERT INTO accountlines + +## find the accountline desc +my $sth2=$dbh->prepare("select description from accountlines where accountid=?"); +$sth2->execute($accountid); +my $desc2=$sth2->fetchrow; +$desc.=" Credited for ".$desc2." by ".$user; +$sth2->finish; + + my $sth=$dbh->prepare("INSERT INTO accountlines (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,offset) VALUES (?, ?, now(), ?, ?, ?, ?,?)"); $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount); - } + return ("0"); } else { return("1"); @@ -428,36 +383,14 @@ return ("0"); # fixcredit sub fixcredit{ #here we update both the accountoffsets and the account lines - my ($dbh,$bornumber,$data,$itemnumber,$type,$user)=@_; + my ($dbh,$bornumber,$data,$accountid,$type,$user)=@_; my $newamtos = 0; my $accdata = ""; my $amountleft = $data; my $env; - my $query="Select * from accountlines where (borrowernumber=? - and amountoutstanding > 0)"; -my $exectype; - if ($type eq 'CL'){ - $query.=" and (accounttype = 'L' or accounttype = 'Rep')"; - } elsif ($type eq 'CF'){ - $query.=" and ( itemnumber= ? and (accounttype = 'FU' or accounttype='F') )"; - $exectype=1; - } elsif ($type eq 'CN'){ - $query.=" and ( accounttype = 'N' )"; - } elsif ($type eq 'CR'){ - $query.=" and ( itemnumber= ? and ( accounttype='Res' or accounttype='Rent'))"; - $exectype=1; - }elsif ($type eq 'CM'){ - $query.=" and ( accounttype = 'M' )"; - }elsif ($type eq 'CA'){ - $query.=" and ( accounttype = 'A' )"; - } -# print $query; - my $sth=$dbh->prepare($query); - if ($exectype && $itemnumber ne ''){ - $sth->execute($bornumber,$itemnumber); - }else{ - $sth->execute($bornumber); - } + my $query="Select * from accountlines where accountid=? and amountoutstanding > 0"; + my $sth=$dbh->prepare($query); +$sth->execute($accountid); $accdata=$sth->fetchrow_hashref; $sth->finish; @@ -469,13 +402,12 @@ if ($accdata){ $newamtos = $accdata->{'amountoutstanding'} - $amountleft; $amountleft = 0; } - my $thisacct = $accdata->{accountno}; + my $thisacct = $accdata->{accountid}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? - where (borrowernumber = ?) and (accountno=?)"); - $usth->execute($newamtos,$bornumber,$thisacct); + where accountid=?"); + $usth->execute($newamtos,$thisacct); $usth->finish; - # begin transaction # get lines with outstanding amounts to offset my $sth = $dbh->prepare("select * from accountlines @@ -485,29 +417,30 @@ if ($accdata){ # print $query; # offset transactions while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){ - if ($accdata->{'amountoutstanding'} < $amountleft) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; - } else { - $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + if ($accdata->{'amountoutstanding'} < $amountleft) { + $newamtos = 0; + $amountleft -= $accdata->{'amountoutstanding'}; + } else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; $amountleft = 0; - } - my $thisacct = $accdata->{accountno}; + } + my $thisacct = $accdata->{accountid}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? - where (borrowernumber = ?) and (accountno=?)"); - $usth->execute($newamtos,$bornumber,$thisacct); + where accountid=?"); + $usth->execute($newamtos,$thisacct); $usth->finish; - } + }## while account $sth->finish; $amountleft*=-1; return($amountleft,1,$accdata->{'accountno'}); }else{ -return("",0) +return("",0); } } -# FIXME - Figure out what this function does, and write it down. + +# sub refund{ #here we update both the accountoffsets and the account lines my ($env,$bornumber,$data)=@_; @@ -534,15 +467,15 @@ sub refund{ $amountleft = 0; } # print $amountleft; - my $thisacct = $accdata->{accountno}; + my $thisacct = $accdata->{accountid}; my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? - where (borrowernumber = ?) and (accountno=?)"); - $usth->execute($newamtos,$bornumber,$thisacct); + where accountid=?"); + $usth->execute($newamtos,$thisacct); $usth->finish; } $sth->finish; - return($amountleft); + return($amountleft*-1); } #Funtion to manage the daily account# diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 8a293cc9e3..df6c12a087 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -121,7 +121,7 @@ my $counter = $offset; $length=10 unless $length; my @oAuth; my $i; - $oAuth[0]=C4::Context->Zconn("authorityserver",1,1); + $oAuth[0]=C4::Context->Zconnauth("authorityserver"); my ($mainentry)=MARCfind_attr_from_kohafield("mainentry"); my ($allentry)=MARCfind_attr_from_kohafield("allentry"); @@ -316,15 +316,23 @@ sub AUTHaddauthority { $sth->execute; ($authid)=$sth->fetchrow; $authid=$authid+1; - } - -##Modified record may also come here use REPLACE -- bulk import comes here -XML_writeline($record,"authid",$authid,"authorities"); -XML_writeline($record,"authtypecode",$authtypecode,"authorities"); -my $xml=XML_hash2xml($record); - my $sth=$dbh->prepare("REPLACE auth_header set marcxml=?, authid=?,authtypecode=?,datecreated=now()"); - $sth->execute($xml,$authid,$authtypecode); + XML_writeline($record,"authid",$authid,"authorities"); + XML_writeline($record,"authtypecode",$authtypecode,"authorities"); + my $xml=XML_hash2xml($record); + $dbh->do("lock tables auth_header WRITE"); + $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marcxml) values (?,now(),?,?)"); + $sth->execute($authid,$authtypecode,$xml); + $sth->finish; + }else + +##Modified record may also come here use UPDATE -- bulk import comes here + XML_writeline($record,"authid",$authid,"authorities"); + XML_writeline($record,"authtypecode",$authtypecode,"authorities"); + my $xml=XML_hash2xml($record); + my $sth=$dbh->prepare("UPDATE auth_header set marcxml=?,authtypecode=? where authid=?"); + $sth->execute($xml,$authtypecode,$authid); $sth->finish; + } ZEBRAop($dbh,$authid,'specialUpdate',"authorityserver"); ## If the record is linked to another update the linked authorities with new authid my @linkids=XML_readline_asarray($record,"linkid","authorities"); @@ -738,7 +746,7 @@ $oConnection[0]->destroy(); if ($update==1){ my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","biblios"); my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); - ModBiblio($dbh,$biblionumber,$xmlhash,$frameworkcode) ; + NEWmodbiblio($dbh,$biblionumber,$xmlhash,$frameworkcode) ; } }#foreach $xmlhash diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 1719f830d8..72a1c2cc19 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -436,7 +436,7 @@ if ($related_record eq "biblios" || $related_record eq "" || !$related_record){ } }else{ - my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'biblios' and tagfield is not null" ); + my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like 'biblios' and tagfield is not null" ); $sth2->execute(); my $field; while ($field=$sth2->fetchrow) { @@ -479,7 +479,7 @@ my $itemresult; push @items, $itemresult; } }else{ - my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like 'holdings' and tagfield is not null" ); + my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like 'holdings' and tagfield is not null" ); foreach my $holding (@$holdings){ $sth2->execute(); my $field; @@ -510,7 +510,7 @@ sub XMLmarc2koha_onerecord { $result->{$field}=$val if $val; } }else{ - my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where recordtype like ? and tagfield is not null" ); + my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where recordtype like ? and tagfield is not null" ); $sth2->execute($related_record); my $field; while ($field=$sth2->fetchrow) { @@ -572,7 +572,7 @@ my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios"); my $xml=" naa a22 7ar4500"; ## Now build XML my $record = XML_xml2hash($xml); - my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?"); + my $sth2=$dbh->prepare("SELECT kohafield from koha_attr where tagfield is not null and recordtype=?"); $sth2->execute($recordtype); my $field; while (($field)=$sth2->fetchrow) { @@ -913,7 +913,6 @@ NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber); ##Add biblionumber to $record $xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings"); -# MARCkoha2marcOnefield($record,"biblionumber",$biblionumber,"holdings"); my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'"); $sth->execute(); my $notforloan=$sth->fetchrow; @@ -1381,7 +1380,7 @@ sub getitemtypes { sub getkohafields{ #returns MySQL like fieldnames to emulate searches on sql like fieldnames -my $type=@_; +my $type=shift; ## Either opac or intranet to select appropriate fields ## Assumes intranet $type="intra" unless $type; @@ -1390,7 +1389,7 @@ my $dbh = C4::Context->dbh; my $i=0; my @results; $type=$type."show"; -my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by liblibrarian"); +my $sth=$dbh->prepare("SELECT * FROM koha_attr where $type=1 order by label"); $sth->execute(); while (my $data=$sth->fetchrow_hashref){ $results[$i]=$data; diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 4e561db071..6172007c99 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -85,8 +85,8 @@ Also deals with stocktaking. &fixdate &itemissues &patronflags - get_current_return_date_of - get_transfert_infos + &get_current_return_date_of + &get_transfert_infos &checktransferts &GetReservesForBranch &GetReservesToBranch @@ -1730,7 +1730,7 @@ sub renewstatus { my $renewokay; ## # Look in the issues table for this item, lent to this borrower, # and not yet returned. -my $borrower=getpatroninformation($dbh,$bornum,undef); +my $borrower=C4::Members::getpatroninformation($dbh,$bornum,undef); if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){ ## faculty members and privileged get renewal whatever the case may be if ($borrower->{'categorycode'} eq 'F' ||$borrower->{'categorycode'} eq 'P'){ diff --git a/C4/Circulation/Fines.pm b/C4/Circulation/Fines.pm index 0415f3d466..0aee4660fd 100644 --- a/C4/Circulation/Fines.pm +++ b/C4/Circulation/Fines.pm @@ -171,19 +171,19 @@ sub CalcFine { # the first thing the patron gets is a second notice, but that's a # week after the server crash, so people may not connect the two # events. - if ($difference >= $data->{'firstremind'}){ + if ($difference > $data->{'firstremind'}){ # Yes. Set the fine as listed. $amount=$data->{'fine'}* $difference; $printout="First Notice"; } # Is it time to send out a second reminder? -# my $second=$data->{'firstremind'}+$data->{'chargeperiod'}; -# if ($difference == $second){ + my $second=$data->{'firstremind'}+$data->{'chargeperiod'}; + if ($difference == $second){ # # Yes. The fine is double. # $amount=$data->{'fine'}*2; -# $printout="Second Notice"; -# } + $printout="Second Notice"; + } # Is it time to send the account to a collection agency? # FIXME - At least, I *think* that's what this code is doing. @@ -252,8 +252,8 @@ sub UpdateFine { my $out=$data->{'amountoutstanding'}+$diff; my $sth2=$dbh->prepare("update accountlines set date=now(), amount=?, amountoutstanding=?,accounttype='FU' where - accountno=?"); - $sth2->execute($amount,$out,$data->{'accountno'}); + accountid=?"); + $sth2->execute($amount,$out,$data->{'accountid'}); $sth2->finish; } else { print "no update needed $data->{'amount'} \n"; diff --git a/C4/Context.pm b/C4/Context.pm index a7ddc14ddf..be8e8687a0 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -434,9 +434,9 @@ my $Zconn; my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"}; my $o = new ZOOM::Options(); $o->option(async => 1); -$o->option(preferredRecordSyntax => $syntax); ## Authorities use marc while biblioserver is xml +$o->option(preferredRecordSyntax => $syntax); ## in case we use MARC $o->option(databaseName=>$context->{"config"}->{$server}); -#$o->option(proxy=>$context->{"config"}->{"proxy"});## if proxyserver provided will route searches to proxy + my $o2= new ZOOM::Options(); $Zconn=create ZOOM::Connection($o); @@ -635,7 +635,7 @@ sub _new_marcfromkohafield { my $dbh = C4::Context->dbh; my $marcfromkohafield; - my $sth = $dbh->prepare("select marctokoha,tagfield,tagsubfield,recordtype from koha_attr where tagfield is not null "); + my $sth = $dbh->prepare("select kohafield,tagfield,tagsubfield,recordtype from koha_attr where tagfield is not null "); $sth->execute; while (my ($kohafield,$tagfield,$tagsubfield,$recordtype) = $sth->fetchrow) { my $retval = {}; @@ -652,11 +652,11 @@ sub _new_attrfromkohafield { my $dbh = C4::Context->dbh; my $attrfromkohafield; - my $sth2 = $dbh->prepare("select marctokoha,attr from koha_attr" ); + my $sth2 = $dbh->prepare("select kohafield,attr,extraattr from koha_attr" ); $sth2->execute; - while (my ($marctokoha,$attr) = $sth2->fetchrow) { + while (my ($kohafield,$attr,$extra) = $sth2->fetchrow) { my $retval = {}; - $attrfromkohafield->{$marctokoha} = $attr; + $attrfromkohafield->{$kohafield} = "\@attr 1=".$attr." ".$extra; } return $attrfromkohafield; } @@ -832,6 +832,9 @@ Andrew Arensburger =cut # $Log$ +# Revision 1.47 2006/09/27 19:53:52 tgarip1957 +# Finalizing main components. All koha modules are now working with the new XML API +# # Revision 1.46 2006/09/06 16:21:03 tgarip1957 # Clean up before final commits # diff --git a/C4/Koha.pm b/C4/Koha.pm index 9d0f1ae410..51a406091c 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -56,7 +56,7 @@ Koha.pm provides many functions for Koha scripts. &getframeworks &getframeworkinfo &getauthtypes &getauthtype &getallthemes &getalllanguages - &getallbranches &getletters + &GetallBranches &getletters &getbranchname getnbpages getitemtypeimagedir @@ -67,6 +67,8 @@ Koha.pm provides many functions for Koha scripts. get_branchinfos_of get_notforloan_label_of get_infos_of + &getFacets + $DEBUG); use vars qw(); @@ -173,61 +175,26 @@ sub getbranchname { =head2 getallbranches - $branches = &getallbranches(); + @branches = &GetallBranches(); returns informations about ALL branches. Create a branch selector with the following code IndependantBranches Insensitive... -=head3 in PERL SCRIPT - -my $branches = getallbranches; -my @branchloop; -foreach my $thisbranch (keys %$branches) { - my $selected = 1 if $thisbranch eq $branch; - my %row =(value => $thisbranch, - selected => $selected, - branchname => $branches->{$thisbranch}->{'branchname'}, - ); - push @branchloop, \%row; -} - - -=head3 in TEMPLATE - =cut -sub getallbranches { -# returns a reference to a hash of references to ALL branches... - my %branches; +sub GetallBranches { +# returns an array to ALL branches... + my @branches; my $dbh = C4::Context->dbh; my $sth; $sth = $dbh->prepare("Select * from branches order by branchname"); $sth->execute; while (my $branch=$sth->fetchrow_hashref) { - my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?"); - $nsth->execute($branch->{'branchcode'}); - while (my ($cat) = $nsth->fetchrow_array) { - # FIXME - This seems wrong. It ought to be - # $branch->{categorycodes}{$cat} = 1; - # otherwise, there's a namespace collision if there's a - # category with the same name as a field in the 'branches' - # table (i.e., don't create a category called "issuing"). - # In addition, the current structure doesn't really allow - # you to list the categories that a branch belongs to: - # you'd have to list keys %$branch, and remove those keys - # that aren't fields in the "branches" table. - $branch->{$cat} = 1; - } - $branches{$branch->{'branchcode'}}=$branch; + push @branches,$branch; } - return (\%branches); + return (@branches); } =head2 getletters @@ -945,6 +912,31 @@ sub get_infos_of { return \%infos_of; } +sub getFacets { +###Subfields is an array as well although MARC21 has them all in "a" in case UNIMARC has differing subfields +my $dbh=C4::Context->dbh; +my @facets; +my $sth=$dbh->prepare("SELECT facets_label,attr FROM koha_attr where (facets_label<>'' ) group by facets_label"); +my $sth2=$dbh->prepare("SELECT * FROM koha_attr where facets_label=?"); +$sth->execute(); +while (my ($label,$attr)=$sth->fetchrow){ + $sth2->execute($label); +my (@tags,@subfield); + while (my $data=$sth2->fetchrow_hashref){ + push @tags,$data->{tagfield} ; + push @subfield,$data->{tagsubfield} ; + } + my $facet = { + link_value =>"kohafield=$attr", + label_value =>$label, + tags => \@tags, + subfield =>\@subfield, + } ; + push @facets,$facet; +} + return \@facets; +} + 1; __END__ diff --git a/C4/Search.pm b/C4/Search.pm index 1bfa3c9dff..40b1fa0814 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -22,7 +22,9 @@ use C4::Context; use C4::Reserves2; use C4::Biblio; use Date::Calc; +use ZOOM; use Encode; + # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search. # So Perl complains that all of the functions here get redefined. use C4::Date; @@ -60,11 +62,11 @@ ZEBRA databases. @EXPORT = qw( &barcodes &ItemInfo &itemcount &getcoverPhoto &add_query_line - &FindDuplicate &ZEBRAsearch_kohafields &sqlsearch &cataloguing_search + &FindDuplicate &ZEBRAsearch_kohafields &convertPQF &sqlsearch &cataloguing_search &getMARCnotes &getMARCsubjects &getMARCurls &parsefields); # make all your functions, whether exported or not; -=item +=head1 ZEBRAsearchkohafields is the underlying API for searching zebra for KOHA internal use its kept similar to earlier version Koha Marc searches. instead of passing marc tags to the routine you pass named kohafields @@ -72,7 +74,7 @@ So you give an array of @kohafieldnames,@values, what relation they have @relati you receive an array of XML records. 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 search results templates do actually work. -However more advanced search frontends will be available and this routine can serve as the connecting API for circulation and serials management +This routine will also take CCL,CQL or PQF queries and pass them straight to the server See sub FindDuplicates for an example; =cut @@ -80,17 +82,17 @@ See sub FindDuplicates for an example; sub ZEBRAsearch_kohafields{ -my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom)=@_; +my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom,$searchtype)=@_; return (0,undef) unless (@$value[0]); my $server="biblioserver"; my @results; my $attr; my $query; - my $i; + unless($searchtype){ for ( $i=0; $i<=$#{$value}; $i++){ - last if (@$value[$i] eq ""); + next if (@$value[$i] eq ""); my $keyattr=MARCfind_attr_from_kohafield(@$kohafield[$i]) if (@$kohafield[$i]); if (!$keyattr){$keyattr=" \@attr 1=any";} @@ -100,39 +102,42 @@ my $i; for (my $z= 0;$z<=$#{$and_or};$z++){ $query=@$and_or[$z]." ".$query if (@$value[$z+1] ne ""); } - + } #warn $query; + my @oConnection; ($oConnection[0])=C4::Context->Zconn($server); - - - -if ($reorder){ -my (@sortpart)=split /,/,$reorder; - if (@sortpart<2){ - push @sortpart,1; ## - } -my ($sortattr)=MARCfind_attr_from_kohafield($sortpart[0]); -my @sortfield=split /@/,$sortattr; ## incase our $sortattr contains type modifiers - $query.=" \@attr 7=".$sortpart[1]." \@".$sortfield[1]." 0";## - $query= "\@or ".$query; +my @sortpart; +if ($reorder ){ + (@sortpart)=split /,/,$reorder; }elsif ($sort){ -my (@sortpart)=split /,/,$sort; + (@sortpart)=split /,/,$sort; +} +if (@sortpart){ +##sortpart is expected to contain the form "title i<" notation or "title,1" both mean the same thing if (@sortpart<2){ - push @sortpart,1; ## Ascending by default + push @sortpart," "; ##In case multisort variable is coming as a single query + } + if ($sortpart[1]==2){ + $sortpart[1]=">i"; ##Descending + }elsif ($sortpart[1]==1){ + $sortpart[1]="sortby($sortpart[0]." ".$sortpart[1]) if @sortpart; my $oResult; my $tried=0; @@ -140,7 +145,7 @@ my $tried=0; my $numresults; retry: -$oResult= $oConnection[0]->search_pqf($query); +$oResult= $oConnection[0]->search($query); my $i; my $event; while (($i = ZOOM::event(\@oConnection)) != 0) { @@ -170,27 +175,57 @@ my $dbh=C4::Context->dbh; $ri=$startfrom if $startfrom; for ( $ri; $ri<$numresults ; $ri++){ + my $xmlrecord=$oResult->record($ri)->raw(); $xmlrecord=Encode::decode("utf8",$xmlrecord); $xmlrecord=XML_xml2hash($xmlrecord); $z++; + push @results,$xmlrecord; last if ($number_of_results && $z>=$number_of_results); }## for #numresults if ($fordisplay){ - my (@parsed)=parsefields($dbh,$searchfrom,@results); - return ($numresults,@parsed) ; + my ($facets,@parsed)=parsefields($dbh,$searchfrom,@results); + return ($numresults,$facets,@parsed) ; } }# if numresults - +EXITING: $oResult->destroy(); $oConnection[0]->destroy(); return ($numresults,@results) ; -#return (0,undef); } +sub convertPQF{ +# Convert CCL, CQF or PQF to ZEBRA RPN queries,trap errors +my ($search_type,$zconn,$query)=@_; + +my $pqf_query; +if ($search_type eq "pqf"){ +eval{ +$pqf_query=new ZOOM::Query::PQF(@$query[0]); +}; +}elsif ($search_type eq "ccl"){ + +my $cclfile=C4::Context->config("ccl2rpn"); +$zconn->option(cclfile=>$cclfile);## CCL conversion file path +eval{ +$pqf_query=new ZOOM::Query::CCL2RPN(@$query[0],$zconn); +}; +}elsif ($search_type eq "cql"){ +eval{ +$pqf_query=new ZOOM::Query::CQL(@$query[0]); +}; +} +if ($@){ +$pqf_query=0; +} + +return $pqf_query; +} + + =item add_bold_fields After a search the searched keyword is boldened in the displayed search results if it exists in the title or author It is now depreceated @@ -201,11 +236,9 @@ sub add_html_bold_fields { my $new_key; $new_key = 'bold_' . $key; - $data->{$new_key} = $data->{$key}; - - + $data->{$new_key} = $data->{$key}; my $key1; - + $key1 = $key; @@ -508,23 +541,27 @@ sub getMARCnotes { my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); - if ($marcflavour eq "MARC21") { + if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") { $mintag = "500"; $maxtag = "599"; } else { # assume unimarc if not marc21 $mintag = "300"; $maxtag = "399"; } - my @marcnotes; + my @marcnotes=(); + foreach my $field ($mintag..$maxtag) { - my @value=XML_readline_asarray($record,"","",$field,""); - push @marcnotes, \@value; + my %line; + my @values=XML_readline_asarray($record,"","",$field,""); + foreach my $value (@values){ + $line{MARCNOTE}=$value if $value; + push @marcnotes,\%line if $line{MARCNOTE}; + } } - - my $marcnotesarray=\@marcnotes; - return $marcnotesarray; + return $marcnotesarray; + } # end getMARCnotes @@ -532,7 +569,7 @@ sub getMARCsubjects { my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); - if ($marcflavour eq "MARC21") { + if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") { $mintag = "600"; $maxtag = "699"; } else { # assume unimarc if not marc21 @@ -561,7 +598,7 @@ sub getMARCurls { ### This code is wrong only works with MARC21 my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); - if ($marcflavour eq "MARC21") { + if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") { $mintag = "856"; $maxtag = "856"; } else { # assume unimarc if not marc21 @@ -575,7 +612,7 @@ sub getMARCurls { my $marcurl; my $value; foreach my $field ($mintag..$maxtag) { - my @value =XML_readline_asarray($record,"","",$field,"a"); + my @value =XML_readline_asarray($record,"","",$field,"u"); foreach my $url (@value){ if ( $value ne $url) { $marcurl = {MARCURL => $url,}; @@ -623,8 +660,16 @@ my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_ } } my $even=1; +### FACETED RESULTS + my $facets_counter = (); + my $facets_info = (); + my @facets_loop; # stores the ref to array of hashes for template + foreach my $xml(@marcrecords){ -#my $xml=XML_xml2hash($xmlrecord); + + if (C4::Context->preference('useFacets')){ + ($facets_counter,$facets_info)=FillFacets($xml,$facets_counter,$facets_info); + } my @kohafields; ## just name those necessary for the result page push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn"; my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields); @@ -713,9 +758,95 @@ my $norequests = 1; push @results,$oldbiblio; }## For each record received - return(@results); +@facets_loop=BuildFacets($facets_counter,$facets_info,%branches); + + return(@facets_loop,@results); } +sub FillFacets{ +my ($facet_record,$facets_counter,$facets_info)=@_; + my $facets = C4::Koha::getFacets(); + for (my $k=0; $k<@$facets;$k++) { + my $tags=@$facets->[$k]->{tags}; + my $subfields=@$facets->[$k]->{subfield}; + my @fields; + for (my $i=0; $i<@$tags;$i++) { + my $type="biblios"; + $type="holdings" if @$facets->[$k]->{'link_value'} =~/branch/; ## if using other facets from items add them here + if ($type eq "holdings"){ + ###Read each item record + my $holdings=$facet_record->{holdings}->[0]->{record}; + foreach my $holding(@$holdings){ + my $data=XML_readline($holding,"","holdings",@$tags[$i],@$subfields[$i]); + $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data; + } + }else{ + my $data=XML_readline($facet_record,"","biblios",@$tags[$i],@$subfields[$i]); + $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data; + } + } + $facets_info->{ @$facets->[$k]->{'link_value'} }->{ 'label_value' } = @$facets->[$k]->{'label_value'}; + $facets_info->{ @$facets->[$k]->{'link_value'} }->{ 'expanded' } = @$facets->[$k]->{'expanded'}; + } +return ($facets_counter,$facets_info); +} + +sub BuildFacets { +my ($facets_counter, $facets_info,%branches) = @_; + + my @facets_loop; # stores the ref to array of hashes for template +# BUILD FACETS + foreach my $link_value ( sort { $facets_counter->{$b} <=> $facets_counter->{$a} } keys %$facets_counter) { + my $expandable; + my $number_of_facets; + my @this_facets_array; + foreach my $one_facet ( sort { $facets_counter->{ $link_value }->{$b} <=> $facets_counter->{ $link_value }->{$a} } keys %{$facets_counter->{$link_value}} ) { + $number_of_facets++; + if (($number_of_facets < 11) || ($facets_info->{ $link_value }->{ 'expanded'})) { + + # sanitize the link value ), ( will cause errors with CCL + my $facet_link_value = $one_facet; + $facet_link_value =~ s/(\(|\))/ /g; + + # fix the length that will display in the label + my $facet_label_value = $one_facet; + $facet_label_value = substr($one_facet,0,20)."..." unless length($facet_label_value)<=20; + # well, if it's a branch, label by the name, not the code + if ($link_value =~/branch/) { + $facet_label_value = $branches{$one_facet}; + } + + # but we're down with the whole label being in the link's title + my $facet_title_value = $one_facet; + + push @this_facets_array , + ( { facet_count => $facets_counter->{ $link_value }->{ $one_facet }, + facet_label_value => $facet_label_value, + facet_title_value => $facet_title_value, + facet_link_value => $facet_link_value, + type_link_value => $link_value, + }, + ); + }## if $number_of_facets + }##for $one_facet + unless ($facets_info->{ $link_value }->{ 'expanded'}) { + $expandable=1 if ($number_of_facets > 10); + } + push @facets_loop,( + { type_link_value => $link_value, + type_id => $link_value."_id", + type_label => $facets_info->{ $link_value }->{ 'label_value' }, + facets => \@this_facets_array, + expandable => $expandable, + expand => $link_value, + }, + ); + + } +return \@facets_loop; +} + + sub getcoverPhoto { ## return the address of a cover image if defined otherwise the amazon cover images my $record =shift ; -- 2.39.5