[Koha-cvs] koha/C4 Accounts2.pm AuthoritiesMarc.pm Biblio....
Tumer Garip
tgarip at neu.edu.tr
Wed Sep 27 21:53:53 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Tumer Garip <tgarip1957> 06/09/27 19:53:52
Modified files:
C4 : Accounts2.pm AuthoritiesMarc.pm Biblio.pm
Context.pm Koha.pm Search.pm
C4/Circulation : Circ2.pm Fines.pm
Log message:
Finalizing main components. All koha modules are now working with the new XML API
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Accounts2.pm?cvsroot=koha&r1=1.33&r2=1.34
http://cvs.savannah.gnu.org/viewcvs/koha/C4/AuthoritiesMarc.pm?cvsroot=koha&r1=1.33&r2=1.34
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.183&r2=1.184
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&r1=1.46&r2=1.47
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Koha.pm?cvsroot=koha&r1=1.43&r2=1.44
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Search.pm?cvsroot=koha&r1=1.123&r2=1.124
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.118&r2=1.119
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Fines.pm?cvsroot=koha&r1=1.18&r2=1.19
Patches:
Index: Accounts2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Accounts2.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -b -r1.33 -r1.34
--- Accounts2.pm 6 Sep 2006 16:21:03 -0000 1.33
+++ Accounts2.pm 27 Sep 2006 19:53:52 -0000 1.34
@@ -142,16 +142,11 @@
$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 @@
&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 @@
AND accountno = $accountno
EOT
-# print $updquery;
-# $dbh->do(<<EOT);
-# INSERT INTO accountoffsets
-# (borrowernumber, accountno, offsetaccount,
-# offsetamount)
-# VALUES ($bornumber, $accountno, $nextaccntno, $newamtos)
-# EOT
+
# create new line
my $payment=0-$amount;
@@ -286,7 +274,7 @@
=cut
#'
-# FIXME - I don't understand what this function does.
+# FIXME - I don't know whether used
sub fixaccounts {
my ($borrowernumber,$accountno,$amount)=@_;
my $dbh = C4::Context->dbh;
@@ -317,34 +305,26 @@
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<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
or C<REF>.
-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 @@
}
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 {
+## 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 @@
# 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 $query="Select * from accountlines where accountid=? and amountoutstanding > 0";
my $sth=$dbh->prepare($query);
- if ($exectype && $itemnumber ne ''){
- $sth->execute($bornumber,$itemnumber);
- }else{
- $sth->execute($bornumber);
- }
+$sth->execute($accountid);
$accdata=$sth->fetchrow_hashref;
$sth->finish;
@@ -469,13 +402,12 @@
$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
@@ -492,22 +424,23 @@
$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 @@
$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#
Index: AuthoritiesMarc.pm
===================================================================
RCS file: /sources/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -b -r1.33 -r1.34
--- AuthoritiesMarc.pm 24 Sep 2006 20:00:51 -0000 1.33
+++ AuthoritiesMarc.pm 27 Sep 2006 19:53:52 -0000 1.34
@@ -121,7 +121,7 @@
$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 @@
$sth->execute;
($authid)=$sth->fetchrow;
$authid=$authid+1;
- }
+ 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 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);
+##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 @@
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
@@ -847,7 +855,7 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.33 2006/09/24 20:00:51 kados Exp $
+# $Id: AuthoritiesMarc.pm,v 1.34 2006/09/27 19:53:52 tgarip1957 Exp $
# Revision 1.30 2006/09/06 16:21:03 tgarip1957
# Clean up before final commits
Index: Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.183
retrieving revision 1.184
diff -u -b -r1.183 -r1.184
--- Biblio.pm 20 Sep 2006 21:48:44 -0000 1.183
+++ Biblio.pm 27 Sep 2006 19:53:52 -0000 1.184
@@ -436,7 +436,7 @@
}
}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 @@
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 @@
$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 $xml="<record><leader> naa a22 7ar4500</leader><controlfield tag='xxx'></controlfield><datafield ind1='' ind2='' tag='$titletag'></datafield></record>";
## 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 @@
##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 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 $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;
Index: Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -b -r1.46 -r1.47
--- Context.pm 6 Sep 2006 16:21:03 -0000 1.46
+++ Context.pm 27 Sep 2006 19:53:52 -0000 1.47
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.46 2006/09/06 16:21:03 tgarip1957 Exp $
+# $Id: Context.pm,v 1.47 2006/09/27 19:53:52 tgarip1957 Exp $
package C4::Context;
use strict;
use DBI;
@@ -25,7 +25,7 @@
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.46 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.47 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -434,9 +434,9 @@
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 @@
{
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 @@
{
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 @@
=cut
# $Log: Context.pm,v $
+# 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
#
Index: Koha.pm
===================================================================
RCS file: /sources/koha/koha/C4/Koha.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -b -r1.43 -r1.44
--- Koha.pm 6 Sep 2006 16:21:03 -0000 1.43
+++ Koha.pm 27 Sep 2006 19:53:52 -0000 1.44
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Koha.pm,v 1.43 2006/09/06 16:21:03 tgarip1957 Exp $
+# $Id: Koha.pm,v 1.44 2006/09/27 19:53:52 tgarip1957 Exp $
use strict;
require Exporter;
@@ -25,7 +25,7 @@
use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = do { my @v = '$Revision: 1.43 $' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = do { my @v = '$Revision: 1.44 $' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -56,7 +56,7 @@
&getframeworks &getframeworkinfo
&getauthtypes &getauthtype
&getallthemes &getalllanguages
- &getallbranches &getletters
+ &GetallBranches &getletters
&getbranchname
getnbpages
getitemtypeimagedir
@@ -67,6 +67,8 @@
get_branchinfos_of
get_notforloan_label_of
get_infos_of
+ &getFacets
+
$DEBUG);
use vars qw();
@@ -173,61 +175,26 @@
=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
- <select name="branch">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="branchloop" -->
- <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
- <!-- /TMPL_LOOP -->
- </select>
=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 @@
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, at 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__
Index: Search.pm
===================================================================
RCS file: /sources/koha/koha/C4/Search.pm,v
retrieving revision 1.123
retrieving revision 1.124
diff -u -b -r1.123 -r1.124
--- Search.pm 6 Sep 2006 16:21:03 -0000 1.123
+++ Search.pm 27 Sep 2006 19:53:52 -0000 1.124
@@ -22,7 +22,9 @@
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;
@@ -30,7 +32,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.123 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.124 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -60,11 +62,11 @@
@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 @@
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 @@
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 @@
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]="<i"; ##Ascending
}
-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";## fix to accept secondary sort as well
- $query= "\@or ".$query;
}else{
unless($query=~/4=109/){ ###ranked sort not valid for numeric fields
##Use Ranked sort
$query="\@attr 2=102 ".$query;
}
}
-#warn $query;
+
+if ($searchtype){
+$query=convertPQF($searchtype,$oConnection[0],$value);
+}else{
+$query=new ZOOM::Query::PQF($query);
+}
+goto EXITING unless $query;## erronous query coming in
+$query->sortby($sortpart[0]." ".$sortpart[1]) if @sortpart;
my $oResult;
my $tried=0;
@@ -140,7 +145,7 @@
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 @@
$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, at results);
- return ($numresults, at parsed) ;
+ my ($facets, at parsed)=parsefields($dbh,$searchfrom, at results);
+ return ($numresults,$facets, at parsed) ;
}
}# if numresults
-
+EXITING:
$oResult->destroy();
$oConnection[0]->destroy();
return ($numresults, at 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 <b>boldened</b> in the displayed search results if it exists in the title or author
It is now depreceated
@@ -202,8 +237,6 @@
$new_key = 'bold_' . $key;
$data->{$new_key} = $data->{$key};
-
-
my $key1;
$key1 = $key;
@@ -508,23 +541,27 @@
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;
+
} # end getMARCnotes
@@ -532,7 +569,7 @@
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 @@
### 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 @@
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 $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, at itemrecords) = XMLmarc2koha($dbh,$xml,"", at kohafields);
@@ -713,9 +758,95 @@
push @results,$oldbiblio;
}## For each record received
- return(@results);
+ at facets_loop=BuildFacets($facets_counter,$facets_info,%branches);
+
+ return(@facets_loop, at 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 ;
Index: Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -b -r1.118 -r1.119
--- Circulation/Circ2.pm 20 Sep 2006 21:48:44 -0000 1.118
+++ Circulation/Circ2.pm 27 Sep 2006 19:53:52 -0000 1.119
@@ -3,7 +3,7 @@
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.118 2006/09/20 21:48:44 tgarip1957 Exp $
+# $Id: Circ2.pm,v 1.119 2006/09/27 19:53:52 tgarip1957 Exp $
#package to deal with Returns
#written 3/11/99 by olwen at katipo.co.nz
@@ -85,8 +85,8 @@
&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 @@
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'){
Index: Circulation/Fines.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Fines.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- Circulation/Fines.pm 20 Sep 2006 21:48:44 -0000 1.18
+++ Circulation/Fines.pm 27 Sep 2006 19:53:52 -0000 1.19
@@ -1,6 +1,6 @@
package C4::Circulation::Fines;
-# $Id: Fines.pm,v 1.18 2006/09/20 21:48:44 tgarip1957 Exp $
+# $Id: Fines.pm,v 1.19 2006/09/27 19:53:52 tgarip1957 Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -171,19 +171,19 @@
# 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 @@
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";
More information about the Koha-cvs
mailing list