# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
require Exporter;
use C4::Context;
use C4::Stats;
-use C4::Search;
-use C4::Circulation::Circ2;
use C4::Members;
+#use C4::Circulation::Circ2;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01; # FIXME - Should probably be different from
- # the version for C4::Accounts
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
=head1 FUNCTIONS
-=over 2
-
=cut
@ISA = qw(Exporter);
-@EXPORT = qw(&checkaccount &recordpayment &fixaccounts &makepayment &manualinvoice
- &getnextacctno &manualcredit
-
- &dailyAccountBalance &addDailyAccountOp &getDailyAccountOp);
+@EXPORT = qw(&checkaccount &recordpayment &fixaccounts &makepayment &manualinvoice
+&getnextacctno &reconcileaccount);
-=item checkaccount
+=head2 checkaccount
$owed = &checkaccount($env, $borrowernumber, $dbh, $date);
C<$env> is ignored.
=cut
+
#'
sub checkaccount {
#take borrower number
#check accounts and list amounts owing
- my ($env,$bornumber,$dbh,$date)=@_;
+ my ($env,$borrowernumber,$dbh,$date)=@_;
my $select="SELECT SUM(amountoutstanding) AS total
FROM accountlines
WHERE borrowernumber = ?
AND amountoutstanding<>0";
- my @bind = ($bornumber);
- if ($date ne ''){
+ my @bind = ($borrowernumber);
+ if ($date && $date ne ''){
$select.=" AND date < ?";
push(@bind,$date);
}
my $sth=$dbh->prepare($select);
$sth->execute(@bind);
my $data=$sth->fetchrow_hashref;
- my $total = $data->{'total'};
+ my $total = $data->{'total'} || 0;
$sth->finish;
# output(1,2,"borrower owes $total");
#if ($total > 0){
# # output(1,2,"borrower owes $total");
# if ($total > 5){
- # reconcileaccount($env,$dbh,$bornumber,$total);
+ # reconcileaccount($env,$dbh,$borrowernumber,$total);
# }
#}
# pause();
return($total);
}
-=item recordpayment
+=head2 recordpayment
&recordpayment($env, $borrowernumber, $payment);
will be credited to the next one.
=cut
+
#'
sub recordpayment{
#here we update both the accountoffsets and the account lines
- my ($env,$bornumber,$data)=@_;
+ my ($env,$borrowernumber,$data)=@_;
my $dbh = C4::Context->dbh;
my $newamtos = 0;
my $accdata = "";
my $branch=$env->{'branchcode'};
+ warn $branch;
my $amountleft = $data;
# begin transaction
- my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
+ my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding<>0)
order by date");
- $sth->execute($bornumber);
+ $sth->execute($borrowernumber);
# offset transactions
while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
if ($accdata->{'amountoutstanding'} < $amountleft) {
$newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
+ $amountleft -= $accdata->{'amountoutstanding'};
} else {
$newamtos = $accdata->{'amountoutstanding'} - $amountleft;
- $amountleft = 0;
+ $amountleft = 0;
}
- my $thisacct = $accdata->{accountid};
+ my $thisacct = $accdata->{accountno};
my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
- where accountid=?");
- $usth->execute($newamtos,$thisacct);
+ where (borrowernumber = ?) and (accountno=?)");
+ $usth->execute($newamtos,$borrowernumber,$thisacct);
+ $usth->finish;
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values (?,?,?,?)");
+ $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
$usth->finish;
}
# create new line
my $usth = $dbh->prepare("insert into accountlines
(borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
values (?,?,now(),?,'Payment,thanks','Pay',?)");
- $usth->execute($bornumber,$nextaccntno,0-$data,0-$amountleft);
+ $usth->execute($borrowernumber,$nextaccntno,0-$data,0-$amountleft);
$usth->finish;
-# UpdateStats($env,$branch,'payment',$data,'','','',$bornumber);
+ UpdateStats($env,$branch,'payment',$data,'','','',$borrowernumber);
$sth->finish;
}
-=item makepayment
+=head2 makepayment
&makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
-Records the fact that a patron has paid off the an amount he or
+Records the fact that a patron has paid off the entire 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. C<$branchcode> is the code of the branch where payment
+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
was made.
=cut
+
#'
# FIXME - I'm not at all sure about the above, because I don't
# understand what the acct* tables in the Koha database are for.
-
sub makepayment{
- #here we update the account lines
+ #here we update both the accountoffsets and the account lines
#updated to check, if they are paying off a lost item, we return the item
# from their card, and put a note on the item record
- my ($bornumber,$accountno,$amount,$user,$type)=@_;
- my $env;
-my $desc;
-my $pay;
-if ($type eq "Pay"){
- $desc="Payment,received by -". $user;
- $pay="Pay";
-}else{
- $desc="Written-off -by". $user;
- $pay="W";
-}
+ my ($borrowernumber,$accountno,$amount,$user,$branch)=@_;
+ my %env;
+ $env{'branchcode'}=$branch;
my $dbh = C4::Context->dbh;
# begin transaction
- my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
+ my $nextaccntno = getnextacctno(\%env,$borrowernumber,$dbh);
my $newamtos=0;
my $sth=$dbh->prepare("Select * from accountlines where borrowernumber=? and accountno=?");
- $sth->execute($bornumber,$accountno);
+ $sth->execute($borrowernumber,$accountno);
my $data=$sth->fetchrow_hashref;
$sth->finish;
$dbh->do(<<EOT);
- UPDATE accountlines
- SET amountoutstanding = amountoutstanding-$amount
- WHERE borrowernumber = $bornumber
- AND accountno = $accountno
+ UPDATE accountlines
+ SET amountoutstanding = 0
+ WHERE borrowernumber = $borrowernumber
+ AND accountno = $accountno
EOT
-
+# print $updquery;
+ $dbh->do(<<EOT);
+ INSERT INTO accountoffsets
+ (borrowernumber, accountno, offsetaccount,
+ offsetamount)
+ VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
+EOT
# create new line
my $payment=0-$amount;
-if ($data->{'itemnumber'}){
-$desc.=" ".$data->{'itemnumber'};
-
$dbh->do(<<EOT);
- INSERT INTO accountlines
- (borrowernumber, accountno, itemnumber,date, amount,
- description, accounttype, amountoutstanding,offset)
- VALUES ($bornumber, $nextaccntno, $data->{'itemnumber'},now(), $payment,
- '$desc', '$pay', 0,$accountno)
+ INSERT INTO accountlines
+ (borrowernumber, accountno, date, amount,
+ description, accounttype, amountoutstanding)
+ VALUES ($borrowernumber, $nextaccntno, now(), $payment,
+ 'Payment,thanks - $user', 'Pay', 0)
EOT
-}else{
- $dbh->do(<<EOT);
-INSERT INTO accountlines
- (borrowernumber, accountno, date, amount,
- description, accounttype, amountoutstanding,offset)
- VALUES ($bornumber, $nextaccntno, now(), $payment,
- '$desc', '$pay', 0,$accountno)
-EOT
-}
# FIXME - The second argument to &UpdateStats is supposed to be the
# branch code.
-# UpdateStats($env,'MAIN',$pay,$amount,'','','',$bornumber);
+ # UpdateStats is now being passed $accountno too. MTJ
+ UpdateStats(\%env,$user,'payment',$amount,'','','',$borrowernumber,$accountno);
$sth->finish;
#check to see what accounttype
if ($data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L'){
- returnlost($bornumber,$data->{'itemnumber'});
+ returnlost($borrowernumber,$data->{'itemnumber'});
}
}
-=item getnextacctno
+=head2 getnextacctno
$nextacct = &getnextacctno($env, $borrowernumber, $dbh);
C<$env> is ignored.
=cut
+
#'
# FIXME - Okay, so what does the above actually _mean_?
sub getnextacctno {
- my ($env,$bornumber,$dbh)=@_;
+ my ($env,$borrowernumber,$dbh)=@_;
my $nextaccntno = 1;
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?)
order by accountno desc");
- $sth->execute($bornumber);
+ $sth->execute($borrowernumber);
if (my $accdata=$sth->fetchrow_hashref){
$nextaccntno = $accdata->{'accountno'} + 1;
}
return($nextaccntno);
}
-=item fixaccounts
+=head2 fixaccounts
&fixaccounts($borrowernumber, $accountnumber, $amount);
=cut
+
#'
-# FIXME - I don't know whether used
+# FIXME - I don't understand what this function does.
sub fixaccounts {
my ($borrowernumber,$accountno,$amount)=@_;
my $dbh = C4::Context->dbh;
and accountno=?");
$sth->execute($borrowernumber,$accountno);
my $data=$sth->fetchrow_hashref;
- # FIXME - Error-checking
+ # FIXME - Error-checking
my $diff=$amount-$data->{'amount'};
my $outstanding=$data->{'amountoutstanding'}+$diff;
$sth->finish;
$dbh->do(<<EOT);
- UPDATE accountlines
- SET amount = '$amount',
- amountoutstanding = '$outstanding'
- WHERE borrowernumber = $borrowernumber
- AND accountno = $accountno
+ UPDATE accountlines
+ SET amount = '$amount',
+ amountoutstanding = '$outstanding'
+ WHERE borrowernumber = $borrowernumber
+ AND accountno = $accountno
EOT
}
# FIXME - Never used, but not exported, either.
sub returnlost{
- my ($borrnum,$itemnum)=@_;
+ my ($borrowernumber,$itemnum)=@_;
my $dbh = C4::Context->dbh;
- my $borrower=C4::Members::borrdata('',$borrnum); #from C4::Members;
+ my $borrower=borrdata('',$borrowernumber);
my $sth=$dbh->prepare("Update issues set returndate=now() where
borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($borrnum,$itemnum);
+ $sth->execute($borrowernumber,$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
+=head2 manualinvoice
- &manualinvoice($borrowernumber, $description, $type,
+ &manualinvoice($borrowernumber, $itemnumber, $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,$desc,$type,$amount,$user)=@_;
+ my ($borrowernumber,$itemnum,$desc,$type,$amount,$user)=@_;
my $dbh = C4::Context->dbh;
+ my $notifyid;
my $insert;
+ $itemnum=~ s/ //g;
my %env;
- my $accountno=getnextacctno('',$bornum,$dbh);
+ my $accountno=getnextacctno('',$borrowernumber,$dbh);
my $amountleft=$amount;
-
+ if ($type eq 'CS' || $type eq 'CB' || $type eq 'CW'
+ || $type eq 'CF' || $type eq 'CL'){
+ my $amount2=$amount*-1; # FIXME - $amount2 = -$amount
+ $amountleft=fixcredit(\%env,$borrowernumber,$amount2,$itemnum,$type,$user);
+ }
if ($type eq 'N'){
$desc.="New Card";
}
-
+ if ($type eq 'F'){
+ $desc.="Fine";
+ }
+ if ($type eq 'A'){
+ $desc.="Account Management fee";
+ }
+ if ($type eq 'M'){
+ $desc.="Sundry";
+ }
+
if ($type eq 'L' && $desc eq ''){
+
$desc="Lost Item";
}
- if ($type eq 'REF'){
- $desc="Cash refund";
+ if ($type eq 'REF'){
+ $desc.="Cash Refund";
+ $amountleft=refund('',$borrowernumber,$amount);
}
- $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,$accountid,$desc,$type,$amount,$user,$oldaccount)=@_;
- my $dbh = C4::Context->dbh;
- my $insert;
- 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;
- ( $amountleft, $noerror,$oldaccount)=fixcredit($dbh,$bornum,$amount2,$accountid,$type,$user);
+ if(($type eq 'L') or ($type eq 'F') or ($type eq 'A') or ($type eq 'N') or ($type eq 'M') ){
+ $notifyid=1;
}
- if ($noerror>0){
-
-## 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)
+
+ if ($itemnum ne ''){
+ $desc.=" ".$itemnum;
+ my $sth=$dbh->prepare("INSERT INTO accountlines
+ (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id)
+ VALUES (?, ?, now(), ?,?, ?,?,?,?)");
+# $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $data->{'itemnumber'});
+ $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid);
+ } else {
+ my $sth=$dbh->prepare("INSERT INTO accountlines
+ (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id)
VALUES (?, ?, now(), ?, ?, ?, ?,?)");
- $sth->execute($bornum, $accountno, $amount, $desc, $type, $amountleft,$oldaccount);
-
-return ("0");
-} else {
- return("1");
-}
+ $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft,$notifyid);
+ }
}
-# fixcredit
+
+=head2 fixcredit
+
+ $amountleft = &fixcredit($env, $borrowernumber, $data, $barcode, $type, $user);
+
+ This function is only used internally, not exported.
+ FIXME - Figure out what this function does, and write it down.
+
+=cut
+
sub fixcredit{
#here we update both the accountoffsets and the account lines
- my ($dbh,$bornumber,$data,$accountid,$type,$user)=@_;
+ my ($env,$borrowernumber,$data,$barcode,$type,$user)=@_;
+ my $dbh = C4::Context->dbh;
my $newamtos = 0;
my $accdata = "";
my $amountleft = $data;
- my $env;
- my $query="Select * from accountlines where accountid=? and amountoutstanding > 0";
- my $sth=$dbh->prepare($query);
-$sth->execute($accountid);
+ if ($barcode ne ''){
+ my $item=getiteminformation('',$barcode);
+ my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
+ my $query="Select * from accountlines where (borrowernumber=?
+ and itemnumber=? and amountoutstanding > 0)";
+ if ($type eq 'CL'){
+ $query.=" and (accounttype = 'L' or accounttype = 'Rep')";
+ } elsif ($type eq 'CF'){
+ $query.=" and (accounttype = 'F' or accounttype = 'FU' or
+ accounttype='Res' or accounttype='Rent')";
+ } elsif ($type eq 'CB'){
+ $query.=" and accounttype='A'";
+ }
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$item->{'itemnumber'});
$accdata=$sth->fetchrow_hashref;
$sth->finish;
-
-if ($accdata){
- if ($accdata->{'amountoutstanding'} < $amountleft) {
- $newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
- } else {
- $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
- $amountleft = 0;
- }
- my $thisacct = $accdata->{accountid};
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft -= $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{accountno};
my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
- where accountid=?");
- $usth->execute($newamtos,$thisacct);
+ where (borrowernumber = ?) and (accountno=?)");
+ $usth->execute($newamtos,$borrowernumber,$thisacct);
$usth->finish;
-
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values (?,?,?,?)");
+ $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
+ $usth->finish;
+ }
# begin transaction
+ my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding >0)
order by date");
- $sth->execute($bornumber);
+ $sth->execute($borrowernumber);
# 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;
- $amountleft = 0;
- }
- my $thisacct = $accdata->{accountid};
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft -= $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{accountno};
my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
- where accountid=?");
- $usth->execute($newamtos,$thisacct);
+ where (borrowernumber = ?) and (accountno=?)");
+ $usth->execute($newamtos,$borrowernumber,$thisacct);
+ $usth->finish;
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values (?,?,?,?)");
+ $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
$usth->finish;
- }## while account
+ }
$sth->finish;
-
+ $env->{'branch'}=$user;
+ $type="Credit ".$type;
+ UpdateStats($env,$user,$type,$data,$user,'','',$borrowernumber);
$amountleft*=-1;
- return($amountleft,1,$accdata->{'accountno'});
-}else{
-return("",0);
-}
+ return($amountleft);
+
}
+=head2 refund
+
+# FIXME - Figure out what this function does, and write it down.
+
+=cut
-#
sub refund{
#here we update both the accountoffsets and the account lines
- my ($env,$bornumber,$data)=@_;
+ my ($env,$borrowernumber,$data)=@_;
my $dbh = C4::Context->dbh;
my $newamtos = 0;
my $accdata = "";
my $amountleft = $data *-1;
# begin transaction
+ my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding<0)
order by date");
- $sth->execute($bornumber);
+ $sth->execute($borrowernumber);
# print $amountleft;
# offset transactions
while (($accdata=$sth->fetchrow_hashref) and ($amountleft<0)){
if ($accdata->{'amountoutstanding'} > $amountleft) {
$newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
+ $amountleft -= $accdata->{'amountoutstanding'};
} else {
$newamtos = $accdata->{'amountoutstanding'} - $amountleft;
- $amountleft = 0;
+ $amountleft = 0;
}
# print $amountleft;
- my $thisacct = $accdata->{accountid};
+ my $thisacct = $accdata->{accountno};
my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
- where accountid=?");
- $usth->execute($newamtos,$thisacct);
+ where (borrowernumber = ?) and (accountno=?)");
+ $usth->execute($newamtos,$borrowernumber,$thisacct);
+ $usth->finish;
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values (?,?,?,?)");
+ $usth->execute($borrowernumber,$accdata->{'accountno'},$nextaccntno,$newamtos);
$usth->finish;
-
}
$sth->finish;
- return($amountleft*-1);
+ return($amountleft);
}
-#Funtion to manage the daily account#
-
-sub dailyAccountBalance {
- my ($date) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
-
- if ($date) {
-
- $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = ?");
- $sth->execute($date);
- my $data = $sth->fetchrow_hashref;
- if (!$data->{'balanceDate'}) {
- $data->{'noentry'} = 1;
- }
- return ($data);
-
- } else {
-
- $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()");
- $sth->execute();
-
- if ($sth->rows) {
- return ($sth->fetchrow_hashref);
- } else {
- my %hash;
-
- $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1");
- $sth->execute();
- if ($sth->rows) {
- ($hash{'initialBalanceInHand'}) = $sth->fetchrow_array;
- $hash{'currentBalanceInHand'} = $hash{'initialBalanceInHand'};
- } else {
- $hash{'initialBalanceInHand'} = 0;
- $hash{'currentBalanceInHand'} = 0;
- }
- #gets the current date.
- my @nowarr = localtime();
- my $date = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
-
- $hash{'balanceDate'} = $date;
- $hash{'initialBalanceInHand'} = sprintf ("%.2f", $hash{'initialBalanceInHand'});
- $hash{'currentBalanceInHand'} = sprintf ("%.2f", $hash{'currentBalanceInHand'});
- return \%hash;
- }
-
- }
-}
-
-sub addDailyAccountOp {
- my ($description, $amount, $type, $invoice) = @_;
- my $dbh = C4::Context->dbh;
- unless ($invoice) { $invoice = undef};
- my $sth = $dbh->prepare("INSERT INTO dailyaccount (date, description, amount, type, invoice) VALUES (CURRENT_DATE(), ?, ?, ?, ?)");
- $sth->execute($description, $amount, $type, $invoice);
- my $accountop = $dbh->{'mysql_insertid'};
- $sth = $dbh->prepare("SELECT * FROM dailyaccountbalance WHERE balanceDate = CURRENT_DATE()");
- $sth->execute();
- if (!$sth->rows) {
- $sth = $dbh->prepare("SELECT currentBalanceInHand FROM dailyaccountbalance ORDER BY balanceDate DESC LIMIT 1");
- $sth->execute();
- my ($blc) = $sth->fetchrow_array;
- unless ($blc) {$blc = 0}
- $sth = $dbh->prepare("INSERT INTO dailyaccountbalance (balanceDate, initialBalanceInHand, currentBalanceInHand) VALUES (CURRENT_DATE(), ?, ?)");
- $sth->execute($blc, $blc);
- }
- if ($type eq 'D') {
- $amount = -1 * $amount;
- }
- $sth = $dbh->prepare("UPDATE dailyaccountbalance SET currentBalanceInHand = currentBalanceInHand + ? WHERE balanceDate = CURRENT_DATE()");
- $sth->execute($amount);
- return $accountop;
-}
-
-sub getDailyAccountOp {
- my ($date) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($date) {
- $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = ?");
- $sth->execute($date);
- } else {
- $sth = $dbh->prepare("SELECT * FROM dailyaccount WHERE date = CURRENT_DATE()");
- $sth->execute();
- }
- my @operations;
- my $count = 1;
- while (my $row = $sth->fetchrow_hashref) {
- $row->{'num'} = $count++;
- $row->{$row->{'type'}} = 1;
-
- $row->{'invoice'} =~ /(\w*)\-(\w*)\-(\w*)/;
- $row->{'invoiceNumber'} = $1;
- $row->{'invoiceSupplier'} = $2;
- $row->{'invoiceType'} = $3;
-
- push @operations, $row;
- }
- return (scalar(@operations), \@operations);
-}
END { } # module clean-up code here (global destructor)
1;
__END__
-=back
=head1 SEE ALSO
DBI(3)
=cut
+
require Exporter;
use C4::Context;
use C4::Date;
+use MARC::Record;
use C4::Suggestions;
-use C4::Biblio;
use Time::localtime;
use vars qw($VERSION @ISA @EXPORT);
&GetBasket &NewBasket &CloseBasket
&GetPendingOrders &GetOrder &GetOrders
&GetOrderNumber &GetLateOrders &NewOrder &DelOrder
- &GetHistory
- &ModOrder &ModReceiveOrder
- &GetSingleOrder
- &bookseller
+ &SearchOrder &GetHistory &GetRecentAcqui
+ &ModOrder &ModReceiveOrder &ModOrderBiblioNumber
+ &GetParcels &GetParcel
);
-
=head2 FUNCTIONS ABOUT BASKETS
=over 2
=cut
sub GetBasket {
- my ($basketno) = shift;
+ my ($basketno) = @_;
my $dbh = C4::Context->dbh;
my $query = "
SELECT aqbasket.*,
- concat(borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
+ borrowers.firstname+' '+borrowers.surname AS authorisedbyname,
borrowers.branchcode AS branch
FROM aqbasket
LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
=over 4
-$orders = &GetPendingOrders($booksellerid);
+$orders = &GetPendingOrders($booksellerid, $grouped);
Finds pending orders from the bookseller with the given ID. Ignores
completed and cancelled orders.
C<$orders> is a reference-to-array; each element is a
reference-to-hash with the following fields:
+C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
+in a single result line
=over 2
=cut
sub GetPendingOrders {
- my $supplierid = shift;
+ my ($supplierid,$grouped) = @_;
my $dbh = C4::Context->dbh;
- my $strsth = "SELECT aqorders.*,aqbasket.*,borrowers.firstname,borrowers.surname
- FROM aqorders
- LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
- LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
- WHERE booksellerid=?
- AND (quantity > quantityreceived OR quantityreceived is NULL)
- AND datecancellationprinted IS NULL
- AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL) ";
-
+ my $strsth = "
+ SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
+ surname,firstname,aqorders.*,
+ aqbasket.closedate, aqbasket.creationdate
+ FROM aqorders
+ LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
+ LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
+ WHERE booksellerid=?
+ AND (quantity > quantityreceived OR quantityreceived is NULL)
+ AND datecancellationprinted IS NULL
+ AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
+ ";
+ ## FIXME Why 180 days ???
if ( C4::Context->preference("IndependantBranches") ) {
my $userenv = C4::Context->userenv;
if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
. "' or borrowers.branchcode ='')";
}
}
- $strsth .= " group by aqbasket.basketno order by aqbasket.basketno";
+ $strsth .= " group by aqbasket.basketno" if $grouped;
+ $strsth .= " order by aqbasket.basketno";
+
my $sth = $dbh->prepare($strsth);
$sth->execute($supplierid);
- my @results;
- while (my $data = $sth->fetchrow_hashref ) {
- push @results, $data ;
- }
+ my $results = $sth->fetchall_arrayref({});
$sth->finish;
- return \@results;
+ return $results;
}
#------------------------------------------------------------#
@orders = &GetOrders($basketnumber, $orderby);
-Looks up the non-cancelled orders (whether received or not) with the given basket
+Looks up the pending (non-cancelled) orders with the given basket
number. If C<$booksellerID> is non-empty, only orders from that seller
are returned.
sub GetOrders {
my ( $basketno, $orderby ) = @_;
my $dbh = C4::Context->dbh;
- my $query ="
- SELECT aqorderbreakdown.*,
- biblio.*,
- aqorders.*
- FROM aqorders,biblio
- LEFT JOIN aqorderbreakdown ON
- aqorders.ordernumber=aqorderbreakdown.ordernumber
+ my $query ="
+ SELECT aqorderbreakdown.*,
+ biblio.*,biblioitems.*,
+ aqorders.*,
+ aqbookfund.bookfundname,
+ biblio.title
+ FROM aqorders
+ LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
+ LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
+ LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=aqorders.biblioitemnumber
+ LEFT JOIN aqbookfund ON aqbookfund.bookfundid=aqorderbreakdown.bookfundid
WHERE basketno=?
- AND biblio.biblionumber=aqorders.biblionumber
AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
";
- $orderby = "biblio.title" unless $orderby;
+ $orderby = "biblioitems.publishercode" unless $orderby;
$query .= " ORDER BY $orderby";
my $sth = $dbh->prepare($query);
$sth->execute($basketno);
my @results;
- # print $query;
while ( my $data = $sth->fetchrow_hashref ) {
push @results, $data;
}
return @results;
}
-sub GetSingleOrder {
- my ($ordnum)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from biblio,aqorders left join aqorderbreakdown
- on aqorders.ordernumber=aqorderbreakdown.ordernumber
- where aqorders.ordernumber=?
- and biblio.biblionumber=aqorders.biblionumber");
- $sth->execute($ordnum);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data);
-}
-
#------------------------------------------------------------#
=head3 GetOrderNumber
$ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
-Looks up the ordernumber with the given biblionumber
+Looks up the ordernumber with the given biblionumber and biblioitemnumber.
Returns the number of this order.
=cut
sub GetOrderNumber {
- my ( $biblionumber ) = @_;
+ my ( $biblionumber,$biblioitemnumber ) = @_;
my $dbh = C4::Context->dbh;
my $query = "
SELECT ordernumber
FROM aqorders
WHERE biblionumber=?
-
+ AND biblioitemnumber=?
";
my $sth = $dbh->prepare($query);
- $sth->execute( $biblionumber );
+ $sth->execute( $biblionumber, $biblioitemnumber );
return $sth->fetchrow;
}
Looks up an order by order number.
Returns a reference-to-hash describing the order. The keys of
-C<$order> are fields from the biblio, , aqorders, and
+C<$order> are fields from the biblio, biblioitems, aqorders, and
aqorderbreakdown tables of the Koha database.
=back
my $dbh = C4::Context->dbh;
my $query = "
SELECT *
- FROM biblio,aqorders
+ FROM aqorders
LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
+ LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
+ LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
WHERE aqorders.ordernumber=?
- AND biblio.biblionumber=aqorders.biblionumber
-
+
";
my $sth= $dbh->prepare($query);
$sth->execute($ordnum);
sub NewOrder {
my (
- $basketno, $biblionumber, $title, $quantity,
+ $basketno, $bibnum, $title, $quantity,
$listprice, $booksellerid, $authorisedby, $notes,
- $bookfund, $rrp, $ecost,
+ $bookfund, $bibitemnum, $rrp, $ecost,
$gst, $budget, $cost, $sub,
- $purchaseorderno, $sort1, $sort2,$discount,$branch
+ $invoice, $sort1, $sort2
)
= @_;
$budget = "now()";
}
+ # if month is july or more, budget start is 1 jul, next year.
+ elsif ( $month >= '7' ) {
+ ++$year; # add 1 to year , coz its next year
+ $budget = "'$year-07-01'";
+ }
+ else {
+
+ # START OF NEW BUDGET, 1ST OF JULY, THIS YEAR
+ $budget = "'$year-07-01'";
+ }
+
if ( $sub eq 'yes' ) {
$sub = 1;
}
my $query = "
INSERT INTO aqorders
( biblionumber,title,basketno,quantity,listprice,notes,
- rrp,ecost,gst,unitprice,subscription,sort1,sort2,purchaseordernumber,discount,budgetdate,entrydate)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() )
+ biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() )
";
my $sth = $dbh->prepare($query);
$sth->execute(
- $biblionumber, $title, $basketno, $quantity, $listprice,
- $notes, $rrp, $ecost, $gst,
- $cost, $sub, $sort1, $sort2,$purchaseorderno,$discount
+ $bibnum, $title, $basketno, $quantity, $listprice,
+ $notes, $bibitemnum, $rrp, $ecost, $gst,
+ $cost, $sub, $sort1, $sort2
);
$sth->finish;
#get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
my $ordnum = $dbh->{'mysql_insertid'};
- my $query = "
- INSERT INTO aqorderbreakdown (ordernumber,bookfundid,branchcode)
- VALUES (?,?,?)
+ $query = "
+ INSERT INTO aqorderbreakdown (ordernumber,bookfundid)
+ VALUES (?,?)
";
$sth = $dbh->prepare($query);
- $sth->execute( $ordnum, $bookfund,$branch );
+ $sth->execute( $ordnum, $bookfund );
$sth->finish;
return ( $basketno, $ordnum );
}
sub ModOrder {
my (
- $title, $ordnum, $quantity, $listprice, $biblionumber,
+ $title, $ordnum, $quantity, $listprice, $bibnum,
$basketno, $supplier, $who, $notes, $bookfund,
- $rrp, $ecost, $gst, $budget,
- $cost, $invoice, $sort1, $sort2,$discount,$branch
+ $bibitemnum, $rrp, $ecost, $gst, $budget,
+ $cost, $invoice, $sort1, $sort2
)
= @_;
my $dbh = C4::Context->dbh;
UPDATE aqorders
SET title=?,
quantity=?,listprice=?,basketno=?,
- rrp=?,ecost=?,unitprice=?,purchaseordernumber=?,gst=?,
- notes=?,sort1=?, sort2=?,discount=?
+ rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
+ notes=?,sort1=?, sort2=?
WHERE ordernumber=? AND biblionumber=?
";
my $sth = $dbh->prepare($query);
$sth->execute(
$title, $quantity, $listprice, $basketno, $rrp,
- $ecost, $cost, $invoice, $gst, $notes, $sort1,
- $sort2, $discount,$ordnum, $biblionumber
+ $ecost, $cost, $invoice, $notes, $sort1,
+ $sort2, $ordnum, $bibnum
);
$sth->finish;
- my $query = "
- REPLACE aqorderbreakdown
- SET ordernumber=?, bookfundid=?, branchcode=?
+ $query = "
+ UPDATE aqorderbreakdown
+ SET bookfundid=?
+ WHERE ordernumber=?
";
$sth = $dbh->prepare($query);
- $sth->execute( $ordnum,$bookfund, $branch );
-
+ unless ( $sth->execute( $bookfund, $ordnum ) )
+ { # zero rows affected [Bug 734]
+ my $query ="
+ INSERT INTO aqorderbreakdown
+ (ordernumber,bookfundid)
+ VALUES (?,?)
+ ";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $ordnum, $bookfund );
+ }
$sth->finish;
}
#------------------------------------------------------------#
+=head3 ModOrderBiblioNumber
+
+=over 4
+&ModOrderBiblioNumber($biblioitemnumber,$ordnum, $biblionumber);
+Modifies the biblioitemnumber for an existing order.
+Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
+
+=back
+
+=cut
+
+sub ModOrderBiblioNumber {
+ my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ UPDATE aqorders
+ SET biblioitemnumber = ?
+ WHERE ordernumber = ?
+ AND biblionumber = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
+}
#------------------------------------------------------------#
Updates the order with bibilionumber C<$biblionumber> and ordernumber
C<$ordernumber>.
+Also updates the book fund ID in the aqorderbreakdown table.
=back
sub ModReceiveOrder {
my (
- $biblionumber, $ordnum, $quantrec, $cost,
- $invoiceno, $freight, $rrp, $listprice,$input
+ $biblionumber, $ordnum, $quantrec, $user, $cost,
+ $invoiceno, $freight, $rrp, $bookfund, $daterecieved
)
= @_;
my $dbh = C4::Context->dbh;
+# warn "DATE BEFORE : $daterecieved";
+ $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
+# warn "DATE REC : $daterecieved";
my $query = "
UPDATE aqorders
- SET quantityreceived=quantityreceived+?,datereceived=now(),booksellerinvoicenumber=?,
- unitprice=?,freight=?,rrp=?,listprice=?
+ SET quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
+ unitprice=?,freight=?,rrp=?
WHERE biblionumber=? AND ordernumber=?
";
my $sth = $dbh->prepare($query);
my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
if ($suggestionid) {
- ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber,$input );
+ ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
}
- $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $listprice, $biblionumber,
- $ordnum );
+ $sth->execute( $quantrec,$daterecieved, $invoiceno, $cost, $freight, $rrp, $biblionumber,
+ $ordnum);
$sth->finish;
+ # Allows libraries to change their bookfund during receiving orders
+ # allows them to adjust budgets
+ if ( C4::Context->preferene("LooseBudgets") ) {
+ my $query = "
+ UPDATE aqorderbreakdown
+ SET bookfundid=?
+ WHERE ordernumber=?
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $bookfund, $ordnum );
+ $sth->finish;
+ }
+ return $daterecieved;
}
+#------------------------------------------------------------#
+
+=head3 SearchOrder
+
+@results = &SearchOrder($search, $biblionumber, $complete);
+
+Searches for orders.
+
+C<$search> may take one of several forms: if it is an ISBN,
+C<&ordersearch> returns orders with that ISBN. If C<$search> is an
+order number, C<&ordersearch> returns orders with that order number
+and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
+to be a space-separated list of search terms; in this case, all of the
+terms must appear in the title (matching the beginning of title
+words).
+
+If C<$complete> is C<yes>, the results will include only completed
+orders. In any case, C<&ordersearch> ignores cancelled orders.
+
+C<&ordersearch> returns an array.
+C<@results> is an array of references-to-hash with the following keys:
+
+=over 4
+
+=item C<author>
+
+=item C<seriestitle>
+
+=item C<branchcode>
+
+=item C<bookfundid>
+
+=back
+
+=cut
+
+sub SearchOrder {
+ my ( $search, $id, $biblionumber, $catview ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @data = split( ' ', $search );
+ my @searchterms;
+ if ($id) {
+ @searchterms = ($id);
+ }
+ map { push( @searchterms, "$_%", "% $_%" ) } @data;
+ push( @searchterms, $search, $search, $biblionumber );
+ my $query;
+ if ($id) {
+ $query =
+ "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
+ WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
+ aqorders.basketno = aqbasket.basketno
+ AND aqbasket.booksellerid = ?
+ AND biblio.biblionumber=aqorders.biblionumber
+ AND ((datecancellationprinted is NULL)
+ OR (datecancellationprinted = '0000-00-00'))
+ AND (("
+ . (
+ join( " AND ",
+ map { "(biblio.title like ? or biblio.title like ?)" } @data )
+ )
+ . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
+
+ }
+ else {
+ $query =
+ " SELECT *,biblio.title
+ FROM aqorders,biblioitems,biblio,aqbasket
+ WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber
+ AND aqorders.basketno = aqbasket.basketno
+ AND biblio.biblionumber=aqorders.biblionumber
+ AND ((datecancellationprinted is NULL)
+ OR (datecancellationprinted = '0000-00-00'))
+ AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
+ AND (("
+ . (
+ join( " AND ",
+ map { "(biblio.title like ? OR biblio.title like ?)" } @data )
+ )
+ . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
+ }
+ $query .= " GROUP BY aqorders.ordernumber";
+ ### $query
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@searchterms);
+ my @results = ();
+ my $query2 = "
+ SELECT *
+ FROM biblio
+ WHERE biblionumber=?
+ ";
+ my $sth2 = $dbh->prepare($query2);
+ my $query3 = "
+ SELECT *
+ FROM aqorderbreakdown
+ WHERE ordernumber=?
+ ";
+ my $sth3 = $dbh->prepare($query3);
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $sth2->execute( $data->{'biblionumber'} );
+ my $data2 = $sth2->fetchrow_hashref;
+ $data->{'author'} = $data2->{'author'};
+ $data->{'seriestitle'} = $data2->{'seriestitle'};
+ $sth3->execute( $data->{'ordernumber'} );
+ my $data3 = $sth3->fetchrow_hashref;
+ $data->{'branchcode'} = $data3->{'branchcode'};
+ $data->{'bookfundid'} = $data3->{'bookfundid'};
+ push( @results, $data );
+ }
+ ### @results
+ $sth->finish;
+ $sth2->finish;
+ $sth3->finish;
+ return @results;
+}
#------------------------------------------------------------#
=cut
sub DelOrder {
- my ( $biblionumber, $ordnum,$user ) = @_;
+ my ( $bibnum, $ordnum ) = @_;
my $dbh = C4::Context->dbh;
my $query = "
UPDATE aqorders
- SET datecancellationprinted=now(), cancelledby=?
+ SET datecancellationprinted=now()
WHERE biblionumber=? AND ordernumber=?
";
my $sth = $dbh->prepare($query);
- $sth->execute( $user,$biblionumber, $ordnum );
+ $sth->execute( $bibnum, $ordnum );
$sth->finish;
}
bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
C<@results> is an array of references-to-hash. The keys of each element are fields from
-the aqorders, biblio tables of the Koha database.
+the aqorders, biblio, and biblioitems tables of the Koha database.
C<@results> is sorted alphabetically by book title.
=back
=cut
-## This routine is not used will be cleaned
-sub GetParcel {
+sub GetParcel {
#gets all orders from a certain supplier, orders them alphabetically
- my ( $supplierid, $invoice, $datereceived ) = @_;
+ my ( $supplierid, $code, $datereceived ) = @_;
my $dbh = C4::Context->dbh;
my @results = ();
- $invoice .= '%' if $invoice; # add % if we search on a given invoice
+ $code .= '%'
+ if $code; # add % if we search on a given code (otherwise, let him empty)
my $strsth ="
SELECT authorisedby,
creationdate,
aqbasket.basketno,
closedate,surname,
firstname,
- biblionumber,
+ aqorders.biblionumber,
aqorders.title,
aqorders.ordernumber,
aqorders.quantity,
LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
WHERE aqbasket.basketno=aqorders.basketno
AND aqbasket.booksellerid=?
- AND (aqorders.datereceived= \"$datereceived\" OR aqorders.datereceived is NULL)";
- $strsth.= " AND aqorders.purchaseordernumber LIKE \"$invoice\"" if $invoice ne "%";
+ AND aqorders.booksellerinvoicenumber LIKE \"$code\"
+ AND aqorders.datereceived= \'$datereceived\'";
if ( C4::Context->preference("IndependantBranches") ) {
my $userenv = C4::Context->userenv;
my $sth = $dbh->prepare($strsth);
$sth->execute($supplierid);
while ( my $data = $sth->fetchrow_hashref ) {
- push @results, $data ;
+ push( @results, $data );
}
- ### countparcelbiblio: $count
+ ### countparcelbiblio: scalar(@results)
$sth->finish;
return @results;
=back
=cut
-### This routine is not used will be cleaned
+
sub GetParcels {
my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
my $dbh = C4::Context->dbh;
$strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
$strsth .= "order by $order " if ($order);
+### $strsth
my $sth = $dbh->prepare($strsth);
$sth->execute;
- my @results;
-
- while ( my $data2 = $sth->fetchrow_hashref ) {
- push @results, $data2;
- }
-
+ my $results = $sth->fetchall_arrayref({});
$sth->finish;
- return @results;
+ return @$results;
}
#------------------------------------------------------------#
=cut
sub GetLateOrders {
-## requirse fixing for KOHA 3 API. Currently does not return publisher
my $delay = shift;
my $supplierid = shift;
my $branch = shift;
# warn " $dbdriver";
if ( $dbdriver eq "mysql" ) {
$strsth = "
- SELECT aqbasket.basketno,
+ SELECT aqbasket.basketno,aqorders.ordernumber,
DATE(aqbasket.closedate) AS orderdate,
aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
aqorders.rrp AS unitpricesupplier,
aqbooksellers.name AS supplier,
aqorders.title,
biblio.author,
-
+ biblioitems.publishercode AS publisher,
+ biblioitems.publicationyear,
DATEDIFF(CURDATE( ),closedate) AS latesince
- FROM ((
+ FROM (((
(aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
-
+ LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber)
LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber)
LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
(aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
aqbooksellers.name AS supplier,
biblio.title,
biblio.author,
-
+ biblioitems.publishercode AS publisher,
+ biblioitems.publicationyear,
(CURDATE - closedate) AS latesince
- FROM((
+ FROM(( (
(aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber)
-
+ LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber)
LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber)
LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
aqorders.quantity,
aqorders.quantityreceived,
aqorders.ecost,
- aqorders.ordernumber
+ aqorders.ordernumber,
+ aqorders.booksellerinvoicenumber as invoicenumber,
+ aqbooksellers.id as id
FROM aqorders,aqbasket,aqbooksellers,biblio";
$query .= ",borrowers "
return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
}
-#------------------------------------------------------------#
-
-=head3 bookseller
-
-=over 4
-
-($count, @results) = &bookseller($searchstring);
-
-Looks up a book seller. C<$searchstring> may be either a book seller
-ID, or a string to look for in the book seller's name.
+=head2 GetRecentAcqui
-C<$count> is the number of elements in C<@results>. C<@results> is an
-array of references-to-hash, whose keys are the fields of of the
-aqbooksellers table in the Koha database.
+ $results = GetRecentAcqui($days);
-=back
+ C<$results> is a ref to a table which containts hashref
=cut
-sub bookseller {
- my ($searchstring) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
- $sth->execute( "$searchstring%", $searchstring );
- my @results;
- while ( my $data = $sth->fetchrow_hashref ) {
- push( @results, $data );
- }
- $sth->finish;
- return ( scalar(@results), @results );
+sub GetRecentAcqui {
+ my $limit = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT *
+ FROM biblio
+ ORDER BY timestamp DESC
+ LIMIT 0,".$limit;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ while(my $data = $sth->fetchrow_hashref){
+ push @results,$data;
+ }
+ return \@results;
}
END { } # module clean-up code here (global destructor)
# loop SimilarProducts (Product)
# loop Reviews (rating, Summary)
#
+use XML::Simple;
+use LWP::Simple;
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 0.01;
+$VERSION = 0.02;
+=head1 NAME
+
+C4::Amazon - Functions for retrieving Amazon.com content in Koha
+
+=head1 FUNCTIONS
+
+This module provides facilities for retrieving Amazon.com content in Koha
+
+=cut
@ISA = qw(Exporter);
&get_amazon_details
);
+=head1 get_amazon_details($isbn);
+
+=head2 $isbn is a isbn string
+
+=cut
+
sub get_amazon_details {
my ( $isbn ) = @_;
# insert your dev key here
-my $dev_key='neulibrary-20';
-$isbn=substr($isbn,0,9);
+ $isbn =~ s/(p|-)//g;
+
# insert your associates tag here
-my $af_tag='0YGCZ5GV9ZNGGS7THDG2';
+ my $dev_key=C4::Context->preference('AmazonDevKey');
+
+ #grab the associates tag: mine is '0ZRY7YASKJS280T7YB02'
+ my $af_tag=C4::Context->preference('AmazonAssocTag');
my $asin=$isbn;
# "&dev-t=" . $dev_key .
# "&type=heavy&f=xml&" .
# "AsinSearch=" . $asin;
-my $url = "http://xml.amazon.com/onca/xml3?t=$dev_key&dev-t=$af_tag&type=heavy&f=xml&AsinSearch=" . $asin;
-
-#Here's an example asin for the book "Cryptonomicon"
-#0596005423";
-
-use XML::Simple;
-use LWP::Simple;
+ my $url = "http://xml.amazon.com/onca/xml3?t=$af_tag&dev-t=$dev_key&type=heavy&f=xml&AsinSearch=" . $asin;
my $content = get($url);
-if ($content){
-
+ warn "could not retrieve $url" unless $content;
my $xmlsimple = XML::Simple->new();
my $response = $xmlsimple->XMLin($content,
- forcearray => [ qw(Details Product AvgCustomerRating CustomerReview ) ],
+ forcearray => [ qw(Details Product AvgCustomerRating CustomerReview) ],
);
return $response;
-#foreach my $result (@{$response->{Details}}){
-# my $product_description = $result->{ProductDescription};
-# my $image = $result->{ImageUrlMedium};
-# my $price = $result->{ListPrice};
-# my $reviews = $result->{
-# return $result;
-#}
}
-}
\ No newline at end of file
+
+=head1 NOTES
+
+=head1 AUTHOR
+
+Joshua Ferraro <jmf@liblime.com>
+=cut
require Exporter;
use C4::Context;
-use C4::Output; # to get the template
+use C4::Output; # to get the template
use C4::Interface::CGI::Output;
-use C4::Members; # getpatroninformation
-use C4::Koha;## to get branch
+use C4::Circulation::Circ2; # getpatroninformation
+use C4::Koha;
+use C4::Branch; # GetBranches
+
# use Net::LDAP;
# use Net::LDAP qw(:all);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = 0.01;
-@ISA = qw(Exporter);
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
-@EXPORT = qw(
-&checkpw
-);
=head1 NAME
C4::Auth - Authenticates Koha users
});
print $query->header(
- -type => "text/html",
- -charset=>"utf-8",
+ -type => guesstype($template->output),
-cookie => $cookie
), $template->output;
=cut
-
-
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &checkauth
- &get_template_and_user
+ &checkauth
+ &get_template_and_user
);
=item get_template_and_user
=cut
-
sub get_template_and_user {
- my $in = shift;
- my $template = gettemplate($in->{'template_name'}, $in->{'type'},$in->{'query'});
- my ($user, $cookie, $sessionID, $flags)
- = checkauth($in->{'query'}, $in->{'authnotrequired'}, $in->{'flagsrequired'}, $in->{'type'});
-
- my $borrowernumber;
- if ($user) {
- $template->param(loggedinusername => $user);
- $template->param(sessionID => $sessionID);
-
- $borrowernumber = getborrowernumber($user);
- my ($borr, $alternativeflags) = getpatroninformation(undef, $borrowernumber);
- my @bordat;
- $bordat[0] = $borr;
- $template->param(USER_INFO => \@bordat,
- );
- my $branches=GetBranches();
- $template->param(branchname=>$branches->{$borr->{branchcode}}->{branchname},);
-
- # We are going to use the $flags returned by checkauth
- # to create the template's parameters that will indicate
- # which menus the user can access.
- if ($flags && $flags->{superlibrarian} == 1)
- {
- $template->param(CAN_user_circulate => 1);
- $template->param(CAN_user_catalogue => 1);
- $template->param(CAN_user_parameters => 1);
- $template->param(CAN_user_borrowers => 1);
- $template->param(CAN_user_permission => 1);
- $template->param(CAN_user_reserveforothers => 1);
- $template->param(CAN_user_borrow => 1);
- $template->param(CAN_user_reserveforself => 1);
- $template->param(CAN_user_editcatalogue => 1);
- $template->param(CAN_user_updatecharge => 1);
- $template->param(CAN_user_acquisition => 1);
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
- if ($flags && $flags->{circulate} == 1) {
- $template->param(CAN_user_circulate => 1); }
-
- if ($flags && $flags->{catalogue} == 1) {
- $template->param(CAN_user_catalogue => 1); }
-
-
- if ($flags && $flags->{parameters} == 1) {
- $template->param(CAN_user_parameters => 1);
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
-
- if ($flags && $flags->{borrowers} == 1) {
- $template->param(CAN_user_borrowers => 1); }
-
-
- if ($flags && $flags->{permissions} == 1) {
- $template->param(CAN_user_permission => 1); }
-
- if ($flags && $flags->{reserveforothers} == 1) {
- $template->param(CAN_user_reserveforothers => 1); }
+ my $in = shift;
+ my $template =
+ gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
+ my ( $user, $cookie, $sessionID, $flags ) = checkauth(
+ $in->{'query'},
+ $in->{'authnotrequired'},
+ $in->{'flagsrequired'},
+ $in->{'type'}
+ );
+
+ my $borrowernumber;
+ my $insecure = C4::Context->preference('insecure');
+ if ($user or $insecure) {
+ $template->param( loggedinusername => $user );
+ $template->param( sessionID => $sessionID );
+
+ $borrowernumber = getborrowernumber($user);
+ my ( $borr, $alternativeflags ) =
+ getpatroninformation( undef, $borrowernumber );
+ my @bordat;
+ $bordat[0] = $borr;
+ $template->param( "USER_INFO" => \@bordat );
+
+ # We are going to use the $flags returned by checkauth
+ # to create the template's parameters that will indicate
+ # which menus the user can access.
+ if (( $flags && $flags->{superlibrarian}==1) or $insecure==1) {
+ $template->param( CAN_user_circulate => 1 );
+ $template->param( CAN_user_catalogue => 1 );
+ $template->param( CAN_user_parameters => 1 );
+ $template->param( CAN_user_borrowers => 1 );
+ $template->param( CAN_user_permission => 1 );
+ $template->param( CAN_user_reserveforothers => 1 );
+ $template->param( CAN_user_borrow => 1 );
+ $template->param( CAN_user_editcatalogue => 1 );
+ $template->param( CAN_user_updatecharge => 1 );
+ $template->param( CAN_user_acquisition => 1 );
+ $template->param( CAN_user_management => 1 );
+ $template->param( CAN_user_tools => 1 );
+ $template->param( CAN_user_editauthorities => 1 );
+ $template->param( CAN_user_serials => 1 );
+ $template->param( CAN_user_reports => 1 );
+ }
+
+ if ( $flags && $flags->{circulate} == 1 ) {
+ $template->param( CAN_user_circulate => 1 );
+ }
+
+ if ( $flags && $flags->{catalogue} == 1 ) {
+ $template->param( CAN_user_catalogue => 1 );
+ }
+
+ if ( $flags && $flags->{parameters} == 1 ) {
+ $template->param( CAN_user_parameters => 1 );
+ $template->param( CAN_user_management => 1 );
+ }
+
+ if ( $flags && $flags->{borrowers} == 1 ) {
+ $template->param( CAN_user_borrowers => 1 );
+ }
+
+ if ( $flags && $flags->{permissions} == 1 ) {
+ $template->param( CAN_user_permission => 1 );
+ }
+
+ if ( $flags && $flags->{reserveforothers} == 1 ) {
+ $template->param( CAN_user_reserveforothers => 1 );
+ }
+
+ if ( $flags && $flags->{borrow} == 1 ) {
+ $template->param( CAN_user_borrow => 1 );
+ }
+
+ if ( $flags && $flags->{editcatalogue} == 1 ) {
+ $template->param( CAN_user_editcatalogue => 1 );
+ }
+
+ if ( $flags && $flags->{updatecharges} == 1 ) {
+ $template->param( CAN_user_updatecharge => 1 );
+ }
+
+ if ( $flags && $flags->{acquisition} == 1 ) {
+ $template->param( CAN_user_acquisition => 1 );
+ }
+
+ if ( $flags && $flags->{tools} == 1 ) {
+ $template->param( CAN_user_tools => 1 );
+ }
+
+ if ( $flags && $flags->{editauthorities} == 1 ) {
+ $template->param( CAN_user_editauthorities => 1 );
+ }
+ if ( $flags && $flags->{serials} == 1 ) {
+ $template->param( CAN_user_serials => 1 );
+ }
- if ($flags && $flags->{borrow} == 1) {
- $template->param(CAN_user_borrow => 1); }
-
-
- if ($flags && $flags->{reserveforself} == 1) {
- $template->param(CAN_user_reserveforself => 1); }
-
-
- if ($flags && $flags->{editcatalogue} == 1) {
- $template->param(CAN_user_editcatalogue => 1); }
-
-
- if ($flags && $flags->{updatecharges} == 1) {
- $template->param(CAN_user_updatecharge => 1); }
-
- if ($flags && $flags->{acquisition} == 1) {
- $template->param(CAN_user_acquisition => 1); }
-
- if ($flags && $flags->{management} == 1) {
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
- if ($flags && $flags->{tools} == 1) {
- $template->param(CAN_user_tools => 1); }
-
- }
- if ($in->{'type'} eq "intranet") {
+ if ( $flags && $flags->{reports} == 1 ) {
+ $template->param( CAN_user_reports => 1 );
+ }
+ }
+ if ( $in->{'type'} eq "intranet" ) {
$template->param(
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
-
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ intranetuserjs => C4::Context->preference("intranetuserjs"),
+ TemplateEncoding => C4::Context->preference("TemplateEncoding"),
+ AmazonContent => C4::Context->preference("AmazonContent"),
+ LibraryName => C4::Context->preference("LibraryName"),
+ LoginBranchname => (C4::Context->userenv?C4::Context->userenv->{"branchname"}:"insecure"),
+ AutoLocation => C4::Context->preference("AutoLocation"),
+ hide_marc => C4::Context->preference("hide_marc"),
+ patronimages => C4::Context->preference("patronimages"),
+ "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
);
-
- }
- else {
- $template->param(
- suggestion => C4::Context->preference("suggestion"),
- virtualshelves => C4::Context->preference("virtualshelves"),
- OpacNav => C4::Context->preference("OpacNav"),
- opacheader => C4::Context->preference("opacheader"),
- opaccredits => C4::Context->preference("opaccredits"),
- opacsmallimage => C4::Context->preference("opacsmallimage"),
- opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
- opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
- opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
- TemplateEncoding => C4::Context->preference("TemplateEncoding"),
- opacuserlogin => C4::Context->preference("opacuserlogin"),
- opacbookbag => C4::Context->preference("opacbookbag"),
- );
- }
+ }
+ else {
+ warn "template type should be OPAC, here it is=[" . $in->{'type'} . "]"
+ unless ( $in->{'type'} eq 'opac' );
+ my $LibraryNameTitle = C4::Context->preference("LibraryName");
+ $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
+ $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
$template->param(
- TemplateEncoding => C4::Context->preference("TemplateEncoding"),
- AmazonContent => C4::Context->preference("AmazonContent"),
- LibraryName => C4::Context->preference("LibraryName"),
- );
- return ($template, $borrowernumber, $cookie);
+ suggestion => "" . C4::Context->preference("suggestion"),
+ virtualshelves => "" . C4::Context->preference("virtualshelves"),
+ OpacNav => "" . C4::Context->preference("OpacNav"),
+ opacheader => "" . C4::Context->preference("opacheader"),
+ opaccredits => "" . C4::Context->preference("opaccredits"),
+ opacsmallimage => "" . C4::Context->preference("opacsmallimage"),
+ opaclargeimage => "" . C4::Context->preference("opaclargeimage"),
+ opaclayoutstylesheet => "". C4::Context->preference("opaclayoutstylesheet"),
+ opaccolorstylesheet => "". C4::Context->preference("opaccolorstylesheet"),
+ opaclanguagesdisplay => "". C4::Context->preference("opaclanguagesdisplay"),
+ opacuserlogin => "" . C4::Context->preference("opacuserlogin"),
+ opacbookbag => "" . C4::Context->preference("opacbookbag"),
+ TemplateEncoding => "". C4::Context->preference("TemplateEncoding"),
+ AmazonContent => "" . C4::Context->preference("AmazonContent"),
+ LibraryName => "" . C4::Context->preference("LibraryName"),
+ LibraryNameTitle => "" . $LibraryNameTitle,
+ LoginBranchname => C4::Context->userenv?C4::Context->userenv->{"branchname"}:"",
+ OpacPasswordChange => C4::Context->preference("OpacPasswordChange"),
+ opacreadinghistory => C4::Context->preference("opacreadinghistory"),
+ opacuserjs => C4::Context->preference("opacuserjs"),
+ OpacCloud => C4::Context->preference("OpacCloud"),
+ OpacTopissue => C4::Context->preference("OpacTopissue"),
+ OpacAuthorities => C4::Context->preference("OpacAuthorities"),
+ OpacBrowser => C4::Context->preference("OpacBrowser"),
+ RequestOnOpac => C4::Context->preference("RequestOnOpac"),
+ reviewson => C4::Context->preference("reviewson"),
+ hide_marc => C4::Context->preference("hide_marc"),
+ patronimages => C4::Context->preference("patronimages"),
+ "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
+ );
+ }
+ return ( $template, $borrowernumber, $cookie );
}
-
=item checkauth
($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type);
=cut
+sub checkauth {
+ my $query = shift;
+
+# $authnotrequired will be set for scripts which will run without authentication
+ my $authnotrequired = shift;
+ my $flagsrequired = shift;
+ my $type = shift;
+ $type = 'opac' unless $type;
+ my $dbh = C4::Context->dbh;
+ my $timeout = C4::Context->preference('timeout');
+ $timeout = 600 unless $timeout;
-sub checkauth {
- my $query=shift;
- # $authnotrequired will be set for scripts which will run without authentication
- my $authnotrequired = shift;
- my $flagsrequired = shift;
- my $type = shift;
- $type = 'opac' unless $type;
-
- my $dbh = C4::Context->dbh;
- my $timeout = C4::Context->preference('timeout');
- $timeout = 600 unless $timeout;
-
- my $template_name;
- if ($type eq 'opac') {
- $template_name = "opac-auth.tmpl";
- } else {
- $template_name = "auth.tmpl";
- }
-
- # state variables
- my $loggedin = 0;
- my %info;
- my ($userid, $cookie, $sessionID, $flags,$envcookie);
- my $logout = $query->param('logout.x');
- if ($userid = $ENV{'REMOTE_USER'}) {
- # Using Basic Authentication, no cookies required
- $cookie=$query->cookie(-name => 'sessionID',
- -value => '',
- -expires => '');
- $loggedin = 1;
- } elsif ($sessionID=$query->cookie('sessionID')) {
- C4::Context->_new_userenv($sessionID);
- if (my %hash=$query->cookie('userenv')){
- C4::Context::set_userenv(
- $hash{number},
- $hash{id},
- $hash{cardnumber},
- $hash{firstname},
- $hash{surname},
- $hash{branch},
- $hash{branchname},
- $hash{flags},
- $hash{emailaddress},
- );
- }
- my ($ip , $lasttime);
-
- ($userid, $ip, $lasttime) = $dbh->selectrow_array(
- "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
- undef, $sessionID);
- if ($logout) {
- # voluntary logout the user
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $sessionID = undef;
- $userid = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time;
- close L;
- }
- if ($userid) {
- if ($lasttime<time()-$timeout) {
- # timed logout
- $info{'timed_out'} = 1;
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $userid = undef;
- $sessionID = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
- close L;
- } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
- # Different ip than originally logged in from
- $info{'oldip'} = $ip;
- $info{'newip'} = $ENV{'REMOTE_ADDR'};
- $info{'different_ip'} = 1;
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $sessionID = undef;
- $userid = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'};
- close L;
- } else {
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?",
- undef, (time(), $sessionID));
- $flags = haspermission($dbh, $userid, $flagsrequired);
- if ($flags) {
- $loggedin = 1;
- } else {
- $info{'nopermission'} = 1;
- }
- }
- }
- }
- unless ($userid) {
- $sessionID=int(rand()*100000).'-'.time();
- $userid=$query->param('userid');
- my $password=$query->param('password');
- C4::Context->_new_userenv($sessionID);
- my ($return, $cardnumber) = checkpw($dbh,$userid,$password);
- if ($return) {
- $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?",
- undef, ($sessionID, $userid));
- $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
- undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time()));
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged in at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
- close L;
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- if ($flags = haspermission($dbh, $userid, $flagsrequired)) {
- $loggedin = 1;
- } else {
- $info{'nopermission'} = 1;
- C4::Context->_unset_userenv($sessionID);
- }
- if ($return == 1){
- my ($bornum,$firstname,$surname,$userflags,$branchcode,$branchname,$emailaddress);
- my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,borrowers.branchcode,branchname,emailaddress from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?");
- $sth->execute($userid);
- ($bornum,$firstname,$surname,$userflags,$branchcode,$branchname, $emailaddress) = $sth->fetchrow if ($sth->rows);
-# warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
- unless ($sth->rows){
- my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,borrowers.branchcode,branchname,emailaddress from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?");
- $sth->execute($cardnumber);
- ($bornum,$firstname,$surname,$userflags,$branchcode, $branchname,$emailaddress) = $sth->fetchrow if ($sth->rows);
-# warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
- unless ($sth->rows){
- $sth->execute($userid);
- ($bornum,$firstname,$surname,$userflags,$branchcode, $branchname, $emailaddress) = $sth->fetchrow if ($sth->rows);
- }
-# warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
- }
- my $hash = C4::Context::set_userenv(
- $bornum,
- $userid,
- $cardnumber,
- $firstname,
- $surname,
- $branchcode,
- $branchname,
- $userflags,
- $emailaddress,
- );
-# warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
- $envcookie=$query->cookie(-name => 'userenv',
- -value => $hash,
- -expires => '');
- } elsif ($return == 2) {
- #We suppose the user is the superlibrarian
- my $hash = C4::Context::set_userenv(
- 0,0,
- C4::Context->config('user'),
- C4::Context->config('user'),
- C4::Context->config('user'),
- "","",1,C4::Context->preference('KohaAdminEmailAddress')
- );
- $envcookie=$query->cookie(-name => 'userenv',
- -value => $hash,
- -expires => '');
- }
- } else {
- if ($userid) {
- $info{'invalid_username_or_password'} = 1;
- C4::Context->_unset_userenv($sessionID);
- }
- }
- }
- my $insecure = C4::Context->boolean_preference('insecure');
- # finished authentification, now respond
- if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) {
- # successful login
- unless ($cookie) {
- $cookie=$query->cookie(-name => 'sessionID',
- -value => '',
- -expires => '');
- }
- if ($envcookie){
- return ($userid, [$cookie,$envcookie], $sessionID, $flags)
- } else {
- return ($userid, $cookie, $sessionID, $flags);
- }
- }
- # else we have a problem...
- # get the inputs from the incoming query
- my @inputs =();
- foreach my $name (param $query) {
- (next) if ($name eq 'userid' || $name eq 'password');
- my $value = $query->param($name);
- push @inputs, {name => $name , value => $value};
- }
-
- my $template = gettemplate($template_name, $type,$query);
- $template->param(INPUTS => \@inputs,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- opacnav => C4::Context->preference("OpacNav"),
- TemplateEncoding => C4::Context->preference("TemplateEncoding"),
-
- );
- $template->param(loginprompt => 1) unless $info{'nopermission'};
-
- my $self_url = $query->url(-absolute => 1);
- $template->param(url => $self_url, LibraryName=> => C4::Context->preference("LibraryName"),);
- $template->param(\%info);
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- print $query->header(
- -type => "text/html",
- -charset=>"utf-8",
- -cookie => $cookie
- ), $template->output;
- exit;
-}
+ my $template_name;
+ if ( $type eq 'opac' ) {
+ $template_name = "opac-auth.tmpl";
+ }
+ else {
+ $template_name = "auth.tmpl";
+ }
+ # state variables
+ my $loggedin = 0;
+ my %info;
+ my ( $userid, $cookie, $sessionID, $flags, $envcookie );
+ my $logout = $query->param('logout.x');
+ if ( $userid = $ENV{'REMOTE_USER'} ) {
+
+ # Using Basic Authentication, no cookies required
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => '',
+ -expires => ''
+ );
+ $loggedin = 1;
+ }
+ elsif ( $sessionID = $query->cookie('sessionID') ) {
+ C4::Context->_new_userenv($sessionID);
+ if ( my %hash = $query->cookie('userenv') ) {
+ C4::Context::set_userenv(
+ $hash{number}, $hash{id},
+ $hash{cardnumber}, $hash{firstname},
+ $hash{surname}, $hash{branch},
+ $hash{branchname}, $hash{flags},
+ $hash{emailaddress}, $hash{branchprinter}
+ );
+ }
+ my ( $ip, $lasttime );
+
+ ( $userid, $ip, $lasttime ) =
+ $dbh->selectrow_array(
+ "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
+ undef, $sessionID );
+ if ($logout) {
+
+ # voluntary logout the user
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $sessionID = undef;
+ $userid = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
+ $ip, $time;
+ close L;
+ }
+ if ($userid) {
+ if ( $lasttime < time() - $timeout ) {
+
+ # timed logout
+ $info{'timed_out'} = 1;
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $userid = undef;
+ $sessionID = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged out at %30s (inactivity).\n",
+ $userid, $ip, $time;
+ close L;
+ }
+ elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
+
+ # Different ip than originally logged in from
+ $info{'oldip'} = $ip;
+ $info{'newip'} = $ENV{'REMOTE_ADDR'};
+ $info{'different_ip'} = 1;
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $sessionID = undef;
+ $userid = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L
+"%20s from logged out at %30s (ip changed from %16s to %16s).\n",
+ $userid, $time, $ip, $info{'newip'};
+ close L;
+ }
+ else {
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
+ undef, ( time(), $sessionID ) );
+ $flags = haspermission( $dbh, $userid, $flagsrequired );
+ if ($flags) {
+ $loggedin = 1;
+ }
+ else {
+ $info{'nopermission'} = 1;
+ }
+ }
+ }
+ }
+ unless ($userid) {
+ $sessionID = int( rand() * 100000 ) . '-' . time();
+ $userid = $query->param('userid');
+ C4::Context->_new_userenv($sessionID);
+ my $password = $query->param('password');
+ C4::Context->_new_userenv($sessionID);
+ my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
+ if ($return) {
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
+ undef, ( $sessionID, $userid ) );
+ $dbh->do(
+"INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
+ undef,
+ ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
+ );
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged in at %30s.\n", $userid,
+ $ENV{'REMOTE_ADDR'}, $time;
+ close L;
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
+ $loggedin = 1;
+ }
+ else {
+ $info{'nopermission'} = 1;
+ C4::Context->_unset_userenv($sessionID);
+ }
+ if ( $return == 1 ) {
+ my (
+ $borrowernumber, $firstname, $surname,
+ $userflags, $branchcode, $branchname,
+ $branchprinter, $emailaddress
+ );
+ my $sth =
+ $dbh->prepare(
+"select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"
+ );
+ $sth->execute($userid);
+ (
+ $borrowernumber, $firstname, $surname,
+ $userflags, $branchcode, $branchname,
+ $branchprinter, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+
+# warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
+ unless ( $sth->rows ) {
+ my $sth =
+ $dbh->prepare(
+"select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"
+ );
+ $sth->execute($cardnumber);
+ (
+ $borrowernumber, $firstname, $surname,
+ $userflags, $branchcode, $branchname,
+ $branchprinter, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+
+# warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
+ unless ( $sth->rows ) {
+ $sth->execute($userid);
+ (
+ $borrowernumber, $firstname, $surname, $userflags,
+ $branchcode, $branchname, $branchprinter, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+ }
+
+# warn "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress";
+ }
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# new op dev :
+# launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip.
+ my $ip = $ENV{'REMOTE_ADDR'};
+ my $branches = GetBranches();
+ my @branchesloop;
+ foreach my $br ( keys %$branches ) {
+
+ # now we work with the treatment of ip
+ my $domain = $branches->{$br}->{'branchip'};
+ if ( $domain && $ip =~ /^$domain/ ) {
+ $branchcode = $branches->{$br}->{'branchcode'};
+
+ # new op dev : add the branchprinter and branchname in the cookie
+ $branchprinter = $branches->{$br}->{'branchprinter'};
+ $branchname = $branches->{$br}->{'branchname'};
+ }
+ }
+ my $hash = C4::Context::set_userenv(
+ $borrowernumber, $userid, $cardnumber,
+ $firstname, $surname, $branchcode,
+ $branchname, $userflags, $emailaddress,
+ $branchprinter,
+ );
+
+ $envcookie = $query->cookie(
+ -name => 'userenv',
+ -value => $hash,
+ -expires => ''
+ );
+ }
+ elsif ( $return == 2 ) {
+
+ #We suppose the user is the superlibrarian
+ my $hash = C4::Context::set_userenv(
+ 0,
+ 0,
+ C4::Context->config('user'),
+ C4::Context->config('user'),
+ C4::Context->config('user'),
+ "",
+ "SUPER",
+ 1,
+ C4::Context->preference('KohaAdminEmailAddress')
+ );
+ $envcookie = $query->cookie(
+ -name => 'userenv',
+ -value => $hash,
+ -expires => ''
+ );
+ }
+ }
+ else {
+ if ($userid) {
+ $info{'invalid_username_or_password'} = 1;
+ C4::Context->_unset_userenv($sessionID);
+ }
+ }
+ }
+ my $insecure = C4::Context->boolean_preference('insecure');
+
+ # finished authentification, now respond
+ if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
+ {
+
+ # successful login
+ unless ($cookie) {
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => '',
+ -expires => ''
+ );
+ }
+ if ($envcookie) {
+ return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
+ }
+ else {
+ return ( $userid, $cookie, $sessionID, $flags );
+ }
+ }
+ # else we have a problem...
+ # get the inputs from the incoming query
+ my @inputs = ();
+ foreach my $name ( param $query) {
+ (next) if ( $name eq 'userid' || $name eq 'password' );
+ my $value = $query->param($name);
+ push @inputs, { name => $name, value => $value };
+ }
+ my $template = gettemplate( $template_name, $type, $query );
+ $template->param(
+ INPUTS => \@inputs,
+ suggestion => C4::Context->preference("suggestion"),
+ virtualshelves => C4::Context->preference("virtualshelves"),
+ opaclargeimage => C4::Context->preference("opaclargeimage"),
+ LibraryName => C4::Context->preference("LibraryName"),
+ OpacNav => C4::Context->preference("OpacNav"),
+ opaccredits => C4::Context->preference("opaccredits"),
+ opacreadinghistory => C4::Context->preference("opacreadinghistory"),
+ opacsmallimage => C4::Context->preference("opacsmallimage"),
+ opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
+ opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
+ opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
+ opacuserjs => C4::Context->preference("opacuserjs"),
+
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ intranetuserjs => C4::Context->preference("intranetuserjs"),
+ TemplateEncoding => C4::Context->preference("TemplateEncoding"),
+
+ );
+ $template->param( loginprompt => 1 ) unless $info{'nopermission'};
+
+ my $self_url = $query->url( -absolute => 1 );
+ $template->param(
+ url => $self_url,
+ LibraryName => => C4::Context->preference("LibraryName"),
+ );
+ $template->param( \%info );
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ print $query->header(
+ -type => guesstype( $template->output ),
+ -cookie => $cookie
+ ),
+ $template->output;
+ exit;
+}
sub checkpw {
- my ($dbh, $userid, $password) = @_;
-# INTERNAL AUTH
- my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($md5password,$cardnumber) = $sth->fetchrow;
- if (md5_base64($password) eq $md5password) {
- return 1,$cardnumber;
- }
- }
- my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($md5password) = $sth->fetchrow;
- if (md5_base64($password) eq $md5password) {
- return 1,$userid;
- }
- }
- if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
- # Koha superuser account
- return 2;
- }
- if ($userid eq 'demo' && $password eq 'demo' && C4::Context->config('demo')) {
- # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
- # some features won't be effective : modify systempref, modify MARC structure,
- return 2;
- }
- return 0;
+ my ( $dbh, $userid, $password ) = @_;
+
+ # INTERNAL AUTH
+ my $sth =
+ $dbh->prepare(
+"select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
+ );
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
+ $surname, $branchcode, $flags )
+ = $sth->fetchrow;
+ if ( md5_base64($password) eq $md5password ) {
+
+ C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
+ $firstname, $surname, $branchcode, $flags );
+ return 1, $cardnumber;
+ }
+ }
+ $sth =
+ $dbh->prepare(
+"select password,cardnumber,borrowernumber,userid, firstname,surname,branchcode,flags from borrowers where cardnumber=?"
+ );
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ( $md5password, $cardnumber, $borrowernumber, $userid, $firstname,
+ $surname, $branchcode, $flags )
+ = $sth->fetchrow;
+ if ( md5_base64($password) eq $md5password ) {
+
+ C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
+ $firstname, $surname, $branchcode, $flags );
+ return 1, $userid;
+ }
+ }
+ if ( $userid && $userid eq C4::Context->config('user')
+ && "$password" eq C4::Context->config('pass') )
+ {
+
+# Koha superuser account
+# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
+ return 2;
+ }
+ if ( $userid && $userid eq 'demo'
+ && "$password" eq 'demo'
+ && C4::Context->config('demo') )
+ {
+
+# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf
+# some features won't be effective : modify systempref, modify MARC structure,
+ return 2;
+ }
+ return 0;
}
sub getuserflags {
- my $cardnumber=shift;
- my $dbh=shift;
+ my $cardnumber = shift;
+ my $dbh = shift;
my $userflags;
- my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
+ my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
$sth->execute($cardnumber);
my ($flags) = $sth->fetchrow;
- $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
+ $flags = 0 unless $flags;
+ $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
$sth->execute;
- while (my ($bit, $flag, $defaulton) = $sth->fetchrow) {
- if (($flags & (2**$bit)) || $defaulton) {
- $userflags->{$flag}=1;
- }
+
+ while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
+ if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
+ $userflags->{$flag} = 1;
+ }
+ else {
+ $userflags->{$flag} = 0;
+ }
}
return $userflags;
}
sub haspermission {
- my ($dbh, $userid, $flagsrequired) = @_;
- my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
+ my ( $dbh, $userid, $flagsrequired ) = @_;
+ my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
$sth->execute($userid);
my ($cardnumber) = $sth->fetchrow;
- ($cardnumber) || ($cardnumber=$userid);
- my $flags=getuserflags($cardnumber,$dbh);
+ ($cardnumber) || ( $cardnumber = $userid );
+ my $flags = getuserflags( $cardnumber, $dbh );
my $configfile;
- if ($userid eq C4::Context->config('user')) {
- # Super User Account from /etc/koha.conf
- $flags->{'superlibrarian'}=1;
- }
- if ($userid eq 'demo' && C4::Context->config('demo')) {
- # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
- $flags->{'superlibrarian'}=1;
+ if ( $userid eq C4::Context->config('user') ) {
+
+ # Super User Account from /etc/koha.conf
+ $flags->{'superlibrarian'} = 1;
+ }
+ if ( $userid eq 'demo' && C4::Context->config('demo') ) {
+
+ # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
+ $flags->{'superlibrarian'} = 1;
}
return $flags if $flags->{superlibrarian};
- foreach (keys %$flagsrequired) {
- return $flags if $flags->{$_};
+ foreach ( keys %$flagsrequired ) {
+ return $flags if $flags->{$_};
}
return 0;
}
sub getborrowernumber {
my ($userid) = @_;
my $dbh = C4::Context->dbh;
- for my $field ('userid', 'cardnumber') {
- my $sth=$dbh->prepare
- ("select borrowernumber from borrowers where $field=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($bnumber) = $sth->fetchrow;
- return $bnumber;
- }
+ for my $field ( 'userid', 'cardnumber' ) {
+ my $sth =
+ $dbh->prepare("select borrowernumber from borrowers where $field=?");
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ($bnumber) = $sth->fetchrow;
+ return $bnumber;
+ }
}
return 0;
}
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
require Exporter;
use C4::Context;
-use C4::Output; # to get the template
+use C4::Output; # to get the template
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2; # getpatroninformation
+use C4::Circulation::Circ2; # getpatroninformation
use C4::Members;
+
# use Net::LDAP;
# use Net::LDAP qw(:all);
query => $query,
type => "opac",
authnotrequired => 1,
- flagsrequired => {borrow => 1},
+ flagsrequired => {circulate => 1},
});
print $query->header(
=cut
-
-
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &checkauth
- &get_template_and_user
+ &checkauth
+ &get_template_and_user
);
=item get_template_and_user
query => $query,
type => "opac",
authnotrequired => 1,
- flagsrequired => {borrow => 1},
+ flagsrequired => {circulate => 1},
});
This call passes the C<query>, C<flagsrequired> and C<authnotrequired>
=cut
-
sub get_template_and_user {
- my $in = shift;
- my $template = gettemplate($in->{'template_name'}, $in->{'type'},$in->{'query'});
- my ($user, $cookie, $sessionID, $flags)
- = checkauth($in->{'query'}, $in->{'authnotrequired'}, $in->{'flagsrequired'}, $in->{'type'});
-
- my $borrowernumber;
- if ($user) {
- $template->param(loggedinusername => $user);
- $template->param(sessionID => $sessionID);
-
- $borrowernumber = getborrowernumber($user);
- my ($borr, $alternativeflags) = getpatroninformation(undef, $borrowernumber);
- my @bordat;
- $bordat[0] = $borr;
- $template->param(USER_INFO => \@bordat,
- );
- # We are going to use the $flags returned by checkauth
- # to create the template's parameters that will indicate
- # which menus the user can access.
- if ($flags && $flags->{superlibrarian} == 1)
- {
- $template->param(CAN_user_circulate => 1);
- $template->param(CAN_user_catalogue => 1);
- $template->param(CAN_user_parameters => 1);
- $template->param(CAN_user_borrowers => 1);
- $template->param(CAN_user_permission => 1);
- $template->param(CAN_user_reserveforothers => 1);
- $template->param(CAN_user_borrow => 1);
- $template->param(CAN_user_reserveforself => 1);
- $template->param(CAN_user_editcatalogue => 1);
- $template->param(CAN_user_updatecharge => 1);
- $template->param(CAN_user_acquisition => 1);
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
- if ($flags && $flags->{circulate} == 1) {
- $template->param(CAN_user_circulate => 1); }
-
- if ($flags && $flags->{catalogue} == 1) {
- $template->param(CAN_user_catalogue => 1); }
-
-
- if ($flags && $flags->{parameters} == 1) {
- $template->param(CAN_user_parameters => 1);
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
-
- if ($flags && $flags->{borrowers} == 1) {
- $template->param(CAN_user_borrowers => 1); }
-
-
- if ($flags && $flags->{permissions} == 1) {
- $template->param(CAN_user_permission => 1); }
-
- if ($flags && $flags->{reserveforothers} == 1) {
- $template->param(CAN_user_reserveforothers => 1); }
-
-
- if ($flags && $flags->{borrow} == 1) {
- $template->param(CAN_user_borrow => 1); }
-
-
- if ($flags && $flags->{reserveforself} == 1) {
- $template->param(CAN_user_reserveforself => 1); }
-
-
- if ($flags && $flags->{editcatalogue} == 1) {
- $template->param(CAN_user_editcatalogue => 1); }
-
-
- if ($flags && $flags->{updatecharges} == 1) {
- $template->param(CAN_user_updatecharge => 1); }
-
- if ($flags && $flags->{acquisition} == 1) {
- $template->param(CAN_user_acquisition => 1); }
-
- if ($flags && $flags->{management} == 1) {
- $template->param(CAN_user_management => 1);
- $template->param(CAN_user_tools => 1); }
-
- if ($flags && $flags->{tools} == 1) {
- $template->param(CAN_user_tools => 1); }
- }
- $template->param(
- LibraryName => C4::Context->preference("LibraryName"),
- );
- return ($template, $borrowernumber, $cookie);
-}
+ my $in = shift;
+ my $template =
+ gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} );
+ my ( $user, $cookie, $sessionID, $flags ) = checkauth(
+ $in->{'query'},
+ $in->{'authnotrequired'},
+ $in->{'flagsrequired'},
+ $in->{'type'}
+ );
+
+ my $borrowernumber;
+ if ($user) {
+ $template->param( loggedinusername => $user );
+ $template->param( sessionID => $sessionID );
+
+ $borrowernumber = getborrowernumber($user);
+ my ( $borr, $alternativeflags ) =
+ getpatroninformation( undef, $borrowernumber );
+ my @bordat;
+ $bordat[0] = $borr;
+ $template->param( USER_INFO => \@bordat, );
+
+ # We are going to use the $flags returned by checkauth
+ # to create the template's parameters that will indicate
+ # which menus the user can access.
+ if ( $flags && $flags->{superlibrarian} == 1 ) {
+ $template->param( CAN_user_circulate => 1 );
+ $template->param( CAN_user_catalogue => 1 );
+ $template->param( CAN_user_parameters => 1 );
+ $template->param( CAN_user_borrowers => 1 );
+ $template->param( CAN_user_permission => 1 );
+ $template->param( CAN_user_reserveforothers => 1 );
+ $template->param( CAN_user_borrow => 1 );
+ $template->param( CAN_user_editcatalogue => 1 );
+ $template->param( CAN_user_updatecharge => 1 );
+ $template->param( CAN_user_editauthorities => 1 );
+ $template->param( CAN_user_acquisition => 1 );
+ $template->param( CAN_user_management => 1 );
+ $template->param( CAN_user_tools => 1 );
+ $template->param( CAN_user_serials => 1 );
+ $template->param( CAN_user_reports => 1 );
+ }
+ if ( $flags && $flags->{circulate} == 1 ) {
+ $template->param( CAN_user_circulate => 1 );
+ }
+
+ if ( $flags && $flags->{catalogue} == 1 ) {
+ $template->param( CAN_user_catalogue => 1 );
+ }
+
+ if ( $flags && $flags->{parameters} == 1 ) {
+ $template->param( CAN_user_parameters => 1 );
+ $template->param( CAN_user_management => 1 );
+ $template->param( CAN_user_tools => 1 );
+ }
+
+ if ( $flags && $flags->{borrowers} == 1 ) {
+ $template->param( CAN_user_borrowers => 1 );
+ }
+
+ if ( $flags && $flags->{permissions} == 1 ) {
+ $template->param( CAN_user_permission => 1 );
+ }
+
+ if ( $flags && $flags->{reserveforothers} == 1 ) {
+ $template->param( CAN_user_reserveforothers => 1 );
+ }
+
+ if ( $flags && $flags->{borrow} == 1 ) {
+ $template->param( CAN_user_borrow => 1 );
+ }
+
+ if ( $flags && $flags->{editcatalogue} == 1 ) {
+ $template->param( CAN_user_editcatalogue => 1 );
+ }
+ if ( $flags && $flags->{updatecharges} == 1 ) {
+ $template->param( CAN_user_updatecharge => 1 );
+ }
+
+ if ( $flags && $flags->{acquisition} == 1 ) {
+ $template->param( CAN_user_acquisition => 1 );
+ }
+
+ if ( $flags && $flags->{management} == 1 ) {
+ $template->param( CAN_user_management => 1 );
+ $template->param( CAN_user_tools => 1 );
+ }
+
+ if ( $flags && $flags->{tools} == 1 ) {
+ $template->param( CAN_user_tools => 1 );
+ }
+ if ( $flags && $flags->{editauthorities} == 1 ) {
+ $template->param( CAN_user_editauthorities => 1 );
+ }
+
+ if ( $flags && $flags->{serials} == 1 ) {
+ $template->param( CAN_user_serials => 1 );
+ }
+
+ if ( $flags && $flags->{reports} == 1 ) {
+ $template->param( CAN_user_reports => 1 );
+ }
+ }
+ $template->param( LibraryName => C4::Context->preference("LibraryName"), );
+ return ( $template, $borrowernumber, $cookie );
+}
=item checkauth
=cut
+sub checkauth {
+ my $query = shift;
+# $authnotrequired will be set for scripts which will run without authentication
+ my $authnotrequired = shift;
+ my $flagsrequired = shift;
+ my $type = shift;
+ $type = 'opac' unless $type;
-sub checkauth {
- my $query=shift;
- # $authnotrequired will be set for scripts which will run without authentication
- my $authnotrequired = shift;
- my $flagsrequired = shift;
- my $type = shift;
- $type = 'opac' unless $type;
-
- my $dbh = C4::Context->dbh;
- my $timeout = C4::Context->preference('timeout');
- $timeout = 600 unless $timeout;
-
- my $template_name;
- if ($type eq 'opac') {
- $template_name = "opac-auth.tmpl";
- } else {
- $template_name = "auth.tmpl";
- }
-
- # state variables
- my $loggedin = 0;
- my %info;
- my ($userid, $cookie, $sessionID, $flags,$envcookie);
- my $logout = $query->param('logout.x');
- if ($userid = $ENV{'REMOTE_USER'}) {
- # Using Basic Authentication, no cookies required
- $cookie=$query->cookie(-name => 'sessionID',
- -value => '',
- -expires => '');
- $loggedin = 1;
- } elsif ($sessionID=$query->cookie('sessionID')) {
- C4::Context->_new_userenv($sessionID);
- if (my %hash=$query->cookie('userenv')){
- C4::Context::set_userenv(
- $hash{number},
- $hash{id},
- $hash{cardnumber},
- $hash{firstname},
- $hash{surname},
- $hash{branch},
- $hash{flags},
- $hash{emailaddress},
- );
- }
- my ($ip , $lasttime);
- ($userid, $ip, $lasttime) = $dbh->selectrow_array(
- "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
- undef, $sessionID);
- if ($logout) {
- # voluntary logout the user
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $sessionID = undef;
- $userid = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time;
- close L;
- }
- if ($userid) {
- if ($lasttime<time()-$timeout) {
- # timed logout
- $info{'timed_out'} = 1;
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $userid = undef;
- $sessionID = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time;
- close L;
- } elsif ($ip ne $ENV{'REMOTE_ADDR'}) {
- # Different ip than originally logged in from
- $info{'oldip'} = $ip;
- $info{'newip'} = $ENV{'REMOTE_ADDR'};
- $info{'different_ip'} = 1;
- $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID);
- C4::Context->_unset_userenv($sessionID);
- $sessionID = undef;
- $userid = undef;
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'};
- close L;
- } else {
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?",
- undef, (time(), $sessionID));
- $flags = haspermission($dbh, $userid, $flagsrequired);
- if ($flags) {
- $loggedin = 1;
- } else {
- $info{'nopermission'} = 1;
- }
- }
- }
- }
- unless ($userid) {
- $sessionID=int(rand()*100000).'-'.time();
- $userid=$query->param('userid');
- my $password=$query->param('password');
- C4::Context->_new_userenv($sessionID);
- my ($return, $cardnumber) = checkpw($dbh,$userid,$password);
- if ($return) {
- $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?",
- undef, ($sessionID, $userid));
- $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
- undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time()));
- open L, ">>/tmp/sessionlog";
- my $time=localtime(time());
- printf L "%20s from %16s logged in at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time;
- close L;
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- if ($flags = haspermission($dbh, $userid, $flagsrequired)) {
- $loggedin = 1;
- } else {
- $info{'nopermission'} = 1;
- C4::Context->_unset_userenv($sessionID);
- }
- if ($return == 1){
- my ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress);
- my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where userid=?");
- $sth->execute($userid);
- ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
- unless ($sth->rows){
- my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where cardnumber=?");
- $sth->execute($cardnumber);
- ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
- unless ($sth->rows){
- $sth->execute($userid);
- ($bornum,$firstname,$surname,$userflags,$branchcode,$emailaddress) = $sth->fetchrow if ($sth->rows);
- }
- }
- my $hash = C4::Context::set_userenv(
- $bornum,
- $userid,
- $cardnumber,
- $firstname,
- $surname,
- $branchcode,
- $userflags,
- $emailaddress,
- );
- $envcookie=$query->cookie(-name => 'userenv',
- -value => $hash,
- -expires => '');
- } elsif ($return == 2) {
- #We suppose the user is the superlibrarian
- my $hash = C4::Context::set_userenv(
- 0,0,
- C4::Context->config('user'),
- C4::Context->config('user'),
- C4::Context->config('user'),
- "",1,C4::Context->preference('KohaAdminEmailAddress')
- );
- $envcookie=$query->cookie(-name => 'userenv',
- -value => $hash,
- -expires => '');
- }
- } else {
- if ($userid) {
- $info{'invalid_username_or_password'} = 1;
- C4::Context->_unset_userenv($sessionID);
- }
- }
- }
- my $insecure = C4::Context->boolean_preference('insecure');
- # finished authentification, now respond
- if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) {
- # successful login
- unless ($cookie) {
- $cookie=$query->cookie(-name => 'sessionID',
- -value => '',
- -expires => '');
- }
- if ($envcookie){
- return ($userid, [$cookie,$envcookie], $sessionID, $flags)
- } else {
- return ($userid, $cookie, $sessionID, $flags);
- }
- }
- # else we have a problem...
- # get the inputs from the incoming query
- my @inputs =();
- foreach my $name (param $query) {
- (next) if ($name eq 'userid' || $name eq 'password');
- my $value = $query->param($name);
- push @inputs, {name => $name , value => $value};
- }
-
- my $template = gettemplate($template_name, $type,$query);
- $template->param(INPUTS => \@inputs);
- $template->param(loginprompt => 1) unless $info{'nopermission'};
-
- my $self_url = $query->url(-absolute => 1);
- $template->param(url => $self_url);
- $template->param(\%info);
- $cookie=$query->cookie(-name => 'sessionID',
- -value => $sessionID,
- -expires => '');
- print $query->header(
- -type => guesstype($template->output),
- -cookie => $cookie
- ), $template->output;
- exit;
-}
+ my $dbh = C4::Context->dbh;
+ my $timeout = C4::Context->preference('timeout');
+ $timeout = 600 unless $timeout;
+
+ my $template_name;
+ if ( $type eq 'opac' ) {
+ $template_name = "opac-auth.tmpl";
+ }
+ else {
+ $template_name = "auth.tmpl";
+ }
+
+ # state variables
+ my $loggedin = 0;
+ my %info;
+ my ( $userid, $cookie, $sessionID, $flags, $envcookie );
+ my $logout = $query->param('logout.x');
+ if ( $userid = $ENV{'REMOTE_USER'} ) {
+
+ # Using Basic Authentication, no cookies required
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => '',
+ -expires => ''
+ );
+ $loggedin = 1;
+ }
+ elsif ( $sessionID = $query->cookie('sessionID') ) {
+ C4::Context->_new_userenv($sessionID);
+ if ( my %hash = $query->cookie('userenv') ) {
+ C4::Context::set_userenv(
+ $hash{number}, $hash{id}, $hash{cardnumber},
+ $hash{firstname}, $hash{surname}, $hash{branch},
+ $hash{flags}, $hash{emailaddress},
+ );
+ }
+ my ( $ip, $lasttime );
+ ( $userid, $ip, $lasttime ) =
+ $dbh->selectrow_array(
+ "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?",
+ undef, $sessionID );
+ if ($logout) {
+
+ # voluntary logout the user
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $sessionID = undef;
+ $userid = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged out at %30s (manually).\n", $userid,
+ $ip, $time;
+ close L;
+ }
+ if ($userid) {
+ if ( $lasttime < time() - $timeout ) {
+
+ # timed logout
+ $info{'timed_out'} = 1;
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $userid = undef;
+ $sessionID = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged out at %30s (inactivity).\n",
+ $userid, $ip, $time;
+ close L;
+ }
+ elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
+
+ # Different ip than originally logged in from
+ $info{'oldip'} = $ip;
+ $info{'newip'} = $ENV{'REMOTE_ADDR'};
+ $info{'different_ip'} = 1;
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=?",
+ undef, $sessionID );
+ C4::Context->_unset_userenv($sessionID);
+ $sessionID = undef;
+ $userid = undef;
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L
+"%20s from logged out at %30s (ip changed from %16s to %16s).\n",
+ $userid, $time, $ip, $info{'newip'};
+ close L;
+ }
+ else {
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?",
+ undef, ( time(), $sessionID ) );
+ $flags = haspermission( $dbh, $userid, $flagsrequired );
+ if ($flags) {
+ $loggedin = 1;
+ }
+ else {
+ $info{'nopermission'} = 1;
+ }
+ }
+ }
+ }
+ unless ($userid) {
+ $sessionID = int( rand() * 100000 ) . '-' . time();
+ $userid = $query->param('userid');
+ my $password = $query->param('password');
+ C4::Context->_new_userenv($sessionID);
+ my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password );
+ if ($return) {
+ $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?",
+ undef, ( $sessionID, $userid ) );
+ $dbh->do(
+"INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)",
+ undef,
+ ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() )
+ );
+ open L, ">>/tmp/sessionlog";
+ my $time = localtime( time() );
+ printf L "%20s from %16s logged in at %30s.\n", $userid,
+ $ENV{'REMOTE_ADDR'}, $time;
+ close L;
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) {
+ $loggedin = 1;
+ }
+ else {
+ $info{'nopermission'} = 1;
+ C4::Context->_unset_userenv($sessionID);
+ }
+ if ( $return == 1 ) {
+ my ( $borrowernumber, $firstname, $surname, $userflags,
+ $branchcode, $emailaddress );
+ my $sth =
+ $dbh->prepare(
+"select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where userid=?"
+ );
+ $sth->execute($userid);
+ (
+ $borrowernumber, $firstname, $surname, $userflags,
+ $branchcode, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+ unless ( $sth->rows ) {
+ my $sth =
+ $dbh->prepare(
+"select borrowernumber,firstname,surname,flags,branchcode,emailaddress from borrowers where cardnumber=?"
+ );
+ $sth->execute($cardnumber);
+ (
+ $borrowernumber, $firstname, $surname, $userflags,
+ $branchcode, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+ unless ( $sth->rows ) {
+ $sth->execute($userid);
+ (
+ $borrowernumber, $firstname, $surname, $userflags,
+ $branchcode, $emailaddress
+ )
+ = $sth->fetchrow
+ if ( $sth->rows );
+ }
+ }
+ my $hash =
+ C4::Context::set_userenv( $borrowernumber, $userid,
+ $cardnumber, $firstname, $surname, $branchcode, $userflags,
+ $emailaddress, );
+ $envcookie = $query->cookie(
+ -name => 'userenv',
+ -value => $hash,
+ -expires => ''
+ );
+ }
+ elsif ( $return == 2 ) {
+
+ #We suppose the user is the superlibrarian
+ my $hash = C4::Context::set_userenv(
+ 0,
+ 0,
+ C4::Context->config('user'),
+ C4::Context->config('user'),
+ C4::Context->config('user'),
+ "",
+ 1,
+ C4::Context->preference('KohaAdminEmailAddress')
+ );
+ $envcookie = $query->cookie(
+ -name => 'userenv',
+ -value => $hash,
+ -expires => ''
+ );
+ }
+ }
+ else {
+ if ($userid) {
+ $info{'invalid_username_or_password'} = 1;
+ C4::Context->_unset_userenv($sessionID);
+ }
+ }
+ }
+ my $insecure = C4::Context->boolean_preference('insecure');
+
+ # finished authentification, now respond
+ if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) )
+ {
+
+ # successful login
+ unless ($cookie) {
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => '',
+ -expires => ''
+ );
+ }
+ if ($envcookie) {
+ return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags );
+ }
+ else {
+ return ( $userid, $cookie, $sessionID, $flags );
+ }
+ }
+ # else we have a problem...
+ # get the inputs from the incoming query
+ my @inputs = ();
+ foreach my $name ( param $query) {
+ (next) if ( $name eq 'userid' || $name eq 'password' );
+ my $value = $query->param($name);
+ push @inputs, { name => $name, value => $value };
+ }
+ my $template = gettemplate( $template_name, $type, $query );
+ $template->param( INPUTS => \@inputs );
+ $template->param( loginprompt => 1 ) unless $info{'nopermission'};
+
+ my $self_url = $query->url( -absolute => 1 );
+ $template->param( url => $self_url );
+ $template->param( \%info );
+ $cookie = $query->cookie(
+ -name => 'sessionID',
+ -value => $sessionID,
+ -expires => ''
+ );
+ print $query->header(
+ -type => guesstype( $template->output ),
+ -cookie => $cookie
+ ),
+ $template->output;
+ exit;
+}
# this checkpw is a LDAP based one
# it connects to LDAP (anonymous)
# and calls the memberadd if necessary
sub checkpw {
- my ($dbh, $userid, $password) = @_;
- if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
- # Koha superuser account
- return 2;
- }
- ##################################################
- ### LOCAL
- ### Change the code below to match your own LDAP server.
- ##################################################
- # LDAP connexion parameters
- my $ldapserver = 'your.ldap.server.com';
- # Infos to do an anonymous bind
- my $ldapinfos = 'a-section=people,dc=emn,dc=fr ';
- my $name = "a-section=people,dc=emn,dc=fr";
- my $db = Net::LDAP->new( $ldapserver );
-
- # do an anonymous bind
- my $res =$db->bind();
- if($res->code) {
- # auth refused
- warn "LDAP Auth impossible : server not responding";
- return 0;
- } else {
- my $userdnsearch = $db->search(base => $name,
- filter =>"(a-login=$userid)",
- );
- if($userdnsearch->code || ! ( $userdnsearch-> count eq 1 ) ) {
- warn "LDAP Auth impossible : user unknown in LDAP";
- return 0;
- };
-
- my $userldapentry=$userdnsearch -> shift_entry;
- my $cmpmesg = $db -> compare ( $userldapentry, attr => 'a-weak', value => $password );
- ## HACK LMK
- ## ligne originale
- # if( $cmpmesg -> code != 6 ) {
- if( ( $cmpmesg -> code != 6 ) && ! ( $password eq "kivabien" ) ) {
- warn "LDAP Auth impossible : wrong password";
- return 0;
- };
- # build LDAP hash
- my %memberhash;
- my $x =$userldapentry->{asn}{attributes};
- my $key;
- foreach my $k ( @$x) {
- foreach my $k2 (keys %$k) {
- if ($k2 eq 'type') {
- $key = $$k{$k2};
- } else {
- my $a = @$k{$k2};
- foreach my $k3 (@$a) {
- $memberhash{$key} .= $k3." ";
- }
- }
- }
- }
- #
- # BUILD %borrower to CREATE or MODIFY BORROWER
- # change $memberhash{'xxx'} to fit your ldap structure.
- # check twice that mandatory fields are correctly filled
- #
- my %borrower;
- $borrower{cardnumber} = $userid;
- $borrower{firstname} = $memberhash{givenName}; # MANDATORY FIELD
- $borrower{surname} = $memberhash{sn}; # MANDATORY FIELD
- $borrower{initials} = substr($borrower{firstname},0,1).substr($borrower{surname},0,1)." "; # MANDATORY FIELD
- $borrower{streetaddress} = $memberhash{l}." "; # MANDATORY FIELD
- $borrower{city} = " "; # MANDATORY FIELD
- $borrower{phone} = " "; # MANDATORY FIELD
- $borrower{branchcode} = $memberhash{branch}; # MANDATORY FIELD
- $borrower{emailaddress} = $memberhash{mail};
- $borrower{categorycode} = $memberhash{employeeType};
- ##################################################
- ### /LOCAL
- ### No change needed after this line (unless there's a bug ;-) )
- ##################################################
- # check if borrower exists
- my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
- $sth->execute($userid);
- if ($sth->rows) {
- # it exists, MODIFY
-# warn "MODIF borrower";
- my $sth2 = $dbh->prepare("update borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? where cardnumber=?");
- $sth2->execute($borrower{firstname},$borrower{surname},$borrower{initials},
- $borrower{streetaddress},$borrower{city},$borrower{phone},
- $borrower{categorycode},$borrower{branchcode},$borrower{emailaddress},
- $borrower{sort1} ,$userid);
- } else {
- # it does not exists, ADD borrower
-# warn "ADD borrower";
- my $borrowerid = newmember(%borrower);
- }
- #
- # CREATE or MODIFY PASSWORD/LOGIN
- #
- # search borrowerid
- $sth = $dbh->prepare("select borrowernumber from borrowers where cardnumber=?");
- $sth->execute($userid);
- my ($borrowerid)=$sth->fetchrow;
-# warn "change password for $borrowerid setting $password";
- my $digest=md5_base64($password);
- changepassword($userid,$borrowerid,$digest);
- }
-
-# INTERNAL AUTH
- my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($md5password,$cardnumber) = $sth->fetchrow;
- if (md5_base64($password) eq $md5password) {
- return 1,$cardnumber;
- }
- }
- my $sth=$dbh->prepare("select password from borrowers where cardnumber=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($md5password) = $sth->fetchrow;
- if (md5_base64($password) eq $md5password) {
- return 1,$userid;
- }
- }
- return 0;
+ my ( $dbh, $userid, $password ) = @_;
+ if ( $userid eq C4::Context->config('user')
+ && $password eq C4::Context->config('pass') )
+ {
+
+ # Koha superuser account
+ return 2;
+ }
+ ##################################################
+ ### LOCAL
+ ### Change the code below to match your own LDAP server.
+ ##################################################
+ # LDAP connexion parameters
+ my $ldapserver = 'your.ldap.server.com';
+
+ # Infos to do an anonymous bind
+ my $ldapinfos = 'a-section=people,dc=emn,dc=fr ';
+ my $name = "a-section=people,dc=emn,dc=fr";
+ my $db = Net::LDAP->new($ldapserver);
+
+ # do an anonymous bind
+ my $res = $db->bind();
+ if ( $res->code ) {
+
+ # auth refused
+ warn "LDAP Auth impossible : server not responding";
+ return 0;
+ }
+ else {
+ my $userdnsearch = $db->search(
+ base => $name,
+ filter => "(a-login=$userid)",
+ );
+ if ( $userdnsearch->code || !( $userdnsearch->count eq 1 ) ) {
+ warn "LDAP Auth impossible : user unknown in LDAP";
+ return 0;
+ }
+
+ my $userldapentry = $userdnsearch->shift_entry;
+ my $cmpmesg =
+ $db->compare( $userldapentry, attr => 'a-weak', value => $password );
+ ## HACK LMK
+ ## ligne originale
+ # if( $cmpmesg -> code != 6 ) {
+ if ( ( $cmpmesg->code != 6 ) && !( $password eq "kivabien" ) ) {
+ warn "LDAP Auth impossible : wrong password";
+ return 0;
+ }
+
+ # build LDAP hash
+ my %memberhash;
+ my $x = $userldapentry->{asn}{attributes};
+ my $key;
+ foreach my $k (@$x) {
+ foreach my $k2 ( keys %$k ) {
+ if ( $k2 eq 'type' ) {
+ $key = $$k{$k2};
+ }
+ else {
+ my $a = @$k{$k2};
+ foreach my $k3 (@$a) {
+ $memberhash{$key} .= $k3 . " ";
+ }
+ }
+ }
+ }
+
+ #
+ # BUILD %borrower to CREATE or MODIFY BORROWER
+ # change $memberhash{'xxx'} to fit your ldap structure.
+ # check twice that mandatory fields are correctly filled
+ #
+ my %borrower;
+ $borrower{cardnumber} = $userid;
+ $borrower{firstname} = $memberhash{givenName}; # MANDATORY FIELD
+ $borrower{surname} = $memberhash{sn}; # MANDATORY FIELD
+ $borrower{initials} =
+ substr( $borrower{firstname}, 0, 1 )
+ . substr( $borrower{surname}, 0, 1 )
+ . " "; # MANDATORY FIELD
+ $borrower{streetaddress} = $memberhash{l} . " "; # MANDATORY FIELD
+ $borrower{city} = " "; # MANDATORY FIELD
+ $borrower{phone} = " "; # MANDATORY FIELD
+ $borrower{branchcode} = $memberhash{branch}; # MANDATORY FIELD
+ $borrower{emailaddress} = $memberhash{mail};
+ $borrower{categorycode} = $memberhash{employeeType};
+ ##################################################
+ ### /LOCAL
+ ### No change needed after this line (unless there's a bug ;-) )
+ ##################################################
+ # check if borrower exists
+ my $sth =
+ $dbh->prepare("select password from borrowers where cardnumber=?");
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+
+ # it exists, MODIFY
+ # warn "MODIF borrower";
+ my $sth2 =
+ $dbh->prepare(
+"update borrowers set firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=? where cardnumber=?"
+ );
+ $sth2->execute(
+ $borrower{firstname}, $borrower{surname},
+ $borrower{initials}, $borrower{streetaddress},
+ $borrower{city}, $borrower{phone},
+ $borrower{categorycode}, $borrower{branchcode},
+ $borrower{emailaddress}, $borrower{sort1},
+ $userid
+ );
+ }
+ else {
+
+ # it does not exists, ADD borrower
+ # warn "ADD borrower";
+ my $borrowerid = newmember(%borrower);
+ }
+
+ #
+ # CREATE or MODIFY PASSWORD/LOGIN
+ #
+ # search borrowerid
+ $sth =
+ $dbh->prepare(
+ "select borrowernumber from borrowers where cardnumber=?");
+ $sth->execute($userid);
+ my ($borrowerid) = $sth->fetchrow;
+
+ # warn "change password for $borrowerid setting $password";
+ my $digest = md5_base64($password);
+ changepassword( $userid, $borrowerid, $digest );
+ }
+
+ # INTERNAL AUTH
+ my $sth =
+ $dbh->prepare("select password,cardnumber from borrowers where userid=?");
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ( $md5password, $cardnumber ) = $sth->fetchrow;
+ if ( md5_base64($password) eq $md5password ) {
+ return 1, $cardnumber;
+ }
+ }
+ $sth = $dbh->prepare("select password from borrowers where cardnumber=?");
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ($md5password) = $sth->fetchrow;
+ if ( md5_base64($password) eq $md5password ) {
+ return 1, $userid;
+ }
+ }
+ return 0;
}
sub getuserflags {
- my $cardnumber=shift;
- my $dbh=shift;
+ my $cardnumber = shift;
+ my $dbh = shift;
my $userflags;
- my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
+ my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?");
$sth->execute($cardnumber);
my ($flags) = $sth->fetchrow;
- $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
+ $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags");
$sth->execute;
- while (my ($bit, $flag, $defaulton) = $sth->fetchrow) {
- if (($flags & (2**$bit)) || $defaulton) {
- $userflags->{$flag}=1;
- }
+
+ while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) {
+ if ( ( $flags & ( 2**$bit ) ) || $defaulton ) {
+ $userflags->{$flag} = 1;
+ }
}
return $userflags;
}
sub haspermission {
- my ($dbh, $userid, $flagsrequired) = @_;
- my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
+ my ( $dbh, $userid, $flagsrequired ) = @_;
+ my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?");
$sth->execute($userid);
my ($cardnumber) = $sth->fetchrow;
- ($cardnumber) || ($cardnumber=$userid);
- my $flags=getuserflags($cardnumber,$dbh);
+ ($cardnumber) || ( $cardnumber = $userid );
+ my $flags = getuserflags( $cardnumber, $dbh );
my $configfile;
- if ($userid eq C4::Context->config('user')) {
- # Super User Account from /etc/koha.conf
- $flags->{'superlibrarian'}=1;
- }
- if ($userid eq 'demo' && C4::Context->config('demo')) {
- # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
- $flags->{'superlibrarian'}=1;
+ if ( $userid eq C4::Context->config('user') ) {
+
+ # Super User Account from /etc/koha.conf
+ $flags->{'superlibrarian'} = 1;
+ }
+ if ( $userid eq 'demo' && C4::Context->config('demo') ) {
+
+ # Demo user that can do "anything" (demo=1 in /etc/koha.conf)
+ $flags->{'superlibrarian'} = 1;
}
return $flags if $flags->{superlibrarian};
- foreach (keys %$flagsrequired) {
- return $flags if $flags->{$_};
+ foreach ( keys %$flagsrequired ) {
+ return $flags if $flags->{$_};
}
return 0;
}
sub getborrowernumber {
my ($userid) = @_;
my $dbh = C4::Context->dbh;
- for my $field ('userid', 'cardnumber') {
- my $sth=$dbh->prepare
- ("select borrowernumber from borrowers where $field=?");
- $sth->execute($userid);
- if ($sth->rows) {
- my ($bnumber) = $sth->fetchrow;
- return $bnumber;
- }
+ for my $field ( 'userid', 'cardnumber' ) {
+ my $sth =
+ $dbh->prepare("select borrowernumber from borrowers where $field=?");
+ $sth->execute($userid);
+ if ( $sth->rows ) {
+ my ($bnumber) = $sth->fetchrow;
+ return $bnumber;
+ }
}
return 0;
}
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
require Exporter;
use C4::Context;
use C4::Koha;
-use Encode;
+use MARC::Record;
use C4::Biblio;
-
+use C4::Search;
+#use ZOOM;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@ISA = qw(Exporter);
@EXPORT = qw(
- &AUTHgettagslib
- &AUTHfindsubfield
- &AUTHfind_authtypecode
- &AUTHaddauthority
- &AUTHmodauthority
- &AUTHdelauthority
- &AUTHaddsubfield
-
- &AUTHfind_marc_from_kohafield
- &AUTHgetauth_type
- &AUTHcount_usage
- &getsummary
- &authoritysearch
- &XMLgetauthority
- &XMLgetauthorityhash
- &XML_readline_withtags
- &merge
- &FindDuplicateauth
- &ZEBRAdelauthority
+ &AUTHgettagslib
+ &AUTHfindsubfield
+ &AUTHfind_authtypecode
+
+ &AUTHaddauthority
+ &AUTHmodauthority
+ &AUTHdelauthority
+ &AUTHaddsubfield
+ &AUTHgetauthority
+ &AUTHfind_marc_from_kohafield
+ &AUTHgetauth_type
+ &AUTHcount_usage
+ &getsummary
+ &authoritysearch
+ &XMLgetauthority
+
+ &AUTHhtml2marc
+ &BuildUnimarcHierarchies
+ &BuildUnimarcHierarchy
+ &merge
+ &FindDuplicate
);
sub AUTHfind_marc_from_kohafield {
return 0, 0 unless $kohafield;
$authtypecode="" unless $authtypecode;
my $marcfromkohafield;
- my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
- $sth->execute($kohafield,$authtypecode);
- my ($tagfield,$tagsubfield) = $sth->fetchrow;
- return ($tagfield,$tagsubfield);
+ my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
+ $sth->execute($kohafield,$authtypecode);
+ my ($tagfield,$tagsubfield) = $sth->fetchrow;
+
+ return ($tagfield,$tagsubfield);
}
sub authoritysearch {
-## This routine requires rewrite--TG
- my ($dbh, $tags, $operator, $value, $offset,$length,$authtypecode,$dictionary) = @_;
-###Dictionary flag used to set what to show in summary;
- my $query;
- my $attr;
- my $server;
- my $mainentrytag;
- ##first set the authtype search and may be multiple authorities( linked authorities)
- my $n=0;
- my @authtypecode;
- my @auths=split / /,$authtypecode ;
- my ($attrfield)=MARCfind_attr_from_kohafield("authtypecode");
- foreach my $auth (@auths){
- $query .=$attrfield." ".$auth." "; ##No truncation on authtype
- push @authtypecode ,$auth;
- $n++;
- }
- if ($n>1){
- $query= "\@or ".$query;
- }
-
- my $dosearch;
- my $and;
- my $q2;
- for(my $i = 0 ; $i <= $#{$value} ; $i++)
- {
-
- if (@$value[$i]){
- ##If mainentry search $a tag
- if (@$tags[$i] eq "mainentry") {
- ($attr)=MARCfind_attr_from_kohafield("mainentry")." ";
- }else{
- ($attr) =MARCfind_attr_from_kohafield("allentry")." ";
- }
- if (@$operator[$i] eq 'phrase') {
- $attr.=" \@attr 4=1 \@attr 5=100 \@attr 6=3 ";##Phrase, No truncation,all of subfield field must match
-
- } else {
-
- $attr .=" \@attr 4=6 \@attr 5=1 ";## Word list, right truncated, anywhere
- }
-
-
- $and .=" \@and " ;
- $attr =$attr."\"".@$value[$i]."\"";
- $q2 .=$attr;
- $dosearch=1;
- }#if value
-
- }## value loop
+ my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_;
+ my $dbh=C4::Context->dbh;
+ my $query;
+ my $attr;
+ # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on
+ # the authtypecode. Then, search on $a of this tag_to_report
+ # also store main entry MARC tag, to extract it at end of search
+ my $mainentrytag;
+ ##first set the authtype search and may be multiple authorities
+ my $n=0;
+ my @authtypecode;
+ my @auths=split / /,$authtypecode ;
+ foreach my $auth (@auths){
+ $query .=" \@attr 1=Authority/format-id \@attr 5=100 ".$auth; ##No truncation on authtype
+ push @authtypecode ,$auth;
+ $n++;
+ }
+ if ($n>1){
+ $query= "\@or ".$query;
+ }
+
+ my $dosearch;
+ my $and;
+ my $q2;
+ for(my $i = 0 ; $i <= $#{$value} ; $i++)
+ {
+ if (@$value[$i]){
+ ##If mainentry search $a tag
+ if (@$tags[$i] eq "mainmainentry") {
+ $attr =" \@attr 1=Heading ";
+ }elsif (@$tags[$i] eq "mainentry") {
+ $attr =" \@attr 1=Heading-Entity ";
+ }else{
+ $attr =" \@attr 1=Any ";
+ }
+ if (@$operator[$i] eq 'is') {
+ $attr.=" \@attr 4=1 \@attr 5=100 ";##Phrase, No truncation,all of subfield field must match
+ }elsif (@$operator[$i] eq "="){
+ $attr.=" \@attr 4=107 "; #Number Exact match
+ }elsif (@$operator[$i] eq "start"){
+ $attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated
+ } else {
+ $attr .=" \@attr 5=1 ";## Word list, right truncated, anywhere
+ }
+ $and .=" \@and " ;
+ $attr =$attr."\"".@$value[$i]."\"";
+ $q2 .=$attr;
+ $dosearch=1;
+ }#if value
+ }
##Add how many queries generated
$query= $and.$query.$q2;
-#warn $query;
+$query=' @or @attr 7=1 @attr 1=Heading 0 '.$query if ($sortby eq "HeadingAsc");
+$query=' @or @attr 7=2 @attr 1=Heading 0 '.$query if ($sortby eq "HeadingDsc");
+warn $query;
$offset=0 unless $offset;
my $counter = $offset;
$length=10 unless $length;
my @oAuth;
my $i;
- $oAuth[0]=C4::Context->Zconn("authorityserver");
-my ($mainentry)=MARCfind_attr_from_kohafield("mainentry");
-my ($allentry)=MARCfind_attr_from_kohafield("allentry");
-
-$query="\@attr 2=102 \@or \@or ".$query." \@attr 7=1 ".$mainentry." 0 \@attr 7=1 ".$allentry." 1"; ## sort on mainfield and subfields
-
-
+$oAuth[0]=C4::Context->Zconn("authorityserver" , 1);
+my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]);
+# $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
+# $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
my $oAResult;
- $oAResult= $oAuth[0]->search_pqf($query) ;
+ $oAResult= $oAuth[0]->search($Anewq) ;
while (($i = ZOOM::event(\@oAuth)) != 0) {
my $ev = $oAuth[$i-1]->last_event();
-# warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
+# warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
last if $ev == ZOOM::Event::ZEND;
}
my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x();
if ($error) {
- warn "oAuth error: $errmsg ($error) $addinfo $diagset\n";
- goto NOLUCK;
+ warn "oAuth error: $errmsg ($error) $addinfo $diagset\n";
+ goto NOLUCK;
}
my $nbresults;
$nbresults=$oAResult->size();
-my $nremains=$nbresults;
- my @result = ();
- my @finalresult = ();
+my $nremains=$nbresults;
+ my @result = ();
+ my @finalresult = ();
+
if ($nbresults>0){
##Find authid and linkid fields
-
-
-while (($counter < $nbresults) && ($counter < ($offset + $length))) {
-##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
-my $rec=$oAResult->record($counter);
-my $marcdata=$rec->raw();
-my $authrecord=Encode::decode("utf8",$marcdata);
-$authrecord=XML_xml2hash_onerecord($authrecord);
-my @linkids;
-my $separator=C4::Context->preference('authoritysep');
-my $linksummary=" ".$separator;
-my $authid=XML_readline_onerecord($authrecord,"authid","authorities");
-my @linkid=XML_readline_asarray($authrecord,"linkid","authorities");##May have many linked records
-
- foreach my $linkid (@linkid){
- my $linktype=AUTHfind_authtypecode($dbh,$linkid);
- my $linkrecord=XMLgetauthorityhash($dbh,$linkid);
- $linksummary.="<br> <a href='detail.pl?authid=$linkid'>".getsummary($dbh,$linkrecord,$linkid,$linktype).".</a>".$separator;
-
- }
-my $summary;
-unless ($dictionary){
- $summary=getsummary($dbh,$authrecord,$authid,$authtypecode);
-$summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>";
- if ( $linksummary ne " ".$separator){
- $summary="<b>".$summary."</b>".$linksummary;
- }
-}else{
- $summary=getdictsummary($dbh,$authrecord,$authid,$authtypecode);
-}
-my $toggle;
- if ($counter % 2) {
- $toggle="#ffffcc";
- } else {
- $toggle="white";
- }
-my %newline;
- $newline{'toggle'}=$toggle;
- $newline{summary} = $summary;
- $newline{authid} = $authid;
- $newline{linkid} = $linkid[0];
- $newline{even} = $counter % 2;
- $counter++;
- push @finalresult, \%newline;
- }## while counter
-
-
-for (my $z=0; $z<$length; $z++){
- $finalresult[$z]{used}=AUTHcount_usage($finalresult[$z]{authid});
-
- }# all $z's
-
+##we may be searching multiple authoritytypes.
+## FIXME this assumes that all authid and linkid fields are the same for all authority types
+# my ($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode[0]);
+# my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode[0]);
+ while (($counter < $nbresults) && ($counter < ($offset + $length))) {
+
+ ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
+ my $rec=$oAResult->record($counter);
+ my $marcdata=$rec->raw();
+ my $authrecord;
+ my $linkid;
+ my @linkids;
+ my $separator=C4::Context->preference('authoritysep');
+ my $linksummary=" ".$separator;
+
+ $authrecord = MARC::File::USMARC::decode($marcdata);
+
+ my $authid=$authrecord->field('001')->data();
+ # if ($authrecord->field($linkidfield)){
+ # my @fields=$authrecord->field($linkidfield);
+ #
+ # # foreach my $field (@fields){
+ # # # $linkid=$field->subfield($linkidsubfield) ;
+ # # # if ($linkid){ ##There is a linked record add fields to produce summary
+ # # # my $linktype=AUTHfind_authtypecode($dbh,$linkid);
+ # # # my $linkrecord=AUTHgetauthority($dbh,$linkid);
+ # # # $linksummary.="<br> <a href='detail.pl?authid=$linkid'>".getsummary($dbh,$linkrecord,$linkid,$linktype).".</a>".$separator;
+ # # # }
+ # # }
+ # }#
+
+ my $summary=getsummary($authrecord,$authid,$authtypecode);
+# $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
+# $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
+ # if ($linkid && $linksummary ne " ".$separator){
+ # $summary="<b>".$summary."</b>".$linksummary;
+ # }
+ my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
+ my $sth = $dbh->prepare($query_auth_tag);
+ $sth->execute($authtypecode);
+ my $auth_tag_to_report = $sth->fetchrow;
+ my %newline;
+ $newline{summary} = $summary;
+ $newline{authid} = $authid;
+ # $newline{linkid} = $linkid;
+ # $newline{reported_tag} = $reported_tag;
+ # $newline{used} =0;
+ # $newline{biblio_fields} = $tags_using_authtype;
+ $newline{even} = $counter % 2;
+ $counter++;
+ push @finalresult, \%newline;
+ }## while counter
+
+
+ ###
+ for (my $z=0; $z<@finalresult; $z++){
+ my $count=AUTHcount_usage($finalresult[$z]{authid});
+ $finalresult[$z]{used}=$count;
+ }# all $z's
}## if nbresult
NOLUCK:
-$oAResult->destroy();
-$oAuth[0]->destroy();
+# $oAResult->destroy();
+# $oAuth[0]->destroy();
- return (\@finalresult, $nbresults);
+ return (\@finalresult, $nbresults);
}
+# Creates the SQL Request
+
+sub create_request {
+ my ($dbh,$tags, $and_or, $operator, $value) = @_;
+
+ my $sql_tables; # will contain marc_subfield_table as m1,...
+ my $sql_where1; # will contain the "true" where
+ my $sql_where2 = "("; # will contain m1.authid=m2.authid
+ my $nb_active=0; # will contain the number of "active" entries. and entry is active is a value is provided.
+ my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided.
+
+
+ for(my $i=0; $i<=@$value;$i++) {
+ if (@$value[$i]) {
+ $nb_active++;
+ if ($nb_active==1) {
+
+ $sql_tables = "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "( m$nb_table.subfieldvalue like '@$value[$i]' ";
+ if (@$tags[$i]) {
+ $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) IN (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ } else {
+
+
+
+
+ $nb_table++;
+
+ $sql_tables .= "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like '@$value[$i]' ";
+ if (@$tags[$i]) {
+ $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) IN (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ $sql_where2.="m1.authid=m$nb_table.authid and ";
+
+
+ }
+ }
+ }
+
+ if($sql_where2 ne "(") # some datas added to sql_where2, processing
+ {
+ $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and '
+ $sql_where2 .= ")";
+ }
+ else # no sql_where2 statement, deleting '('
+ {
+ $sql_where2 = "";
+ }
+ chop $sql_tables; # deletes the trailing ','
+
+ return ($sql_tables, $sql_where1, $sql_where2);
+}
sub AUTHcount_usage {
- my ($authid) = @_;
+ my ($authid) = @_;
### try ZOOM search here
-my @oConnection;
-$oConnection[0]=C4::Context->Zconn("biblioserver");
+my $oConnection=C4::Context->Zconn("biblioserver",1);
my $query;
-my ($attrfield)=MARCfind_attr_from_kohafield("authid");
-$query= $attrfield." ".$authid;
-
-my $oResult = $oConnection[0]->search_pqf($query);
-my $event;
-my $i;
- while (($i = ZOOM::event(\@oConnection)) != 0) {
- $event = $oConnection[$i-1]->last_event();
- last if $event == ZOOM::Event::ZEND;
- }# while
-my $result=$oResult->size() ;
- return ($result);
+$query= "an=".$authid;
+
+my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
+my $result;
+while ((my $i = ZOOM::event([ $oConnection ])) != 0) {
+ my $ev = $oConnection->last_event();
+ if ($ev == ZOOM::Event::ZEND) {
+ $result = $oResult->size();
+ }
+}
+return ($result);
}
sub AUTHfind_authtypecode {
- my ($dbh,$authid) = @_;
- my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
- $sth->execute($authid);
- my ($authtypecode) = $sth->fetchrow;
- return $authtypecode;
+ my ($dbh,$authid) = @_;
+ my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
+ $sth->execute($authid);
+ my ($authtypecode) = $sth->fetchrow;
+ return $authtypecode;
}
sub AUTHgettagslib {
- my ($dbh,$forlibrarian,$authtypecode)= @_;
- $authtypecode="" unless $authtypecode;
- my $sth;
- my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
-
-
- # check that authority exists
- $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
- $sth->execute($authtypecode);
- my ($total) = $sth->fetchrow;
- $authtypecode="" unless ($total >0);
- $sth= $dbh->prepare(
+ my ($dbh,$forlibrarian,$authtypecode)= @_;
+ $authtypecode="" unless $authtypecode;
+ my $sth;
+ my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
+
+
+ # check that authority exists
+ $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
+ $sth->execute($authtypecode);
+ my ($total) = $sth->fetchrow;
+ $authtypecode="" unless ($total >0);
+ $sth= $dbh->prepare(
"select tagfield,liblibrarian,libopac,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield"
);
$sth->execute($authtypecode);
- my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
+ my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
$res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
- $res->{$tab}->{tab} = ""; # XXX
+ $res->{$tag}->{tab} = " "; # XXX
$res->{$tag}->{mandatory} = $mandatory;
$res->{$tag}->{repeatable} = $repeatable;
}
- $sth= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"
+ $sth= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"
);
- $sth->execute($authtypecode);
+ $sth->execute($authtypecode);
- my $subfield;
+ my $subfield;
my $authorised_value;
- my $authtypecode;
my $value_builder;
my $kohafield;
my $seealso;
my $hidden;
my $isurl;
- my $link;
+ my $link;
while (
( $tag, $subfield, $liblibrarian, , $libopac, $tab,
$mandatory, $repeatable, $authorised_value, $authtypecode,
- $value_builder, $seealso, $hidden,
- $isurl, $link )
+ $value_builder, $kohafield, $seealso, $hidden,
+ $isurl, $link )
= $sth->fetchrow
)
{
$res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
$res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
$res->{$tag}->{$subfield}->{value_builder} = $value_builder;
+ $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
$res->{$tag}->{$subfield}->{seealso} = $seealso;
$res->{$tag}->{$subfield}->{hidden} = $hidden;
$res->{$tag}->{$subfield}->{isurl} = $isurl;
}
sub AUTHaddauthority {
-# pass the XML hash to this function, and it will create the records in the authority table
- my ($dbh,$record,$authid,$authtypecode) = @_;
+# pass the MARC::Record to this function, and it will create the records in the authority table
+ my ($dbh,$record,$authid,$authtypecode) = @_;
+
+#my $leadercode=AUTHfind_leader($dbh,$authtypecode);
+my $leader=' a ';##Fixme correct leader as this one just adds utf8 to MARC21
+#substr($leader,8,1)=$leadercode;
+# $record->leader($leader);
+# my ($authfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
+# my ($authfield2,$authtypesubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
+# my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
+
# if authid empty => true add, find a new authid number
- if (!$authid) {
- my $sth=$dbh->prepare("select max(authid) from auth_header");
- $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);
- $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");
- foreach my $linkid (@linkids){
- ##Modify the record of linked
- AUTHaddlink($dbh,$linkid,$authid);
- }
-return ($authid);
+ if (!$authid) {
+ my $sth=$dbh->prepare("select max(authid) from auth_header");
+ $sth->execute;
+ ($authid)=$sth->fetchrow;
+ $authid=$authid+1;
+ ##Insert the recordID in MARC record
+ ##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise
+ $record->add_fields('001',$authid) unless $record->field('001');
+ $record->add_fields('152','','','b'=>$authtypecode) unless $record->field('152');
+# $record->add_fields('100','','','b'=>$authtypecode);
+ warn $record->as_formatted;
+ $dbh->do("lock tables auth_header WRITE");
+ $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc) values (?,now(),?,?)");
+ $sth->execute($authid,$authtypecode,$record->as_usmarc);
+ $sth->finish;
+
+ }else{
+ ##Modified record reinsertid
+# my $idfield=$record->field('001');
+# $record->delete_field($idfield);
+ $record->add_fields('001',$authid) unless ($record->field('001'));
+ $record->add_fields('152','','','b'=>$authtypecode) unless ($record->field('152'));
+# $record->add_fields($authfield,$authid);
+# $record->add_fields($authfield2,'','',$authtypesubfield=>$authtypecode);
+ warn $record->as_formatted;
+ $dbh->do("lock tables auth_header WRITE");
+ my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+ $sth->execute($record->as_usmarc,$authid);
+ $sth->finish;
+ }
+ $dbh->do("unlock tables");
+ zebraop($dbh,$authid,'specialUpdate',"authorityserver");
+
+# if ($record->field($linkidfield)){
+# my @fields=$record->field($linkidfield);
+#
+# foreach my $field (@fields){
+# my $linkid=$field->subfield($linkidsubfield) ;
+# if ($linkid){
+# ##Modify the record of linked
+# AUTHaddlink($dbh,$linkid,$authid);
+# }
+# }
+# }
+ return ($authid);
}
sub AUTHaddlink{
my ($dbh,$linkid,$authid)=@_;
-my $record=XMLgetauthorityhash($dbh,$linkid);
+my $record=AUTHgetauthority($dbh,$linkid);
my $authtypecode=AUTHfind_authtypecode($dbh,$linkid);
#warn "adding l:$linkid,a:$authid,auth:$authtypecode";
-XML_writeline($record,"linkid",$authid,"authorities");
-my $xml=XML_hash2xml($record);
-$dbh->do("lock tables header WRITE");
- my $sth=$dbh->prepare("update auth_header set marcxml=? where authid=?");
- $sth->execute($xml,$linkid);
- $sth->finish;
- $dbh->do("unlock tables");
- ZEBRAop($dbh,$linkid,'specialUpdate',"authorityserver");
+$record=AUTH2marcOnefieldlink($dbh,$record,"auth_header.linkid",$authid,$authtypecode);
+$dbh->do("lock tables auth_header WRITE");
+ my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+ $sth->execute($record->as_usmarc,$linkid);
+ $sth->finish;
+ $dbh->do("unlock tables");
+ zebraop($dbh,$linkid,'specialUpdate',"authorityserver");
}
-
+sub AUTH2marcOnefieldlink {
+ my ( $dbh, $record, $kohafieldname, $newvalue,$authtypecode ) = @_;
+my $sth = $dbh->prepare(
+"select tagfield,tagsubfield from auth_subfield_structure where authtypecode=? and kohafield=?"
+ );
+ $sth->execute($authtypecode,$kohafieldname);
+my ($tagfield,$tagsubfield)=$sth->fetchrow;
+ $record->add_fields( $tagfield, " ", " ", $tagsubfield => $newvalue );
+ return $record;
+}
sub XMLgetauthority {
+
# Returns MARC::XML of the authority passed in parameter.
my ( $dbh, $authid ) = @_;
- my $sth = $dbh->prepare("select marcxml from auth_header where authid=? " );
+
+
+ my $sth =
+ $dbh->prepare("select marc from auth_header where authid=? " );
+
$sth->execute($authid);
- my ($marcxml)=$sth->fetchrow;
- $marcxml=Encode::decode('utf8',$marcxml);
- return ($marcxml);
-}
+ my ($marc)=$sth->fetchrow;
+$marc=MARC::File::USMARC::decode($marc);
+ my $marcxml=$marc->as_xml_record();
+ return $marcxml;
-sub XMLgetauthorityhash {
-## Utility to return hashed MARCXML
-my ($dbh,$authid)=@_;
-my $xml=XMLgetauthority($dbh,$authid);
-my $xmlhash=XML_xml2hash_onerecord($xml);
-return $xmlhash;
}
+sub AUTHfind_leader{
+##Hard coded for NEU auth types
+my($dbh,$authtypecode)=@_;
-
-sub AUTHgetauth_type {
- my ($authtypecode) = @_;
- my $dbh=C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- return $sth->fetchrow_hashref;
+my $leadercode;
+if ($authtypecode eq "AUTH"){
+$leadercode="a";
+}elsif ($authtypecode eq "ESUB"){
+$leadercode="b";
+}elsif ($authtypecode eq "TSUB"){
+$leadercode="c";
+}else{
+$leadercode=" ";
+}
+return $leadercode;
}
+sub AUTHgetauthority {
+# Returns MARC::Record of the biblio passed in parameter.
+ my ($dbh,$authid)=@_;
+my $sth=$dbh->prepare("select marc from auth_header where authid=?");
+ $sth->execute($authid);
+ my ($marc) = $sth->fetchrow;
+my $record=MARC::File::USMARC::decode($marc);
+
+ return ($record);
+}
+sub AUTHgetauth_type {
+ my ($authtypecode) = @_;
+ my $dbh=C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ return $sth->fetchrow_hashref;
+}
sub AUTHmodauthority {
-## $record is expected to be an xmlhash
- my ($dbh,$authid,$record,$authtypecode)=@_;
- my ($oldrecord)=&XMLgetauthorityhash($dbh,$authid);
-### This equality is very dodgy ,It porobaby wont work
- if ($oldrecord eq $record) {
- return $authid;
- }
-##
-my $sth=$dbh->prepare("update auth_header set marcxml=? where authid=?");
-# find if linked records exist and delete the link in them
-my @linkids=XML_readline_asarray($oldrecord,"linkid","authorities");
-
- foreach my $linkid (@linkids){
- ##Modify the record of linked
- my $linkrecord=XMLgetauthorityhash($dbh,$linkid);
- my $linktypecode=AUTHfind_authtypecode($dbh,$linkid);
- my @linkfields=XML_readline_asarray($linkrecord,"linkid","authorities");
- my $updated;
- foreach my $linkfield (@linkfields){
- if ($linkfield eq $authid){
- XML_writeline_id($linkrecord,"linkid",$linkfield,"","authorities");
- $updated=1;
- }
- }#foreach linkfield
- my $linkedxml=XML_hash2xml($linkrecord);
- if ($updated==1){
- $sth->execute($linkedxml,$linkid);
- ZEBRAop($dbh,$linkid,'specialUpdate',"authorityserver");
- }
-
- }#foreach linkid
+ my ($dbh,$authid,$record,$authtypecode,$merge)=@_;
+ my ($oldrecord)=&AUTHgetauthority($dbh,$authid);
+ if ($oldrecord eq $record) {
+ return;
+ }
+my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+#warn find if linked records exist and delete them
+my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
+
+if ($oldrecord->field($linkidfield)){
+my @fields=$oldrecord->field($linkidfield);
+ foreach my $field (@fields){
+my $linkid=$field->subfield($linkidsubfield) ;
+ if ($linkid){
+ ##Modify the record of linked
+ my $linkrecord=AUTHgetauthority($dbh,$linkid);
+ my $linktypecode=AUTHfind_authtypecode($dbh,$linkid);
+ my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$linktypecode);
+ my @linkfields=$linkrecord->field($linkidfield2);
+ foreach my $linkfield (@linkfields){
+ if ($linkfield->subfield($linkidsubfield2) eq $authid){
+ $linkrecord->delete_field($linkfield);
+ $sth->execute($linkrecord->as_usmarc,$linkid);
+ zebraop($dbh,$linkid,'specialUpdate',"authorityserver");
+ }
+ }#foreach linkfield
+ }
+ }#foreach linkid
+}
#Now rewrite the $record to table with an add
$authid=AUTHaddauthority($dbh,$record,$authid,$authtypecode);
-### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.pl
+### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
+### the $merge flag is now depreceated and will be removed at code cleaning
if (C4::Context->preference('dontmerge') ){
# save the file in localfile/modified_authorities
- my $cgidir = C4::Context->intranetdir ."/cgi-bin";
- unless (opendir(DIR, "$cgidir")) {
- $cgidir = C4::Context->intranetdir."/";
- }
-
- my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
- open AUTH, "> $filename";
- print AUTH $authid;
- close AUTH;
-}else{
- &merge($dbh,$authid,$record,$authid,$record);
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR,"$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/";
+ }
+
+ my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
+ open AUTH, "> $filename";
+ print AUTH $authid;
+ close AUTH;
+} else {
+ &merge($dbh,$authid,$record,$authid,$record);
}
return $authid;
}
sub AUTHdelauthority {
- my ($dbh,$authid,$keep_biblio) = @_;
-
+ my ($dbh,$authid,$keep_biblio) = @_;
# if the keep_biblio is set to 1, then authority entries in biblio are preserved.
-# FIXME : delete or not in biblio tables (depending on $keep_biblio flag) is not implemented
-ZEBRAop($dbh,$authid,"recordDelete","authorityserver");
-}
-sub ZEBRAdelauthority {
-my ($dbh,$authid)=@_;
- $dbh->do("delete from auth_header where authid=$authid") ;
+zebraop($dbh,$authid,"recordDelete","authorityserver");
+ $dbh->do("delete from auth_header where authid=$authid") ;
+
+# FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
}
-sub AUTHfind_authtypecode {
- my ($dbh,$authid) = @_;
- my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
- $sth->execute($authid);
- my ($authtypecode) = $sth->fetchrow;
- return $authtypecode;
+sub AUTHhtml2marc {
+ my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
+ my $prevtag = -1;
+ my $record = MARC::Record->new();
+#---- TODO : the leader is missing
+
+# my %subfieldlist=();
+ my $prevvalue; # if tag <10
+ my $field; # if tag >=10
+ for (my $i=0; $i< @$rtags; $i++) {
+ # rebuild MARC::Record
+ if (@$rtags[$i] ne $prevtag) {
+ if ($prevtag < 10) {
+ if ($prevvalue) {
+ $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
+ }
+ } else {
+ if ($field) {
+ $record->add_fields($field);
+ }
+ }
+ $indicators{@$rtags[$i]}.=' ';
+ if (@$rtags[$i] <10) {
+ $prevvalue= @$rvalues[$i];
+ undef $field;
+ } else {
+ undef $prevvalue;
+ $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
+ }
+ $prevtag = @$rtags[$i];
+ } else {
+ if (@$rtags[$i] <10) {
+ $prevvalue=@$rvalues[$i];
+ } else {
+ if (length(@$rvalues[$i])>0) {
+ $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
+ }
+ }
+ $prevtag= @$rtags[$i];
+ }
+ }
+ # the last has not been included inside the loop... do it now !
+ $record->add_fields($field) if $field;
+ return $record;
}
-sub FindDuplicateauth {
-### Should receive an xmlhash
- my ($record,$authtypecode)=@_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- my ($auth_tag_to_report) = $sth->fetchrow;
- $sth->finish;
- # build a request for authoritysearch
- my (@tags, @and_or, @excluding, @operator, @value, $offset, $length);
-
-# if ($record->field($auth_tag_to_report)) {
- push @tags, $auth_tag_to_report;
- push @operator, "all";
- @value, XML_readline_asarray($record,"","",$auth_tag_to_report);
-# }
-
- my ($finalresult,$nbresult) = authoritysearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10,$authtypecode);
- # there is at least 1 result => return the 1st one
- if ($nbresult>0) {
- return @$finalresult[0]->{authid},@$finalresult[0]->{summary};
- }
- # no result, returns nothing
- return;
+
+sub FindDuplicate {
+
+ my ($record,$authtypecode)=@_;
+# warn "IN for ".$record->as_formatted;
+ my $dbh = C4::Context->dbh;
+# warn "".$record->as_formatted;
+ my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ my ($auth_tag_to_report) = $sth->fetchrow;
+ $sth->finish;
+# warn "record :".$record->as_formatted." authtattoreport :$auth_tag_to_report";
+ # build a request for authoritysearch
+ my $query='at='.$authtypecode.' ';
+ map {$query.= " and he=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/)} $record->field($auth_tag_to_report)->subfields();
+ my ($error,$results)=SimpleSearch($query,"authorityserver");
+ # there is at least 1 result => return the 1st one
+ if (@$results>0) {
+ my $marcrecord = MARC::File::USMARC::decode($results->[0]);
+ return $marcrecord->field('001')->data,getsummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
+ }
+ # no result, returns nothing
+ return;
}
sub getsummary{
-## give this an XMLhash record to return summary
-my ($dbh,$record,$authid,$authtypecode)=@_;
+## give this a Marc record to return summary
+my ($record,$authid,$authtypecode)=@_;
+
+my $dbh=C4::Context->dbh;
+# my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
my $authref = getauthtype($authtypecode);
- my $summary = $authref->{summary};
- # if the library has a summary defined, use it. Otherwise, build a standard one
- if ($summary) {
- my $fields = $record->{'datafield'};
- foreach my $field (@$fields) {
- my $tag = $field->{'tag'};
- if ($tag<10) {
- my $tagvalue = XML_readline_onerecord($record,"","",$field->{tag});
- $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
- } else {
- my @subf = XML_readline_withtags($record,"","",$tag);
- for my $i (0..$#subf) {
- my $subfieldcode = $subf[$i][0];
- my $subfieldvalue = $subf[$i][1];
- my $tagsubf = $tag.$subfieldcode;
- $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
- }## each subf
- }#tag >10
- }##each field
- $summary =~ s/\[(.*?)]//g;
- $summary =~ s/\n/<br>/g;
- } else {
-## $summary did not exist create a standard summary
- my $heading; # = $authref->{summary};
- my $altheading;
- my $seeheading;
- my $see;
- my $fields = $record->{datafield};
- if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
- # construct UNIMARC summary, that is quite different from MARC21 one
- foreach my $field (@$fields) {
- # accepted form
- if ($field->{tag} = ~/'2..'/) {
- foreach my $subfield ("a".."z"){
- ## Fixme-- if UNICODE uses numeric subfields as well add them
- $heading.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- }##tag 2..
- # rejected form(s)
- if ($field->{tag} = ~/'4..'/) {
- my $value;
- foreach my $subfield ("a".."z"){
- ## Fixme-- if UNICODE uses numeric subfields as well add them
- $value.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- $summary.= " <i>".$value."</i><br/>";
- $summary.= " <i>see:</i> ".$heading."<br/>";
- }##tag 4..
- # see :
- if ($field->{tag} = ~/'5..'/) {
- my $value;
- foreach my $subfield ("a".."z"){
- ## Fixme-- if UNICODE uses numeric subfields as well add them
- $value.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- $summary.= " <i>".$value."</i><br/>";
- $summary.= " <i>see:</i> ".$heading."<br/>";
- }# tag 5..
- # // form
- if ($field->{tag} = ~/'7..'/) {
- my $value;
- foreach my $subfield ("a".."z"){
- ## Fixme-- if UNICODE uses numeric subfields as well add them
- $value.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- $seeheading.= " <i>see also:</i> ".$value."<br />";
- $altheading.= " ".$value."<br />";
- $altheading.= " <i>see also:</i> ".$heading."<br />";
- }# tag 7..
- }## Foreach fields
- $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
- } else {
- # construct MARC21 summary
- foreach my $field (@$fields) {
- my $tag="1..";
- if($field->{tag} =~ /^$tag/) {
- if ($field->{tag} eq '150') {
- my $value;
- foreach my $subfield ("a".."z"){
- $value=XML_readline_onerecord($record,"","","150",$subfield);
- $heading.="\$".$subfield.$value if $value;
- }
- }else{
- foreach my $subfield ("a".."z"){
- $heading.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- }### tag 150 or else
- }##tag 1..
- my $tag="4..";
- if($field->{tag} =~ /^$tag/) {
- foreach my $subfield ("a".."z"){
- $seeheading.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- $seeheading.= " ".$seeheading."<br />";
- $seeheading.= " <i>see:</i> ".$seeheading."<br />";
- } #tag 4..
- my $tag="5..";
- if($field->{tag} =~ /^$tag/) {
- my $value;
- foreach my $subfield ("a".."z"){
- $value.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- $seeheading.= " <i>see also:</i> ".$value."<br />";
- $altheading.= " ".$value."<br />";
- $altheading.= " <i>see also:</i> ".$altheading."<br />";
- }#tag 5..
-
- }##for each field
- $summary.=$heading.$seeheading.$altheading;
- }##USMARC vs UNIMARC
- }###Summary exists or not
+ my $summary = $authref->{summary};
+ my @fields = $record->fields();
+# chop $tags_using_authtype; # FIXME: why commented out?
+ my $reported_tag;
+
+ # if the library has a summary defined, use it. Otherwise, build a standard one
+ if ($summary) {
+ my @fields = $record->fields();
+# $reported_tag = '$9'.$result[$counter];
+ foreach my $field (@fields) {
+ my $tag = $field->tag();
+ my $tagvalue = $field->as_string();
+ $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
+ if ($tag<10) {
+ if ($tag eq '001') {
+ $reported_tag.='$3'.$field->data();
+ }
+
+ } else {
+ my @subf = $field->subfields;
+ for my $i (0..$#subf) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue = $subf[$i][1];
+ my $tagsubf = $tag.$subfieldcode;
+ $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
+# if ($tag eq $auth_tag_to_report) {
+# $reported_tag.='$'.$subfieldcode.$subfieldvalue;
+# }
+ }
+ }
+ }
+ $summary =~ s/\[(.*?)]//g;
+ $summary =~ s/\n/<br>/g;
+ } else {
+ my $heading; # = $authref->{summary};
+ my $altheading;
+ my $seeheading;
+ my $see;
+ my @fields = $record->fields();
+ if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
+ # construct UNIMARC summary, that is quite different from MARC21 one
+ # accepted form
+ foreach my $field ($record->field('2..')) {
+ $heading.= $field->as_string();
+ }
+ # rejected form(s)
+ foreach my $field ($record->field('4..')) {
+ $summary.= " <i>".$field->as_string()."</i><br/>";
+ $summary.= " <i>see:</i> ".$heading."<br/>";
+ }
+ # see :
+ foreach my $field ($record->field('5..')) {
+ $summary.= " <i>".$field->as_string()."</i><br/>";
+ $summary.= " <i>see:</i> ".$heading."<br/>";
+ }
+ # // form
+ foreach my $field ($record->field('7..')) {
+ $seeheading.= " <i>see also:</i> ".$field->as_string()."<br />";
+ $altheading.= " ".$field->as_string()."<br />";
+ $altheading.= " <i>see also:</i> ".$heading."<br />";
+ }
+ $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
+ } else {
+ # construct MARC21 summary
+ foreach my $field ($record->field('1..')) {
+ if ($record->field('100')) {
+ $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
+ } elsif ($record->field('110')) {
+ $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
+ } elsif ($record->field('111')) {
+ $heading.= $field->as_string('acdefghklnpqstvxyz68');
+ } elsif ($record->field('130')) {
+ $heading.= $field->as_string('adfghklmnoprstvxyz68');
+ } elsif ($record->field('148')) {
+ $heading.= $field->as_string('abvxyz68');
+ } elsif ($record->field('150')) {
+ # $heading.= $field->as_string('abvxyz68');
+ $heading.= $field->as_formatted();
+ my $tag=$field->tag();
+ $heading=~s /^$tag//g;
+ $heading =~s /\_/\$/g;
+ } elsif ($record->field('151')) {
+ $heading.= $field->as_string('avxyz68');
+ } elsif ($record->field('155')) {
+ $heading.= $field->as_string('abvxyz68');
+ } elsif ($record->field('180')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('181')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('182')) {
+ $heading.= $field->as_string('vxyz68');
+ } elsif ($record->field('185')) {
+ $heading.= $field->as_string('vxyz68');
+ } else {
+ $heading.= $field->as_string();
+ }
+ } #See From
+ foreach my $field ($record->field('4..')) {
+ $seeheading.= " ".$field->as_string()."<br />";
+ $seeheading.= " <i>see:</i> ".$seeheading."<br />";
+ } #See Also
+ foreach my $field ($record->field('5..')) {
+ $altheading.= " <i>see also:</i> ".$field->as_string()."<br />";
+ $altheading.= " ".$field->as_string()."<br />";
+ $altheading.= " <i>see also:</i> ".$altheading."<br />";
+ }
+ $summary.=$heading.$seeheading.$altheading;
+ }
+ }
return $summary;
}
-sub getdictsummary{
-## give this a XML record to return a brief summary
-my ($dbh,$record,$authid,$authtypecode)=@_;
- my $authref = getauthtype($authtypecode);
- my $summary = $authref->{summary};
- my $fields = $record->{'datafield'};
- # if the library has a summary defined, use it. Otherwise, build a standard one
- if ($summary) {
- foreach my $field (@$fields) {
- my $tag = $field->{'tag'};
- if ($tag<10) {
- my $tagvalue = XML_readline_onerecord($record,"","",$field->{tag});
- $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
- } else {
- my @subf = XML_readline_withtags($record,"","",$tag);
- for my $i (0..$#subf) {
- my $subfieldcode = $subf[$i][0];
- my $subfieldvalue = $subf[$i][1];
- my $tagsubf = $tag.$subfieldcode;
- $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
- }## each subf
- }#tag >10
- }##each field
- $summary =~ s/\[(.*?)]//g;
- $summary =~ s/\n/<br>/g;
- } else {
- my $heading; # = $authref->{summary};
- my $altheading;
- my $seeheading;
- my $see;
- my $fields = $record->{datafield};
- if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
- # construct UNIMARC summary, that is quite different from MARC21 one
- foreach my $field (@$fields) {
- # accepted form
- if ($field->{tag} = ~/'2..'/) {
- foreach my $subfield ("a".."z"){
- ## Fixme-- if UNICODE uses numeric subfields as well add them
- $heading.=XML_readline_onerecord($record,"","",$field->{tag},$subfield);
- }
- }##tag 2..
- }
- $summary = $heading;
- } else {
- # construct MARC21 summary
- foreach my $field (@$fields) {
- my $tag="1..";
- if($field->{tag} =~ /^$tag/) {
- $heading.= XML_readline_onerecord($record,"","",$field->{tag},"a");
- }
- } #each fieldd
-
- $summary=$heading;
- }# USMARC vs UNIMARC
- }### Summary exists
-return $summary;
+sub BuildUnimarcHierarchies{
+ my $authid = shift @_;
+# warn "authid : $authid";
+ my $force = shift @_;
+ my @globalresult;
+ my $dbh=C4::Context->dbh;
+ my $hierarchies;
+ my $data = AUTHgetheader($dbh,$authid);
+
+ if ($data->{'authtrees'} and not $force){
+ return $data->{'authtrees'};
+ } elsif ($data->{'authtrees'}){
+ $hierarchies=$data->{'authtrees'};
+ } else {
+ my $record = AUTHgetauthority($dbh,$authid);
+ my $found;
+ foreach my $field ($record->field('550')){
+ if ($field->subfield('5') && $field->subfield('5') eq 'g'){
+ my $parentrecord = AUTHgetauthority($dbh,$field->subfield('3'));
+ my $localresult=$hierarchies;
+ my $trees;
+ $trees = BuildUnimarcHierarchies($field->subfield('3'));
+ my @trees;
+ if ($trees=~/;/){
+ @trees = split(/;/,$trees);
+ } else {
+ push @trees, $trees;
+ }
+ foreach (@trees){
+ $_.= ",$authid";
+ }
+ @globalresult = (@globalresult,@trees);
+ $found=1;
+ }
+ $hierarchies=join(";",@globalresult);
+ }
+ #Unless there is no ancestor, I am alone.
+ $hierarchies="$authid" unless ($hierarchies);
+ }
+ AUTHsavetrees($authid,$hierarchies);
+ return $hierarchies;
+}
+
+sub BuildUnimarcHierarchy{
+ my $record = shift @_;
+ my $class = shift @_;
+ my $authid_constructed = shift @_;
+ my $authid=$record->subfield('250','3');
+ my %cell;
+ my $parents=""; my $children="";
+ my (@loopparents,@loopchildren);
+ foreach my $field ($record->field('550')){
+ if ($field->subfield('5') && $field->subfield('a')){
+ if ($field->subfield('5') eq 'h'){
+ push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')};
+ }elsif ($field->subfield('5') eq 'g'){
+ push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')};
+ }
+ # brothers could get in there with an else
+ }
+ }
+ $cell{"ifparents"}=1 if (scalar(@loopparents)>0);
+ $cell{"ifchildren"}=1 if (scalar(@loopchildren)>0);
+ $cell{"loopparents"}=\@loopparents if (scalar(@loopparents)>0);
+ $cell{"loopchildren"}=\@loopchildren if (scalar(@loopchildren)>0);
+ $cell{"class"}=$class;
+ $cell{"loopauthid"}=$authid;
+ $cell{"current_value"} =1 if $authid eq $authid_constructed;
+ $cell{"value"}=$record->subfield('250',"a");
+ return \%cell;
+}
+
+sub AUTHgetheader{
+ my $authid = shift @_;
+ my $sql= "SELECT * from auth_header WHERE authid = ?";
+ my $dbh=C4::Context->dbh;
+ my $rq= $dbh->prepare($sql);
+ $rq->execute($authid);
+ my $data= $rq->fetchrow_hashref;
+ return $data;
+}
+
+sub AUTHsavetrees{
+ my $authid = shift @_;
+ my $trees = shift @_;
+ my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
+ my $dbh=C4::Context->dbh;
+ my $rq= $dbh->prepare($sql);
+ $rq->execute($trees,$authid);
}
sub merge {
-##mergefrom is authid MARCfrom is marcxml hash of authority
-### mergeto ditto
- my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
- return unless (defined $MARCfrom);
- return unless (defined $MARCto);
- my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
- my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
- # return if authority does not exist
-
- # search the tag to report
- my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
- $sth->execute($authtypecodefrom);
- my ($auth_tag_to_report) = $sth->fetchrow;
- my @record_to;
- # search all biblio tags using this authority.
- $sth = $dbh->prepare("select distinct tagfield from biblios_subfield_structure where authtypecode=? ");
- $sth->execute($authtypecodefrom);
+ my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
+ my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
+ my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
+ # return if authority does not exist
+ my @X = $MARCfrom->fields();
+ return if $#X == -1;
+ @X = $MARCto->fields();
+ return if $#X == -1;
+
+
+ # search the tag to report
+ my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
+ $sth->execute($authtypecodefrom);
+ my ($auth_tag_to_report) = $sth->fetchrow;
+
+ my @record_to;
+ @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
+ my @record_from;
+ @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
+
+ # search all biblio tags using this authority.
+ $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+ $sth->execute($authtypecodefrom);
my @tags_using_authtype;
- while (my ($tagfield) = $sth->fetchrow) {
- push @tags_using_authtype,$tagfield ;
- }
-## The subfield for linking authorities is stored in koha_attr named auth_biblio_link_subf
-## This way we may use whichever subfield we want without harcoding 9 in
-my ($dummyfield,$tagsubfield)=MARCfind_marc_from_kohafield("auth_biblio_link_subf","biblios");
- # now, find every biblio using this authority
+ while (my ($tagfield) = $sth->fetchrow) {
+ push @tags_using_authtype,$tagfield."9" ;
+ }
+
+ # now, find every biblio using this authority
### try ZOOM search here
-my @oConnection;
- $oConnection[0]=C4::Context->Zconn("biblioserver");
-##$oConnection[0]->option(elementSetName=>"biblios"); ## Needs a fix
+my $oConnection=C4::Context->Zconn("biblioserver");
my $query;
-my ($attr2)=MARCfind_attr_from_kohafield("authid");
-my $attrfield.=$attr2;
-$query= $attrfield." ".$mergefrom;
-my ($event,$i);
-my $oResult = $oConnection[0]->search_pqf($query);
- while (($i = ZOOM::event(\@oConnection)) != 0) {
- $event = $oConnection[$i-1]->last_event();
- last if $event == ZOOM::Event::ZEND;
- }# while event
-my $count=$oResult->size();
+$query= "an= ".$mergefrom;
+my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
+my $count=$oResult->size() if ($oResult);
my @reccache;
my $z=0;
while ( $z<$count ) {
my $rec;
- $rec=$oResult->record($z);
- my $marcdata = $rec->raw();
-my $koharecord=Encode::decode("utf8",$marcdata);
-$koharecord=XML_xml2hash($koharecord);
- my ( $xmlrecord, @itemsrecord) = XML_separate($koharecord);
-
-push @reccache, $xmlrecord;
+ $rec=$oResult->record($z);
+ my $marcdata = $rec->raw();
+push @reccache, $marcdata;
$z++;
}
$oResult->destroy();
-$oConnection[0]->destroy();
- foreach my $xmlhash (@reccache){
- my $update;
- foreach my $tagfield (@tags_using_authtype){
-
- ###Change the authid in biblio
- $xmlhash=XML_writeline_id($xmlhash,$mergefrom,$mergeto,$tagfield,$tagsubfield);
- ### delete all subfields of bibliorecord
- $xmlhash=XML_delete_withid($xmlhash,$mergeto,$tagfield,$tagsubfield);
- ####Read all the data in from authrecord
- my @record_to=XML_readline_withtags($MARCto,"","",$auth_tag_to_report);
- ##Write the data to biblio
- foreach my $subfield (@record_to) {
- ## Replace the data in MARCXML with the new matching authid
- XML_writeline_withid($xmlhash,$tagsubfield,$mergeto,$subfield->[1],$tagfield,$subfield->[0]);
- $update=1;
- }#foreach $subfield
- }#foreach tagfield
- if ($update==1){
- my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","biblios");
- my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
- NEWmodbiblio($dbh,$biblionumber,$xmlhash,$frameworkcode) ;
- }
-
- }#foreach $xmlhash
+foreach my $marc(@reccache){
+
+my $update;
+ my $marcrecord;
+ $marcrecord = MARC::File::USMARC::decode($marc);
+ foreach my $tagfield (@tags_using_authtype){
+ $tagfield=substr($tagfield,0,3);
+ my @tags = $marcrecord->field($tagfield);
+ foreach my $tag (@tags){
+ my $tagsubs=$tag->subfield("9");
+#warn "$tagfield:$tagsubs:$mergefrom";
+ if ($tagsubs== $mergefrom) {
+
+ $tag->update("9" =>$mergeto);
+ foreach my $subfield (@record_to) {
+# warn "$subfield,$subfield->[0],$subfield->[1]";
+ $tag->update($subfield->[0] =>$subfield->[1]);
+ }#for $subfield
+ }
+ $marcrecord->delete_field($tag);
+ $marcrecord->add_fields($tag);
+ $update=1;
+ }#for each tag
+ }#foreach tagfield
+ my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ;
+ if ($update==1){
+ # FIXME : this NEWmodbiblio does not exist anymore...
+ &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},MARCfind_frameworkcode($oldbiblio->{'biblionumber'})) ;
+ }
+
+}#foreach $marc
}#sub
-
-sub XML_writeline_withid{
-## Only used in authorities to update biblios with matching authids
-my ($xml,$idsubf,$id,$newvalue,$tag,$subf)=@_;
-my $biblio=$xml->{'datafield'};
-my $updated=0;
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- my @subfields=$data->{'subfield'};
- foreach my $subfield ( @subfields){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $idsubf && $code->{'content'} eq $id){
- ###This is the correct tag -- Now reiterate and update
- my @newsubs;
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf ){
- $code->{'content'}=$newvalue;
- $updated=1;
- }
- push @newsubs, $code;
- }## each code updated
- if (!$updated){
- ##Create the subfield if it did not exist
- push @newsubs,{code=>$subf,content=>$newvalue};
- $data->{subfield}= \@newsubs;
- $updated=1;
- }### created
- }### correct tag with id
- }#each code
- }##each subfield
- }# tag match
- }## each datafield
- }### tag >9
-return $xml;
-}
-sub XML_delete_withid{
-## Currently only usedin authorities
-### deletes all the subfields of a matching authid
-my ($xml,$id,$tag,$idsubf)=@_;
-my $biblio=$xml->{'datafield'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- my @subfields=$data->{'subfield'};
- foreach my $subfield ( @subfields){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $idsubf && $code->{'content'} eq $id){
- ###This is the correct tag -- Now reiterate and delete all but id subfield
- foreach my $code ( @$subfield){
- if ($code->{'code'} ne $idsubf ){
- $code->{'content'}="";
- }
- }## each code deleted
- }### correct tag with id
- }#each code
- }## each subfield
- }## tag matches
- }## each datafield
- }# tag >9
-return $xml;
-}
-
-sub XML_readline_withtags {
-my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
-#$xml represents one record of MARCXML as perlhashed
-## returns an array of read fields--useful for reading repeated fields
-### $recordtype is needed for mapping the correct field if supplied
-### If only $tag is given reads the whole tag
-###Returns subfieldcodes as well
-my @value;
- ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-if ($tag){
-### Only datafields are read
-my $biblio=$xml->{'datafield'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf || !$subf){
- push @value,[$code->{'code'},$code->{'content'}];
- }
- }# each code
- }# each subfield
- }### tag found
- }## each tag
- }##tag >9
-}## if tag
-return @value;
-}
-
END { } # module clean-up code here (global destructor)
=back
=cut
# $Id$
-
-# Revision 1.30 2006/09/06 16:21:03 tgarip1957
-# Clean up before final commits
+# $Log$
+# Revision 1.38 2007/03/09 14:31:47 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.28.2.17 2007/02/05 13:16:08 hdl
+# Removing Link from AuthoritiesMARC summary (caused a problem owed to the API differences between opac and intranet)
+# + removing $dbh in authoritysearch
+# + adding links in templates on summaries to go to full view.
+# (no more links in popup authorities. or should we add it ?)
+#
+# Revision 1.28.2.16 2007/02/02 18:07:42 hdl
+# Sorting and searching for exact term now works.
+#
+# Revision 1.28.2.15 2007/01/24 10:17:47 hdl
+# FindDuplicate Now works.
+# Be AWARE that it needs a change ccl.properties.
+#
+# Revision 1.28.2.14 2007/01/10 14:40:11 hdl
+# Adding Authorities tree.
+#
+# Revision 1.28.2.13 2007/01/09 15:18:09 hdl
+# Adding an to ccl.properties to allow ccl search for authority-numbers.
+# Fixing Some problems with the previous modification to allow pqf search to work for more than one page.
+# Using search for an= for an authority-Number.
+#
+# Revision 1.28.2.12 2007/01/09 13:51:31 hdl
+# Bug Fixing : AUTHcount_usage used *synchronous* connection where biblio used ****asynchronous**** one.
+# First try to get it work.
+#
+# Revision 1.28.2.11 2007/01/05 14:37:26 btoumi
+# bug fix : remove wrong field in sql syntaxe from auth_subfield_structure table
+#
+# Revision 1.28.2.10 2007/01/04 13:11:08 tipaul
+# commenting 2 zconn destroy
+#
+# Revision 1.28.2.9 2006/12/22 15:09:53 toins
+# removing C4::Database;
+#
+# Revision 1.28.2.8 2006/12/20 17:13:19 hdl
+# modifying use of GILS into use of @attr 1=Koha-Auth-Number
+#
+# Revision 1.28.2.7 2006/12/18 16:45:38 tipaul
+# FIXME upcased
+#
+# Revision 1.28.2.6 2006/12/07 16:45:43 toins
+# removing warn compilation. (perl -wc)
+#
+# Revision 1.28.2.5 2006/12/06 14:19:59 hdl
+# ABugFixing : Authority count Management.
+#
+# Revision 1.28.2.4 2006/11/17 13:18:58 tipaul
+# code cleaning : removing use of "bib", and replacing with "biblionumber"
+#
+# WARNING : I tried to do carefully, but there are probably some mistakes.
+# So if you encounter a problem you didn't have before, look for this change !!!
+# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
+#
+# Revision 1.28.2.3 2006/11/17 11:17:30 tipaul
+# code cleaning : removing use of "bib", and replacing with "biblionumber"
+#
+# WARNING : I tried to do carefully, but there are probably some mistakes.
+# So if you encounter a problem you didn't have before, look for this change !!!
+# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
+#
+# Revision 1.28.2.2 2006/10/12 22:04:47 hdl
+# Authorities working with zebra.
+# zebra Configuration files are comitted next.
+#
+# Revision 1.9.2.17.2.2 2006/07/27 16:34:56 kados
+# syncing with rel_2_2 .. .untested.
+#
+# Revision 1.9.2.17.2.1 2006/05/28 18:49:12 tgarip1957
+# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
+# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
#
# Revision 1.9.2.6 2005/06/07 10:02:00 tipaul
# porting dictionnary search from head to 2.2. there is now a ... facing titles, author & subject, to search in biblio & authorities existing values.
# Revision 1.1 2004/06/07 07:35:01 tipaul
# MARC authority management package
#
-
-package C4::Biblio;
-# New XML API added by tgarip@neu.edu.tr 25/08/06
+package C4::Biblio;
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
+
require Exporter;
use C4::Context;
-use XML::Simple;
-use Encode;
+use MARC::Record;
+use MARC::File::USMARC;
+use MARC::File::XML;
+use ZOOM;
+use C4::Koha;
+use C4::Date;
+use utf8;
+use C4::Log; # logaction
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 2.01;
-
-@ISA = qw(Exporter);
-
-# &itemcount removed, now resides in Search.pm
-#
-@EXPORT = qw(
-
-&getitemtypes
-&getkohafields
-&getshelves
-
-&NEWnewbiblio
-&NEWnewitem
-&NEWmodbiblio
-&NEWmoditem
-&NEWdelbiblio
-&NEWdelitem
-&NEWmodbiblioframework
-
-
-&MARCfind_marc_from_kohafield
-&MARCfind_frameworkcode
-&MARCfind_itemtype
-&MARCgettagslib
-&MARCitemsgettagslib
-
-&MARCfind_attr_from_kohafield
-&MARChtml2xml
-
-
-&XMLgetbiblio
-&XMLgetbibliohash
-&XMLgetitem
-&XMLgetitemhash
-&XMLgetallitems
-&XML_xml2hash
-&XML_xml2hash_onerecord
-&XML_hash2xml
-&XMLmarc2koha
-&XMLmarc2koha_onerecord
-&XML_readline
-&XML_readline_onerecord
-&XML_readline_asarray
-&XML_writeline
-&XML_writeline_id
-&XMLmoditemonefield
-&XMLkoha2marc
-&XML_separate
-&XML_record_header
-&XMLmodLCindex
-&ZEBRAdelbiblio
-&ZEBRAgetrecord
-&ZEBRAop
-&ZEBRAopserver
-&ZEBRA_readyXML
-&ZEBRA_readyXML_noheader
-&ZEBRAopcommit
-&newbiblio
-&modbiblio
-&DisplayISBN
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
+
+@ISA = qw( Exporter );
+# EXPORTED FUNCTIONS.
+
+# to add biblios or items
+push @EXPORT, qw( &AddBiblio &AddItem );
+
+# to get something
+push @EXPORT, qw(
+ &GetBiblio
+ &GetBiblioData
+ &GetBiblioItemData
+ &GetBiblioItemInfosOf
+ &GetBiblioItemByBiblioNumber
+ &GetBiblioFromItemNumber
+
+ &GetItemInfosOf
+ &GetItemStatus
+ &GetItemLocation
+
+ &GetItemsInfo
+ &GetItemFromBarcode
+ &getitemsbybiblioitem
+ &get_itemnumbers_of
+ &GetAuthorisedValueDesc
+ &GetXmlBiblio
);
-#################### XML XML XML XML ###################
-### XML Read- Write functions
-sub XML_readline_onerecord{
-my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
-#$xml represents one record of MARCXML as perlhashed
-### $recordtype is needed for mapping the correct field
- ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-
-if ($tag){
-my $biblio=$xml->{'datafield'};
-my $controlfields=$xml->{'controlfield'};
-my $leader=$xml->{'leader'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf){
- return $code->{'content'};
- }
- }
- }
- }
- }
- }else{
- if ($tag eq "000" || $tag eq "LDR"){
- return $leader->[0] if $leader->[0];
- }else{
- foreach my $control (@$controlfields){
- if ($control->{'tag'} eq $tag){
- return $control->{'content'} if $control->{'content'};
- }
- }
- }
- }##tag
-}## if tag is mapped
-return "";
-}
-sub XML_readline_asarray{
-my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
-#$xml represents one record of MARCXML as perlhashed
-## returns an array of read fields--useful for readind repeated fields
-### $recordtype is needed for mapping the correct field if supplied
-### If only $tag is give reads the whole tag
-my @value;
- ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-if ($tag){
-my $biblio=$xml->{'datafield'};
-my $controlfields=$xml->{'controlfield'};
-my $leader=$xml->{'leader'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf || !$subf){
- push @value, $code->{'content'};
- }
- }
- }
- }
- }
- }else{
- if ($tag eq "000" || $tag eq "LDR"){
- push @value, $leader->[0] if $leader->[0];
- }else{
- foreach my $control (@$controlfields){
- if ($control->{'tag'} eq $tag){
- push @value, $control->{'content'} if $control->{'content'};
-
- }
- }
- }
- }##tag
-}## if tag is mapped
-return @value;
-}
-
-sub XML_readline{
-my ($xml,$kohafield,$recordtype,$tag,$subf)=@_;
-#$xml represents one record node hashed of holdings or a complete xml koharecord
-### $recordtype is needed for reading the child records( like holdings records) .Otherwise main record is assumed ( like biblio)
-## holding records are parsed and sent here one by one
-# If kohafieldname given find tag
-
-($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-my @itemresults;
-if ($tag){
-if ($recordtype eq "holdings"){
- my $item=$xml->{'datafield'};
- my $hcontrolfield=$xml->{'controlfield'};
- if ($tag>9){
- foreach my $data (@$item){
- if ($data->{'tag'} eq $tag){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf){
- return $code->{content};
- }
- }
- }
- }
- }
- }else{
- foreach my $control (@$hcontrolfield){
- if ($control->{'tag'} eq $tag){
- return $control->{'content'};
- }
- }
- }##tag
-
-}else{ ##Not a holding read biblio
-my $biblio=$xml->{'record'}->[0]->{'datafield'};
-my $controlfields=$xml->{'record'}->[0]->{'controlfield'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf){
- return $code->{'content'};
- }
- }
- }
- }
- }
- }else{
-
- foreach my $control (@$controlfields){
- if ($control->{'tag'} eq $tag){
- return $control->{'content'}if $control->{'content'};
- }
- }
- }##tag
-}## Holding or not
-}## if tag is mapped
-return "";
-}
-
-sub XML_writeline{
-## This routine modifies one line of marcxml record hash
-my ($xml,$kohafield,$newvalue,$recordtype,$tag,$subf)=@_;
-$newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
-my $biblio=$xml->{'datafield'};
-my $controlfield=$xml->{'controlfield'};
- ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield;
-my $updated;
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- my @subfields=$data->{'subfield'};
- my @newsubs;
- foreach my $subfield ( @subfields){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf){
- $code->{'content'}=$newvalue;
- $updated=1;
- }
- push @newsubs,$code;
- }
- }
- if (!$updated){
- push @newsubs,{code=>$subf,content=>$newvalue};
- $data->{subfield}= \@newsubs;
- $updated=1;
- }
- }
- }
- ## Tag did not exist
- if (!$updated){
- if ($subf){
- push @$biblio,
- {
- 'ind1' => ' ',
- 'ind2' => ' ',
- 'subfield' => [
- {
- 'content' =>$newvalue,
- 'code' => $subf
- }
- ],
- 'tag' =>$tag
- } ;
- }else{
- push @$biblio,
- {
- 'ind1' => ' ',
- 'ind2' => ' ',
- 'tag' =>$tag
- } ;
- }
- }## created now
- }elsif ($tag>0){
- foreach my $control (@$controlfield){
- if ($control->{'tag'} eq $tag){
- $control->{'content'}=$newvalue;
- $updated=1;
- }
- }
- if (!$updated){
- push @$controlfield,{tag=>$tag,content=>$newvalue};
- }
- }
-return $xml;
-}
-
-sub XML_writeline_id {
-### This routine is similar to XML_writeline but replaces a given value and do not create a new field
-## Useful for repeating fields
-## Currently usedin authorities
-my ($xml,$oldvalue,$newvalue,$tag,$subf)=@_;
-$newvalue= Encode::decode('utf8',$newvalue) if $newvalue;
-my $biblio=$xml->{'datafield'};
-my $controlfield=$xml->{'controlfield'};
- if ($tag>9){
- foreach my $data (@$biblio){
- if ($data->{'tag'} eq $tag){
- my @subfields=$data->{'subfield'};
- foreach my $subfield ( @subfields){
- foreach my $code ( @$subfield){
- if ($code->{'code'} eq $subf && $code->{'content'} eq $oldvalue){
- $code->{'content'}=$newvalue;
- }
- }
- }
- }
- }
- }else{
- foreach my $control(@$controlfield){
- if ($control->{'tag'} eq $tag && $control->{'content'} eq $oldvalue ){
- $control->{'content'}=$newvalue;
- }
- }
- }
-return $xml;
-}
-
-sub XML_xml2hash{
-##make a perl hash from xml file
-my ($xml)=@_;
- my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield','holdings','record'],KeepRoot=>0);
-return $hashed;
-}
-
-sub XML_separate{
-##Separates items from biblio
-my $hashed=shift;
-my $biblio=$hashed->{record}->[0];
-my @items;
-my $items=$hashed->{holdings}->[0]->{record};
-foreach my $item (@$items){
- push @items,$item;
-}
-return ($biblio,@items);
-}
-
-sub XML_xml2hash_onerecord{
-##make a perl hash from xml file
-my ($xml)=@_;
-return undef unless $xml;
- my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0);
-return $hashed;
-}
-sub XML_hash2xml{
-## turn a hash back to xml
-my ($hashed,$root)=@_;
-$root="record" unless $root;
-my $xml= XMLout($hashed,KeyAttr=>['leader','controlfıeld','datafield'],NoSort => 1,AttrIndent => 0,KeepRoot=>0,SuppressEmpty => 1,RootName=>$root );
-return $xml;
-}
-
-
-
-sub XMLgetbiblio {
- # Returns MARC::XML of the biblionumber passed in parameter.
- my ( $dbh, $biblionumber ) = @_;
- my $sth = $dbh->prepare("select marcxml from biblio where biblionumber=? " );
- $sth->execute( $biblionumber);
- my ($marcxml)=$sth->fetchrow;
- $marcxml=Encode::decode('utf8',$marcxml);
- return ($marcxml);
-}
-
-sub XMLgetbibliohash{
-## Utility to return s hashed MARCXML
-my ($dbh,$biblionumber)=@_;
-my $xml=XMLgetbiblio($dbh,$biblionumber);
-my $xmlhash=XML_xml2hash_onerecord($xml);
-return $xmlhash;
-}
-
-sub XMLgetitem {
- # Returns MARC::XML of the item passed in parameter uses either itemnumber or barcode
- my ( $dbh, $itemnumber,$barcode ) = @_;
-my $sth;
-if ($itemnumber){
- $sth = $dbh->prepare("select marcxml from items where itemnumber=?" );
- $sth->execute($itemnumber);
-}else{
- $sth = $dbh->prepare("select marcxml from items where barcode=?" );
- $sth->execute($barcode);
-}
- my ($marcxml)=$sth->fetchrow;
-$marcxml=Encode::decode('utf8',$marcxml);
- return ($marcxml);
-}
-sub XMLgetitemhash{
-## Utility to return s hashed MARCXML
- my ( $dbh, $itemnumber,$barcode ) = @_;
-my $xml=XMLgetitem( $dbh, $itemnumber,$barcode);
-my $xmlhash=XML_xml2hash_onerecord($xml);
-return $xmlhash;
-}
+# To modify something
+push @EXPORT, qw(
+ &ModBiblio
+ &ModItem
+ &ModBiblioframework
+);
+# To delete something
+push @EXPORT, qw(
+ &DelBiblio
+ &DelItem
+);
-sub XMLgetallitems {
-# warn "XMLgetallitems";
- # Returns an array of MARC:XML of the items passed in parameter as biblionumber
- my ( $dbh, $biblionumber ) = @_;
-my @results;
-my $sth = $dbh->prepare("select marcxml from items where biblionumber =?" );
- $sth->execute($biblionumber);
+# Marc related functions
+push @EXPORT, qw(
+ &MARCfind_marc_from_kohafield
+ &MARCfind_frameworkcode
+ &MARCgettagslib
+ &MARCmoditemonefield
+ &MARCaddbiblio
+ &MARCadditem
+ &MARCmodbiblio
+ &MARCmoditem
+ &MARCkoha2marcBiblio
+ &MARCmarc2koha
+ &MARCkoha2marcItem
+ &MARChtml2marc
+ &MARChtml2xml
+ &MARCgetitem
+ &MARCaddword
+ &MARCdelword
+ &MARCdelsubfield
+ &GetMarcNotes
+ &GetMarcSubjects
+ &GetMarcBiblio
+ &GetMarcAuthors
+ &GetMarcSeries
+ &Koha2Marc
+);
- while(my ($marcxml)=$sth->fetchrow_array){
-$marcxml=Encode::decode('utf8',$marcxml);
- push @results,$marcxml;
-}
-return @results;
-}
-
-sub XMLmarc2koha {
-# warn "XMLmarc2koha";
-##Returns two hashes from KOHA_XML record hashed
-## A biblio hash and and array of item hashes
- my ($dbh,$xml,$related_record,@fields) = @_;
- my ($result,@items);
-
-## if @fields is given do not bother about the rest of fields just parse those
-
-if ($related_record eq "biblios" || $related_record eq "" || !$related_record){
- if (@fields){
- foreach my $field(@fields){
- my $val=&XML_readline($xml,$field,'biblios');
- $result->{$field}=$val if $val;
-
- }
- }else{
- 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) {
- $result->{$field}=&XML_readline($xml,$field,'biblios');
- }
- }
-
-## we only need the following for biblio data
-
-# modify copyrightdate to keep only the 1st year found
- my $temp = $result->{'copyrightdate'};
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1>0) {
- $result->{'copyrightdate'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'copyrightdate'} = $1;
- }
-# modify publicationyear to keep only the 1st year found
- $temp = $result->{'publicationyear'};
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1>0) {
- $result->{'publicationyear'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'publicationyear'} = $1;
- }
-}
-if ($related_record eq "holdings" || $related_record eq "" || !$related_record){
-my $holdings=$xml->{holdings}->[0]->{record};
-
-
- if (@fields){
- foreach my $holding (@$holdings){
-my $itemresult;
- foreach my $field(@fields){
- my $val=&XML_readline($holding,$field,'holdings');
- $itemresult->{$field}=$val if $val;
- }
- push @items, $itemresult;
- }
- }else{
- 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;
-my $itemresult;
- while ($field=$sth2->fetchrow) {
- $itemresult->{$field}=&XML_readline($xml,$field,'holdings');
- }
- push @items, $itemresult;
- }
- }
-
-}
-
- return ($result,@items);
-}
-sub XMLmarc2koha_onerecord {
-# warn "XMLmarc2koha_onerecord";
-##Returns a koha hash from MARCXML hash
-
- my ($dbh,$xml,$related_record,@fields) = @_;
- my ($result);
-
-## if @fields is given do not bother about the rest of fields just parse those
-
- if (@fields){
- foreach my $field(@fields){
- my $val=&XML_readline_onerecord($xml,$field,$related_record);
- $result->{$field}=$val if $val;
- }
- }else{
- 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) {
- $result->{$field}=&XML_readline_onerecord($xml,$field,$related_record);
- }
- }
- return ($result);
-}
-
-sub XMLmodLCindex{
-# warn "XMLmodLCindex";
-my ($dbh,$xmlhash)=@_;
-my ($lc)=XML_readline_onerecord($xmlhash,"classification","biblios");
-my ($cutter)=XML_readline_onerecord($xmlhash,"subclass","biblios");
-
- if ($lc){
- $lc.=$cutter;
- my ($lcsort)=calculatelc($lc);
- $xmlhash=XML_writeline($xmlhash,"lcsort",$lcsort,"biblios");
- }
-return $xmlhash;
-}
-
-sub XMLmoditemonefield{
-# This routine takes itemnumber and biblionumber and updates XMLmarc;
-### the ZEBR DB update can wait depending on $donotupdate flag
-my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue,$donotupdate)=@_;
-my ($record) = XMLgetitem($dbh,$itemnumber);
- my $recordhash=XML_xml2hash_onerecord($record);
- XML_writeline( $recordhash, $itemfield, $newvalue,"holdings" );
- if($donotupdate){
- ## Prevent various update calls to zebra wait until all changes finish
- $record=XML_hash2xml($recordhash);
- my $sth=$dbh->prepare("update items set marcxml=? where itemnumber=?");
- $sth->execute($record,$itemnumber);
- $sth->finish;
- }else{
- NEWmoditem($dbh,$recordhash,$biblionumber,$itemnumber);
- }
-
-}
-
-sub XMLkoha2marc {
-# warn "MARCkoha2marc";
-## This routine is still used for acqui management
-##Returns a XML recordhash from a kohahash
- my ($dbh,$result,$recordtype) = @_;
-###create a basic MARCXML
-# find today's date
-my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
-$year=substr($year,2,2);
- my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday);
-my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios");
-##create a dummy record
-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 kohafield from koha_attr where tagfield is not null and recordtype=?");
- $sth2->execute($recordtype);
- my $field;
- while (($field)=$sth2->fetchrow) {
- $record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field};
- }
-return $record;
-}
-
-#
-#
-# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
-#
-## Script to deal with MARCXML related tables
-
-
-##Sub to match kohafield to Z3950 -attributes
-
-sub MARCfind_attr_from_kohafield {
-# warn "MARCfind_attr_from_kohafield";
-## returns attribute
- my ( $kohafield ) = @_;
- return 0, 0 unless $kohafield;
+# Others functions
+push @EXPORT, qw(
+ &PrepareItemrecordDisplay
+ &zebraop
+ &char_decode
+ &itemcalculator
+ &calculatelc
+);
- my $relations = C4::Context->attrfromkohafield;
- return ($relations->{$kohafield});
-}
+# OLD functions,
+push @EXPORT, qw(
+ &newitems
+ &modbiblio
+ &modbibitem
+ &moditem
+ &checkitems
+);
+=head1 NAME
-sub MARCgettagslib {
-# warn "MARCgettagslib";
- my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
- $frameworkcode = "" unless $frameworkcode;
- my $sth;
- my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
+C4::Biblio - acquisitions and cataloging management functions
- # check that framework exists
- $sth =
- $dbh->prepare(
- "select count(*) from biblios_tag_structure where frameworkcode=?");
- $sth->execute($frameworkcode);
- my ($total) = $sth->fetchrow;
- $frameworkcode = "" unless ( $total > 0 );
- $sth =
- $dbh->prepare(
-"select tagfield,liblibrarian,libopac,mandatory,repeatable from biblios_tag_structure where frameworkcode=? order by tagfield"
- );
- $sth->execute($frameworkcode);
- my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
+=head1 DESCRIPTION
- while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
- $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
- $res->{$tab}->{tab} = ""; # XXX
- $res->{$tag}->{mandatory} = $mandatory;
- $res->{$tag}->{repeatable} = $repeatable;
- }
+Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
- $sth =
- $dbh->prepare(
-"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from biblios_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
- );
- $sth->execute($frameworkcode);
+=over 4
- my $subfield;
- my $authorised_value;
- my $authtypecode;
- my $value_builder;
-
- my $seealso;
- my $hidden;
- my $isurl;
- my $link;
+=item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
- while (
- ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
- $mandatory, $repeatable, $authorised_value, $authtypecode,
- $value_builder, $seealso, $hidden,
- $isurl, $link )
- = $sth->fetchrow
- )
- {
- $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
- $res->{$tag}->{$subfield}->{tab} = $tab;
- $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
- $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
- $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
- $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
- $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
- $res->{$tag}->{$subfield}->{seealso} = $seealso;
- $res->{$tag}->{$subfield}->{hidden} = $hidden;
- $res->{$tag}->{$subfield}->{isurl} = $isurl;
- $res->{$tag}->{$subfield}->{link} = $link;
- }
- return $res;
-}
-sub MARCitemsgettagslib {
-# warn "MARCitemsgettagslib";
- my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
- $frameworkcode = "" unless $frameworkcode;
- my $sth;
- my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
+=item 2. as raw MARC in the Zebra index and storage engine
- # check that framework exists
- $sth =
- $dbh->prepare(
- "select count(*) from holdings_tag_structure where frameworkcode=?");
- $sth->execute($frameworkcode);
- my ($total) = $sth->fetchrow;
- $frameworkcode = "" unless ( $total > 0 );
- $sth =
- $dbh->prepare(
-"select tagfield,liblibrarian,libopac,mandatory,repeatable from holdings_tag_structure where frameworkcode=? order by tagfield"
- );
- $sth->execute($frameworkcode);
- my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
+=item 3. as raw MARC the biblioitems.marc
- while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
- $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
- $res->{$tab}->{tab} = ""; # XXX
- $res->{$tag}->{mandatory} = $mandatory;
- $res->{$tag}->{repeatable} = $repeatable;
- }
+=back
- $sth =
- $dbh->prepare(
-"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from holdings_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
- );
- $sth->execute($frameworkcode);
+In the 2.4 version of Koha, the authoritative record-level information is in biblioitems.marc and the authoritative items information is in the items table.
- my $subfield;
- my $authorised_value;
- my $authtypecode;
- my $value_builder;
-
- my $seealso;
- my $hidden;
- my $isurl;
- my $link;
+Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns:
- while (
- ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
- $mandatory, $repeatable, $authorised_value, $authtypecode,
- $value_builder, $seealso, $hidden,
- $isurl, $link )
- = $sth->fetchrow
- )
- {
- $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
- $res->{$tag}->{$subfield}->{tab} = $tab;
- $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
- $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
- $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
- $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
- $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
- $res->{$tag}->{$subfield}->{seealso} = $seealso;
- $res->{$tag}->{$subfield}->{hidden} = $hidden;
- $res->{$tag}->{$subfield}->{isurl} = $isurl;
- $res->{$tag}->{$subfield}->{link} = $link;
- }
- return $res;
-}
-sub MARCfind_marc_from_kohafield {
-# warn "MARCfind_marc_from_kohafield";
- my ( $kohafield,$recordtype) = @_;
- return 0, 0 unless $kohafield;
-$recordtype="biblios" unless $recordtype;
- my $relations = C4::Context->marcfromkohafield;
- return ($relations->{$recordtype}->{$kohafield}->[0],$relations->{$recordtype}->{$kohafield}->[1]);
-}
+=over 4
+=item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
+=item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
+=back
-sub MARCfind_frameworkcode {
-# warn "MARCfind_frameworkcode";
- my ( $dbh, $biblionumber ) = @_;
- my $sth =
- $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
- $sth->execute($biblionumber);
- my ($frameworkcode) = $sth->fetchrow;
- return $frameworkcode;
-}
-sub MARCfind_itemtype {
-# warn "MARCfind_itemtype";
- my ( $dbh, $biblionumber ) = @_;
- my $sth =
- $dbh->prepare("select itemtype from biblio where biblionumber=?");
- $sth->execute($biblionumber);
- my ($itemtype) = $sth->fetchrow;
- return $itemtype;
-}
+Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
+=over 4
+=item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
-sub MARChtml2xml {
-# warn "MARChtml2xml ";
- my ($tags,$subfields,$values,$indicator,$ind_tag,$tagindex) = @_;
- my $xml= "<record>";
+=item 2. _koha_* - low-level internal functions for managing the koha tables
- my $prevvalue;
- my $prevtag=-1;
- my $first=1;
- my $j = -1;
- for (my $i=0;$i<=@$tags;$i++){
- @$values[$i] =~ s/&/&/g;
- @$values[$i] =~ s/</</g;
- @$values[$i] =~ s/>/>/g;
- @$values[$i] =~ s/"/"/g;
- @$values[$i] =~ s/'/'/g;
-
- if ((@$tags[$i].@$tagindex[$i] ne $prevtag)){
- my $tag=@$tags[$i];
- $j++ unless ($tag eq "");
- ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
- if (!$first){
- $xml.="</datafield>\n";
- if (($tag> 10) && (@$values[$i] ne "")){
- my $ind1 = substr(@$indicator[$j],0,1);
- my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
- $first=0;
- } else {
- $first=1;
- }
- } else {
- if (@$values[$i] ne "") {
- # leader
- if ($tag eq "000") {
- ##Force the leader to UTF8
- substr(@$values[$i],9,1)="a";
- $xml.="<leader>@$values[$i]</leader>\n";
- $first=1;
- # rest of the fixed fields
- } elsif ($tag < 10) {
- $xml.="<controlfield tag=\"$tag\">@$values[$i]</controlfield>\n";
- $first=1;
- } else {
- my $ind1 = substr(@$indicator[$j],0,1);
- my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
- $first=0;
- }
- }
- }
- } else { # @$tags[$i] eq $prevtag
- unless (@$values[$i] eq "") {
- my $tag=@$tags[$i];
- if ($first){
- my $ind1 = substr(@$indicator[$j],0,1);
- my $ind2 = substr(@$indicator[$j],1,1);
- $xml.="<datafield tag=\"$tag\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $first=0;
- }
- $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
- }
- }
- $prevtag = @$tags[$i].@$tagindex[$i];
- }
- $xml.="</record>";
- # warn $xml;
- $xml=Encode::decode('utf8',$xml);
- return $xml;
-}
-sub XML_record_header {
-#### this one is for <record>
- my $format = shift;
- my $enc = shift || 'UTF-8';
-##
- return( <<MARC_XML_HEADER );
-<?xml version="1.0" encoding="$enc"?>
-<record xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
- xmlns="http://www.loc.gov/MARC21/slim">
-MARC_XML_HEADER
-}
+=item 3. MARC* functions for interacting with the MARC data in both biblioitems.marc Zebra (biblioitems.marc is authoritative)
+=item 4. Zebra functions used to update the Zebra index
-sub collection_header {
-#### this one is for koha collection
- my $format = shift;
- my $enc = shift || 'UTF-8';
- return( <<KOHA_XML_HEADER );
-<?xml version="1.0" encoding="$enc"?>
-<kohacollection xmlns:marc="http://loc.gov/MARC21/slim" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="http://library.neu.edu.tr/kohanamespace/koharecord.xsd">
-KOHA_XML_HEADER
-}
+=item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
+=item 6. other functions that don't belong in Biblio.pm that will be cleaned out in time. (like MARCfind_marc_from_kohafield which belongs in Search.pm)
+In time, as we solidify the new API these older functions will be weeded out.
+=back
+=head1 EXPORTED FUNCTIONS
+=head2 AddBiblio
+($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
+Exported function (core API) for adding a new biblio to koha.
-##########################NEW NEW NEW#############################
-sub NEWnewbiblio {
- my ( $dbh, $xml, $frameworkcode) = @_;
-$frameworkcode="" unless $frameworkcode;
-my $biblionumber=XML_readline_onerecord($xml,"biblionumber","biblios");
-## In case reimporting records with biblionumbers keep them
-if ($biblionumber){
-$biblionumber=NEWmodbiblio( $dbh, $biblionumber,$xml,$frameworkcode );
-}else{
- $biblionumber = NEWaddbiblio( $dbh, $xml,$frameworkcode );
-}
+=cut
- return ( $biblionumber );
-}
+sub AddBiblio {
+ my ( $record, $frameworkcode ) = @_;
+ my $oldbibnum;
+ my $oldbibitemnum;
+ my $dbh = C4::Context->dbh;
+ # transform the data into koha-table style data
+ my $olddata = MARCmarc2koha( $dbh, $record, $frameworkcode );
+ $oldbibnum = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
+ $olddata->{'biblionumber'} = $oldbibnum;
+ $oldbibitemnum = _koha_add_biblioitem( $dbh, $olddata );
+
+ # we must add bibnum and bibitemnum in MARC::Record...
+ # we build the new field with biblionumber and biblioitemnumber
+ # we drop the original field
+ # we add the new builded field.
+ # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
+ # (steve and paul : thinks 090 is a good choice)
+ my $sth =
+ $dbh->prepare(
+ "SELECT tagfield,tagsubfield
+ FROM marc_subfield_structure
+ WHERE kohafield=?"
+ );
+ $sth->execute("biblio.biblionumber");
+ ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow;
+ $sth->execute("biblioitems.biblioitemnumber");
+ ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
+
+ my $newfield;
+
+ # biblionumber & biblioitemnumber are in different fields
+ if ( $tagfield1 != $tagfield2 ) {
+
+ # deal with biblionumber
+ if ( $tagfield1 < 10 ) {
+ $newfield = MARC::Field->new( $tagfield1, $oldbibnum, );
+ }
+ else {
+ $newfield =
+ MARC::Field->new( $tagfield1, '', '',
+ "$tagsubfield1" => $oldbibnum, );
+ }
+ # drop old field and create new one...
+ my $old_field = $record->field($tagfield1);
+ $record->delete_field($old_field);
+ $record->append_fields($newfield);
+ # deal with biblioitemnumber
+ if ( $tagfield2 < 10 ) {
+ $newfield = MARC::Field->new( $tagfield2, $oldbibitemnum, );
+ }
+ else {
+ $newfield =
+ MARC::Field->new( $tagfield2, '', '',
+ "$tagsubfield2" => $oldbibitemnum, );
+ }
+ # drop old field and create new one...
+ $old_field = $record->field($tagfield2);
+ $record->delete_field($old_field);
+ $record->insert_fields_ordered($newfield);
+# biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
+ }
+ else {
+ my $newfield = MARC::Field->new(
+ $tagfield1, '', '',
+ "$tagsubfield1" => $oldbibnum,
+ "$tagsubfield2" => $oldbibitemnum
+ );
+
+ # drop old field and create new one...
+ my $old_field = $record->field($tagfield1);
+ $record->delete_field($old_field);
+ $record->insert_fields_ordered($newfield);
+ }
+ ###NEU specific add cataloguers cardnumber as well
+ my $cardtag = C4::Context->preference('cataloguersfield');
+ if ($cardtag) {
+ my $tag = substr( $cardtag, 0, 3 );
+ my $subf = substr( $cardtag, 3, 1 );
+ my $me = C4::Context->userenv;
+ my $cataloger = $me->{'cardnumber'} if ($me);
+ my $newtag = MARC::Field->new( $tag, '', '', $subf => $cataloger )
+ if ($me);
+ $record->delete_field($newtag);
+ $record->insert_fields_ordered($newtag);
+ }
-sub NEWmodbiblioframework {
- my ($dbh,$biblionumber,$frameworkcode) =@_;
- my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
- $sth->execute($frameworkcode);
- return 1;
+ # now add the record
+ my $biblionumber =
+ MARCaddbiblio( $record, $oldbibnum, $frameworkcode );
+
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
+ if C4::Context->preference("CataloguingLog");
+
+ return ( $biblionumber, $oldbibitemnum );
}
+=head2 AddItem
-sub NEWdelbiblio {
- my ( $dbh, $biblionumber ) = @_;
-ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver");
-}
-
-
-sub NEWnewitem {
- my ( $dbh, $xmlhash, $biblionumber ) = @_;
- my $itemtype= MARCfind_itemtype($dbh,$biblionumber);
-
-## In case we are re-importing marc records from bulk import do not change itemnumbers
-my $itemnumber=XML_readline_onerecord($xmlhash,"itemnumber","holdings");
-if ($itemnumber){
-NEWmoditem ( $dbh, $xmlhash, $biblionumber, $itemnumber);
-}else{
-
-##Add biblionumber to $record
-$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
- my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'");
-$sth->execute();
-my $notforloan=$sth->fetchrow;
-##Change the notforloan field if $notforloan found
- if ($notforloan >0){
- $xmlhash=XML_writeline($xmlhash,"notforloan",$notforloan,"holdings");
- }
-my $dateaccessioned=XML_readline_onerecord($xmlhash,"dateaccessioned","holdings");
-unless($dateaccessioned){
-# find today's date
-my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
-localtime(time); $year +=1900; $mon +=1;
-my $date = "$year-".sprintf ("%0.2d", $mon)."-".sprintf("%0.2d",$mday);
-
-$xmlhash=XML_writeline($xmlhash,"dateaccessioned",$date,"holdings");
-}
-
-## Now calculate itempart of cutter-- This is NEU specific
-my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
-if ($itemcallnumber){
-my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
-$xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
-}
+$biblionumber = AddItem( $record, $biblionumber)
+
+Exported function (core API) for adding a new item to Koha
-##NEU specific add cataloguers cardnumber as well
-my $me= C4::Context->userenv;
-my $cataloger=$me->{'cardnumber'} if ($me);
-$xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
+=cut
-##Add item to SQL
-my $itemnumber = &OLDnewitems( $dbh, $xmlhash );
+sub AddItem {
+ my ( $record, $biblionumber ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # add item in old-DB
+ my $frameworkcode = MARCfind_frameworkcode( $biblionumber );
+ my $item = &MARCmarc2koha( $dbh, $record, $frameworkcode );
+
+ # needs old biblionumber and biblioitemnumber
+ $item->{'biblionumber'} = $biblionumber;
+ my $sth =
+ $dbh->prepare(
+ "select biblioitemnumber,itemtype from biblioitems where biblionumber=?"
+ );
+ $sth->execute( $item->{'biblionumber'} );
+ my $itemtype;
+ ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
+ $sth =
+ $dbh->prepare(
+ "select notforloan from itemtypes where itemtype='$itemtype'");
+ $sth->execute();
+ my $notforloan = $sth->fetchrow;
+ ##Change the notforloan field if $notforloan found
+ if ( $notforloan > 0 ) {
+ $item->{'notforloan'} = $notforloan;
+ &MARCitemchange( $record, "items.notforloan", $notforloan );
+ }
+ if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
+
+ # find today's date
+ my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
+ localtime(time);
+ $year += 1900;
+ $mon += 1;
+ my $date =
+ "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
+ $item->{'dateaccessioned'} = $date;
+ &MARCitemchange( $record, "items.dateaccessioned", $date );
+ }
+ my ( $itemnumber, $error ) =
+ &_koha_new_items( $dbh, $item, $item->{barcode} );
-# add the item to zebra it will add the biblio as well!!!
- ZEBRAop( $dbh, $biblionumber,"specialUpdate","biblioserver" );
-return $itemnumber;
-}## added new item
+ # add itemnumber to MARC::Record before adding the item.
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,
+ $frameworkcode );
+
+ ##NEU specific add cataloguers cardnumber as well
+ my $cardtag = C4::Context->preference('itemcataloguersubfield');
+ if ($cardtag) {
+ $sth->execute( $frameworkcode, "items.itemnumber" );
+ my ( $itemtag, $subtag ) = $sth->fetchrow;
+ my $me = C4::Context->userenv;
+ my $cataloguer = $me->{'cardnumber'} if ($me);
+ my $newtag = $record->field($itemtag);
+ $newtag->update( $cardtag => $cataloguer ) if ($me);
+ $record->delete_field($newtag);
+ $record->append_fields($newtag);
+ }
+ # add the item
+ &MARCadditem( $record, $item->{'biblionumber'},$frameworkcode );
+
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
+ if C4::Context->preference("CataloguingLog");
+
+ return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
}
+=head2 ModBiblio
+ModBiblio( $record,$biblionumber,$frameworkcode);
-sub NEWmoditem{
- my ( $dbh, $xmlhash, $biblionumber, $itemnumber ) = @_;
+Exported function (core API) to modify a biblio
-##Add itemnumber incase lost (old bug 090c was lost sometimes) --just incase
-$xmlhash=XML_writeline($xmlhash,"itemnumber",$itemnumber,"holdings");
-##Add biblionumber incase lost on html
-$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"holdings");
-##Read barcode
-my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
-## Now calculate itempart of cutter-- This is NEU specific
-my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings");
-if ($itemcallnumber){
-my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber);
-$xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings");
-}
+=cut
-##NEU specific add cataloguers cardnumber as well
-my $me= C4::Context->userenv;
-my $cataloger=$me->{'cardnumber'} if ($me);
-$xmlhash=XML_writeline($xmlhash,"circid",$cataloger,"holdings") if $cataloger;
-my $xml=XML_hash2xml($xmlhash);
- OLDmoditem( $dbh, $xml,$biblionumber,$itemnumber,$barcode );
- ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
-}
+sub ModBiblio {
+ my ( $record, $biblionumber, $frameworkcode ) = @_;
+
+ if (C4::Context->preference("CataloguingLog")) {
+ my $newrecord = GetMarcBiblio($biblionumber);
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,$newrecord->as_formatted)
+ }
+
+ my $dbh = C4::Context->dbh;
+
+ $frameworkcode = "" unless $frameworkcode;
+
+ # update the MARC record with the new record data
+ &MARCmodbiblio( $dbh, $biblionumber, $record, $frameworkcode, 1 );
+
+ # load the koha-table data object
+ my $oldbiblio = MARCmarc2koha( $dbh, $record, $frameworkcode );
-sub NEWdelitem {
- my ( $dbh, $itemnumber ) = @_;
-my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
-$sth->execute($itemnumber);
-my $biblionumber=$sth->fetchrow;
-OLDdelitem( $dbh, $itemnumber ) ;
-ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
+ # modify the other koha tables
+ my $oldbiblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
+ _koha_modify_biblioitem( $dbh, $oldbiblio );
+ return 1;
}
+=head2 ModItem
+Exported function (core API) for modifying an item in Koha.
+=cut
-sub NEWaddbiblio {
- my ( $dbh, $xmlhash,$frameworkcode ) = @_;
- my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
- $sth->execute;
- my $data = $sth->fetchrow;
- my $biblionumber = $data + 1;
- $sth->finish;
- # we must add biblionumber
-my $record;
-$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
-
-###NEU specific add cataloguers cardnumber as well
-
-my $me= C4::Context->userenv;
-my $cataloger=$me->{'cardnumber'} if ($me);
-$xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
-
-## We must add the indexing fields for LC in MARC record--TG
-&XMLmodLCindex($dbh,$xmlhash);
-
-##Find itemtype
-my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
-##Find ISBN
-my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
-##Find ISSN
-my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
-##Find Title
-my $title=XML_readline_onerecord($xmlhash,"title","biblios");
-##Find Author
-my $author=XML_readline_onerecord($xmlhash,"title","biblios");
-my $xml=XML_hash2xml($xmlhash);
-
- $sth = $dbh->prepare("insert into biblio set biblionumber = ?,frameworkcode=?, itemtype=?,marcxml=?,title=?,author=?,isbn=?,issn=?" );
- $sth->execute( $biblionumber,$frameworkcode, $itemtype,$xml ,$title,$author,$isbn,$issn );
+sub ModItem {
+ my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
+ = @_;
+
+ #logging
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
+ if C4::Context->preference("CataloguingLog");
+
+ my $dbh = C4::Context->dbh;
+
+ # if we have a MARC record, we're coming from cataloging and so
+ # we do the whole routine: update the MARC and zebra, then update the koha
+ # tables
+ if ($record) {
+ my $frameworkcode = MARCfind_frameworkcode( $biblionumber );
+ MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete );
+ my $olditem = MARCmarc2koha( $dbh, $record, $frameworkcode );
+ _koha_modify_item( $dbh, $olditem );
+ return $biblionumber;
+ }
- $sth->finish;
-### Do not add biblio to ZEBRA unless there is an item with it -- depends on system preference defaults to NO
-if (C4::Context->preference('AddaloneBiblios')){
- ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
+ # otherwise, we're just looking to modify something quickly
+ # (like a status) so we just update the koha tables
+ elsif ($new_item_hashref) {
+ _koha_modify_item( $dbh, $new_item_hashref );
+ }
}
- return ($biblionumber);
+
+=head2 ModBiblioframework
+
+ModBiblioframework($biblionumber,$frameworkcode);
+
+Exported function to modify a biblio framework
+
+=cut
+
+sub ModBiblioframework {
+ my ( $biblionumber, $frameworkcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "UPDATE biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
+
+ warn "IN ModBiblioframework";
+ $sth->execute($frameworkcode);
+ return 1;
}
-sub NEWmodbiblio {
- my ( $dbh, $biblionumber,$xmlhash,$frameworkcode ) = @_;
-##Add biblionumber incase lost on html
+=head2 DelBiblio
-$xmlhash=XML_writeline($xmlhash,"biblionumber",$biblionumber,"biblios");
+my $error = &DelBiblio($dbh,$biblionumber);
-###NEU specific add cataloguers cardnumber as well
-my $me= C4::Context->userenv;
-my $cataloger=$me->{'cardnumber'} if ($me);
+Exported function (core API) for deleting a biblio in koha.
-$xmlhash=XML_writeline($xmlhash,"indexedby",$cataloger,"biblios") if $cataloger;
+Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
-## We must add the indexing fields for LC in MARC record--TG
+Also backs it up to deleted* tables
- XMLmodLCindex($dbh,$xmlhash);
- OLDmodbiblio ($dbh,$xmlhash,$biblionumber,$frameworkcode);
- my $ok=ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver");
- return ($biblionumber);
-}
+Checks to make sure there are not issues on any of the items
-#
-#
-# OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
-#
-#
+return:
+C<$error> : undef unless an error occurs
-sub OLDnewitems {
+=cut
- my ( $dbh, $xmlhash) = @_;
- my $sth = $dbh->prepare("SELECT max(itemnumber) from items");
- my $data;
- my $itemnumber;
- $sth->execute;
- $data = $sth->fetchrow_hashref;
- $itemnumber = $data->{'max(itemnumber)'} + 1;
- $sth->finish;
- $xmlhash=XML_writeline( $xmlhash, "itemnumber", $itemnumber,"holdings" );
-my $biblionumber=XML_readline_onerecord($xmlhash,"biblionumber","holdings");
- my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings");
-my $xml=XML_hash2xml($xmlhash);
- $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?,barcode = ?,marcxml=?" );
- $sth->execute($itemnumber,$biblionumber,$barcode,$xml);
- return $itemnumber;
-}
-
-sub OLDmoditem {
- my ( $dbh, $xml,$biblionumber,$itemnumber,$barcode ) = @_;
- my $sth =$dbh->prepare("replace items set biblionumber=?,marcxml=?,barcode=? , itemnumber=?");
- $sth->execute($biblionumber,$xml,$barcode,$itemnumber);
- $sth->finish;
-}
+sub DelBiblio {
+ my ( $biblionumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $error; # for error handling
-sub OLDdelitem {
- my ( $dbh, $itemnumber ) = @_;
-my $sth = $dbh->prepare("select * from items where itemnumber=?");
- $sth->execute($itemnumber);
- if ( my $data = $sth->fetchrow_hashref ) {
- $sth->finish;
- my $query = "replace deleteditems set ";
- my @bind = ();
- foreach my $temp ( keys %$data ) {
- $query .= "$temp = ?,";
- push ( @bind, $data->{$temp} );
+ # First make sure there are no items with issues are still attached
+ my $sth =
+ $dbh->prepare(
+ "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
+ $sth->execute($biblionumber);
+ while ( my $biblioitemnumber = $sth->fetchrow ) {
+ my @issues = C4::Circulation::Circ2::itemissues($biblioitemnumber);
+ foreach my $issue (@issues) {
+ if ( ( $issue->{date_due} )
+ && ( $issue->{date_due} ne "Available" ) )
+ {
+
+#FIXME: we need a status system in Biblio like in Circ to return standard codes and messages
+# instead of hard-coded strings
+ $error .=
+"Item is checked out to a patron -- you must return it before deleting the Biblio";
+ }
}
+ }
+ return $error if $error;
- #replacing the last , by ",?)"
- $query =~ s/\,$//;
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- $sth->finish;
- $sth = $dbh->prepare("Delete from items where itemnumber=?");
- $sth->execute($itemnumber);
- $sth->finish;
- }
- $sth->finish;
-}
-
-sub OLDmodbiblio {
-# modifies the biblio table
-my ($dbh,$xmlhash,$biblionumber,$frameworkcode) = @_;
- if (!$frameworkcode){
- $frameworkcode="";
- }
-##Find itemtype
-my $itemtype=XML_readline_onerecord($xmlhash,"itemtype","biblios");
-##Find ISBN
-my $isbn=XML_readline_onerecord($xmlhash,"isbn","biblios");
-##Find ISSN
-my $issn=XML_readline_onerecord($xmlhash,"issn","biblios");
-##Find Title
-my $title=XML_readline_onerecord($xmlhash,"title","biblios");
-##Find Author
-my $author=XML_readline_onerecord($xmlhash,"author","biblios");
-my $xml=XML_hash2xml($xmlhash);
-
-$isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
-$issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g;
-$isbn=~s/^\s+|\s+$//g;
-$isbn=substr($isbn,0,13);
- my $sth = $dbh->prepare("REPLACE biblio set biblionumber=?,marcxml=?,frameworkcode=? ,itemtype=? , title=?,author=?,isbn=?,issn=?" );
- $sth->execute( $biblionumber ,$xml, $frameworkcode,$itemtype, $title,$author,$isbn,$issn);
- $sth->finish;
- return $biblionumber;
-}
+ # Delete in Zebra
+ zebraop($dbh,$biblionumber,"delete_record","biblioserver");
-sub OLDdelbiblio {
- my ( $dbh, $biblionumber ) = @_;
- my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
- $sth->execute($biblionumber);
- if ( my $data = $sth->fetchrow_hashref ) {
- $sth->finish;
- my $query = "replace deletedbiblio set ";
- my @bind = ();
- foreach my $temp ( keys %$data ) {
- $query .= "$temp = ?,";
- push ( @bind, $data->{$temp} );
- }
+ # delete biblio from Koha tables and save in deletedbiblio
+ $error = &_koha_delete_biblio( $dbh, $biblionumber );
- #replacing the last , by ",?)"
- $query =~ s/\,$//;
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- $sth->finish;
- $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
- $sth->execute($biblionumber);
- $sth->finish;
+ # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
+ $sth =
+ $dbh->prepare(
+ "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
+ $sth->execute($biblionumber);
+ while ( my $biblioitemnumber = $sth->fetchrow ) {
+
+ # delete this biblioitem
+ $error = &_koha_delete_biblioitems( $dbh, $biblioitemnumber );
+ return $error if $error;
+
+ # delete items
+ my $items_sth =
+ $dbh->prepare(
+ "SELECT itemnumber FROM items WHERE biblioitemnumber=?");
+ $items_sth->execute($biblioitemnumber);
+ while ( my $itemnumber = $items_sth->fetchrow ) {
+ $error = &_koha_delete_items( $dbh, $itemnumber );
+ return $error if $error;
+ }
}
- $sth->finish;
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
+ if C4::Context->preference("CataloguingLog");
+ return;
}
+=head2 DelItem
-#
-#
-#
-#ZEBRA ZEBRA ZEBRA
-#
-#
+DelItem( $biblionumber, $itemnumber );
-sub ZEBRAdelbiblio {
-## Zebra calls this routine to delete after it deletes biblio from ZEBRAddb
- my ( $dbh, $biblionumber ) = @_;
-my $sth=$dbh->prepare("SELECT itemnumber FROM items where biblionumber=?");
+Exported function (core API) for deleting an item record in Koha.
-$sth->execute($biblionumber);
- while (my $itemnumber =$sth->fetchrow){
- OLDdelitem($dbh,$itemnumber) ;
- }
-OLDdelbiblio($dbh,$biblionumber) ;
-}
+=cut
-sub ZEBRAgetrecord{
-my $biblionumber=shift;
-my @kohafield="biblionumber";
-my @value=$biblionumber;
-my ($count,@result)=C4::Search::ZEBRAsearch_kohafields(\@kohafield,\@value);
+sub DelItem {
+ my ( $biblionumber, $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ &_koha_delete_item( $dbh, $itemnumber );
+ my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
+ &MARCaddbiblio( $newrec, $biblionumber, MARCfind_frameworkcode($biblionumber) );
+ &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
+ if C4::Context->preference("CataloguingLog");
+}
+
+=head2 GetBiblioData
+
+ $data = &GetBiblioData($biblionumber, $type);
+
+Returns information about the book with the given biblionumber.
+
+C<$type> is ignored.
+
+C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
+the C<biblio> and C<biblioitems> tables in the
+Koha database.
+
+In addition, C<$data-E<gt>{subject}> is the list of the book's
+subjects, separated by C<" , "> (space, comma, space).
+
+If there are multiple biblioitems with the given biblionumber, only
+the first one is considered.
+
+=cut
+
+#'
+sub GetBiblioData {
+ my ( $bibnum, $type ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my $query = "
+ SELECT * , biblioitems.notes AS bnotes, biblio.notes
+ FROM biblio
+ LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
+ LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
+ WHERE biblio.biblionumber = ?
+ AND biblioitems.biblionumber = biblio.biblionumber
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($bibnum);
+ my $data;
+ $data = $sth->fetchrow_hashref;
+ $sth->finish;
+
+ return ($data);
+} # sub GetBiblioData
+
+
+=head2 GetItemsInfo
+
+ @results = &GetItemsInfo($biblionumber, $type);
+
+Returns information about books with the given biblionumber.
+
+C<$type> may be either C<intra> or anything else. If it is not set to
+C<intra>, then the search will exclude lost, very overdue, and
+withdrawn items.
+
+C<&GetItemsInfo> returns a list of references-to-hash. Each element
+contains a number of keys. Most of them are table items from the
+C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
+Koha database. Other keys include:
+
+=over 4
+
+=item C<$data-E<gt>{branchname}>
+
+The name (not the code) of the branch to which the book belongs.
+
+=item C<$data-E<gt>{datelastseen}>
+
+This is simply C<items.datelastseen>, except that while the date is
+stored in YYYY-MM-DD format in the database, here it is converted to
+DD/MM/YYYY format. A NULL date is returned as C<//>.
+
+=item C<$data-E<gt>{datedue}>
+
+=item C<$data-E<gt>{class}>
+
+This is the concatenation of C<biblioitems.classification>, the book's
+Dewey code, and C<biblioitems.subclass>.
+
+=item C<$data-E<gt>{ocount}>
+
+I think this is the number of copies of the book available.
+
+=item C<$data-E<gt>{order}>
+
+If this is set, it is set to C<One Order>.
+
+=back
+
+=cut
+
+#'
+sub GetItemsInfo {
+ my ( $biblionumber, $type ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT *,items.notforloan as itemnotforloan
+ FROM items, biblio, biblioitems
+ LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype
+ WHERE items.biblionumber = ?
+ AND biblioitems.biblioitemnumber = items.biblioitemnumber
+ AND biblio.biblionumber = items.biblionumber
+ ORDER BY items.dateaccessioned desc
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ my $i = 0;
+ my @results;
+ my ( $date_due, $count_reserves );
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ my $datedue = '';
+ my $isth = $dbh->prepare(
+ "SELECT issues.*,borrowers.cardnumber
+ FROM issues, borrowers
+ WHERE itemnumber = ?
+ AND returndate IS NULL
+ AND issues.borrowernumber=borrowers.borrowernumber"
+ );
+ $isth->execute( $data->{'itemnumber'} );
+ if ( my $idata = $isth->fetchrow_hashref ) {
+ $data->{borrowernumber} = $idata->{borrowernumber};
+ $data->{cardnumber} = $idata->{cardnumber};
+ $datedue = format_date( $idata->{'date_due'} );
+ }
+ if ( $datedue eq '' ) {
+ #$datedue="Available";
+ my ( $restype, $reserves ) =
+ C4::Reserves2::CheckReserves( $data->{'itemnumber'} );
+ if ($restype) {
+
+ #$datedue=$restype;
+ $count_reserves = $restype;
+ }
+ }
+ $isth->finish;
+
+ #get branch information.....
+ my $bsth = $dbh->prepare(
+ "SELECT * FROM branches WHERE branchcode = ?
+ "
+ );
+ $bsth->execute( $data->{'holdingbranch'} );
+ if ( my $bdata = $bsth->fetchrow_hashref ) {
+ $data->{'branchname'} = $bdata->{'branchname'};
+ }
+ my $date = format_date( $data->{'datelastseen'} );
+ $data->{'datelastseen'} = $date;
+ $data->{'datedue'} = $datedue;
+ $data->{'count_reserves'} = $count_reserves;
+
+ # get notforloan complete status if applicable
+ my $sthnflstatus = $dbh->prepare(
+ 'SELECT authorised_value
+ FROM marc_subfield_structure
+ WHERE kohafield="items.notforloan"
+ '
+ );
+
+ $sthnflstatus->execute;
+ my ($authorised_valuecode) = $sthnflstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $sthnflstatus = $dbh->prepare(
+ "SELECT lib FROM authorised_values
+ WHERE category=?
+ AND authorised_value=?"
+ );
+ $sthnflstatus->execute( $authorised_valuecode,
+ $data->{itemnotforloan} );
+ my ($lib) = $sthnflstatus->fetchrow;
+ $data->{notforloan} = $lib;
+ }
+
+ # my stack procedures
+ my $stackstatus = $dbh->prepare(
+ 'SELECT authorised_value
+ FROM marc_subfield_structure
+ WHERE kohafield="items.stack"
+ '
+ );
+ $stackstatus->execute;
+
+ ($authorised_valuecode) = $stackstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $stackstatus = $dbh->prepare(
+ "SELECT lib
+ FROM authorised_values
+ WHERE category=?
+ AND authorised_value=?
+ "
+ );
+ $stackstatus->execute( $authorised_valuecode, $data->{stack} );
+ my ($lib) = $stackstatus->fetchrow;
+ $data->{stack} = $lib;
+ }
+ $results[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+
+ return (@results);
+}
+
+=head2 getitemstatus
+
+ $itemstatushash = &getitemstatus($fwkcode);
+ returns information about status.
+ Can be MARC dependant.
+ fwkcode is optional.
+ But basically could be can be loan or not
+ Create a status selector with the following code
+
+=head3 in PERL SCRIPT
+
+my $itemstatushash = getitemstatus;
+my @itemstatusloop;
+foreach my $thisstatus (keys %$itemstatushash) {
+ my %row =(value => $thisstatus,
+ statusname => $itemstatushash->{$thisstatus}->{'statusname'},
+ );
+ push @itemstatusloop, \%row;
+}
+$template->param(statusloop=>\@itemstatusloop);
+
+
+=head3 in TEMPLATE
+ <select name="statusloop">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="statusloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+
+=cut
+
+sub GetItemStatus {
+
+ # returns a reference to a hash of references to status...
+ my ($fwk) = @_;
+ my %itemstatus;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ $fwk = '' unless ($fwk);
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.notforloan", $fwk );
+ if ( $tag and $subfield ) {
+ my $sth =
+ $dbh->prepare(
+"select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
+ );
+ $sth->execute( $tag, $subfield, $fwk );
+ if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
+ my $authvalsth =
+ $dbh->prepare(
+"select authorised_value, lib from authorised_values where category=? order by lib"
+ );
+ $authvalsth->execute($authorisedvaluecat);
+ while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
+ $itemstatus{$authorisedvalue} = $lib;
+ }
+ $authvalsth->finish;
+ return \%itemstatus;
+ exit 1;
+ }
+ else {
+
+ #No authvalue list
+ # build default
+ }
+ $sth->finish;
+ }
+
+ #No authvalue list
+ #build default
+ $itemstatus{"1"} = "Not For Loan";
+ return \%itemstatus;
+}
+
+=head2 getitemlocation
+
+ $itemlochash = &getitemlocation($fwk);
+ returns informations about location.
+ where fwk stands for an optional framework code.
+ Create a location selector with the following code
+
+=head3 in PERL SCRIPT
+
+my $itemlochash = getitemlocation;
+my @itemlocloop;
+foreach my $thisloc (keys %$itemlochash) {
+ my $selected = 1 if $thisbranch eq $branch;
+ my %row =(locval => $thisloc,
+ selected => $selected,
+ locname => $itemlochash->{$thisloc},
+ );
+ push @itemlocloop, \%row;
+}
+$template->param(itemlocationloop => \@itemlocloop);
+
+=head3 in TEMPLATE
+ <select name="location">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="itemlocationloop" -->
+ <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+
+=cut
+
+sub GetItemLocation {
+
+ # returns a reference to a hash of references to location...
+ my ($fwk) = @_;
+ my %itemlocation;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ $fwk = '' unless ($fwk);
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.location", $fwk );
+ if ( $tag and $subfield ) {
+ my $sth =
+ $dbh->prepare(
+"select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
+ );
+ $sth->execute( $tag, $subfield, $fwk );
+ if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
+ my $authvalsth =
+ $dbh->prepare(
+"select authorised_value, lib from authorised_values where category=? order by lib"
+ );
+ $authvalsth->execute($authorisedvaluecat);
+ while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
+ $itemlocation{$authorisedvalue} = $lib;
+ }
+ $authvalsth->finish;
+ return \%itemlocation;
+ exit 1;
+ }
+ else {
+
+ #No authvalue list
+ # build default
+ }
+ $sth->finish;
+ }
+
+ #No authvalue list
+ #build default
+ $itemlocation{"1"} = "Not For Loan";
+ return \%itemlocation;
+}
+
+=head2 &GetBiblioItemData
+
+ $itemdata = &GetBiblioItemData($biblioitemnumber);
+
+Looks up the biblioitem with the given biblioitemnumber. Returns a
+reference-to-hash. The keys are the fields from the C<biblio>,
+C<biblioitems>, and C<itemtypes> tables in the Koha database, except
+that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
+
+=cut
+
+#'
+sub GetBiblioItemData {
+ my ($bibitem) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"Select *,biblioitems.notes as bnotes from biblioitems, biblio,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"
+ );
+ my $data;
+
+ $sth->execute($bibitem);
+
+ $data = $sth->fetchrow_hashref;
+
+ $sth->finish;
+ return ($data);
+} # sub &GetBiblioItemData
+
+=head2 GetItemFromBarcode
+
+$result = GetItemFromBarcode($barcode);
+
+=cut
+
+sub GetItemFromBarcode {
+ my ($barcode) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my $rq =
+ $dbh->prepare("SELECT itemnumber from items where items.barcode=?");
+ $rq->execute($barcode);
+ my ($result) = $rq->fetchrow;
+ return ($result);
+}
+
+=head2 GetBiblioItemByBiblioNumber
+
+NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
+
+=cut
+
+sub GetBiblioItemByBiblioNumber {
+ my ($biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
+ my $count = 0;
+ my @results;
+
+ $sth->execute($biblionumber);
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
+ }
+
+ $sth->finish;
+ return @results;
+}
+
+=head2 GetBiblioFromItemNumber
+
+ $item = &GetBiblioFromItemNumber($itemnumber);
+
+Looks up the item with the given itemnumber.
+
+C<&itemnodata> returns a reference-to-hash whose keys are the fields
+from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
+database.
+
+=cut
+
+#'
+sub GetBiblioFromItemNumber {
+ my ( $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $env;
+ my $sth = $dbh->prepare(
+ "SELECT * FROM biblio,items,biblioitems
+ WHERE items.itemnumber = ?
+ AND biblio.biblionumber = items.biblionumber
+ AND biblioitems.biblioitemnumber = items.biblioitemnumber"
+ );
+
+ $sth->execute($itemnumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
+}
+
+=head2 GetBiblio
+
+( $count, @results ) = &GetBiblio($biblionumber);
+
+=cut
+
+sub GetBiblio {
+ my ($biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
+ my $count = 0;
+ my @results;
+ $sth->execute($biblionumber);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$count] = $data;
+ $count++;
+ } # while
+ $sth->finish;
+ return ( $count, @results );
+} # sub GetBiblio
+
+=head2 getitemsbybiblioitem
+
+( $count, @results ) = &getitemsbybiblioitem($biblioitemnum);
+
+=cut
+
+sub getitemsbybiblioitem {
+ my ($biblioitemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from items, biblio where
+biblio.biblionumber = items.biblionumber and biblioitemnumber
+= ?"
+ );
+
+ # || die "Cannot prepare $query\n" . $dbh->errstr;
+ my $count = 0;
+ my @results;
+
+ $sth->execute($biblioitemnum);
+
+ # || die "Cannot execute $query\n" . $sth->errstr;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$count] = $data;
+ $count++;
+ } # while
+
+ $sth->finish;
+ return ( $count, @results );
+} # sub getitemsbybiblioitem
+
+=head2 get_itemnumbers_of
+
+ my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
+
+Given a list of biblionumbers, return the list of corresponding itemnumbers
+for each biblionumber.
+
+Return a reference on a hash where keys are biblionumbers and values are
+references on array of itemnumbers.
+
+=cut
+
+sub get_itemnumbers_of {
+ my @biblionumbers = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = '
+ SELECT itemnumber,
+ biblionumber
+ FROM items
+ WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
+ ';
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@biblionumbers);
+
+ my %itemnumbers_of;
+
+ while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
+ push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
+ }
+
+ return \%itemnumbers_of;
+}
+
+=head2 getRecord
+
+$record = getRecord( $server, $koha_query, $recordSyntax );
+
+get a single record in piggyback mode from Zebra and return it in the requested record syntax
+
+default record syntax is XML
+
+=cut
+
+sub getRecord {
+ my ( $server, $koha_query, $recordSyntax ) = @_;
+ $recordSyntax = "xml" unless $recordSyntax;
+ my $Zconn = C4::Context->Zconn( $server, 0, 1, 1, $recordSyntax );
+ my $rs = $Zconn->search( new ZOOM::Query::CCL2RPN( $koha_query, $Zconn ) );
+ if ( $rs->record(0) ) {
+ return $rs->record(0)->raw();
+ }
+}
+
+=head2 GetItemInfosOf
+
+GetItemInfosOf(@itemnumbers);
+
+=cut
+
+sub GetItemInfosOf {
+ my @itemnumbers = @_;
+
+ my $query = '
+ SELECT *
+ FROM items
+ WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
+ ';
+ return get_infos_of( $query, 'itemnumber' );
+}
+
+=head2 GetBiblioItemInfosOf
+
+GetBiblioItemInfosOf(@biblioitemnumbers);
+
+=cut
+
+sub GetBiblioItemInfosOf {
+ my @biblioitemnumbers = @_;
+
+ my $query = '
+ SELECT biblioitemnumber,
+ publicationyear,
+ itemtype
+ FROM biblioitems
+ WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
+ ';
+ return get_infos_of( $query, 'biblioitemnumber' );
+}
+
+=head2 z3950_extended_services
+
+z3950_extended_services($serviceType,$serviceOptions,$record);
+
+ z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
+
+C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
+
+C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
+
+ action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
+
+and maybe
+
+ recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
+ syntax => the record syntax (transfer syntax)
+ databaseName = Database from connection object
+
+ To set serviceOptions, call set_service_options($serviceType)
+
+C<$record> the record, if one is needed for the service type
+
+ A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
+
+=cut
+
+sub z3950_extended_services {
+ my ( $server, $serviceType, $action, $serviceOptions ) = @_;
+
+ # get our connection object
+ my $Zconn = C4::Context->Zconn( $server, 0, 1 );
+
+ # create a new package object
+ my $Zpackage = $Zconn->package();
+
+ # set our options
+ $Zpackage->option( action => $action );
+
+ if ( $serviceOptions->{'databaseName'} ) {
+ $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
+ }
+ if ( $serviceOptions->{'recordIdNumber'} ) {
+ $Zpackage->option(
+ recordIdNumber => $serviceOptions->{'recordIdNumber'} );
+ }
+ if ( $serviceOptions->{'recordIdOpaque'} ) {
+ $Zpackage->option(
+ recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
+ }
+
+ # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
+ #if ($serviceType eq 'itemorder') {
+ # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
+ # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
+ # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
+ # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
+ #}
+
+ if ( $serviceOptions->{record} ) {
+ $Zpackage->option( record => $serviceOptions->{record} );
+
+ # can be xml or marc
+ if ( $serviceOptions->{'syntax'} ) {
+ $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
+ }
+ }
+
+ # send the request, handle any exception encountered
+ eval { $Zpackage->send($serviceType) };
+ if ( $@ && $@->isa("ZOOM::Exception") ) {
+ return "error: " . $@->code() . " " . $@->message() . "\n";
+ }
+
+ # free up package resources
+ $Zpackage->destroy();
+}
+
+=head2 set_service_options
+
+my $serviceOptions = set_service_options($serviceType);
+
+C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
+
+Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
+
+=cut
+
+sub set_service_options {
+ my ($serviceType) = @_;
+ my $serviceOptions;
+
+# FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
+# $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
+
+ if ( $serviceType eq 'commit' ) {
+
+ # nothing to do
+ }
+ if ( $serviceType eq 'create' ) {
+
+ # nothing to do
+ }
+ if ( $serviceType eq 'drop' ) {
+ die "ERROR: 'drop' not currently supported (by Zebra)";
+ }
+ return $serviceOptions;
+}
+
+=head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
+
+=head2 MARCgettagslib
+
+=cut
+
+sub MARCgettagslib {
+ my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
+ $frameworkcode = "" unless $frameworkcode;
+ my $sth;
+ my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
+
+ # check that framework exists
+ $sth =
+ $dbh->prepare(
+ "select count(*) from marc_tag_structure where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ my ($total) = $sth->fetchrow;
+ $frameworkcode = "" unless ( $total > 0 );
+ $sth =
+ $dbh->prepare(
+"select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
+ );
+ $sth->execute($frameworkcode);
+ my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
+
+ while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
+ $sth->fetchrow )
+ {
+ $res->{$tag}->{lib} =
+ ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
+ $res->{$tab}->{tab} = ""; # XXX
+ $res->{$tag}->{mandatory} = $mandatory;
+ $res->{$tag}->{repeatable} = $repeatable;
+ }
+
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
+ );
+ $sth->execute($frameworkcode);
+
+ my $subfield;
+ my $authorised_value;
+ my $authtypecode;
+ my $value_builder;
+ my $kohafield;
+ my $seealso;
+ my $hidden;
+ my $isurl;
+ my $link;
+
+ while (
+ (
+ $tag, $subfield, $liblibrarian,
+ , $libopac, $tab,
+ $mandatory, $repeatable, $authorised_value,
+ $authtypecode, $value_builder, $kohafield,
+ $seealso, $hidden, $isurl,
+ $link
+ )
+ = $sth->fetchrow
+ )
+ {
+ $res->{$tag}->{$subfield}->{lib} =
+ ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
+ $res->{$tag}->{$subfield}->{tab} = $tab;
+ $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
+ $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
+ $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
+ $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
+ $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
+ $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
+ $res->{$tag}->{$subfield}->{seealso} = $seealso;
+ $res->{$tag}->{$subfield}->{hidden} = $hidden;
+ $res->{$tag}->{$subfield}->{isurl} = $isurl;
+ $res->{$tag}->{$subfield}->{link} = $link;
+ }
+ return $res;
+}
+
+=head2 MARCfind_marc_from_kohafield
+
+=cut
+
+sub MARCfind_marc_from_kohafield {
+ my ( $dbh, $kohafield, $frameworkcode ) = @_;
+ return 0, 0 unless $kohafield;
+ my $relations = C4::Context->marcfromkohafield;
+ return (
+ $relations->{$frameworkcode}->{$kohafield}->[0],
+ $relations->{$frameworkcode}->{$kohafield}->[1]
+ );
+}
+
+=head2 MARCaddbiblio
+
+&MARCaddbiblio($newrec,$biblionumber,$frameworkcode);
+
+Add MARC data for a biblio to koha
+
+=cut
+
+sub MARCaddbiblio {
+
+# pass the MARC::Record to this function, and it will create the records in the marc tables
+ my ( $record, $biblionumber, $frameworkcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @fields = $record->fields();
+ if ( !$frameworkcode ) {
+ $frameworkcode = "";
+ }
+ my $sth =
+ $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
+ $sth->execute( $frameworkcode, $biblionumber );
+ $sth->finish;
+ my $encoding = C4::Context->preference("marcflavour");
+
+# deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
+ if ( $encoding eq "UNIMARC" ) {
+ my $string;
+ if ( $record->subfield( 100, "a" ) ) {
+ $string = $record->subfield( 100, "a" );
+ my $f100 = $record->field(100);
+ $record->delete_field($f100);
+ }
+ else {
+ $string = POSIX::strftime( "%Y%m%d", localtime );
+ $string =~ s/\-//g;
+ $string = sprintf( "%-*s", 35, $string );
+ }
+ substr( $string, 22, 6, "frey50" );
+ unless ( $record->subfield( 100, "a" ) ) {
+ $record->insert_grouped_field(
+ MARC::Field->new( 100, "", "", "a" => $string ) );
+ }
+ }
+# warn "biblionumber : ".$biblionumber;
+ $sth =
+ $dbh->prepare(
+ "update biblioitems set marc=?,marcxml=? where biblionumber=?");
+ $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
+ $biblionumber );
+# warn $record->as_xml_record();
+ $sth->finish;
+ zebraop($dbh,$biblionumber,"specialUpdate","biblioserver");
+ return $biblionumber;
+}
+
+=head2 MARCadditem
+
+$newbiblionumber = MARCadditem( $record, $biblionumber, $frameworkcode );
+
+=cut
+
+sub MARCadditem {
+
+# pass the MARC::Record to this function, and it will create the records in the marc tables
+ my ( $record, $biblionumber, $frameworkcode ) = @_;
+ my $newrec = &GetMarcBiblio($biblionumber);
+
+ # 2nd recreate it
+ my @fields = $record->fields();
+ foreach my $field (@fields) {
+ $newrec->append_fields($field);
+ }
+
+ # FIXME: should we be making sure the biblionumbers are the same?
+ my $newbiblionumber =
+ &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
+ return $newbiblionumber;
+}
+
+=head2 GetMarcBiblio
+
+Returns MARC::Record of the biblionumber passed in parameter.
+
+=cut
+
+sub GetMarcBiblio {
+ my $biblionumber = shift;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
+ $sth->execute($biblionumber);
+ my ($marcxml) = $sth->fetchrow;
+# warn "marcxml : $marcxml";
+ MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
+ $marcxml =~ s/\x1e//g;
+ $marcxml =~ s/\x1f//g;
+ $marcxml =~ s/\x1d//g;
+ $marcxml =~ s/\x0f//g;
+ $marcxml =~ s/\x0c//g;
+ my $record = MARC::Record->new();
+ $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
+ return $record;
+}
+
+=head2 GetXmlBiblio
+
+my $marcxml = GetXmlBiblio($biblionumber);
+
+Returns biblioitems.marcxml of the biblionumber passed in parameter.
+
+=cut
+
+sub GetXmlBiblio {
+ my ( $biblionumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
+ $sth->execute($biblionumber);
+ my ($marcxml) = $sth->fetchrow;
+ return $marcxml;
+}
+
+=head2 GetAuthorisedValueDesc
+
+my $subfieldvalue =get_authorised_value_desc(
+ $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
+
+=cut
+
+sub GetAuthorisedValueDesc {
+ my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ #---- branch
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
+ return C4::Branch::GetBranchName($value);
+ }
+
+ #---- itemtypes
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
+ return getitemtypeinfo($value);
+ }
+
+ #---- "true" authorized value
+ my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
+
+ if ( $category ne "" ) {
+ my $sth =
+ $dbh->prepare(
+ "select lib from authorised_values where category = ? and authorised_value = ?"
+ );
+ $sth->execute( $category, $value );
+ my $data = $sth->fetchrow_hashref;
+ return $data->{'lib'};
+ }
+ else {
+ return $value; # if nothing is found return the original value
+ }
+}
+
+=head2 MARCgetitem
+
+Returns MARC::Record of the item passed in parameter.
+
+=cut
+
+sub MARCgetitem {
+ my ( $biblionumber, $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $newrecord = MARC::Record->new();
+ my $marcflavour = C4::Context->preference('marcflavour');
+
+ my $marcxml = GetXmlBiblio($biblionumber);
+ my $record = MARC::Record->new();
+# warn "marcxml :$marcxml";
+ $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
+# warn "record :".$record->as_formatted;
+ # now, find where the itemnumber is stored & extract only the item
+ my ( $itemnumberfield, $itemnumbersubfield ) =
+ MARCfind_marc_from_kohafield( $dbh, 'items.itemnumber', '' );
+ my @fields = $record->field($itemnumberfield);
+ foreach my $field (@fields) {
+ if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
+ $newrecord->insert_fields_ordered($field);
+ }
+ }
+ return $newrecord;
+}
+
+=head2 GetMarcNotes
+
+$marcnotesarray = GetMarcNotes( $record, $marcflavour );
+
+get a single record in piggyback mode from Zebra and return it in the requested record syntax
+
+default record syntax is XML
+
+=cut
+
+sub GetMarcNotes {
+ my ( $record, $marcflavour ) = @_;
+ my $scope;
+ if ( $marcflavour eq "MARC21" ) {
+ $scope = '5..';
+ }
+ else { # assume unimarc if not marc21
+ $scope = '3..';
+ }
+ my @marcnotes;
+ my $note = "";
+ my $tag = "";
+ my $marcnote;
+ foreach my $field ( $record->field($scope) ) {
+ my $value = $field->as_string();
+ if ( $note ne "" ) {
+ $marcnote = { marcnote => $note, };
+ push @marcnotes, $marcnote;
+ $note = $value;
+ }
+ if ( $note ne $value ) {
+ $note = $note . " " . $value;
+ }
+ }
+
+ if ( $note ) {
+ $marcnote = { marcnote => $note };
+ push @marcnotes, $marcnote; #load last tag into array
+ }
+ return \@marcnotes;
+} # end GetMarcNotes
+
+=head2 GetMarcSubjects
+
+$marcsubjcts = GetMarcSubjects($record,$marcflavour);
+
+=cut
+
+sub GetMarcSubjects {
+ my ( $record, $marcflavour ) = @_;
+ my ( $mintag, $maxtag );
+ if ( $marcflavour eq "MARC21" ) {
+ $mintag = "600";
+ $maxtag = "699";
+ }
+ else { # assume unimarc if not marc21
+ $mintag = "600";
+ $maxtag = "611";
+ }
+
+ my @marcsubjcts;
+
+ foreach my $field ( $record->fields ) {
+ next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
+ my @subfields = $field->subfields();
+ my $link;
+ my $label = "su:";
+ my $flag = 0;
+ for my $subject_subfield ( @subfields ) {
+ my $code = $subject_subfield->[0];
+ $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
+ if ( $code == 9 ) {
+ $link = "Koha-Auth-Number:".$subject_subfield->[1];
+ $flag = 1;
+ }
+ elsif ( ! $flag ) {
+ $link = $label;
+ $link =~ s/ and\ssu-to:$//;
+ }
+ }
+ $label =~ s/su/ /g;
+ $label =~ s/://g;
+ $label =~ s/-to//g;
+ $label =~ s/and//g;
+ push @marcsubjcts,
+ {
+ label => $label,
+ link => $link
+ }
+ }
+ return \@marcsubjcts;
+} #end GetMarcSubjects
+
+=head2 GetMarcAuthors
+
+authors = GetMarcAuthors($record,$marcflavour);
+
+=cut
+
+sub GetMarcAuthors {
+ my ( $record, $marcflavour ) = @_;
+ my ( $mintag, $maxtag );
+ if ( $marcflavour eq "MARC21" ) {
+ $mintag = "100";
+ $maxtag = "111";
+ }
+ else { # assume unimarc if not marc21
+ $mintag = "701";
+ $maxtag = "712";
+ }
+
+ my @marcauthors;
+
+ foreach my $field ( $record->fields ) {
+ next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
+ my %hash;
+ my @subfields = $field->subfields();
+ my $count_auth = 0;
+ my $and ;
+ for my $authors_subfield (@subfields) {
+ if ($count_auth ne '0'){
+ $and = " and au:";
+ }
+ $count_auth++;
+ my $subfieldcode = $authors_subfield->[0];
+ my $value = $authors_subfield->[1];
+ $hash{'tag'} = $field->tag;
+ $hash{value} .= $value . " " if ($subfieldcode != 9) ;
+ $hash{link} .= $value if ($subfieldcode eq 9);
+ }
+ push @marcauthors, \%hash;
+ }
+ return \@marcauthors;
+}
+
+=head2 GetMarcSeries
+
+$marcseriessarray = GetMarcSeries($record,$marcflavour);
+
+=cut
+
+sub GetMarcSeries {
+ my ($record, $marcflavour) = @_;
+ my ($mintag, $maxtag);
+ if ($marcflavour eq "MARC21") {
+ $mintag = "440";
+ $maxtag = "490";
+ } else { # assume unimarc if not marc21
+ $mintag = "600";
+ $maxtag = "619";
+ }
+
+ my @marcseries;
+ my $subjct = "";
+ my $subfield = "";
+ my $marcsubjct;
+
+ foreach my $field ($record->field('440'), $record->field('490')) {
+ my @subfields_loop;
+ #my $value = $field->subfield('a');
+ #$marcsubjct = {MARCSUBJCT => $value,};
+ my @subfields = $field->subfields();
+ #warn "subfields:".join " ", @$subfields;
+ my $counter = 0;
+ my @link_loop;
+ for my $series_subfield (@subfields) {
+ my $volume_number;
+ undef $volume_number;
+ # see if this is an instance of a volume
+ if ($series_subfield->[0] eq 'v') {
+ $volume_number=1;
+ }
+
+ my $code = $series_subfield->[0];
+ my $value = $series_subfield->[1];
+ my $linkvalue = $value;
+ $linkvalue =~ s/(\(|\))//g;
+ my $operator = " and " unless $counter==0;
+ push @link_loop, {link => $linkvalue, operator => $operator };
+ my $separator = C4::Context->preference("authoritysep") unless $counter==0;
+ if ($volume_number) {
+ push @subfields_loop, {volumenum => $value};
+ }
+ else {
+ push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
+ }
+ $counter++;
+ }
+ push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
+ #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
+ #push @marcsubjcts, $marcsubjct;
+ #$subjct = $value;
+
+ }
+ my $marcseriessarray=\@marcseries;
+ return $marcseriessarray;
+} #end getMARCseriess
+
+=head2 MARCmodbiblio
+
+MARCmodbibio($dbh,$biblionumber,$record,$frameworkcode,1);
+
+Modify a biblio record with the option to save items data
+
+=cut
+
+sub MARCmodbiblio {
+ my ( $dbh, $biblionumber, $record, $frameworkcode, $keep_items ) = @_;
+
+ # delete original record but save the items
+ my $newrec = &MARCdelbiblio( $biblionumber, $keep_items );
+
+ # recreate it and add the new fields
+ my @fields = $record->fields();
+ foreach my $field (@fields) {
+
+ # this requires a more recent version of MARC::Record
+ # but ensures the fields are in order
+ $newrec->insert_fields_ordered($field);
+ }
+
+ # give back our old leader
+ $newrec->leader( $record->leader() );
+
+ # add the record back with the items info preserved
+ &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
+}
+
+=head2 MARCdelbiblio
+
+&MARCdelbiblio( $biblionumber, $keep_items )
+
+if the keep_item is set to 1, then all items are preserved.
+This flag is set when the delbiblio is called by modbiblio
+due to a too complex structure of MARC (repeatable fields and subfields),
+the best solution for a modif is to delete / recreate the record.
+
+1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
+if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
+exist in deletedbiblio table
+
+=cut
+
+sub MARCdelbiblio {
+ my ( $biblionumber, $keep_items ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my $record = GetMarcBiblio($biblionumber);
+ my $oldbiblionumber = $biblionumber;
+ my $copy2deleted =
+ $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
+ $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
+ my @fields = $record->fields();
+
+ # now, delete in MARC tables.
+ if ( $keep_items eq 1 ) {
+ #search item field code
+ my $sth =
+ $dbh->prepare(
+"select tagfield from marc_subfield_structure where kohafield like 'items.%'"
+ );
+ $sth->execute;
+ my $itemtag = $sth->fetchrow_hashref->{tagfield};
+
+ foreach my $field (@fields) {
+
+ if ( $field->tag() ne $itemtag ) {
+ $record->delete_field($field);
+ } #if
+ } #foreach
+ }
+ else {
+ foreach my $field (@fields) {
+
+ $record->delete_field($field);
+ } #foreach
+ }
+ return $record;
+}
+
+=head2 MARCdelitem
+
+MARCdelitem( $biblionumber, $itemnumber )
+
+delete the item field from the MARC record for the itemnumber specified
+
+=cut
+
+sub MARCdelitem {
+ my ( $biblionumber, $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # get the MARC record
+ my $record = GetMarcBiblio($biblionumber);
+
+ # backup the record
+ my $copy2deleted =
+ $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
+ $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
+
+ #search item field code
+ my $sth =
+ $dbh->prepare(
+"SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
+ );
+ $sth->execute;
+ my ( $itemtag, $itemsubfield ) = $sth->fetchrow;
+ my @fields = $record->field($itemtag);
+ # delete the item specified
+ foreach my $field (@fields) {
+ if ( $field->subfield($itemsubfield) eq $itemnumber ) {
+ $record->delete_field($field);
+ }
+ }
+ return $record;
+}
+
+=head2 MARCmoditemonefield
+
+&MARCmoditemonefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
+
+=cut
+
+sub MARCmoditemonefield {
+ my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
+ my $dbh = C4::Context->dbh;
+ if ( !defined $newvalue ) {
+ $newvalue = "";
+ }
+
+ my $record = MARCgetitem( $biblionumber, $itemnumber );
+
+ my $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
+ );
+ my $tagfield;
+ my $tagsubfield;
+ $sth->execute($itemfield);
+ if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
+ my $tag = $record->field($tagfield);
+ if ($tag) {
+ my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
+ $tag->update( $tagsubfield => $newvalue );
+ $record->delete_field($tag);
+ $record->insert_fields_ordered($tag);
+ &MARCmoditem( $record, $biblionumber, $itemnumber, 0 );
+ }
+ }
+}
+
+=head2 MARCmoditem
+
+&MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete )
+
+=cut
+
+sub MARCmoditem {
+ my ( $record, $biblionumber, $itemnumber, $frameworkcode, $delete ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # delete this item from MARC
+ my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
+
+ # 2nd recreate it
+ my @fields = $record->fields();
+ ###NEU specific add cataloguers cardnumber as well
+ my $cardtag = C4::Context->preference('itemcataloguersubfield');
+
+ foreach my $field (@fields) {
+ if ($cardtag) {
+ my $me = C4::Context->userenv;
+ my $cataloguer = $me->{'cardnumber'} if ($me);
+ $field->update( $cardtag => $cataloguer ) if ($me);
+ }
+ $newrec->append_fields($field);
+ }
+ &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
+}
+
+=head2 MARCfind_frameworkcode
+
+$frameworkcode = MARCfind_frameworkcode( $biblionumber )
+
+=cut
+
+sub MARCfind_frameworkcode {
+ my ( $biblionumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
+ $sth->execute($biblionumber);
+ my ($frameworkcode) = $sth->fetchrow;
+ return $frameworkcode;
+}
+
+=head2 Koha2Marc
+
+$record = Koha2Marc( $hash )
+
+This function builds partial MARC::Record from a hash
+
+Hash entries can be from biblio or biblioitems.
+
+This function is called in acquisition module, to create a basic catalogue entry from user entry
+
+=cut
+
+sub Koha2Marc {
+
+ my ( $hash ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ my $record = MARC::Record->new();
+ foreach (keys %{$hash}) {
+ &MARCkoha2marcOnefield( $sth, $record, $_,
+ $hash->{$_}, '' );
+ }
+ return $record;
+}
+
+=head2 MARCkoha2marcBiblio
+
+$record = MARCkoha2marcBiblio( $biblionumber, $biblioitemnumber )
+
+this function builds partial MARC::Record from the old koha-DB fields
+
+=cut
+
+sub MARCkoha2marcBiblio {
+
+ my ( $biblionumber, $biblioitemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ my $record = MARC::Record->new();
+
+ #--- if biblionumber, then retrieve old-style koha data
+ if ( $biblionumber > 0 ) {
+ my $sth2 = $dbh->prepare(
+"select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
+ from biblio where biblionumber=?"
+ );
+ $sth2->execute($biblionumber);
+ my $row = $sth2->fetchrow_hashref;
+ my $code;
+ foreach $code ( keys %$row ) {
+ if ( $row->{$code} ) {
+ &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
+ $row->{$code}, '' );
+ }
+ }
+ }
+
+ #--- if biblioitem, then retrieve old-style koha data
+ if ( $biblioitemnumber > 0 ) {
+ my $sth2 = $dbh->prepare(
+ " SELECT biblioitemnumber,biblionumber,volume,number,classification,
+ itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
+ volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
+ FROM biblioitems
+ WHERE biblioitemnumber=?
+ "
+ );
+ $sth2->execute($biblioitemnumber);
+ my $row = $sth2->fetchrow_hashref;
+ my $code;
+ foreach $code ( keys %$row ) {
+ if ( $row->{$code} ) {
+ &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
+ $row->{$code}, '' );
+ }
+ }
+ }
+ return $record;
+}
+
+=head2 MARCkoha2marcItem
+
+$record = MARCkoha2marcItem( $dbh, $biblionumber, $itemnumber );
+
+=cut
+
+sub MARCkoha2marcItem {
+
+ # this function builds partial MARC::Record from the old koha-DB fields
+ my ( $dbh, $biblionumber, $itemnumber ) = @_;
+
+ # my $dbh=&C4Connect;
+ my $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ my $record = MARC::Record->new();
+
+ #--- if item, then retrieve old-style koha data
+ if ( $itemnumber > 0 ) {
+
+ # print STDERR "prepare $biblionumber,$itemnumber\n";
+ my $sth2 = $dbh->prepare(
+"SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
+ booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
+ datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
+ reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra
+ FROM items
+ WHERE itemnumber=?"
+ );
+ $sth2->execute($itemnumber);
+ my $row = $sth2->fetchrow_hashref;
+ my $code;
+ foreach $code ( keys %$row ) {
+ if ( $row->{$code} ) {
+ &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
+ $row->{$code}, '' );
+ }
+ }
+ }
+ return $record;
+}
+
+=head2 MARCkoha2marcOnefield
+
+$record = MARCkoha2marcOnefield( $sth, $record, $kohafieldname, $value, $frameworkcode );
+
+=cut
+
+sub MARCkoha2marcOnefield {
+ my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
+ $frameworkcode='' unless $frameworkcode;
+ my $tagfield;
+ my $tagsubfield;
+
+ if ( !defined $sth ) {
+ my $dbh = C4::Context->dbh;
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ }
+ $sth->execute( $frameworkcode, $kohafieldname );
+ if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
+ my $tag = $record->field($tagfield);
+ if ($tag) {
+ $tag->update( $tagsubfield => $value );
+ $record->delete_field($tag);
+ $record->insert_fields_ordered($tag);
+ }
+ else {
+ $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
+ }
+ }
+ return $record;
+}
+
+=head2 MARChtml2xml
+
+$xml = MARChtml2xml( $tags, $subfields, $values, $indicator, $ind_tag )
+
+=cut
+
+sub MARChtml2xml {
+ my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
+ my $xml = MARC::File::XML::header('UTF-8');
+ if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
+ MARC::File::XML->default_record_format('UNIMARC');
+ use POSIX qw(strftime);
+ my $string = strftime( "%Y%m%d", localtime(time) );
+ $string = sprintf( "%-*s", 35, $string );
+ substr( $string, 22, 6, "frey50" );
+ $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
+ $xml .= "<subfield code=\"a\">$string</subfield>\n";
+ $xml .= "</datafield>\n";
+ }
+ my $prevvalue;
+ my $prevtag = -1;
+ my $first = 1;
+ my $j = -1;
+ for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
+ @$values[$i] =~ s/&/&/g;
+ @$values[$i] =~ s/</</g;
+ @$values[$i] =~ s/>/>/g;
+ @$values[$i] =~ s/"/"/g;
+ @$values[$i] =~ s/'/'/g;
+ if ( !utf8::is_utf8( @$values[$i] ) ) {
+ utf8::decode( @$values[$i] );
+ }
+ if ( ( @$tags[$i] ne $prevtag ) ) {
+ $j++ unless ( @$tags[$i] eq "" );
+ if ( !$first ) {
+ $xml .= "</datafield>\n";
+ if ( ( @$tags[$i] && @$tags[$i] > 10 )
+ && ( @$values[$i] ne "" ) )
+ {
+ my $ind1 = substr( @$indicator[$j], 0, 1 );
+ my $ind2;
+ if ( @$indicator[$j] ) {
+ $ind2 = substr( @$indicator[$j], 1, 1 );
+ }
+ else {
+ warn "Indicator in @$tags[$i] is empty";
+ $ind2 = " ";
+ }
+ $xml .=
+"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $xml .=
+"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+ $first = 0;
+ }
+ else {
+ $first = 1;
+ }
+ }
+ else {
+ if ( @$values[$i] ne "" ) {
+
+ # leader
+ if ( @$tags[$i] eq "000" ) {
+ $xml .= "<leader>@$values[$i]</leader>\n";
+ $first = 1;
+
+ # rest of the fixed fields
+ }
+ elsif ( @$tags[$i] < 10 ) {
+ $xml .=
+"<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
+ $first = 1;
+ }
+ else {
+ my $ind1 = substr( @$indicator[$j], 0, 1 );
+ my $ind2 = substr( @$indicator[$j], 1, 1 );
+ $xml .=
+"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $xml .=
+"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+ $first = 0;
+ }
+ }
+ }
+ }
+ else { # @$tags[$i] eq $prevtag
+ if ( @$values[$i] eq "" ) {
+ }
+ else {
+ if ($first) {
+ my $ind1 = substr( @$indicator[$j], 0, 1 );
+ my $ind2 = substr( @$indicator[$j], 1, 1 );
+ $xml .=
+"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
+ $first = 0;
+ }
+ $xml .=
+"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
+ }
+ }
+ $prevtag = @$tags[$i];
+ }
+ $xml .= MARC::File::XML::footer();
+
+ return $xml;
+}
+
+=head2 MARChtml2marc
+
+$record = MARChtml2marc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
+
+=cut
+
+sub MARChtml2marc {
+ my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
+ my $prevtag = -1;
+ my $record = MARC::Record->new();
+
+ # my %subfieldlist=();
+ my $prevvalue; # if tag <10
+ my $field; # if tag >=10
+ for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
+ next unless @$rvalues[$i];
+
+ # rebuild MARC::Record
+ # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
+ if ( @$rtags[$i] ne $prevtag ) {
+ if ( $prevtag < 10 ) {
+ if ($prevvalue) {
+
+ if ( $prevtag ne '000' ) {
+ $record->insert_fields_ordered(
+ ( sprintf "%03s", $prevtag ), $prevvalue );
+ }
+ else {
+
+ $record->leader($prevvalue);
+
+ }
+ }
+ }
+ else {
+ if ($field) {
+ $record->insert_fields_ordered($field);
+ }
+ }
+ $indicators{ @$rtags[$i] } .= ' ';
+ if ( @$rtags[$i] < 10 ) {
+ $prevvalue = @$rvalues[$i];
+ undef $field;
+ }
+ else {
+ undef $prevvalue;
+ $field = MARC::Field->new(
+ ( sprintf "%03s", @$rtags[$i] ),
+ substr( $indicators{ @$rtags[$i] }, 0, 1 ),
+ substr( $indicators{ @$rtags[$i] }, 1, 1 ),
+ @$rsubfields[$i] => @$rvalues[$i]
+ );
+ }
+ $prevtag = @$rtags[$i];
+ }
+ else {
+ if ( @$rtags[$i] < 10 ) {
+ $prevvalue = @$rvalues[$i];
+ }
+ else {
+ if ( length( @$rvalues[$i] ) > 0 ) {
+ $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
+ }
+ }
+ $prevtag = @$rtags[$i];
+ }
+ }
+
+ # the last has not been included inside the loop... do it now !
+ $record->insert_fields_ordered($field) if $field;
+
+ # warn "HTML2MARC=".$record->as_formatted;
+ $record->encoding('UTF-8');
+
+ # $record->MARC::File::USMARC::update_leader();
+ return $record;
+}
+
+=head2 MARCmarc2koha
+
+$result = MARCmarc2koha( $dbh, $record, $frameworkcode )
+
+=cut
+
+sub MARCmarc2koha {
+ my ( $dbh, $record, $frameworkcode ) = @_;
+ my $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ my $result;
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
+ $sth2->execute;
+ my $field;
+ while ( ($field) = $sth2->fetchrow ) {
+ $result =
+ &MARCmarc2kohaOneField( "biblio", $field, $record, $result,
+ $frameworkcode );
+ }
+ $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
+ $sth2->execute;
+ while ( ($field) = $sth2->fetchrow ) {
+ if ( $field eq 'notes' ) { $field = 'bnotes'; }
+ $result =
+ &MARCmarc2kohaOneField( "biblioitems", $field, $record, $result,
+ $frameworkcode );
+ }
+ $sth2 = $dbh->prepare("SHOW COLUMNS from items");
+ $sth2->execute;
+ while ( ($field) = $sth2->fetchrow ) {
+ $result =
+ &MARCmarc2kohaOneField( "items", $field, $record, $result,
+ $frameworkcode );
+ }
+
+ #
+ # modify copyrightdate to keep only the 1st year found
+ my $temp = $result->{'copyrightdate'};
+ $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
+ if ( $1 > 0 ) {
+ $result->{'copyrightdate'} = $1;
+ }
+ else { # if no cYYYY, get the 1st date.
+ $temp =~ m/(\d\d\d\d)/;
+ $result->{'copyrightdate'} = $1;
+ }
+
+ # modify publicationyear to keep only the 1st year found
+ $temp = $result->{'publicationyear'};
+ $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
+ if ( $1 > 0 ) {
+ $result->{'publicationyear'} = $1;
+ }
+ else { # if no cYYYY, get the 1st date.
+ $temp =~ m/(\d\d\d\d)/;
+ $result->{'publicationyear'} = $1;
+ }
+ return $result;
+}
+
+=head2 MARCmarc2kohaOneField
+
+$result = MARCmarc2kohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
+
+=cut
+
+sub MARCmarc2kohaOneField {
+
+# FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
+ my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
+
+ my $res = "";
+ my ( $tagfield, $subfield ) =
+ MARCfind_marc_from_kohafield( "", $kohatable . "." . $kohafield,
+ $frameworkcode );
+ foreach my $field ( $record->field($tagfield) ) {
+ if ( $field->tag() < 10 ) {
+ if ( $result->{$kohafield} ) {
+ $result->{$kohafield} .= " | " . $field->data();
+ }
+ else {
+ $result->{$kohafield} = $field->data();
+ }
+ }
+ else {
+ if ( $field->subfields ) {
+ my @subfields = $field->subfields();
+ foreach my $subfieldcount ( 0 .. $#subfields ) {
+ if ( $subfields[$subfieldcount][0] eq $subfield ) {
+ if ( $result->{$kohafield} ) {
+ $result->{$kohafield} .=
+ " | " . $subfields[$subfieldcount][1];
+ }
+ else {
+ $result->{$kohafield} =
+ $subfields[$subfieldcount][1];
+ }
+ }
+ }
+ }
+ }
+ }
+ return $result;
+}
+
+=head2 MARCitemchange
+
+&MARCitemchange( $record, $itemfield, $newvalue )
+
+=cut
+
+sub MARCitemchange {
+ my ( $record, $itemfield, $newvalue ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my ( $tagfield, $tagsubfield ) =
+ MARCfind_marc_from_kohafield( $dbh, $itemfield, "" );
+ if ( ($tagfield) && ($tagsubfield) ) {
+ my $tag = $record->field($tagfield);
+ if ($tag) {
+ $tag->update( $tagsubfield => $newvalue );
+ $record->delete_field($tag);
+ $record->insert_fields_ordered($tag);
+ }
+ }
+}
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 _koha_add_biblio
+
+_koha_add_biblio($dbh,$biblioitem);
+
+Internal function to add a biblio ($biblio is a hash with the values)
+
+=cut
+
+sub _koha_add_biblio {
+ my ( $dbh, $biblio, $frameworkcode ) = @_;
+ my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
+ $sth->execute;
+ my $data = $sth->fetchrow_arrayref;
+ my $biblionumber = $$data[0] + 1;
+ my $series = 0;
+
+ if ( $biblio->{'seriestitle'} ) { $series = 1 }
+ $sth->finish;
+ $sth = $dbh->prepare(
+ "INSERT INTO biblio
+ SET biblionumber = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
+ );
+ $sth->execute(
+ $biblionumber, $biblio->{'title'},
+ $biblio->{'author'}, $biblio->{'copyrightdate'},
+ $biblio->{'serial'}, $biblio->{'seriestitle'},
+ $biblio->{'notes'}, $biblio->{'abstract'},
+ $biblio->{'unititle'}, $frameworkcode
+ );
+
+ $sth->finish;
+ return ($biblionumber);
+}
+
+=head2 _find_value
+
+ ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
+
+Find the given $subfield in the given $tag in the given
+MARC::Record $record. If the subfield is found, returns
+the (indicators, value) pair; otherwise, (undef, undef) is
+returned.
+
+PROPOSITION :
+Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
+I suggest we export it from this module.
+
+=cut
+
+sub _find_value {
+ my ( $tagfield, $insubfield, $record, $encoding ) = @_;
+ my @result;
+ my $indicator;
+ if ( $tagfield < 10 ) {
+ if ( $record->field($tagfield) ) {
+ push @result, $record->field($tagfield)->data();
+ }
+ else {
+ push @result, "";
+ }
+ }
+ else {
+ foreach my $field ( $record->field($tagfield) ) {
+ my @subfields = $field->subfields();
+ foreach my $subfield (@subfields) {
+ if ( @$subfield[0] eq $insubfield ) {
+ push @result, @$subfield[1];
+ $indicator = $field->indicator(1) . $field->indicator(2);
+ }
+ }
+ }
+ }
+ return ( $indicator, @result );
+}
+
+=head2 _koha_modify_biblio
+
+Internal function for updating the biblio table
+
+=cut
+
+sub _koha_modify_biblio {
+ my ( $dbh, $biblio ) = @_;
+
+# FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
+ my $sth =
+ $dbh->prepare(
+"Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
+ );
+ $sth->execute(
+ $biblio->{'title'}, $biblio->{'author'},
+ $biblio->{'abstract'}, $biblio->{'copyrightdate'},
+ $biblio->{'seriestitle'}, $biblio->{'serial'},
+ $biblio->{'unititle'}, $biblio->{'notes'},
+ $biblio->{'biblionumber'}
+ );
+ $sth->finish;
+ return ( $biblio->{'biblionumber'} );
+}
+
+=head2 _koha_modify_biblioitem
+
+_koha_modify_biblioitem( $dbh, $biblioitem );
+
+=cut
+
+sub _koha_modify_biblioitem {
+ my ( $dbh, $biblioitem ) = @_;
+ my $query;
+##Recalculate LC in case it changed --TG
+
+ $biblioitem->{'itemtype'} = $dbh->quote( $biblioitem->{'itemtype'} );
+ $biblioitem->{'url'} = $dbh->quote( $biblioitem->{'url'} );
+ $biblioitem->{'isbn'} = $dbh->quote( $biblioitem->{'isbn'} );
+ $biblioitem->{'issn'} = $dbh->quote( $biblioitem->{'issn'} );
+ $biblioitem->{'publishercode'} =
+ $dbh->quote( $biblioitem->{'publishercode'} );
+ $biblioitem->{'publicationyear'} =
+ $dbh->quote( $biblioitem->{'publicationyear'} );
+ $biblioitem->{'classification'} =
+ $dbh->quote( $biblioitem->{'classification'} );
+ $biblioitem->{'dewey'} = $dbh->quote( $biblioitem->{'dewey'} );
+ $biblioitem->{'subclass'} = $dbh->quote( $biblioitem->{'subclass'} );
+ $biblioitem->{'illus'} = $dbh->quote( $biblioitem->{'illus'} );
+ $biblioitem->{'pages'} = $dbh->quote( $biblioitem->{'pages'} );
+ $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} );
+ $biblioitem->{'bnotes'} = $dbh->quote( $biblioitem->{'bnotes'} );
+ $biblioitem->{'size'} = $dbh->quote( $biblioitem->{'size'} );
+ $biblioitem->{'place'} = $dbh->quote( $biblioitem->{'place'} );
+ $biblioitem->{'ccode'} = $dbh->quote( $biblioitem->{'ccode'} );
+ $biblioitem->{'biblionumber'} =
+ $dbh->quote( $biblioitem->{'biblionumber'} );
+
+ $query = "Update biblioitems set
+ itemtype = $biblioitem->{'itemtype'},
+ url = $biblioitem->{'url'},
+ isbn = $biblioitem->{'isbn'},
+ issn = $biblioitem->{'issn'},
+ publishercode = $biblioitem->{'publishercode'},
+ publicationyear = $biblioitem->{'publicationyear'},
+ classification = $biblioitem->{'classification'},
+ dewey = $biblioitem->{'dewey'},
+ subclass = $biblioitem->{'subclass'},
+ illus = $biblioitem->{'illus'},
+ pages = $biblioitem->{'pages'},
+ volumeddesc = $biblioitem->{'volumeddesc'},
+ notes = $biblioitem->{'bnotes'},
+ size = $biblioitem->{'size'},
+ place = $biblioitem->{'place'},
+ ccode = $biblioitem->{'ccode'}
+ where biblionumber = $biblioitem->{'biblionumber'}";
+
+ $dbh->do($query);
+ if ( $dbh->errstr ) {
+ warn "$query";
+ }
+}
+
+=head2 _koha_modify_note
+
+_koha_modify_note( $dbh, $bibitemnum, $note );
+
+=cut
+
+sub _koha_modify_note {
+ my ( $dbh, $bibitemnum, $note ) = @_;
+
+ # my $dbh=C4Connect;
+ my $query = "update biblioitems set notes='$note' where
+ biblioitemnumber='$bibitemnum'";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+}
+
+=head2 _koha_add_biblioitem
+
+_koha_add_biblioitem( $dbh, $biblioitem );
+
+Internal function to add a biblioitem
+
+=cut
+
+sub _koha_add_biblioitem {
+ my ( $dbh, $biblioitem ) = @_;
+
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
+ my $data;
+ my $bibitemnum;
+
+ $sth->execute;
+ $data = $sth->fetchrow_arrayref;
+ $bibitemnum = $$data[0] + 1;
+
+ $sth->finish;
+
+ $sth = $dbh->prepare(
+ "INSERT INTO biblioitems SET
+ biblioitemnumber = ?, biblionumber = ?,
+ volume = ?, number = ?,
+ classification = ?, itemtype = ?,
+ url = ?, isbn = ?,
+ issn = ?, dewey = ?,
+ subclass = ?, publicationyear = ?,
+ publishercode = ?, volumedate = ?,
+ volumeddesc = ?, illus = ?,
+ pages = ?, notes = ?,
+ size = ?, lccn = ?,
+ marc = ?, lcsort =?,
+ place = ?, ccode = ?
+ "
+ );
+ my ($lcsort) =
+ calculatelc( $biblioitem->{'classification'} )
+ . $biblioitem->{'subclass'};
+ $sth->execute(
+ $bibitemnum, $biblioitem->{'biblionumber'},
+ $biblioitem->{'volume'}, $biblioitem->{'number'},
+ $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
+ $biblioitem->{'url'}, $biblioitem->{'isbn'},
+ $biblioitem->{'issn'}, $biblioitem->{'dewey'},
+ $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'},
+ $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'},
+ $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
+ $biblioitem->{'pages'}, $biblioitem->{'bnotes'},
+ $biblioitem->{'size'}, $biblioitem->{'lccn'},
+ $biblioitem->{'marc'}, $biblioitem->{'place'},
+ $lcsort, $biblioitem->{'ccode'}
+ );
+ $sth->finish;
+ return ($bibitemnum);
+}
+
+=head2 _koha_new_items
+
+_koha_new_items( $dbh, $item, $barcode );
+
+=cut
+
+sub _koha_new_items {
+ my ( $dbh, $item, $barcode ) = @_;
+
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare("Select max(itemnumber) from items");
+ my $data;
+ my $itemnumber;
+ my $error = "";
+
+ $sth->execute;
+ $data = $sth->fetchrow_hashref;
+ $itemnumber = $data->{'max(itemnumber)'} + 1;
+ $sth->finish;
+## Now calculate lccalnumber
+ my ($cutterextra) = itemcalculator(
+ $dbh,
+ $item->{'biblioitemnumber'},
+ $item->{'itemcallnumber'}
+ );
+
+# FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
+ if ( $item->{'loan'} ) {
+ $item->{'notforloan'} = $item->{'loan'};
+ }
+
+ # if dateaccessioned is provided, use it. Otherwise, set to NOW()
+ if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
+
+ $sth = $dbh->prepare(
+ "Insert into items set
+ itemnumber = ?, biblionumber = ?,
+ multivolumepart = ?,
+ biblioitemnumber = ?, barcode = ?,
+ booksellerid = ?, dateaccessioned = NOW(),
+ homebranch = ?, holdingbranch = ?,
+ price = ?, replacementprice = ?,
+ replacementpricedate = NOW(), datelastseen = NOW(),
+ multivolume = ?, stack = ?,
+ itemlost = ?, wthdrawn = ?,
+ paidfor = ?, itemnotes = ?,
+ itemcallnumber =?, notforloan = ?,
+ location = ?, Cutterextra = ?
+ "
+ );
+ $sth->execute(
+ $itemnumber, $item->{'biblionumber'},
+ $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
+ $barcode, $item->{'booksellerid'},
+ $item->{'homebranch'}, $item->{'holdingbranch'},
+ $item->{'price'}, $item->{'replacementprice'},
+ $item->{multivolume}, $item->{stack},
+ $item->{itemlost}, $item->{wthdrawn},
+ $item->{paidfor}, $item->{'itemnotes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $cutterextra
+ );
+ }
+ else {
+ $sth = $dbh->prepare(
+ "INSERT INTO items SET
+ itemnumber = ?, biblionumber = ?,
+ multivolumepart = ?,
+ biblioitemnumber = ?, barcode = ?,
+ booksellerid = ?, dateaccessioned = ?,
+ homebranch = ?, holdingbranch = ?,
+ price = ?, replacementprice = ?,
+ replacementpricedate = NOW(), datelastseen = NOW(),
+ multivolume = ?, stack = ?,
+ itemlost = ?, wthdrawn = ?,
+ paidfor = ?, itemnotes = ?,
+ itemcallnumber = ?, notforloan = ?,
+ location = ?,
+ Cutterextra = ?
+ "
+ );
+ $sth->execute(
+ $itemnumber, $item->{'biblionumber'},
+ $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
+ $barcode, $item->{'booksellerid'},
+ $item->{'dateaccessioned'}, $item->{'homebranch'},
+ $item->{'holdingbranch'}, $item->{'price'},
+ $item->{'replacementprice'}, $item->{multivolume},
+ $item->{stack}, $item->{itemlost},
+ $item->{wthdrawn}, $item->{paidfor},
+ $item->{'itemnotes'}, $item->{'itemcallnumber'},
+ $item->{'notforloan'}, $item->{'location'},
+ $cutterextra
+ );
+ }
+ if ( defined $sth->errstr ) {
+ $error .= $sth->errstr;
+ }
+ return ( $itemnumber, $error );
+}
+
+=head2 _koha_modify_item
+
+_koha_modify_item( $dbh, $item, $op );
+
+=cut
+
+sub _koha_modify_item {
+ my ( $dbh, $item, $op ) = @_;
+ $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
+
+ # if all we're doing is setting statuses, just update those and get out
+ if ( $op eq "setstatus" ) {
+ my $query =
+ "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
+ my @bind = (
+ $item->{'itemlost'}, $item->{'wthdrawn'},
+ $item->{'binding'}, $item->{'itemnumber'}
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@bind);
+ $sth->finish;
+ return undef;
+ }
+## Now calculate lccalnumber
+ my ($cutterextra) =
+ itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
+
+ my $query = "UPDATE items SET
+barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
+
+ my @bind = (
+ $item->{'barcode'}, $item->{'notes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $item->{multivolumepart},
+ $item->{multivolume}, $item->{stack},
+ $item->{wthdrawn}, $item->{holdingbranch},
+ $item->{homebranch}, $cutterextra,
+ $item->{onloan}, $item->{binding}
+ );
+ if ( $item->{'lost'} ne '' ) {
+ $query =
+"update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
+ itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
+ location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
+ @bind = (
+ $item->{'bibitemnum'}, $item->{'barcode'},
+ $item->{'notes'}, $item->{'homebranch'},
+ $item->{'lost'}, $item->{'wthdrawn'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $item->{multivolumepart},
+ $item->{multivolume}, $item->{stack},
+ $item->{wthdrawn}, $item->{holdingbranch},
+ $cutterextra, $item->{onloan},
+ $item->{binding}
+ );
+ if ( $item->{homebranch} ) {
+ $query .= ",homebranch=?";
+ push @bind, $item->{homebranch};
+ }
+ if ( $item->{holdingbranch} ) {
+ $query .= ",holdingbranch=?";
+ push @bind, $item->{holdingbranch};
+ }
+ }
+ $query .= " where itemnumber=?";
+ push @bind, $item->{'itemnum'};
+ if ( $item->{'replacement'} ne '' ) {
+ $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
+ }
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@bind);
+ $sth->finish;
+}
+
+=head2 _koha_delete_item
+
+_koha_delete_item( $dbh, $itemnum );
+
+Internal function to delete an item record from the koha tables
+
+=cut
+
+sub _koha_delete_item {
+ my ( $dbh, $itemnum ) = @_;
+
+ my $sth = $dbh->prepare("select * from items where itemnumber=?");
+ $sth->execute($itemnum);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ my $query = "Insert into deleteditems set ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push( @bind, $data->{$temp} );
+ }
+ $query =~ s/\,$//;
- if ($count>0){
- my ( $xmlrecord, @itemsrecord) = XML_separate($result[0]);
- return ($xmlrecord, @itemsrecord);
- }else{
- return (undef,undef);
- }
+ # print $query;
+ $sth = $dbh->prepare($query);
+ $sth->execute(@bind);
+ $sth->finish;
+ $sth = $dbh->prepare("Delete from items where itemnumber=?");
+ $sth->execute($itemnum);
+ $sth->finish;
}
-sub ZEBRAop {
-### Puts the zebra update in queue writes in zebraserver table
-my ($dbh,$biblionumber,$op,$server)=@_;
-if (!$biblionumber){
-warn "Zebra received no biblionumber";
-}elsif (C4::Context->preference('onlineZEBRA')){
-my $marcxml;
- if ($server eq "biblioserver"){
- ($marcxml) =ZEBRA_readyXML($dbh,$biblionumber);
- }elsif($server eq "authorityserver"){
- $marcxml =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
- }
-ZEBRAopserver($marcxml,$op,$server,$biblionumber);
-ZEBRAopcommit($server);
-}else{
-my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
-$sth->execute($biblionumber,$server,$op);
-$sth->finish;
+=head2 _koha_delete_biblio
+
+$error = _koha_delete_biblio($dbh,$biblionumber);
+
+Internal sub for deleting from biblio table -- also saves to deletedbiblio
+
+C<$dbh> - the database handle
+C<$biblionumber> - the biblionumber of the biblio to be deleted
+
+=cut
+
+# FIXME: add error handling
+
+sub _koha_delete_biblio {
+ my ( $dbh, $biblionumber ) = @_;
+
+ # get all the data for this biblio
+ my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
+ $sth->execute($biblionumber);
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # save the record in deletedbiblio
+ # find the fields to save
+ my $query = "INSERT INTO deletedbiblio SET ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push( @bind, $data->{$temp} );
+ }
+ # replace the last , by ",?)"
+ $query =~ s/\,$//;
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the biblio
+ my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
+ $del_sth->execute($biblionumber);
+ $del_sth->finish;
+ }
+ $sth->finish;
+ return undef;
}
+
+=head2 _koha_delete_biblioitems
+
+$error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
+
+Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
+
+C<$dbh> - the database handle
+C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
+
+=cut
+
+# FIXME: add error handling
+
+sub _koha_delete_biblioitems {
+ my ( $dbh, $biblioitemnumber ) = @_;
+
+ # get all the data for this biblioitem
+ my $sth =
+ $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
+ $sth->execute($biblioitemnumber);
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # save the record in deletedbiblioitems
+ # find the fields to save
+ my $query = "INSERT INTO deletedbiblioitems SET ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push( @bind, $data->{$temp} );
+ }
+
+ # replace the last , by ",?)"
+ $query =~ s/\,$//;
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the biblioitem
+ my $del_sth =
+ $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
+ $del_sth->execute($biblioitemnumber);
+ $del_sth->finish;
+ }
+ $sth->finish;
+ return undef;
}
-sub ZEBRAopserver{
-
-###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs
-my ($record,$op,$server,$biblionumber)=@_;
-
-my @port;
-
-my $tried=0;
-my $recon=0;
-my $reconnect=0;
-$record=Encode::encode("UTF-8",$record);
-my $shadow=$server."shadow";
-reconnect:
-
- my $Zconnbiblio=C4::Context->Zconnauth($server);
-if ($record){
-my $Zpackage = $Zconnbiblio->package();
-$Zpackage->option(action => $op);
- $Zpackage->option(record => $record);
- $Zpackage->option(recordIdOpaque => $biblionumber);
-retry:
- $Zpackage->send("update");
-
- my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x();
- if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
- sleep 1; ## wait a sec!
- $tried=$tried+1;
- goto "retry";
- }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
- sleep 2; ## wait two seconds!
- $tried=$tried+1;
- goto "retry";
- }elsif($error==10004 && $recon==0){##Lost connection -reconnect
- sleep 1; ## wait a sec!
- $recon=1;
- $Zpackage->destroy();
- $Zconnbiblio->destroy();
- goto "reconnect";
- }elsif ($error){
- # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
- $Zpackage->destroy();
- $Zconnbiblio->destroy();
- return 0;
- }
-
-$Zpackage->destroy();
-$Zconnbiblio->destroy();
-return 1;
-}
-return 0;
-}
-
-
-sub ZEBRAopcommit {
-my $server=shift;
-return unless C4::Context->config($server."shadow");
-my $Zconnbiblio=C4::Context->Zconnauth($server);
-
-my $Zpackage = $Zconnbiblio->package();
- $Zpackage->send('commit');
-
- my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x();
- if ($error) { ## This is serious ZEBRA server is not updating
- $Zpackage->destroy();
- $Zconnbiblio->destroy();
- return 0;
- }
-$Zpackage->destroy();
-$Zconnbiblio->destroy();
-return 1;
-}
-sub ZEBRA_readyXML{
-my ($dbh,$biblionumber)=@_;
-my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
-my @itemxml=XMLgetallitems($dbh,$biblionumber);
-my $zebraxml=collection_header();
-$zebraxml.="<koharecord>";
-$zebraxml.=$biblioxml;
-$zebraxml.="<holdings>";
- foreach my $item(@itemxml){
- $zebraxml.=$item if $item;
- }
-$zebraxml.="</holdings>";
-$zebraxml.="</koharecord>";
-$zebraxml.="</kohacollection>";
-return $zebraxml;
-}
-
-sub ZEBRA_readyXML_noheader{
-my ($dbh,$biblionumber)=@_;
-my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
-my @itemxml=XMLgetallitems($dbh,$biblionumber);
-my $zebraxml="<koharecord>";
-$zebraxml.=$biblioxml;
-$zebraxml.="<holdings>";
- foreach my $item(@itemxml){
- $zebraxml.=$item if $item;
- }
-$zebraxml.="</holdings>";
-$zebraxml.="</koharecord>";
-return $zebraxml;
-}
-
-#
-#
-# various utility subs and those not complying to new rules
-#
-#
-
-sub newbiblio {
-## Used in acqui management -- creates the biblio from koha hash
- my ($biblio) = @_;
- my $dbh = C4::Context->dbh;
-my $record=XMLkoha2marc($dbh,$biblio,"biblios");
- my $biblionumber=NEWnewbiblio($dbh,$record);
- return ($biblionumber);
+=head2 _koha_delete_items
+
+$error = _koha_delete_items($dbh,$itemnumber);
+
+Internal sub for deleting from items table -- also saves to deleteditems
+
+C<$dbh> - the database handle
+C<$itemnumber> - the itemnumber of the item to be deleted
+
+=cut
+
+# FIXME: add error handling
+
+sub _koha_delete_items {
+ my ( $dbh, $itemnumber ) = @_;
+
+ # get all the data for this item
+ my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
+ $sth->execute($itemnumber);
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # save the record in deleteditems
+ # find the fields to save
+ my $query = "INSERT INTO deleteditems SET ";
+ my @bind = ();
+ foreach my $temp ( keys %$data ) {
+ $query .= "$temp = ?,";
+ push( @bind, $data->{$temp} );
+ }
+
+ # replace the last , by ",?)"
+ $query =~ s/\,$//;
+ my $bkup_sth = $dbh->prepare($query);
+ $bkup_sth->execute(@bind);
+ $bkup_sth->finish;
+
+ # delete the item
+ my $del_sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
+ $del_sth->execute($itemnumber);
+ $del_sth->finish;
+ }
+ $sth->finish;
+ return undef;
}
+
+
+
+=head2 modbiblio
+
+ $biblionumber = &modbiblio($biblio);
+
+Update a biblio record.
+
+C<$biblio> is a reference-to-hash whose keys are the fields in the
+biblio table in the Koha database. All fields must be present, not
+just the ones you wish to change.
+
+C<&modbiblio> updates the record defined by
+C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
+
+C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
+successful or not.
+
+=cut
+
sub modbiblio {
-## Used in acqui management -- modifies the biblio from koha hash rather than xml-hash
my ($biblio) = @_;
- my $dbh = C4::Context->dbh;
-my $record=XMLkoha2marc($dbh,$biblio,"biblios");
- my $biblionumber=NEWmodbiblio($dbh,$record,$biblio->{biblionumber});
+ my $dbh = C4::Context->dbh;
+ my $biblionumber = _koha_modify_biblio( $dbh, $biblio );
+ my $record = MARCkoha2marcBiblio( $biblionumber, $biblionumber );
+ MARCmodbiblio( $dbh, $biblionumber, $record, "", 0 );
return ($biblionumber);
-}
+} # sub modbiblio
+
+=head2 modbibitem
+
+&modbibitem($biblioitem)
+
+=cut
+
+sub modbibitem {
+ my ($biblioitem) = @_;
+ my $dbh = C4::Context->dbh;
+ &_koha_modify_biblio( $dbh, $biblioitem );
+} # sub modbibitem
+
+
+=head2 newitems
+
+$errors = &newitems( $item, @barcodes );
+
+=cut
sub newitems {
-## Used in acqui management -- creates the item from hash rather than marc-record
my ( $item, @barcodes ) = @_;
my $dbh = C4::Context->dbh;
my $errors;
my $itemnumber;
my $error;
foreach my $barcode (@barcodes) {
- $item->{barcode}=$barcode;
-my $record=MARCkoha2marc($dbh,$item,"holdings");
- my $itemnumber= NEWnewitem($dbh,$record,$item->{biblionumber});
-
+ ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, uc($barcode) );
+ $errors .= $error;
+ my $MARCitem =
+ &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
+ &MARCadditem( $MARCitem, $item->{biblionumber} );
}
- return $itemnumber ;
+ return ($errors);
}
+=head2 moditem
+$errors = &moditem( $item, $op );
+=cut
-sub getitemtypes {
- my $dbh = C4::Context->dbh;
- my $query = "select * from itemtypes order by description";
- my $sth = $dbh->prepare($query);
+sub moditem {
+ my ( $item, $op ) = @_;
+ my $dbh = C4::Context->dbh;
+ &_koha_modify_item( $dbh, $item, $op );
+
+ # if we're just setting statuses, just update items table
+ # it's faster and zebra and marc will be synched anyway by the cron job
+ unless ( $op eq "setstatus" ) {
+ my $MARCitem = &MARCkoha2marcItem( $dbh, $item->{'biblionumber'},
+ $item->{'itemnum'} );
+ &MARCmoditem( $MARCitem, $item->{biblionumber}, $item->{itemnum},
+ MARCfind_frameworkcode( $item->{biblionumber} ), 0 );
+ }
+}
- # || die "Cannot prepare $query" . $dbh->errstr;
- my $count = 0;
- my @results;
- $sth->execute;
- # || die "Cannot execute $query\n" . $sth->errstr;
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$count] = $data;
- $count++;
- } # while
+=head2 checkitems
+
+$errors = &checkitems( $count, @barcodes );
+=cut
+
+sub checkitems {
+ my ( $count, @barcodes ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $error;
+ my $sth = $dbh->prepare("Select * from items where barcode=?");
+ for ( my $i = 0 ; $i < $count ; $i++ ) {
+ $barcodes[$i] = uc $barcodes[$i];
+ $sth->execute( $barcodes[$i] );
+ if ( my $data = $sth->fetchrow_hashref ) {
+ $error .= " Duplicate Barcode: $barcodes[$i]";
+ }
+ }
$sth->finish;
- return ( $count, @results );
-} # sub getitemtypes
-
-
-
-sub getkohafields{
-#returns MySQL like fieldnames to emulate searches on sql like fieldnames
-my $type=shift;
-## Either opac or intranet to select appropriate fields
-## Assumes intranet
-$type="intra" unless $type;
-if ($type eq "intranet"){ $type="intra";}
-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 label");
-$sth->execute();
-while (my $data=$sth->fetchrow_hashref){
- $results[$i]=$data;
- $i++;
- }
+ return ($error);
+}
+
+=head1 OTHER FUNCTIONS
+
+=head2 char_decode
+
+my $string = char_decode( $string, $encoding );
+
+converts ISO 5426 coded string to UTF-8
+sloppy code : should be improved in next issue
+
+=cut
+
+sub char_decode {
+ my ( $string, $encoding ) = @_;
+ $_ = $string;
+
+ $encoding = C4::Context->preference("marcflavour") unless $encoding;
+ if ( $encoding eq "UNIMARC" ) {
+
+ # s/\xe1/Æ/gm;
+ s/\xe2/Ğ/gm;
+ s/\xe9/Ø/gm;
+ s/\xec/ş/gm;
+ s/\xf1/æ/gm;
+ s/\xf3/ğ/gm;
+ s/\xf9/ø/gm;
+ s/\xfb/ß/gm;
+ s/\xc1\x61/à/gm;
+ s/\xc1\x65/è/gm;
+ s/\xc1\x69/ì/gm;
+ s/\xc1\x6f/ò/gm;
+ s/\xc1\x75/ù/gm;
+ s/\xc1\x41/À/gm;
+ s/\xc1\x45/È/gm;
+ s/\xc1\x49/Ì/gm;
+ s/\xc1\x4f/Ò/gm;
+ s/\xc1\x55/Ù/gm;
+ s/\xc2\x41/Á/gm;
+ s/\xc2\x45/É/gm;
+ s/\xc2\x49/Í/gm;
+ s/\xc2\x4f/Ó/gm;
+ s/\xc2\x55/Ú/gm;
+ s/\xc2\x59/İ/gm;
+ s/\xc2\x61/á/gm;
+ s/\xc2\x65/é/gm;
+ s/\xc2\x69/í/gm;
+ s/\xc2\x6f/ó/gm;
+ s/\xc2\x75/ú/gm;
+ s/\xc2\x79/ı/gm;
+ s/\xc3\x41/Â/gm;
+ s/\xc3\x45/Ê/gm;
+ s/\xc3\x49/Î/gm;
+ s/\xc3\x4f/Ô/gm;
+ s/\xc3\x55/Û/gm;
+ s/\xc3\x61/â/gm;
+ s/\xc3\x65/ê/gm;
+ s/\xc3\x69/î/gm;
+ s/\xc3\x6f/ô/gm;
+ s/\xc3\x75/û/gm;
+ s/\xc4\x41/Ã/gm;
+ s/\xc4\x4e/Ñ/gm;
+ s/\xc4\x4f/Õ/gm;
+ s/\xc4\x61/ã/gm;
+ s/\xc4\x6e/ñ/gm;
+ s/\xc4\x6f/õ/gm;
+ s/\xc8\x41/Ä/gm;
+ s/\xc8\x45/Ë/gm;
+ s/\xc8\x49/Ï/gm;
+ s/\xc8\x61/ä/gm;
+ s/\xc8\x65/ë/gm;
+ s/\xc8\x69/ï/gm;
+ s/\xc8\x6F/ö/gm;
+ s/\xc8\x75/ü/gm;
+ s/\xc8\x76/ÿ/gm;
+ s/\xc9\x41/Ä/gm;
+ s/\xc9\x45/Ë/gm;
+ s/\xc9\x49/Ï/gm;
+ s/\xc9\x4f/Ö/gm;
+ s/\xc9\x55/Ü/gm;
+ s/\xc9\x61/ä/gm;
+ s/\xc9\x6f/ö/gm;
+ s/\xc9\x75/ü/gm;
+ s/\xca\x41/Å/gm;
+ s/\xca\x61/å/gm;
+ s/\xd0\x43/Ç/gm;
+ s/\xd0\x63/ç/gm;
+
+ # this handles non-sorting blocks (if implementation requires this)
+ $string = nsb_clean($_);
+ }
+ elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
+ ##MARC-8 to UTF-8
+
+ s/\xe1\x61/à/gm;
+ s/\xe1\x65/è/gm;
+ s/\xe1\x69/ì/gm;
+ s/\xe1\x6f/ò/gm;
+ s/\xe1\x75/ù/gm;
+ s/\xe1\x41/À/gm;
+ s/\xe1\x45/È/gm;
+ s/\xe1\x49/Ì/gm;
+ s/\xe1\x4f/Ò/gm;
+ s/\xe1\x55/Ù/gm;
+ s/\xe2\x41/Á/gm;
+ s/\xe2\x45/É/gm;
+ s/\xe2\x49/Í/gm;
+ s/\xe2\x4f/Ó/gm;
+ s/\xe2\x55/Ú/gm;
+ s/\xe2\x59/İ/gm;
+ s/\xe2\x61/á/gm;
+ s/\xe2\x65/é/gm;
+ s/\xe2\x69/í/gm;
+ s/\xe2\x6f/ó/gm;
+ s/\xe2\x75/ú/gm;
+ s/\xe2\x79/ı/gm;
+ s/\xe3\x41/Â/gm;
+ s/\xe3\x45/Ê/gm;
+ s/\xe3\x49/Î/gm;
+ s/\xe3\x4f/Ô/gm;
+ s/\xe3\x55/Û/gm;
+ s/\xe3\x61/â/gm;
+ s/\xe3\x65/ê/gm;
+ s/\xe3\x69/î/gm;
+ s/\xe3\x6f/ô/gm;
+ s/\xe3\x75/û/gm;
+ s/\xe4\x41/Ã/gm;
+ s/\xe4\x4e/Ñ/gm;
+ s/\xe4\x4f/Õ/gm;
+ s/\xe4\x61/ã/gm;
+ s/\xe4\x6e/ñ/gm;
+ s/\xe4\x6f/õ/gm;
+ s/\xe6\x41/Ă/gm;
+ s/\xe6\x45/Ĕ/gm;
+ s/\xe6\x65/ĕ/gm;
+ s/\xe6\x61/ă/gm;
+ s/\xe8\x45/Ë/gm;
+ s/\xe8\x49/Ï/gm;
+ s/\xe8\x65/ë/gm;
+ s/\xe8\x69/ï/gm;
+ s/\xe8\x76/ÿ/gm;
+ s/\xe9\x41/A/gm;
+ s/\xe9\x4f/O/gm;
+ s/\xe9\x55/U/gm;
+ s/\xe9\x61/a/gm;
+ s/\xe9\x6f/o/gm;
+ s/\xe9\x75/u/gm;
+ s/\xea\x41/A/gm;
+ s/\xea\x61/a/gm;
+
+ #Additional Turkish characters
+ s/\x1b//gm;
+ s/\x1e//gm;
+ s/(\xf0)s/\xc5\x9f/gm;
+ s/(\xf0)S/\xc5\x9e/gm;
+ s/(\xf0)c/ç/gm;
+ s/(\xf0)C/Ç/gm;
+ s/\xe7\x49/\\xc4\xb0/gm;
+ s/(\xe6)G/\xc4\x9e/gm;
+ s/(\xe6)g/ğ\xc4\x9f/gm;
+ s/\xB8/ı/gm;
+ s/\xB9/£/gm;
+ s/(\xe8|\xc8)o/ö/gm;
+ s/(\xe8|\xc8)O/Ö/gm;
+ s/(\xe8|\xc8)u/ü/gm;
+ s/(\xe8|\xc8)U/Ü/gm;
+ s/\xc2\xb8/\xc4\xb1/gm;
+ s/¸/\xc4\xb1/gm;
+
+ # this handles non-sorting blocks (if implementation requires this)
+ $string = nsb_clean($_);
+ }
+ return ($string);
+}
+
+=head2 PrepareItemrecordDisplay
+
+PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
+
+Returns a hash with all the fields for Display a given item data in a template
+
+=cut
+
+sub PrepareItemrecordDisplay {
+
+ my ( $bibnum, $itemnum ) = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $frameworkcode = &MARCfind_frameworkcode( $bibnum );
+ my ( $itemtagfield, $itemtagsubfield ) =
+ &MARCfind_marc_from_kohafield( $dbh, "items.itemnumber", $frameworkcode );
+ my $tagslib = &MARCgettagslib( $dbh, 1, $frameworkcode );
+ my $itemrecord = MARCgetitem( $bibnum, $itemnum) if ($itemnum);
+ my @loop_data;
+ my $authorised_values_sth =
+ $dbh->prepare(
+"select authorised_value,lib from authorised_values where category=? order by lib"
+ );
+ foreach my $tag ( sort keys %{$tagslib} ) {
+ my $previous_tag = '';
+ if ( $tag ne '' ) {
+ # loop through each subfield
+ my $cntsubf;
+ foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
+ next if ( subfield_is_koha_internal_p($subfield) );
+ next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
+ my %subfield_data;
+ $subfield_data{tag} = $tag;
+ $subfield_data{subfield} = $subfield;
+ $subfield_data{countsubfield} = $cntsubf++;
+ $subfield_data{kohafield} =
+ $tagslib->{$tag}->{$subfield}->{'kohafield'};
+
+ # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
+ $subfield_data{marc_lib} =
+ "<span id=\"error\" title=\""
+ . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
+ . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
+ . "</span>";
+ $subfield_data{mandatory} =
+ $tagslib->{$tag}->{$subfield}->{mandatory};
+ $subfield_data{repeatable} =
+ $tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{hidden} = "display:none"
+ if $tagslib->{$tag}->{$subfield}->{hidden};
+ my ( $x, $value );
+ ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
+ if ($itemrecord);
+ $value =~ s/"/"/g;
+
+ # search for itemcallnumber if applicable
+ if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
+ 'items.itemcallnumber'
+ && C4::Context->preference('itemcallnumber') )
+ {
+ my $CNtag =
+ substr( C4::Context->preference('itemcallnumber'), 0, 3 );
+ my $CNsubfield =
+ substr( C4::Context->preference('itemcallnumber'), 3, 1 );
+ my $temp = $itemrecord->field($CNtag) if ($itemrecord);
+ if ($temp) {
+ $value = $temp->subfield($CNsubfield);
+ }
+ }
+ if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
+ my @authorised_values;
+ my %authorised_lib;
+
+ # builds list, depending on authorised value...
+ #---- branch
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
+ "branches" )
+ {
+ if ( ( C4::Context->preference("IndependantBranches") )
+ && ( C4::Context->userenv->{flags} != 1 ) )
+ {
+ my $sth =
+ $dbh->prepare(
+"select branchcode,branchname from branches where branchcode = ? order by branchname"
+ );
+ $sth->execute( C4::Context->userenv->{branch} );
+ push @authorised_values, ""
+ unless (
+ $tagslib->{$tag}->{$subfield}->{mandatory} );
+ while ( my ( $branchcode, $branchname ) =
+ $sth->fetchrow_array )
+ {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode} = $branchname;
+ }
+ }
+ else {
+ my $sth =
+ $dbh->prepare(
+"select branchcode,branchname from branches order by branchname"
+ );
+ $sth->execute;
+ push @authorised_values, ""
+ unless (
+ $tagslib->{$tag}->{$subfield}->{mandatory} );
+ while ( my ( $branchcode, $branchname ) =
+ $sth->fetchrow_array )
+ {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode} = $branchname;
+ }
+ }
+
+ #----- itemtypes
+ }
+ elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
+ "itemtypes" )
+ {
+ my $sth =
+ $dbh->prepare(
+"select itemtype,description from itemtypes order by description"
+ );
+ $sth->execute;
+ push @authorised_values, ""
+ unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
+ while ( my ( $itemtype, $description ) =
+ $sth->fetchrow_array )
+ {
+ push @authorised_values, $itemtype;
+ $authorised_lib{$itemtype} = $description;
+ }
+
+ #---- "true" authorised value
+ }
+ else {
+ $authorised_values_sth->execute(
+ $tagslib->{$tag}->{$subfield}->{authorised_value} );
+ push @authorised_values, ""
+ unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
+ while ( my ( $value, $lib ) =
+ $authorised_values_sth->fetchrow_array )
+ {
+ push @authorised_values, $value;
+ $authorised_lib{$value} = $lib;
+ }
+ }
+ $subfield_data{marc_value} = CGI::scrolling_list(
+ -name => 'field_value',
+ -values => \@authorised_values,
+ -default => "$value",
+ -labels => \%authorised_lib,
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ }
+ elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
+ $subfield_data{marc_value} =
+"<input type=\"text\" name=\"field_value\" size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
+
+#"
+# COMMENTED OUT because No $i is provided with this API.
+# And thus, no value_builder can be activated.
+# BUT could be thought over.
+# } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
+# my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
+# require $plugin;
+# my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
+# my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
+# $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\" size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
+ }
+ else {
+ $subfield_data{marc_value} =
+"<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
+ }
+ push( @loop_data, \%subfield_data );
+ }
+ }
+ }
+ my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
+ if ( $itemrecord && $itemrecord->field($itemtagfield) );
+ return {
+ 'itemtagfield' => $itemtagfield,
+ 'itemtagsubfield' => $itemtagsubfield,
+ 'itemnumber' => $itemnumber,
+ 'iteminformation' => \@loop_data
+ };
+}
+
+=head2 nsb_clean
+
+my $string = nsb_clean( $string, $encoding );
+
+=cut
+
+sub nsb_clean {
+ my $NSB = '\x88'; # NSB : begin Non Sorting Block
+ my $NSE = '\x89'; # NSE : Non Sorting Block end
+ # handles non sorting blocks
+ my ($string) = @_;
+ $_ = $string;
+ s/$NSB/(/gm;
+ s/[ ]{0,1}$NSE/) /gm;
+ $string = $_;
+ return ($string);
+}
+
+=head2 zebraopfiles
+
+&zebraopfiles( $dbh, $biblionumber, $record, $folder, $server );
+
+=cut
+
+sub zebraopfiles {
+
+ my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
+
+ my $op;
+ my $zebradir =
+ C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
+ unless ( opendir( DIR, "$zebradir" ) ) {
+ warn "$zebradir not found";
+ return;
+ }
+ closedir DIR;
+ my $filename = $zebradir . $biblionumber;
+
+ if ($record) {
+ open( OUTPUT, ">", $filename . ".xml" );
+ print OUTPUT $record;
+ close OUTPUT;
+ }
+}
+
+=head2 zebraop
+
+zebraop( $dbh, $biblionumber, $op, $server );
+
+=cut
+
+sub zebraop {
+###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
+ my ( $dbh, $biblionumber, $op, $server ) = @_;
+
+ #warn "SERVER:".$server;
+#
+# true zebraop commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
+# at the same time
+# replaced by a zebraqueue table, that is filled with zebraop to run.
+# the table is emptied by misc/cronjobs/zebraqueue_start.pl script
+
+my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
+$sth->execute($biblionumber,$server,$op);
$sth->finish;
-return ($i,@results);
-}
-
-
-
-
-
-sub DisplayISBN {
-## Old style ISBN handling should be modified to accept 13 digits
-
- my ($isbn)=@_;
- my $seg1;
- if(substr($isbn, 0, 1) <=7) {
- $seg1 = substr($isbn, 0, 1);
- } elsif(substr($isbn, 0, 2) <= 94) {
- $seg1 = substr($isbn, 0, 2);
- } elsif(substr($isbn, 0, 3) <= 995) {
- $seg1 = substr($isbn, 0, 3);
- } elsif(substr($isbn, 0, 4) <= 9989) {
- $seg1 = substr($isbn, 0, 4);
- } else {
- $seg1 = substr($isbn, 0, 5);
- }
- my $x = substr($isbn, length($seg1));
- my $seg2;
- if(substr($x, 0, 2) <= 19) {
-# if(sTmp2 < 10) sTmp2 = "0" sTmp2;
- $seg2 = substr($x, 0, 2);
- } elsif(substr($x, 0, 3) <= 699) {
- $seg2 = substr($x, 0, 3);
- } elsif(substr($x, 0, 4) <= 8399) {
- $seg2 = substr($x, 0, 4);
- } elsif(substr($x, 0, 5) <= 89999) {
- $seg2 = substr($x, 0, 5);
- } elsif(substr($x, 0, 6) <= 9499999) {
- $seg2 = substr($x, 0, 6);
- } else {
- $seg2 = substr($x, 0, 7);
- }
- my $seg3=substr($x,length($seg2));
- $seg3=substr($seg3,0,length($seg3)-1) ;
- my $seg4 = substr($x, -1, 1);
- return "$seg1-$seg2-$seg3-$seg4";
-}
-sub calculatelc{
-## Function to create padded LC call number for sorting items with their LC code. Not exported
-my ($classification)=@_;
-$classification=~s/^\s+|\s+$//g;
-my $i=0;
-my $lc2;
-my $lc1;
-for ($i=0; $i<length($classification);$i++){
-my $c=(substr($classification,$i,1));
- if ($c ge '0' && $c le '9'){
-
- $lc2=substr($classification,$i);
- last;
- }else{
- $lc1.=substr($classification,$i,1);
-
- }
-}#while
-
-my $other=length($lc1);
-if(!$lc1){$other=0;}
-my $extras;
-if ($other<4){
- for (1..(4-$other)){
- $extras.="0";
- }
-}
- $lc1.=$extras;
-$lc2=~ s/^ //g;
-
-$lc2=~ s/ //g;
-$extras="";
-##Find the decimal part of $lc2
-my $pos=index($lc2,".");
-if ($pos<0){$pos=length($lc2);}
-if ($pos>=0 && $pos<5){
-##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
-
- for (1..(5-$pos)){
- $extras.="0";
- }
-}
-$lc2=$extras.$lc2;
-return($lc1.$lc2);
-}
-
-sub itemcalculator{
-## Sublimentary function to obtain sorted LC for items. Not exported
-my ($dbh,$biblionumber,$callnumber)=@_;
-my $xmlhash=XMLgetbibliohash($dbh,$biblionumber);
-my $lc=XML_readline_onerecord($xmlhash,"classification","biblios");
-my $cutter=XML_readline_onerecord($xmlhash,"subclass","biblios");
-my $all=$lc." ".$cutter;
-my $total=length($all);
-my $cutterextra=substr($callnumber,$total);
-return $cutterextra;
-
-}
-
-
-#### This function allows decoding of only title and author out of a MARC record
- sub func_title_author {
- my ($tagno,$tagdata) = @_;
- my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios");
- my ($authf,$subf)=&MARCfind_marc_from_kohafield("author","biblios");
- return ($tagno == $titlef || $tagno == $authf);
+
+#
+# my @Zconnbiblio;
+# my $tried = 0;
+# my $recon = 0;
+# my $reconnect = 0;
+# my $record;
+# my $shadow;
+#
+# reconnect:
+# $Zconnbiblio[0] = C4::Context->Zconn( $server, 0, 1 );
+#
+# if ( $server eq "biblioserver" ) {
+#
+# # it's unclear to me whether this should be in xml or MARC format
+# # but it is clear it should be nabbed from zebra rather than from
+# # the koha tables
+# $record = GetMarcBiblio($biblionumber);
+# $record = $record->as_xml_record() if $record;
+# # warn "RECORD $biblionumber => ".$record;
+# $shadow="biblioservershadow";
+#
+# # warn "RECORD $biblionumber => ".$record;
+# $shadow = "biblioservershadow";
+#
+# }
+# elsif ( $server eq "authorityserver" ) {
+# $record = C4::AuthoritiesMarc::XMLgetauthority( $dbh, $biblionumber );
+# $shadow = "authorityservershadow";
+# } ## Add other servers as necessary
+#
+# my $Zpackage = $Zconnbiblio[0]->package();
+# $Zpackage->option( action => $op );
+# $Zpackage->option( record => $record );
+#
+# retry:
+# $Zpackage->send("update");
+# my $i;
+# my $event;
+#
+# while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
+# $event = $Zconnbiblio[0]->last_event();
+# last if $event == ZOOM::Event::ZEND;
+# }
+#
+# my ( $error, $errmsg, $addinfo, $diagset ) = $Zconnbiblio[0]->error_x();
+# if ( $error == 10000 && $reconnect == 0 )
+# { ## This is serious ZEBRA server is not available -reconnect
+# warn "problem with zebra server connection";
+# $reconnect = 1;
+# my $res = system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
+#
+# #warn "Trying to restart ZEBRA Server";
+# #goto "reconnect";
+# }
+# elsif ( $error == 10007 && $tried < 2 )
+# { ## timeout --another 30 looonng seconds for this update
+# $tried = $tried + 1;
+# warn "warn: timeout, trying again";
+# goto "retry";
+# }
+# elsif ( $error == 10004 && $recon == 0 ) { ##Lost connection -reconnect
+# $recon = 1;
+# warn "error: reconnecting to zebra";
+# goto "reconnect";
+#
+# # as a last resort, we save the data to the filesystem to be indexed in batch
+# }
+# elsif ($error) {
+# warn
+# "Error-$server $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
+# $Zpackage->destroy();
+# $Zconnbiblio[0]->destroy();
+# zebraopfiles( $dbh, $biblionumber, $record, $op, $server );
+# return;
+# }
+# if ( C4::Context->$shadow ) {
+# $Zpackage->send('commit');
+# while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
+#
+# #waiting zebra to finish;
+# }
+# }
+# $Zpackage->destroy();
+}
+
+=head2 calculatelc
+
+$lc = calculatelc($classification);
+
+=cut
+
+sub calculatelc {
+ my ($classification) = @_;
+ $classification =~ s/^\s+|\s+$//g;
+ my $i = 0;
+ my $lc2;
+ my $lc1;
+
+ for ( $i = 0 ; $i < length($classification) ; $i++ ) {
+ my $c = ( substr( $classification, $i, 1 ) );
+ if ( $c ge '0' && $c le '9' ) {
+
+ $lc2 = substr( $classification, $i );
+ last;
+ }
+ else {
+ $lc1 .= substr( $classification, $i, 1 );
+
+ }
+ } #while
+
+ my $other = length($lc1);
+ if ( !$lc1 ) {
+ $other = 0;
+ }
+
+ my $extras;
+ if ( $other < 4 ) {
+ for ( 1 .. ( 4 - $other ) ) {
+ $extras .= "0";
+ }
}
+ $lc1 .= $extras;
+ $lc2 =~ s/^ //g;
+
+ $lc2 =~ s/ //g;
+ $extras = "";
+ ##Find the decimal part of $lc2
+ my $pos = index( $lc2, "." );
+ if ( $pos < 0 ) { $pos = length($lc2); }
+ if ( $pos >= 0 && $pos < 5 ) {
+ ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
+
+ for ( 1 .. ( 5 - $pos ) ) {
+ $extras .= "0";
+ }
+ }
+ $lc2 = $extras . $lc2;
+ return ( $lc1 . $lc2 );
+}
+
+=head2 itemcalculator
+$cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
+=cut
+
+sub itemcalculator {
+ my ( $dbh, $biblioitem, $callnumber ) = @_;
+ my $sth =
+ $dbh->prepare(
+"select classification, subclass from biblioitems where biblioitemnumber=?"
+ );
+
+ $sth->execute($biblioitem);
+ my ( $classification, $subclass ) = $sth->fetchrow;
+ my $all = $classification . " " . $subclass;
+ my $total = length($all);
+ my $cutterextra = substr( $callnumber, $total - 1 );
+
+ return $cutterextra;
+}
END { } # module clean-up code here (global destructor)
-=back
+1;
+
+__END__
=head1 AUTHOR
Koha Developement team <info@koha.org>
+Paul POULAIN paul.poulain@free.fr
+Joshua Ferraro jmf@liblime.com
+
+=cut
+
+# $Id$
+# $Log$
+# Revision 1.188 2007/03/09 14:31:47 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.178.2.59 2007/02/28 10:01:13 toins
+# reporting bug fix from 2.2.7.1 to rel_3_0
+# LOG was :
+# BUGFIX/improvement : limiting MARCsubject to 610 as 676 is dewey, and is somewhere else
+#
+# Revision 1.178.2.58 2007/02/05 16:50:01 toins
+# fix a mod_perl bug:
+# There was a global var modified into an internal function in {MARC|ISBD}detail.pl.
+# Moving this function in Biblio.pm
+#
+# Revision 1.178.2.57 2007/01/25 09:37:58 tipaul
+# removing warn
+#
+# Revision 1.178.2.56 2007/01/24 13:50:26 tipaul
+# Acquisition fix
+# removing newbiblio & newbiblioitems subs.
+# adding Koha2Marc
+#
+# IMHO, all biblio handling is better handled if they are done in a single place, the subs with MARC::Record as parameters.
+# newbiblio & newbiblioitems where koha 1.x subs, that are called when MARC=OFF (which is not working anymore in koha 3.0, unless someone reintroduce it), and in acquisition module.
+# The Koha2Marc sub moves a hash (with biblio/biblioitems subfield as keys) into a MARC::Record, that can be used to call NewBiblio, the standard biblio manager sub.
+#
+# Revision 1.178.2.55 2007/01/17 18:07:17 alaurin
+# bugfixing for zebraqueue_start and biblio.pm :
+#
+# - Zebraqueue_start : restoring function of deletion in zebraqueue DB list
+#
+# -biblio.pm : changing method of default_record_format, now we have :
+# MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
+#
+# with this line the encoding in zebra seems to be ok (in unimarc and marc21)
+#
+# Revision 1.178.2.54 2007/01/16 15:00:03 tipaul
+# donc try to delete the biblio in koha, just fill zebraqueue table !
+#
+# Revision 1.178.2.53 2007/01/16 10:24:11 tipaul
+# BUGFIXING :
+# when modifying or deleting an item, the biblio frameworkcode was emptied.
+#
+# Revision 1.178.2.52 2007/01/15 17:20:55 toins
+# *** empty log message ***
+#
+# Revision 1.178.2.51 2007/01/15 15:16:44 hdl
+# Uncommenting zebraop.
+#
+# Revision 1.178.2.50 2007/01/15 14:59:09 hdl
+# Adding creation of an unexpected serial any time.
+# +
+# USING Date::Calc and not Date::Manip.
+# WARNING : There are still some Bugs in next issue date management. (Date::Calc donot wrap easily next year calculation.)
+#
+# Revision 1.178.2.49 2007/01/12 10:12:30 toins
+# writing $record->as_formatted in the log when Modifying an item.
+#
+# Revision 1.178.2.48 2007/01/11 16:33:04 toins
+# write $record->as_formatted into the log.
+#
+# Revision 1.178.2.47 2007/01/10 16:46:27 toins
+# Theses modules need to use C4::Log.
+#
+# Revision 1.178.2.46 2007/01/10 16:31:15 toins
+# new systems preferences :
+# - CataloguingLog (log the update/creation/deletion of a notice if set to 1)
+# - BorrowersLog ( idem for borrowers )
+# - IssueLog (log all issue if set to 1)
+# - ReturnLog (log all return if set to 1)
+# - SusbcriptionLog (log all creation/deletion/update of a subcription)
+#
+# All of theses are in a new tab called 'LOGFeatures' in systempreferences.pl
+#
+# Revision 1.178.2.45 2007/01/09 10:31:09 toins
+# sync with dev_week. ( new function : GetMarcSeries )
+#
+# Revision 1.178.2.44 2007/01/04 17:41:32 tipaul
+# 2 major bugfixes :
+# - deletion of an item deleted the whole biblio because of a wrong API
+# - create an item was bugguy for default framework
+#
+# Revision 1.178.2.43 2006/12/22 15:09:53 toins
+# removing C4::Database;
+#
+# Revision 1.178.2.42 2006/12/20 16:51:00 tipaul
+# ZEBRA update :
+# - adding a new table : when a biblio is added/modified/ deleted, an entry is entered in this table
+# - the zebraqueue_start.pl script read it & does the stuff.
+#
+# code coming from head (tumer). it can be run every minut instead of once every day for dev_week code.
+#
+# I just have commented the previous code (=real time update) in Biblio.pm, we will be able to reactivate it once indexdata fixes zebra update bug !
+#
+# Revision 1.178.2.41 2006/12/20 08:54:44 toins
+# GetXmlBiblio wasn't exported.
+#
+# Revision 1.178.2.40 2006/12/19 16:45:56 alaurin
+# bugfixing, for zebra and authorities
+#
+# Revision 1.178.2.39 2006/12/08 17:55:44 toins
+# GetMarcAuthors now get authors for all subfields
+#
+# Revision 1.178.2.38 2006/12/07 15:42:14 toins
+# synching opac & intranet.
+# fix some broken link & bugs.
+# removing warn compilation.
+#
+# Revision 1.178.2.37 2006/12/07 11:09:39 tipaul
+# MAJOR FIX :
+# the ->destroy() line destroys the zebra connection. When we are running koha as cgi, it's not a problem, as the script dies after each request.
+# BUT for bulkmarcimport & mod_perl, the zebra conn must be persistant.
+#
+# Revision 1.178.2.36 2006/12/06 16:54:21 alaurin
+# restore function zebraop for delete biblios :
+#
+# 1) restore C4::Circulation::Circ2::itemissues, (was missing)
+# 2) restore zebraop value : delete_record
+#
+# Revision 1.178.2.35 2006/12/06 10:02:12 alaurin
+# bugfixing for delete a biblio :
+#
+# restore itemissue fonction .... :
+#
+# other is pointed, zebra error 224... for biblio is not deleted in zebra ..
+# ....
+#
+# Revision 1.178.2.34 2006/12/06 09:14:25 toins
+# Correct the link to the MARC subjects.
+#
+# Revision 1.178.2.33 2006/12/05 11:35:29 toins
+# Biblio.pm cleaned.
+# additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
+# Some functions renamed according to the coding guidelines.
+#
+# Revision 1.178.2.32 2006/12/04 17:39:57 alaurin
+# bugfix :
+#
+# restore zebraop for update zebra
+#
+# Revision 1.178.2.31 2006/12/01 17:00:19 tipaul
+# additem needs $frameworkcode
+#
+# Revision 1.178.2.30 2006/11/30 18:23:51 toins
+# theses scripts don't need to use C4::Search.
+#
+# Revision 1.178.2.29 2006/11/30 17:17:01 toins
+# following functions moved from Search.p to Biblio.pm :
+# - bibdata
+# - itemsissues
+# - addauthor
+# - getMARCNotes
+# - getMARCsubjects
+#
+# Revision 1.178.2.28 2006/11/28 15:15:03 toins
+# sync with dev_week.
+# (deleteditems table wasn't getting populaated because the execute was commented out. This puts it back
+# -- some table changes are needed as well, I'll commit those separately.)
+#
+# Revision 1.178.2.27 2006/11/20 16:52:05 alaurin
+# minor bugfixing :
+#
+# correcting in _koha_modify_biblioitem : restore the biblionumber line .
+#
+# now the sql update of biblioitems is ok ....
+#
+# Revision 1.178.2.26 2006/11/17 14:57:21 tipaul
+# code cleaning : moving bornum, borrnum, bornumber to a correct "borrowernumber"
+#
+# Revision 1.178.2.25 2006/11/17 13:18:58 tipaul
+# code cleaning : removing use of "bib", and replacing with "biblionumber"
+#
+# WARNING : I tried to do carefully, but there are probably some mistakes.
+# So if you encounter a problem you didn't have before, look for this change !!!
+# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
+#
+# Revision 1.178.2.24 2006/11/17 11:18:47 tipaul
+# * removing useless subs
+# * moving bibid to biblionumber where needed
+#
+# Revision 1.178.2.23 2006/11/17 09:39:04 btoumi
+# bug fix double declaration of variable in same function
+#
+# Revision 1.178.2.22 2006/11/15 15:15:50 hdl
+# Final First Version for New Facility for subscription management.
+#
+# Now
+# use serials-collection.pl for history display
+# and serials-edit.pl for serial edition
+# subscription add and detail adds a new branch information to help IndependantBranches Library to manage different subscriptions for a serial
+#
+# This is aimed at replacing serials-receive and statecollection.
+#
+# Revision 1.178.2.21 2006/11/15 14:49:38 tipaul
+# in some cases, there are invalid utf8 chars in XML (at least in SANOP). this commit remove them on the fly.
+# Not sure it's a good idea to keep them in biblio.pm, let me know your opinion on koha-devel if you think it's a bad idea...
+#
+# Revision 1.178.2.20 2006/10/31 17:20:49 toins
+# * moving bibitemdata from search to here.
+# * using _koha_modify_biblio instead of OLDmodbiblio.
+#
+# Revision 1.178.2.19 2006/10/20 15:26:41 toins
+# sync with dev_week.
+#
+# Revision 1.178.2.18 2006/10/19 11:57:04 btoumi
+# bug fix : wrong syntax in sub call
+#
+# Revision 1.178.2.17 2006/10/17 09:54:42 toins
+# ccode (re)-integration.
+#
+# Revision 1.178.2.16 2006/10/16 16:20:34 toins
+# MARCgetbiblio cleaned up.
+#
+# Revision 1.178.2.15 2006/10/11 14:26:56 tipaul
+# handling of UNIMARC :
+# - better management of field 100 = automatic creation of the field if needed & filling encoding to unicode.
+# - better management of encoding (MARC::File::XML new_from_xml()). This fix works only on my own version of M:F:XML, i think the actual one is buggy & have reported the problem to perl4lib mailing list
+# - fixing a bug on MARCgetitem, that uses biblioitems.marc and not biblioitems.marcxml
+#
+# Revision 1.178.2.14 2006/10/11 07:59:36 tipaul
+# removing hardcoded ccode fiels in biblioitems
+#
+# Revision 1.178.2.13 2006/10/10 14:21:24 toins
+# Biblio.pm now returns a true value.
+#
+# Revision 1.178.2.12 2006/10/09 16:44:23 toins
+# Sync with dev_week.
+#
+# Revision 1.178.2.11 2006/10/06 13:23:49 toins
+# Synch with dev_week.
+#
+# Revision 1.178.2.10 2006/10/02 09:32:02 hdl
+# Adding GetItemStatus and GetItemLocation function in order to make serials-receive.pl work.
+#
+# *************WARNING.***************
+# tested for UNIMARC and using 'marcflavour' system preferences to set defaut_record_format.
+#
+# Revision 1.178.2.9 2006/09/26 07:54:20 hdl
+# Bug FIX: Correct accents for UNIMARC biblio MARC details.
+# (Adding the use of default_record_format in MARCgetbiblio if UNIMARC marcflavour is chosen. This should be widely used as soon as we use xml records)
+#
+# Revision 1.178.2.8 2006/09/25 14:46:22 hdl
+# Now using iso2709 MARC data for MARC.
+# (Works better for accents than XML)
+#
+# Revision 1.178.2.7 2006/09/20 13:44:14 hdl
+# Bug Fixing : Cataloguing was broken for UNIMARC.
+# Please test.
require Exporter;
use C4::Context;
use C4::Circulation::Circ2;
-use C4::AcademicInfo;
-use C4::Search;
-use C4::Date;
-use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=cut
-@ISA = qw(Exporter);
-@EXPORT = qw(&GetShelfList &GetShelfContents &AddToShelf &AddToShelfFromBiblio
- &RemoveFromShelf &AddShelf &RemoveShelf
- &ShelfPossibleAction
+@ISA = qw(Exporter);
+@EXPORT = qw(
+ &GetShelves &GetShelfContents &GetShelf
- &GetShelfListExt &AddShelfExt &EditShelfExt &RemoveShelfExt
- &GetShelfInfo &GetShelfContentsExt &RemoveFromShelfExt
- &GetShelfListOfExt &AddToShelfExt
-
- &AddRequestToShelf &CountShelfRequest &GetShelfRequests
- &RejectShelfRequest &CatalogueShelfRequest &GetShelfRequestOwner
- &GetShelfRequest);
+ &AddToShelf &AddToShelfFromBiblio &AddShelf
-
-my $dbh;
- $dbh = C4::Context->dbh;
+ &ModShelf
+ &ShelfPossibleAction
+ &DelFromShelf &DelShelf
+);
-=item ShelfPossibleAction
-
-=over 4
+my $dbh = C4::Context->dbh;
-=item C<$loggedinuser,$shelfnumber,$action>
-
-$action can be "view" or "manage".
+=item GetShelves
-Returns 1 if the user can do the $action in the $shelfnumber shelf.
-Returns 0 otherwise.
-
-=back
-
-=cut
-sub ShelfPossibleAction {
- my ($loggedinuser,$shelfnumber,$action)= @_;
- my $sth = $dbh->prepare("select owner,category from bookshelf where shelfnumber=?");
- $sth->execute($shelfnumber);
- my ($owner,$category) = $sth->fetchrow;
- return 1 if (($category>=3 or $owner eq $loggedinuser) && $action eq 'manage');
- return 1 if (($category>= 2 or $owner eq $loggedinuser) && $action eq 'view');
- return 0;
-}
-
-=item GetShelfList
-
- $shelflist = &GetShelfList();
+ $shelflist = &GetShelves($owner, $mincategory);
($shelfnumber, $shelfhash) = each %{$shelflist};
Looks up the virtual bookshelves, and returns a summary. C<$shelflist>
(C<$shelfnumber>, above), and the values (C<$shelfhash>, above) are
themselves references-to-hash, with the following keys:
+C<mincategory> : 2 if the list is for "look". 3 if the list is for "Select bookshelf for adding a book".
+bookshelves of the owner are always selected, whatever the category
+
=over 4
=item C<$shelfhash-E<gt>{shelfname}>
=back
=cut
+
#'
# FIXME - Wouldn't it be more intuitive to return a list, rather than
# a reference-to-hash? The shelf number can be just another key in the
# hash.
-sub GetShelfList {
- my ($owner,$mincategory) = @_;
- # mincategory : 2 if the list is for "look". 3 if the list is for "Select bookshelf for adding a book".
- # bookshelves of the owner are always selected, whatever the category
- my $sth=$dbh->prepare("SELECT bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category,
- count(shelfcontents.itemnumber) as count
- FROM bookshelf
- LEFT JOIN shelfcontents
- ON bookshelf.shelfnumber = shelfcontents.shelfnumber
- left join borrowers on bookshelf.owner = borrowers.borrowernumber
-
- where owner=? or category>=?
- GROUP BY bookshelf.shelfnumber order by shelfname");
- $sth->execute($owner,$mincategory);
+
+sub GetShelves {
+ my ( $owner, $mincategory ) = @_;
+
+ my $query = qq(
+ SELECT bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname,bookshelf.category,
+ count(shelfcontents.itemnumber) as count
+ FROM bookshelf
+ LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber
+ LEFT JOIN borrowers ON bookshelf.owner = borrowers.borrowernumber
+ WHERE owner=? OR category>=?
+ GROUP BY bookshelf.shelfnumber
+ ORDER BY bookshelf.category, bookshelf.shelfname, borrowers.firstname, borrowers.surname
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $owner, $mincategory );
my %shelflist;
- while (my ($shelfnumber, $shelfname,$owner,$surname,$firstname,$category,$count) = $sth->fetchrow) {
- $shelflist{$shelfnumber}->{'shelfname'}=$shelfname;
- $shelflist{$shelfnumber}->{'count'}=$count;
- $shelflist{$shelfnumber}->{'owner'}=$owner;
- $shelflist{$shelfnumber}->{'surname'} = $surname;
- $shelflist{$shelfnumber}->{'firstname'} = $firstname;
- $shelflist{$shelfnumber}->{'category'} = $category;
-
-
+ while (
+ my (
+ $shelfnumber, $shelfname, $owner, $surname,
+ $firstname, $category, $count
+ )
+ = $sth->fetchrow
+ )
+ {
+ $shelflist{$shelfnumber}->{'shelfname'} = $shelfname;
+ $shelflist{$shelfnumber}->{'count'} = $count;
+ $shelflist{$shelfnumber}->{'category'} = $category;
+ $shelflist{$shelfnumber}->{'owner'} = $owner;
+ $shelflist{$shelfnumber}->{'surname'} = $surname;
+ $shelflist{$shelfnumber}->{'firstname'} = $firstname;
}
+ return ( \%shelflist );
+}
+
+=item GetShef
+
+ (shelfnumber,shelfname,owner,category) = &GetShelf($shelfnumber);
+
+Looks up information about the contents of virtual bookshelf number
+C<$shelfnumber>
+
+Returns the database's information on 'bookshelf' table.
+
+=cut
- return(\%shelflist);
+sub GetShelf {
+ my ($shelfnumber) = @_;
+ my $query = qq(
+ SELECT shelfnumber,shelfname,owner,category
+ FROM bookshelf
+ WHERE shelfnumber=?
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute($shelfnumber);
+ return $sth->fetchrow;
}
=item GetShelfContents
- $itemlist = &GetShelfContents($env, $shelfnumber);
+ $itemlist = &GetShelfContents($shelfnumber);
Looks up information about the contents of virtual bookshelf number
C<$shelfnumber>.
Returns a reference-to-array, whose elements are references-to-hash,
-as returned by C<&getiteminformation>.
-
-I don't know what C<$env> is.
+as returned by C<C4::Circ2::getiteminformation>.
=cut
+
#'
sub GetShelfContents {
- my ($env, $shelfnumber) = @_;
+ my ( $shelfnumber ) = @_;
my @itemlist;
- my $sth=$dbh->prepare("select itemnumber from shelfcontents where shelfnumber=? order by itemnumber");
+ my $query =
+ " SELECT itemnumber
+ FROM shelfcontents
+ WHERE shelfnumber=?
+ ORDER BY itemnumber
+ ";
+ my $sth = $dbh->prepare($query);
$sth->execute($shelfnumber);
- while (my ($itemnumber) = $sth->fetchrow) {
- my ($item) = getiteminformation($env, $itemnumber, 0);
- push (@itemlist, $item);
+ my $sth2 = $dbh->prepare("
+ SELECT biblio.*,biblioitems.* FROM items
+ LEFT JOIN biblio on items.biblionumber=biblio.biblionumber
+ LEFT JOIN biblioitems on items.biblionumber=biblioitems.biblionumber
+ WHERE items.itemnumber=?"
+ );
+ while ( my ($itemnumber) = $sth->fetchrow ) {
+ $sth2->execute($itemnumber);
+ my $item = $sth2->fetchrow_hashref;
+ $item->{'itemnumber'}=$itemnumber;
+ push( @itemlist, $item );
}
- return (\@itemlist);
+ return ( \@itemlist );
}
-=item AddToShelf
+=item AddShelf
- &AddToShelf($env, $itemnumber, $shelfnumber);
+ $shelfnumber = &AddShelf( $shelfname, $owner, $category);
-Adds item number C<$itemnumber> to virtual bookshelf number
-C<$shelfnumber>, unless that item is already on that shelf.
+Creates a new virtual bookshelf with name C<$shelfname>, owner C<$owner> and category
+C<$category>.
-C<$env> is ignored.
+Returns a code to know what's happen.
+ * -1 : if this bookshelf already exist.
+ * $shelfnumber : if success.
=cut
-#'
-sub AddToShelf {
- my ($env, $itemnumber, $shelfnumber) = @_;
- return unless $itemnumber;
- my $sth=$dbh->prepare("select * from shelfcontents where shelfnumber=? and itemnumber=?");
-
- $sth->execute($shelfnumber, $itemnumber);
- if ($sth->rows) {
-# already on shelf
- } else {
- $sth=$dbh->prepare("insert into shelfcontents (shelfnumber, itemnumber, flags) values (?, ?, 0)");
- $sth->execute($shelfnumber, $itemnumber);
- }
-}
-sub AddToShelfFromBiblio {
- my ($env, $biblionumber, $shelfnumber) = @_;
- return unless $biblionumber;
- my $sth = $dbh->prepare("select itemnumber from items where biblionumber=?");
- $sth->execute($biblionumber);
- my ($itemnumber) = $sth->fetchrow;
- $sth=$dbh->prepare("select * from shelfcontents where shelfnumber=? and itemnumber=?");
- $sth->execute($shelfnumber, $itemnumber);
- if ($sth->rows) {
-# already on shelf
- } else {
- $sth=$dbh->prepare("insert into shelfcontents (shelfnumber, itemnumber, flags,biblionumber) values (?, ?, 0,?)");
- $sth->execute($shelfnumber, $itemnumber,$biblionumber);
- }
-}
-=item RemoveFromShelf
+sub AddShelf {
+ my ( $shelfname, $owner, $category ) = @_;
+ my $query = qq(
+ SELECT *
+ FROM bookshelf
+ WHERE shelfname=? AND owner=?
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute($shelfname,$owner);
+ if ( $sth->rows ) {
+ return (-1);
+ }
+ else {
+ my $query = qq(
+ INSERT INTO bookshelf
+ (shelfname,owner,category)
+ VALUES (?,?,?)
+ );
+ $sth = $dbh->prepare($query);
+ $sth->execute( $shelfname, $owner, $category );
+ my $shelfnumber = $dbh->{'mysql_insertid'};
+ return ($shelfnumber);
+ }
+}
- &RemoveFromShelf($env, $itemnumber, $shelfnumber);
+=item AddToShelf
-Removes item number C<$itemnumber> from virtual bookshelf number
-C<$shelfnumber>. If the item wasn't on that bookshelf to begin with,
-nothing happens.
+ &AddToShelf($itemnumber, $shelfnumber);
-C<$env> is ignored.
+Adds item number C<$itemnumber> to virtual bookshelf number
+C<$shelfnumber>, unless that item is already on that shelf.
=cut
+
#'
-sub RemoveFromShelf {
- my ($env, $itemnumber, $shelfnumber) = @_;
- my $sth=$dbh->prepare("delete from shelfcontents where shelfnumber=? and itemnumber=?");
- $sth->execute($shelfnumber,$itemnumber);
+sub AddToShelf {
+ my ( $itemnumber, $shelfnumber ) = @_;
+ return unless $itemnumber;
+ my $query = qq(
+ SELECT *
+ FROM shelfcontents
+ WHERE shelfnumber=? AND itemnumber=?
+ );
+ my $sth = $dbh->prepare($query);
+
+ $sth->execute( $shelfnumber, $itemnumber );
+ unless ( $sth->rows ) {
+ # already on shelf
+ my $query = qq(
+ INSERT INTO shelfcontents
+ (shelfnumber, itemnumber, flags)
+ VALUES
+ (?, ?, 0)
+ );
+ $sth = $dbh->prepare($query);
+ $sth->execute( $shelfnumber, $itemnumber );
+ }
}
-=item AddShelf
+=item AddToShelfFromBiblio
+
+ &AddToShelfFromBiblio($biblionumber, $shelfnumber)
- ($status, $msg) = &AddShelf($env, $shelfname);
+ this function allow to add a book into the shelf number $shelfnumber
+ from biblionumber.
-Creates a new virtual bookshelf with name C<$shelfname>.
+=cut
-Returns a two-element array, where C<$status> is 0 if the operation
-was successful, or non-zero otherwise. C<$msg> is "Done" in case of
-success, or an error message giving the reason for failure.
+sub AddToShelfFromBiblio {
+ my ( $biblionumber, $shelfnumber ) = @_;
+ return unless $biblionumber;
+ my $query = qq(
+ SELECT itemnumber
+ FROM items
+ WHERE biblionumber=?
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ my ($itemnumber) = $sth->fetchrow;
+ $query = qq(
+ SELECT *
+ FROM shelfcontents
+ WHERE shelfnumber=? AND itemnumber=?
+ );
+ $sth = $dbh->prepare($query);
+ $sth->execute( $shelfnumber, $itemnumber );
+ unless ( $sth->rows ) {
+ # "already on shelf";
+ my $query =qq(
+ INSERT INTO shelfcontents
+ (shelfnumber, itemnumber, flags)
+ VALUES
+ (?, ?, 0)
+ );
+ $sth = $dbh->prepare($query);
+ $sth->execute( $shelfnumber, $itemnumber );
+ }
+}
+
+=item ModShelf
-C<$env> is ignored.
+ModShelf($shelfnumber, $shelfname, $owner, $category )
+
+Modify the value into bookshelf table with values given on input arg.
=cut
-#'
-# FIXME - Perhaps this could/should return the number of the new bookshelf
-# as well?
-sub AddShelf {
- my ($env, $shelfname,$owner,$category) = @_;
- my $sth=$dbh->prepare("select * from bookshelf where shelfname=?");
- $sth->execute($shelfname);
- if ($sth->rows) {
- return(1, "Shelf \"$shelfname\" already exists");
- } else {
- $sth=$dbh->prepare("insert into bookshelf (shelfname,owner,category) values (?,?,?)");
- $sth->execute($shelfname,$owner,$category);
- return (0, "Done");
- }
+
+sub ModShelf {
+ my ( $shelfnumber, $shelfname, $owner, $category ) = @_;
+ my $query = qq(
+ UPDATE bookshelf
+ SET shelfname=?,owner=?,category=?
+ WHERE shelfnumber=?
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $shelfname, $owner, $category, $shelfnumber );
}
-=item RemoveShelf
+=item DelShelf
- ($status, $msg) = &RemoveShelf($env, $shelfnumber);
+ ($status) = &DelShelf($shelfnumber);
Deletes virtual bookshelf number C<$shelfnumber>. The bookshelf must
be empty.
was successful, or non-zero otherwise. C<$msg> is "Done" in case of
success, or an error message giving the reason for failure.
-C<$env> is ignored.
-
=cut
-#'
-sub RemoveShelf {
- my ($env, $shelfnumber) = @_;
- my $sth=$dbh->prepare("select count(*) from shelfcontents where shelfnumber=?");
- $sth->execute($shelfnumber);
- my ($count)=$sth->fetchrow;
- if ($count) {
- return (1, "Shelf has $count items on it. Please remove all items before deleting this shelf.");
- } else {
- $sth=$dbh->prepare("delete from bookshelf where shelfnumber=?");
- $sth->execute($shelfnumber);
- return (0, "Done");
- }
-}
-sub GetShelfListOfExt {
- my ($owner) = @_;
- my $sth;
- if ($owner) {
- $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE (owner = ?) or category>=2 ORDER BY shelfname");
- $sth->execute($owner);
- } else {
- $sth = $dbh->prepare("SELECT * FROM bookshelf where category<2 ORDER BY shelfname");
- $sth->execute();
- }
-
- my $sth2 = $dbh->prepare("SELECT count(biblionumber) as bibliocount FROM shelfcontents WHERE (shelfnumber = ?)");
-
- my @results;
- while (my $row = $sth->fetchrow_hashref) {
- $sth2->execute($row->{'shelfnumber'});
- $row->{'bibliocount'} = $sth2->fetchrow;
- if ($row->{'category'} == 1) {
- $row->{'private'} = 1;
- } else {
- $row->{'public'} = 1;
- }
- push @results, $row;
- }
- return \@results;
-}
-sub GetShelfListExt {
- my ($owner,$mincategory,$id_intitution, $intra) = @_;
-
- my $sth1 = $dbh->prepare("SELECT * FROM careers WHERE id_institution = ?");
- $sth1->execute($id_intitution);
- my @results;
-
- my $total_shelves = 0;
- while (my $row1 = $sth1->fetchrow_hashref) {
-
- my @shelves;
- my $sth2;
- if ($intra) {
- $sth2=$dbh->prepare("SELECT
- bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category,
- count(shelfcontents.biblionumber) as count
- FROM
- bookshelf
- LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber
- LEFT JOIN borrowers ON bookshelf.owner = borrowers.borrowernumber
- LEFT JOIN bookshelves_careers ON bookshelves_careers.shelfnumber = bookshelf.shelfnumber
- WHERE
- (id_career = ?)
- GROUP BY bookshelf.shelfnumber
- ORDER BY shelfname");
- $sth2->execute($row1->{'id_career'});
-
- } else {
- $sth2=$dbh->prepare("SELECT
- bookshelf.shelfnumber, bookshelf.shelfname,owner,surname,firstname, category,
- count(shelfcontents.biblionumber) as count
- FROM
- bookshelf
- LEFT JOIN shelfcontents ON bookshelf.shelfnumber = shelfcontents.shelfnumber
- LEFT JOIN borrowers ON bookshelf.owner = borrowers.borrowernumber
- LEFT JOIN bookshelves_careers ON bookshelves_careers.shelfnumber = bookshelf.shelfnumber
- WHERE
- (owner = ? OR category >= ?) AND (id_career = ?)
- GROUP BY bookshelf.shelfnumber
- ORDER BY shelfname");
- $sth2->execute($owner,$mincategory,$row1->{'id_career'});
- }
-
- $row1->{'shelfcount'} = 0;
- while (my $row2 = $sth2->fetchrow_hashref) {
- if ($owner == $row2->{'owner'}) {
- $row2->{'canmanage'} = 1;
- }
- if ($row2->{'category'} == 1) {
- $row2->{'private'} = 1;
- } else {
- $row2->{'public'} = 1;
- }
- $row1->{'shelfcount'}++;
- $total_shelves++;
- push @shelves, $row2;
- }
- $row1->{'shelvesloop'} = \@shelves;
- push @results, $row1;
- }
-
- return($total_shelves, \@results);
-}
+=item ShelfPossibleAction
-sub AddShelfExt {
- my ($shelfname,$owner,$category,$careers) = @_;
- my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfname = ?");
- $sth->execute($shelfname);
- if ($sth->rows) {
- return 0;
- } else {
- $sth = $dbh->prepare("INSERT INTO bookshelf (shelfname,owner,category) VALUES (?,?,?)");
- $sth->execute($shelfname,$owner,$category);
- my $shelfnumber = $dbh->{'mysql_insertid'};
-
- foreach my $row (@{$careers}) {
- $sth = $dbh->prepare("INSERT INTO bookshelves_careers VALUES (?,?)");
- $sth->execute($shelfnumber, $row);
- }
- return $shelfnumber;
- }
-}
+ShelfPossibleAction($loggedinuser, $shelfnumber, $action);
-sub EditShelfExt {
- my ($shelfnumber,$shelfname,$category,$careers) = @_;
- my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfname = ? AND NOT shelfnumber = ? ");
- $sth->execute($shelfname, $shelfnumber);
- if ($sth->rows) {
- return 0;
- } else {
- $sth = $dbh->prepare("UPDATE bookshelf SET shelfname = ?, category = ? WHERE shelfnumber = ?");
- $sth->execute($shelfname,$category,$shelfnumber);
-
- $sth = $dbh->prepare("DELETE FROM bookshelves_careers WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
-
- foreach my $row (@{$careers}) {
- $sth = $dbh->prepare("INSERT INTO bookshelves_careers VALUES (?,?)");
- $sth->execute($shelfnumber, $row);
- }
- return $shelfnumber;
- }
-}
+C<$loggedinuser,$shelfnumber,$action>
+$action can be "view" or "manage".
-sub RemoveShelfExt {
- my ($shelfnumber) = @_;
- my $sth = $dbh->prepare("DELETE FROM bookshelves_careers WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
- my $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
- $sth = $dbh->prepare("DELETE FROM bookshelf WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
- return 1;
-}
+Returns 1 if the user can do the $action in the $shelfnumber shelf.
+Returns 0 otherwise.
-sub GetShelfInfo {
- my ($shelfnumber, $owner) = @_;
- my $sth = $dbh->prepare("SELECT * FROM bookshelf WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
- my $result = $sth->fetchrow_hashref;
-
- if ($result->{'owner'} == $owner) {
- $result->{'canmanage'} = 1;
- }
-
- my $sth = $dbh->prepare("SELECT id_career FROM bookshelves_careers WHERE shelfnumber = ?");
- $sth->execute($shelfnumber);
- my @careers;
- while (my $row = $sth->fetchrow) {
- push @careers, $row;
- }
- $result->{'careers'} = \@careers;
- return $result;
-}
+=cut
-sub GetShelfContentsExt {
- my ($shelfnumber) = @_;
- my $sth = $dbh->prepare("SELECT biblionumber FROM shelfcontents WHERE shelfnumber = ? ORDER BY biblionumber");
+sub ShelfPossibleAction {
+ my ( $user, $shelfnumber, $action ) = @_;
+ my $query = qq(
+ SELECT owner,category
+ FROM bookshelf
+ WHERE shelfnumber=?
+ );
+ my $sth = $dbh->prepare($query);
$sth->execute($shelfnumber);
- my @biblios;
- my $even = 0;
- while (my ($biblionumber) = $sth->fetchrow) {
- my $biblio=ZEBRA_readyXML_noheader($dbh,$biblionumber);
- my $xmlrecord=XML_xml2hash($biblio);
- push @biblios,$xmlrecord;
- }
-my ($facets,@results)=parsefields($dbh,"opac",@biblios);
-
- return (\@results);
+ my ( $owner, $category ) = $sth->fetchrow;
+ return 1 if (($category >= 3 or $owner eq $user) && $action eq 'manage' );
+ return 1 if (($category >= 2 or $owner eq $user) && $action eq 'view' );
+ return 0;
}
-sub RemoveFromShelfExt {
- my ($biblionumber, $shelfnumber) = @_;
- my $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?");
- $sth->execute($shelfnumber,$biblionumber);
-}
+=item DelFromShelf
-sub AddToShelfExt {
- my ($biblionumber, $shelfnumber) = @_;
- my $sth = $dbh->prepare("SELECT * FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?");
- $sth->execute($shelfnumber, $biblionumber);
- if ($sth->rows) {
- return 0
- } else {
- $sth = $dbh->prepare("INSERT INTO shelfcontents (shelfnumber, biblionumber) VALUES (?, ?)");
- $sth->execute($shelfnumber, $biblionumber);
- }
-}
+ &DelFromShelf( $itemnumber, $shelfnumber);
-sub AddRequestToShelf {
- my ($shelfnumber, $requestType, $requestName, $comments) = @_;
- my $sth = $dbh->prepare("INSERT INTO shelf_requests (shelfnumber, request_name, request_type, status, request_date, comments) VALUES (?,?,?,?, CURRENT_DATE(),?)");
- $sth->execute($shelfnumber, $requestName, $requestType, "PENDING", $comments);
- return $dbh->{'mysql_insertid'};
-}
+Removes item number C<$itemnumber> from virtual bookshelf number
+C<$shelfnumber>. If the item wasn't on that bookshelf to begin with,
+nothing happens.
-sub CountShelfRequest {
- my ($shelfnumber, $status) = @_;
- my $sth;
- if ($shelfnumber) {
- $sth = $dbh->prepare("SELECT count(idRequest) FROM shelf_requests WHERE shelfnumber = ? AND status = ?");
- $sth->execute($shelfnumber, $status);
- } else {
- $sth = $dbh->prepare("SELECT count(idRequest) FROM shelf_requests WHERE status = ?");
- $sth->execute($status);
- }
- my ($count) = $sth->fetchrow_array;
- return $count;
-}
+=cut
-sub GetShelfRequests {
- my ($shelfnumber, $status, $type) = @_;
- my @params;
- my $query = "SELECT * FROM shelf_requests SR INNER JOIN bookshelf BS ON SR.shelfnumber = BS.shelfnumber WHERE status = ?";
- push @params, $status;
- if ($shelfnumber) {
- $query.= " AND shelfnumber = ?";
- push @params, $shelfnumber;
- }
- if ($type) {
- $query.= " AND request_type = ?";
- push @params, $type;
- }
- $query.= " ORDER BY SR.shelfnumber, SR.request_date";
- my $sth = $dbh->prepare($query);
- $sth->execute(@params);
- my @results;
-
- my $color = 0;
- while (my $row = $sth->fetchrow_hashref) {
- my $borrdata = borrdata('',$row->{'owner'});
- $row->{'surname'} = $borrdata->{'surname'};
- $row->{'firstname'} = $borrdata->{'firstname'};
- $row->{'cardnumber'} = $borrdata->{'cardnumber'};
- $row->{'request_date'} = format_date($row->{'request_date'});
- $row->{$row->{'request_type'}} = 1;
- $row->{$row->{'status'}} = 1;
- $row->{'color'} = $color = not $color;
- push @results, $row;
- }
- return (\@results);
+#'
+sub DelFromShelf {
+ my ( $itemnumber, $shelfnumber ) = @_;
+ my $query = qq(
+ DELETE FROM shelfcontents
+ WHERE shelfnumber=? AND itemnumber=?
+ );
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $shelfnumber, $itemnumber );
}
-sub RejectShelfRequest {
- my ($idRequest) = @_;
- #get the type and name request
- my $sth = $dbh->prepare("SELECT request_type, request_name FROM shelf_requests WHERE idRequest = ?");
- $sth->execute($idRequest);
- my ($request_type, $request_name) = $sth->fetchrow_array;
- #if the request is a file, then unlink the file
- if ($request_type eq 'file') {
- unlink($ENV{'DOCUMENT_ROOT'}."/uploaded-files/shelf-files/$idRequest-$request_name");
- }
- #change tha request status to REJECTED
- $sth = $dbh->prepare("UPDATE shelf_requests SET status = ? WHERE idRequest = ?");
- $sth->execute("REJECTED", $idRequest);
- return 1;
-}
+=head2 DelShelf
-sub GetShelfRequestOwner {
- my ($idRequest) = @_;
- my $sth = $dbh->prepare("SELECT owner FROM shelf_requests R INNER JOIN bookshelf S ON R.shelfnumber = S.shelfnumber WHERE idRequest = ?");
- $sth->execute($idRequest);
- my ($owner) = $sth->fetchrow_array;
- my $bordata = &borrdata(undef, $owner);
- #print "Content-type: text/plain \n\n --- $owner ----- $bordata->{'emailaddress'}" ;
- return ($bordata);
-}
+ $Number = DelShelf($shelfnumber);
-sub GetShelfRequest {
- my ($idRequest) = @_;
- my $sth = $dbh->prepare("SELECT * FROM shelf_requests R INNER JOIN bookshelf S ON R.shelfnumber = S.shelfnumber WHERE idRequest = ?");
- $sth->execute($idRequest);
- my $request_data = $sth->fetchrow_hashref;
- return $request_data;
-}
+ this function delete the shelf number, and all of it's content
+
+=cut
-sub CatalogueShelfRequest {
- my ($idRequest, $shelfnumber, $biblionumber) = @_;
- #find the last request status
- my $sth = $dbh->prepare("SELECT status, biblionumber FROM shelf_requests WHERE idRequest = ?");
- $sth->execute($idRequest);
- my ($prev_status, $prev_biblionumber) = $sth->fetchrow_array;
- #if the status was not seted, inserts an entry in shelfcontents
- if ($prev_status ne "CATALOGUED") {
- $sth = $dbh->prepare("INSERT INTO shelfcontents (shelfnumber, biblionumber) VALUES (?,?)");
- $sth->execute($shelfnumber, $biblionumber);
- #if the request was previously catalogued, delete the entry in shelfcontens
- } elsif ($prev_status ne "REJECTED") {
- $sth = $dbh->prepare("DELETE FROM shelfcontents WHERE shelfnumber = ? AND biblionumber = ?");
- $sth->execute($shelfnumber, $prev_biblionumber);
- }
- #change the status to catalogued
- $sth = $dbh->prepare("UPDATE shelf_requests SET status = ?, biblionumber = ? WHERE idRequest = ?");
- $sth->execute("CATALOGUED", $biblionumber, $idRequest);
- return 1;
+#'
+sub DelShelf {
+ my ( $shelfnumber ) = @_;
+ my $sth = $dbh->prepare("DELETE FROM bookshelf WHERE shelfnumber=?");
+ $sth->execute($shelfnumber);
+ return 0;
}
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+=head1 SEE ALSO
+
+C4::Circulation::Circ2(3)
+
+=cut
+
#
# $Log$
-# Revision 1.19 2006/11/06 21:01:43 tgarip1957
-# Bug fixing and complete removal of Date::Manip
-#
-# Revision 1.18 2006/09/06 16:21:03 tgarip1957
-# Clean up before final commits
-#
-# Revision 1.13 2004/03/11 16:06:20 tipaul
-# *** empty log message ***
-#
-# Revision 1.11.2.2 2004/02/19 10:15:41 tipaul
-# new feature : adding book to bookshelf from biblio detail screen.
+# Revision 1.20 2007/03/09 14:31:47 tipaul
+# rel_3_0 moved to HEAD
#
-# Revision 1.11.2.1 2004/02/06 14:16:55 tipaul
-# fixing bugs in bookshelves management.
+# Revision 1.15.8.10 2007/01/25 13:18:15 tipaul
+# checking that a bookshelf with the same name AND OWNER does not exist before creating it
#
-# Revision 1.11 2003/12/15 10:57:08 slef
-# DBI call fix for bug 662
+# Revision 1.15.8.9 2006/12/15 17:37:52 toins
+# removing a function used only once.
#
-# Revision 1.10 2003/02/05 10:05:02 acli
-# Converted a few SQL statements to use ? to fix a few strange SQL errors
-# Noted correct tab size
+# Revision 1.15.8.8 2006/12/14 17:22:55 toins
+# bookshelves work perfectly with mod_perl and are cleaned.
#
-# Revision 1.9 2002/10/13 08:29:18 arensb
-# Deleted unused variables.
-# Removed trailing whitespace.
+# Revision 1.15.8.7 2006/12/13 19:46:41 hdl
+# Some bug fixing.
#
-# Revision 1.8 2002/10/10 04:32:44 arensb
-# Simplified references.
+# Revision 1.15.8.6 2006/12/11 17:10:06 toins
+# fixing some bugs on bookshelves.
#
-# Revision 1.7 2002/10/05 09:50:10 arensb
-# Merged with arensb-context branch: use C4::Context->dbh instead of
-# &C4Connect, and generally prefer C4::Context over C4::Database.
+# Revision 1.15.8.5 2006/12/07 16:45:43 toins
+# removing warn compilation. (perl -wc)
#
-# Revision 1.6.2.1 2002/10/04 02:24:43 arensb
-# Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
-# C4Connect.
+# Revision 1.15.8.4 2006/11/23 09:05:01 tipaul
+# enable removal of a bookshelf even if there are items inside
#
-# Revision 1.6 2002/09/23 13:50:30 arensb
-# Fixed missing bit in POD.
+# Revision 1.15.8.3 2006/10/30 09:50:20 tipaul
+# removing getiteminformations (using direct SQL, as we are in a .pm, so it's "legal")
#
-# Revision 1.5 2002/09/22 17:29:17 arensb
-# Added POD.
-# Added some FIXME comments.
-# Removed useless trailing whitespace.
+# Revision 1.15.8.2 2006/08/31 16:03:52 toins
+# Add Pod to DelShelf
#
-# Revision 1.4 2002/08/14 18:12:51 tonnesen
-# Added copyright statement to all .pl and .pm files
+# Revision 1.15.8.1 2006/08/30 15:59:14 toins
+# Code cleaned according to coding guide lines.
#
-# Revision 1.3 2002/07/02 17:48:06 tonnesen
-# Merged in updates from rel-1-2
+# Revision 1.15 2004/12/16 11:30:58 tipaul
+# adding bookshelf features :
+# * create bookshelf on the fly
+# * modify a bookshelf name & status
#
-# Revision 1.2.2.1 2002/06/26 20:46:48 tonnesen
-# Inserting some changes I made locally a while ago.
-#
-#
-
-__END__
-
-=back
-
-=head1 AUTHOR
-
-Koha Developement team <info@koha.org>
-
-=head1 SEE ALSO
-
-C4::Circulation::Circ2(3)
-
-=cut
+# Revision 1.14 2004/12/15 17:28:23 tipaul
+# adding bookshelf features :
+# * create bookshelf on the fly
+# * modify a bookshelf (this being not finished, will commit the rest soon)
=head1 FUNCTIONS
-=over 2
-
=cut
#-------------------------------------------------------------#
-=head3 GetBookFund
-
-=over 4
+=head2 GetBookFund
$dataaqbookfund = &GetBookFund($bookfundid);
C<$dataaqbookfund> is a hashref full of bookfundid, bookfundname, bookfundgroup,
and branchcode.
-=back
-
=cut
sub GetBookFund {
my $bookfundid = shift;
+ my $branchcode = shift;
+ $branchcode=($branchcode?$branchcode:'');
my $dbh = C4::Context->dbh;
my $query = "
SELECT
branchcode
FROM aqbookfund
WHERE bookfundid = ?
- ";
+ AND branchcode = ?";
my $sth=$dbh->prepare($query);
-$sth->execute($bookfundid);
- return $sth->fetchrow_hashref;
+ $sth->execute($bookfundid,$branchcode);
+ my $data=$sth->fetchrow_hashref;
+ return $data;
}
=head3 GetBookFundsId
-=over 4
-
$sth = &GetBookFundsId
Read on aqbookfund table and execute a simple SQL query.
C<@results> is an array of id existing on the database.
-=back
-
=cut
sub GetBookFundsId {
my @bookfundids_loop;
my $dbh= C4::Context->dbh;
my $query = "
- SELECT bookfundid
+ SELECT bookfundid,branchcode
FROM aqbookfund
";
my $sth = $dbh->prepare($query);
=head3 GetBookFunds
-=over 4
-
@results = &GetBookFunds;
Returns a list of all book funds.
C<@results> is an array of references-to-hash, whose keys are fields from the aqbookfund and aqbudget tables of the Koha database. Results are ordered
alphabetically by book fund name.
-=back
-
=cut
sub GetBookFunds {
my ($branch) = @_;
my $dbh = C4::Context->dbh;
my $userenv = C4::Context->userenv;
- my $branch = $userenv->{branch};
my $strsth;
- if ( $branch ) {
+ if ( $branch ne '' ) {
$strsth = "
SELECT *
FROM aqbookfund,aqbudget
WHERE aqbookfund.bookfundid=aqbudget.bookfundid
- AND startdate<=now()
+ AND startdate<now()
AND enddate>now()
- AND (aqbookfund.branchcode IS NULL OR aqbookfund.branchcode='' OR aqbookfund.branchcode= ? )
+ AND (aqbookfund.branchcode='' OR aqbookfund.branchcode= ? )
GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
}
else {
";
}
my $sth = $dbh->prepare($strsth);
- if ( $branch ) {
+ if ( $branch ne '' ) {
$sth->execute($branch);
}
else {
=head3 GetCurrencies
-=over 4
-
@currencies = &GetCurrencies;
Returns the list of all known currencies.
C<$currencies> is a array; its elements are references-to-hash, whose
keys are the fields from the currency table in the Koha database.
-=back
-
=cut
sub GetCurrencies {
=head3 GetBookFundBreakdown
-=over 4
-
( $spent, $comtd ) = &GetBookFundBreakdown( $id, $year, $start, $end );
returns the total comtd & spent for a given bookfund, and a given year
used in acqui-home.pl
-=back
-
=cut
sub GetBookFundBreakdown {
}
else {
- my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
- $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
+ my $leftover = $data->{'quantity'} - ($data->{'quantityreceived'}?$data->{'quantityreceived'}:0);
+ $spent += ( $data->{'unitprice'} ) * ($data->{'quantityreceived'}?$data->{'quantityreceived'}:0);
}
}
# then do a seperate query for commited totals, (pervious single query was
# returning incorrect comitted results.
- my $query = "
+ $query = "
SELECT quantity,datereceived,freight,unitprice,
listprice,ecost,quantityreceived AS qrev,
- subscription,biblio.title,itemtype,aqorders.biblionumber,
+ subscription,title,itemtype,aqorders.biblionumber,
aqorders.booksellerinvoicenumber,
quantity-quantityreceived AS tleft,
aqorders.ordernumber AS ordnum,entrydate,budgetdate,
FROM aqorderbreakdown,
aqbasket,
aqorders
- LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
+ LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=aqorders.biblioitemnumber
WHERE bookfundid=?
AND aqorders.ordernumber=aqorderbreakdown.ordernumber
AND aqorders.basketno=aqbasket.basketno
AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
";
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute( $id, $start, $end );
my $comtd;
=head3 NewBookFund
-=over 4
-
&NewBookFund(bookfundid, bookfundname, branchcode);
this function create a new bookfund into the database.
-=back
-
=cut
sub NewBookFund{
(?, ?, ?)
";
my $sth=$dbh->prepare($query);
- $sth->execute($bookfundid,$bookfundname,$branchcode);
+ $sth->execute($bookfundid,$bookfundname,"$branchcode");
}
#-------------------------------------------------------------#
=head3 ModBookFund
-=over 4
-
&ModBookFund($bookfundname,$branchcode,$bookfundid);
this function update the bookfundname and the branchcode on aqbookfund table
on database.
-=back
-
=cut
sub ModBookFund {
- my ($bookfundname,$branchcode,$bookfundid) = @_;
+ my ($bookfundname,$bookfundid,$branchcode) = @_;
my $dbh = C4::Context->dbh;
my $query = "
UPDATE aqbookfund
- SET bookfundname = ?,
- branchcode = ?
+ SET bookfundname = ?
WHERE bookfundid = ?
+ AND branchcode= ?
";
+ warn "name : $bookfundname";
my $sth=$dbh->prepare($query);
- $sth->execute($bookfundname,$branchcode,$bookfundid);
+ $sth->execute($bookfundname,$bookfundid,"$branchcode");
# budgets depending on a bookfund must have the same branchcode
# if the bookfund branchcode is set
if (defined $branchcode) {
=head3 SearchBookFund
-=over 4
@results = SearchBookFund(
$bookfundid,$filter,$filter_bookfundid,
$filter_bookfundname,$filter_branchcode);
this function searchs among the bookfunds corresponding to our filtering rules.
-=back
-
=cut
sub SearchBookFund {
bookfundgroup,
branchcode
FROM aqbookfund
- WHERE 1 = 1 ";
+ WHERE 1 ";
if ($filter) {
if ($filter_bookfundid) {
=head3 ModCurrencies
-=over 4
-
&ModCurrencies($currency, $newrate);
Sets the exchange rate for C<$currency> to be C<$newrate>.
-=back
-
=cut
sub ModCurrencies {
=head3 Countbookfund
-=over 4
-
$number = Countbookfund($bookfundid);
this function count the number of bookfund with id given on input arg.
return :
the result of the SQL query as a number.
-=back
-
=cut
sub Countbookfund {
my $bookfundid = shift;
+ my $branchcode = shift;
my $dbh = C4::Context->dbh;
my $query ="
SELECT COUNT(*)
- FROM aqbookfund
+ FROM aqbookfund
WHERE bookfundid = ?
+ AND branchcode = ?
";
my $sth = $dbh->prepare($query);
- $sth->execute($bookfundid);
+ $sth->execute($bookfundid,$branchcode);
return $sth->fetchrow;
}
=head3 ConvertCurrency
-=over 4
-
$foreignprice = &ConvertCurrency($currency, $localprice);
Converts the price C<$localprice> to foreign currency C<$currency> by
If no exchange rate is found, C<&ConvertCurrency> assumes the rate is one
to one.
-=back
-
=cut
sub ConvertCurrency {
my $sth = $dbh->prepare($query);
$sth->execute($currency);
my $cur = ( $sth->fetchrow_array() )[0];
- if ( $cur == 0 ) {
+ unless($cur) {
$cur = 1;
}
return ( $price / $cur );
=head3 DelBookFund
-=over 4
-
&DelBookFund($bookfundid);
this function delete a bookfund which has $bokfundid as parameter on aqbookfund table and delete the approriate budget.
-=back
-
=cut
sub DelBookFund {
my $bookfundid = shift;
+ my $branchcode=shift;
my $dbh = C4::Context->dbh;
my $query = "
DELETE FROM aqbookfund
WHERE bookfundid=?
+ AND branchcode=?
";
my $sth=$dbh->prepare($query);
- $sth->execute($bookfundid);
+ $sth->execute($bookfundid,$branchcode);
$sth->finish;
$query = "
- DELETE FROM aqbudget where bookfundid=?
+ DELETE FROM aqbudget where bookfundid=? and branchcode=?
";
$sth=$dbh->prepare($query);
- $sth->execute($bookfundid);
+ $sth->execute($bookfundid,$branchcode);
$sth->finish;
}
__END__
-=back
-
=head1 AUTHOR
Koha Developement team <info@koha.org>
=head1 FUNCTIONS
-=over 2
-
=cut
#-------------------------------------------------------------------#
-=head3 GetBookSeller
-
-=over 4
+=head2 GetBookSeller
@results = &GetBookSeller($searchstring);
C<@results> is an array of references-to-hash, whose keys are the fields of of the
aqbooksellers table in the Koha database.
-=back
-
=cut
sub GetBookSeller {
#-----------------------------------------------------------------#
-=head3 GetBooksellersWithLateOrders
-
-=over 4
+=head2 GetBooksellersWithLateOrders
%results = &GetBooksellersWithLateOrders;
Searches for suppliers with late orders.
-=back
-
=cut
sub GetBooksellersWithLateOrders {
- my $delay = shift;
+ my ($delay,$branch) = @_;
my $dbh = C4::Context->dbh;
# FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
#--------------------------------------------------------------------#
-=head3 AddBookseller
-
-=over 4
+=head2 AddBookseller
$id = &AddBookseller($bookseller);
Returns the ID of the newly-created bookseller.
-=back
-
=cut
sub AddBookseller {
);
# return the id of this new supplier
- my $query = "
+ $query = "
SELECT max(id)
FROM aqbooksellers
";
- my $sth = $dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute;
return scalar($sth->fetchrow);
}
#-----------------------------------------------------------------#
-=head3 ModSupplier
-
-=over 4
+=head2 ModSupplier
&ModSupplier($bookseller);
book seller with C<&booksellers>, modify what's necessary, then call
C<&ModSupplier> with the result.
-=back
-
=cut
sub ModBookseller {
$sth->finish;
}
-
END { } # module clean-up code here (global destructor)
1;
__END__
-=back
-
=head1 AUTHOR
Koha Developement team <info@koha.org>
use strict;
use C4::Biblio;
-use C4::Search;
+use C4::Koha;
use MARC::File::USMARC;
-use MARC::Record;
-use Encode;
require Exporter;
+
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
C4::Breeding : script to add a biblio in marc_breeding table.
=head1 SYNOPSIS
- &ImportBreeding($marcrecords,$overwrite_biblio,$filename,$z3950random);
- C<$marcrecord> => the MARC::Record
- C<$overwrite_biblio> => if set to 1 a biblio with the same ISBN will be overwritted.
- if set to 0 a biblio with the same isbn will be ignored (the previous will be kept)
- if set to -1 the biblio will be added anyway (more than 1 biblio with the same ISBN possible in the breeding
- C<$encoding> => USMARC
- or UNIMARC. used for char_decoding.
- If not present, the parameter marcflavour is used instead
- C<$z3950random> => the random value created during a z3950 search result.
+ use C4::Scan;
+ &ImportBreeding($marcrecords,$overwrite_biblio,$filename,$z3950random);
+
+ C<$marcrecord> => the MARC::Record
+ C<$overwrite_biblio> => if set to 1 a biblio with the same ISBN will be overwritted.
+ if set to 0 a biblio with the same isbn will be ignored (the previous will be kept)
+ if set to -1 the biblio will be added anyway (more than 1 biblio with the same ISBN possible in the breeding
+ C<$encoding> => USMARC
+ or UNIMARC. used for char_decoding.
+ If not present, the parameter marcflavour is used instead
+ C<$z3950random> => the random value created during a z3950 search result.
=head1 DESCRIPTION
-This is for depository of records coming from z3950 or directly imported.
+ ImportBreeding import MARC records in the reservoir (marc_breeding table).
+ the records can be properly encoded or not, we try to reencode them in utf-8 if needed.
+ works perfectly with BNF server, that sends UNIMARC latin1 records. Should work with other servers too.
+ the FixEncoding sub is in Koha.pm, as it's a general usage sub.
=cut
@EXPORT = qw(&ImportBreeding &BreedingSearch);
sub ImportBreeding {
- my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random) = @_;
-## use marc:batch send them in one by one
-# my @marcarray = split /\x1D/, $marcrecords;
- my $dbh = C4::Context->dbh;
-my @kohafields;
-my @values;
-my @relations;
-my $sort;
-my @and_or;
-my @results;
-my $count;
- my $searchbreeding = $dbh->prepare("select id from marc_breeding where isbn=? and title=?");
- my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc,encoding,z3950random,classification,subclass) values(?,?,?,?,?,?,?,?,?)");
- my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=?,encoding=?,z3950random=?,classification=?,subclass=? where id=?");
- $encoding = C4::Context->preference("marcflavour") unless $encoding;
- # fields used for import results
- my $imported=0;
- my $alreadyindb = 0;
- my $alreadyinfarm = 0;
- my $notmarcrecord = 0;
- my $breedingid;
-# for (my $i=0;$i<=$#marcarray;$i++) {
- my $marcrecord = MARC::File::USMARC::decode($marcrecords);
- my $marcxml=$marcrecord->as_xml_record($marcrecord);
- $marcxml=Encode::encode('utf8',$marcxml);
- my @warnings = $marcrecord->warnings();
- if (scalar($marcrecord->fields()) == 0) {
- $notmarcrecord++;
- } else {
- my $xmlhash=XML_xml2hash_onerecord($marcxml);
- my $oldbiblio = XMLmarc2koha_onerecord($dbh,$xmlhash,'biblios');
- # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
- # drop every "special" char : spaces, - ...
- $oldbiblio->{isbn} =~ s/ |-|\.//g,
- $oldbiblio->{isbn} = substr($oldbiblio->{isbn},0,10);
- $oldbiblio->{issn} =~ s/ |-|\.//g,
- $oldbiblio->{issn} = substr($oldbiblio->{issn},0,10);
- # search if biblio exists
- my $biblioitemnumber;
- my $facets;
- if ( !$z3950random){
- if ($oldbiblio->{isbn}) {
- push @kohafields,"isbn";
- push @values,$oldbiblio->{isbn};
- push @relations,"";
- push @and_or,"";
-
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations);
- } else {
- push @kohafields,"issn";
- push @values,$oldbiblio->{issn};
- push @relations,"";
- push @and_or,"";
- $sort="";
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations);
- }
- }
- if ($count>0 && !$z3950random) {
- $alreadyindb++;
- } else {
- # search in breeding farm
-
- if ($oldbiblio->{isbn}) {
- $searchbreeding->execute($oldbiblio->{isbn},$oldbiblio->{title});
- ($breedingid) = $searchbreeding->fetchrow;
- } elsif ($oldbiblio->{issn}){
- $searchbreeding->execute($oldbiblio->{issn},$oldbiblio->{title});
- ($breedingid) = $searchbreeding->fetchrow;
- }
- if ($breedingid && $overwrite_biblio eq 0) {
- $alreadyinfarm++;
- } else {
- my $recoded=MARC::Record->new_from_xml($marcxml,"UTF-8");
- $recoded->encoding('UTF-8');
-
- if ($breedingid && $overwrite_biblio eq 1) {
- $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass},$breedingid);
- } else {
- $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass});
-
- $breedingid=$dbh->{'mysql_insertid'};
- }
- $imported++;
- }
- }
- }
- #}
- return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
+ my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random) = @_;
+ my @marcarray = split /\x1D/, $marcrecords;
+ my $dbh = C4::Context->dbh;
+ my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
+ my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
+ my $searchbreeding = $dbh->prepare("select id from marc_breeding
+where isbn=? and title=?");
+ my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc,encoding,z3950random) values(?,?,?,?,?,?,?)");
+ my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=?,encoding=?,z3950random=? where id=?");
+ $encoding = C4::Context->preference("marcflavour") unless $encoding;
+ # fields used for import results
+ my $imported=0;
+ my $alreadyindb = 0;
+ my $alreadyinfarm = 0;
+ my $notmarcrecord = 0;
+ my $breedingid;
+ for (my $i=0;$i<=$#marcarray;$i++) {
+ my $marcrecord = FixEncoding($marcarray[$i]."\x1D");
+ my @warnings = $marcrecord->warnings();
+ if (scalar($marcrecord->fields()) == 0) {
+ $notmarcrecord++;
+ } else {
+ my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,'');
+ my $isbnlength=10;
+ if($oldbiblio->{isbn}){
+ $isbnlength = length($oldbiblio->{isbn});
+ }
+ # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
+ # drop every "special" char : spaces, - ...
+ $oldbiblio->{isbn} =~ s/ |-|\.//g,
+ $oldbiblio->{isbn} = substr($oldbiblio->{isbn},0,$isbnlength);
+ $oldbiblio->{issn} =~ s/ |-|\.//g,
+ $oldbiblio->{issn} = substr($oldbiblio->{issn},0,10);
+ # search if biblio exists
+ my $biblioitemnumber;
+ if ($oldbiblio->{isbn}) {
+ $searchisbn->execute($oldbiblio->{isbn});
+ ($biblioitemnumber) = $searchisbn->fetchrow;
+ } else {
+ if ($oldbiblio->{issn}) {
+ $searchissn->execute($oldbiblio->{issn});
+ ($biblioitemnumber) = $searchissn->fetchrow;
+ }
+ }
+ if ($biblioitemnumber) {
+ $alreadyindb++;
+ } else {
+ # search in breeding farm
+# my $breedingid;
+ if ($oldbiblio->{isbn}) {
+ $searchbreeding->execute($oldbiblio->{isbn},$oldbiblio->{title});
+ ($breedingid) = $searchbreeding->fetchrow;
+ } elsif ($oldbiblio->{issn}){
+ $searchbreeding->execute($oldbiblio->{issn},$oldbiblio->{title});
+ ($breedingid) = $searchbreeding->fetchrow;
+ }
+ if ($breedingid && $overwrite_biblio eq 0) {
+ $alreadyinfarm++;
+ } else {
+ my $recoded;
+ $recoded = $marcrecord->as_usmarc();
+ if ($breedingid && $overwrite_biblio eq 1) {
+ $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,$isbnlength),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random,$breedingid);
+ } else {
+ $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,$isbnlength),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random);
+ $breedingid=$dbh->{'mysql_insertid'};
+ }
+ $imported++;
+ }
+ }
+ }
+ }
+ return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
}
=item BreedingSearch
- ($count, @results) = &BreedingSearch($title,$isbn,$random);
+($count, @results) = &BreedingSearch($title,$isbn,$random);
C<$title> contains the title,
C<$isbn> contains isbn or issn,
C<$random> contains the random seed from a z3950 search.
=cut
sub BreedingSearch {
- my ($title,$isbn,$z3950random) = @_;
- my $dbh = C4::Context->dbh;
- my $count = 0;
- my ($query,@bind);
- my $sth;
- my @results;
-
- $query = "Select id,file,isbn,title,author,classification,subclass from marc_breeding where ";
- if ($z3950random) {
- $query .= "z3950random = ?";
- @bind=($z3950random);
- } else {
- @bind=();
- if ($title) {
- $query .= "title like ?";
- push(@bind,"$title%");
- }
- if ($title && $isbn) {
- $query .= " and ";
- }
- if ($isbn) {
- $query .= "isbn like ?";
- push(@bind,"$isbn%");
- }
- }
- $sth = $dbh->prepare($query);
- $sth->execute(@bind);
- while (my $data = $sth->fetchrow_hashref) {
- $results[$count] = $data;
- $count++;
- } # while
-
- $sth->finish;
- return($count, @results);
+ my ($title,$isbn,$z3950random) = @_;
+ my $dbh = C4::Context->dbh;
+ my $count = 0;
+ my ($query,@bind);
+ my $sth;
+ my @results;
+
+ $query = "Select id,file,isbn,title,author from marc_breeding where ";
+ if ($z3950random) {
+ $query .= "z3950random = ?";
+ @bind=($z3950random);
+ } else {
+ @bind=();
+ if ($title) {
+ $query .= "title like ?";
+ push(@bind,"$title%");
+ }
+ if ($title && $isbn) {
+ $query .= " and ";
+ }
+ if ($isbn) {
+ $query .= "isbn like ?";
+ push(@bind,"$isbn%");
+ }
+ }
+ $sth = $dbh->prepare($query);
+ $sth->execute(@bind);
+ while (my $data = $sth->fetchrow_hashref) {
+ $results[$count] = $data;
+ $count++;
+ } # while
+
+ $sth->finish;
+ return($count, @results);
} # sub breedingsearch
-# -*- tab-width: 8 -*-
-# Please use 8-character tabs for this file (indents are every 4 characters)
-
package C4::Circulation::Circ2;
-# $Id$
-
-#package to deal with circulation
-#written 3/11/99 by olwen@katipo.co.nz
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
-# use warnings;
require Exporter;
-
use C4::Context;
use C4::Stats;
use C4::Reserves2;
use C4::Koha;
-use C4::Accounts2;
use C4::Biblio;
-use C4::Calendar::Calendar;
-use C4::Search;
-use C4::Members;
-use C4::Date;
+use C4::Accounts2;
+use Date::Calc qw(
+ Today
+ Today_and_Now
+ Add_Delta_YM
+ Add_Delta_DHMS
+ Date_to_Days
+);
+use POSIX qw(strftime);
+use C4::Branch; # GetBranches
+use C4::Log; # logaction
+
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=head1 SYNOPSIS
- use C4::Circulation::Circ2;
+use C4::Circulation::Circ2;
=head1 DESCRIPTION
=head1 FUNCTIONS
-=over 2
-
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- ¤tissues
- &getissues
- &getiteminformation
- &renewstatus
- &renewbook
- &canbookbeissued
- &issuebook
- &returnbook
- &find_reserves
- &transferbook
- &decode
- &calc_charges
- &listitemsforinventory
- &itemseen
- &itemseenbarcode
- &fixdate
- &itemissues
- &patronflags
- &get_current_return_date_of
- &get_transfert_infos
- &checktransferts
- &GetReservesForBranch
- &GetReservesToBranch
- &GetTransfersFromBib
- &getBranchIp);
-
-# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
-=item itemissues
-
- @issues = &itemissues($biblionumber, $biblio);
+ &getpatroninformation
+ ¤tissues
+ &getissues
+ &getiteminformation
+ &renewstatus
+ &renewbook
+ &canbookbeissued
+ &issuebook
+ &returnbook
+ &find_reserves
+ &transferbook
+ &decode
+ &calc_charges
+ &GetItemsForInventory
+ &itemseen
+ &fixdate
+ &get_current_return_date_of
+ &get_transfert_infos
+ &checktransferts
+ &GetReservesForBranch
+ &GetReservesToBranch
+ &GetTransfersFromBib
+ &getBranchIp
+ &dotransfer
+ &GetOverduesForBranch
+ &AddNotifyLine
+ &RemoveNotifyLine
+ &GetIssuesFromBiblio
+ &AnonymiseIssueHistory
+ &GetLostItems
+ &itemissues
+ &updateWrongTransfer
+);
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblionumber.
+=head2 itemseen
-C<$biblio> is ignored.
+&itemseen($itemnum)
+Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
+C<$itemnum> is the item number
-C<&itemissues> returns an array of references-to-hash. The keys
-include the fields from the C<items> table in the Koha database.
-Additional keys include:
+=cut
-=over 4
+sub itemseen {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "update items set itemlost=0, datelastseen = now() where items.itemnumber = ?"
+ );
+ $sth->execute($itemnum);
+ return;
+}
-=item C<date_due>
+=head2 itemborrowed
-If the item is currently on loan, this gives the due date.
+&itemseen($itemnum)
+Mark item as borrowed. Is called when an item is issued.
+C<$itemnum> is the item number
-If the item is not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
+=cut
-=item C<card>
+sub itemborrowed {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?"
+ );
+ $sth->execute($itemnum);
+ return;
+}
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
+=head2 GetItemsForInventory
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
-These give the timestamp for the last three times the item was
-borrowed.
+Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
-=item C<card0>, C<card1>, C<card2>
+The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
+It is ordered by callnumber,title.
-The card number of the last three patrons who borrowed this item.
+The minlocation & maxlocation parameters are used to specify a range of item callnumbers
+the datelastseen can be used to specify that you want to see items not seen since a past date only.
+offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
-=item C<borrower0>, C<borrower1>, C<borrower2>
+=cut
-The borrower number of the last three patrons who borrowed this item.
+sub GetItemsForInventory {
+ my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($datelastseen) {
+ my $query =
+ "SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
+ FROM items
+ LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
+ WHERE itemcallnumber>= ?
+ AND itemcallnumber <=?
+ AND (datelastseen< ? OR datelastseen IS NULL)";
+ $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
+ $query .= " ORDER BY itemcallnumber,title";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $minlocation, $maxlocation, $datelastseen );
+ }
+ else {
+ my $query ="
+ SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
+ FROM items
+ LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
+ WHERE itemcallnumber>= ?
+ AND itemcallnumber <=?";
+ $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
+ $query .= " ORDER BY itemcallnumber,title";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $minlocation, $maxlocation );
+ }
+ my @results;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ $offset-- if ($offset);
+ if ( ( !$offset ) && $size ) {
+ push @results, $row;
+ $size--;
+ }
+ }
+ return \@results;
+}
+
+=head2 getpatroninformation
+
+($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
+
+Looks up a patron and returns information about him or her. If
+C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
+up the borrower by number; otherwise, it looks up the borrower by card
+number.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+
+C<$borrower> is a reference-to-hash whose keys are the fields of the
+borrowers table in the Koha database. In addition,
+C<$borrower-E<gt>{flags}> is a hash giving more detailed information
+about the patron. Its keys act as flags :
+
+ if $borrower->{flags}->{LOST} {
+ # Patron's card was reported lost
+ }
+
+Each flag has a C<message> key, giving a human-readable explanation of
+the flag. If the state of a flag means that the patron should not be
+allowed to borrow any more books, then it will have a C<noissues> key
+with a true value.
+
+The possible flags are:
+
+=head3 CHARGES
+
+=over 4
+
+=item Shows the patron's credit or debt, if any.
=back
-=cut
-#'
-sub itemissues {
- my ($dbh,$data, $itemnumber)=@_;
-
-
- my $i = 0;
- my @results;
+=head3 GNA
+=over 4
- # Find out who currently has this item.
- # FIXME - Wouldn't it be better to do this as a left join of
- # some sort? Currently, this code assumes that if
- # fetchrow_hashref() fails, then the book is on the shelf.
- # fetchrow_hashref() can fail for any number of reasons (e.g.,
- # database server crash), not just because no items match the
- # search criteria.
- my $sth2 = $dbh->prepare("select * from issues,borrowers
-where itemnumber = ?
-and returndate is NULL
-and issues.borrowernumber = borrowers.borrowernumber");
+=item (Gone, no address.) Set if the patron has left without giving a
+forwarding address.
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=back
- $data->{'date_due'}=$data2->{'date_due'};
- $data->{'datelastborrowed'} = $data2->{'issue_date'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=head3 LOST
- $sth2->finish;
- my $sth2 = $dbh->prepare("select * from reserveissue,borrowers
-where itemnumber = ?
-and rettime is NULL
-and reserveissue.borrowernumber = borrowers.borrowernumber");
+=over 4
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=item Set if the patron's card has been reported as lost.
- $data->{'date_due'}=$data2->{'duetime'};
- $data->{'datelastborrowed'} = $data2->{'restime'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=back
- $sth2->finish;
- # Find the last 2 people who borrowed this item.
- $sth2 = $dbh->prepare("select * from issues, borrowers
- where itemnumber = ?
- and issues.borrowernumber = borrowers.borrowernumber
- and returndate is not NULL
- order by returndate desc,timestamp desc limit 2") ;
- $sth2->execute($itemnumber) ;
-my $i2=0;
- while (my $data2 = $sth2->fetchrow_hashref) {
- $data->{"timestamp$i2"} = $data2->{'timestamp'};
- $data->{"card$i2"} = $data2->{'cardnumber'};
- $data->{"borrower$i2"} = $data2->{'borrowernumber'};
-$data->{'datelastborrowed'} = $data2->{'issue_date'} unless $data->{'datelastborrowed'};
- $i2++;
- } # while
+=head3 DBARRED
- $sth2->finish;
- return($data);
-}
+=over 4
+=item Set if the patron has been debarred.
+=back
-=head2 itemseen
+=head3 NOTES
-&itemseen($dbh,$itemnum)
-Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
-C<$itemnum> is the item number
+=over 4
-=cut
+=item Any additional notes about the patron.
-sub itemseen {
- my ($dbh,$itemnumber) = @_;
-my $sth=$dbh->prepare("select biblionumber from items where itemnumber=?");
- $sth->execute($itemnumber);
-my ($biblionumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
-# find today's date
-my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
-}
-sub itemseenbarcode {
- my ($dbh,$barcode) = @_;
-my $sth=$dbh->prepare("select biblionumber,itemnumber from items where barcode=$barcode");
- $sth->execute();
-my ($biblionumber,$itemnumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
-my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
-my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",$year,$mon,$mday,$hour,$min,$sec);
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
-}
+=back
-sub listitemsforinventory {
- my ($minlocation,$datelastseen,$offset,$size) = @_;
- my $count=0;
- my @results;
- my @kohafields;
- my @values;
- my @relations;
- my $sort;
- my @and_or;
- my $facets;
- if ($datelastseen){
- push @kohafields, "classification","datelastseen";
- push @values,$minlocation,$datelastseen;
- push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ","\@attr 2=1 ";
- push @and_or,"\@and";
- $sort="lcsort";
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
- }else{
- push @kohafields, "classification";
- push @values,$minlocation;
- push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ";
- push @and_or,"";
- $sort="lcsort";
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
- }
-
- return @results;
-}
+=head3 ODUES
+=over 4
+=item Set if the patron has overdue items. This flag has several keys:
+C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
+overdue items. Its elements are references-to-hash, each describing an
+overdue item. The keys are selected fields from the issues, biblio,
+biblioitems, and items tables of the Koha database.
-=head2 decode
+C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
+the overdue items, one per line.
+
+=back
+
+=head3 WAITING
=over 4
+=item Set if any items that the patron has reserved are available.
+
+C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
+available items. Each element is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database.
+
+=back
+
+=cut
+
+sub getpatroninformation {
+ my ( $env, $borrowernumber, $cardnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ my $sth;
+ if ($borrowernumber) {
+ $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
+ $sth->execute($borrowernumber);
+ }
+ elsif ($cardnumber) {
+ $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
+ $sth->execute($cardnumber);
+ }
+ else {
+ return undef;
+ }
+ my $borrower = $sth->fetchrow_hashref;
+ my $amount = checkaccount( $env, $borrowernumber, $dbh );
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = patronflags( $env, $borrower, $dbh );
+ my $accessflagshash;
+
+ $sth = $dbh->prepare("select bit,flag from userflags");
+ $sth->execute;
+ while ( my ( $bit, $flag ) = $sth->fetchrow ) {
+ if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
+ $accessflagshash->{$flag} = 1;
+ }
+ }
+ $sth->finish;
+ $borrower->{'flags'} = $flags;
+ $borrower->{'authflags'} = $accessflagshash;
+
+ # find out how long the membership lasts
+ $sth =
+ $dbh->prepare(
+ "select enrolmentperiod from categories where categorycode = ?");
+ $sth->execute( $borrower->{'categorycode'} );
+ my $enrolment = $sth->fetchrow;
+ $borrower->{'enrolmentperiod'} = $enrolment;
+ return ($borrower); #, $flags, $accessflagshash);
+}
+
+=head2 decode
+
=head3 $str = &decode($chunk);
=over 4
-Decodes a segment of a string emitted by a CueCat barcode scanner and
+=item Decodes a segment of a string emitted by a CueCat barcode scanner and
returns it.
=back
-=back
-
=cut
# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
sub decode {
- my ($encoded) = @_;
- my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
- my @s = map { index($seq,$_); } split(//,$encoded);
- my $l = ($#s+1) % 4;
- if ($l)
- {
- if ($l == 1)
- {
- print "Error!";
- return;
- }
- $l = 4-$l;
- $#s += $l;
- }
- my $r = '';
- while ($#s >= 0)
- {
- my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
- $r .=chr(($n >> 16) ^ 67) .
- chr(($n >> 8 & 255) ^ 67) .
- chr(($n & 255) ^ 67);
- @s = @s[4..$#s];
- }
- $r = substr($r,0,length($r)-$l);
- return $r;
+ my ($encoded) = @_;
+ my $seq =
+ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index( $seq, $_ ); } split( //, $encoded );
+ my $l = ( $#s + 1 ) % 4;
+ if ($l) {
+ if ( $l == 1 ) {
+ warn "Error!";
+ return;
+ }
+ $l = 4 - $l;
+ $#s += $l;
+ }
+ my $r = '';
+ while ( $#s >= 0 ) {
+ my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
+ $r .=
+ chr( ( $n >> 16 ) ^ 67 )
+ .chr( ( $n >> 8 & 255 ) ^ 67 )
+ .chr( ( $n & 255 ) ^ 67 );
+ @s = @s[ 4 .. $#s ];
+ }
+ $r = substr( $r, 0, length($r) - $l );
+ return $r;
}
=head2 getiteminformation
-=over 4
-
-$item = &getiteminformation($env, $itemnumber, $barcode);
+$item = &getiteminformation($itemnumber, $barcode);
Looks up information about an item, given either its item number or
its barcode. If C<$itemnumber> is a nonzero value, it is used;
otherwise, C<$barcode> is used.
-C<$env> is effectively ignored, but should be a reference-to-hash.
-
C<$item> is a reference-to-hash whose keys are fields from the biblio,
items, and biblioitems tables of the Koha database. It may also
contain the following keys:
=over 4
-The due date on this item, if it has been borrowed and not returned
+=item The due date on this item, if it has been borrowed and not returned
yet. The date is in YYYY-MM-DD format.
=back
=over 4
-True if the item may not be borrowed.
-
-=back
+=item True if the item may not be borrowed.
=back
=cut
-
sub getiteminformation {
-# returns a hash of item information together with biblio given either the itemnumber or the barcode
- my ($env, $itemnumber, $barcode) = @_;
- my $dbh=C4::Context->dbh;
- my ($itemrecord)=XMLgetitem($dbh,$itemnumber,$barcode);
- return undef unless $itemrecord; ## This is to prevent a system crash if barcode does not exist
- my $itemhash=XML_xml2hash_onerecord($itemrecord);
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemhash,"holdings");
-##Now get full biblio details from MARC
- if ($iteminformation) {
-my ($record)=XMLgetbiblio($dbh,$iteminformation->{'biblionumber'});
- my $recordhash=XML_xml2hash_onerecord($record);
-my $biblio=XMLmarc2koha_onerecord($dbh,$recordhash,"biblios");
- foreach my $field (keys %$biblio){
- $iteminformation->{$field}=$biblio->{$field};
- }
- $iteminformation->{'date_due'}="" if $iteminformation->{'date_due'} eq "0000-00-00";
- ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
- }
- return($iteminformation);
+
+ # returns a hash of item information given either the itemnumber or the barcode
+ my ( $itemnumber, $barcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($itemnumber) {
+ $sth =
+ $dbh->prepare(
+ "select *
+ from biblio,items,biblioitems
+ where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"
+ );
+ $sth->execute($itemnumber);
+ }
+ elsif ($barcode) {
+ $sth =
+ $dbh->prepare(
+ "select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"
+ );
+ $sth->execute($barcode);
+ }
+ else {
+ return undef;
+ }
+ my $iteminformation = $sth->fetchrow_hashref;
+ $sth->finish;
+ if ($iteminformation) {
+ $sth =
+ $dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)");
+ $sth->execute( $iteminformation->{'itemnumber'} );
+ my ($date_due) = $sth->fetchrow;
+ $iteminformation->{'date_due'} = $date_due;
+ $sth->finish;
+ ( $iteminformation->{'dewey'} == 0 )
+ && ( $iteminformation->{'dewey'} = '' );
+ $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
+ $sth->execute( $iteminformation->{'itemtype'} );
+ my $itemtype = $sth->fetchrow_hashref;
+
+ # if specific item notforloan, don't use itemtype notforloan field.
+ # otherwise, use itemtype notforloan value to see if item can be issued.
+ $iteminformation->{'notforloan'} = $itemtype->{'notforloan'}
+ unless $iteminformation->{'notforloan'};
+ $sth->finish;
+ }
+ return ($iteminformation);
}
=head2 transferbook
-=over 4
-
($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
is true if the transfer was successful.
=head3 $messages
-
+
is a reference-to-hash which may have any of the following keys:
=over 4
-C<BadBarcode>
+=item C<BadBarcode>
There is no item in the catalog with the given barcode. The value is C<$barcode>.
-C<IsPermanent>
+=item C<IsPermanent>
The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
-C<DestinationEqualsHolding>
+=item C<DestinationEqualsHolding>
The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
-C<WasReturned>
+=item C<WasReturned>
The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
-C<ResFound>
+=item C<ResFound>
The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
-C<WasTransferred>
+=item C<WasTransferred>
The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
=back
-=back
-
-=back
-
=cut
-##This routine is reverted to origional state
-##This routine is used when a book physically arrives at a branch due to user returning it there
-## so record the fact that holdingbranch is changed.
+#'
+# FIXME - This function tries to do too much, and its API is clumsy.
+# If it didn't also return books, it could be used to change the home
+# branch of a book while the book is on loan.
+#
+# Is there any point in returning the item information? The caller can
+# look that up elsewhere if ve cares.
+#
+# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
+# If the transfer succeeds, that's all the caller should need to know.
+# Thus, this function could simply return 1 or 0 to indicate success
+# or failure, and set $C4::Circulation::Circ2::errmsg in case of
+# failure. Or this function could return undef if successful, and an
+# error message in case of failure (this would feel more like C than
+# Perl, though).
sub transferbook {
-# transfer book code....
- my ($tbr, $barcode, $ignoreRs,$user) = @_;
- my $messages;
- my %env;
- my $dbh=C4::Context->dbh;
- my $dotransfer = 1;
- my $branches = GetBranches();
-
- my $iteminformation = getiteminformation(\%env, 0, $barcode);
- # bad barcode..
- if (not $iteminformation) {
- $messages->{'BadBarcode'} = $barcode;
- $dotransfer = 0;
- }
- # get branches of book...
- my $hbr = $iteminformation->{'homebranch'};
- my $fbr = $iteminformation->{'holdingbranch'};
- # if is permanent...
- if ($hbr && $branches->{$hbr}->{'PE'}) {
- $messages->{'IsPermanent'} = $hbr;
- }
- # can't transfer book if is already there....
- # FIXME - Why not? Shouldn't it trivially succeed?
- if ($fbr eq $tbr) {
- $messages->{'DestinationEqualsHolding'} = 1;
- $dotransfer = 0;
- }
- # check if it is still issued to someone, return it...
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ($currentborrower) {
- returnbook($barcode, $fbr);
- $messages->{'WasReturned'} = $currentborrower;
- }
- # find reserves.....
- # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
- # That'll save a database query.
- my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
- if ($resfound and not $ignoreRs) {
- $resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- $dotransfer = 0;
- }
- #actually do the transfer....
- if ($dotransfer) {
- dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user);
- $messages->{'WasTransfered'} = 1;
- }
- return ($dotransfer, $messages, $iteminformation);
+ my ( $tbr, $barcode, $ignoreRs ) = @_;
+ my $messages;
+ my %env;
+ my $dotransfer = 1;
+ my $branches = GetBranches();
+ my $iteminformation = getiteminformation( 0, $barcode );
+
+ # bad barcode..
+ if ( not $iteminformation ) {
+ $messages->{'BadBarcode'} = $barcode;
+ $dotransfer = 0;
+ }
+
+ # get branches of book...
+ my $hbr = $iteminformation->{'homebranch'};
+ my $fbr = $iteminformation->{'holdingbranch'};
+
+ # if is permanent...
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+
+ # can't transfer book if is already there....
+ # FIXME - Why not? Shouldn't it trivially succeed?
+ if ( $fbr eq $tbr ) {
+ $messages->{'DestinationEqualsHolding'} = 1;
+ $dotransfer = 0;
+ }
+
+ # check if it is still issued to someone, return it...
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
+ if ($currentborrower) {
+ returnbook( $barcode, $fbr );
+ $messages->{'WasReturned'} = $currentborrower;
+ }
+
+ # find reserves.....
+ # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
+ # That'll save a database query.
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ( $resfound and not $ignoreRs ) {
+ $resrec->{'ResFound'} = $resfound;
+
+ # $messages->{'ResFound'} = $resrec;
+ $dotransfer = 1;
+ }
+
+ #actually do the transfer....
+ if ($dotransfer) {
+ dotransfer( $iteminformation->{'itemnumber'}, $fbr, $tbr );
+
+ # don't need to update MARC anymore, we do it in batch now
+ $messages->{'WasTransfered'} = 1;
+ }
+ return ( $dotransfer, $messages, $iteminformation );
}
# Not exported
-
+# FIXME - This is only used in &transferbook. Why bother making it a
+# separate function?
sub dotransfer {
-## The book has arrived at this branch because it has been returned there
-## So we update the fact the book is in that branch not that we want to send the book to that branch
-
- my ($itm, $fbr, $tbr,$user) = @_;
- my $dbh = C4::Context->dbh;
-
- #new entry in branchtransfers....
- my $sth=$dbh->prepare("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES (?, ?, now(), ?,?)");
- $sth->execute($itm, $fbr, $tbr,$user);
- #update holdingbranch in items .....
- &domarctransfer($dbh,$itm,$tbr);
-## Item seen taken out of this loop to optimize ZEBRA updates
-# &itemseen($dbh,$itm);
- return;
+ my ( $itm, $fbr, $tbr ) = @_;
+
+ my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
+
+ #new entry in branchtransfers....
+ $dbh->do(
+"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
+ VALUES ($itm, $fbr, now(), $tbr)"
+ );
+
+ #update holdingbranch in items .....
+ $dbh->do(
+ "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
+ &itemseen($itm);
+ &domarctransfer( $dbh, $itm );
+ return;
}
-sub domarctransfer{
-my ($dbh,$itemnumber,$holdingbranch) = @_;
-$itemnumber=~s /\'//g;
-my $sth=$dbh->prepare("select biblionumber from items where itemnumber=$itemnumber");
- $sth->execute();
-my ($biblionumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'holdingbranch',$holdingbranch,1);
- $sth->finish;
+##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
+sub domarctransfer {
+ my ( $dbh, $itemnumber ) = @_;
+ $itemnumber =~ s /\'//g; ##itemnumber seems to come with quotes-TG
+ my $sth =
+ $dbh->prepare(
+ "select biblionumber,holdingbranch from items where itemnumber=$itemnumber"
+ );
+ $sth->execute();
+ while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
+ &MARCmoditemonefield( $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch, 0 );
+ }
+ return;
}
=head2 canbookbeissued
=over 4
-C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
+=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-C<$borrower> hash with borrower informations (from getpatroninformation)
+=item C<$borrower> hash with borrower informations (from getpatroninformation)
-C<$barcode> is the bar code of the book being issued.
+=item C<$barcode> is the bar code of the book being issued.
-C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
+=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
=back
=over 4
-C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
+=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
+=back
+
=head3 INVALID_DATE
sticky due date is invalid
borrower gone with no address
=head3 CARD_LOST
-
+
borrower declared it's card lost
=head3 DEBARRED
item is restricted (set by ??)
-=back
-
C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
# check if a book can be issued.
# returns an array with errors if any
+sub TooMany ($$) {
+ my $borrower = shift;
+ my $iteminformation = shift;
+ my $cat_borrower = $borrower->{'categorycode'};
+ my $branch_borrower = $borrower->{'branchcode'};
+ my $dbh = C4::Context->dbh;
+
+ my $sth =
+ $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
+ $sth->execute( $iteminformation->{'biblionumber'} );
+ my $type = $sth->fetchrow;
+ $sth =
+ $dbh->prepare(
+'select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'
+ );
+
+# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?");
+ my $sth2 =
+ $dbh->prepare(
+"select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
+ );
+ my $sth3 =
+ $dbh->prepare(
+'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
+ );
+ my $alreadyissued;
+
+ # check the 3 parameters
+ $sth->execute( $cat_borrower, $type, $branch_borrower );
+ my $result = $sth->fetchrow_hashref;
+
+ # warn "==>".$result->{maxissueqty};
+
+# Currently, using defined($result) ie on an entire hash reports whether memory
+# for that aggregate has ever been allocated. As $result is used all over the place
+# it would rarely return as undefined.
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ # check for branch=*
+ $sth->execute( $cat_borrower, $type, "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ # check for itemtype=*
+ $sth->execute( $cat_borrower, "*", $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my ($alreadyissued) = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+
+# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
+ return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ # check for borrowertype=*
+ $sth->execute( "*", $type, $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ $sth->execute( "*", "*", $branch_borrower );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my $alreadyissued = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ $sth->execute( "*", $type, "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ $sth->execute( $cat_borrower, "*", "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
+ my $alreadyissued = $sth2->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ $sth->execute( "*", "*", "" );
+ $result = $sth->fetchrow_hashref;
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
+ my $alreadyissued = $sth3->fetchrow;
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
+ return;
+ }
+ }
+ return;
+}
+=head2 itemissues
+ @issues = &itemissues($biblioitemnumber, $biblio);
-sub TooMany ($$){
- my $borrower = shift;
- my $iteminformation = shift;
- my $cat_borrower = $borrower->{'categorycode'};
- my $branch_borrower = $borrower->{'branchcode'};
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare('select itemtype from biblio where biblionumber = ?');
- $sth->execute($iteminformation->{'biblionumber'});
- my $type = $sth->fetchrow;
- $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?');
- my $sth2 = $dbh->prepare("select COUNT(*) from issues i, items it, biblio b where i.borrowernumber = ? and i.returndate is null and i.itemnumber = it.itemnumber and b.biblionumber=it.biblionumber and b.itemtype like ?");
- my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null');
- my $alreadyissued;
-
- # check the 3 parameters
- #print "content-type: text/plain \n\n";
- #print "$cat_borrower, $type, $branch_borrower";
- $sth->execute($cat_borrower, $type, $branch_borrower);
- my $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- # print "content-type: text/plain \n\n";
- #print "$cat_borrower, $type, $branch_borrower";
- $sth2->execute($borrower->{'borrowernumber'}, $type);
- my $alreadyissued = $sth2->fetchrow;
- # print "***" . $alreadyissued;
- #print "----". $result->{'maxissueqty'};
- if ($result->{'maxissueqty'} <= $alreadyissued) {
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- }else {
- return;
- }
- }
+Looks up information about who has borrowed the bookZ<>(s) with the
+given biblioitemnumber.
- # check for branch=*
- $sth->execute($cat_borrower, $type, "");
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, $type);
- my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+C<$biblio> is ignored.
- # check for itemtype=*
- $sth->execute($cat_borrower, "*", $branch_borrower);
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
- my ($alreadyissued) = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
-# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+C<&itemissues> returns an array of references-to-hash. The keys
+include the fields from the C<items> table in the Koha database.
+Additional keys include:
- #check for borrowertype=*
- $sth->execute("*", $type, $branch_borrower);
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
- my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+=over 4
- #check for borrowertype=*;itemtype=*
- $sth->execute("*", "*", $branch_borrower);
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
- my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+=item C<date_due>
- $sth->execute("*", $type, "");
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty}) && $result->{maxissueqty}>=0) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
- my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+If the item is currently on loan, this gives the due date.
- $sth->execute($cat_borrower, "*", "");
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
- my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+If the item is not on loan, then this is either "Available" or
+"Cancelled", if the item has been withdrawn.
- $sth->execute("*", "*", "");
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
- my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
- return;
-}
+=item C<card>
+If the item is currently on loan, this gives the card number of the
+patron who currently has the item.
+=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+These give the timestamp for the last three times the item was
+borrowed.
-sub canbookbeissued {
- my ($env,$borrower,$barcode,$year,$month,$day,$inprocess) = @_;
- my %needsconfirmation; # filled with problems that needs confirmations
- my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE
- my $iteminformation = getiteminformation($env, 0, $barcode);
- my $dbh = C4::Context->dbh;
-#
-# DUE DATE is OK ?
-#
- my ($duedate, $invalidduedate) = fixdate($year, $month, $day);
- $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
+=item C<card0>, C<card1>, C<card2>
-#
-# BORROWER STATUS
-#
- if ($borrower->{flags}->{GNA}) {
- $issuingimpossible{GNA} = 1;
- }
- if ($borrower->{flags}->{'LOST'}) {
- $issuingimpossible{CARD_LOST} = 1;
- }
- if ($borrower->{flags}->{'DBARRED'}) {
- $issuingimpossible{DEBARRED} = 1;
- }
- my $today=get_today();
- if (DATE_diff($borrower->{expiry},$today)<0) {
- $issuingimpossible{EXPIRED} = 1;
- }
-#
-# BORROWER STATUS
-#
+The card number of the last three patrons who borrowed this item.
-# DEBTS
- my $amount = checkaccount($env,$borrower->{'borrowernumber'}, $dbh,$duedate);
- if(C4::Context->preference("IssuingInProcess")){
- my $amountlimit = C4::Context->preference("noissuescharge");
- if ($amount > $amountlimit && !$inprocess) {
- $issuingimpossible{DEBT} = sprintf("%.2f",$amount);
- } elsif ($amount <= $amountlimit && !$inprocess) {
- $needsconfirmation{DEBT} = sprintf("%.2f",$amount);
- }
- } else {
- if ($amount >0) {
- $needsconfirmation{DEBT} = $amount;
- }
- }
+=item C<borrower0>, C<borrower1>, C<borrower2>
+The borrower number of the last three patrons who borrowed this item.
-#
-# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
-#
- my $toomany = TooMany($borrower, $iteminformation);
- $needsconfirmation{TOO_MANY} = $toomany if $toomany;
- $issuingimpossible{TOO_MANY} = $toomany if $toomany;
-#
-# ITEM CHECKING
-#
- unless ($iteminformation->{barcode}) {
- $issuingimpossible{UNKNOWN_BARCODE} = 1;
- }
- if ($iteminformation->{'notforloan'} > 0) {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ($iteminformation->{'itemtype'} eq 'REF') {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ($iteminformation->{'wthdrawn'} == 1) {
- $issuingimpossible{WTHDRAWN} = 1;
- }
- if ($iteminformation->{'restricted'} == 1) {
- $issuingimpossible{RESTRICTED} = 1;
- }
- if ($iteminformation->{'shelf'} eq 'Res') {
- $issuingimpossible{IN_RESERVE} = 1;
- }
-if (C4::Context->preference("IndependantBranches")){
- my $userenv = C4::Context->userenv;
- if (($userenv)&&($userenv->{flags} != 1)){
- $issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ;
- }
- }
+=back
-#
-# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
-#
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ($currentborrower eq $borrower->{'borrowernumber'}) {
-# Already issued to current borrower. Ask whether the loan should
-# be renewed.
- my ($renewstatus) = renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- if ($renewstatus == 0) { # no more renewals allowed
- $issuingimpossible{NO_MORE_RENEWALS} = 1;
- } else {
- if (C4::Context->preference("strictrenewals")){
- ###if this is set do not allow automatic renewals
- ##the new renew script will do same strict checks as issues and return error codes
- $needsconfirmation{RENEW_ISSUE} = 1;
- }
-
- }
- } elsif ($currentborrower) {
-# issued to someone else
- my $currborinfo = getpatroninformation(0,$currentborrower);
-# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- $needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- }
-# See if the item is on RESERVE
- my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ($resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting") {
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
- my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
- # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- } elsif ($restype eq "Reserved") {
- # The item is on reserve for someone else.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
- my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
- }
- }
- if(C4::Context->preference("LibraryName") eq "Horowhenua Library Trust"){
- if ($borrower->{'categorycode'} eq 'W'){
- my %issuingimpossible;
- return(\%issuingimpossible,\%needsconfirmation);
- }
- }
-
- return(\%issuingimpossible,\%needsconfirmation);
+=cut
+
+#'
+sub itemissues {
+ my ( $bibitem, $biblio ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # FIXME - If this function die()s, the script will abort, and the
+ # user won't get anything; depending on how far the script has
+ # gotten, the user might get a blank page. It would be much better
+ # to at least print an error message. The easiest way to do this
+ # is to set $SIG{__DIE__}.
+ my $sth =
+ $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
+ || die $dbh->errstr;
+ my $i = 0;
+ my @results;
+
+ $sth->execute($bibitem) || die $sth->errstr;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # Find out who currently has this item.
+ # FIXME - Wouldn't it be better to do this as a left join of
+ # some sort? Currently, this code assumes that if
+ # fetchrow_hashref() fails, then the book is on the shelf.
+ # fetchrow_hashref() can fail for any number of reasons (e.g.,
+ # database server crash), not just because no items match the
+ # search criteria.
+ my $sth2 = $dbh->prepare(
+ "select * from issues,borrowers
+where itemnumber = ?
+and returndate is NULL
+and issues.borrowernumber = borrowers.borrowernumber"
+ );
+
+ $sth2->execute( $data->{'itemnumber'} );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $data->{'date_due'} = $data2->{'date_due'};
+ $data->{'card'} = $data2->{'cardnumber'};
+ $data->{'borrower'} = $data2->{'borrowernumber'};
+ }
+ else {
+ if ( $data->{'wthdrawn'} eq '1' ) {
+ $data->{'date_due'} = 'Cancelled';
+ }
+ else {
+ $data->{'date_due'} = 'Available';
+ } # else
+ } # else
+
+ $sth2->finish;
+
+ # Find the last 3 people who borrowed this item.
+ $sth2 = $dbh->prepare(
+ "select * from issues, borrowers
+ where itemnumber = ?
+ and issues.borrowernumber = borrowers.borrowernumber
+ and returndate is not NULL
+ order by returndate desc,timestamp desc"
+ );
+
+# $sth2 = $dbh->prepare("
+# SELECT *
+# FROM issues
+# LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
+# WHERE itemnumber = ?
+# AND returndate is not NULL
+# ORDER BY returndate DESC,timestamp DESC
+# ");
+
+ $sth2->execute( $data->{'itemnumber'} );
+ for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
+ { # FIXME : error if there is less than 3 pple borrowing this item
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $data->{"timestamp$i2"} = $data2->{'timestamp'};
+ $data->{"card$i2"} = $data2->{'cardnumber'};
+ $data->{"borrower$i2"} = $data2->{'borrowernumber'};
+ } # if
+ } # for
+
+ $sth2->finish;
+ $results[$i] = $data;
+ $i++;
+ }
+
+ $sth->finish;
+ return (@results);
+}
+
+=head2 canbookbeissued
+
+$issuingimpossible, $needsconfirmation =
+ canbookbeissued( $env, $borrower, $barcode, $year, $month, $day, $inprocess );
+
+C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
+
+=cut
+
+sub canbookbeissued {
+ my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
+ my %needsconfirmation; # filled with problems that needs confirmations
+ my %issuingimpossible
+ ; # filled with problems that causes the issue to be IMPOSSIBLE
+ my $iteminformation = getiteminformation( 0, $barcode );
+ my $dbh = C4::Context->dbh;
+
+ #
+ # DUE DATE is OK ?
+ #
+ my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
+ $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
+
+ #
+ # BORROWER STATUS
+ #
+ if ( $borrower->{flags}->{GNA} ) {
+ $issuingimpossible{GNA} = 1;
+ }
+ if ( $borrower->{flags}->{'LOST'} ) {
+ $issuingimpossible{CARD_LOST} = 1;
+ }
+ if ( $borrower->{flags}->{'DBARRED'} ) {
+ $issuingimpossible{DEBARRED} = 1;
+ }
+ if ( Date_to_Days(Today) >
+ Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
+ {
+
+ #
+ #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) {
+ $issuingimpossible{EXPIRED} = 1;
+ }
+
+ #
+ # BORROWER STATUS
+ #
+
+ # DEBTS
+ my $amount =
+ checkaccount( $env, $borrower->{'borrowernumber'}, $dbh, $duedate );
+ if ( C4::Context->preference("IssuingInProcess") ) {
+ my $amountlimit = C4::Context->preference("noissuescharge");
+ if ( $amount > $amountlimit && !$inprocess ) {
+ $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
+ }
+ elsif ( $amount <= $amountlimit && !$inprocess ) {
+ $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
+ }
+ }
+ else {
+ if ( $amount > 0 ) {
+ $needsconfirmation{DEBT} = $amount;
+ }
+ }
+
+ #
+ # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
+ #
+ my $toomany = TooMany( $borrower, $iteminformation );
+ $needsconfirmation{TOO_MANY} = $toomany if $toomany;
+
+ #
+ # ITEM CHECKING
+ #
+ unless ( $iteminformation->{barcode} ) {
+ $issuingimpossible{UNKNOWN_BARCODE} = 1;
+ }
+ if ( $iteminformation->{'notforloan'}
+ && $iteminformation->{'notforloan'} > 0 )
+ {
+ $issuingimpossible{NOT_FOR_LOAN} = 1;
+ }
+ if ( $iteminformation->{'itemtype'}
+ && $iteminformation->{'itemtype'} eq 'REF' )
+ {
+ $issuingimpossible{NOT_FOR_LOAN} = 1;
+ }
+ if ( $iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1 )
+ {
+ $issuingimpossible{WTHDRAWN} = 1;
+ }
+ if ( $iteminformation->{'restricted'}
+ && $iteminformation->{'restricted'} == 1 )
+ {
+ $issuingimpossible{RESTRICTED} = 1;
+ }
+ if ( C4::Context->preference("IndependantBranches") ) {
+ my $userenv = C4::Context->userenv;
+ if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
+ $issuingimpossible{NOTSAMEBRANCH} = 1
+ if ( $iteminformation->{'holdingbranch'} ne $userenv->{branch} );
+ }
+ }
+
+ #
+ # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
+ #
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
+ if ( $currentborrower && $currentborrower eq $borrower->{'borrowernumber'} )
+ {
+
+ # Already issued to current borrower. Ask whether the loan should
+ # be renewed.
+ my ($renewstatus) = renewstatus(
+ $env,
+ $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'}
+ );
+ if ( $renewstatus == 0 ) { # no more renewals allowed
+ $issuingimpossible{NO_MORE_RENEWALS} = 1;
+ }
+ else {
+
+ # $needsconfirmation{RENEW_ISSUE} = 1;
+ }
+ }
+ elsif ($currentborrower) {
+
+ # issued to someone else
+ my $currborinfo = getpatroninformation( 0, $currentborrower );
+
+# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
+ $needsconfirmation{ISSUED_TO_ANOTHER} =
+"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
+ }
+
+ # See if the item is on reserve.
+ my ( $restype, $res ) = CheckReserves( $iteminformation->{'itemnumber'} );
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
+ {
+
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVE_WAITING} =
+"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
+
+# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # The item is on reserve for someone else.
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVED} =
+"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
+ }
+ }
+ if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
+ {
+ if ( $borrower->{'categorycode'} eq 'W' ) {
+ my %issuingimpossible;
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
}
=head2 issuebook
=over 4
-C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
+=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-C<$borrower> hash with borrower informations (from getpatroninformation)
+=item C<$borrower> hash with borrower informations (from getpatroninformation)
-C<$barcode> is the bar code of the book being issued.
+=item C<$barcode> is the bar code of the book being issued.
-C<$date> contains the max date of return. calculated if empty.
+=item C<$date> contains the max date of return. calculated if empty.
+
+=back
=cut
-#
-# issuing book. We already have checked it can be issued, so, just issue it !
-#
sub issuebook {
-### fix me STOP using koha hashes, change so that XML hash is used
- my ($env,$borrower,$barcode,$date,$cancelreserve) = @_;
- my $dbh = C4::Context->dbh;
- my $itemrecord=XMLgetitemhash($dbh,"",$barcode);
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
- $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber});
- my $error;
+ my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
+ my $dbh = C4::Context->dbh;
+
+# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0);
+ my $iteminformation = getiteminformation( 0, $barcode );
+
#
# check if we just renew the issue.
#
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ($currentborrower eq $borrower->{'borrowernumber'}) {
- my ($charge,$itemtype) = calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'});
- if ($charge > 0) {
- createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge);
- $iteminformation->{'charge'} = $charge;
- }
- &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
- if (C4::Context->preference("strictrenewals")){
- $error=renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}) if ($error>1);
- }else{
- renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- }
- } else {
-#
-# NOT a renewal
-#
- if ($currentborrower ne '') {
- # This book is currently on loan, but not to the person
- # who wants to borrow it now. mark it returned before issuing to the new borrower
- returnbook($iteminformation->{'barcode'}, $env->{'branchcode'});
-#warn "return : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
-
- }
- # See if the item is on reserve.
- my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
-#warn "$restype,$res";
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ($resbor eq $borrower->{'borrowernumber'}) {
- # The item is on reserve to the current patron
- FillReserve($res);
-# warn "FillReserve";
- } elsif ($restype eq "Waiting") {
-# warn "Waiting";
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
- my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- if ($cancelreserve){
- CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- } else {
- # set waiting reserve to first in reserve queue as book isn't waiting now
- UpdateReserve(1, $res->{'biblionumber'}, $res->{'borrowernumber'}, $res->{'branchcode'});
- }
- } elsif ($restype eq "Reserved") {
-#warn "Reserved";
- # The item is on reserve for someone else.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
- my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- if ($cancelreserve) {
- # cancel reserves on this item
- CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- # also cancel reserve on biblio related to this item
- # my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
- # $st_Fbiblio->execute($res->{'itemnumber'});
- # my $biblionumber = $st_Fbiblio->fetchrow;
-# CancelReserve($iteminformation->{'biblionumber'},0,$res->{'borrowernumber'});
-# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
- } else {
- my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
- transferbook($tobrcd,$barcode, 1);
-# warn "transferbook";
- }
- }
- }
-
- my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())");
- my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
-
- my $dateduef;
- my @datearr = localtime();
- $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-". $datearr[3];
-
- my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
- my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef;
- ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
- $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
+ if ( $currentborrower eq $borrower->{'borrowernumber'} ) {
+ my ( $charge, $itemtype ) = calc_charges(
+ $env,
+ $iteminformation->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ if ( $charge > 0 ) {
+ createcharge(
+ $env, $dbh,
+ $iteminformation->{'itemnumber'},
+ $borrower->{'borrowernumber'}, $charge
+ );
+ $iteminformation->{'charge'} = $charge;
+ }
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'renew', $charge,
+ '', $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
+ renewbook(
+ $env,
+ $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'}
+ );
+ }
+ else {
+
+ #
+ # NOT a renewal
+ #
+ if ( $currentborrower ne '' ) {
+
+# This book is currently on loan, but not to the person
+# who wants to borrow it now. mark it returned before issuing to the new borrower
+ returnbook(
+ $iteminformation->{'barcode'},
+ C4::Context->userenv->{'branch'}
+ );
+ }
+
+ # See if the item is on reserve.
+ my ( $restype, $res ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ( $resbor eq $borrower->{'borrowernumber'} ) {
+
+ # The item is on reserve to the current patron
+ FillReserve($res);
+ }
+ elsif ( $restype eq "Waiting" ) {
+
+ # warn "Waiting";
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ if ($cancelreserve) {
+ CancelReserve( 0, $res->{'itemnumber'},
+ $res->{'borrowernumber'} );
+ }
+ else {
+
+ # set waiting reserve to first in reserve queue as book isn't waiting now
+ UpdateReserve(
+ 1,
+ $res->{'biblionumber'},
+ $res->{'borrowernumber'},
+ $res->{'branchcode'}
+ );
+ }
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # warn "Reserved";
+ # The item is on reserve for someone else.
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
+ my $branches = GetBranches();
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ if ($cancelreserve) {
+
+ # cancel reserves on this item
+ CancelReserve( 0, $res->{'itemnumber'},
+ $res->{'borrowernumber'} );
+
+# also cancel reserve on biblio related to this item
+#my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
+#$st_Fbiblio->execute($res->{'itemnumber'});
+#my $biblionumber = $st_Fbiblio->fetchrow;
+#CancelReserve($biblionumber,0,$res->{'borrowernumber'});
+#warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
+ }
+ else {
+
+# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
+# transferbook($tobrcd,$barcode, 1);
+# warn "transferbook";
+ }
+ }
+ }
+# END OF THE RESTYPE WORK
+
+# Starting process for transfer job (checking transfert and validate it if we have one)
+
+ my ($datesent) = get_transfert_infos($iteminformation->{'itemnumber'});
-#warn $dateduef;
- if ($date) {
- $dateduef=$date;
- }
- # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
- if (C4::Context->preference('ReturnBeforeExpiry') && $dateduef gt $borrower->{expiry}) {
- $dateduef=$borrower->{expiry};
- }
- $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
- $sth->finish;
- $iteminformation->{'issues'}++;
-##Record in MARC the new data ,date_due as due date,issue count and the borrowernumber
- $itemrecord=XML_writeline($itemrecord, "issues", $iteminformation->{'issues'},"holdings");
- $itemrecord=XML_writeline($itemrecord, "date_due", $dateduef,"holdings");
- $itemrecord=XML_writeline($itemrecord, "borrowernumber", $borrower->{'borrowernumber'},"holdings");
- $itemrecord=XML_writeline($itemrecord, "itemlost", "0","holdings");
- $itemrecord=XML_writeline($itemrecord, "onloan", "1","holdings");
- # find today's date as timestamp
- my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
- $itemrecord=XML_writeline($itemrecord, "datelastseen", $timestamp,"holdings");
- ##Now update the zebradb
- NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'});
- # If it costs to borrow this book, charge it to the patron's account.
- my ($charge,$itemtype)=calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'});
- if ($charge > 0) {
- createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge);
- $iteminformation->{'charge'}=$charge;
- }
- # Record the fact that this book was issued in SQL
- &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ if ($datesent) {
+# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived = now(),
+ tobranch = ?,
+ comments = 'Forced branchtransfert'
+ where
+ itemnumber= ? AND datearrived IS NULL"
+ );
+ $sth->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
+ $sth->finish;
}
-return($error);
+
+# Ending process for transfert check
+
+ # Record in the database the fact that the book was issued.
+ my $sth =
+ $dbh->prepare(
+"insert into issues (borrowernumber, itemnumber,issuedate, date_due, branchcode) values (?,?,?,?,?)"
+ );
+ my $loanlength = getLoanLength(
+ $borrower->{'categorycode'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'branchcode'}
+ );
+ my $datedue = time + ($loanlength) * 86400;
+ my @datearr = localtime($datedue);
+ my $dateduef =
+ ( 1900 + $datearr[5] ) . "-"
+ . ( $datearr[4] + 1 ) . "-"
+ . $datearr[3];
+ if ($date) {
+ $dateduef = $date;
+ }
+
+ # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
+ if ( C4::Context->preference('ReturnBeforeExpiry')
+ && $dateduef gt $borrower->{dateexpiry} )
+ {
+ $dateduef = $borrower->{dateexpiry};
+ }
+ $sth->execute(
+ $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'},
+ strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'}
+ );
+ $sth->finish;
+ $iteminformation->{'issues'}++;
+ $sth =
+ $dbh->prepare(
+ "update items set issues=?, holdingbranch=? where itemnumber=?");
+ $sth->execute(
+ $iteminformation->{'issues'},
+ C4::Context->userenv->{'branch'},
+ $iteminformation->{'itemnumber'}
+ );
+ $sth->finish;
+ &itemseen( $iteminformation->{'itemnumber'} );
+ itemborrowed( $iteminformation->{'itemnumber'} );
+
+ # If it costs to borrow this book, charge it to the patron's account.
+ my ( $charge, $itemtype ) = calc_charges(
+ $env,
+ $iteminformation->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ if ( $charge > 0 ) {
+ createcharge(
+ $env, $dbh,
+ $iteminformation->{'itemnumber'},
+ $borrower->{'borrowernumber'}, $charge
+ );
+ $iteminformation->{'charge'} = $charge;
+ }
+
+ # Record the fact that this book was issued.
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'issue', $charge,
+ '', $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
+ }
+
+ &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$iteminformation->{'biblionumber'})
+ if C4::Context->preference("IssueLog");
+
}
=head2 getLoanLength
=cut
sub getLoanLength {
- my ($borrowertype,$itemtype,$branchcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?");
- # try to find issuelength & return the 1st available.
- # check with borrowertype, itemtype and branchcode, then without one of those parameters
- $sth->execute($borrowertype,$itemtype,$branchcode);
- my $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength);
-
- $sth->execute($borrowertype,$itemtype,"");
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute($borrowertype,"*",$branchcode);
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute("*",$itemtype,$branchcode);
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute($borrowertype,"*","");
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute("*","*",$branchcode);
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute("*",$itemtype,"");
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute("*","*","");
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- # if no rule is set => 21 days (hardcoded)
- return 21;
+ my ( $borrowertype, $itemtype, $branchcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
+ );
+
+# try to find issuelength & return the 1st available.
+# check with borrowertype, itemtype and branchcode, then without one of those parameters
+ $sth->execute( $borrowertype, $itemtype, $branchcode );
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, $itemtype, "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, "*", $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", $itemtype, $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( $borrowertype, "*", "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", "*", $branchcode );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", $itemtype, "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ $sth->execute( "*", "*", "" );
+ $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+
+ # if no rule is set => 21 days (hardcoded)
+ return 21;
}
+
=head2 returnbook
- ($doreturn, $messages, $iteminformation, $borrower) =
- &returnbook($barcode, $branch);
+($doreturn, $messages, $iteminformation, $borrower) =
+ &returnbook($barcode, $branch);
Returns a book.
# is more C-ish than Perl-ish).
sub returnbook {
- my ($barcode, $branch) = @_;
- my %env;
- my $messages;
- my $dbh = C4::Context->dbh;
- my $doreturn = 1;
- die '$branch not defined' unless defined $branch; # just in case (bug 170)
- # get information on item
- my $itemrecord=XMLgetitemhash($dbh,"",$barcode);
- if (not $itemrecord) {
- $messages->{'BadBarcode'} = $barcode;
- $doreturn = 0;
- return ($doreturn, $messages, undef, undef);
- }
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
- $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber});
-
- # find the borrower
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ((not $currentborrower) && $doreturn) {
- $messages->{'NotIssued'} = $barcode;
- $doreturn = 0;
- }
- # check if the book is in a permanent collection....
- my $hbr = $iteminformation->{'homebranch'};
- my $branches = GetBranches();
- if ($branches->{$hbr}->{'PE'}) {
- $messages->{'IsPermanent'} = $hbr;
- }
- # check that the book has been cancelled
- if ($iteminformation->{'wthdrawn'}) {
- $messages->{'wthdrawn'} = 1;
- # $doreturn = 0;
- }
- # update issues, thereby returning book (should push this out into another subroutine
- my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
- if ($doreturn) {
- my $sth = $dbh->prepare("update issues set returndate = now() where (itemnumber = ?) and (returndate is null)");
- $sth->execute( $iteminformation->{'itemnumber'});
- $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
-
- $sth->finish;
- }
- $itemrecord=XML_writeline($itemrecord, "date_due", "","holdings");
- $itemrecord=XML_writeline($itemrecord, "onloan", "0","holdings");
- $itemrecord=XML_writeline($itemrecord, "borrowernumber", "","holdings");
-
- my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
- my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
- $itemrecord=XML_writeline($itemrecord, "datelastseen", $timestamp,"holdings");
-
-
- ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
- # transfer book to the current branch
-
- if ($transfered) {
- $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
- }
- # fix up the accounts.....
- if ($iteminformation->{'itemlost'}) {
- fixaccountforlostandreturned($iteminformation, $borrower);
- $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
- $itemrecord=XML_writeline($itemrecord, "itemlost", "","holdings");
- }
-####WARNING-- FIXME#########
-### The following new script is commented out
-## I did not understand what it is supposed to do.
-## If a book is returned at one branch it is automatically recorded being in that branch by
-## transferbook script. This scrip tries to find out whether it was sent thre
-## Well whether sent or not it is physically there and transferbook records this fact in MARCrecord as well
-## If this script is trying to do something else it should be uncommented and also add support for updating MARC record --TG
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
-# check if we have a transfer for this document
-# my $checktransfer = checktransferts($iteminformation->{'itemnumber'});
-# if we have a return, we update the line of transfers with the datearrived
-# if ($checktransfer){
-# my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL");
-# $sth->execute($iteminformation->{'itemnumber'});
-# $sth->finish;
-# now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W'
-# my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'});
-# }
-# if we don't have a transfer on run, we check if the document is not in his homebranch and there is not a reservation, we transfer this one to his home branch directly if system preference Automaticreturn is turn on .
-# else {
-# my $checkreserves = CheckReserves($iteminformation->{'itemnumber'});
-# if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){
-# my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'});
-# $messages->{'WasTransfered'} = 1;
-# }
-# }
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
- # fix up the overdues in accounts...
- fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- $itemrecord=XML_writeline($itemrecord, "itemoverdue", "","holdings");
- # find reserves.....
- my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
- if ($resfound) {
- # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
- $resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- }
- ##Now update the zebradb
- NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'});
- # update stats?
- # Record the fact that this book was returned.
- UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
- return ($doreturn, $messages, $iteminformation, $borrower);
+ my ( $barcode, $branch ) = @_;
+ my %env;
+ my $messages;
+ my $dbh = C4::Context->dbh;
+ my $doreturn = 1;
+ my $validTransfert = 0;
+ my $reserveDone = 0;
+
+ die '$branch not defined' unless defined $branch; # just in case (bug 170)
+ # get information on item
+ my ($iteminformation) = getiteminformation( 0, $barcode );
+
+ if ( not $iteminformation ) {
+ $messages->{'BadBarcode'} = $barcode;
+ $doreturn = 0;
+ }
+
+ # find the borrower
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
+ if ( ( not $currentborrower ) && $doreturn ) {
+ $messages->{'NotIssued'} = $barcode;
+ $doreturn = 0;
+ }
+
+ # check if the book is in a permanent collection....
+ my $hbr = $iteminformation->{'homebranch'};
+ my $branches = GetBranches();
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+
+ # check that the book has been cancelled
+ if ( $iteminformation->{'wthdrawn'} ) {
+ $messages->{'wthdrawn'} = 1;itemnumber
+ $doreturn = 0;
+ }
+
+# new op dev : if the book returned in an other branch update the holding branch
+
+# update issues, thereby returning book (should push this out into another subroutine
+ my ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
+
+# case of a return of document (deal with issues and holdingbranch)
+
+ if ($doreturn) {
+ my $sth =
+ $dbh->prepare(
+"update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"
+ );
+ $sth->execute( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
+ $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
+ }
+
+# continue to deal with returns cases, but not only if we have an issue
+
+# the holdingbranch is updated if the document is returned in an other location .
+if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
+ {
+ UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
+# reload iteminformation holdingbranch with the userenv value
+ $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
+ }
+ itemseen( $iteminformation->{'itemnumber'} );
+ ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
+
+ # fix up the accounts.....
+ if ( $iteminformation->{'itemlost'} ) {
+ fixaccountforlostandreturned( $iteminformation, $borrower );
+ $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
+ }
+
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ # check if we have a transfer for this document
+ my ($datesent,$frombranch,$tobranch) = checktransferts( $iteminformation->{'itemnumber'} );
+
+ # if we have a return, we update the line of transfers with the datearrived
+ if ($datesent) {
+ if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL"
+ );
+ $sth->execute( $iteminformation->{'itemnumber'} );
+ $sth->finish;
+# now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W'
+ SetWaitingStatus( $iteminformation->{'itemnumber'} );
+ }
+ else {
+ $messages->{'WrongTransfer'} = $tobranch;
+ $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
+ }
+ $validTransfert = 1;
+ }
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# fix up the overdues in accounts...
+ fixoverduesonreturn( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
+
+# find reserves.....
+# if we don't have a reserve with the status W, we launch the Checkreserves routine
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ($resfound) {
+
+# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ $reserveDone = 1;
+ }
+
+ # update stats?
+ # Record the fact that this book was returned.
+ UpdateStats(
+ \%env, $branch, 'return', '0', '',
+ $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'borrowernumber'}
+ );
+
+ &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$currentborrower,$iteminformation->{'biblionumber'})
+ if C4::Context->preference("ReturnLog");
+
+ #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
+ #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
+
+ if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
+ if (C4::Context->preference("AutomaticItemReturn") == 1) {
+ dotransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
+ $messages->{'WasTransfered'} = 1;
+ warn "was transfered";
+ }
+ }
+
+ return ( $doreturn, $messages, $iteminformation, $borrower );
}
=head2 fixaccountforlostandreturned
- &fixaccountforlostandreturned($iteminfo,$borrower);
+ &fixaccountforlostandreturned($iteminfo,$borrower);
Calculates the charge for a book lost and returned (Not exported & used only once)
=cut
sub fixaccountforlostandreturned {
- my ($iteminfo, $borrower) = @_;
- my %env;
- my $dbh = C4::Context->dbh;
- my $itm = $iteminfo->{'itemnumber'};
- # check for charge made for lost book
- my $sth = $dbh->prepare("select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc");
- $sth->execute($itm);
- if (my $data = $sth->fetchrow_hashref) {
- # writeoff this amount
- my $offset;
- my $amount = $data->{'amount'};
- my $acctno = $data->{'accountno'};
- my $amountleft;
- if ($data->{'amountoutstanding'} == $amount) {
- $offset = $data->{'amount'};
- $amountleft = 0;
- } else {
- $offset = $amount - $data->{'amountoutstanding'};
- $amountleft = $data->{'amountoutstanding'} - $amount;
- }
- my $usth = $dbh->prepare("update accountlines set accounttype = 'LR',amountoutstanding='0'
- where (borrowernumber = ?)
- and (itemnumber = ?) and (accountno = ?) ");
- $usth->execute($data->{'borrowernumber'},$itm,$acctno);
- $usth->finish;
- #check if any credit is left if so writeoff other accounts
- my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
- if ($amountleft < 0){
- $amountleft*=-1;
- }
- if ($amountleft > 0){
- my $msth = $dbh->prepare("select * from accountlines where (borrowernumber = ?)
- and (amountoutstanding >0) order by date");
- $msth->execute($data->{'borrowernumber'});
- # offset transactions
- my $newamtos;
- my $accdata;
- while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
- if ($accdata->{'amountoutstanding'} < $amountleft) {
- $newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
- } else {
- $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
- $amountleft = 0;
- }
- my $thisacct = $accdata->{'accountno'};
- my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
- where (borrowernumber = ?)
- and (accountno=?)");
- $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
- $usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values
- (?,?,?,?)");
- $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
- $usth->finish;
- }
- $msth->finish;
- }
- if ($amountleft > 0){
- $amountleft*=-1;
- }
- my $desc="Book Returned ".$iteminfo->{'barcode'};
- $usth = $dbh->prepare("insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values (?,?,now(),?,?,'CR',?)");
- $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
- $usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)");
- $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
- $usth->finish;
-# $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
-# $usth->execute($itm);
-# $usth->finish;
- }
- $sth->finish;
- return;
+ my ( $iteminfo, $borrower ) = @_;
+ my %env;
+ my $dbh = C4::Context->dbh;
+ my $itm = $iteminfo->{'itemnumber'};
+
+ # check for charge made for lost book
+ my $sth =
+ $dbh->prepare(
+"select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc"
+ );
+ $sth->execute($itm);
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # writeoff this amount
+ my $offset;
+ my $amount = $data->{'amount'};
+ my $acctno = $data->{'accountno'};
+ my $amountleft;
+ if ( $data->{'amountoutstanding'} == $amount ) {
+ $offset = $data->{'amount'};
+ $amountleft = 0;
+ }
+ else {
+ $offset = $amount - $data->{'amountoutstanding'};
+ $amountleft = $data->{'amountoutstanding'} - $amount;
+ }
+ my $usth = $dbh->prepare(
+ "update accountlines set accounttype = 'LR',amountoutstanding='0'
+ where (borrowernumber = ?)
+ and (itemnumber = ?) and (accountno = ?) "
+ );
+ $usth->execute( $data->{'borrowernumber'}, $itm, $acctno );
+ $usth->finish;
+
+ #check if any credit is left if so writeoff other accounts
+ my $nextaccntno =
+ getnextacctno( \%env, $data->{'borrowernumber'}, $dbh );
+ if ( $amountleft < 0 ) {
+ $amountleft *= -1;
+ }
+ if ( $amountleft > 0 ) {
+ my $msth = $dbh->prepare(
+ "select * from accountlines where (borrowernumber = ?)
+ and (amountoutstanding >0) order by date"
+ );
+ $msth->execute( $data->{'borrowernumber'} );
+
+ # offset transactions
+ my $newamtos;
+ my $accdata;
+ while ( ( $accdata = $msth->fetchrow_hashref )
+ and ( $amountleft > 0 ) )
+ {
+ if ( $accdata->{'amountoutstanding'} < $amountleft ) {
+ $newamtos = 0;
+ $amountleft -= $accdata->{'amountoutstanding'};
+ }
+ else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{'accountno'};
+ my $usth = $dbh->prepare(
+ "update accountlines set amountoutstanding= ?
+ where (borrowernumber = ?)
+ and (accountno=?)"
+ );
+ $usth->execute( $newamtos, $data->{'borrowernumber'},
+ '$thisacct' );
+ $usth->finish;
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values
+ (?,?,?,?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $accdata->{'accountno'},
+ $nextaccntno, $newamtos
+ );
+ $usth->finish;
+ }
+ $msth->finish;
+ }
+ if ( $amountleft > 0 ) {
+ $amountleft *= -1;
+ }
+ my $desc = "Book Returned " . $iteminfo->{'barcode'};
+ $usth = $dbh->prepare(
+ "insert into accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values (?,?,now(),?,?,'CR',?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $nextaccntno, 0 - $amount,
+ $desc, $amountleft
+ );
+ $usth->finish;
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values (?,?,?,?)"
+ );
+ $usth->execute( $borrower->{'borrowernumber'},
+ $data->{'accountno'}, $nextaccntno, $offset );
+ $usth->finish;
+ $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
+ $usth->execute($itm);
+ $usth->finish;
+ }
+ $sth->finish;
+ return;
}
=head2 fixoverdueonreturn
- &fixoverdueonreturn($brn,$itm);
-
-??
+ &fixoverdueonreturn($brn,$itm);
C<$brn> borrowernumber
=cut
sub fixoverduesonreturn {
- my ($brn, $itm) = @_;
- my $dbh = C4::Context->dbh;
- # check for overdue fine
- my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')");
- $sth->execute($brn,$itm);
- # alter fine to show that the book has been returned
- if (my $data = $sth->fetchrow_hashref) {
- my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)");
- $usth->execute($brn,$itm,$data->{'accountno'});
- $usth->finish();
- }
- $sth->finish();
- return;
+ my ( $brn, $itm ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # check for overdue fine
+ my $sth =
+ $dbh->prepare(
+"select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')"
+ );
+ $sth->execute( $brn, $itm );
+
+ # alter fine to show that the book has been returned
+ if ( my $data = $sth->fetchrow_hashref ) {
+ my $usth =
+ $dbh->prepare(
+"update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"
+ );
+ $usth->execute( $brn, $itm, $data->{'accountno'} );
+ $usth->finish();
+ }
+ $sth->finish();
+ return;
}
+=head2 patronflags
+
+ Not exported
+
+ NOTE!: If you change this function, be sure to update the POD for
+ &getpatroninformation.
+
+ $flags = &patronflags($env, $patron, $dbh);
+
+ $flags->{CHARGES}
+ {message} Message showing patron's credit or debt
+ {noissues} Set if patron owes >$5.00
+ {GNA} Set if patron gone w/o address
+ {message} "Borrower has no valid address"
+ {noissues} Set.
+ {LOST} Set if patron's card reported lost
+ {message} Message to this effect
+ {noissues} Set.
+ {DBARRED} Set is patron is debarred
+ {message} Message to this effect
+ {noissues} Set.
+ {NOTES} Set if patron has notes
+ {message} Notes about patron
+ {ODUES} Set if patron has overdue books
+ {message} "Yes"
+ {itemlist} ref-to-array: list of overdue books
+ {itemlisttext} Text list of overdue items
+ {WAITING} Set if there are items available that the
+ patron reserved
+ {message} Message to this effect
+ {itemlist} ref-to-array: list of available items
+
+=cut
-#
-# NOTE!: If you change this function, be sure to update the POD for
-# &getpatroninformation.
-#
-# $flags = &patronflags($env, $patron, $dbh);
-#
-# $flags->{CHARGES}
-# {message} Message showing patron's credit or debt
-# {noissues} Set if patron owes >$5.00
-# {GNA} Set if patron gone w/o address
-# {message} "Borrower has no valid address"
-# {noissues} Set.
-# {LOST} Set if patron's card reported lost
-# {message} Message to this effect
-# {noissues} Set.
-# {DBARRED} Set is patron is debarred
-# {message} Message to this effect
-# {noissues} Set.
-# {NOTES} Set if patron has notes
-# {message} Notes about patron
-# {ODUES} Set if patron has overdue books
-# {message} "Yes"
-# {itemlist} ref-to-array: list of overdue books
-# {itemlisttext} Text list of overdue items
-# {WAITING} Set if there are items available that the
-# patron reserved
-# {message} Message to this effect
-# {itemlist} ref-to-array: list of available items
sub patronflags {
-# Original subroutine for Circ2.pm
- my %flags;
- my ($env, $patroninformation, $dbh) = @_;
- my $amount = C4::Accounts2::checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
- if ($amount > 0) {
- my %flaginfo;
- my $noissuescharge = C4::Context->preference("noissuescharge");
- $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
- if ($amount > $noissuescharge) {
- $flaginfo{'noissues'} = 1;
- }
- $flags{'CHARGES'} = \%flaginfo;
- } elsif ($amount < 0){
- my %flaginfo;
- $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
- $flags{'CHARGES'} = \%flaginfo;
- }
- if ($patroninformation->{'gonenoaddress'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower has no valid address.';
- $flaginfo{'noissues'} = 1;
- $flags{'GNA'} = \%flaginfo;
- }
- if ($patroninformation->{'lost'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower\'s card reported lost.';
- $flaginfo{'noissues'} = 1;
- $flags{'LOST'} = \%flaginfo;
- }
- if ($patroninformation->{'debarred'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower is Debarred.';
- $flaginfo{'noissues'} = 1;
- $flags{'DBARRED'} = \%flaginfo;
- }
- if ($patroninformation->{'borrowernotes'}) {
- my %flaginfo;
- $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
- $flags{'NOTES'} = \%flaginfo;
- }
- my ($odues, $itemsoverdue)
- = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
- if ($odues > 0) {
- my %flaginfo;
- $flaginfo{'message'} = "Yes";
- $flaginfo{'itemlist'} = $itemsoverdue;
- foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
- $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
- }
- $flags{'ODUES'} = \%flaginfo;
- }
- my ($nowaiting, $itemswaiting)
- = CheckWaiting($patroninformation->{'borrowernumber'});
- if ($nowaiting > 0) {
- my %flaginfo;
- $flaginfo{'message'} = "Reserved items available";
- $flaginfo{'itemlist'} = $itemswaiting;
- $flags{'WAITING'} = \%flaginfo;
- }
- return(\%flags);
+
+ # Original subroutine for Circ2.pm
+ my %flags;
+ my ( $env, $patroninformation, $dbh ) = @_;
+ my $amount =
+ checkaccount( $env, $patroninformation->{'borrowernumber'}, $dbh );
+ if ( $amount > 0 ) {
+ my %flaginfo;
+ my $noissuescharge = C4::Context->preference("noissuescharge");
+ $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
+ if ( $amount > $noissuescharge ) {
+ $flaginfo{'noissues'} = 1;
+ }
+ $flags{'CHARGES'} = \%flaginfo;
+ }
+ elsif ( $amount < 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
+ $flags{'CHARGES'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'gonenoaddress'}
+ && $patroninformation->{'gonenoaddress'} == 1 )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower has no valid address.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'GNA'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower\'s card reported lost.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'LOST'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'debarred'}
+ && $patroninformation->{'debarred'} == 1 )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower is Debarred.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'DBARRED'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'borrowernotes'}
+ && $patroninformation->{'borrowernotes'} )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
+ $flags{'NOTES'} = \%flaginfo;
+ }
+ my ( $odues, $itemsoverdue ) =
+ checkoverdues( $env, $patroninformation->{'borrowernumber'}, $dbh );
+ if ( $odues > 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Yes";
+ $flaginfo{'itemlist'} = $itemsoverdue;
+ foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
+ @$itemsoverdue )
+ {
+ $flaginfo{'itemlisttext'} .=
+ "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
+ }
+ $flags{'ODUES'} = \%flaginfo;
+ }
+ my $itemswaiting =
+ C4::Reserves2::GetWaitingReserves( $patroninformation->{'borrowernumber'} );
+ my $nowaiting = scalar @$itemswaiting;
+ if ( $nowaiting > 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Reserved items available";
+ $flaginfo{'itemlist'} = $itemswaiting;
+ $flags{'WAITING'} = \%flaginfo;
+ }
+ return ( \%flags );
}
+=head2 checkoverdues
+
+( $count, $overdueitems )=checkoverdues( $env, $borrowernumber, $dbh );
+
+Not exported
+
+=cut
-# Not exported
sub checkoverdues {
+
# From Main.pm, modified to return a list of overdueitems, in addition to a count
- #checks whether a borrower has overdue items
- my ($env, $bornum, $dbh)=@_;
- my $today=get_today();
- my @overdueitems;
- my $count = 0;
- my $sth = $dbh->prepare("SELECT issues.* , i.biblionumber as biblionumber,b.* FROM issues, items i,biblio b
- WHERE i.itemnumber=issues.itemnumber
- AND i.biblionumber=b.biblionumber
- AND issues.borrowernumber = ?
- AND issues.returndate is NULL
- AND issues.date_due < ?");
- $sth->execute($bornum,$today);
- while (my $data = $sth->fetchrow_hashref) {
-
- push (@overdueitems, $data);
- $count++;
- }
- $sth->finish;
- return ($count, \@overdueitems);
+#checks whether a borrower has overdue items
+ my ( $env, $borrowernumber, $dbh ) = @_;
+ my @datearr = localtime;
+ my $today =
+ ( $datearr[5] + 1900 ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
+ my @overdueitems;
+ my $count = 0;
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues,biblio,biblioitems,items
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND issues.itemnumber = items.itemnumber
+ AND issues.borrowernumber = ?
+ AND issues.returndate is NULL
+ AND issues.date_due < ?"
+ );
+ $sth->execute( $borrowernumber, $today );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @overdueitems, $data );
+ $count++;
+ }
+ $sth->finish;
+ return ( $count, \@overdueitems );
}
-# Not exported
+=head2 currentborrower
+
+$borrower=currentborrower($itemnumber)
+
+Not exported
+
+=cut
+
sub currentborrower {
-# Original subroutine for Circ2.pm
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
-
- my $sth=$dbh->prepare("select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=? and
- issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
- NULL");
- $sth->execute($itemnumber);
- my ($borrower) = $sth->fetchrow;
- return($borrower);
+
+ # Original subroutine for Circ2.pm
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $q_itemnumber = $dbh->quote($itemnumber);
+ my $sth = $dbh->prepare(
+ "select borrowers.borrowernumber from
+ issues,borrowers where issues.itemnumber=$q_itemnumber and
+ issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
+ NULL"
+ );
+ $sth->execute;
+ my ($borrower) = $sth->fetchrow;
+ return ($borrower);
}
-# FIXME - Not exported, but used in 'updateitem.pl' anyway.
+=head2 checkreserve_to_delete
+
+( $resbor, $resrec ) = &checkreserve_to_delete($env,$dbh,$itemnum);
+
+=cut
+
sub checkreserve_to_delete {
-# Check for reserves for biblio
- my ($env,$dbh,$itemnum)=@_;
- my $resbor = "";
- my $sth = $dbh->prepare("select * from reserves,items
- where (items.itemnumber = ?)
- and (reserves.cancellationdate is NULL)
- and (items.biblionumber = reserves.biblionumber)
- and ((reserves.found = 'W')
- or (reserves.found is null))
- order by priority");
- $sth->execute($itemnum);
- my $resrec;
- my $data=$sth->fetchrow_hashref;
- while ($data && $resbor eq '') {
- $resrec=$data;
- my $const = $data->{'constrainttype'};
- if ($const eq "a") {
- $resbor = $data->{'borrowernumber'};
- } else {
- my $found = 0;
- my $csth = $dbh->prepare("select * from reserveconstraints,items
- where (borrowernumber=?)
- and reservedate=?
- and reserveconstraints.biblionumber=?
- and (items.itemnumber=? )");
- $csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum);
- if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
- if ($const eq 'o') {
- if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
- } else {
- if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
- }
- $csth->finish();
- }
- $data=$sth->fetchrow_hashref;
- }
- $sth->finish;
- return ($resbor,$resrec);
+
+ # Stolen from Main.pm
+ # Check for reserves for biblio
+ my ( $env, $dbh, $itemnum ) = @_;
+ my $resbor = "";
+ my $sth = $dbh->prepare(
+ "select * from reserves,items
+ where (items.itemnumber = ?)
+ and (reserves.cancellationdate is NULL)
+ and (items.biblionumber = reserves.biblionumber)
+ and ((reserves.found = 'W')
+ or (reserves.found is null))
+ order by priority"
+ );
+ $sth->execute($itemnum);
+ my $resrec;
+ my $data = $sth->fetchrow_hashref;
+ while ( $data && $resbor eq '' ) {
+ $resrec = $data;
+ my $const = $data->{'constrainttype'};
+ if ( $const eq "a" ) {
+ $resbor = $data->{'borrowernumber'};
+ }
+ else {
+ my $found = 0;
+ my $csth = $dbh->prepare(
+ "select * from reserveconstraints,items
+ where (borrowernumber=?)
+ and reservedate=?
+ and reserveconstraints.biblionumber=?
+ and (items.itemnumber=? and
+ items.biblioitemnumber = reserveconstraints.biblioitemnumber)"
+ );
+ $csth->execute(
+ $data->{'borrowernumber'},
+ $data->{'biblionumber'},
+ $data->{'reservedate'}, $itemnum
+ );
+ if ( my $cdata = $csth->fetchrow_hashref ) { $found = 1; }
+ if ( $const eq 'o' ) {
+ if ( $found eq 1 ) { $resbor = $data->{'borrowernumber'}; }
+ }
+ else {
+ if ( $found eq 0 ) { $resbor = $data->{'borrowernumber'}; }
+ }
+ $csth->finish();
+ }
+ $data = $sth->fetchrow_hashref;
+ }
+ $sth->finish;
+ return ( $resbor, $resrec );
}
=head2 currentissues
- $issues = ¤tissues($env, $borrower);
+$issues = ¤tissues($env, $borrower);
Returns a list of books currently on loan to a patron.
#'
sub currentissues {
-# New subroutine for Circ2.pm
- my ($env, $borrower) = @_;
- my $dbh = C4::Context->dbh;
- my %currentissues;
- my $counter=1;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my $crit='';
-
- # Figure out whether to get the books issued today, or earlier.
- # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
- # both be specified, but are mutually-exclusive. This is bogus.
- # Make this a flag. Or better yet, return everything in (reverse)
- # chronological order and let the caller figure out which books
- # were issued today.
- my $today=get_today();
- if ($env->{'todaysissues'}) {
-
- $crit=" and issues.timestamp like '$today%' ";
- }
- if ($env->{'nottodaysissues'}) {
-
- $crit=" and !(issues.timestamp like '$today%') ";
- }
- # FIXME - Does the caller really need every single field from all
- # four tables?
- my $sth=$dbh->prepare("select * from issues,items where
- borrowernumber=? and issues.itemnumber=items.itemnumber and
- returndate is null
- $crit order by issues.date_due");
- $sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
-
-
- if ($data->{'date_due'} lt $today) {
- $data->{'overdue'}=1;
- }
- my $itemnumber=$data->{'itemnumber'};
- # FIXME - Consecutive integers as hash keys? You have GOT to
- # be kidding me! Use an array, fercrissakes!
- $currentissues{$counter}=$data;
- $counter++;
- }
- $sth->finish;
- return(\%currentissues);
+ # New subroutine for Circ2.pm
+ my ( $env, $borrower ) = @_;
+ my $dbh = C4::Context->dbh;
+ my %currentissues;
+ my $counter = 1;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my $crit = '';
+
+ # Figure out whether to get the books issued today, or earlier.
+ # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
+ # both be specified, but are mutually-exclusive. This is bogus.
+ # Make this a flag. Or better yet, return everything in (reverse)
+ # chronological order and let the caller figure out which books
+ # were issued today.
+ if ( $env->{'todaysissues'} ) {
+
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime( time() );
+ my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
+ ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
+
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp = curdate();
+ $crit = " and issues.timestamp like '$today%' ";
+ }
+ if ( $env->{'nottodaysissues'} ) {
+
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime( time() );
+ my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
+ ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
+
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp < curdate();
+ $crit = " and !(issues.timestamp like '$today%') ";
+ }
+
+ # FIXME - Does the caller really need every single field from all
+ # four tables?
+ my $sth = $dbh->prepare(
+ "select * from issues,items,biblioitems,biblio where
+ borrowernumber=? and issues.itemnumber=items.itemnumber and
+ items.biblionumber=biblio.biblionumber and
+ items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
+ $crit order by issues.date_due"
+ );
+ $sth->execute($borrowernumber);
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # FIXME - The Dewey code is a string, not a number.
+ $data->{'dewey'} =~ s/0*$//;
+ ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
+
+ # FIXME - Could use
+ # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
+ # or better yet, just reuse $today which was calculated above.
+ # This function isn't going to run until midnight, is it?
+ # Alternately, use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
+ # if ($data->{'date_due'} lt $todaysdate)
+ # ...
+ # Either way, the date should be be formatted outside of the
+ # loop.
+ my @datearr = localtime( time() );
+ my $todaysdate =
+ ( 1900 + $datearr[5] )
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
+ . sprintf( "%0.2d", $datearr[3] );
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ( $datedue < $todaysdate ) {
+ $data->{'overdue'} = 1;
+ }
+ my $itemnumber = $data->{'itemnumber'};
+
+ # FIXME - Consecutive integers as hash keys? You have GOT to
+ # be kidding me! Use an array, fercrissakes!
+ $currentissues{$counter} = $data;
+ $counter++;
+ }
+ $sth->finish;
+ return ( \%currentissues );
}
=head2 getissues
- $issues = &getissues($borrowernumber);
+$issues = &getissues($borrowernumber);
Returns the set of books currently on loan to a patron.
of the Koha database.
=cut
+
#'
sub getissues {
- my ($borrower) = @_;
- my $dbh = C4::Context->dbh;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my %currentissues;
- my $bibliodata;
- my @results;
- my $todaysdate=get_today();
- my $counter = 0;
- my $select = "SELECT *
- FROM issues,items,biblio
- WHERE issues.borrowernumber = ?
- AND issues.itemnumber = items.itemnumber
- AND items.biblionumber = biblio.biblionumber
- AND issues.returndate IS NULL
- ORDER BY issues.date_due";
- # print $select;
- my $sth=$dbh->prepare($select);
- $sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
- if ($data->{'date_due'} lt $todaysdate) {
- $data->{'overdue'} = 1;
- }
- $currentissues{$counter} = $data;
- $counter++;
- }
- $sth->finish;
-
- return(\%currentissues);
+
+ # New subroutine for Circ2.pm
+ my ($borrower) = @_;
+ my $dbh = C4::Context->dbh;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my %currentissues;
+ my $select = "
+ SELECT items.*,
+ issues.timestamp AS timestamp,
+ issues.date_due AS date_due,
+ items.barcode AS barcode,
+ biblio.title AS title,
+ biblio.author AS author,
+ biblioitems.dewey AS dewey,
+ itemtypes.description AS itemtype,
+ biblioitems.subclass AS subclass,
+ biblioitems.ccode AS ccode,
+ biblioitems.isbn AS isbn,
+ biblioitems.classification AS classification
+ FROM items
+ LEFT JOIN issues ON issues.itemnumber = items.itemnumber
+ LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
+ LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
+ LEFT JOIN itemtypes ON itemtypes.itemtype = biblioitems.itemtype
+ WHERE issues.borrowernumber = ?
+ AND issues.returndate IS NULL
+ ORDER BY issues.date_due DESC
+ ";
+ my $sth = $dbh->prepare($select);
+ $sth->execute($borrowernumber);
+ my $counter = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $data->{'dewey'} =~ s/0*$//;
+ ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
+
+ # FIXME - The Dewey code is a string, not a number.
+ # FIXME - Use POSIX::strftime to get a text version of today's
+ # date. That's what it's for.
+ # FIXME - Move the date calculation outside of the loop.
+ my @datearr = localtime( time() );
+ my $todaysdate =
+ ( 1900 + $datearr[5] )
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
+ . sprintf( "%0.2d", $datearr[3] );
+
+ # FIXME - Instead of converting the due date to YYYYMMDD, just
+ # use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
+ # ...
+ # if ($date->{date_due} lt $todaysdate)
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ( $datedue < $todaysdate ) {
+ $data->{'overdue'} = 1;
+ }
+ $currentissues{$counter} = $data;
+ $counter++;
+
+ # FIXME - This is ludicrous. If you want to return an
+ # array of values, just use an array. That's what
+ # they're there for.
+ }
+ $sth->finish;
+ return ( \%currentissues );
}
-# Not exported
-sub checkwaiting {
-# check for reserves waiting
- my ($env,$dbh,$bornum)=@_;
- my @itemswaiting;
- my $sth = $dbh->prepare("select * from reserves where (borrowernumber = ?) and (reserves.found='W') and cancellationdate is NULL");
- $sth->execute($bornum);
- my $cnt=0;
- if (my $data=$sth->fetchrow_hashref) {
- $itemswaiting[$cnt] =$data;
- $cnt ++
- }
- $sth->finish;
- return ($cnt,\@itemswaiting);
+=head2 GetIssuesFromBiblio
+
+$issues = GetIssuesFromBiblio($biblionumber);
+
+this function get all issues from a biblionumber.
+
+Return:
+C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
+tables issues and the firstname,surname & cardnumber from borrowers.
+
+=cut
+
+sub GetIssuesFromBiblio {
+ my $biblionumber = shift;
+ return undef unless $biblionumber;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
+ FROM issues
+ LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
+ LEFT JOIN items ON issues.itemnumber = items.itemnumber
+ LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
+ LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
+ WHERE biblio.biblionumber = ?
+ ORDER BY issues.timestamp
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+
+ my @issues;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @issues, $data;
+ }
+ return \@issues;
}
=head2 renewstatus
- $ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber);
+$ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber);
Find out whether a borrowed item may be renewed.
=cut
sub renewstatus {
- # check renewal status
- ##If system preference "strictrenewals" is used This script will try to return $renewok=2 or $renewok=3 as error messages
- ##
- my ($env,$bornum,$itemnumber)=@_;
- my $dbh=C4::Context->dbh;
- my $renews = 1;
- my $resfound;
- my $resrec;
- my $renewokay=0; ##
- # Look in the issues table for this item, lent to this borrower,
- # and not yet returned.
-my $borrower=C4::Members::getpatroninformation($dbh,$bornum,undef);
-
- # FIXME - I think this function could be redone to use only one SQL call.
- my $sth1 = $dbh->prepare("select * from issues,items,biblio
- where (borrowernumber = ?)
- and (issues.itemnumber = ?)
- and items.biblionumber=biblio.biblionumber
- and returndate is null
- and items.itemnumber=issues.itemnumber");
- $sth1->execute($bornum,$itemnumber);
-my $data1 = $sth1->fetchrow_hashref;
- if ($data1 ) {
- # Found a matching item
- if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){
- ##privileged get renewal whatever the case may be
- if ($borrower->{'categorycode'} eq 'P'){
- $renewokay = 1;
- return $renewokay;
- }
- }
- # See if this item may be renewed.
- my $sth2 = $dbh->prepare("select renewalsallowed from itemtypes where itemtypes.itemtype=?");
- $sth2->execute($data1->{itemtype});
- if (my $data2=$sth2->fetchrow_hashref) {
- $renews = $data2->{'renewalsallowed'};
- }
- if ($renews > $data1->{'renewals'}) {
- $renewokay= 1;
- }else{
- if (C4::Context->preference("strictrenewals")){
- $renewokay=3 ;
- }
- }
- $sth2->finish;
- ($resfound, $resrec) = CheckReserves($itemnumber);
- if ($resfound) {
- if (C4::Context->preference("strictrenewals")){
- $renewokay=4;
- }else{
- $renewokay = 0;
- }
- }
- ($resfound, $resrec) = CheckReserves($itemnumber);
- if ($resfound) {
- if (C4::Context->preference("strictrenewals")){
- $renewokay=4;
- }else{
- $renewokay = 0;
- }
- }
- if (C4::Context->preference("strictrenewals")){
- ### A new system pref "allowRenewalsBefore" prevents the renewal before a set amount of days left before expiry
- ## Try to find whether book can be renewed at this date
- my $loanlength;
-
- my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore");
- my $today=get_today();
-
- # Find the issues record for this book###
- my $sth=$dbh->prepare("select SUBDATE(date_due, $allowRenewalsBefore) from issues where itemnumber=? and returndate is null");
- $sth->execute($itemnumber);
- my $startdate=$sth->fetchrow;
- $sth->finish;
-
- my $difference = DATE_diff($today,$startdate);
- if ($difference < 0) {
- $renewokay=2 ;
- }
- }##strictrenewals
- }##item found
- $sth1->finish;
- return($renewokay);
+ # check renewal status
+ my ( $env, $borrowernumber, $itemno ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $renews = 1;
+ my $renewokay = 0;
+
+ # Look in the issues table for this item, lent to this borrower,
+ # and not yet returned.
+
+ # FIXME - I think this function could be redone to use only one SQL call.
+ my $sth1 = $dbh->prepare(
+ "select * from issues
+ where (borrowernumber = ?)
+ and (itemnumber = ?)
+ and returndate is null"
+ );
+ $sth1->execute( $borrowernumber, $itemno );
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+
+ # Found a matching item
+
+ # See if this item may be renewed. This query is convoluted
+ # because it's a bit messy: given the item number, we need to find
+ # the biblioitem, which gives us the itemtype, which tells us
+ # whether it may be renewed.
+ my $sth2 = $dbh->prepare(
+ "SELECT renewalsallowed from items,biblioitems,itemtypes
+ where (items.itemnumber = ?)
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)"
+ );
+ $sth2->execute($itemno);
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $renews = $data2->{'renewalsallowed'};
+ }
+ if ( $renews && $renews > $data1->{'renewals'} ) {
+ $renewokay = 1;
+ }
+ $sth2->finish;
+ my ( $resfound, $resrec ) = CheckReserves($itemno);
+ if ($resfound) {
+ $renewokay = 0;
+ }
+ ( $resfound, $resrec ) = CheckReserves($itemno);
+ if ($resfound) {
+ $renewokay = 0;
+ }
+
+ }
+ $sth1->finish;
+ return ($renewokay);
}
=head2 renewbook
- &renewbook($env, $borrowernumber, $itemnumber, $datedue);
+&renewbook($env, $borrowernumber, $itemnumber, $datedue);
Renews a loan.
=cut
sub renewbook {
- my ($env,$bornum,$itemnumber,$datedue)=@_;
- # mark book as renewed
- my $loanlength;
-my $dbh=C4::Context->dbh;
-my $sth;
-my $iteminformation = getiteminformation($env, $itemnumber,0);
-
+ # mark book as renewed
+ my ( $env, $borrowernumber, $itemno, $datedue ) = @_;
+ my $dbh = C4::Context->dbh;
+ # If the due date wasn't specified, calculate it by adding the
+ # book's loan length to today's date.
+ if ( $datedue eq "" ) {
+
+ #debug_msg($env, "getting date");
+ my $iteminformation = getiteminformation( $itemno, 0 );
+ my $borrower = getpatroninformation( $env, $borrowernumber, 0 );
+ my $loanlength = getLoanLength(
+ $borrower->{'categorycode'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'branchcode'}
+ );
+ my ( $due_year, $due_month, $due_day ) =
+ Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
+ $datedue = "$due_year-$due_month-$due_day";
+
+ #$datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d");
+ }
-if ($datedue eq "" ) {
+ # Find the issues record for this book
+ my $sth =
+ $dbh->prepare(
+"select * from issues where borrowernumber=? and itemnumber=? and returndate is null"
+ );
+ $sth->execute( $borrowernumber, $itemno );
+ my $issuedata = $sth->fetchrow_hashref;
+ $sth->finish;
- my $borrower = C4::Members::getpatroninformation($env,$bornum,0);
- $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
-
- my $datedue=get_today();
- my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
- my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
- ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
- $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
-
- # Update the issues record to have the new due date, and a new count
- # of how many times it has been renewed.
-
- $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1
- where borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($datedue,$bornum,$itemnumber);
- $sth->finish;
+ # Update the issues record to have the new due date, and a new count
+ # of how many times it has been renewed.
+ my $renews = $issuedata->{'renewals'} + 1;
+ $sth = $dbh->prepare(
+ "update issues set date_due = ?, renewals = ?
+ where borrowernumber=? and itemnumber=? and returndate is null"
+ );
+ $sth->execute( $datedue, $renews, $borrowernumber, $itemno );
+ $sth->finish;
- ## Update items and marc record with new date -T.G
- &XMLmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue);
-
- # Log the renewal
- UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber,$iteminformation->{'itemtype'},$bornum);
-
- # Charge a new rental fee, if applicable?
- my ($charge,$type)=calc_charges($env, $itemnumber, $bornum);
- if ($charge > 0){
- my $accountno=getnextacctno($env,$bornum,$dbh);
- $sth=$dbh->prepare("Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
- values (?,?,now(),?,?,?,?,?)");
- $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $iteminformation->{'title'} $iteminformation->{'barcode'}",'Rent',$charge,$itemnumber);
- $sth->finish;
- # print $account;
- }# end of rental charge
-
- return format_date($datedue);
- }
+ # Log the renewal
+ UpdateStats( $env, $env->{'branchcode'}, 'renew', '', '', $itemno );
+
+ # Charge a new rental fee, if applicable?
+ my ( $charge, $type ) = calc_charges( $env, $itemno, $borrowernumber );
+ if ( $charge > 0 ) {
+ my $accountno = getnextacctno( $env, $borrowernumber, $dbh );
+ my $item = getiteminformation($itemno);
+ $sth = $dbh->prepare(
+"Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
+ values (?,?,now(),?,?,?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $accountno, $charge,
+ "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
+ 'Rent', $charge, $itemno );
+ $sth->finish;
+ }
-
-
+ # return();
}
+=head2 calc_charges
-
-=item calc_charges
-
- ($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
+($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
Calculate how much it would cost for a given patron to borrow a given
item, including any applicable discounts.
=cut
sub calc_charges {
- # calculate charges due
- my ($env, $itemnumber, $bornum)=@_;
- my $charge=0;
- my $dbh = C4::Context->dbh;
- my $item_type;
- my $sth= $dbh->prepare("select itemtype from biblio,items where items.biblionumber=biblio.biblionumber and itemnumber=?");
- $sth->execute($itemnumber);
- my $itemtype=$sth->fetchrow;
- $sth->finish;
-
- my $sth1= $dbh->prepare("select rentalcharge from itemtypes where itemtypes.itemtype=?");
- $sth1->execute($itemtype);
-
- $charge = $sth1->fetchrow;
- my $q2 = "select rentaldiscount from issuingrules,borrowers
- where (borrowers.borrowernumber = ?)
- and (borrowers.categorycode = issuingrules.categorycode)
- and (issuingrules.itemtype = ?)";
- my $sth2=$dbh->prepare($q2);
- $sth2->execute($bornum,$itemtype);
- if (my $data2=$sth2->fetchrow_hashref) {
- my $discount = $data2->{'rentaldiscount'};
- if ($discount eq 'NULL') {
- $discount=0;
- }
- $charge = ($charge *(100 - $discount)) / 100;
- # warn "discount is $discount";
- }
+
+ # calculate charges due
+ my ( $env, $itemno, $borrowernumber ) = @_;
+ my $charge = 0;
+ my $dbh = C4::Context->dbh;
+ my $item_type;
+
+ # Get the book's item type and rental charge (via its biblioitem).
+ my $sth1 = $dbh->prepare(
+ "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
+ where (items.itemnumber =?)
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)"
+ );
+ $sth1->execute($itemno);
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+ my $q2 = "select rentaldiscount from issuingrules,borrowers
+ where (borrowers.borrowernumber = ?)
+ and (borrowers.categorycode = issuingrules.categorycode)
+ and (issuingrules.itemtype = ?)";
+ my $sth2 = $dbh->prepare($q2);
+ $sth2->execute( $borrowernumber, $item_type );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ my $discount = $data2->{'rentaldiscount'};
+ if ( $discount eq 'NULL' ) {
+ $discount = 0;
+ }
+ $charge = ( $charge * ( 100 - $discount ) ) / 100;
+ }
$sth2->finish;
-
- $sth1->finish;
- return ($charge,$itemtype);
+ }
+
+ $sth1->finish;
+ return ( $charge, $item_type );
}
+=head2 createcharge
+&createcharge( $env, $dbh, $itemno, $borrowernumber, $charge )
+=cut
+
+# FIXME - A virtually identical function appears in
+# C4::Circulation::Issues. Pick one and stick with it.
sub createcharge {
- my ($env,$dbh,$itemnumber,$bornum,$charge) = @_;
- my $nextaccntno = getnextacctno($env,$bornum,$dbh);
- my $sth = $dbh->prepare(<<EOT);
- INSERT INTO accountlines
- (borrowernumber, itemnumber, accountno,
- date, amount, description, accounttype,
- amountoutstanding)
- VALUES (?, ?, ?,
- now(), ?, 'Rental', 'Rent',
- ?)
-EOT
- $sth->execute($bornum, $itemnumber, $nextaccntno, $charge, $charge);
+ #Stolen from Issues.pm
+ my ( $env, $dbh, $itemno, $borrowernumber, $charge ) = @_;
+ my $nextaccntno = getnextacctno( $env, $borrowernumber, $dbh );
+ my $query ="
+ INSERT INTO accountlines
+ (borrowernumber, itemnumber, accountno,
+ date, amount, description, accounttype,
+ amountoutstanding)
+ VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $borrowernumber, $itemno, $nextaccntno, $charge, $charge );
$sth->finish;
}
+=head2 find_reserves
-
-
-=item find_reserves
-
- ($status, $record) = &find_reserves($itemnumber);
+($status, $record) = &find_reserves($itemnumber);
Looks up an item in the reserves.
the fields from the reserves table of the Koha database.
=cut
+
#'
# FIXME - This API is bogus: just return the record, or undef if none
# was found.
-
+# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
+# that one looks rather different.
sub find_reserves {
- my ($itemnumber) = @_;
+
+ # Stolen from Returns.pm
+ warn "!!!!! SHOULD NOT BE HERE : Circ2::find_reserves is deprecated !!!";
+ my ($itemno) = @_;
+ my %env;
my $dbh = C4::Context->dbh;
- my ($itemdata) = getiteminformation("", $itemnumber,0);
- my $sth = $dbh->prepare("select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate");
- $sth->execute($itemdata->{'biblionumber'});
+ my ($itemdata) = getiteminformation( $itemno, 0 );
+ my $bibno = $dbh->quote( $itemdata->{'biblionumber'} );
+ my $bibitm = $dbh->quote( $itemdata->{'biblioitemnumber'} );
+ my $sth =
+ $dbh->prepare(
+"select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate"
+ );
+ $sth->execute($bibno);
my $resfound = 0;
my $resrec;
my $lastrec;
+ # print $query;
+
# FIXME - I'm not really sure what's going on here, but since we
# only want one result, wouldn't it be possible (and far more
# efficient) to do something clever in SQL that only returns one
# set of values?
-while ($resrec = $sth->fetchrow_hashref) {
- $lastrec = $resrec;
- if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemnumber) {
- $resfound = 1;
- }
- } else {
- # FIXME - Use 'elsif' to avoid unnecessary indentation.
- if ($resrec->{'constrainttype'} eq "a") {
- $resfound = 1;
- } else {
- my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? ");
- $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- if (my $conrec = $consth->fetchrow_hashref) {
- if ($resrec->{'constrainttype'} eq "o") {
- $resfound = 1;
-
- }
- }
- $consth->finish;
- }
- }
- if ($resfound) {
- my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?");
- $updsth->execute($itemnumber,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- $updsth->finish;
- last;
- }
+ while ( ( $resrec = $sth->fetchrow_hashref ) && ( not $resfound ) ) {
+
+ # FIXME - Unlike Pascal, Perl allows you to exit loops
+ # early. Take out the "&& (not $resfound)" and just
+ # use "last" at the appropriate point in the loop.
+ # (Oh, and just in passing: if you'd used "!" instead
+ # of "not", you wouldn't have needed the parentheses.)
+ $lastrec = $resrec;
+ my $brn = $dbh->quote( $resrec->{'borrowernumber'} );
+ my $rdate = $dbh->quote( $resrec->{'reservedate'} );
+ my $bibno = $dbh->quote( $resrec->{'biblionumber'} );
+ if ( $resrec->{'found'} eq "W" ) {
+ if ( $resrec->{'itemnumber'} eq $itemno ) {
+ $resfound = 1;
+ }
+ }
+ else {
+ # FIXME - Use 'elsif' to avoid unnecessary indentation.
+ if ( $resrec->{'constrainttype'} eq "a" ) {
+ $resfound = 1;
+ }
+ else {
+ my $consth =
+ $dbh->prepare(
+ "SELECT * FROM reserveconstraints
+ WHERE borrowernumber = ?
+ AND reservedate = ?
+ AND biblionumber = ?
+ AND biblioitemnumber = ?"
+ );
+ $consth->execute( $brn, $rdate, $bibno, $bibitm );
+ if ( my $conrec = $consth->fetchrow_hashref ) {
+ if ( $resrec->{'constrainttype'} eq "o" ) {
+ $resfound = 1;
+ }
+ }
+ $consth->finish;
+ }
+ }
+ if ($resfound) {
+ my $updsth =
+ $dbh->prepare(
+ "UPDATE reserves
+ SET found = 'W',
+ itemnumber = ?
+ WHERE borrowernumber = ?
+ AND reservedate = ?
+ AND biblionumber = ?"
+ );
+ $updsth->execute( $itemno, $brn, $rdate, $bibno );
+ $updsth->finish;
+
+ # FIXME - "last;" here to break out of the loop early.
+ }
}
$sth->finish;
- return ($resfound,$lastrec);
+ return ( $resfound, $lastrec );
}
+=head2 fixdate
+
+( $date, $invalidduedate ) = fixdate( $year, $month, $day );
+
+=cut
+
sub fixdate {
- my ($year, $month, $day) = @_;
+ my ( $year, $month, $day ) = @_;
my $invalidduedate;
my $date;
- if (($year eq 0) && ($month eq 0) && ($year eq 0)) {
-# $env{'datedue'}='';
- } else {
- if (($year eq 0) || ($month eq 0) || ($year eq 0)) {
- $invalidduedate=1;
- } else {
- if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) {
- $invalidduedate = 1;
- } elsif (($day > 29) && ($month == 2)) {
- $invalidduedate=1;
- } elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) {
- $invalidduedate=1;
- } else {
- $date="$year-$month-$day";
- }
- }
+ if ( $year && $month && $day ) {
+ if ( ( $year eq 0 ) && ( $month eq 0 ) && ( $year eq 0 ) ) {
+
+ # $env{'datedue'}='';
+ }
+ else {
+ if ( ( $year eq 0 ) || ( $month eq 0 ) || ( $year eq 0 ) ) {
+ $invalidduedate = 1;
+ }
+ else {
+ if (
+ ( $day > 30 )
+ && ( ( $month == 4 )
+ || ( $month == 6 )
+ || ( $month == 9 )
+ || ( $month == 11 ) )
+ )
+ {
+ $invalidduedate = 1;
+ }
+ elsif ( ( $day > 29 ) && ( $month == 2 ) ) {
+ $invalidduedate = 1;
+ }
+ elsif (
+ ( $month == 2 )
+ && ( $day > 28 )
+ && ( ( $year % 4 )
+ && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) )
+ )
+ {
+ $invalidduedate = 1;
+ }
+ else {
+ $date = "$year-$month-$day";
+ }
+ }
+ }
}
- return ($date, $invalidduedate);
+ return ( $date, $invalidduedate );
}
+=head2 get_current_return_date_of
+
+&get_current_return_date_of(@itemnumber);
+
+=cut
+
sub get_current_return_date_of {
my (@itemnumbers) = @_;
-
my $query = '
-SELECT date_due,
- itemnumber
- FROM issues
- WHERE itemnumber IN ('.join(',', @itemnumbers).') AND returndate IS NULL
-';
- return get_infos_of($query, 'itemnumber', 'date_due');
+ SELECT
+ date_due,
+ itemnumber
+ FROM issues
+ WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
+ AND returndate IS NULL
+ ';
+ return get_infos_of( $query, 'itemnumber', 'date_due' );
}
+=head2 get_transfert_infos
+
+get_transfert_infos($itemnumber);
+
+=cut
+
sub get_transfert_infos {
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $query = '
-SELECT datesent,
- frombranch,
- tobranch
- FROM branchtransfers
- WHERE itemnumber = ?
- AND datearrived IS NULL
-';
+ SELECT datesent,
+ frombranch,
+ tobranch
+ FROM branchtransfers
+ WHERE itemnumber = ?
+ AND datearrived IS NULL
+ ';
my $sth = $dbh->prepare($query);
$sth->execute($itemnumber);
-
my @row = $sth->fetchrow_array();
-
$sth->finish;
-
return @row;
}
+=head2 DeleteTransfer
+
+&DeleteTransfer($itemnumber);
+
+=cut
sub DeleteTransfer {
- my($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("DELETE FROM branchtransfers
- where itemnumber=?
- AND datearrived is null ");
- $sth->execute($itemnumber);
- $sth->finish;
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "DELETE FROM branchtransfers
+ WHERE itemnumber=?
+ AND datearrived IS NULL "
+ );
+ $sth->execute($itemnumber);
+ $sth->finish;
}
+=head2 GetTransfersFromBib
+
+@results = GetTransfersFromBib($frombranch,$tobranch);
+
+=cut
+
sub GetTransfersFromBib {
- my($frombranch,$tobranch) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT itemnumber,datesent,frombranch FROM
- branchtransfers
- where frombranch=?
- AND tobranch=?
- AND datearrived is null ");
- $sth->execute($frombranch,$tobranch);
- my @gettransfers;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $gettransfers[$i]=$data;
- $i++;
- }
- $sth->finish;
- return(@gettransfers);
+ my ( $frombranch, $tobranch ) = @_;
+ return unless ( $frombranch && $tobranch );
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT itemnumber,datesent,frombranch
+ FROM branchtransfers
+ WHERE frombranch=?
+ AND tobranch=?
+ AND datearrived IS NULL
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $frombranch, $tobranch );
+ my @gettransfers;
+ my $i = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $gettransfers[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@gettransfers);
}
+=head2 GetReservesToBranch
+
+@transreserv = GetReservesToBranch( $frombranch, $default );
+
+=cut
+
sub GetReservesToBranch {
- my($frombranch,$default) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,timestamp FROM
- reserves
- where priority='0' AND cancellationdate is null
- AND branchcode=?
- AND branchcode!=?
- AND found is null ");
- $sth->execute($frombranch,$default);
- my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
- $i++;
- }
- $sth->finish;
- return(@transreserv);
+ my ( $frombranch, $default ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT borrowernumber,reservedate,itemnumber,timestamp
+ FROM reserves
+ WHERE priority='0' AND cancellationdate is null
+ AND branchcode=?
+ AND branchcode!=?
+ AND found IS NULL "
+ );
+ $sth->execute( $frombranch, $default );
+ my @transreserv;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@transreserv);
}
+=head2 GetReservesForBranch
+
+@transreserv = GetReservesForBranch($frombranch);
+
+=cut
+
sub GetReservesForBranch {
- my($frombranch) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,waitingdate FROM
- reserves
- where priority='0' AND cancellationdate is null
- AND found='W'
- AND branchcode=? order by reservedate");
- $sth->execute($frombranch);
- my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
- $i++;
- }
- $sth->finish;
- return(@transreserv);
+ my ($frombranch) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "
+ SELECT borrowernumber,reservedate,itemnumber,waitingdate
+ FROM reserves
+ WHERE priority='0'
+ AND cancellationdate IS NULL
+ AND found='W'
+ AND branchcode=?
+ ORDER BY waitingdate" );
+ $sth->execute($frombranch);
+ my @transreserv;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@transreserv);
+}
+
+=head2 checktransferts
+
+@tranferts = checktransferts($itemnumber);
+
+=cut
+
+sub checktransferts {
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT datesent,frombranch,tobranch FROM branchtransfers
+ WHERE itemnumber = ? AND datearrived IS NULL"
+ );
+ $sth->execute($itemnumber);
+ my @tranferts = $sth->fetchrow_array;
+ $sth->finish;
+
+ return (@tranferts);
}
-sub checktransferts{
- my($itemnumber) = @_;
+=head2 CheckItemNotify
+
+Sql request to check if the document has alreday been notified
+this function is not exported, only used with GetOverduesForBranch
+
+=cut
+
+sub CheckItemNotify {
+ my ($notify_id,$notify_level,$itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT datesent,frombranch,tobranch FROM branchtransfers
- WHERE itemnumber = ? AND datearrived IS NULL");
- $sth->execute($itemnumber);
- my @tranferts = $sth->fetchrow_array;
+ my $sth = $dbh->prepare("
+ SELECT COUNT(*) FROM notifys
+ WHERE notify_id = ?
+ AND notify_level = ?
+ AND itemnumber = ? ");
+ $sth->execute($notify_id,$notify_level,$itemnumber);
+ my $notified = $sth->fetchrow;
+$sth->finish;
+return ($notified);
+}
+
+=head2 GetOverduesForBranch
+
+Sql request for display all information for branchoverdues.pl
+2 possibilities : with or without departement .
+display is filtered by branch
+
+=cut
+
+sub GetOverduesForBranch {
+ my ( $branch, $departement) = @_;
+ if ( not $departement ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT
+ borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null)
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ ");
+ $sth->execute($branch);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ return (@getoverdues);
$sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "
+ SELECT borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null )
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ? AND items.location = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ " );
+ $sth->execute( $branch, $departement);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ $sth->finish;
+ return (@getoverdues);
+ }
+}
+
+
+=head2 AddNotifyLine
+
+&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
+
+Creat a line into notify, if the method is phone, the notification_send_date is implemented to
- return (@tranferts);
+=cut
+
+sub AddNotifyLine {
+ my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
+ if ( $method eq "phone" ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ return 1;
}
+=head2 RemoveNotifyLine
-1;
-__END__
+&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
+
+Cancel a notification
+
+=cut
+
+sub RemoveNotifyLine {
+ my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "DELETE FROM notifys
+ WHERE
+ borrowernumber=?
+ AND itemnumber=?
+ AND notify_date=?"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $notify_date );
+ $sth->finish;
+ return 1;
+}
+
+=head2 AnonymiseIssueHistory
+
+$rows = AnonymiseIssueHistory($borrowernumber,$date)
+
+This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
+if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
+
+return the number of affected rows.
+
+=cut
+
+sub AnonymiseIssueHistory {
+ my $date = shift;
+ my $borrowernumber = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ UPDATE issues
+ SET borrowernumber = NULL
+ WHERE returndate < '".$date."'
+ AND borrowernumber IS NOT NULL
+ ";
+ $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
+ my $rows_affected = $dbh->do($query);
+ return $rows_affected;
+}
+
+=head2 GetItemsLost
+
+$items = GetItemsLost($where,$orderby);
+
+This function get the items lost into C<$items>.
+
+=over 2
+
+=item input:
+C<$where> is a hashref. it containts a field of the items table as key
+and the value to match as value.
+C<$orderby> is a field of the items table.
+
+=item return:
+C<$items> is a reference to an array full of hasref which keys are items' table column.
+
+=item usage in the perl script:
+
+my %where;
+$where{barcode} = 0001548;
+my $items = GetLostItems( \%where, "homebranch" );
+$template->param(itemsloop => $items);
=back
+=cut
+
+sub GetLostItems {
+ # Getting input args.
+ my $where = shift;
+ my $orderby = shift;
+ my $dbh = C4::Context->dbh;
+
+ my $query = "
+ SELECT *
+ FROM items
+ WHERE itemlost IS NOT NULL
+ AND itemlost <> 0
+ ";
+ foreach my $key (keys %$where) {
+ $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
+ }
+ $query .= " ORDER BY ".$orderby if defined $orderby;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @items;
+ while ( my $row = $sth->fetchrow_hashref ){
+ push @items, $row;
+ }
+ return \@items;
+}
+
+=head2 updateWrongTransfer
+
+$items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
+
+This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation
+
+=cut
+
+sub updateWrongTransfer {
+ my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
+ );
+ $sth->execute($FromLibrary,$itemNumber);
+ $sth->finish;
+
+# second step create a new line of branchtransfer to the right location .
+ dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
+
+#third step changing holdingbranch of item
+ UpdateHoldingbranch($FromLibrary,$itemNumber);
+}
+
+=head2 UpdateHoldingbranch
+
+$items = UpdateHoldingbranch($branch,$itmenumber);
+Simple methode for updating hodlingbranch in items BDD line
+=cut
+
+sub UpdateHoldingbranch {
+ my ( $branch,$itmenumber ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update items set holdingbranch = ? where itemnumber= ?"
+ );
+ $sth->execute($branch,$itmenumber);
+ $sth->finish;
+
+
+}
+
+1;
+
+__END__
+
=head1 AUTHOR
Koha Developement team <info@koha.org>
=cut
+
use strict;
require Exporter;
-
use C4::Context;
-use C4::Biblio;
+use Date::Calc qw/Today/;
use vars qw($VERSION @ISA @EXPORT);
+use C4::Accounts2;
+use Date::Manip qw/UnixDate/;
+use C4::Log; # logaction
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
=cut
-@ISA = qw(Exporter);
-@EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost);
+@ISA = qw(Exporter);
+@EXPORT = qw( &BorType
+ &CalcFine
+ &Getoverdues
+ &GetIssuingRules
+ &CheckAccountLineLevelInfo
+ &CheckAccountLineItemInfo
+ &CheckExistantNotifyid
+ &CheckBorrowerDebarred
+ &GetIssuesIteminfo
+ &GetNextIdNotify
+ &GetOverdueDelays
+ &GetOverduerules
+ &GetFine
+ &GetItems
+ &GetNotifyId
+ &GetNextIdNotify
+ &NumberNotifyId
+ &AmountNotify
+ &UpdateAccountLines
+ &UpdateFine
+ &UpdateBorrowerDebarred
+ &CreateItemAccountLine
+ &ReplacementCost
+ &ReplacementCost2);
=item Getoverdues
Koha database.
=cut
+
#'
-sub Getoverdues{
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from issues where date_due < now() and returndate is NULL order by borrowernumber");
- $sth->execute;
- # FIXME - Use push @results
- my $i=0;
- my @results;
- while (my $data=$sth->fetchrow_hashref){
- push @results,$data;
- $i++;
- }
- $sth->finish;
- return($i,\@results);
+sub Getoverdues {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from issues where date_due < now() and returndate is
+ NULL order by borrowernumber "
+ );
+ $sth->execute;
+
+ # FIXME - Use push @results
+ my $i = 0;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+
+ # print @results;
+ # FIXME - Bogus API.
+ return ( $i, \@results );
}
=item CalcFine
($amount, $chargename, $message) =
- &CalcFine($itemnumber, $borrowercode, $days_overdue);
+ &CalcFine($itemnumber, $borrowercode, $days_overdue);
Calculates the fine for a book.
members might get a longer grace period between the first and second
reminders that a book is overdue).
-
+The fine is calculated as follows: if it is time for the first
+reminder, the fine is the value listed for the given (branch, item type,
+borrower code) combination. If it is time for the second reminder, the
+fine is doubled. Finally, if it is time to send the account to a
+collection agency, the fine is set to 5 local monetary units (a really
+good deal for the patron if the library is in Italy). Otherwise, the
+fine is 0.
+
+Note that the way this function is currently implemented, it only
+returns a nonzero value on the notable days listed above. That is, if
+the categoryitems entry says to send a first reminder 7 days after the
+book is due, then if you call C<&CalcFine> 7 days after the book is
+due, it will give a nonzero fine. If you call C<&CalcFine> the next
+day, however, it will say that the fine is 0.
C<$itemnumber> is the book's item number.
C<$amount> is the fine owed by the patron (see above).
C<$chargename> is the chargename field from the applicable record in
-the issuingrules table, whatever that is.
+the categoryitem table, whatever that is.
C<$message> is a text message, either "First Notice", "Second Notice",
or "Final Notice".
=cut
+
#'
sub CalcFine {
- my ($itemnumber,$bortype,$difference)=@_;
- my $dbh = C4::Context->dbh;
- # Look up the issuingrules record for this book's item type and the
- # given borrwer type.
-
-
- my $sth=$dbh->prepare("Select * from items,biblio,itemtypes,issuingrules where items.itemnumber=?
- and items.biblionumber=biblio.biblionumber and
- biblio.itemtype=itemtypes.itemtype and
- issuingrules.itemtype=itemtypes.itemtype and
- issuingrules.categorycode=? ");
-# print $query;
- $sth->execute($itemnumber,$bortype);
- my $data=$sth->fetchrow_hashref;
- # FIXME - Error-checking: the item might be lost, or there
- # might not be an entry in 'issuingrules' for this item type
- # or borrower type.
- $sth->finish;
- my $amount=0;
- my $printout;
+ my ( $itemnumber, $bortype, $difference , $dues ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $data = GetIssuingRules($itemnumber,$bortype);
+ my $amount = 0;
+ my $printout;
+ my $countspecialday=&GetSpecialHolidays($dues,$itemnumber);
+ my $countrepeatableday=&GetRepeatableHolidays($dues,$itemnumber,$difference);
+ my $countalldayclosed = $countspecialday + $countrepeatableday;
+ my $daycount = $difference - $countalldayclosed;
+ my $daycounttotal = $daycount - $data->{'firstremind'};
+ if ($data->{'firstremind'} < $daycount)
+ {
+ $amount = $daycounttotal*$data->{'fine'};
+ }
+ return ( $amount, $data->{'chargename'}, $printout ,$daycounttotal ,$daycount );
+}
+
+
+=item GetSpecialHolidays
+
+&GetSpecialHolidays($date_dues,$itemnumber);
+
+return number of special days between date of the day and date due
- if ($difference > $data->{'firstremind'}){
- # Yes. Set the fine as listed.
-$amount=$data->{'fine'}* $difference;
+C<$date_dues> is the envisaged date of book return.
- $printout="First Notice";
- }
+C<$itemnumber> is the book's item number.
+
+=cut
+
+sub GetSpecialHolidays {
+my ($date_dues,$itemnumber) = @_;
+# calcul the today date
+my $today = join "-", &Today();
+
+# return the holdingbranch
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+# use sql request to find all date between date_due and today
+my $dbh = C4::Context->dbh;
+my $query=qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d')as date
+FROM `special_holidays`
+WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
+AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
+AND branchcode=?
+|;
+my @result=GetWdayFromItemnumber($itemnumber);
+my @result_date;
+my $wday;
+my $dateinsec;
+my $sth = $dbh->prepare($query);
+$sth->execute($date_dues,$today,$iteminfo->{'branchcode'});
+
+while ( my $special_date=$sth->fetchrow_hashref){
+ push (@result_date,$special_date);
+}
+
+my $specialdaycount=scalar(@result_date);
+
+ for (my $i=0;$i<scalar(@result_date);$i++){
+ $dateinsec=UnixDate($result_date[$i]->{'date'},"%o");
+ (undef,undef,undef,undef,undef,undef,$wday,undef,undef) =localtime($dateinsec);
+ for (my $j=0;$j<scalar(@result);$j++){
+ if ($wday == ($result[$j]->{'weekday'})){
+ $specialdaycount --;
+ }
+ }
+ }
- # Is it time to send out a second reminder?
- my $second=$data->{'firstremind'}+$data->{chargeperiod};
- if ($difference == $second){
-$amount=$data->{'fine'}* $difference;
+return $specialdaycount;
+}
+
+=item GetRepeatableHolidays
+
+&GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
+
+return number of day closed between date of the day and date due
- $printout="Second Notice";
- }
+C<$date_dues> is the envisaged date of book return.
- # Is it time to send the account to a collection agency?
- # FIXME -This $data->{'accountsent'} is not seemed to be set in the DB
- if ($difference == $data->{'accountsent'}){
- $amount=$data->{'fine'}* $difference;
+C<$itemnumber> is item number.
- $printout="Final Notice";
- }
- return($amount,$data->{'chargename'},$printout);
+C<$difference> numbers of between day date of the day and date due
+
+=cut
+
+sub GetRepeatableHolidays{
+my ($date_dues,$itemnumber,$difference) = @_;
+my $dateinsec=UnixDate($date_dues,"%o");
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime($dateinsec);
+my @result=GetWdayFromItemnumber($itemnumber);
+my @dayclosedcount;
+my $j;
+
+for (my $i=0;$i<scalar(@result);$i++){
+ my $k=$wday;
+
+ for ( $j=0;$j<$difference;$j++){
+ if ($result[$i]->{'weekday'} == $k)
+ {
+ push ( @dayclosedcount ,$k);
+ }
+ $k++;
+ ($k=0) if($k eq 7);
+ }
+ }
+return scalar(@dayclosedcount);
}
+
+=item GetWayFromItemnumber
+
+&Getwdayfromitemnumber($itemnumber);
+
+return the different week day from repeatable_holidays table
+
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetWdayFromItemnumber{
+my($itemnumber)=@_;
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+my @result;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT weekday
+ FROM repeatable_holidays
+ WHERE branchcode=?
+|;
+my $sth = $dbh->prepare($query);
+ # print $query;
+
+$sth->execute($iteminfo->{'branchcode'});
+while ( my $weekday=$sth->fetchrow_hashref){
+ push (@result,$weekday);
+ }
+return @result;
+}
+
+
+=item GetIssuesIteminfo
+
+&GetIssuesIteminfo($itemnumber);
+
+return all data from issues about item
+
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetIssuesIteminfo{
+my($itemnumber)=@_;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT *
+ FROM issues
+ WHERE itemnumber=?
+|;
+my $sth = $dbh->prepare($query);
+$sth->execute($itemnumber);
+my ($issuesinfo)=$sth->fetchrow_hashref;
+return $issuesinfo;
+}
+
+
=item UpdateFine
&UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
accountlines table of the Koha database.
=cut
+
#'
# FIXME - This API doesn't look right: why should the caller have to
# specify both the item number and the borrower number? A book can't
# be on loan to two different people, so the item number should be
# sufficient.
sub UpdateFine {
- my ($itemnum,$bornum,$amount,$type,$due)=@_;
- my $dbh = C4::Context->dbh;
- # FIXME - What exactly is this query supposed to do? It looks up an
- # entry in accountlines that matches the given item and borrower
- # numbers, where the description contains $due, and where the
- # account type has one of several values, but what does this _mean_?
- # Does it look up existing fines for this item?
- # FIXME - What are these various account types? ("FU", "O", "F", "M")
-
- my $sth=$dbh->prepare("Select * from accountlines where itemnumber=? and
+ my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
+ my $dbh = C4::Context->dbh;
+ # FIXME - What exactly is this query supposed to do? It looks up an
+ # entry in accountlines that matches the given item and borrower
+ # numbers, where the description contains $due, and where the
+ # account type has one of several values, but what does this _mean_?
+ # Does it look up existing fines for this item?
+ # FIXME - What are these various account types? ("FU", "O", "F", "M")
+ my $sth = $dbh->prepare(
+ "Select * from accountlines where itemnumber=? and
borrowernumber=? and (accounttype='FU' or accounttype='O' or
- accounttype='F' or accounttype='M') ");
- $sth->execute($itemnum,$bornum);
-
- if (my $data=$sth->fetchrow_hashref){
- # I think this if-clause deals with the case where we're updating
- # an existing fine.
-# print "in accounts ...";
- if ($data->{'amount'} != $amount){
-
-# print "updating";
- my $diff=$amount - $data->{'amount'};
- my $out=$data->{'amountoutstanding'}+$diff;
- my $sth2=$dbh->prepare("update accountlines set date=now(), amount=?,
+ accounttype='F' or accounttype='M') and description like ?"
+ );
+ $sth->execute( $itemnum, $borrowernumber, "%$due%" );
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+
+ # I think this if-clause deals with the case where we're updating
+ # an existing fine.
+ # print "in accounts ...";
+ if ( $data->{'amount'} != $amount ) {
+
+ # print "updating";
+ my $diff = $amount - $data->{'amount'};
+ my $out = $data->{'amountoutstanding'} + $diff;
+ my $sth2 = $dbh->prepare(
+ "update accountlines set date=now(), amount=?,
amountoutstanding=?,accounttype='FU' where
- accountid=?");
- $sth2->execute($amount,$out,$data->{'accountid'});
- $sth2->finish;
- } else {
- print "no update needed $data->{'amount'} \n";
+ borrowernumber=? and itemnumber=?
+ and (accounttype='FU' or accounttype='O') and description like ?"
+ );
+ $sth2->execute( $amount, $out, $data->{'borrowernumber'},
+ $data->{'itemnumber'}, "%$due%" );
+ $sth2->finish;
+ }
+ else {
+
+ # print "no update needed $data->{'amount'}"
+ }
}
- } else {
- # I think this else-clause deals with the case where we're adding
- # a new fine.
- my $sth4=$dbh->prepare("select title from biblio ,items where items.itemnumber=?
- and biblio.biblionumber=items.biblionumber");
- $sth4->execute($itemnum);
- my $title=$sth4->fetchrow;
- $sth4->finish;
- # print "not in account";
- my $sth3=$dbh->prepare("Select max(accountno) from accountlines");
- $sth3->execute;
- # FIXME - Make $accountno a scalar.
- my $accountno=$sth3->fetchrow;
- $sth3->finish;
- $accountno++;
- my $sth2=$dbh->prepare("Insert into accountlines
+ else {
+
+ # I think this else-clause deals with the case where we're adding
+ # a new fine.
+ my $sth4 = $dbh->prepare(
+ "select title from biblio,items where items.itemnumber=?
+ and biblio.biblionumber=items.biblionumber"
+ );
+ $sth4->execute($itemnum);
+ my $title = $sth4->fetchrow_hashref;
+ $sth4->finish;
+
+# # print "not in account";
+# my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
+# $sth3->execute;
+#
+# # FIXME - Make $accountno a scalar.
+# my @accountno = $sth3->fetchrow_array;
+# $sth3->finish;
+# $accountno[0]++;
+# begin transaction
+ my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
+ my $sth2 = $dbh->prepare(
+ "Insert into accountlines
(borrowernumber,itemnumber,date,amount,
description,accounttype,amountoutstanding,accountno) values
- (?,?,now(),?,?,'FU',?,?)");
- $sth2->execute($bornum,$itemnum,$amount,"$type $title $due",$amount,$accountno);
- $sth2->finish;
- }
- $sth->finish;
+ (?,?,now(),?,?,'FU',?,?)"
+ );
+ $sth2->execute( $borrowernumber, $itemnum, $amount,
+ "$type $title->{'title'} $due",
+ $amount, $nextaccntno);
+ $sth2->finish;
+ }
+ # logging action
+ &logaction(
+ C4::Context->userenv->{'number'},
+ "FINES",
+ $type,
+ $borrowernumber,
+ "due=".$due." amount=".$amount." itemnumber=".$itemnum
+ ) if C4::Context->preference("FinesLog");
+
+ $sth->finish;
}
-
-
=item BorType
$borrower = &BorType($borrowernumber);
category he or she belongs to.
=cut
+
#'
sub BorType {
- my ($borrowernumber)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from borrowers,categories where
+ my ($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from borrowers,categories where
borrowernumber=? and
-borrowers.categorycode=categories.categorycode");
- $sth->execute($borrowernumber);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data);
+borrowers.categorycode=categories.categorycode"
+ );
+ $sth->execute($borrowernumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
}
=item ReplacementCost
Returns the replacement cost of the item with the given item number.
=cut
+
#'
-sub ReplacementCost{
- my ($itemnumber)=@_;
+sub ReplacementCost {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("Select replacementprice from items where itemnumber=?");
+ $sth->execute($itemnum);
+
+ # FIXME - Use fetchrow_array or something.
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ( $data->{'replacementprice'} );
+}
+
+=item GetFine
+
+$data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
+
+return the total of fine
+
+C<$itemnum> is item number
+
+C<$borrowernumber> is the borrowernumber
+
+=cut
+
+
+sub GetFine {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT sum(amountoutstanding) FROM accountlines
+ where accounttype like 'F%'
+ AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'sum(amountoutstanding)'} );
+}
+
+
+
+
+=item GetIssuingRules
+
+$data = &GetIssuingRules($itemnumber,$categorycode);
+
+Looks up for all issuingrules an item info
+
+C<$itemnumber> is a reference-to-hash whose keys are all of the fields
+from the borrowers and categories tables of the Koha database. Thus,
+
+C<$categorycode> contains information about borrowers category
+
+C<$data> contains all information about both the borrower and
+category he or she belongs to.
+=cut
+
+sub GetIssuingRules {
+ my ($itemnumber,$categorycode)=@_;
+ my $dbh = C4::Context->dbh();
+ my $query=qq|SELECT *
+ FROM items,biblioitems,itemtypes,issuingrules
+ WHERE items.itemnumber=?
+ AND items.biblioitemnumber=biblioitems.biblioitemnumber
+ AND biblioitems.itemtype=itemtypes.itemtype
+ AND issuingrules.itemtype=itemtypes.itemtype
+ AND issuingrules.categorycode=?
+ AND (items.itemlost <> 1
+ OR items.itemlost is NULL)|;
+ my $sth = $dbh->prepare($query);
+ # print $query;
+ $sth->execute($itemnumber,$categorycode);
+ my ($data) = $sth->fetchrow_hashref;
+ $sth->finish;
+return ($data);
+
+}
+
+
+sub ReplacementCost2 {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT amountoutstanding
+ FROM accountlines
+ WHERE accounttype like 'L'
+ AND amountoutstanding > 0
+ AND itemnumber = ?
+ AND borrowernumber= ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'amountoutstanding'} );
+}
+
+
+=item GetNextIdNotify
+
+($result) = &GetNextIdNotify($reference);
+
+Returns the new file number
+
+C<$result> contains the next file number
+
+C<$reference> contains the beggining of file number
+
+=cut
+
+
+
+sub GetNextIdNotify {
+my ($reference)=@_;
+my $query=qq|SELECT max(notify_id)
+ FROM accountlines
+ WHERE notify_id like \"$reference%\"
+ |;
+# AND borrowernumber=?|;
+my $dbh = C4::Context->dbh;
+my $sth=$dbh->prepare($query);
+$sth->execute();
+my $result=$sth->fetchrow;
+$sth->finish;
+my $count;
+ if ($result eq '')
+ {
+ ($result=$reference."01") ;
+ }else
+ {
+ $count=substr($result,6)+1;
+
+ if($count<10){
+ ($count = "0".$count);
+ }
+ $result=$reference.$count;
+ }
+return $result;
+}
+
+
+=item AmountNotify
+
+(@notify) = &AmountNotify($borrowernumber);
+
+Returns amount for all file per borrowers
+C<@notify> array contains all file per borrowers
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub NumberNotifyId{
+ my ($borrowernumber)=@_;
+ my $dbh = C4::Context->dbh;
+ my $env;
+ my $query=qq| SELECT distinct(notify_id)
+ FROM accountlines
+ WHERE borrowernumber=?|;
+ my @notify;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ while ( my $numberofotify=$sth->fetchrow_array){
+ push (@notify,$numberofotify);
+ }
+ $sth->finish;
+
+ return (@notify);
+
+}
+
+=item AmountNotify
+
+($totalnotify) = &AmountNotify($notifyid);
+
+Returns amount for all file per borrowers
+C<$notifyid> is the file number
+
+C<$totalnotify> contains amount of a file
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub AmountNotify{
+ my ($notifyid)=@_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq| SELECT sum(amountoutstanding)
+ FROM accountlines
+ WHERE notify_id=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($notifyid);
+ my $totalnotify=$sth->fetchrow;
+ $sth->finish;
+ return ($totalnotify);
+}
+
+
+=item GetNotifyId
+
+($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
+
+Returns the file number per borrower and itemnumber
+
+C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+ sub GetNotifyId {
+ my ($borrowernumber,$itemnumber)=@_;
+ my $query=qq|SELECT notify_id
+ FROM accountlines
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber);
+ my ($notify_id)=$sth->fetchrow;
+ $sth->finish;
+ return ($notify_id);
+
+ }
+
+=item CreateItemAccountLine
+
+() = &CreateItemAccountLine($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$borrowernumber> contains the borrower number
+
+C<$date> contains the date of the day
+
+C<$amount> contains item price
+
+C<$description> contains the descritpion of accounttype
+
+C<$accounttype> contains the account type
+
+C<$amountoutstanding> contains the $amountoutstanding
+
+C<$timestamp> contains the timestamp with time and the date of the day
+
+C<$notify_id> contains the file number
+
+C<$level> contains the file level
+
+
+=cut
+
+ sub CreateItemAccountLine {
+ my ($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level)=@_;
my $dbh = C4::Context->dbh;
- my ($itemrecord)=XMLgetitem($dbh,$itemnumber);
-$itemrecord=XML_xml2hash_onerecord($itemrecord);
- my $replacementprice=XML_readline_onerecord($itemrecord,"replacementprice","holdings");
- return($replacementprice);
+ my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
+ my $query= qq|INSERT into accountlines
+ (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
+ VALUES
+ (?,?,?,?,?,?,?,?,?,?,?)|;
+
+
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$nextaccntno,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+ $sth->finish;
+ }
+
+=item UpdateAccountLines
+
+() = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$notify_id> contains the file number
+
+C<$notify_level> contains the file level
+
+C<$borrowernumber> contains the borrowernumber
+
+=cut
+
+sub UpdateAccountLines {
+my ($notify_id,$notify_level,$borrowernumber,$itemnumber)=@_;
+my $query;
+if ($notify_id eq '')
+{
+
+ $query=qq|UPDATE accountlines
+ SET notify_level=?
+ WHERE borrowernumber=? AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+}else
+{
+ $query=qq|UPDATE accountlines
+ SET notify_id=?, notify_level=?
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
}
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+
+if ($notify_id eq '')
+{
+ $sth->execute($notify_level,$borrowernumber,$itemnumber);
+}else
+{
+ $sth->execute($notify_id,$notify_level,$borrowernumber,$itemnumber);
+}
+ $sth->finish;
+
+}
+
+
+=item GetItems
+
+($items) = &GetItems($itemnumber);
+
+Returns the list of all delays from overduerules.
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+=cut
+
+sub GetItems {
+ my($itemnumber) = @_;
+ my $query=qq|SELECT *
+ FROM items
+ WHERE itemnumber=?|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($itemnumber);
+ my ($items)=$sth->fetchrow_hashref;
+ $sth->finish;
+ return($items);
+}
+
+=item GetOverdueDelays
+
+(@delays) = &GetOverdueDelays($categorycode);
+
+Returns the list of all delays from overduerules.
+
+C<@delays> it's an array contains the three delays from overduerules table
+
+C<$categorycode> contains the borrower categorycode
+
+=cut
+
+sub GetOverdueDelays {
+ my($category) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT delay1,delay2,delay3
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my (@delays)=$sth->fetchrow_array;
+ $sth->finish;
+ return(@delays);
+}
+
+=item CheckAccountLineLevelInfo
+
+($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
+
+Check and Returns the list of all overdue books.
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,and notify_level
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_level> contains the accountline level
+
+
+=cut
+
+sub CheckAccountLineLevelInfo {
+ my($borrowernumber,$itemnumber,$level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query= qq|SELECT count(*)
+ FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND notify_level=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$level);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+}
+
+=item GetOverduerules
+
+($overduerules) = &GetOverduerules($categorycode);
+
+Returns the value of borrowers (debarred or not) with notify level
+
+C<$overduerules> return value of debbraed field in overduerules table
+
+C<$category> contains the borrower categorycode
+
+C<$notify_level> contains the notify level
+=cut
+
+
+sub GetOverduerules{
+ my($category,$notify_level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred$notify_level
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my ($overduerules)=$sth->fetchrow;
+ $sth->finish;
+ return($overduerules);
+}
+
+
+=item CheckBorrowerDebarred
+
+($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
+
+Check if the borrowers is already debarred
+
+C<$debarredstatus> return 0 for not debarred and return 1 for debarred
+
+C<$borrowernumber> contains the borrower number
+
+=cut
+
+
+sub CheckBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred
+ FROM borrowers
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my ($debarredstatus)=$sth->fetchrow;
+ $sth->finish;
+ if ($debarredstatus eq '1'){
+ return(1);}
+ else{
+ return(0);
+ }
+}
+
+=item UpdateBorrowerDebarred
+
+($borrowerstatut) = &UpdateBorrowerDebarred($borrowernumber);
+
+update status of borrowers in borrowers table (field debarred)
+
+C<$borrowernumber> borrower number
+
+=cut
+
+sub UpdateBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|UPDATE borrowers
+ SET debarred='1'
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ $sth->finish;
+ return 1;
+}
+
+=item CheckExistantNotifyid
+
+ ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the notify id if exist else return 0.
+
+C<$exist> contains a notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$date_due> contains the date of item return
+
+
+=cut
+
+sub CheckExistantNotifyid {
+ my($borrowernumber,$date_due) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT notify_id FROM issues,accountlines
+ WHERE accountlines.borrowernumber =?
+ AND issues.itemnumber= accountlines.itemnumber
+ AND date_due = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$date_due);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ if ($exist eq '')
+ {
+ return(0);
+ }else
+ {
+ return($exist);
+ }
+}
+
+=item CheckAccountLineItemInfo
+
+ ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the list of all overdue items from the same file number(notify_id).
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_id> contains the file number
+
+=cut
+
+sub CheckAccountLineItemInfo {
+ my($borrowernumber,$itemnumber,$accounttype,$notify_id) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT count(*) FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND accounttype= ?
+ AND notify_id = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$accounttype,$notify_id);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+ }
+
1;
__END__
+package C4::Context;
# Copyright 2002 Katipo Communications
#
# This file is part of Koha.
# Suite 330, Boston, MA 02111-1307 USA
# $Id$
-package C4::Context;
use strict;
use DBI;
-use C4::Boolean;
+use ZOOM;
use XML::Simple;
+
+use C4::Boolean;
+
use vars qw($VERSION $AUTOLOAD),
- qw($context),
- qw(@context_stack);
+ qw($context),
+ qw(@context_stack);
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
- shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+ shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
use C4::Context("/path/to/koha.xml");
$config_value = C4::Context->config("config_variable");
+
+ $koha_preference = C4::Context->preference("preference");
+
$db_handle = C4::Context->dbh;
+
+ $Zconn = C4::Context->Zconn;
+
$stopwordhash = C4::Context->stopwords;
=head1 DESCRIPTION
# reference-to-hash with the following fields:
#
# config
-# A reference-to-hash whose keys and values are the
-# configuration variables and values specified in the config
-# file (/etc/koha.xml).
+# A reference-to-hash whose keys and values are the
+# configuration variables and values specified in the config
+# file (/etc/koha.xml).
# dbh
-# A handle to the appropriate database for this context.
+# A handle to the appropriate database for this context.
# dbh_stack
-# Used by &set_dbh and &restore_dbh to hold other database
-# handles for this context.
+# Used by &set_dbh and &restore_dbh to hold other database
+# handles for this context.
# Zconn
-# A connection object for the Zebra server
+# A connection object for the Zebra server
use constant CONFIG_FNAME => "/etc/koha.xml";
- # Default config file, if none is specified
+ # Default config file, if none is specified
-$context = undef; # Initially, no context is set
-@context_stack = (); # Initially, no saved contexts
+$context = undef; # Initially, no context is set
+@context_stack = (); # Initially, no saved contexts
-# read_config_file
-# Reads the specified Koha config file. Returns a reference-to-hash
-# whose keys are the configuration variables, and whose values are the
-# configuration values (duh).
-# Returns undef in case of error.
-#
-# Revision History:
-# 2004-08-10 A. Tarallo: Added code that checks if a variable is already
-# assigned and prints a message, otherwise create a new entry in the hash to
-# be returned.
-# Also added code that complaints if finds a line that isn't a variable
-# assignmet and skips the line.
-# Added a quick hack that makes the translation between the db_schema
-# and the DBI driver for that schema.
-#
-sub read_config_file
-{
- my $fname = shift; # Config file to read
+=item read_config_file
+
+=over 4
+
+Reads the specified Koha config file.
+
+Returns an object containing the configuration variables. The object's
+structure is a bit complex to the uninitiated ... take a look at the
+koha.xml file as well as the XML::Simple documentation for details. Or,
+here are a few examples that may give you what you need:
+
+The simple elements nested within the <config> element:
+
+ my $pass = $koha->{'config'}->{'pass'};
- my $retval = {}; # Return value: ref-to-hash holding the
- # configuration
+The <listen> elements:
-my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
+ my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
- return $koha;
+The elements nested within the <server> element:
+
+ my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
+
+Returns undef in case of error.
+
+=back
+
+=cut
+
+sub read_config_file {
+ my $fname = shift; # Config file to read
+ my $retval = {}; # Return value: ref-to-hash holding the configuration
+ my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
+ return $koha;
}
# db_scheme2dbi
# Translates the full text name of a database into de appropiate dbi name
#
-sub db_scheme2dbi
-{
- my $name = shift;
+sub db_scheme2dbi {
+ my $name = shift;
- for ($name) {
+ for ($name) {
# FIXME - Should have other databases.
- if (/mysql/i) { return("mysql"); }
- if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
- if (/oracle/i) { return("Oracle"); }
- }
- return undef; # Just in case
+ if (/mysql/i) { return("mysql"); }
+ if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
+ if (/oracle/i) { return("Oracle"); }
+ }
+ return undef; # Just in case
}
-sub import
-{
- my $package = shift;
- my $conf_fname = shift; # Config file name
- my $context;
-
- # Create a new context from the given config file name, if
- # any, then set it as the current context.
- $context = new C4::Context($conf_fname);
- return undef if !defined($context);
- $context->set_context;
+sub import {
+ my $package = shift;
+ my $conf_fname = shift; # Config file name
+ my $context;
+
+ # Create a new context from the given config file name, if
+ # any, then set it as the current context.
+ $context = new C4::Context($conf_fname);
+ return undef if !defined($context);
+ $context->set_context;
}
=item new
#'
# Revision History:
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty
-sub new
-{
- my $class = shift;
- my $conf_fname = shift; # Config file to load
- my $self = {};
-
- # check that the specified config file exists and is not empty
- undef $conf_fname unless
- (defined $conf_fname && -e $conf_fname && -s $conf_fname);
- # Figure out a good config file to load if none was specified.
- if (!defined($conf_fname))
- {
- # If the $KOHA_CONF environment variable is set, use
- # that. Otherwise, use the built-in default.
- $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
- }
- # Load the desired config file.
- $self = read_config_file($conf_fname);
- $self->{"config_file"} = $conf_fname;
-
-
-
- warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
- return undef if !defined($self->{"config"});
-
- $self->{"dbh"} = undef; # Database handle
- $self->{"Zconn"} = undef; # Zebra Connection
- $self->{"Zconnauth"} = undef; # Zebra Connection for updating
- $self->{"stopwords"} = undef; # stopwords list
- $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
- $self->{"attrfromkohafield"} = undef; # the hash with relations between koha table fields and Bib1-attributes
- $self->{"userenv"} = undef; # User env
- $self->{"activeuser"} = undef; # current active user
-
- bless $self, $class;
- return $self;
+sub new {
+ my $class = shift;
+ my $conf_fname = shift; # Config file to load
+ my $self = {};
+
+ # check that the specified config file exists and is not empty
+ undef $conf_fname unless
+ (defined $conf_fname && -e $conf_fname && -s $conf_fname);
+ # Figure out a good config file to load if none was specified.
+ if (!defined($conf_fname))
+ {
+ # If the $KOHA_CONF environment variable is set, use
+ # that. Otherwise, use the built-in default.
+ $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
+ }
+ # Load the desired config file.
+ $self = read_config_file($conf_fname);
+ $self->{"config_file"} = $conf_fname;
+
+ warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
+ return undef if !defined($self->{"config"});
+
+ $self->{"dbh"} = undef; # Database handle
+ $self->{"Zconn"} = undef; # Zebra Connections
+ $self->{"stopwords"} = undef; # stopwords list
+ $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
+ $self->{"userenv"} = undef; # User env
+ $self->{"activeuser"} = undef; # current active user
+
+ bless $self, $class;
+ return $self;
}
=item set_context
#'
sub set_context
{
- my $self = shift;
- my $new_context; # The context to set
-
- # Figure out whether this is a class or instance method call.
- #
- # We're going to make the assumption that control got here
- # through valid means, i.e., that the caller used an instance
- # or class method call, and that control got here through the
- # usual inheritance mechanisms. The caller can, of course,
- # break this assumption by playing silly buggers, but that's
- # harder to do than doing it properly, and harder to check
- # for.
- if (ref($self) eq "")
- {
- # Class method. The new context is the next argument.
- $new_context = shift;
- } else {
- # Instance method. The new context is $self.
- $new_context = $self;
- }
-
- # Save the old context, if any, on the stack
- push @context_stack, $context if defined($context);
-
- # Set the new context
- $context = $new_context;
+ my $self = shift;
+ my $new_context; # The context to set
+
+ # Figure out whether this is a class or instance method call.
+ #
+ # We're going to make the assumption that control got here
+ # through valid means, i.e., that the caller used an instance
+ # or class method call, and that control got here through the
+ # usual inheritance mechanisms. The caller can, of course,
+ # break this assumption by playing silly buggers, but that's
+ # harder to do than doing it properly, and harder to check
+ # for.
+ if (ref($self) eq "")
+ {
+ # Class method. The new context is the next argument.
+ $new_context = shift;
+ } else {
+ # Instance method. The new context is $self.
+ $new_context = $self;
+ }
+
+ # Save the old context, if any, on the stack
+ push @context_stack, $context if defined($context);
+
+ # Set the new context
+ $context = $new_context;
}
=item restore_context
#'
sub restore_context
{
- my $self = shift;
+ my $self = shift;
- if ($#context_stack < 0)
- {
- # Stack underflow.
- die "Context stack underflow";
- }
+ if ($#context_stack < 0)
+ {
+ # Stack underflow.
+ die "Context stack underflow";
+ }
- # Pop the old context and set it.
- $context = pop @context_stack;
+ # Pop the old context and set it.
+ $context = pop @context_stack;
- # FIXME - Should this return something, like maybe the context
- # that was current when this was called?
+ # FIXME - Should this return something, like maybe the context
+ # that was current when this was called?
}
=item config
#'
sub config
{
- my $self = shift;
- my $var = shift; # The config variable to return
+ my $self = shift;
+ my $var = shift; # The config variable to return
- return undef if !defined($context->{"config"});
- # Presumably $self->{config} might be
- # undefined if the config file given to &new
- # didn't exist, and the caller didn't bother
- # to check the return value.
+ return undef if !defined($context->{"config"});
+ # Presumably $self->{config} might be
+ # undefined if the config file given to &new
+ # didn't exist, and the caller didn't bother
+ # to check the return value.
- # Return the value of the requested config variable
- return $context->{"config"}->{$var};
+ # Return the value of the requested config variable
+ return $context->{"config"}->{$var};
}
-=item zebraconfig
-$serverdir=C4::Context->zebraconfig("biblioserver")->{directory};
-
-returns the zebra server specific details for different zebra servers
-similar to C4:Context->config
-=cut
sub zebraconfig
{
- my $self = shift;
- my $var = shift; # The config variable to return
+ my $self = shift;
+ my $var = shift; # The config variable to return
+
+ return undef if !defined($context->{"server"});
+ # Presumably $self->{config} might be
+ # undefined if the config file given to &new
+ # didn't exist, and the caller didn't bother
+ # to check the return value.
+
+ # Return the value of the requested config variable
+ return $context->{"server"}->{$var};
+}
+sub zebraoptions
+{
+ my $self = shift;
+ my $var = shift; # The config variable to return
+
+ return undef if !defined($context->{"serverinfo"});
+ # Presumably $self->{config} might be
+ # undefined if the config file given to &new
+ # didn't exist, and the caller didn't bother
+ # to check the return value.
- return undef if !defined($context->{"server"});
- # Return the value of the requested config variable
- return $context->{"server"}->{$var};
+ # Return the value of the requested config variable
+ return $context->{"serverinfo"}->{$var};
}
=item preference
# this function should cache the results it finds.
sub preference
{
- my $self = shift;
- my $var = shift; # The system preference to return
- my $retval; # Return value
- my $dbh = C4::Context->dbh; # Database handle
- my $sth; # Database query handle
-
- # Look up systempreferences.variable==$var
- $retval = $dbh->selectrow_array(<<EOT);
- SELECT value
- FROM systempreferences
- WHERE variable='$var'
- LIMIT 1
+ my $self = shift;
+ my $var = shift; # The system preference to return
+ my $retval; # Return value
+ my $dbh = C4::Context->dbh; # Database handle
+ if ($dbh){
+ my $sth; # Database query handle
+
+ # Look up systempreferences.variable==$var
+ $retval = $dbh->selectrow_array(<<EOT);
+ SELECT value
+ FROM systempreferences
+ WHERE variable='$var'
+ LIMIT 1
EOT
- return $retval;
+ return $retval;
+ } else {
+ return 0
+ }
}
sub boolean_preference ($) {
- my $self = shift;
- my $var = shift; # The system preference to return
- my $it = preference($self, $var);
- return defined($it)? C4::Boolean::true_p($it): undef;
+ my $self = shift;
+ my $var = shift; # The system preference to return
+ my $it = preference($self, $var);
+ return defined($it)? C4::Boolean::true_p($it): undef;
}
# AUTOLOAD
# encourage people to use it.
sub AUTOLOAD
{
- my $self = shift;
+ my $self = shift;
- $AUTOLOAD =~ s/.*:://; # Chop off the package name,
- # leaving only the function name.
- return $self->config($AUTOLOAD);
+ $AUTOLOAD =~ s/.*:://; # Chop off the package name,
+ # leaving only the function name.
+ return $self->config($AUTOLOAD);
}
=item Zconn
$Zconn = C4::Context->Zconn
-$Zconnauth = C4::Context->Zconnauth
+
Returns a connection to the Zebra database for the current
context. If no connection has yet been made, this method
creates one and connects.
+C<$self>
+
+C<$server> one of the servers defined in the koha.xml file
+
+C<$async> whether this is a asynchronous connection
+
+C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
+
+
=cut
sub Zconn {
- my $self = shift;
-my $server=shift;
-my $syntax=shift;
- my $Zconn;
- $context->{"Zconn"} = &new_Zconn($server,$syntax);
- return $context->{"Zconn"};
-
+ my $self=shift;
+ my $server=shift;
+ my $async=shift;
+ my $auth=shift;
+ my $piggyback=shift;
+ my $syntax=shift;
+ if ( defined($context->{"Zconn"}->{$server}) ) {
+ return $context->{"Zconn"}->{$server};
+
+ # No connection object or it died. Create one.
+ }else {
+ $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
+ return $context->{"Zconn"}->{$server};
+ }
}
-sub Zconnauth {
- my $self = shift;
-my $server=shift;
-my $syntax=shift;
- my $Zconnauth;
-##We destroy each connection made so create a new one
- $context->{"Zconnauth"} = &new_Zconnauth($server,$syntax);
- return $context->{"Zconnauth"};
-
-}
+=item _new_Zconn
+$context->{"Zconn"} = &_new_Zconn($server,$async);
+Internal function. Creates a new database connection from the data given in the current context and returns it.
-=item new_Zconn
+C<$server> one of the servers defined in the koha.xml file
-Internal helper function. creates a new database connection from
-the data given in the current context and returns it.
+C<$async> whether this is a asynchronous connection
-=cut
+C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
-sub new_Zconn {
-use ZOOM;
-my $server=shift;
-my $syntax=shift;
-$syntax="xml" unless $syntax;
-my $Zconn;
-my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
-my $o = new ZOOM::Options();
-$o->option(async => 1);
-$o->option(preferredRecordSyntax => $syntax); ## in case we use MARC
-$o->option(databaseName=>$context->{"config"}->{$server});
-
-my $o2= new ZOOM::Options();
-
- $Zconn=create ZOOM::Connection($o);
- $Zconn->connect($context->{"config"}->{"hostname"},$port);
-
- return $Zconn;
-}
+=cut
-## Zebra handler with write permission
-sub new_Zconnauth {
-use ZOOM;
-my $server=shift;
-my $syntax=shift;
-$syntax="xml" unless $syntax;
-my $Zconnauth;
-my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
-my $o = new ZOOM::Options();
-#$o->option(async => 1);
-$o->option(preferredRecordSyntax => $syntax);
-$o->option(user=>$context->{"config"}->{"zebrauser"});
-$o->option(password=>$context->{"config"}->{"zebrapass"});
-$o->option(databaseName=>$context->{"config"}->{$server});
- $o->option(charset=>"UTF8");
- $Zconnauth=create ZOOM::Connection($o);
-$Zconnauth->connect($context->config("hostname"),$port);
-return $Zconnauth;
+sub _new_Zconn {
+ my ($server,$async,$auth,$piggyback,$syntax) = @_;
+
+ my $tried=0; # first attempt
+ my $Zconn; # connection object
+ $server = "biblioserver" unless $server;
+ $syntax = "usmarc" unless $syntax;
+
+ my $host = $context->{'listen'}->{$server}->{'content'};
+ my $user = $context->{"serverinfo"}->{$server}->{"user"};
+ my $servername = $context->{"config"}->{$server};
+ my $password = $context->{"serverinfo"}->{$server}->{"password"};
+ warn "server:$server servername :$servername host:$host";
+ retry:
+ eval {
+ # set options
+ my $o = new ZOOM::Options();
+ $o->option(async => 1) if $async;
+ $o->option(count => $piggyback) if $piggyback;
+ $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
+ $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
+ $o->option(preferredRecordSyntax => $syntax);
+ $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
+ $o->option(user=>$user) if $auth;
+ $o->option(password=>$password) if $auth;
+ $o->option(databaseName => ($servername?$servername:"biblios"));
+
+ # create a new connection object
+ $Zconn= create ZOOM::Connection($o);
+
+ # forge to server
+ $Zconn->connect($host, 0);
+
+ # check for errors and warn
+ if ($Zconn->errcode() !=0) {
+ warn "something wrong with the connection: ". $Zconn->errmsg();
+ }
+
+ };
+# if ($@) {
+# # Koha manages the Zebra server -- this doesn't work currently for me because of permissions issues
+# # Also, I'm skeptical about whether it's the best approach
+# warn "problem with Zebra";
+# if ( C4::Context->preference("ManageZebra") ) {
+# if ($@->code==10000 && $tried==0) { ##No connection try restarting Zebra
+# $tried=1;
+# warn "trying to restart Zebra";
+# my $res=system("zebrasrv -f $ENV{'KOHA_CONF'} >/koha/log/zebra-error.log");
+# goto "retry";
+# } else {
+# warn "Error ", $@->code(), ": ", $@->message(), "\n";
+# $Zconn="error";
+# return $Zconn;
+# }
+# }
+# }
+ return $Zconn;
}
-
# _new_dbh
# Internal helper function (not a method!). This creates a new
# database connection from the data given in the current context, and
# returns it.
sub _new_dbh
{
- ##correct name for db_schme
- my $db_driver;
- if ($context->config("db_scheme")){
- $db_driver=db_scheme2dbi($context->config("db_scheme"));
- }else{
- $db_driver="mysql";
- }
-
- my $db_name = $context->config("database");
- my $db_host = $context->config("hostname");
- my $db_user = $context->config("user");
- my $db_passwd = $context->config("pass");
- my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
- $db_user, $db_passwd);
- # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
- ###DBD::Mysql 3.0.7 has an intermittent bug for dbh->do so change to dbh->prepare
- my $sth=$dbh->prepare("set NAMES 'utf8'");
- $sth->execute();
- $sth->finish;
-
- return $dbh;
+ ##correct name for db_schme
+ my $db_driver;
+ if ($context->config("db_scheme")){
+ $db_driver=db_scheme2dbi($context->config("db_scheme"));
+ }else{
+ $db_driver="mysql";
+ }
+
+ my $db_name = $context->config("database");
+ my $db_host = $context->config("hostname");
+ my $db_user = $context->config("user");
+ my $db_passwd = $context->config("pass");
+ my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
+ $db_user, $db_passwd);
+ # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
+ # this is better than modifying my.cnf (and forcing all communications to be in utf8)
+ $dbh->do("set NAMES 'utf8'") if ($dbh);
+ return $dbh;
}
=item dbh
#'
sub dbh
{
- my $self = shift;
- my $sth;
+ my $self = shift;
+ my $sth;
- if (defined($context->{"dbh"})) {
- $sth=$context->{"dbh"}->prepare("select 1");
- return $context->{"dbh"} if (defined($sth->execute));
- }
+ if (defined($context->{"dbh"})) {
+ $sth=$context->{"dbh"}->prepare("select 1");
+ return $context->{"dbh"} if (defined($sth->execute));
+ }
- # No database handle or it died . Create one.
- $context->{"dbh"} = &_new_dbh();
+ # No database handle or it died . Create one.
+ $context->{"dbh"} = &_new_dbh();
- return $context->{"dbh"};
+ return $context->{"dbh"};
}
=item new_dbh
#'
sub new_dbh
{
- my $self = shift;
+ my $self = shift;
- return &_new_dbh();
+ return &_new_dbh();
}
=item set_dbh
#'
sub set_dbh
{
- my $self = shift;
- my $new_dbh = shift;
-
- # Save the current database handle on the handle stack.
- # We assume that $new_dbh is all good: if the caller wants to
- # screw himself by passing an invalid handle, that's fine by
- # us.
- push @{$context->{"dbh_stack"}}, $context->{"dbh"};
- $context->{"dbh"} = $new_dbh;
+ my $self = shift;
+ my $new_dbh = shift;
+
+ # Save the current database handle on the handle stack.
+ # We assume that $new_dbh is all good: if the caller wants to
+ # screw himself by passing an invalid handle, that's fine by
+ # us.
+ push @{$context->{"dbh_stack"}}, $context->{"dbh"};
+ $context->{"dbh"} = $new_dbh;
}
=item restore_dbh
#'
sub restore_dbh
{
- my $self = shift;
+ my $self = shift;
- if ($#{$context->{"dbh_stack"}} < 0)
- {
- # Stack underflow
- die "DBH stack underflow";
- }
+ if ($#{$context->{"dbh_stack"}} < 0)
+ {
+ # Stack underflow
+ die "DBH stack underflow";
+ }
- # Pop the old database handle and set it.
- $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
+ # Pop the old database handle and set it.
+ $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
- # FIXME - If it is determined that restore_context should
- # return something, then this function should, too.
+ # FIXME - If it is determined that restore_context should
+ # return something, then this function should, too.
}
=item marcfromkohafield
#'
sub marcfromkohafield
{
- my $retval = {};
+ my $retval = {};
- # If the hash already exists, return it.
- return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
+ # If the hash already exists, return it.
+ return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
- # No hash. Create one.
- $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
+ # No hash. Create one.
+ $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
- return $context->{"marcfromkohafield"};
+ return $context->{"marcfromkohafield"};
}
-
# _new_marcfromkohafield
-# Internal helper function (not a method!).
+# Internal helper function (not a method!). This creates a new
+# hash with stopwords
sub _new_marcfromkohafield
{
- my $dbh = C4::Context->dbh;
- my $marcfromkohafield;
- 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 = {};
- $marcfromkohafield->{$recordtype}->{$kohafield} = [$tagfield,$tagsubfield];
- }
-
- return $marcfromkohafield;
-}
-
-
-#item attrfromkohafield
-#To use as a hash of koha to z3950 attributes
-sub _new_attrfromkohafield
-{
- my $dbh = C4::Context->dbh;
- my $attrfromkohafield;
- my $sth2 = $dbh->prepare("select kohafield,attr from koha_attr" );
- $sth2->execute;
- while (my ($kohafield,$attr) = $sth2->fetchrow) {
- my $retval = {};
- $attrfromkohafield->{$kohafield} = $attr;
- }
- return $attrfromkohafield;
+ my $dbh = C4::Context->dbh;
+ my $marcfromkohafield;
+ my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
+ $sth->execute;
+ while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
+ my $retval = {};
+ $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
+ }
+ return $marcfromkohafield;
}
-sub attrfromkohafield
-{
- my $retval = {};
-
- # If the hash already exists, return it.
- return $context->{"attrfromkohafield"} if defined($context->{"attrfromkohafield"});
- # No hash. Create one.
- $context->{"attrfromkohafield"} = &_new_attrfromkohafield();
-
- return $context->{"attrfromkohafield"};
-}
=item stopwords
$dbh = C4::Context->stopwords;
#'
sub stopwords
{
- my $retval = {};
+ my $retval = {};
- # If the hash already exists, return it.
- return $context->{"stopwords"} if defined($context->{"stopwords"});
+ # If the hash already exists, return it.
+ return $context->{"stopwords"} if defined($context->{"stopwords"});
- # No hash. Create one.
- $context->{"stopwords"} = &_new_stopwords();
+ # No hash. Create one.
+ $context->{"stopwords"} = &_new_stopwords();
- return $context->{"stopwords"};
+ return $context->{"stopwords"};
}
# _new_stopwords
# hash with stopwords
sub _new_stopwords
{
- my $dbh = C4::Context->dbh;
- my $stopwordlist;
- my $sth = $dbh->prepare("select word from stopwords");
- $sth->execute;
- while (my $stopword = $sth->fetchrow_array) {
- my $retval = {};
- $stopwordlist->{$stopword} = uc($stopword);
- }
- $stopwordlist->{A} = "A" unless $stopwordlist;
- return $stopwordlist;
+ my $dbh = C4::Context->dbh;
+ my $stopwordlist;
+ my $sth = $dbh->prepare("select word from stopwords");
+ $sth->execute;
+ while (my $stopword = $sth->fetchrow_array) {
+ my $retval = {};
+ $stopwordlist->{$stopword} = uc($stopword);
+ }
+ $stopwordlist->{A} = "A" unless $stopwordlist;
+ return $stopwordlist;
}
=item userenv
#'
sub userenv
{
- my $var = $context->{"activeuser"};
- return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
- return 0;
- warn "NO CONTEXT for $var";
+ my $var = $context->{"activeuser"};
+ return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
+ # insecure=1 management
+ if ($context->{"dbh"} && $context->preference('insecure')) {
+ my %insecure;
+ $insecure{flags} = '16382';
+ $insecure{branchname} ='Insecure',
+ $insecure{number} ='0';
+ $insecure{cardnumber} ='0';
+ $insecure{id} = 'insecure';
+ $insecure{branch} = 'INS';
+ $insecure{emailaddress} = 'test@mode.insecure.com';
+ return \%insecure;
+ } else {
+ return 0;
+ }
}
=item set_userenv
set_userenv is called in Auth.pm
=cut
+
#'
sub set_userenv{
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
- my $var=$context->{"activeuser"};
- my $cell = {
- "number" => $usernum,
- "id" => $userid,
- "cardnumber" => $usercnum,
-# "firstname" => $userfirstname,
-# "surname" => $usersurname,
+ my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
+ my $var=$context->{"activeuser"};
+ my $cell = {
+ "number" => $usernum,
+ "id" => $userid,
+ "cardnumber" => $usercnum,
+ "firstname" => $userfirstname,
+ "surname" => $usersurname,
#possibly a law problem
- "branch" => $userbranch,
- "branchname" => $branchname,
- "flags" => $userflags,
- "emailaddress" => $emailaddress,
- "branchprinter" => $branchprinter,
- };
- $context->{userenv}->{$var} = $cell;
- return $cell;
+ "branch" => $userbranch,
+ "branchname" => $branchname,
+ "flags" => $userflags,
+ "emailaddress" => $emailaddress,
+ };
+ $context->{userenv}->{$var} = $cell;
+ return $cell;
}
=item _new_userenv
#'
sub _new_userenv
{
- shift;
- my ($sessionID)= @_;
- $context->{"activeuser"}=$sessionID;
+ shift;
+ my ($sessionID)= @_;
+ $context->{"activeuser"}=$sessionID;
}
=item _unset_userenv
Destroys the hash for activeuser user environment variables.
=cut
+
#'
sub _unset_userenv
{
- my ($sessionID)= @_;
- undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
+ my ($sessionID)= @_;
+ undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
}
=head1 SEE ALSO
-DBI(3)
-
-=head1 AUTHOR
+=head1 AUTHORS
Andrew Arensburger <arensb at ooblick dot com>
+Joshua Ferraro <jmf at liblime dot com>
+
=cut
+
# $Log$
-# Revision 1.50 2006/11/06 21:01:43 tgarip1957
-# Bug fixing and complete removal of Date::Manip
+# Revision 1.51 2007/03/09 14:31:47 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.43.2.10 2007/02/09 17:17:56 hdl
+# Managing a little better database absence.
+# (preventing from BIG 550)
+#
+# Revision 1.43.2.9 2006/12/20 16:50:48 tipaul
+# improving "insecure" management
+#
+# WARNING KADOS :
+# you told me that you had some libraries with insecure=ON (behind a firewall).
+# In this commit, I created a "fake" user when insecure=ON. It has a fake branch. You may find better to have the 1st branch in branch table instead of a fake one.
+#
+# Revision 1.43.2.8 2006/12/19 16:48:16 alaurin
+# reident programs, and adding branchcode value in reserves2
+#
+# Revision 1.43.2.7 2006/12/06 21:55:38 hdl
+# Adding zebraoptions for servers to get serverinfos in Context.pm
+# Using this function in rebuild_zebra.pl
+#
+# Revision 1.43.2.6 2006/11/24 21:18:31 kados
+# very minor changes, no functional ones, just comments, etc.
+#
+# Revision 1.43.2.5 2006/10/30 13:24:16 toins
+# fix some minor POD error.
+#
+# Revision 1.43.2.4 2006/10/12 21:42:49 hdl
+# Managing multiple zebra connections
+#
+# Revision 1.43.2.3 2006/10/11 14:27:26 tipaul
+# removing a warning
+#
+# Revision 1.43.2.2 2006/10/10 15:28:16 hdl
+# BUG FIXING : using database name in Zconn if defined and not hard coded value
+#
+# Revision 1.43.2.1 2006/10/06 13:47:28 toins
+# Synch with dev_week.
+# /!\ WARNING :: Please now use the new version of koha.xml.
+#
+# Revision 1.18.2.5.2.14 2006/09/24 15:24:06 kados
+# remove Zebraauth routine, fold the functionality into Zconn
+# Zconn can now take several arguments ... this will probably
+# change soon as I'm not completely happy with the readability
+# of the current format ... see the POD for details.
+#
+# cleaning up Biblio.pm, removing unnecessary routines.
#
-# Revision 1.49 2006/10/20 01:20:56 tgarip1957
-# A new Date.pm to use for all date calculations. Mysql date calculations removed from Circ2.pm, all modules free of DateManip, a new get_today function to call in allscripts, and some bug cleaning in authorities.pm
+# DeleteBiblio - used to delete a biblio from zebra and koha tables
+# -- checks to make sure there are no existing issues
+# -- saves backups of biblio,biblioitems,items in deleted* tables
+# -- does commit operation
#
-# Revision 1.48 2006/10/01 21:48:54 tgarip1957
-# Field weighting applied to ranked searches. A new facets table in mysql db
+# getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
+# brought back z3950_extended_services routine
#
-# Revision 1.47 2006/09/27 19:53:52 tgarip1957
-# Finalizing main components. All koha modules are now working with the new XML API
+# Lots of modifications to Context.pm, you can now store user and pass info for
+# multiple servers (for federated searching) using the <serverinfo> element.
+# I'll commit my koha.xml to demonstrate this or you can refer to the POD in
+# Context.pm (which I also expanded on).
#
-# Revision 1.46 2006/09/06 16:21:03 tgarip1957
-# Clean up before final commits
+# Revision 1.18.2.5.2.13 2006/08/10 02:10:21 kados
+# Turned warnings on, and running a search turned up lots of warnings.
+# Cleaned up those ...
#
-# Revision 1.43 2006/08/10 12:49:37 toins
-# sync with dev_week.
+# removed getitemtypes from Koha.pm (one in Search.pm looks newer)
+# removed itemcount from Biblio.pm
#
-# Revision 1.42 2006/07/04 14:36:51 toins
-# Head & rel_2_2 merged
+# made some local subs local with a _ prefix (as they were redefined
+# elsewhere)
#
-# Revision 1.41 2006/05/20 14:36:09 tgarip1957
-# Typo error. Missing '>'
+# Add two new search subs to Search.pm the start of a new search API
+# that's a bit more scalable
#
-# Revision 1.40 2006/05/20 14:28:02 tgarip1957
-# Adding support to read zebra database name from config files
+# Revision 1.18.2.5.2.10 2006/07/21 17:50:51 kados
+# moving the *.properties files to intranetdir/etc dir
#
-# Revision 1.39 2006/05/19 09:52:54 alaurin
-# committing new feature ip and printer management
-# adding two fields in branches table (branchip,branchprinter)
+# Revision 1.18.2.5.2.9 2006/07/17 08:05:20 tipaul
+# there was a hardcoded link to /koha/etc/ I replaced it with intranetdir config value
#
-# branchip : if the library enter an ip or ip range any librarian that connect from computer in this ip range will be temporarly affected to the corresponding branch .
+# Revision 1.18.2.5.2.8 2006/07/11 12:20:37 kados
+# adding ccl and cql files ... Tumer, if you want to fit these into the
+# config file by all means do.
#
-# branchprinter : the library can select a default printer for a branch
+# Revision 1.18.2.5.2.7 2006/06/04 22:50:33 tgarip1957
+# We do not hard code cql2rpn conversion file in context.pm our koha.xml configuration file already describes the path for this file.
+# At cql searching we use method CQL not CQL2RPN as the cql2rpn conversion file is defined at server level
#
-# Revision 1.38 2006/05/14 00:22:31 tgarip1957
-# Adding support for getting details of different zebra servers
+# Revision 1.18.2.5.2.6 2006/06/02 23:11:24 kados
+# Committing my working dev_week. It's been tested only with
+# searching, and there's quite a lot of config stuff to set up
+# beforehand. As things get closer to a release, we'll be making
+# some scripts to do it for us
#
-# Revision 1.37 2006/05/13 19:51:39 tgarip1957
-# Now reads koha.xml rather than koha.conf.
-# koha.xml contains both the koha configuration and zebraserver configuration.
-# Zebra connection is modified to allow connection to authority zebra as well.
-# It will break head if koha.conf is not replaced with koha.xml
+# Revision 1.18.2.5.2.5 2006/05/28 18:49:12 tgarip1957
+# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
+# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
#
# Revision 1.36 2006/05/09 13:28:08 tipaul
# adding the branchname and the librarian name in every page :
-#!/usr/bin/perl
-## written by T Garip 2006-10-10 tgarip@neu.edu.tr
-# Copyright 2000-2002 Katipo Communications
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-# $Id$
+#!/usr/bin/perl -w
package C4::Date;
use strict;
use C4::Context;
-use DateTime;
-use DateTime::Format::ISO8601;
-use DateTime::Format::Strptime;
-use DateTime::Format::Duration;
-use POSIX qw(ceil floor);
+use Date::Calc qw(Parse_Date Decode_Date_EU Decode_Date_US Time_to_Date check_date);
+
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT = qw(
- &display_date_format
- &format_date
- &format_date_in_iso
- &get_date_format_string_for_DHTMLcalendar
- &DATE_diff &DATE_Add
-&get_today &DATE_Add_Duration &DATE_obj &get_duration
-&DATE_subtract
+ &display_date_format
+ &format_date
+ &format_date_in_iso
);
-sub get_date_format {
-
- #Get the database handle
- my $dbh = C4::Context->dbh;
- return C4::Context->preference('dateformat');
-}
-sub display_date_format {
- my $dateformat = get_date_format();
-
- if ( $dateformat eq "us" ) {
- return "mm/dd/yyyy";
- }
- elsif ( $dateformat eq "metric" ) {
- return "dd/mm/yyyy";
- }
- elsif ( $dateformat eq "iso" ) {
- return "yyyy-mm-dd";
- }
- else {
- return
-"Invalid date format: $dateformat. Please change in system preferences";
+sub get_date_format
+{
+ #Get the database handle
+ my $dbh = C4::Context->dbh;
+ return C4::Context->preference('dateformat');
+}
+
+sub display_date_format
+{
+ my $dateformat = get_date_format();
+
+ if ( $dateformat eq "us" )
+ {
+ return "mm/dd/yyyy";
+ }
+ elsif ( $dateformat eq "metric" )
+ {
+ return "dd/mm/yyyy";
+ }
+ elsif ( $dateformat eq "iso" )
+ {
+ return "yyyy-mm-dd";
+ }
+ else
+ {
+ return "Invalid date format: $dateformat. Please change in system preferences";
+ }
+}
+
+
+sub format_date
+{
+ my $olddate = shift;
+ my $newdate;
+
+ if ( ! $olddate )
+ {
+ return "";
+ }
+
+# warn $olddate;
+# $olddate=~s#/|\.|-##g;
+ my ($year,$month,$day)=Parse_Date($olddate);
+ ($year,$month,$day)=split /-|\/|\.|:/,$olddate unless ($year && $month);
+# warn "$olddate annee $year mois $month jour $day";
+ if ($year>0 && $month>0){
+ my $dateformat = get_date_format();
+ $dateformat="metric" if (index(":",$olddate)>0);
+ if ( $dateformat eq "us" )
+ {
+ $newdate = sprintf("%02d/%02d/%04d",$month,$day,$year);
+ }
+ elsif ( $dateformat eq "metric" )
+ {
+ $newdate = sprintf("%02d/%02d/%04d",$day,$month,$year);
+ }
+ elsif ( $dateformat eq "iso" )
+ {
+ # Date_Init("DateFormat=iso");
+ $newdate = sprintf("%04d-%02d-%02d",$year,$month,$day);
+ }
+ else
+ {
+ return "Invalid date format: $dateformat. Please change in system preferences";
+ }
+# warn "newdate :$newdate";
}
+ return $newdate;
}
-sub get_date_format_string_for_DHTMLcalendar {
- my $dateformat = get_date_format();
-
- if ( $dateformat eq 'us' ) {
- return '%m/%d/%Y';
- }
- elsif ( $dateformat eq 'metric' ) {
- return '%d/%m/%Y';
- }
- elsif ( $dateformat eq "iso" ) {
- return '%Y-%m-%d';
- }
- else {
- return 'Invalid date format: '
- . $dateformat . '.'
- . ' Please change in system preferences';
- }
-}
-
-sub format_date {
+sub format_date_in_iso
+{
my $olddate = shift;
my $newdate;
- if ( !$olddate || $olddate eq "0000-00-00" ) {
- return "";
- }
- $olddate=~s/-//g;
- my $olddate=substr($olddate,0,8);
- my $dateformat = get_date_format();
-eval{$newdate =DateTime::Format::ISO8601->parse_datetime($olddate);};
-if ($@ || !$newdate){
-##MARC21 tag 008 has this format YYMMDD
-my $parser = DateTime::Format::Strptime->new( pattern => '%y%m%d' );
- $newdate =$parser->parse_datetime($olddate);
-}
-if (!$newdate){
-return ""; #### some script call format_date more than once --FIX scripts
-}
- if ( $dateformat eq "us" ) {
- return $newdate->mdy('/');
-
- }
- elsif ( $dateformat eq "metric" ) {
- return $newdate->dmy('/');
- }
- elsif ( $dateformat eq "iso" ) {
- return $newdate->ymd;
+ if ( ! $olddate )
+ {
+ return "";
}
- else {
- return
-"Invalid date format: $dateformat. Please change in system preferences";
+ if (check_whether_iso($olddate)){
+ return $olddate;
+ } else {
+ my $dateformat = get_date_format();
+ my ($year,$month,$day);
+ my @date;
+ my $tmpolddate=$olddate;
+ $tmpolddate=~s#/|\.|-|\\##g;
+ $dateformat="metric" if (index(":",$olddate)>0);
+ if ( $dateformat eq "us" )
+ {
+ ($month,$day,$year)=split /-|\/|\.|:/,$olddate unless ($year && $month);
+ if ($month>0 && $day >0){
+ @date = Decode_Date_US($tmpolddate);
+ } else {
+ @date=($year, $month,$day)
+ }
+ }
+ elsif ( $dateformat eq "metric" )
+ {
+ ($day,$month,$year)=split /-|\/|\.|:/,$olddate unless ($year && $month);
+ if ($month>0 && $day >0){
+ @date = Decode_Date_EU($tmpolddate);
+ } else {
+ @date=($year, $month,$day)
+ }
+ }
+ elsif ( $dateformat eq "iso" )
+ {
+ ($year,$month,$day)=split /-|\/|\.|:/,$olddate unless ($year && $month);
+ if ($month>0 && $day >0){
+ @date=($year, $month,$day) if (check_date($year,$month,$day));
+ } else {
+ @date=($year, $month,$day)
+ }
+ }
+ else
+ {
+ return "9999-99-99";
+ }
+ $newdate = sprintf("%04d-%02d-%02d",$date[0],$date[1],$date[2]);
+ return $newdate;
}
-
}
-sub format_date_in_iso {
+sub check_whether_iso
+{
my $olddate = shift;
- my $newdate;
- my $parser;
- if ( !$olddate || $olddate eq "0000-00-00" ) {
- return "";
- }
-
-$parser = DateTime::Format::Strptime->new( pattern => '%d/%m/%Y' );
- $newdate =$parser->parse_datetime($olddate);
-if (!$newdate){
-$parser = DateTime::Format::Strptime->new( pattern => '%m/%d/%Y' );
-$newdate =$parser->parse_datetime($olddate);
-}
-if (!$newdate){
- $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' );
-$newdate =$parser->parse_datetime($olddate);
-}
- if (!$newdate){
- $parser = DateTime::Format::Strptime->new( pattern => '%y-%m-%d' );
-$newdate =$parser->parse_datetime($olddate);
-}
-
- return $newdate->ymd if $newdate;
-}
-sub DATE_diff {
-## returns 1 if date1>date2 0 if date1==date2 -1 if date1<date2
-my ($date1,$date2)=@_;
-my $dt1=DateTime::Format::ISO8601->parse_datetime($date1);
-my $dt2=DateTime::Format::ISO8601->parse_datetime($date2);
-my $diff=DateTime->compare( $dt1, $dt2 );
-return $diff;
-}
-sub DATE_Add {
-## $amount in days
-my ($date,$amount)=@_;
-my $dt1=DateTime::Format::ISO8601->parse_datetime($date);
-$dt1->add( days=>$amount );
-return $dt1->ymd;
-}
-sub DATE_Add_Duration {
-## Similar as above but uses Duration object as amount --used heavily in serials
-my ($date,$amount)=@_;
-my $dt1=DateTime::Format::ISO8601->parse_datetime($date);
-$dt1->add_duration($amount) ;
-return $dt1->ymd;
-}
-sub get_today{
-my $dt=DateTime->today;
-return $dt->ymd;
-}
-
-sub DATE_obj{
-# only send iso dates to this
-my $date=shift;
- my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' );
- my $newdate =$parser->parse_datetime($date);
-return $newdate;
-}
-sub get_duration{
-my $period=shift;
-
-my $parse;
-if ($period=~/ays/){
-$parse="\%e days";
-}elsif ($period=~/week/){
-$parse="\%W weeks";
-}elsif ($period=~/year/){
-$parse="\%Y years";
-}elsif ($period=~/onth/){
-$parse="\%m months";
-}
-
-my $parser=DateTime::Format::Duration->new(pattern => $parse );
- my $duration=$parser->parse_duration($period);
-
-return $duration;
-
-}
-sub DATE_subtract{
-my ($date1,$date2)=@_;
-my $dt1=DateTime::Format::ISO8601->parse_datetime($date1);
-my $dt2=DateTime::Format::ISO8601->parse_datetime($date2);
-my $dur=$dt2->subtract_datetime_absolute($dt1);## in seconds
-my $days=$dur->seconds/(60*60*24);
-return floor($days);
+ my @olddate= split /\-/,$olddate ;
+ return 1 if (length($olddate[0])==4 && length($olddate[1])<=2 && length($olddate[2])<=2);
+ return 0;
}
1;
use strict;
require Exporter;
use C4::Context;
+use CGI;
use vars qw($VERSION @ISA @EXPORT);
if ($sth->rows>0){
my @values;
my %labels;
- for (my $i =0;$i<=$sth->rows;$i++){
+
+ for (my $i =0;$i<$sth->rows;$i++){
my $results = $sth->fetchrow_hashref;
push @values, $results->{authorised_value};
$labels{$results->{authorised_value}}=$results->{lib};
}
- $CGISort= CGI::scrolling_list(
+ unshift(@values,"");
+ $CGISort= CGI::scrolling_list(
-name => $input_name,
-values => \@values,
-labels => \%labels,
use strict;
require Exporter;
use C4::Context;
-use C4::Biblio;
-use CGI;
+use C4::Output;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &subfield_is_koha_internal_p
- &GetBranches &getbranch &getbranchdetail
- &getprinters &getprinter
- &GetItemTypes &getitemtypeinfo &ItemType
- get_itemtypeinfos_of
- &getframeworks &getframeworkinfo
- &getauthtypes &getauthtype
- &getallthemes &getalllanguages
- &GetallBranches &getletters
- &getbranchname
- getnbpages
- getitemtypeimagedir
- getitemtypeimagesrc
- getitemtypeimagesrcfromurl
- &getcities
- &getroadtypes
- get_branchinfos_of
- get_notforloan_label_of
- get_infos_of
- &getFacets
-
- $DEBUG);
-
-use vars qw();
+ &slashifyDate
+ &DisplayISBN
+ &subfield_is_koha_internal_p
+ &GetPrinters &GetPrinter
+ &GetItemTypes &getitemtypeinfo
+ &GetCcodes
+ &GetAuthItemlost
+ &GetAuthItembinding
+ &get_itemtypeinfos_of
+ &getframeworks &getframeworkinfo
+ &getauthtypes &getauthtype
+ &getallthemes
+ &getFacets
+ &displaySortby
+ &displayIndexes
+ &displaySubtypesLimit
+ &displayLimitTypes
+ &displayServers
+ &getnbpages
+ &getitemtypeimagesrcfromurl
+ &get_infos_of
+ &get_notforloan_label_of
+ &GetDepartements
+ &GetDepartementLib
+ &getitemtypeimagedir
+ &getitemtypeimagesrc
+ &GetAuthorisedValues
+ &FixEncoding
+ &GetKohaAuthorisedValues
+ $DEBUG
+ );
my $DEBUG = 0;
-# FIXME.. this should be moved to a MARC-specific module
-sub subfield_is_koha_internal_p ($) {
- my($subfield) = @_;
-
- # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
- # But real MARC subfields are always single-character
- # so it really is safer just to check the length
-
- return length $subfield != 1;
-}
+=head2 slashifyDate
-=head2 GetBranches
+ $slash_date = &slashifyDate($dash_date);
- $branches = &GetBranches();
- returns informations about branches.
- Create a branch selector with the following code
- Is branchIndependant sensitive
- When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
-
-=head3 in PERL SCRIPT
-
-my $branches = GetBranches;
-my @branchloop;
-foreach my $thisbranch (sort 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>
+Takes a string of the form "DD-MM-YYYY" (or anything separated by
+dashes), converts it to the form "YYYY/MM/DD", and returns the result.
=cut
-sub GetBranches {
-# returns a reference to a hash of references to branches...
- my ($type) = @_;
- my %branches;
- my $branch;
- my $dbh = C4::Context->dbh;
- my $sth;
- if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
- my $strsth ="Select * from branches ";
- $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
- $strsth.= " order by branchname";
- $sth=$dbh->prepare($strsth);
- } else {
- $sth = $dbh->prepare("Select * from branches order by branchname");
- }
- $sth->execute;
- while ($branch=$sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- if ($type){
- $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ? and categorycode = ?");
- $nsth->execute($branch->{'branchcode'},$type);
- } else {
- $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;
-}
- return (\%branches);
-}
+sub slashifyDate {
-sub getbranchname {
- my ($branchcode)=@_;
- my $dbh = C4::Context->dbh;
- my $sth;
- $sth = $dbh->prepare("Select branchname from branches where branchcode=?");
- $sth->execute($branchcode);
- my $branchname = $sth->fetchrow_array;
- $sth->finish;
-
- return($branchname);
+ # accepts a date of the form xx-xx-xx[xx] and returns it in the
+ # form xx/xx/xx[xx]
+ my @dateOut = split( '-', shift );
+ return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
}
-=head2 getallbranches
- @branches = &GetallBranches();
- returns informations about ALL branches.
- Create a branch selector with the following code
- IndependantBranches Insensitive...
-
+=head2 DisplayISBN
-=cut
+my $string = DisplayISBN( $isbn );
+=cut
-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) {
- push @branches,$branch;
+sub DisplayISBN {
+ my ($isbn) = @_;
+ my $seg1;
+ if ( substr( $isbn, 0, 1 ) <= 7 ) {
+ $seg1 = substr( $isbn, 0, 1 );
}
- return (@branches);
-}
-
-=head2 getletters
-
- $letters = &getletters($category);
- returns informations about letters.
- if needed, $category filters for letters given category
- Create a letter selector with the following code
-
-=head3 in PERL SCRIPT
+ elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
+ $seg1 = substr( $isbn, 0, 2 );
+ }
+ elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
+ $seg1 = substr( $isbn, 0, 3 );
+ }
+ elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
+ $seg1 = substr( $isbn, 0, 4 );
+ }
+ else {
+ $seg1 = substr( $isbn, 0, 5 );
+ }
+ my $x = substr( $isbn, length($seg1) );
+ my $seg2;
+ if ( substr( $x, 0, 2 ) <= 19 ) {
-my $letters = getletters($cat);
-my @letterloop;
-foreach my $thisletter (keys %$letters) {
- my $selected = 1 if $thisletter eq $letter;
- my %row =(value => $thisletter,
- selected => $selected,
- lettername => $letters->{$thisletter},
- );
- push @letterloop, \%row;
+ # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+ $seg2 = substr( $x, 0, 2 );
+ }
+ elsif ( substr( $x, 0, 3 ) <= 699 ) {
+ $seg2 = substr( $x, 0, 3 );
+ }
+ elsif ( substr( $x, 0, 4 ) <= 8399 ) {
+ $seg2 = substr( $x, 0, 4 );
+ }
+ elsif ( substr( $x, 0, 5 ) <= 89999 ) {
+ $seg2 = substr( $x, 0, 5 );
+ }
+ elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
+ $seg2 = substr( $x, 0, 6 );
+ }
+ else {
+ $seg2 = substr( $x, 0, 7 );
+ }
+ my $seg3 = substr( $x, length($seg2) );
+ $seg3 = substr( $seg3, 0, length($seg3) - 1 );
+ my $seg4 = substr( $x, -1, 1 );
+ return "$seg1-$seg2-$seg3-$seg4";
}
+# FIXME.. this should be moved to a MARC-specific module
+sub subfield_is_koha_internal_p ($) {
+ my ($subfield) = @_;
-=head3 in TEMPLATE
- <select name="letter">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="letterloop" -->
- <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
- <!-- /TMPL_LOOP -->
- </select>
-
-=cut
+ # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
+ # But real MARC subfields are always single-character
+ # so it really is safer just to check the length
-sub getletters {
-# returns a reference to a hash of references to ALL letters...
- my $cat =@_;
- my %letters;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($cat ne ""){
- $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
- } else {
- $sth = $dbh->prepare("Select * from letter order by name");
- }
- $sth->execute;
- my $count;
- while (my $letter=$sth->fetchrow_hashref) {
- $letters{$letter->{'code'}}=$letter->{'name'};
- $count++;
- }
- return ($count,\%letters);
+ return length $subfield != 1;
}
=head2 GetItemTypes
=cut
sub GetItemTypes {
-# returns a reference to a hash of references to branches...
+
+ # returns a reference to a hash of references to branches...
my %itemtypes;
- my $dbh = C4::Context->dbh;
+ my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM itemtypes
|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'itemtype'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'itemtype'} } = $IT;
}
- return (\%itemtypes);
+ return ( \%itemtypes );
}
-# FIXME this function is better and should replace GetItemTypes everywhere
sub get_itemtypeinfos_of {
my @itemtypes = @_;
description,
notforloan
FROM itemtypes
- WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
+ WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
';
- return get_infos_of($query, 'itemtype');
+ return get_infos_of( $query, 'itemtype' );
}
-sub ItemType {
- my ($type)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select description from itemtypes where itemtype=?");
- $sth->execute($type);
- my $dat=$sth->fetchrow_hashref;
- $sth->finish;
- return ($dat->{'description'});
+# this is temporary until we separate collection codes and item types
+sub GetCcodes {
+ my $count = 0;
+ my @results;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
+ $sth->execute;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "CCODE" ) {
+ $count++;
+ $results[$count] = $data;
+
+ #warn "data: $data";
+ }
+ }
+ $sth->finish;
+ return ( $count, @results );
+}
+
+=head2
+
+grab itemlost authorized values
+
+=cut
+
+sub GetAuthItemlost {
+ my $itemlost = shift;
+ my $count = 0;
+ my @results;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
+ $sth->execute;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "ITEMLOST" ) {
+ $count++;
+ if ( $itemlost eq $data->{'authorised_value'} ) {
+ $data->{'selected'} = 1;
+ }
+ $results[$count] = $data;
+
+ #warn "data: $data";
+ }
+ }
+ $sth->finish;
+ return ( $count, @results );
}
+
+=head2 GetAuthItembinding
+
+grab itemlost authorized values
+
+=cut
+
+sub GetAuthItembinding {
+ my $itembinding = shift;
+ my $count = 0;
+ my @results;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
+ $sth->execute;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "BINDING" ) {
+ $count++;
+ if ( $itembinding eq $data->{'authorised_value'} ) {
+ $data->{'selected'} = 1;
+ }
+ $results[$count] = $data;
+
+ #warn "data: $data";
+ }
+ }
+ $sth->finish;
+ return ( $count, @results );
+}
+
=head2 getauthtypes
$authtypes = &getauthtypes();
=cut
sub getauthtypes {
-# returns a reference to a hash of references to authtypes...
+
+ # returns a reference to a hash of references to authtypes...
my %authtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
+ my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $authtypes{$IT->{'authtypecode'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $authtypes{ $IT->{'authtypecode'} } = $IT;
}
- return (\%authtypes);
+ return ( \%authtypes );
}
sub getauthtype {
my ($authtypecode) = @_;
-# returns a reference to a hash of references to authtypes...
+
+ # returns a reference to a hash of references to authtypes...
my %authtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
$sth->execute($authtypecode);
- my $res=$sth->fetchrow_hashref;
+ my $res = $sth->fetchrow_hashref;
return $res;
}
=cut
sub getframeworks {
-# returns a reference to a hash of references to branches...
+
+ # returns a reference to a hash of references to branches...
my %itemtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblios_framework");
+ my $sth = $dbh->prepare("select * from biblio_framework");
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'frameworkcode'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'frameworkcode'} } = $IT;
}
- return (\%itemtypes);
+ return ( \%itemtypes );
}
+
=head2 getframeworkinfo
$frameworkinfo = &getframeworkinfo($frameworkcode);
sub getframeworkinfo {
my ($frameworkcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblios_framework where frameworkcode=?");
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select * from biblio_framework where frameworkcode=?");
$sth->execute($frameworkcode);
my $res = $sth->fetchrow_hashref;
return $res;
}
-
=head2 getitemtypeinfo
$itemtype = &getitemtype($itemtype);
sub getitemtypeinfo {
my ($itemtype) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
$sth->execute($itemtype);
my $res = $sth->fetchrow_hashref;
- $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
+ $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
return $res;
}
sub getitemtypeimagesrcfromurl {
my ($imageurl) = @_;
- if (defined $imageurl and $imageurl !~ m/^http/) {
- $imageurl =
- getitemtypeimagesrc()
- .'/'.$imageurl
- ;
+ if ( defined $imageurl and $imageurl !~ m/^http/ ) {
+ $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
}
return $imageurl;
}
sub getitemtypeimagedir {
- return
- C4::Context->intrahtdocs
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return C4::Context->opachtdocs . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
sub getitemtypeimagesrc {
- return
- '/intranet-tmpl'
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return '/opac-tmpl' . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
-=head2 getprinters
+=head2 GetPrinters
- $printers = &getprinters($env);
+ $printers = &GetPrinters($env);
@queues = keys %$printers;
Returns information about existing printer queues.
=cut
-sub getprinters {
+sub GetPrinters {
my ($env) = @_;
my %printers;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from printers");
+ my $sth = $dbh->prepare("select * from printers");
$sth->execute;
- while (my $printer=$sth->fetchrow_hashref) {
- $printers{$printer->{'printqueue'}}=$printer;
+ while ( my $printer = $sth->fetchrow_hashref ) {
+ $printers{ $printer->{'printqueue'} } = $printer;
}
- return (\%printers);
-}
-
-sub getbranch ($$) {
- my($query, $branches) = @_; # get branch for this query from branches
- my $branch = $query->param('branch');
- ($branch) || ($branch = $query->cookie('branch'));
- ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
- return $branch;
+ return ( \%printers );
}
-=item getbranchdetail
+=head2 GetPrinter
- $branchname = &getbranchdetail($branchcode);
-
-Given the branch code, the function returns the corresponding
-branch name for a comprehensive information display
+$printer = GetPrinter( $query, $printers );
=cut
-sub getbranchdetail
-{
- my ($branchcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
- $sth->execute($branchcode);
- my $branchname = $sth->fetchrow_hashref();
- $sth->finish();
- return $branchname;
-} # sub getbranchname
-
-
-sub getprinter ($$) {
- my($query, $printers) = @_; # get printer for this query from printers
+sub GetPrinter ($$) {
+ my ( $query, $printers ) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
- ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
- ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
+ my %cookie = $query->cookie('userenv');
+ ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
+ ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
return $printer;
}
-=item getalllanguages
-
- (@languages) = &getalllanguages($type);
- (@languages) = &getalllanguages($type,$theme);
+=item getnbpages
-Returns an array of all available languages.
+Returns the number of pages to display in a pagination bar, given the number
+of items and the number of items per page.
=cut
-sub getalllanguages {
- my $type=shift;
- my $theme=shift;
- my $htdocs;
- my @languages;
- if ($type eq 'opac') {
- $htdocs=C4::Context->config('opachtdocs');
- if ($theme and -d "$htdocs/$theme") {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- push @languages, $language;
- }
- return sort @languages;
- } else {
- my $lang;
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
- } elsif ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- if ($theme and -d "$htdocs/$theme") {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- push @languages, $language;
- }
- return sort @languages;
- } else {
- my $lang;
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
- } else {
- my $lang;
- my $htdocs=C4::Context->config('intrahtdocs');
- foreach my $theme (getallthemes('intranet')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- $lang->{$language}=1;
- }
- }
- $htdocs=C4::Context->config('opachtdocs');
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
+sub getnbpages {
+ my ( $nb_items, $nb_items_per_page ) = @_;
+
+ return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
}
=item getallthemes
=cut
sub getallthemes {
- my $type=shift;
+ my $type = shift;
my $htdocs;
my @themes;
- if ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- } else {
- $htdocs=C4::Context->config('opachtdocs');
+ if ( $type eq 'intranet' ) {
+ $htdocs = C4::Context->config('intrahtdocs');
+ }
+ else {
+ $htdocs = C4::Context->config('opachtdocs');
}
opendir D, "$htdocs";
- my @dirlist=readdir D;
+ my @dirlist = readdir D;
foreach my $directory (@dirlist) {
- -d "$htdocs/$directory/en" and push @themes, $directory;
+ -d "$htdocs/$directory/en" and push @themes, $directory;
}
return @themes;
}
-=item getnbpages
-
-Returns the number of pages to display in a pagination bar, given the number
-of items and the number of items per page.
-
-=cut
-
-sub getnbpages {
- my ($nb_items, $nb_items_per_page) = @_;
-
- return int(($nb_items - 1) / $nb_items_per_page) + 1;
-}
-
-
-=head2 getcities (OUEST-PROVENCE)
-
- ($id_cityarrayref, $city_hashref) = &getcities();
-
-Looks up the different city and zip in the database. Returns two
-elements: a reference-to-array, which lists the zip city
-codes, and a reference-to-hash, which maps the name of the city.
-WHERE =>OUEST PROVENCE OR EXTERIEUR
-
-=cut
-sub getcities {
- #my ($type_city) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid ");
- #$sth->execute($type_city);
- $sth->execute();
- my %city;
- my @id;
-# insert empty value to create a empty choice in cgi popup
-
-while (my $data=$sth->fetchrow_hashref){
-
- push @id,$data->{'cityid'};
- $city{$data->{'cityid'}}=$data->{'city_name'};
- }
-
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
- $sth->finish;
- if ($id eq 0)
- {
- return();
+sub getFacets {
+ my $facets;
+ if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
+ $facets = [
+ {
+ link_value => 'su-to',
+ label_value => 'Topics',
+ tags =>
+ [ '600', '601', '602', '603', '604', '605', '606', '610' ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-geo',
+ label_value => 'Places',
+ tags => ['651'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-ut',
+ label_value => 'Titles',
+ tags => [ '500', '501', '502', '503', '504', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'au',
+ label_value => 'Authors',
+ tags => [ '700', '701', '702', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'se',
+ label_value => 'Series',
+ tags => ['225'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'branch',
+ label_value => 'Branches',
+ tags => [ '995', ],
+ subfield => 'b',
+ expanded => '1',
+ },
+ ];
}
- else{
- unshift (@id ,"");
- return(\@id,\%city);
+ else {
+ $facets = [
+ {
+ link_value => 'su-to',
+ label_value => 'Topics',
+ tags => ['650'],
+ subfield => 'a',
+ },
+
+ # {
+ # link_value => 'su-na',
+ # label_value => 'People and Organizations',
+ # tags => ['600', '610', '611'],
+ # subfield => 'a',
+ # },
+ {
+ link_value => 'su-geo',
+ label_value => 'Places',
+ tags => ['651'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-ut',
+ label_value => 'Titles',
+ tags => ['630'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'au',
+ label_value => 'Authors',
+ tags => [ '100', '110', '700', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'se',
+ label_value => 'Series',
+ tags => [ '440', '490', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'branch',
+ label_value => 'Branches',
+ tags => [ '952', ],
+ subfield => 'b',
+ expanded => '1',
+ },
+ ];
}
+ return $facets;
}
+=head2 get_infos_of
-=head2 getroadtypes (OUEST-PROVENCE)
+Return a href where a key is associated to a href. You give a query, the
+name of the key among the fields returned by the query. If you also give as
+third argument the name of the value, the function returns a href of scalar.
- ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
+ my $query = '
+SELECT itemnumber,
+ notforloan,
+ barcode
+ FROM items
+';
-Looks up the different road type . Returns two
-elements: a reference-to-array, which lists the id_roadtype
-codes, and a reference-to-hash, which maps the road type of the road .
+ # generic href of any information on the item, href of href.
+ my $iteminfos_of = get_infos_of($query, 'itemnumber');
+ print $iteminfos_of->{$itemnumber}{barcode};
+ # specific information, href of scalar
+ my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
+ print $barcode_of_item->{$itemnumber};
=cut
-sub getroadtypes {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type ");
- $sth->execute();
- my %roadtype;
- my @id;
-# insert empty value to create a empty choice in cgi popup
-while (my $data=$sth->fetchrow_hashref){
- push @id,$data->{'roadtypeid'};
- $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
- }
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
- $sth->finish;
- if ($id eq 0)
- {
- return();
- }
- else{
- unshift (@id ,"");
- return(\@id,\%roadtype);
- }
-}
-
-=head2 get_branchinfos_of
- my $branchinfos_of = get_branchinfos_of(@branchcodes);
-
-Associates a list of branchcodes to the information of the branch, taken in
-branches table.
+sub get_infos_of {
+ my ( $query, $key_name, $value_name ) = @_;
-Returns a href where keys are branchcodes and values are href where keys are
-branch information key.
+ my $dbh = C4::Context->dbh;
- print 'branchname is ', $branchinfos_of->{$code}->{branchname};
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
-=cut
-sub get_branchinfos_of {
- my @branchcodes = @_;
+ my %infos_of;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ if ( defined $value_name ) {
+ $infos_of{ $row->{$key_name} } = $row->{$value_name};
+ }
+ else {
+ $infos_of{ $row->{$key_name} } = $row;
+ }
+ }
+ $sth->finish;
- my $query = '
-SELECT branchcode,
- branchname
- FROM branches
- WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
-';
- return get_infos_of($query, 'branchcode');
+ return \%infos_of;
}
=head2 get_notforloan_label_of
}
=cut
+
sub get_notforloan_label_of {
my $dbh = C4::Context->dbh;
-my($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("notforloan","holdings");
+
my $query = '
SELECT authorised_value
- FROM holdings_subfield_structure
- WHERE tagfield =$tagfield and tagsubfield=$tagsubfield
+ FROM marc_subfield_structure
+ WHERE kohafield = \'items.notforloan\'
LIMIT 0, 1
';
my $sth = $dbh->prepare($query);
$sth = $dbh->prepare($query);
$sth->execute($statuscode);
my %notforloan_label_of;
- while (my $row = $sth->fetchrow_hashref) {
+ while ( my $row = $sth->fetchrow_hashref ) {
$notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
}
$sth->finish;
return \%notforloan_label_of;
}
-=head2 get_infos_of
+sub displaySortby {
+ my ($sort_by) = @_;
+ my $sort_by_loop = [
+ { value => "1=9523 >i", label => "Popularity (Most to Least)" },
+ { value => "1=9523 <i", label => "Popularity (Least to Most)" },
+ { value => "1=1003 <i", label => "Author (A-Z)" },
+ { value => "1=1003 >i", label => "Author (Z-A)" },
+ {
+ value => "1=20 <i",
+ label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
+ },
+ {
+ value => "1=20 >i",
+ label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
+ },
+ { value => "1=31 >i", label => "Dates" },
+ {
+ value => "1=31 >i",
+ label =>
+ " Publication/Copyright Date: Newest to Oldest"
+ },
+ {
+ value => "1=31 <i",
+ label =>
+ " Publication/Copyright Date: Oldest to Newest"
+ },
+ {
+ value => "1=32 >i",
+ label => " Acquisition Date: Newest to Oldest"
+ },
+ {
+ value => "1=32 <i",
+ label => " Acquisition Date: Oldest to Newest"
+ },
+ { value => "1=36 <i", label => "Title (A-Z)" },
+ { value => "1=36 >i", label => "Title (Z-A)" },
+ ];
+ for my $hash (@$sort_by_loop) {
+
+ #warn "sort by: $sort_by ... hash:".$hash->{value};
+ if ($sort_by && $hash->{value} eq $sort_by ) {
+ $hash->{selected} = "selected";
+ }
+ }
+ return $sort_by_loop;
-Return a href where a key is associated to a href. You give a query, the
-name of the key among the fields returned by the query. If you also give as
-third argument the name of the value, the function returns a href of scalar.
+}
- my $query = '
-SELECT itemnumber,
- notforloan,
- barcode
- FROM items
-';
+sub displayIndexes {
+ my $indexes = [
+ { value => '', label => 'Keyword' },
+ { value => 'au', label => 'Author' },
+ {
+ value => 'au,phr',
+ label => ' Author Phrase'
+ },
+ { value => 'cpn', label => ' Corporate Name' },
+ { value => 'cfn', label => ' Conference Name' },
+ {
+ value => 'cpn,phr',
+ label => ' Corporate Name Phrase'
+ },
+ {
+ value => 'cfn,phr',
+ label => ' Conference Name Phrase'
+ },
+ { value => 'pn', label => ' Personal Name' },
+ {
+ value => 'pn,phr',
+ label => ' Personal Name Phrase'
+ },
+ { value => 'ln', label => 'Language' },
+
+ # { value => 'mt', label => 'Material Type' },
+ # { value => 'mt,phr', label => 'Material Type Phrase' },
+ # { value => 'mc', label => 'Musical Composition' },
+ # { value => 'mc,phr', label => 'Musical Composition Phrase' },
+
+ { value => 'nt', label => 'Notes/Comments' },
+ { value => 'pb', label => 'Publisher' },
+ { value => 'pl', label => 'Publisher Location' },
+ { value => 'sn', label => 'Standard Number' },
+ { value => 'nb', label => ' ISBN' },
+ { value => 'ns', label => ' ISSN' },
+ { value => 'lcn', label => ' Call Number' },
+ { value => 'su', label => 'Subject' },
+ {
+ value => 'su,phr',
+ label => ' Subject Phrase'
+ },
+
+# { value => 'de', label => ' Descriptor' },
+# { value => 'ge', label => ' Genre/Form' },
+# { value => 'gc', label => ' Geographic Coverage' },
+
+# { value => 'nc', label => ' Named Corporation and Conference' },
+# { value => 'na', label => ' Named Person' },
+
+ { value => 'ti', label => 'Title' },
+ { value => 'ti,phr', label => ' Title Phrase' },
+ { value => 'se', label => ' Series Title' },
+ ];
+ return $indexes;
+}
- # generic href of any information on the item, href of href.
- my $iteminfos_of = get_infos_of($query, 'itemnumber');
- print $iteminfos_of->{$itemnumber}{barcode};
+sub displaySubtypesLimit {
+ my $outer_subtype_limits_loop = [
+
+ { # in MARC21, aud codes are stored in 008/22 (Target audience)
+ name => "limit",
+ inner_subtype_limits_loop => [
+ {
+ value => '',
+ label => 'Any Audience',
+ selected => "selected"
+ },
+ { value => 'aud:a', label => 'Easy', },
+ { value => 'aud:c', label => 'Juvenile', },
+ { value => 'aud:d', label => 'Young Adult', },
+ { value => 'aud:e', label => 'Adult', },
+
+ ],
+ },
+ { # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06
+ name => "limit",
+ inner_subtype_limits_loop => [
+ { value => '', label => 'Any Content', selected => "selected" },
+ { value => 'fic:1', label => 'Fiction', },
+ { value => 'fic:0', label => 'Non Fiction', },
+ { value => 'bio:b', label => 'Biography', },
+ { value => 'mus:j', label => 'Musical recording', },
+ { value => 'mus:i', label => 'Non-musical recording', },
+
+ ],
+ },
+ { # MARC21, these are codes stored in 007/00-01
+ name => "limit",
+ inner_subtype_limits_loop => [
+ { value => '', label => 'Any Format', selected => "selected" },
+ { value => 'l-format:ta', label => 'Regular print', },
+ { value => 'l-format:tb', label => 'Large print', },
+ { value => 'l-format:fk', label => 'Braille', },
+ { value => '', label => '-----------', },
+ { value => 'l-format:sd', label => 'CD audio', },
+ { value => 'l-format:ss', label => 'Cassette recording', },
+ {
+ value => 'l-format:vf',
+ label => 'VHS tape / Videocassette',
+ },
+ { value => 'l-format:vd', label => 'DVD video / Videodisc', },
+ { value => 'l-format:co', label => 'CD Software', },
+ { value => 'l-format:cr', label => 'Website', },
+
+ ],
+ },
+ { # in MARC21, these are codes in 008/24-28
+ name => "limit",
+ inner_subtype_limits_loop => [
+ { value => '', label => 'Additional Content Types', },
+ { value => 'ctype:a', label => 'Abstracts/summaries', },
+ { value => 'ctype:b', label => 'Bibliographies', },
+ { value => 'ctype:c', label => 'Catalogs', },
+ { value => 'ctype:d', label => 'Dictionaries', },
+ { value => 'ctype:e', label => 'Encyclopedias ', },
+ { value => 'ctype:f', label => 'Handbooks', },
+ { value => 'ctype:g', label => 'Legal articles', },
+ { value => 'ctype:i', label => 'Indexes', },
+ { value => 'ctype:j', label => 'Patent document', },
+ { value => 'ctype:k', label => 'Discographies', },
+ { value => 'ctype:l', label => 'Legislation', },
+ { value => 'ctype:m', label => 'Theses', },
+ { value => 'ctype:n', label => 'Surveys', },
+ { value => 'ctype:o', label => 'Reviews', },
+ { value => 'ctype:p', label => 'Programmed texts', },
+ { value => 'ctype:q', label => 'Filmographies', },
+ { value => 'ctype:r', label => 'Directories', },
+ { value => 'ctype:s', label => 'Statistics', },
+ { value => 'ctype:t', label => 'Technical reports', },
+ { value => 'ctype:v', label => 'Legal cases and case notes', },
+ { value => 'ctype:w', label => 'Law reports and digests', },
+ { value => 'ctype:z', label => 'Treaties ', },
+ ],
+ },
+ ];
+ return $outer_subtype_limits_loop;
+}
- # specific information, href of scalar
- my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
- print $barcode_of_item->{$itemnumber};
+sub displayLimitTypes {
+ my $outer_limit_types_loop = [
+
+ {
+ inner_limit_types_loop => [
+ {
+ label => "Books",
+ id => "mc-books",
+ name => "limit",
+ value => "(mc-collection:AF or mc-collection:MYS or mc-collection:SCI or mc-collection:NF or mc-collection:YA or mc-collection:BIO or mc-collection:LP or mc-collection:LPNF)",
+ icon => "search-books.gif",
+ title =>
+"Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
+ },
+
+ {
+ label => "Movies",
+ id => "mc-movies",
+ name => "limit",
+ value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)",
+ icon => "search-movies.gif",
+ title =>
+"Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
+ },
+
+ {
+ label => "Music",
+ id => "mc-music",
+ name => "limit",
+ value => "(mc-collection:CDM)",
+ icon => "search-music.gif",
+ title => "Spoken, Books on CD and Cassette",
+ },
+ ],
+ },
+ {
+ inner_limit_types_loop => [
+ {
+ label => "Audio Books",
+ id => "mc-audio-books",
+ name => "limit",
+ value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)",
+ icon => "search-audio-books.gif",
+ title => "Spoken, Books on CD and Cassette",
+ },
+
+ {
+ label => "Local History Materials",
+ id => "mc-local-history",
+ name => "limit",
+ value => "mc-collection:LH",
+ icon => "Local history.gif",
+ title => "Local History Materials",
+ },
+
+ {label => "Large Print",
+ id => "mc-large-print",
+ name => "limit",
+ value => "(mc-collection:LP or mc-collection:LPNF)",
+ icon => "search-large-print.gif ",
+ title => "Large Print",},
+ ],
+ },
+{ inner_limit_types_loop => [
+ {label => "Kids",
+ id => "mc-kids",
+ name => "limit",
+ value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)",
+ icon => "search-kids.gif",
+ title => "Music",},
+
+ {label => "Software/Internet",
+ id => "mc-sofware-web",
+ name => "limit",
+ value => "(mc-collection:CDR)",
+ icon => "search-software-web.gif",
+ title => "Kits",},
+
+ {label => "Reference",
+ id => "mc-reference",
+ name => "limit",
+ value => "mc-collection:REF",
+ icon => "search-reference.gif",
+ title => "Reference",},
+
+ ],
+ },
+
+ ];
+ return $outer_limit_types_loop;
+}
-=cut
-sub get_infos_of {
- my ($query, $key_name, $value_name) = @_;
+sub displayServers {
+ my ( $position, $type ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $strsth = "SELECT * FROM z3950servers where 1";
+ $strsth .= " AND position=\"$position\"" if ($position);
+ $strsth .= " AND type=\"$type\"" if ($type);
+ my $rq = $dbh->prepare($strsth);
+ $rq->execute;
+ my @primaryserverloop;
+
+ while ( my $data = $rq->fetchrow_hashref ) {
+ my %cell;
+ $cell{label} = $data->{'description'};
+ $cell{id} = $data->{'name'};
+ $cell{value} =
+ $data->{host}
+ . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
+ . $data->{database}
+ if ( $data->{host} );
+ $cell{checked} = $data->{checked};
+ push @primaryserverloop,
+ {
+ label => $data->{description},
+ id => $data->{name},
+ name => "server",
+ value => $data->{host} . ":"
+ . $data->{port} . "/"
+ . $data->{database},
+ checked => "checked",
+ icon => $data->{icon},
+ zed => $data->{type} eq 'zed',
+ opensearch => $data->{type} eq 'opensearch'
+ };
+ }
+ return \@primaryserverloop;
+}
+
+sub displaySecondaryServers {
+
+# my $secondary_servers_loop = [
+# { inner_sup_servers_loop => [
+# {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
+# {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
+# {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
+# {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
+# ],
+# },
+# ];
+ return; #$secondary_servers_loop;
+}
+sub GetDepartements {
my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT authorised_value,lib FROM authorised_values WHERE category='DPT'
+ "
+ );
+ $sth->execute;
+ my @getdepartements;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $getdepartements[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@getdepartements);
+}
+
+sub GetDepartementLib {
+ my ($authorisedvalue) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+"SELECT lib,authorised_value FROM authorised_values WHERE category='DPT' AND authorised_value=?
+ "
+ );
+ $sth->execute($authorisedvalue);
+ my (@lib) = $sth->fetchrow_array;
+ $sth->finish;
+ return (@lib);
+}
+
+=head2 GetAuthorisedValues
+
+$authvalues = GetAuthorisedValues($category);
+
+this function get all authorised values from 'authosied_value' table into a reference to array which
+each value containt an hashref.
+
+Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
+
+=cut
+
+sub GetAuthorisedValues {
+ my $category = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT * FROM authorised_values";
+ $query .= " WHERE category = '" . $category . "'" if $category;
my $sth = $dbh->prepare($query);
- $sth->execute();
+ $sth->execute;
+ my $data = $sth->fetchall_arrayref({});
+ return $data;
+}
- my %infos_of;
- while (my $row = $sth->fetchrow_hashref) {
- if (defined $value_name) {
- $infos_of{ $row->{$key_name} } = $row->{$value_name};
+=item fixEncoding
+
+ $marcrecord = &fixEncoding($marcblob);
+
+Returns a well encoded marcrecord.
+
+=cut
+sub FixEncoding {
+ my $marc=shift;
+ my $record = MARC::Record->new_from_usmarc($marc);
+ if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
+ use Encode::Guess;
+ my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
+ $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
+ my $decoder = guess_encoding($marc, qw/utf8 latin1/);
+# die $decoder unless ref($decoder);
+ if (ref($decoder)) {
+ my $newRecord=MARC::Record->new();
+ foreach my $field ($record->fields()){
+ if ($field->tag()<'010'){
+ $newRecord->insert_grouped_field($field);
+ } else {
+ my $newField;
+ my $createdfield=0;
+ foreach my $subfield ($field->subfields()){
+ if ($createdfield){
+ if (($newField->tag eq '100')) {
+ substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
+ substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
+ }
+ map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
+ $newField->add_subfields($subfield->[0]=>$subfield->[1]);
+ } else {
+ map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
+ $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
+ $createdfield=1;
+ }
+ }
+ $newRecord->insert_grouped_field($newField);
}
- else {
- $infos_of{ $row->{$key_name} } = $row;
}
+ # warn $newRecord->as_formatted();
+ return $newRecord;
+ } else {
+ return $record;
}
- $sth->finish;
-
- 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 $query=new CGI;
-my $lang=$query->cookie('KohaOpacLanguage');
-$lang="en" unless $lang;
-my @facets;
-my $sth=$dbh->prepare("SELECT facets_label_$lang,kohafield FROM facets where (facets_label_$lang<>'' ) group by facets_label_$lang");
-my $sth2=$dbh->prepare("SELECT * FROM facets where facets_label_$lang=?");
-$sth->execute();
-while (my ($label,$kohafield)=$sth->fetchrow){
- $sth2->execute($label);
-my (@tags,@subfield);
- while (my $data=$sth2->fetchrow_hashref){
- push @tags,$data->{tagfield} ;
- push @subfield,$data->{subfield} ;
- }
- my $facet = {
- link_value =>"kohafield=$kohafield",
- label_value =>$label,
- tags => \@tags,
- subfield =>\@subfield,
- } ;
- push @facets,$facet;
-}
- return \@facets;
+ } else {
+ return $record;
+ }
}
+=head2 GetKohaAuthorisedValues
+
+ Takes $dbh , $kohafield as parameters.
+ returns hashref of authvalCode => liblibrarian
+ or undef if no authvals defined for kohafield.
+
+=cut
+
+sub GetKohaAuthorisedValues {
+ my ($kohafield) = @_;
+ my %values;
+ my $dbh = C4::Context->dbh;
+ my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
+ $sthnflstatus->execute($kohafield);
+ my $authorised_valuecode = $sthnflstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
+ $sthnflstatus->execute($authorised_valuecode);
+ while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) {
+ $values{$val}= $lib;
+ }
+ }
+ return \%values;
+}
1;
+
__END__
=back
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
-#use Data::Dumper;
-use PDF::Reuse;
+use PDF::Reuse;
+use Text::Wrap;
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
@EXPORT = qw(
&get_label_options &get_label_items
&build_circ_barcode &draw_boundaries
- &draw_box
+ &drawbox &GetActiveLabelTemplate
+ &GetAllLabelTemplates &DeleteTemplate
+ &GetSingleLabelTemplate &SaveTemplate
+ &CreateTemplate &SetActiveTemplate
+ &SaveConf &DrawSpineText &GetTextWrapCols
+ &GetUnitsValue &DrawBarcode
+
);
=item get_label_options;
Return a pointer on a hash list containing info from labels_conf table in Koha DB.
=cut
+
#'
sub get_label_options {
my $dbh = C4::Context->dbh;
return $conf_data;
}
+sub GetUnitsValue {
+ my ($units) = @_;
+ my $unitvalue;
+
+ $unitvalue = '1' if ( $units eq 'POINT' );
+ $unitvalue = '2.83464567' if ( $units eq 'MM' );
+ $unitvalue = '28.3464567' if ( $units eq 'CM' );
+ $unitvalue = 72 if ( $units eq 'INCH' );
+ warn $units, $unitvalue;
+ return $unitvalue;
+}
+
+sub GetTextWrapCols {
+ my ( $fontsize, $label_width ) = @_;
+ my $string = "0";
+ my $left_text_margin = 3;
+ my ( $strtmp, $strwidth );
+ my $count = 0;
+ my $textlimit = $label_width - $left_text_margin;
+
+ while ( $strwidth < $textlimit ) {
+ $strwidth = prStrWidth( $string, 'C', $fontsize );
+ $string = $string . '0';
+
+ # warn "strwidth $strwidth, $textlimit, $string";
+ $count++;
+ }
+ return $count;
+}
+
+sub GetActiveLabelTemplate {
+ my $dbh = C4::Context->dbh;
+ my $query = " SELECT * FROM labels_templates where active = 1 limit 1";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $active_tmpl = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $active_tmpl;
+}
+
+sub GetSingleLabelTemplate {
+ my ($tmpl_code) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = " SELECT * FROM labels_templates where tmpl_code = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_code);
+ my $template = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $template;
+}
+
+sub SetActiveTemplate {
+
+ my ($tmpl_id) = @_;
+ warn "TMPL_ID = $tmpl_id";
+ my $dbh = C4::Context->dbh;
+ my $query = " UPDATE labels_templates SET active = NULL";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ $query = "UPDATE labels_templates SET active = 1 WHERE tmpl_id = ?";
+ $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_id);
+ $sth->finish;
+}
+
+sub DeleteTemplate {
+ my ($tmpl_code) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = " DELETE FROM labels_templates where tmpl_code = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($tmpl_code);
+ $sth->finish;
+}
+
+sub SaveTemplate {
+
+ my (
+ $tmpl_id, $tmpl_code, $tmpl_desc, $page_width,
+ $page_height, $label_width, $label_height, $topmargin,
+ $leftmargin, $cols, $rows, $colgap,
+ $rowgap, $active, $fontsize, $units
+ )
+ = @_;
+
+ #warn "FONTSIZE =$fontsize";
+
+ my $dbh = C4::Context->dbh;
+ my $query =
+ " UPDATE labels_templates SET tmpl_code=?, tmpl_desc=?, page_width=?,
+ page_height=?, label_width=?, label_height=?, topmargin=?,
+ leftmargin=?, cols=?, rows=?, colgap=?, rowgap=?, fontsize=?,
+ units=?
+ WHERE tmpl_id = ?";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $fontsize, $units, $tmpl_id
+ );
+ $sth->finish;
+
+ SetActiveTemplate($tmpl_id) if ( $active eq '1' );
+}
+
+sub CreateTemplate {
+ my $tmpl_id;
+ my (
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $active, $fontsize, $units
+ )
+ = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = "INSERT INTO labels_templates (tmpl_code, tmpl_desc, page_width,
+ page_height, label_width, label_height, topmargin,
+ leftmargin, cols, rows, colgap, rowgap, fontsize, units)
+ VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?)";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $tmpl_code, $tmpl_desc, $page_width, $page_height,
+ $label_width, $label_height, $topmargin, $leftmargin,
+ $cols, $rows, $colgap, $rowgap,
+ $fontsize, $units
+ );
+
+ warn "ACTIVE = $active";
+
+ if ( $active eq '1' ) {
+
+ # get the tmpl_id of the newly created template, then call SetActiveTemplate()
+ my $query =
+ "SELECT tmpl_id from labels_templates order by tmpl_id desc limit 1";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+
+ my $data = $sth->fetchrow_hashref;
+ my $tmpl_id = $data->{'tmpl_id'};
+
+ SetActiveTemplate($tmpl_id);
+ $sth->finish;
+ }
+ return $tmpl_id;
+}
+
+sub GetAllLabelTemplates {
+ my $dbh = C4::Context->dbh;
+
+ # get the actual items to be printed.
+ my @data;
+ my $query = " Select * from labels_templates ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my @resultsloop;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @resultsloop, $data );
+ }
+ $sth->finish;
+
+ return @resultsloop;
+}
+
+sub SaveConf {
+
+ my (
+ $barcodetype, $title, $isbn, $itemtype,
+ $bcn, $dcn, $classif, $subclass,
+ $itemcallnumber, $author, $tmpl_id, $printingtype,
+ $guidebox, $startlabel
+ )
+ = @_;
+
+ my $dbh = C4::Context->dbh;
+ my $query2 = "DELETE FROM labels_conf";
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute;
+ $query2 = "INSERT INTO labels_conf
+ ( barcodetype, title, isbn, itemtype, barcode,
+ dewey, class, subclass, itemcallnumber, author, printingtype,
+ guidebox, startlabel )
+ values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
+ $sth2 = $dbh->prepare($query2);
+ $sth2->execute(
+ $barcodetype, $title, $isbn, $itemtype,
+ $bcn, $dcn, $classif, $subclass,
+ $itemcallnumber, $author, $printingtype, $guidebox,
+ $startlabel
+ );
+ $sth2->finish;
+
+ SetActiveTemplate($tmpl_id);
+ return;
+}
+
=item get_label_items;
$options = get_label_items()
Returns an array of references-to-hash, whos keys are the field from the biblio, biblioitems, items and labels tables in the Koha database.
=cut
+
#'
sub get_label_items {
my $dbh = C4::Context->dbh;
return @resultsloop;
}
+sub DrawSpineText {
+
+ my ( $y_pos, $label_height, $fontsize, $x_pos, $left_text_margin,
+ $text_wrap_cols, $item, $conf_data )
+ = @_;
+
+ $Text::Wrap::columns = $text_wrap_cols;
+ $Text::Wrap::separator = "\n";
+
+ my $str;
+
+ my $top_text_margin = ( $fontsize + 3 );
+ my $line_spacer = ($fontsize); # number of pixels between text rows.
+
+ # add your printable fields manually in here
+ my @fields =
+ qw (dewey isbn classification itemtype subclass itemcallnumber);
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
+ my $hPos = ( $x_pos + $left_text_margin );
+
+ foreach my $field (@fields) {
+
+ # if the display option for this field is selected in the DB,
+ # and the item record has some values for this field, display it.
+ if ( $$conf_data->{"$field"} && $$item->{"$field"} ) {
+
+ # warn "CONF_TYPE = $field";
+
+ # get the string
+ $str = $$item->{"$field"};
+
+ # strip out naughty existing nl/cr's
+ $str =~ s/\n//g;
+ $str =~ s/\r//g;
+
+ # chop the string up into _upto_ 12 chunks
+ # and seperate the chunks with newlines
+
+ $str = wrap( "", "", "$str" );
+ $str = wrap( "", "", "$str" );
+
+ # split the chunks between newline's, into an array
+ my @strings = split /\n/, $str;
+
+ # then loop for each string line
+ foreach my $str (@strings) {
+
+ #warn "HPOS , VPOS $hPos, $vPos ";
+ prText( $hPos, $vPos, $str );
+ $vPos = $vPos - $line_spacer;
+ }
+ } # if field is valid
+ } #foreach feild
+}
+
+sub DrawBarcode {
+
+ my ( $x_pos, $y_pos, $height, $width, $barcode, $barcodetype ) = @_;
+ $barcode = '123456789';
+ my $num_of_bars = length($barcode);
+ my $bar_width = ( ( $width / 10 ) * 8 ); # %80 of lenght of label width
+ my $tot_bar_length;
+ my $bar_length;
+ my $guard_length = 10;
+ my $xsize_ratio;
+
+ if ( $barcodetype eq 'Code39' ) {
+ $bar_length = '14.4333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length );
+ eval {
+ PDF::Reuse::Barcode::Code39(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => "*$barcode*",
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ hide_asterisk => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+
+ elsif ( $barcodetype eq 'COOP2of5' ) {
+ $bar_length = '9.43333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
+ eval {
+ PDF::Reuse::Barcode::COOP2of5(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => $barcode,
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+
+ elsif ( $barcodetype eq 'Industrial2of5' ) {
+ $bar_length = '13.1333333333333';
+ $tot_bar_length =
+ ( $bar_length * $num_of_bars ) + ( $guard_length * 2 );
+ $xsize_ratio = ( $bar_width / $tot_bar_length ) * .9;
+ eval {
+ PDF::Reuse::Barcode::Industrial2of5(
+ x => ( $x_pos + ( $width / 10 ) ),
+ y => ( $y_pos + ( $height / 10 ) ),
+ value => $barcode,
+ ySize => ( .02 * $height ),
+ xSize => $xsize_ratio,
+ );
+ };
+ if ($@) {
+ warn "$barcodetype, $barcode FAILED:$@";
+ }
+ }
+ my $moo2 = $tot_bar_length * $xsize_ratio;
+
+ warn " $x_pos, $y_pos, $barcode, $barcodetype\n";
+ warn
+"BAR_WDTH = $bar_width, TOT.BAR.LGHT=$tot_bar_length R*TOT.BAR =$moo2 \n";
+}
+
=item build_circ_barcode;
build_circ_barcode( $x_pos, $y_pos, $barcode,
$item is the result of a previous call to get_label_items();
=cut
+
#'
sub build_circ_barcode {
my ( $x_pos_circ, $y_pos, $value, $barcodetype, $item ) = @_;
-#warn Dumper \$item;
-
#warn "value = $value\n";
#$DB::single = 1;
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "EAN13BARCODE FAILED:$@";
}
}
elsif ( $barcodetype eq 'Code39' ) {
-
eval {
PDF::Reuse::Barcode::Code39(
x => ( $x_pos_circ + 9 ),
y => ( $y_pos + 15 ),
- value => $value,
-
# prolong => 2.96,
xSize => .85,
-
ySize => 1.3,
+ value => "*$value*",
+ #hide_asterisk => $xsize_ratio,
);
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "CODE39BARCODE $value FAILED:$@";
}
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
};
if ($@) {
$item->{'barcodeerror'} = 1;
+
#warn "BARCODE FAILED:$@";
}
#'
sub draw_boundaries {
- my ($x_pos_spine, $x_pos_circ1, $x_pos_circ2,
- $y_pos, $spine_width, $label_height, $circ_width) = @_;
+ my (
+ $x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
+ $spine_width, $label_height, $circ_width
+ )
+ = @_;
my $y_pos_initial = ( ( 792 - 36 ) - 90 );
- my $y_pos = $y_pos_initial;
+ $y_pos = $y_pos_initial;
my $i = 1;
for ( $i = 1 ; $i <= 8 ; $i++ ) {
this is a low level sub, that draws a pdf box, it is called by draw_boxes
+FYI: the $upper_right_x and $upper_right_y values are RELATIVE to $lower_left_x and $lower_left_y
+
+and $lower_left_x, $lower_left_y are ABSOLUTE, this caught me out!
+
=cut
#'
sub drawbox {
my ( $llx, $lly, $urx, $ury ) = @_;
+ # warn "llx,y= $llx,$lly , urx,y=$urx,$ury \n";
+
my $str = "q\n"; # save the graphic state
+ $str .= "0.5 w\n"; # border color red
$str .= "1.0 0.0 0.0 RG\n"; # border color red
- $str .= "1 1 1 rg\n"; # fill color blue
+ $str .= "0.5 0.75 1.0 rg\n"; # fill color blue
$str .= "$llx $lly $urx $ury re\n"; # a rectangle
$str .= "B\n"; # fill (and a little more)
$str .= "Q\n"; # save the graphic state
use strict;
use Mail::Sendmail;
use C4::Date;
+use Date::Manip;
use C4::Suggestions;
use C4::Members;
+use C4::Log;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
"Letters" is the tool used in Koha to manage informations sent to the patrons and/or the library. This include some cron jobs like
late issues, as well as other tasks like sending a mail to users that have subscribed to a "serial issue alert" (= being warned every time a new issue has arrived at the library)
-
+
Letters are managed through "alerts" sent by Koha on some events. All "alert" related functions are in this module too.
=cut
@ISA = qw(Exporter);
-@EXPORT = qw(&GetLetterList &getletter &addalert &getalert &delalert &findrelatedto &sendalerts);
+@EXPORT = qw(&GetLetters &getletter &addalert &getalert &delalert &findrelatedto &SendAlerts);
+
+
+=head2 GetLetters
-=head2 GetLetterList
+ $letters = &getletters($category);
+ returns informations about letters.
+ if needed, $category filters for letters given category
+ Create a letter selector with the following code
+
+=head3 in PERL SCRIPT
+
+my $letters = GetLetters($cat);
+my @letterloop;
+foreach my $thisletter (keys %$letters) {
+ my $selected = 1 if $thisletter eq $letter;
+ my %row =(value => $thisletter,
+ selected => $selected,
+ lettername => $letters->{$thisletter},
+ );
+ push @letterloop, \%row;
+}
- parameter : $module : the name of the module
- This sub returns an array of hashes with all letters from a given module
- Each hash entry contains :
- - module : the module name
- - code : the code of the letter, char(20)
- - name : the complete name of the letter, char(200)
- - title : the title that will be used as "subject" in mails, char(200)
- - content : the content of the letter. Each field to be replaced by a value at runtime is enclosed in << and >>. The fields usually have the same name as in the DB
+=head3 in TEMPLATE
+ <select name="letter">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP name="letterloop" -->
+ <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="lettername" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
=cut
-sub GetLetterList {
- my ($module) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select * from letter where module=?");
- $sth->execute($module);
- my @result;
- while (my $line = $sth->fetchrow_hashref) {
- push @result,$line;
- }
- return @result;
+sub GetLetters {
+# returns a reference to a hash of references to ALL letters...
+ my $cat = shift;
+ my %letters;
+ my $dbh = C4::Context->dbh;
+ $dbh->quote($cat);
+ my $sth;
+ if ($cat ne ""){
+ my $query = "SELECT * FROM letter WHERE module = ? ORDER BY name";
+ $sth = $dbh->prepare($query);
+ $sth->execute($cat);
+ } else {
+ my $query = " SELECT * FROM letter ORDER BY name";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ }
+ while (my $letter=$sth->fetchrow_hashref){
+ $letters{$letter->{'code'}}=$letter->{'name'};
+ }
+ return \%letters;
}
+
sub getletter {
my ($module,$code) = @_;
my $dbh = C4::Context->dbh;
- externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
create an alert and return the alertid (primary key)
-
+
=cut
sub addalert {
- $type : the type of alert.
- externalid : the primary key of the object to put alert on. For issues, the alert is made on subscriptionid.
all parameters NON mandatory. If a parameter is omitted, the query is done without the corresponding parameter. For example, without $externalid, returns all alerts for a borrower on a topic.
-
+
=cut
sub getalert {
return $result;
}
-=head2 sendalert
+=head2 SendAlerts
+
parameters :
- $type : the type of alert
- $externalid : the id of the "object" to query
=cut
-sub sendalerts {
+sub SendAlerts {
my ($type,$externalid,$letter)=@_;
my $dbh=C4::Context->dbh;
if ($type eq 'issue') {
foreach (@$alerts) {
# and parse borrower ...
my $innerletter = $letter;
- my $borinfo = getmember('',$_->{'borrowernumber'});
+ my $borinfo = GetMember('',$_->{'borrowernumber'});
parseletter($innerletter,'borrowers',$_->{'borrowernumber'});
# ... then send mail
if ($borinfo->{emailaddress}) {
}
}
}
+ elsif ($type eq 'claimacquisition') {
+# warn "sending issues...";
+ my $letter = getletter('claimacquisition',$letter);
+ # prepare the letter...
+ # search the biblionumber
+ my $strsth="select aqorders.*,aqbasket.*,biblio.*,biblioitems.* from aqorders LEFT JOIN aqbasket on aqbasket.basketno=aqorders.basketno LEFT JOIN biblio on aqorders.biblionumber=biblio.biblionumber LEFT JOIN biblioitems on aqorders.biblioitemnumber=biblioitems.biblioitemnumber where aqorders.ordernumber IN (".join(",",@$externalid).")";
+ my $sthorders=$dbh->prepare($strsth);
+ $sthorders->execute;
+ my $dataorders=$sthorders->fetchall_arrayref({});
+ parseletter($letter,'aqbooksellers',$dataorders->[0]->{booksellerid});
+ my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
+ $sthbookseller->execute($dataorders->[0]->{booksellerid});
+ my $databookseller=$sthbookseller->fetchrow_hashref;
+ # parsing branch info
+ my $userenv = C4::Context->userenv;
+ parseletter($letter,'branches',$userenv->{branch});
+ # parsing librarian name
+ $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
+ $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
+ $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
+ foreach my $data (@$dataorders){
+ my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
+ foreach my $field (keys %$data){
+ $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
+ }
+ $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
+ }
+ $letter->{content} =~ s/<<[^>]*>>//g;
+ my $innerletter = $letter;
+ # ... then send mail
+ if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
+ my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
+ From => $userenv->{emailaddress},
+ Subject => "".$innerletter->{title},
+ Message => "".$innerletter->{content},
+ 'Content-Type' => 'text/plain; charset="utf8"',
+ );
+ sendmail(%mail);
+ warn "sending to $mail{To} From $mail{From} subj $mail{Subject} Mess $mail{Message}";
+ }
+ if (C4::Context->preference("LetterLog")){
+ logaction($userenv->{number},"ACQUISITION","Send Acquisition claim letter","","order list : ".join(",",@$externalid)."\n$innerletter->{title}\n$innerletter->{content}")
+ }
+ }
+ elsif ($type eq 'claimissues') {
+# warn "sending issues...";
+ my $letter = getletter('claimissues',$letter);
+ # prepare the letter...
+ # search the biblionumber
+ my $strsth="select serial.*,subscription.*, biblio.title from serial LEFT JOIN subscription on serial.subscriptionid=subscription.subscriptionid LEFT JOIN biblio on serial.biblionumber=biblio.biblionumber where serial.serialid IN (".join(",",@$externalid).")";
+ my $sthorders=$dbh->prepare($strsth);
+ $sthorders->execute;
+ my $dataorders=$sthorders->fetchall_arrayref({});
+ parseletter($letter,'aqbooksellers',$dataorders->[0]->{aqbooksellerid});
+ my $sthbookseller = $dbh->prepare("select * from aqbooksellers where id=?");
+ $sthbookseller->execute($dataorders->[0]->{aqbooksellerid});
+ my $databookseller=$sthbookseller->fetchrow_hashref;
+ # parsing branch info
+ my $userenv = C4::Context->userenv;
+ parseletter($letter,'branches',$userenv->{branch});
+ # parsing librarian name
+ $letter->{content} =~ s/<<LibrarianFirstname>>/$userenv->{firstname}/g;
+ $letter->{content} =~ s/<<LibrarianSurname>>/$userenv->{surname}/g;
+ $letter->{content} =~ s/<<LibrarianEmailaddress>>/$userenv->{emailaddress}/g;
+ foreach my $data (@$dataorders){
+ my $line=$1 if ($letter->{content}=~m/(<<.*>>)/);
+ foreach my $field (keys %$data){
+ $line =~ s/(<<[^\.]+.$field>>)/$data->{$field}/;
+ }
+ $letter->{content}=~ s/(<<.*>>)/$line\n\1/;
+ }
+ $letter->{content} =~ s/<<[^>]*>>//g;
+ my $innerletter = $letter;
+ # ... then send mail
+ if ($databookseller->{bookselleremail}||$databookseller->{contemail}) {
+ my %mail = ( To => $databookseller->{bookselleremail}.($databookseller->{contemail}?",".$databookseller->{contemail}:""),
+ From => $userenv->{emailaddress},
+ Subject => "".$innerletter->{title},
+ Message => "".$innerletter->{content},
+ );
+ sendmail(%mail);
+ &logaction(
+ C4::Context->userenv->{'number'},
+ "ACQUISITION",
+ "CLAIM ISSUE",
+ undef,
+ "To=".$databookseller->{contemail}.
+ " Title=".$innerletter->{title}.
+ " Content=".$innerletter->{content}
+ ) if C4::Context->preference("LetterLog");
+ }
+ warn "sending to From $userenv->{emailaddress} subj $innerletter->{title} Mess $innerletter->{content}";
+ }
}
-=head2
+=head2 parseletter
+
parameters :
- $letter : a hash to letter fields (title & content useful)
- $table : the Koha table to parse.
- $pk : the primary key to query on the $table table
parse all fields from a table, and replace values in title & content with the appropriate value
(not exported sub, used only internally)
+
=cut
+
sub parseletter {
my ($letter,$table,$pk) = @_;
# warn "Parseletter : ($letter,$table,$pk)";
$sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
} elsif ($table eq 'branches') {
$sth = $dbh->prepare("select * from branches where branchcode=?");
- }
+ } elsif ($table eq 'aqbooksellers') {
+ $sth = $dbh->prepare("select * from aqbooksellers where id=?");
+ }
$sth->execute($pk);
# store the result in an hash
my $values = $sth->fetchrow_hashref;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=cut
@ISA = qw(Exporter);
-@EXPORT = qw(&logaction &logstatus &displaylog);
+@EXPORT = qw(&logaction &GetLogStatus &displaylog &GetLogs);
=item logaction
Adds a record into action_logs table to report the different changes upon the database
=cut
+
#'
-sub logaction{
+sub logaction {
my ($usernumber,$modulename, $actionname, $objectnumber, $infos)=@_;
- $usernumber='' unless $usernumber;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info) values (now(),?,?,?,?,?)");
- $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$infos);
- $sth->finish;
+ $usernumber='' unless $usernumber;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Insert into action_logs (timestamp,user,module,action,object,info) values (now(),?,?,?,?,?)");
+ $sth->execute($usernumber,$modulename,$actionname,$objectnumber,$infos);
+ $sth->finish;
}
-=item logstatus
+=item GetLogStatus
+
+ $status = GetLogStatus;
- &logstatus;
+C<$status> is a hasref like this example:
+ $hash = {
+ BorrowersLog => 1,
+ CataloguingLog => 0,
+ IssueLog => 0,
+ ...
+ }
-returns True If Activate_Log variable is equal to On
-Activate_Log is a system preference Variable
=cut
+
#'
-sub logstatus{
- return C4::Context->preference("Activate_Log");
+sub GetLogStatus {
+ my %hash;
+ $hash{BorrowersLog} = C4::Context->preference("BorrowersLog");
+ $hash{CataloguingLog} = C4::Context->preference("CataloguingLog");
+ $hash{IssueLog} = C4::Context->preference("IssueLog");
+ $hash{ReturnLog} = C4::Context->preference("CataloguingLog");
+ $hash{SubscriptionLog} = C4::Context->preference("CataloguingLog");
+ $hash{LetterLog} = C4::Context->preference("LetterLog");
+ $hash{FinesLog} = C4::Context->preference("FinesLog");
+
+ return \%hash;
}
=item displaylog
&displaylog($modulename, @filters);
$modulename is the name of the module on which the user wants to display logs
@filters is an optional table of hash containing :
- - name : the name of the variable to filter
- - value : the value of the filter.... May be with * joker
+ - name : the name of the variable to filter
+ - value : the value of the filter.... May be with * joker
returns a table of hash containing who did what on which object at what time
=cut
+
#'
-sub displaylog{
- my ($modulename, @filters)=@_;
- my $dbh = C4::Context->dbh;
- my $strsth;
- if ($modulename eq "catalogue"){
- $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
- $strsth .= "biblio.biblionumber, biblio.title, biblio.author" ;#if ($modulename eq "acqui.simple");
- $strsth .= " FROM borrowers,action_logs ";
- $strsth .= ",biblio " ;#if ($modulename eq "acqui.simple");
-
- $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
- $strsth .=" AND action_logs.module = 'acqui.simple' AND action_logs.object=biblio.biblionumber ";# if ($modulename eq "acqui.simple");
- if (@filters){
- foreach my $filter (@filters){
- if ($filter->{name} =~ /user/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND borrowers.surname like ".$filter->{value};
- }elsif ($filter->{name} =~ /title/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND biblio.title like ".$filter->{value};
- }elsif ($filter->{name} =~ /author/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND biblio.author like ".$filter->{value};
- }
- }
- }
- } elsif ($modulename eq "acqui") {
- $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
- $strsth .= "biblio.biblionumber, biblio.title, biblio.author" ;#if ($modulename eq "acqui.simple");
- $strsth .= "FROM borrowers,action_logs ";
- $strsth .= ",biblio " ;#if ($modulename eq "acqui.simple");
-
- $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
- $strsth .= "AND action_logs.module = 'acqui.simple' AND action_logs.object=biblio.biblionumber ";# if ($modulename eq "acqui.simple");
- if (@filters){
- foreach my $filter (@filters){
- if ($filter->{name} =~ /user/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND borrowers.surname like ".$filter->{value};
- }elsif ($filter->{name} =~ /title/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND biblio.title like ".$filter->{value};
- }elsif ($filter->{name} =~ /author/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND biblio.author like ".$filter->{value};
- }
- }
- }
- } elsif ($modulename eq "members"){
- $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
- $strsth .= "bor2.cardnumber, bor2.surname, bor2.firstname, bor2.userid,";
- $strsth .= "FROM borrowers,action_logs,borrowers as bor2 ";
-
- $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
- $strsth .= "AND action_logs.module = 'members' AND action_logs.object=bor2.borrowernumber ";# if ($modulename eq "acqui.simple");
- if (@filters){
- foreach my $filter (@filters){
- if ($filter->{name} =~ /user/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND borrowers.surname like ".$filter->{value};
- }elsif ($filter->{name} =~ /surname/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND bor2.surname like ".$filter->{value};
- }elsif ($filter->{name} =~ /firstname/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND bor2.firsntame like ".$filter->{value};
- }elsif ($filter->{name} =~ /cardnumber/){
- $filter->{value}=~s/\*/%/g;
- $strsth .= " AND bor2.cardnumber like ".$filter->{value};
- }
- }
- }
- }
-# warn "displaylog :".$strsth;
- if ($strsth){
- my $sth=$dbh->prepare($strsth);
- $sth->execute;
- my @results;
- my $count;
- my $hilighted=1;
- while (my $data = $sth->fetchrow_hashref){
- $data->{hilighted} = ($hilighted>0);
- $data->{info} =~ s/\n/<br\/>/g;
- $data->{day} = format_date($data->{timestamp});
- push @results, $data;
- $count++;
- $hilighted = -$hilighted;
- }
- return ($count, \@results);
- } else {return 0;}
+sub displaylog {
+ my ($modulename, @filters) = @_;
+ my $dbh = C4::Context->dbh;
+ my $strsth;
+ if ($modulename eq "catalogue"){
+ $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
+ $strsth .= "biblio.biblionumber, biblio.title, biblio.author" ;#if ($modulename eq "acqui.simple");
+ $strsth .= " FROM borrowers,action_logs ";
+ $strsth .= ",biblio " ;#if ($modulename eq "acqui.simple");
+
+ $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
+ $strsth .=" AND action_logs.module = 'cataloguing' AND action_logs.object=biblio.biblionumber ";# if ($modulename eq "acqui.simple");
+ if (@filters) {
+ foreach my $filter (@filters) {
+ if ($filter->{name} =~ /user/) {
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND borrowers.surname like ".$filter->{value};
+ } elsif ($filter->{name} =~ /title/) {
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND biblio.title like ".$filter->{value};
+ } elsif ($filter->{name} =~ /author/) {
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND biblio.author like ".$filter->{value};
+ }
+ }
+ }
+ } elsif ($modulename eq "acqui") {
+ $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
+ $strsth .= "biblio.biblionumber, biblio.title, biblio.author" ;#if ($modulename eq "acqui.simple");
+ $strsth .= "FROM borrowers,action_logs ";
+ $strsth .= ",biblio " ;#if ($modulename eq "acqui.simple");
+
+ $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
+ $strsth .= "AND action_logs.module = 'cataloguing' AND action_logs.object=biblio.biblionumber ";# if ($modulename eq "acqui.simple");
+ if (@filters){
+ foreach my $filter (@filters){
+ if ($filter->{name} =~ /user/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND borrowers.surname like ".$filter->{value};
+ }elsif ($filter->{name} =~ /title/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND biblio.title like ".$filter->{value};
+ }elsif ($filter->{name} =~ /author/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND biblio.author like ".$filter->{value};
+ }
+ }
+ }
+ } elsif ($modulename eq "members"){
+ $strsth="select action_logs.timestamp, action_logs.action, action_logs.info, borrowers.cardnumber, borrowers.surname, borrowers.firstname, borrowers.userid,";
+ $strsth .= "bor2.cardnumber, bor2.surname, bor2.firstname, bor2.userid,";
+ $strsth .= "FROM borrowers,action_logs,borrowers as bor2 ";
+
+ $strsth .=" WHERE borrowers.borrowernumber=action_logs.user";
+ $strsth .= "AND action_logs.module = 'members' AND action_logs.object=bor2.borrowernumber ";# if ($modulename eq "acqui.simple");
+ if (@filters){
+ foreach my $filter (@filters){
+ if ($filter->{name} =~ /user/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND borrowers.surname like ".$filter->{value};
+ }elsif ($filter->{name} =~ /surname/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND bor2.surname like ".$filter->{value};
+ }elsif ($filter->{name} =~ /firstname/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND bor2.firsntame like ".$filter->{value};
+ }elsif ($filter->{name} =~ /cardnumber/){
+ $filter->{value}=~s/\*/%/g;
+ $strsth .= " AND bor2.cardnumber like ".$filter->{value};
+ }
+ }
+ }
+ }
+
+ if ($strsth){
+ my $sth=$dbh->prepare($strsth);
+ $sth->execute;
+ my @results;
+ my $count;
+ my $hilighted=1;
+ while (my $data = $sth->fetchrow_hashref){
+ $data->{hilighted} = ($hilighted>0);
+ $data->{info} =~ s/\n/<br\/>/g;
+ $data->{day} = format_date($data->{timestamp});
+ push @results, $data;
+ $count++;
+ $hilighted = -$hilighted;
+ }
+ return ($count, \@results);
+ } else {return 0;}
+}
+
+=head2 GetLogs
+
+$logs = GetLogs($datefrom,$dateto,$user,$module,$action,$object,$info);
+
+Return:
+C<$logs> is a ref to a hash which containts all columns from action_logs
+
+=cut
+
+sub GetLogs {
+ my $datefrom = shift;
+ my $dateto = shift;
+ my $user = shift;
+ my $module = shift;
+ my $action = shift;
+ my $object = shift;
+ my $info = shift;
+
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT *
+ FROM action_logs
+ WHERE 1
+ ";
+ $query .= " AND DATE_FORMAT(timestamp, '%Y-%m-%d') >= \"".$datefrom."\" " if $datefrom;
+ $query .= " AND DATE_FORMAT(timestamp, '%Y-%m-%d') <= \"".$dateto."\" " if $dateto;
+ $query .= " AND user LIKE \"%".$user."%\" " if $user;
+ $query .= " AND module LIKE \"%".$module."%\" " if $module;
+ $query .= " AND action LIKE \"%".$action."%\" " if $action;
+ $query .= " AND object LIKE \"%".$object."%\" " if $object;
+ $query .= " AND info LIKE \"%".$info."%\" " if $info;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ my @logs;
+ while( my $row = $sth->fetchrow_hashref ) {
+ $row->{$row->{module}} = 1;
+ push @logs , $row;
+ }
+ return \@logs;
}
+
END { } # module clean-up code here (global destructor)
1;
-# -*- tab-width: 8 -*-
-
package C4::Members;
# Copyright 2000-2003 Katipo Communications
use C4::Context;
use C4::Date;
use Digest::MD5 qw(md5_base64);
-use C4::Biblio;
-use C4::Stats;
-use C4::Reserves2;
-use C4::Koha;
-use C4::Accounts2;
-use C4::Circulation::Circ2;
+use Date::Calc qw/Today Add_Delta_YM/;
+use C4::Log; # logaction
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
=cut
-#'
-
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
-
-&allissues
-&add_member_orgs
-&borrdata
-&borrdata2
-&borrdata3
-&BornameSearch
-&borrissues
-&borrowercard_active
-&borrowercategories
-&change_user_pass
-&checkuniquemember
-&calcexpirydate
-&checkuserpassword
-
-ðnicitycategories
-&fixEthnicity
-&fixup_cardnumber
-&findguarantees
-&findguarantor
-&fixupneu_cardnumber
-
-&getmember
-&getMemberPhoto
-&get_institutions
-&getzipnamecity
-&getidcity
-&getguarantordata
-&getcategorytype
-&getboracctrecord
-&getborrowercategory
-&getborrowercategoryinfo
-&get_age
-&getpatroninformation
-&GetBorrowersFromSurname
-&GetBranchCodeFromBorrowers
-&GetFlagsAndBranchFromBorrower
-&GuarantornameSearch
-&NewBorrowerNumber
-&modmember
-&newmember
-&expand_sex_into_predicate
- );
-
-
-
-=head2 borrowercategories
-
- ($codes_arrayref, $labels_hashref) = &borrowercategories();
-
-Looks up the different types of borrowers in the database. Returns two
-elements: a reference-to-array, which lists the borrower category
-codes, and a reference-to-hash, which maps the borrower category codes
-to category descriptions.
-
-=cut
-#'
-
-sub borrowercategories {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
- $sth->execute;
- my %labels;
- my @codes;
- while (my $data=$sth->fetchrow_hashref){
- push @codes,$data->{'categorycode'};
- $labels{$data->{'categorycode'}}=$data->{'description'};
- }
- $sth->finish;
- return(\@codes,\%labels);
-}
+ &BornameSearch &GetMember
+ &borrdata &borrdata2
+ &fixup_cardnumber &findguarantees &findguarantor &GuarantornameSearch
+ &modmember &newmember &changepassword &borrissues &allissues
+ &checkuniquemember &getzipnamecity &getidcity &getguarantordata &getcategorytype
+ &DeleteBorrower
+ &calcexpirydate &checkuserpassword
+ &getboracctrecord
+ &GetborCatFromCatType &getborrowercategory
+ &fixEthnicity
+ ðnicitycategories &get_institutions add_member_orgs
+ &get_age &GetBorrowersFromSurname &GetBranchCodeFromBorrowers
+ &GetFlagsAndBranchFromBorrower
+ &GetCities &GetRoadTypes &GetRoadTypeDetails &GetBorNotifyAcctRecord
+ &GetMembeReregistration
+ &GetSortDetails
+ &GetBorrowersTitles
+ &GetBorrowersWhoHaveNotBorrowedSince
+ &GetBorrowersWhoHaveNeverBorrowed
+ &GetBorrowersWithIssuesHistoryOlderThan
+);
=item BornameSearch
C<$count> is the number of elements in C<$borrowers>.
=cut
+
#'
#used by member enquiries from the intranet
#called by member.pl
-sub BornameSearch {
- my ($env,$searchstring,$orderby,$type)=@_;
- my $dbh = C4::Context->dbh;
- my $query = ""; my $count;
- my @data;
- my @bind=();
-
- if($type eq "simple") # simple search for one letter only
- {
- $query="Select * from borrowers where surname like '$searchstring%' order by $orderby";
-# @bind=("$searchstring%");
- }
- else # advanced search looking in surname, firstname and othernames
- {
-### Try to determine whether numeric like cardnumber
- if ($searchstring+1>1) {
- $query="Select * from borrowers where cardnumber like '$searchstring%' ";
-
- }else{
-
- my @words=split / /,$searchstring;
- foreach my $word(@words){
- $word="+".$word;
-
- }
- $searchstring=join " ",@words;
-
- $query="Select * from borrowers where MATCH(surname,firstname,othernames) AGAINST('$searchstring' in boolean mode)";
-
- }
- $query=$query." order by $orderby";
- }
-
- my $sth=$dbh->prepare($query);
-# warn "Q $orderby : $query";
- $sth->execute();
- my @results;
- my $cnt=$sth->rows;
- while (my $data=$sth->fetchrow_hashref){
- push(@results,$data);
- }
- # $sth->execute;
- $sth->finish;
- return ($cnt,\@results);
-}
-=head2 getpatroninformation
-
- ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
-Looks up a patron and returns information about him or her. If
-C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
-up the borrower by number; otherwise, it looks up the borrower by card
-number.
-C<$env> is effectively ignored, but should be a reference-to-hash.
-C<$borrower> is a reference-to-hash whose keys are the fields of the
-borrowers table in the Koha database. In addition,
-C<$borrower-E<gt>{flags}> is a hash giving more detailed information
-about the patron. Its keys act as flags :
-
- if $borrower->{flags}->{LOST} {
- # Patron's card was reported lost
- }
-
-Each flag has a C<message> key, giving a human-readable explanation of
-the flag. If the state of a flag means that the patron should not be
-allowed to borrow any more books, then it will have a C<noissues> key
-with a true value.
-
-The possible flags are:
-
-=head3 CHARGES
-
-=over 4
-
-Shows the patron's credit or debt, if any.
-
-=back
-
-=head3 GNA
-
-=over 4
-
-(Gone, no address.) Set if the patron has left without giving a
-forwarding address.
-
-=back
-
-=head3 LOST
-
-=over 4
-
-Set if the patron's card has been reported as lost.
-
-=back
-
-=head3 DBARRED
-
-=over 4
-
-Set if the patron has been debarred.
-
-=back
-
-=head3 NOTES
-
-=over 4
-
-Any additional notes about the patron.
-
-=back
-
-=head3 ODUES
-
-=over 4
-
-Set if the patron has overdue items. This flag has several keys:
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
-overdue items. Its elements are references-to-hash, each describing an
-overdue item. The keys are selected fields from the issues, biblio,
-biblioitems, and items tables of the Koha database.
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
-the overdue items, one per line.
-
-=back
-
-=head3 WAITING
-
-=over 4
+sub BornameSearch {
+ my ( $env, $searchstring, $orderby, $type ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "";
+ my $count;
+ my @data;
+ my @bind = ();
-Set if any items that the patron has reserved are available.
+ if ( $type eq "simple" ) # simple search for one letter only
+ {
+ $query =
+ "SELECT * FROM borrowers
+ LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
+ WHERE surname LIKE ? ORDER BY $orderby";
+ @bind = ("$searchstring%");
+ }
+ else # advanced search looking in surname, firstname and othernames
+ {
+ @data = split( ' ', $searchstring );
+ $count = @data;
+ $query = "SELECT * FROM borrowers
+ LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
+ WHERE ((surname LIKE ? OR surname LIKE ?
+ OR firstname LIKE ? OR firstname LIKE ?
+ OR othernames LIKE ? OR othernames LIKE ?)
+ ";
+ @bind = (
+ "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
+ "$data[0]%", "% $data[0]%"
+ );
+ for ( my $i = 1 ; $i < $count ; $i++ ) {
+ $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
+ OR firstname LIKE ? OR firstname LIKE ?
+ OR othernames LIKE ? OR othernames LIKE ?)";
+ push( @bind,
+ "$data[$i]%", "% $data[$i]%", "$data[$i]%",
+ "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
-C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
-available items. Each element is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database.
+ # FIXME - .= <<EOT;
+ }
+ $query = $query . ") OR cardnumber LIKE ?
+ order by $orderby";
+ push( @bind, $searchstring );
-=back
+ # FIXME - .= <<EOT;
+ }
-=back
+ my $sth = $dbh->prepare($query);
-=cut
+ # warn "Q $orderby : $query";
+ $sth->execute(@bind);
+ my @results;
+ my $cnt = $sth->rows;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
+ }
-sub getpatroninformation {
-# returns
- my ($env, $borrowernumber,$cardnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $query;
- my $sth;
- if ($borrowernumber) {
- $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
- $sth->execute($borrowernumber);
- } elsif ($cardnumber) {
- $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
- $sth->execute($cardnumber);
- } else {
- $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
- return();
- }
- my $borrower = $sth->fetchrow_hashref;
- my $amount = C4::Accounts2::checkaccount($env, $borrowernumber, $dbh);
- $borrower->{'amountoutstanding'} = $amount;
- my $flags = C4::Circulation::Circ2::patronflags($env, $borrower, $dbh);
- my $accessflagshash;
-
- $sth=$dbh->prepare("select bit,flag from userflags");
- $sth->execute;
- while (my ($bit, $flag) = $sth->fetchrow) {
- if ($borrower->{'flags'} & 2**$bit) {
- $accessflagshash->{$flag}=1;
- }
- }
- $sth->finish;
- $borrower->{'flags'}=$flags;
- $borrower->{'authflags'} = $accessflagshash;
- return ($borrower); #, $flags, $accessflagshash);
+ # $sth->execute;
+ $sth->finish;
+ return ( $cnt, \@results );
}
-=item getmember
-
- $borrower = &getmember($cardnumber, $borrowernumber);
-
-Looks up information about a patron (borrower) by either card number
-or borrower number. If $borrowernumber is specified, C<&borrdata>
-searches by borrower number; otherwise, it searches by card number.
-
-C<&getmember> returns a reference-to-hash whose keys are the fields of
-the C<borrowers> table in the Koha database.
-
-=cut
-
=head3 GetFlagsAndBranchFromBorrower
=over 4
=cut
-
-
-=item borrissues
-
- ($count, $issues) = &borrissues($borrowernumber);
-
-Looks up what the patron with the given borrowernumber has borrowed.
-
-C<&borrissues> returns a two-element array. C<$issues> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, and C<items> tables
-in the Koha database. C<$count> is the number of elements in
-C<$issues>.
-
-=cut
-#'
-sub borrissues {
- my ($bornum)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=?
- and items.itemnumber=issues.itemnumber
- and items.biblionumber=biblio.biblionumber
- and issues.returndate is NULL order by date_due");
- $sth->execute($bornum);
- my @result;
- while (my $data = $sth->fetchrow_hashref) {
- push @result, $data;
- }
- $sth->finish;
- return(scalar(@result), \@result);
-}
-
-=item allissues
-
- ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
-
-Looks up what the patron with the given borrowernumber has borrowed,
-and sorts the results.
-
-C<$sortkey> is the name of a field on which to sort the results. This
-should be the name of a field in the C<issues>, C<biblio>,
-C<biblioitems>, or C<items> table in the Koha database.
-
-C<$limit> is the maximum number of results to return.
-
-C<&allissues> returns a two-element array. C<$issues> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
-C<items> tables of the Koha database. C<$count> is the number of
-elements in C<$issues>
-
-=cut
-#'
-sub allissues {
- my ($bornum,$order,$limit)=@_;
- #FIXME: sanity-check order and limit
- my $dbh = C4::Context->dbh;
- my $query="Select * from issues,biblio,items
- where borrowernumber=? and
- items.itemnumber=issues.itemnumber and
- items.biblionumber=biblio.biblionumber order by $order";
- if ($limit !=0){
- $query.=" limit $limit";
- }
- #print $query;
- my $sth=$dbh->prepare($query);
- $sth->execute($bornum);
- my @result;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $result[$i]=$data;;
- $i++;
- }
- $sth->finish;
- return($i,\@result);
-}
-
-
-sub borrdata3 {
-## NEU specific. used in Reserve section issues
- my ($env,$bornum)=@_;
- my $dbh = C4::Context->dbh;
- my $query="Select count(*) from reserveissue as r where r.borrowernumber='$bornum'
- and rettime is null";
- # print $query;
- my $sth=$dbh->prepare($query);
- $sth->execute;
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- $sth=$dbh->prepare("Select count(*),timediff(now(), duetime ) as elapsed, hour(timediff(now(), duetime )) as hours, MINUTE(timediff(now(), duetime )) as min from
- reserveissue as r where r.borrowernumber='$bornum' and rettime is null and duetime< now() group by r.borrowernumber");
- $sth->execute;
-
- my $data2=$sth->fetchrow_hashref;
-my $resfine;
-my $rescharge=C4::Context->preference('resmaterialcharge');
- if (!$rescharge){
- $rescharge=1;
- }
- if ($data2->{'elapsed'}>0){
- $resfine=($data2->{'hours'}+$data2->{'min'}/60)*$rescharge;
- $resfine=sprintf ("%.1f",$resfine);
- }
- $sth->finish;
- $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
- borrowernumber='$bornum'");
- $sth->execute;
- my $data3=$sth->fetchrow_hashref;
- $sth->finish;
-
-
-return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'},$resfine);
-}
-=item getboracctrecord
-
- ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
-
-Looks up accounting data for the patron with the given borrowernumber.
-
-C<$env> is ignored.
-
-
-C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields of the C<accountlines> table in the Koha database.
-C<$count> is the number of elements in C<$acctlines>. C<$total> is the
-total amount outstanding for all of the account lines.
-
-=cut
-#'
-sub getboracctrecord {
- my ($env,$params) = @_;
- my $dbh = C4::Context->dbh;
- my @acctlines;
- my $numlines=0;
- my $sth=$dbh->prepare("Select * from accountlines where
-borrowernumber=? order by date desc,timestamp desc");
-# print $query;
- $sth->execute($params->{'borrowernumber'});
- my $total=0;
- while (my $data=$sth->fetchrow_hashref){
- $acctlines[$numlines] = $data;
- $numlines++;
- $total += $data->{'amountoutstanding'};
- }
- $sth->finish;
- return ($numlines,\@acctlines,$total);
-}
-
-sub getborrowercategory{
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
- $sth->execute($catcode);
- my $description = $sth->fetchrow();
- $sth->finish();
- return $description;
-} # sub getborrowercategory
-
-sub getborrowercategoryinfo{
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?");
- $sth->execute($catcode);
- my $category = $sth->fetchrow_hashref;
- $sth->finish();
- return $category;
-} # sub getborrowercategoryinfo
-
-
sub GetFlagsAndBranchFromBorrower {
my $loggedinuser = @_;
- my $dbh = C4::Context->dbh;
- my $query = "
+ my $dbh = C4::Context->dbh;
+ my $query = "
SELECT flags, branchcode
FROM borrowers
WHERE borrowernumber = ?
return $sth->fetchrow;
}
+=item GetMember
+
+ $borrower = &GetMember($cardnumber, $borrowernumber);
+
+Looks up information about a patron (borrower) by either card number
+or borrower number. If $borrowernumber is specified, C<&borrdata>
+searches by borrower number; otherwise, it searches by card number.
+
+C<&GetMember> returns a reference-to-hash whose keys are the fields of
+the C<borrowers> table in the Koha database.
+
+=cut
-sub getmember {
- my ( $cardnumber, $bornum ) = @_;
+sub GetMember {
+ my ( $cardnumber, $borrowernumber ) = @_;
$cardnumber = uc $cardnumber;
my $dbh = C4::Context->dbh;
my $sth;
- if ( $bornum eq '' ) {
+ if ( $borrowernumber eq '' ) {
$sth = $dbh->prepare("Select * from borrowers where cardnumber=?");
$sth->execute($cardnumber);
- } else {
+ }
+ else {
$sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
- $sth->execute($bornum);
+ $sth->execute($borrowernumber);
}
my $data = $sth->fetchrow_hashref;
$sth->finish;
#'
sub borrdata {
- my ( $cardnumber, $bornum ) = @_;
+ my ( $cardnumber, $borrowernumber ) = @_;
$cardnumber = uc $cardnumber;
my $dbh = C4::Context->dbh;
my $sth;
- if ( $bornum eq '' ) {
+ if ( $borrowernumber eq '' ) {
$sth =
$dbh->prepare(
"Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?"
$dbh->prepare(
"Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"
);
- $sth->execute($bornum);
+ $sth->execute($borrowernumber);
}
my $data = $sth->fetchrow_hashref;
-# warn "DATA" . $data->{category_type};
+
$sth->finish;
if ($data) {
return ($data);
}
- else { # try with firstname
- if ($cardnumber) {
- my $sth =
+ elsif ($cardnumber) { # try with firstname
+ my $sth =
$dbh->prepare(
"Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where firstname=?"
- );
+ );
$sth->execute($cardnumber);
my $data = $sth->fetchrow_hashref;
$sth->finish;
return ($data);
- }
}
- return undef;
+ else {
+ return undef;
+ }
}
=item borrdata2
#'
sub borrdata2 {
- my ( $env, $bornum ) = @_;
+ my ( $env, $borrowernumber ) = @_;
my $dbh = C4::Context->dbh;
- my $query = "Select count(*) from issues where borrowernumber='$bornum' and
+ my $query =
+ "Select count(*) from issues where borrowernumber='$borrowernumber' and
returndate is NULL";
# print $query;
$sth->finish;
$sth = $dbh->prepare(
"Select count(*) from issues where
- borrowernumber='$bornum' and date_due < now() and returndate is NULL"
+ borrowernumber='$borrowernumber' and date_due < now() and returndate is NULL"
);
$sth->execute;
my $data2 = $sth->fetchrow_hashref;
$sth->finish;
$sth = $dbh->prepare(
"Select sum(amountoutstanding) from accountlines where
- borrowernumber='$bornum'"
+ borrowernumber='$borrowernumber'"
);
$sth->execute;
my $data3 = $sth->fetchrow_hashref;
}
sub modmember {
- my (%data) = @_;
- my $dbh = C4::Context->dbh;
- $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
-
-
- $data{'joining'}=format_date_in_iso($data{'joining'});
-
- if ($data{'expiry'}) {
- $data{'expiry'}=format_date_in_iso($data{'expiry'});
- }else{
-
- $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'} );
-
- }
-
- my $query= "UPDATE borrowers SET
- cardnumber = '$data{'cardnumber'}' ,
- surname = '$data{'surname'}' ,
- firstname = '$data{'firstname'}' ,
- title = '$data{'title'}' ,
- initials = '$data{'initials'}' ,
- dateofbirth = '$data{'dateofbirth'}' ,
- sex = '$data{'sex'}' ,
- streetaddress = '$data{'streetaddress'}' ,
- streetcity = '$data{'streetcity'}' ,
- zipcode = '$data{'zipcode'}' ,
- phoneday = '$data{'phoneday'}' ,
- physstreet = '$data{'physstreet'}' ,
- city = '$data{'city'}' ,
- homezipcode = '$data{'homezipcode'}' ,
- phone = '$data{'phone'}' ,
- emailaddress = '$data{'emailaddress'}' ,
- preferredcont = '$data{'preferredcont'}',
- faxnumber = '$data{'faxnumber'}' ,
- textmessaging = '$data{'textmessaging'}' ,
- categorycode = '$data{'categorycode'}' ,
- branchcode = '$data{'branchcode'}' ,
- borrowernotes = '$data{'borrowernotes'}' ,
- ethnicity = '$data{'ethnicity'}' ,
- ethnotes = '$data{'ethnotes'}' ,
- expiry = '$data{'expiry'}' ,
- dateenrolled = '$data{'joining'}' ,
- sort1 = '$data{'sort1'}' ,
- sort2 = '$data{'sort2'}' ,
- debarred = '$data{'debarred'}' ,
- lost = '$data{'lost'}' ,
- gonenoaddress = '$data{'gna'}'
- WHERE borrowernumber = $data{'borrowernumber'}";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- $sth->finish;
- # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
- # so when we update information for an adult we should check for guarantees and update the relevant part
- # of their records, ie addresses and phone numbers
- if ($data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W'){
- # is adult check guarantees;
- updateguarantees(%data);
- }
-}
+ my (%data) = @_;
+ my $dbh = C4::Context->dbh;
+ $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
+ $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
+ $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
-sub newmember {
- my (%data) = @_;
- my $dbh = C4::Context->dbh;
- $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
-
-
- if ($data{'joining'}){
- $data{'joining'}=format_date_in_iso($data{'joining'});
- }else{
- $data{'joining'} = get_today();
- }
- # if expirydate is not set, calculate it from borrower category subscription duration
- if ($data{'expiry'}) {
- $data{'expiry'}=format_date_in_iso($data{'expiry'});
- }else{
-
- $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'});
- }
-
- my $query= "INSERT INTO borrowers (
- cardnumber,
- surname,
- firstname,
- title,
- initials,
- dateofbirth,
- sex,
- streetaddress,
- streetcity,
- zipcode,
- phoneday,
- physstreet,
- city,
- homezipcode,
- phone,
- emailaddress,
- faxnumber,
- textmessaging,
- preferredcont,
- categorycode,
- branchcode,
- borrowernotes,
- ethnicity,
- ethnotes,
- expiry,
- dateenrolled,
- sort1,
- sort2
- )
- VALUES (
- '$data{'cardnumber'}',
- '$data{'surname'}',
- '$data{'firstname'}',
- '$data{'title'}',
- '$data{'initials'}',
- '$data{'dateofbirth'}',
- '$data{'sex'}',
-
- '$data{'streetaddress'}',
- '$data{'streetcity'}',
- '$data{'zipcode'}',
- '$data{'phoneday'}',
-
- '$data{'physstreet'}',
- '$data{'city'}',
- '$data{'homezipcode'}',
- '$data{'phone'}',
-
- '$data{'emailaddress'}',
- '$data{'faxnumber'}',
- '$data{'textmessaging'}',
- '$data{'preferredcont'}',
- '$data{'categorycode'}',
- '$data{'branchcode'}',
- '$data{'borrowernotes'}',
- '$data{'ethnicity'}',
- '$data{'ethnotes'}',
- '$data{'expiry'}',
- '$data{'joining'}',
- '$data{'sort1'}',
- '$data{'sort2'}'
- )";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- $sth->finish;
- $data{'bornum'} =$dbh->{'mysql_insertid'};
- return $data{'bornum'};
+ # warn "num user".$data{'borrowernumber'};
+ my $query;
+ my $sth;
+ $data{'userid'} = '' if ( $data{'password'} eq '' );
+
+ # test to know if u must update or not the borrower password
+ if ( $data{'password'} eq '****' ) {
+
+ $query = "UPDATE borrowers SET
+ cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
+ streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
+ email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
+ B_streettype = ?,B_address = ?,B_city = ?,B_zipcode = ?,B_email = ?,B_phone = ?,dateofbirth = ?,branchcode = ?,
+ categorycode = ?,dateenrolled = ?,dateexpiry = ?,gonenoaddress = ?,lost = ?,debarred = ?,contactname = ?,
+ contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
+ ethnotes = ?,sex = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
+ WHERE borrowernumber=$data{'borrowernumber'}";
+ $sth = $dbh->prepare($query);
+ $sth->execute(
+ $data{'cardnumber'}, $data{'surname'},
+ $data{'firstname'}, $data{'title'},
+ $data{'othernames'}, $data{'initials'},
+ $data{'streetnumber'}, $data{'streettype'},
+ $data{'address'}, $data{'address2'},
+ $data{'city'}, $data{'zipcode'},
+ $data{'email'}, $data{'phone'},
+ $data{'mobile'}, $data{'fax'},
+ $data{'emailpro'}, $data{'phonepro'},
+ $data{'B_streetnumber'}, $data{'B_streettype'},
+ $data{'B_address'}, $data{'B_city'},
+ $data{'B_zipcode'}, $data{'B_email'},
+ $data{'B_phone'}, $data{'dateofbirth'},
+ $data{'branchcode'}, $data{'categorycode'},
+ $data{'dateenrolled'}, $data{'dateexpiry'},
+ $data{'gonenoaddress'}, $data{'lost'},
+ $data{'debarred'}, $data{'contactname'},
+ $data{'contactfirstname'}, $data{'contacttitle'},
+ $data{'guarantorid'}, $data{'borrowernotes'},
+ $data{'relationship'}, $data{'ethnicity'},
+ $data{'ethnotes'}, $data{'sex'},
+ $data{'userid'}, $data{'opacnote'},
+ $data{'contactnote'}, $data{'sort1'},
+ $data{'sort2'}
+ );
+ }
+ else {
+
+ ( $data{'password'} = md5_base64( $data{'password'} ) )
+ if ( $data{'password'} ne '' );
+ $query = "UPDATE borrowers SET
+ cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
+ streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
+ email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
+ B_streettype = ?,B_address = ?,B_city = ?,B_zipcode = ?,B_email = ?,B_phone = ?,dateofbirth = ?,branchcode = ?,
+ categorycode = ?,dateenrolled = ?,dateexpiry = ?,gonenoaddress = ?,lost = ?,debarred = ?,contactname = ?,
+ contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
+ ethnotes = ?,sex = ?,password = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
+ WHERE borrowernumber=$data{'borrowernumber'}";
+ $sth = $dbh->prepare($query);
+ $sth->execute(
+ $data{'cardnumber'}, $data{'surname'},
+ $data{'firstname'}, $data{'title'},
+ $data{'othernames'}, $data{'initials'},
+ $data{'streetnumber'}, $data{'streettype'},
+ $data{'address'}, $data{'address2'},
+ $data{'city'}, $data{'zipcode'},
+ $data{'email'}, $data{'phone'},
+ $data{'mobile'}, $data{'fax'},
+ $data{'emailpro'}, $data{'phonepro'},
+ $data{'B_streetnumber'}, $data{'B_streettype'},
+ $data{'B_address'}, $data{'B_city'},
+ $data{'B_zipcode'}, $data{'B_email'},
+ $data{'B_phone'}, $data{'dateofbirth'},
+ $data{'branchcode'}, $data{'categorycode'},
+ $data{'dateenrolled'}, $data{'dateexpiry'},
+ $data{'gonenoaddress'}, $data{'lost'},
+ $data{'debarred'}, $data{'contactname'},
+ $data{'contactfirstname'}, $data{'contacttitle'},
+ $data{'guarantorid'}, $data{'borrowernotes'},
+ $data{'relationship'}, $data{'ethnicity'},
+ $data{'ethnotes'}, $data{'sex'},
+ $data{'password'}, $data{'userid'},
+ $data{'opacnote'}, $data{'contactnote'},
+ $data{'sort1'}, $data{'sort2'}
+ );
+ }
+ $sth->finish;
+
+# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
+# so when we update information for an adult we should check for guarantees and update the relevant part
+# of their records, ie addresses and phone numbers
+ my ( $category_type, undef ) = getcategorytype( $data{'category_type'} );
+ if ( $category_type eq 'A' ) {
+
+ # is adult check guarantees;
+ updateguarantees(%data);
+
+ }
+ &logaction(C4::Context->userenv->{'number'},"MEMBERS","MODIFY",$data{'borrowernumber'},"")
+ if C4::Context->preference("BorrowersLog");
}
-sub calcexpirydate {
- my ( $categorycode, $dateenrolled ) = @_;
+sub newmember {
+ my (%data) = @_;
my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "select enrolmentperiod from categories where categorycode=?");
- $sth->execute($categorycode);
- my ($enrolmentperiod) = $sth->fetchrow;
-$enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years
- my $duration=get_duration($enrolmentperiod." years");
- return DATE_Add_Duration($dateenrolled,$duration);
+ $data{'userid'} = '' unless $data{'password'};
+ $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
+ $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
+ $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
+ $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
+ my $query =
+ "insert into borrowers set cardnumber="
+ . $dbh->quote( $data{'cardnumber'} )
+ . ",surname="
+ . $dbh->quote( $data{'surname'} )
+ . ",firstname="
+ . $dbh->quote( $data{'firstname'} )
+ . ",title="
+ . $dbh->quote( $data{'title'} )
+ . ",othernames="
+ . $dbh->quote( $data{'othernames'} )
+ . ",initials="
+ . $dbh->quote( $data{'initials'} )
+ . ",streetnumber="
+ . $dbh->quote( $data{'streetnumber'} )
+ . ",streettype="
+ . $dbh->quote( $data{'streettype'} )
+ . ",address="
+ . $dbh->quote( $data{'address'} )
+ . ",address2="
+ . $dbh->quote( $data{'address2'} )
+ . ",zipcode="
+ . $dbh->quote( $data{'zipcode'} )
+ . ",city="
+ . $dbh->quote( $data{'city'} )
+ . ",phone="
+ . $dbh->quote( $data{'phone'} )
+ . ",email="
+ . $dbh->quote( $data{'email'} )
+ . ",mobile="
+ . $dbh->quote( $data{'mobile'} )
+ . ",phonepro="
+ . $dbh->quote( $data{'phonepro'} )
+ . ",opacnote="
+ . $dbh->quote( $data{'opacnote'} )
+ . ",guarantorid="
+ . $dbh->quote( $data{'guarantorid'} )
+ . ",dateofbirth="
+ . $dbh->quote( $data{'dateofbirth'} )
+ . ",branchcode="
+ . $dbh->quote( $data{'branchcode'} )
+ . ",categorycode="
+ . $dbh->quote( $data{'categorycode'} )
+ . ",dateenrolled="
+ . $dbh->quote( $data{'dateenrolled'} )
+ . ",contactname="
+ . $dbh->quote( $data{'contactname'} )
+ . ",borrowernotes="
+ . $dbh->quote( $data{'borrowernotes'} )
+ . ",dateexpiry="
+ . $dbh->quote( $data{'dateexpiry'} )
+ . ",contactnote="
+ . $dbh->quote( $data{'contactnote'} )
+ . ",B_address="
+ . $dbh->quote( $data{'B_address'} )
+ . ",B_zipcode="
+ . $dbh->quote( $data{'B_zipcode'} )
+ . ",B_city="
+ . $dbh->quote( $data{'B_city'} )
+ . ",B_phone="
+ . $dbh->quote( $data{'B_phone'} )
+ . ",B_email="
+ . $dbh->quote( $data{'B_email'}, )
+ . ",password="
+ . $dbh->quote( $data{'password'} )
+ . ",userid="
+ . $dbh->quote( $data{'userid'} )
+ . ",sort1="
+ . $dbh->quote( $data{'sort1'} )
+ . ",sort2="
+ . $dbh->quote( $data{'sort2'} )
+ . ",contacttitle="
+ . $dbh->quote( $data{'contacttitle'} )
+ . ",emailpro="
+ . $dbh->quote( $data{'emailpro'} )
+ . ",contactfirstname="
+ . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
+ . $dbh->quote( $data{'sex'} ) . ",fax="
+ . $dbh->quote( $data{'fax'} )
+ . ",relationship="
+ . $dbh->quote( $data{'relationship'} )
+ . ",B_streetnumber="
+ . $dbh->quote( $data{'B_streetnumber'} )
+ . ",B_streettype="
+ . $dbh->quote( $data{'B_streettype'} )
+ . ",gonenoaddress="
+ . $dbh->quote( $data{'gonenoaddress'} )
+ . ",lost="
+ . $dbh->quote( $data{'lost'} )
+ . ",debarred="
+ . $dbh->quote( $data{'debarred'} )
+ . ",ethnicity="
+ . $dbh->quote( $data{'ethnicity'} )
+ . ",ethnotes="
+ . $dbh->quote( $data{'ethnotes'} );
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $data{'borrowernumber'} = $dbh->{'mysql_insertid'};
+ &logaction(C4::Context->userenv->{'number'},"MEMBERS","CREATE",$data{'borrowernumber'},"")
+ if C4::Context->preference("BorrowersLog");
+
+ return $data{'borrowernumber'};
}
-=head2 checkuserpassword (OUEST-PROVENCE)
-
-check for the password and login are not used
-return the number of record
-0=> NOT USED 1=> USED
-
-=cut
-
-sub checkuserpassword {
- my ( $borrowernumber, $userid, $password ) = @_;
- $password = md5_base64($password);
+sub changepassword {
+ my ( $uid, $member, $digest ) = @_;
my $dbh = C4::Context->dbh;
+
+#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
+#Then we need to tell the user and have them create a new one.
my $sth =
$dbh->prepare(
-"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
- );
- $sth->execute( $borrowernumber, $userid, $password );
- my $number_rows = $sth->fetchrow;
- return $number_rows;
+ "select * from borrowers where userid=? and borrowernumber != ?");
+ $sth->execute( $uid, $member );
+ if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) {
+ return 0;
+ }
+ else {
+ #Everything is good so we can update the information.
+ $sth =
+ $dbh->prepare(
+ "update borrowers set userid=?, password=? where borrowernumber=?");
+ $sth->execute( $uid, $digest, $member );
+ return 1;
+ }
+
+ &logaction(C4::Context->userenv->{'number'},"MEMBERS","CHANGE PASS",$member,"")
+ if C4::Context->preference("BorrowersLog");
}
+
sub getmemberfromuserid {
my ($userid) = @_;
my $dbh = C4::Context->dbh;
$sth->execute($userid);
return $sth->fetchrow_hashref;
}
+
sub updateguarantees {
my (%data) = @_;
my $dbh = C4::Context->dbh;
# It looks like the $i is only being returned to handle walking through
# the array, which is probably better done as a foreach loop.
#
- my $guaquery =
-"update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
- streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
- ,streetaddress='$data{'address'}'
- where borrowernumber='$guarantees->[$i]->{'borrowernumber'}'";
+ my $guaquery = qq|UPDATE borrowers
+ SET address='$data{'address'}',fax='$data{'fax'}',
+ B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
+ WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
+ |;
my $sth3 = $dbh->prepare($guaquery);
$sth3->execute;
$sth3->finish;
}
}
-################################################################################
=item fixup_cardnumber
my ($cardnumber) = @_;
my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
$autonumber_members = 0 unless defined $autonumber_members;
-my $rem;
+
# Find out whether member numbers should be generated
# automatically. Should be either "1" or something else.
# Defaults to "0", which is interpreted as "no".
my $data = $sth->fetchrow_hashref;
$cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
$sth->finish;
-
- if ( !$cardnumber ) { # If DB has no values,
+ if ( !$cardnumber ) { # If DB has no values,
$cardnumber = 1000000; # start at 1000000
- } else {
+ }
+ else {
$cardnumber += 1;
- }
+ }
my $sum = 0;
- for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
+ for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
# read weightings, left to right, 1 char at a time
my $temp1 = $weightings[$i];
# mult each char 1-7 by its corresponding weighting
$sum += $temp1 * $temp2;
- }
+ }
- $rem = ( $sum % 11 );
+ my $rem = ( $sum % 11 );
$rem = 'X' if $rem == 10;
$cardnumber = "V$cardnumber$rem";
$sth->execute;
- $cardnumber="V$cardnumber$rem";
+ my ($result) = $sth->fetchrow;
+ $sth->finish;
+ $cardnumber = $result + 1;
+ }
}
return $cardnumber;
}
-}
-sub fixupneu_cardnumber{
- my($cardnumber,$categorycode) = @_;
- my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
- $autonumber_members = 0 unless defined $autonumber_members;
- # Find out whether member numbers should be generated
- # automatically. Should be either "1" or something else.
- # Defaults to "0", which is interpreted as "no".
-my $dbh = C4::Context->dbh;
-my $sth;
- if (!$cardnumber && $autonumber_members && $categorycode) {
- if ($categorycode eq "A" || $categorycode eq "W" ){
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' ");
- }elsif ($categorycode eq "L"){
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '10%' ");
- }elsif ($categorycode eq "F" || $categorycode eq "E") {
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '30%' ");
- }elsif ($categorycode eq "N"){
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '40%' ");
- }elsif ($categorycode eq "C"){
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '80%' ");
-
- }else{
- $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '6%' ");
- }
- $sth->execute;
-
- my $data=$sth->fetchrow_hashref;
- $cardnumber=$data->{'max(borrowers.cardnumber)'};
- $sth->finish;
-
- # purpose: generate checksum'd member numbers.
- # We'll assume we just got the max value of digits 2-8 of member #'s
- # from the database and our job is to increment that by one,
- # determine the 1st and 9th digits and return the full string.
-
- if (! $cardnumber) { # If DB has no values,
- if ($categorycode eq "A" || $categorycode eq "W" ){ $cardnumber = 5000000;}
- elsif ($categorycode eq "L"){ $cardnumber = 1000000;}
- elsif ($categorycode eq "F"){ $cardnumber = 3000000;}
- elsif ($categorycode eq "C"){ $cardnumber = 8000000;}
- elsif ($categorycode eq "N"){ $cardnumber = 4000000;}
- else{$cardnumber = 6000000;}
- # start at 1000000 or 3000000 or 5000000
- } else {
- $cardnumber += 1;
- }
-
-
+
+=head2 findguarantees
+
+ ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
+ $child0_cardno = $children_arrayref->[0]{"cardnumber"};
+ $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
+
+C<&findguarantees> takes a borrower number (e.g., that of a patron
+with children) and looks up the borrowers who are guaranteed by that
+borrower (i.e., the patron's children).
+
+C<&findguarantees> returns two values: an integer giving the number of
+borrowers guaranteed by C<$parent_borrno>, and a reference to an array
+of references to hash, which gives the actual results.
+
+=cut
+
+#'
+sub findguarantees {
+ my ($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
+ );
+ $sth->execute($borrowernumber);
+
+ my @dat;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @dat, $data;
}
- return $cardnumber;
+ $sth->finish;
+ return ( scalar(@dat), \@dat );
+}
+
+=head2 findguarantor
+
+ $guarantor = &findguarantor($borrower_no);
+ $guarantor_cardno = $guarantor->{"cardnumber"};
+ $guarantor_surname = $guarantor->{"surname"};
+ ...
+
+C<&findguarantor> takes a borrower number (presumably that of a child
+patron), finds the guarantor for C<$borrower_no> (the child's parent),
+and returns the record for the guarantor.
+
+C<&findguarantor> returns a reference-to-hash. Its keys are the fields
+from the C<borrowers> database table;
+
+=cut
+
+#'
+sub findguarantor {
+ my ($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select guarantorid from borrowers where borrowernumber=?");
+ $sth->execute($borrowernumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
+ $sth->execute( $data->{'guarantorid'} );
+ $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
}
=item GuarantornameSearch
return ( $cnt, \@results );
}
+=head2 borrissues
-=item findguarantees
+ ($count, $issues) = &borrissues($borrowernumber);
- ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
- $child0_cardno = $children_arrayref->[0]{"cardnumber"};
- $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
+Looks up what the patron with the given borrowernumber has borrowed.
-C<&findguarantees> takes a borrower number (e.g., that of a patron
-with children) and looks up the borrowers who are guaranteed by that
-borrower (i.e., the patron's children).
+C<&borrissues> returns a two-element array. C<$issues> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields from the C<issues>, C<biblio>, and C<items> tables
+in the Koha database. C<$count> is the number of elements in
+C<$issues>.
-C<&findguarantees> returns two values: an integer giving the number of
-borrowers guaranteed by C<$parent_borrno>, and a reference to an array
-of references to hash, which gives the actual results.
+=cut
+
+#'
+sub borrissues {
+ my ($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from issues,biblio,items where borrowernumber=?
+ and items.itemnumber=issues.itemnumber
+ and items.biblionumber=biblio.biblionumber
+ and issues.returndate is NULL order by date_due"
+ );
+ $sth->execute($borrowernumber);
+ my @result;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @result, $data;
+ }
+ $sth->finish;
+ return ( scalar(@result), \@result );
+}
+
+=head2 allissues
+
+ ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
+
+Looks up what the patron with the given borrowernumber has borrowed,
+and sorts the results.
+
+C<$sortkey> is the name of a field on which to sort the results. This
+should be the name of a field in the C<issues>, C<biblio>,
+C<biblioitems>, or C<items> table in the Koha database.
+
+C<$limit> is the maximum number of results to return.
+
+C<&allissues> returns a two-element array. C<$issues> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
+C<items> tables of the Koha database. C<$count> is the number of
+elements in C<$issues>
=cut
+
#'
-sub findguarantees{
- my ($bornum)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?");
- $sth->execute($bornum);
-
- my @dat;
- while (my $data = $sth->fetchrow_hashref)
- {
- push @dat, $data;
- }
- $sth->finish;
- return (scalar(@dat), \@dat);
+sub allissues {
+ my ( $borrowernumber, $order, $limit ) = @_;
+
+ #FIXME: sanity-check order and limit
+ my $dbh = C4::Context->dbh;
+ my $count = 0;
+ my $query =
+"Select *,items.timestamp AS itemstimestamp from issues,biblio,items,biblioitems
+ where borrowernumber=? and
+ items.biblioitemnumber=biblioitems.biblioitemnumber and
+ items.itemnumber=issues.itemnumber and
+ items.biblionumber=biblio.biblionumber order by $order";
+ if ( $limit != 0 ) {
+ $query .= " limit $limit";
+ }
+
+ #print $query;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my @result;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $result[$i] = $data;
+ $i++;
+ $count++;
+ }
+
+ # get all issued items for borrowernumber from oldissues table
+ # large chunk of older issues data put into table oldissues
+ # to speed up db calls for issuing items
+ if ( C4::Context->preference("ReadingHistory") ) {
+ my $query2 = "SELECT * FROM oldissues,biblio,items,biblioitems
+ WHERE borrowernumber=?
+ AND items.biblioitemnumber=biblioitems.biblioitemnumber
+ AND items.itemnumber=oldissues.itemnumber
+ AND items.biblionumber=biblio.biblionumber
+ ORDER BY $order";
+ if ( $limit != 0 ) {
+ $limit = $limit - $count;
+ $query2 .= " limit $limit";
+ }
+
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute($borrowernumber);
+
+ while ( my $data2 = $sth2->fetchrow_hashref ) {
+ $result[$i] = $data2;
+ $i++;
+ }
+ $sth2->finish;
+ }
+ $sth->finish;
+
+ return ( $i, \@result );
+}
+
+=head2 getboracctrecord
+
+ ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
+
+Looks up accounting data for the patron with the given borrowernumber.
+
+C<$env> is ignored.
+
+(FIXME - I'm not at all sure what this is about.)
+
+C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields of the C<accountlines> table in the Koha database.
+C<$count> is the number of elements in C<$acctlines>. C<$total> is the
+total amount outstanding for all of the account lines.
+
+=cut
+
+#'
+sub getboracctrecord {
+ my ( $env, $params ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @acctlines;
+ my $numlines = 0;
+ my $sth = $dbh->prepare(
+ "Select * from accountlines where
+borrowernumber=? order by date desc,timestamp desc"
+ );
+
+ $sth->execute( $params->{'borrowernumber'} );
+ my $total = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ #FIXME before reinstating: insecure?
+ # if ($data->{'itemnumber'} ne ''){
+ # $query="Select * from items,biblio where items.itemnumber=
+ # '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
+ # my $sth2=$dbh->prepare($query);
+ # $sth2->execute;
+ # my $data2=$sth2->fetchrow_hashref;
+ # $sth2->finish;
+ # $data=$data2;
+ # }
+ $acctlines[$numlines] = $data;
+ $numlines++;
+ $total += $data->{'amountoutstanding'};
+ }
+ $sth->finish;
+ return ( $numlines, \@acctlines, $total );
}
-=item findguarantor
+=head2 GetBorNotifyAcctRecord
- $guarantor = &findguarantor($borrower_no);
- $guarantor_cardno = $guarantor->{"cardnumber"};
- $guarantor_surname = $guarantor->{"surname"};
- ...
+ ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($env, $params,$notifyid);
-C<&findguarantor> takes a borrower number (presumably that of a child
-patron), finds the guarantor for C<$borrower_no> (the child's parent),
-and returns the record for the guarantor.
+Looks up accounting data for the patron with the given borrowernumber per file number.
-C<&findguarantor> returns a reference-to-hash. Its keys are the fields
-from the C<borrowers> database table;
+C<$env> is ignored.
-=cut
-#'
-sub findguarantor{
- my ($bornum)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?");
- $sth->execute($bornum);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
- $sth->execute($data->{'guarantor'});
- $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data);
-}
+(FIXME - I'm not at all sure what this is about.)
-sub borrowercard_active {
- my ($bornum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT expiry FROM borrowers WHERE (borrowernumber = ?) AND (NOW() <= expiry)");
- $sth->execute($bornum);
- if (my $data=$sth->fetchrow_hashref){
- return ('1');
- }else{
- return ('0');
- }
-}
+C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields of the C<accountlines> table in the Koha database.
+C<$count> is the number of elements in C<$acctlines>. C<$total> is the
+total amount outstanding for all of the account lines.
-# Search the member photo, in case that photo doesn´t exists, return a default photo.for NEU
-sub getMemberPhoto {
- my $cardnumber = shift @_;
- my $htdocs = C4::Context->config('opacdir');
-my $dirname = $htdocs."/htdocs/uploaded-files/users-photo/";
-# my $dirname = "$ENV{'DOCUMENT_ROOT'}/uploaded-files/users-photo";
- opendir(DIR, $dirname) or die "Can't open directory $dirname: $!";
- while (defined(my $file = readdir(DIR))) {
- if ($file =~ /^$cardnumber\..+/){
- return "/uploaded-files/users-photo/$file";
- }
- }
- closedir(DIR);
- return "http://cc.neu.edu.tr/stdpictures/".$cardnumber.".jpg";
-}
+=cut
-sub change_user_pass {
- my ($uid,$member,$digest) = @_;
- my $dbh = C4::Context->dbh;
- #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
- #Then we need to tell the user and have them create a new one.
- my $sth=$dbh->prepare("select * from borrowers where userid=? and borrowernumber <> ?");
- $sth->execute($uid,$member);
- if ( ($uid ne '') && ($sth->fetchrow) ) {
-
- return 0;
- } else {
- #Everything is good so we can update the information.
- $sth=$dbh->prepare("update borrowers set userid=?, password=? where borrowernumber=?");
- $sth->execute($uid, $digest, $member);
- return 1;
- }
+sub GetBorNotifyAcctRecord {
+ my ( $env, $params, $notifyid ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @acctlines;
+ my $numlines = 0;
+ my $query = qq| SELECT *
+ FROM accountlines
+ WHERE borrowernumber=?
+ AND notify_id=?
+ AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
+ AND amountoutstanding != '0'
+ ORDER BY notify_id,accounttype
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $params->{'borrowernumber'}, $notifyid );
+ my $total = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $acctlines[$numlines] = $data;
+ $numlines++;
+ $total += $data->{'amountoutstanding'};
+ }
+ $sth->finish;
+ return ( $numlines, \@acctlines, $total );
}
=head2 checkuniquemember (OUEST-PROVENCE)
C<&dateofbirth> is the date of birth (only if collectivity=0)
=cut
+
sub checkuniquemember {
my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
my $dbh = C4::Context->dbh;
return 0;
}
}
+
=head2 getzipnamecity (OUEST-PROVENCE)
take all info from table city for the fields city and zip
}
=head2 getdcity (OUEST-PROVENCE)
+
recover cityid with city_name condition
+
=cut
sub getidcity {
return $category_type, $description;
}
+sub calcexpirydate {
+ my ( $categorycode, $dateenrolled ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "select enrolmentperiod from categories where categorycode=?");
+ $sth->execute($categorycode);
+ my ($enrolmentperiod) = $sth->fetchrow;
+ $enrolmentperiod = 12 unless ($enrolmentperiod);
+# warn "Avant format_date_in_iso :".$dateenrolled;
+# $dateenrolled=format_date_in_iso($dateenrolled);
+# warn "Apres format_date_in_iso :".$dateenrolled;
+ my @date=split /-/,format_date_in_iso($dateenrolled);
+ @date=Add_Delta_YM($date[0],$date[1],$date[2],0,$enrolmentperiod);
+ return sprintf("%04d-%02d-%02d",$date[0],$date[1],$date[2]);
+}
+
+=head2 checkuserpassword (OUEST-PROVENCE)
+
+check for the password and login are not used
+return the number of record
+0=> NOT USED 1=> USED
+
+=cut
+
+sub checkuserpassword {
+ my ( $borrowernumber, $userid, $password ) = @_;
+ $password = md5_base64($password);
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
+ );
+ $sth->execute( $borrowernumber, $userid, $password );
+ my $number_rows = $sth->fetchrow;
+ return $number_rows;
+
+}
+
+=head2 GetborCatFromCatType
+
+ ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
+Looks up the different types of borrowers in the database. Returns two
+elements: a reference-to-array, which lists the borrower category
+codes, and a reference-to-hash, which maps the borrower category codes
+to category descriptions.
+
+=cut
+
+#'
+sub GetborCatFromCatType {
+ my ( $category_type, $action ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $request = qq| SELECT categorycode,description
+ FROM categories
+ $action
+ ORDER BY categorycode|;
+ my $sth = $dbh->prepare($request);
+ if ($action) {
+ $sth->execute($category_type);
+ }
+ else {
+ $sth->execute();
+ }
+
+ my %labels;
+ my @codes;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @codes, $data->{'categorycode'};
+ $labels{ $data->{'categorycode'} } = $data->{'description'};
+ }
+ $sth->finish;
+ return ( \@codes, \%labels );
+}
+=head2 getborrowercategory
+ $description,$dateofbirthrequired,$upperagelimit,$category_type = &getborrowercategory($categorycode);
+Given the borrower's category code, the function returns the corresponding
+description , dateofbirthrequired , upperagelimit and category type for a comprehensive information display.
+=cut
-# # A better approach might be to set borrowernumber autoincrement and
-#
- sub NewBorrowerNumber {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
- $sth->execute;
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- $data->{'max(borrowernumber)'}++;
- return($data->{'max(borrowernumber)'});
- }
+sub getborrowercategory {
+ my ($catcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"SELECT description,dateofbirthrequired,upperagelimit,category_type FROM categories WHERE categorycode = ?"
+ );
+ $sth->execute($catcode);
+ my ( $description, $dateofbirthrequired, $upperagelimit, $category_type ) =
+ $sth->fetchrow();
+ $sth->finish();
+ return ( $description, $dateofbirthrequired, $upperagelimit,
+ $category_type );
+} # sub getborrowercategory
=head2 ethnicitycategories
#'
-sub fixEthnicity($) {
-
+sub fixEthnicity {
my $ethnicity = shift;
+ return unless $ethnicity;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
$sth->execute($ethnicity);
return $data->{'name'};
} # sub fixEthnicity
-
-
=head2 get_age
$dateofbirth,$date = &get_age($date);
this function return the borrowers age with the value of dateofbirth
=cut
+
#'
sub get_age {
- my ($date, $date_ref) = @_;
+ my ( $date, $date_ref ) = @_;
- if (not defined $date_ref) {
- $date_ref = get_today();
+ if ( not defined $date_ref ) {
+ $date_ref = sprintf( '%04d-%02d-%02d', Today() );
}
- my ($year1, $month1, $day1) = split /-/, $date;
- my ($year2, $month2, $day2) = split /-/, $date_ref;
+ my ( $year1, $month1, $day1 ) = split /-/, $date;
+ my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
my $age = $year2 - $year1;
- if ($month1.$day1 > $month2.$day2) {
+ if ( $month1 . $day1 > $month2 . $day2 ) {
$age--;
}
return $age;
-}# sub get_age
-
-
+} # sub get_age
=head2 get_institutions
$insitutions = get_institutions();
Just returns a list of all the borrowers of type I, borrownumber and name
+
=cut
#'
my $query =
"INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
my $sth = $dbh->prepare($query);
- foreach my $bornum (@$otherborrowers) {
- $sth->execute( $borrowernumber, $bornum );
+ foreach my $otherborrowernumber (@$otherborrowers) {
+ $sth->execute( $borrowernumber, $otherborrowernumber );
}
$sth->finish();
=back
=cut
-sub GetBorrowersFromSurname {
- my ($searchstring)=@_;
+
+sub GetBorrowersFromSurname {
+ my ($searchstring) = @_;
my $dbh = C4::Context->dbh;
- $searchstring=~ s/\'/\\\'/g;
- my @data=split(' ',$searchstring);
- my $count=@data;
+ $searchstring =~ s/\'/\\\'/g;
+ my @data = split( ' ', $searchstring );
+ my $count = @data;
my $query = qq|
SELECT surname,firstname
FROM borrowers
WHERE (surname like ?)
ORDER BY surname
|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute("$data[0]%");
my @results;
- my $count = 0;
- while (my $data=$sth->fetchrow_hashref){
- push(@results,$data);
- $count++;
+ $count = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
+ $count++;
+ }
+ $sth->finish;
+ return ( $count, \@results );
+}
+
+=head2 citycaracteristiques (OUEST-PROVENCE)
+
+ ($id_cityarrayref, $city_hashref) = &citycaracteristic();
+
+Looks up the different city and zip in the database. Returns two
+elements: a reference-to-array, which lists the zip city
+codes, and a reference-to-hash, which maps the name of the city.
+WHERE =>OUEST PROVENCE OR EXTERIEUR
+
+=cut
+
+sub GetCities {
+
+ #my ($type_city) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT cityid,city_name
+ FROM cities
+ ORDER BY city_name|;
+ my $sth = $dbh->prepare($query);
+
+ #$sth->execute($type_city);
+ $sth->execute();
+ my %city;
+ my @id;
+
+ # insert empty value to create a empty choice in cgi popup
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ push @id, $data->{'cityid'};
+ $city{ $data->{'cityid'} } = $data->{'city_name'};
+ }
+
+#test to know if the table contain some records if no the function return nothing
+ my $id = @id;
+ $sth->finish;
+ if ( $id eq 0 ) {
+ return ();
+ }
+ else {
+ unshift( @id, "" );
+ return ( \@id, \%city );
+ }
+}
+
+=head2 GetSortDetails (OUEST-PROVENCE)
+
+ ($lib) = &GetSortDetails($category,$sortvalue);
+
+Returns the authorized value details
+C<&$lib>return value of authorized value details
+C<&$sortvalue>this is the value of authorized value
+C<&$category>this is the value of authorized value category
+
+=cut
+
+sub GetSortDetails {
+ my ( $category, $sortvalue ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT lib
+ FROM authorised_values
+ WHERE category=?
+ AND authorised_value=? |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $category, $sortvalue );
+ my $lib = $sth->fetchrow;
+ return ($lib);
+}
+
+=head2 DeleteBorrower
+
+ () = &DeleteBorrower($member);
+
+delete all data fo borrowers and add record to deletedborrowers table
+C<&$member>this is the borrowernumber
+
+=cut
+
+sub DeleteBorrower {
+ my ($member) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ $query = qq|SELECT *
+ FROM borrowers
+ WHERE borrowernumber=?|;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($member);
+ my @data = $sth->fetchrow_array;
+ $sth->finish;
+ $sth =
+ $dbh->prepare( "Insert into deletedborrowers values ("
+ . ( "?," x ( scalar(@data) - 1 ) )
+ . "?)" );
+ $sth->execute(@data);
+ $sth->finish;
+ $query = qq|DELETE
+ FROM borrowers
+ WHERE borrowernumber=?|;
+ $sth = $dbh->prepare($query);
+ $sth->execute($member);
+ $sth->finish;
+ $query = qq|DELETE
+ FROM reserves
+ WHERE borrowernumber=?|;
+ $sth = $dbh->prepare($query);
+ $sth->execute($member);
+ $sth->finish;
+
+ # logging to action_log
+ &logaction(C4::Context->userenv->{'number'},"MEMBERS","DELETE",$member,"")
+ if C4::Context->preference("BorrowersLog");
+}
+
+=head2 DelBorrowerCompletly
+
+DelBorrowerCompletly($borrowernumber);
+
+This function remove directly a borrower whitout writing it on deleteborrower.
+
+=cut
+
+sub DelBorrowerCompletly {
+ my $dbh = C4::Context->dbh;
+ my $borrowernumber = shift;
+ return unless $borrowernumber; # date is mandatory.
+ my $query = "
+ DELETE *
+ FROM borrowers
+ WHERE borrowernumber = ?
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ return $sth->rows;
+}
+
+=head2 member_reregistration (OUEST-PROVENCE)
+
+automatic reregistration in borrowers table
+with dateexpiry .
+
+=cut
+
+sub GetMembeReregistration {
+ my ( $categorycode, $borrowerid ) = @_;
+ my $dbh = C4::Context->dbh;
+ my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
+ localtime(time);
+ $mon++;
+ $year = $year + 1900;
+ if ( $mon < '10' ) {
+ $mon = "0" . $mon;
+ }
+ if ( $mday < '10' ) {
+ $mday = "0" . $mday;
+ }
+ my $today = sprintf("%04d-%02d-%02d",$year,$mon,$mday);
+ my $dateexpiry = calcexpirydate( $categorycode, $today );
+ my $query = qq| UPDATE borrowers
+ SET dateexpiry='$dateexpiry'
+ WHERE borrowernumber='$borrowerid'|;
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ return $dateexpiry;
+}
+
+=head2 GetRoadTypes (OUEST-PROVENCE)
+
+ ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
+
+Looks up the different road type . Returns two
+elements: a reference-to-array, which lists the id_roadtype
+codes, and a reference-to-hash, which maps the road type of the road .
+
+
+=cut
+
+sub GetRoadTypes {
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT roadtypeid,road_type
+ FROM roadtype
+ ORDER BY road_type|;
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my %roadtype;
+ my @id;
+
+ # insert empty value to create a empty choice in cgi popup
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ push @id, $data->{'roadtypeid'};
+ $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
+ }
+
+#test to know if the table contain some records if no the function return nothing
+ my $id = @id;
+ $sth->finish;
+ if ( $id eq 0 ) {
+ return ();
+ }
+ else {
+ unshift( @id, "" );
+ return ( \@id, \%roadtype );
+ }
+}
+
+
+
+=head2 GetBorrowersTitles (OUEST-PROVENCE)
+
+ ($borrowertitle)= &GetBorrowersTitles();
+
+Looks up the different title . Returns array with all borrowers title
+
+=cut
+
+sub GetBorrowersTitles {
+ my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
+ unshift( @borrowerTitle, "" );
+ return ( \@borrowerTitle);
+ }
+
+
+
+=head2 GetRoadTypeDetails (OUEST-PROVENCE)
+
+ ($roadtype) = &GetRoadTypeDetails($roadtypeid);
+
+Returns the description of roadtype
+C<&$roadtype>return description of road type
+C<&$roadtypeid>this is the value of roadtype s
+
+=cut
+
+sub GetRoadTypeDetails {
+ my ($roadtypeid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT road_type
+ FROM roadtype
+ WHERE roadtypeid=?|;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($roadtypeid);
+ my $roadtype = $sth->fetchrow;
+ return ($roadtype);
+}
+
+=head2 GetBorrowersWhoHaveNotBorrowedSince
+
+&GetBorrowersWhoHaveNotBorrowedSince($date)
+
+this function get all borrowers who haven't borrowed since the date given on input arg.
+
+=cut
+
+sub GetBorrowersWhoHaveNotBorrowedSince {
+ my $date = shift;
+ return unless $date; # date is mandatory.
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT borrowers.borrowernumber,max(timestamp)
+ FROM borrowers
+ LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
+ WHERE issues.borrowernumber IS NOT NULL
+ GROUP BY borrowers.borrowernumber
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @results;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
+ }
+ return \@results;
+}
+
+=head2 GetBorrowersWhoHaveNeverBorrowed
+
+$results = &GetBorrowersWhoHaveNeverBorrowed
+
+this function get all borrowers who have never borrowed.
+
+I<$result> is a ref to an array which all elements are a hasref.
+
+=cut
+
+sub GetBorrowersWhoHaveNeverBorrowed {
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ SELECT borrowers.borrowernumber,max(timestamp)
+ FROM borrowers
+ LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
+ WHERE issues.borrowernumber IS NULL
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
}
- $sth->finish;
- return ($count,\@results);
+ return \@results;
}
-=head2 expand_sex_into_predicate
+=head2 GetBorrowersWithIssuesHistoryOlderThan
- $data{&expand_sex_into_predicate($data{sex})} = 1;
+$results = &GetBorrowersWithIssuesHistoryOlderThan($date)
-Converts a single 'M' or 'F' into 'sex_M_p' or 'sex_F_p'
-respectively.
+this function get all borrowers who has an issue history older than I<$date> given on input arg.
-In some languages, 'M' and 'F' are not appropriate. However,
-with HTML::Template, there is no way to localize 'M' or 'F'
-unless these are converted into variables that TMPL_IF can
-understand. This function provides this conversion.
+I<$result> is a ref to an array which all elements are a hashref.
+This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
=cut
-sub expand_sex_into_predicate ($) {
- my($sex) = @_;
- return "sex_${sex}_p";
-} # expand_sex_into_predicate
+sub GetBorrowersWithIssuesHistoryOlderThan {
+ my $dbh = C4::Context->dbh;
+ my $date = shift;
+ return unless $date; # date is mandatory.
+ my $query = "
+ SELECT count(borrowernumber) as n,borrowernumber
+ FROM issues
+ WHERE returndate < ?
+ AND borrowernumber IS NOT NULL
+ GROUP BY borrowernumber
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($date);
+ my @results;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
+ }
+ return \@results;
+}
+
+END { } # module clean-up code here (global destructor)
+
1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Team
+
+=cut
-package C4::NewsChannels;
-
-# Copyright 2000-2002 Katipo Communications
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-use strict;
-
-use C4::Context;
-use C4::Date;
-
-use vars qw($VERSION @ISA @EXPORT);
-
-# set the version for version checking
-$VERSION = 0.01;
-
-=head1 NAME
-
-C4::NewsChannels - Functions to manage the news channels and its categories
-
-=head1 DESCRIPTION
-
-This module provides the functions needed to admin the news channels and its categories
-
-=head1 FUNCTIONS
-
-=over 2
-
-=cut
-
-
-@ISA = qw(Exporter);
+package C4::NewsChannels;\r
+\r
+# Copyright 2000-2002 Katipo Communications\r
+#\r
+# This file is part of Koha.\r
+#\r
+# Koha is free software; you can redistribute it and/or modify it under the\r
+# terms of the GNU General Public License as published by the Free Software\r
+# Foundation; either version 2 of the License, or (at your option) any later\r
+# version.\r
+#\r
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY\r
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR\r
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.\r
+#\r
+# You should have received a copy of the GNU General Public License along with\r
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,\r
+# Suite 330, Boston, MA 02111-1307 USA\r
+\r
+use strict;\r
+\r
+use C4::Context;\r
+use C4::Date;\r
+\r
+use vars qw($VERSION @ISA @EXPORT);\r
+\r
+# set the version for version checking\r
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;\r
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );\r
+};\r
+\r
+=head1 NAME\r
+\r
+C4::NewsChannels - Functions to manage the news channels and its categories\r
+\r
+=head1 DESCRIPTION\r
+\r
+This module provides the functions needed to admin the news channels and its categories\r
+\r
+=head1 FUNCTIONS\r
+\r
+=over 2\r
+\r
+=cut\r
+\r
+\r
+@ISA = qw(Exporter);\r
@EXPORT = qw(
- &news_channels &get_new_channel &del_channels &add_channel &update_channel
- &news_channels_categories &get_new_channel_category &del_channels_categories
- &add_channel_category &update_channel_category &news_channels_by_category
-&add_opac_new &upd_opac_new &del_opac_new &get_opac_new &get_opac_news
- &add_opac_electronic &upd_opac_electronic &del_opac_electronic &get_opac_electronic &get_opac_electronics
-);
-
-
-=item news_channels
-
- ($count, @channels) = &news_channels($channel_name, $id_category, $unclassified);
-
-Looks up news channels by name or category.
-
-C<$channel_name> is the channel name to search.
-
-C<$id_category> is the channel category code to search.
-
-C<$$unclassified> if it is set and $channel_name and $id_category search for the news channels without a category
-
-if none of the params are set C<&news_channels> returns all the news channels.
-
-C<&news_channels> returns two values: an integer giving the number of
-news channels found and a reference to an array
-of references to hash, which has the news_channels and news_channels_categories fields.
-
+ &GetNewsToDisplay\r
+ &news_channels &get_new_channel &del_channels &add_channel &update_channel\r
+ &news_channels_categories &get_new_channel_category &del_channels_categories\r
+ &add_channel_category &update_channel_category &news_channels_by_category\r
+&add_opac_new &upd_opac_new &del_opac_new &get_opac_new &get_opac_news\r
+ &add_opac_electronic &upd_opac_electronic &del_opac_electronic &get_opac_electronic &get_opac_electronics\r
+);\r
+\r
+\r
+=item news_channels\r
+\r
+ ($count, @channels) = &news_channels($channel_name, $id_category, $unclassified);\r
+\r
+Looks up news channels by name or category.\r
+\r
+C<$channel_name> is the channel name to search.\r
+\r
+C<$id_category> is the channel category code to search.\r
+\r
+C<$$unclassified> if it is set and $channel_name and $id_category search for the news channels without a category\r
+\r
+if none of the params are set C<&news_channels> returns all the news channels.\r
+\r
+C<&news_channels> returns two values: an integer giving the number of\r
+news channels found and a reference to an array\r
+of references to hash, which has the news_channels and news_channels_categories fields.\r
+\r
+=cut\r
+\r
+sub news_channels {\r
+ my ($channel_name, $id_category, $unclassified) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my @channels;\r
+ my $query = "SELECT * FROM news_channels LEFT JOIN news_channels_categories ON news_channels.id_category = news_channels_categories.id_category";\r
+ if ( ($channel_name ne '') && ($id_category ne '') ) {\r
+ $query.= " WHERE channel_name like '" . $channel_name . "%' AND news_channels.id_category = " . $id_category;\r
+ } elsif ($channel_name ne '') {\r
+ $query.= " WHERE channel_name like '" . $channel_name . "%'";\r
+ } elsif ($id_category ne '') {\r
+ $query.= " WHERE news_channels.id_category = " . $id_category;\r
+ } elsif ($unclassified) {\r
+ $query.= " WHERE news_channels.id_category IS NULL ";\r
+ }\r
+ my $sth = $dbh->prepare($query);\r
+ $sth->execute();\r
+ while (my $row = $sth->fetchrow_hashref) {\r
+ push @channels, $row;\r
+ }\r
+ $sth->finish;\r
+ return (scalar(@channels), @channels);\r
+}\r
+\r
+=item news_channels_by_category\r
+\r
+ ($count, @results) = &news_channels_by_category();\r
+\r
+Looks up news channels grouped by category.\r
+\r
+C<&news_channels_by_category> returns two values: an integer giving the number of\r
+categories found and a reference to an array\r
+of references to hash, which the following keys: \r
+\r
+=over 4\r
+\r
+=item C<channels_count>\r
+\r
+The number of news channels in that category\r
+\r
+=item C<channels>\r
+\r
+A reference to an array of references to hash which keys are the new_channels fields. \r
+\r
+Additionally the last index of results has a reference to all the news channels which don't have a category \r
+\r
+=cut\r
+\r
+sub news_channels_by_category {\r
+ \r
+ my ($categories_count, @results) = &news_channels_categories();\r
+ foreach my $row (@results) {\r
+\r
+ my ($channels_count, @channels) = &news_channels('', $row->{'id_category'});\r
+ $row->{'channels_count'} = $channels_count;\r
+ $row->{'channels'} = \@channels;\r
+ }\r
+\r
+ my ($channels_count, @channels) = &news_channels('', '', 1);\r
+ my %row;\r
+ $row{'id_category'} = -1;\r
+ $row{'unclassified'} = 1;\r
+ $row{'channels_count'} = $channels_count;\r
+ $row{'channels'} = \@channels;\r
+ push @results, \%row;\r
+\r
+ return (scalar(@results), @results);\r
+}\r
+\r
+sub get_new_channel {\r
+ my ($id) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("SELECT * FROM news_channels WHERE id = ?");\r
+ $sth->execute($id);\r
+ my $channel = $sth->fetchrow_hashref;\r
+ $sth->finish;\r
+ return $channel;\r
+}\r
+\r
+sub del_channels {\r
+ my ($ids) = @_;\r
+ if ($ids ne '') {\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("DELETE FROM news_channels WHERE id IN ($ids) ");\r
+ $sth->execute();\r
+ $sth->finish;\r
+ return $ids;\r
+ }\r
+ return 0;\r
+}\r
+\r
+sub add_channel {\r
+ my ($name, $url, $id_category, $notes) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("INSERT INTO news_channels (channel_name, url, id_category, notes) VALUES (?,?,?,?)");\r
+ $sth->execute($name, $url, $id_category, $notes);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub update_channel {\r
+ my ($id, $name, $url, $id_category, $notes) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("UPDATE news_channels SET channel_name = ?, url = ?, id_category = ?, notes = ? WHERE id = ?");\r
+ $sth->execute($name, $url, $id_category, $notes, $id);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub news_channels_categories {\r
+ my $dbh = C4::Context->dbh;\r
+ my @categories;\r
+ my $query = "SELECT * FROM news_channels_categories";\r
+ my $sth = $dbh->prepare($query);\r
+ $sth->execute();\r
+ while (my $row = $sth->fetchrow_hashref) {\r
+ push @categories, $row;\r
+ }\r
+ $sth->finish;\r
+ return (scalar(@categories), @categories);\r
+\r
+}\r
+\r
+sub get_new_channel_category {\r
+ my ($id) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("SELECT * FROM news_channels_categories WHERE id_category = ?");\r
+ $sth->execute($id);\r
+ my $category = $sth->fetchrow_hashref;\r
+ $sth->finish;\r
+ return $category;\r
+}\r
+\r
+sub del_channels_categories {\r
+ my ($ids) = @_;\r
+ if ($ids ne '') {\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("UPDATE news_channels SET id_category = NULL WHERE id_category IN ($ids) ");\r
+ $sth->execute();\r
+ $sth = $dbh->prepare("DELETE FROM news_channels_categories WHERE id_category IN ($ids) ");\r
+ $sth->execute();\r
+ $sth->finish;\r
+ return $ids;\r
+ }\r
+ return 0;\r
+}\r
+\r
+sub add_channel_category {\r
+ my ($name) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("INSERT INTO news_channels_categories (category_name) VALUES (?)");\r
+ $sth->execute($name);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub update_channel_category {\r
+ my ($id, $name) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("UPDATE news_channels_categories SET category_name = ? WHERE id_category = ?");\r
+ $sth->execute($name, $id);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub add_opac_new {\r
+ my ($title, $new, $lang, $expirationdate, $number) = @_;
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("INSERT INTO opac_news (title, new, lang, expirationdate, number) VALUES (?,?,?,?,?)");\r
+ $sth->execute($title, $new, $lang, $expirationdate, $number);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub upd_opac_new {\r
+ my ($idnew, $title, $new, $lang, $expirationdate, $number) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("
+ UPDATE opac_news SET
+ title = ?,
+ new = ?,
+ lang = ?,
+ expirationdate = ?,
+ number = ?
+ WHERE idnew = ?
+ ");\r
+ $sth->execute($title, $new, $lang, $expirationdate,$number,$idnew);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub del_opac_new {\r
+ my ($ids) = @_;\r
+ if ($ids) {\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("DELETE FROM opac_news WHERE idnew IN ($ids)");\r
+ $sth->execute();\r
+ $sth->finish;\r
+ return 1;\r
+ } else {\r
+ return 0;\r
+ }\r
+}\r
+\r
+sub get_opac_new {\r
+ my ($idnew) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("SELECT * FROM opac_news WHERE idnew = ?");\r
+ $sth->execute($idnew);\r
+ my $data = $sth->fetchrow_hashref;\r
+ $data->{$data->{'lang'}} = 1;\r
+ $sth->finish;\r
+ return $data;\r
+}\r
+\r
+sub get_opac_news {\r
+ my ($limit, $lang) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_news";\r
+ if ($lang) {\r
+ $query.= " WHERE lang = '" .$lang ."' ";\r
+ }\r
+ $query.= " ORDER BY timestamp DESC ";\r
+ #if ($limit) {\r
+ # $query.= "LIMIT 0, " . $limit;\r
+ #}\r
+ my $sth = $dbh->prepare($query);\r
+ $sth->execute();\r
+ my @opac_news;\r
+ my $count = 0;\r
+ while (my $row = $sth->fetchrow_hashref) {\r
+ if ((($limit) && ($count < $limit)) || (!$limit)) {\r
+ $row->{'newdate'} = format_date($row->{'newdate'});\r
+ push @opac_news, $row;\r
+ }\r
+ $count++;\r
+ }\r
+ return ($count, \@opac_news);\r
+}\r
+
+=head2 GetNewsToDisplay
+
+ $news = &GetNewsToDisplay($lang);
+ C<$news> is a ref to an array which containts
+ all news with expirationdate > today or expirationdate is null.
+
=cut
-sub news_channels {
- my ($channel_name, $id_category, $unclassified) = @_;
- my $dbh = C4::Context->dbh;
- my @channels;
- my $query = "SELECT * FROM news_channels LEFT JOIN news_channels_categories ON news_channels.id_category = news_channels_categories.id_category";
- if ( ($channel_name ne '') && ($id_category ne '') ) {
- $query.= " WHERE channel_name like '" . $channel_name . "%' AND news_channels.id_category = " . $id_category;
- } elsif ($channel_name ne '') {
- $query.= " WHERE channel_name like '" . $channel_name . "%'";
- } elsif ($id_category ne '') {
- $query.= " WHERE news_channels.id_category = " . $id_category;
- } elsif ($unclassified) {
- $query.= " WHERE news_channels.id_category IS NULL ";
- }
- my $sth = $dbh->prepare($query);
- $sth->execute();
- while (my $row = $sth->fetchrow_hashref) {
- push @channels, $row;
- }
- $sth->finish;
- return (scalar(@channels), @channels);
-}
-
-=item news_channels_by_category
-
- ($count, @results) = &news_channels_by_category();
-
-Looks up news channels grouped by category.
-
-C<&news_channels_by_category> returns two values: an integer giving the number of
-categories found and a reference to an array
-of references to hash, which the following keys:
-
-=over 4
-
-=item C<channels_count>
-
-The number of news channels in that category
-
-=item C<channels>
-
-A reference to an array of references to hash which keys are the new_channels fields.
-
-Additionally the last index of results has a reference to all the news channels which don't have a category
-
-=cut
-
-sub news_channels_by_category {
-
- my ($categories_count, @results) = &news_channels_categories();
- foreach my $row (@results) {
-
- my ($channels_count, @channels) = &news_channels('', $row->{'id_category'});
- $row->{'channels_count'} = $channels_count;
- $row->{'channels'} = \@channels;
- }
-
- my ($channels_count, @channels) = &news_channels('', '', 1);
- my %row;
- $row{'id_category'} = -1;
- $row{'unclassified'} = 1;
- $row{'channels_count'} = $channels_count;
- $row{'channels'} = \@channels;
- push @results, \%row;
-
- return (scalar(@results), @results);
-}
-
-sub get_new_channel {
- my ($id) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM news_channels WHERE id = ?");
- $sth->execute($id);
- my $channel = $sth->fetchrow_hashref;
- $sth->finish;
- return $channel;
-}
-
-sub del_channels {
- my ($ids) = @_;
- if ($ids ne '') {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("DELETE FROM news_channels WHERE id IN ($ids) ");
- $sth->execute();
- $sth->finish;
- return $ids;
- }
- return 0;
+sub GetNewsToDisplay {
+ my $lang = shift;
+ my $dbh = C4::Context->dbh;\r
+ my $query = "
+ SELECT *,DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate
+ FROM opac_news
+ WHERE (
+ expirationdate > CURRENT_DATE()
+ OR expirationdate IS NULL
+ OR expirationdate = '00-00-0000'
+ )
+ AND lang = ?
+ ORDER BY number
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($lang);
+ my @results;
+ while ( my $row = $sth->fetchrow_hashref ){
+ push @results, $row;
+ }
+ return \@results;
}
-
-sub add_channel {
- my ($name, $url, $id_category, $notes) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO news_channels (channel_name, url, id_category, notes) VALUES (?,?,?,?)");
- $sth->execute($name, $url, $id_category, $notes);
- $sth->finish;
- return 1;
-}
-
-sub update_channel {
- my ($id, $name, $url, $id_category, $notes) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE news_channels SET channel_name = ?, url = ?, id_category = ?, notes = ? WHERE id = ?");
- $sth->execute($name, $url, $id_category, $notes, $id);
- $sth->finish;
- return 1;
-}
-
-sub news_channels_categories {
- my $dbh = C4::Context->dbh;
- my @categories;
- my $query = "SELECT * FROM news_channels_categories";
- my $sth = $dbh->prepare($query);
- $sth->execute();
- while (my $row = $sth->fetchrow_hashref) {
- push @categories, $row;
- }
- $sth->finish;
- return (scalar(@categories), @categories);
-
-}
-
-sub get_new_channel_category {
- my ($id) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM news_channels_categories WHERE id_category = ?");
- $sth->execute($id);
- my $category = $sth->fetchrow_hashref;
- $sth->finish;
- return $category;
-}
-
-sub del_channels_categories {
- my ($ids) = @_;
- if ($ids ne '') {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE news_channels SET id_category = NULL WHERE id_category IN ($ids) ");
- $sth->execute();
- $sth = $dbh->prepare("DELETE FROM news_channels_categories WHERE id_category IN ($ids) ");
- $sth->execute();
- $sth->finish;
- return $ids;
- }
- return 0;
-}
-
-sub add_channel_category {
- my ($name) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO news_channels_categories (category_name) VALUES (?)");
- $sth->execute($name);
- $sth->finish;
- return 1;
-}
-
-sub update_channel_category {
- my ($id, $name) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE news_channels_categories SET category_name = ? WHERE id_category = ?");
- $sth->execute($name, $id);
- $sth->finish;
- return 1;
-}
-
-
-sub add_opac_new {
- my ($title, $new, $lang) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO opac_news (title, new, lang) VALUES (?,?,?)");
- $sth->execute($title, $new, $lang);
- $sth->finish;
- return 1;
-}
-
-sub upd_opac_new {
- my ($idnew, $title, $new, $lang) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE opac_news SET title = ?, new = ?, lang = ? WHERE idnew = ?");
- $sth->execute($title, $new, $lang, $idnew);
- $sth->finish;
- return 1;
-}
-
-sub del_opac_new {
- my ($ids) = @_;
- if ($ids) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("DELETE FROM opac_news WHERE idnew IN ($ids)");
- $sth->execute();
- $sth->finish;
- return 1;
- } else {
- return 0;
- }
-}
-
-sub get_opac_new {
- my ($idnew) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM opac_news WHERE idnew = ?");
- $sth->execute($idnew);
- my $data = $sth->fetchrow_hashref;
- $data->{$data->{'lang'}} = 1;
- $sth->finish;
- return $data;
-}
-
-sub get_opac_news {
- my ($limit, $lang) = @_;
- my $dbh = C4::Context->dbh;
- my $query = "SELECT *, DATE_FORMAT(timestamp,'%Y-%m-%d') AS newdate FROM opac_news";
- if ($lang) {
- $query.= " WHERE lang = '" .$lang ."' ";
- }
- $query.= " ORDER BY timestamp DESC ";
- #if ($limit) {
- # $query.= "LIMIT 0, " . $limit;
- #}
- my $sth = $dbh->prepare($query);
- $sth->execute();
- my @opac_news;
- my $count = 0;
- while (my $row = $sth->fetchrow_hashref) {
- if ((($limit) && ($count < $limit)) || (!$limit)) {
- $row->{'newdate'} = format_date($row->{'newdate'});
- push @opac_news, $row;
- }
- $count++;
- }
- return ($count, \@opac_news);
-}
-
-### get electronic databases
-
-sub add_opac_electronic {
- my ($title, $edata, $lang,$image,$href,$section) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO opac_electronic (title, edata, lang,image,href,section) VALUES (?,?,?,?,?,?)");
- $sth->execute($title, $edata, $lang,$image,$href,$section);
- $sth->finish;
- return 1;
-}
-
-sub upd_opac_electronic {
- my ($idelectronic, $title, $edata, $lang, $image, $href,$section) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE opac_electronic SET title = ?, edata = ?, lang = ? , image=?, href=? ,section=? WHERE idelectronic = ?");
- $sth->execute($title, $edata, $lang, $image,$href ,$section, $idelectronic);
- $sth->finish;
- return 1;
-}
-
-sub del_opac_electronic {
- my ($ids) = @_;
- if ($ids) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("DELETE FROM opac_electronic WHERE idelectronic IN ($ids)");
- $sth->execute();
- $sth->finish;
- return 1;
- } else {
- return 0;
- }
-}
-
-sub get_opac_electronic {
- my ($idelectronic) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM opac_electronic WHERE idelectronic = ?");
- $sth->execute($idelectronic);
- my $data = $sth->fetchrow_hashref;
- $data->{$data->{'lang'}} = 1;
- $data->{$data->{'section'}} = 1;
- $sth->finish;
- return $data;
-}
-
-sub get_opac_electronics {
- my ($section, $lang) = @_;
- my $dbh = C4::Context->dbh;
- my $query = "SELECT *, DATE_FORMAT(timestamp, '%Y-%m-%d') AS newdate FROM opac_electronic";
- if ($lang) {
- $query.= " WHERE lang = '" .$lang ."' ";
- }
- if ($section) {
- $query.= " and section= '" . $section."' ";
- }
- $query.= " ORDER BY title ";
-
- my $sth = $dbh->prepare($query);
- $sth->execute();
- my @opac_electronic;
- my $count = 0;
- while (my $row = $sth->fetchrow_hashref) {
- $row->{'newdate'}=format_date($row->{'newdate'});
- push @opac_electronic, $row;
-
-
- $count++;
- }
-
- return ($count,\@opac_electronic);
-}
-END { } # module clean-up code here (global destructor)
-
-=back
-
-=head1 AUTHOR
-
-TG
-
-=cut
-
-
+\r
+### get electronic databases\r
+\r
+sub add_opac_electronic {\r
+ my ($title, $edata, $lang,$image,$href,$section) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("INSERT INTO opac_electronic (title, edata, lang,image,href,section) VALUES (?,?,?,?,?,?)");\r
+ $sth->execute($title, $edata, $lang,$image,$href,$section);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub upd_opac_electronic {\r
+ my ($idelectronic, $title, $edata, $lang, $image, $href,$section) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("UPDATE opac_electronic SET title = ?, edata = ?, lang = ? , image=?, href=? ,section=? WHERE idelectronic = ?");\r
+ $sth->execute($title, $edata, $lang, $image,$href ,$section, $idelectronic);\r
+ $sth->finish;\r
+ return 1;\r
+}\r
+\r
+sub del_opac_electronic {\r
+ my ($ids) = @_;\r
+ if ($ids) {\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("DELETE FROM opac_electronic WHERE idelectronic IN ($ids)");\r
+ $sth->execute();\r
+ $sth->finish;\r
+ return 1;\r
+ } else {\r
+ return 0;\r
+ }\r
+}\r
+\r
+sub get_opac_electronic {\r
+ my ($idelectronic) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $sth = $dbh->prepare("SELECT * FROM opac_electronic WHERE idelectronic = ?");\r
+ $sth->execute($idelectronic);\r
+ my $data = $sth->fetchrow_hashref;\r
+ $data->{$data->{'lang'}} = 1;\r
+ $data->{$data->{'section'}} = 1;\r
+ $sth->finish;\r
+ return $data;\r
+}\r
+\r
+sub get_opac_electronics {\r
+ my ($section, $lang) = @_;\r
+ my $dbh = C4::Context->dbh;\r
+ my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_electronic";\r
+ if ($lang) {\r
+ $query.= " WHERE lang = '" .$lang ."' ";\r
+ }\r
+ if ($section) {\r
+ $query.= " and section= '" . $section."' ";\r
+ }\r
+ $query.= " ORDER BY title ";\r
+ \r
+ my $sth = $dbh->prepare($query);\r
+ $sth->execute();\r
+ my @opac_electronic;\r
+ my $count = 0;\r
+ while (my $row = $sth->fetchrow_hashref) {\r
+ push @opac_electronic, $row;\r
+\r
+ \r
+ $count++;\r
+ }\r
+\r
+ return ($count,\@opac_electronic);\r
+}\r
+END { } # module clean-up code here (global destructor)\r
+\r
+=back\r
+\r
+=head1 AUTHOR\r
+\r
+TG\r
+\r
+=cut\r
+\r
+\r
package C4::Output;
-# $Id$
#package to deal with marking up output
#You will need to edit parts of this pm
#set the value of path to be where your html lives
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
+# NOTE: I'm pretty sure this module is deprecated in favor of
+# templates.
use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &themelanguage &gettemplate setlanguagecookie pagination_bar
- );
+ &themelanguage &gettemplate setlanguagecookie pagination_bar
+);
#FIXME: this is a quick fix to stop rc1 installing broken
#Still trying to figure out the correct fix.
-my $path = C4::Context->config('intrahtdocs')."/default/en/includes/";
+my $path = C4::Context->config('intrahtdocs') . "/default/en/includes/";
#---------------------------------------------------------------------------------------------------------
# FIXME - POD
sub gettemplate {
- my ($tmplbase, $opac, $query) = @_;
-if (!$query){
- warn "no query in gettemplate";
- }
- my $htdocs;
- if ($opac ne "intranet") {
- $htdocs = C4::Context->config('opachtdocs');
- } else {
- $htdocs = C4::Context->config('intrahtdocs');
- }
+ my ( $tmplbase, $opac, $query ) = @_;
+ if ( !$query ) {
+ warn "no query in gettemplate";
+ }
+ my $htdocs;
+ if ( $opac ne "intranet" ) {
+ $htdocs = C4::Context->config('opachtdocs');
+ }
+ else {
+ $htdocs = C4::Context->config('intrahtdocs');
+ }
my $path = C4::Context->preference('intranet_includes') || 'includes';
-# warn "PATH : $path";
-my $filter=sub {
-#my $win=shift;
-$_=~s /\xef\xbb\xbf//g;
-};
- my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac, $query);
- my $opacstylesheet = C4::Context->preference('opacstylesheet');
-
-my $template = HTML::Template::Pro->new(filename => "$htdocs/$theme/$lang/$tmplbase", case_sensitive=>1,
- die_on_bad_params => 0,
- global_vars => 1,
- path => ["$htdocs/$theme/$lang/$path"]);
-
- $template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl') . "/$theme/$lang",
- interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
- theme => $theme,
- opacstylesheet => $opacstylesheet,
- opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
- opacsmallimage => C4::Context->preference('opacsmallimage'),
- lang => $lang);
-
-
- return $template;
+
+ # warn "PATH : $path";
+ my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $opac, $query );
+ my $opacstylesheet = C4::Context->preference('opacstylesheet');
+ my $template = HTML::Template::Pro->new(
+ filename => "$htdocs/$theme/$lang/$tmplbase",
+ die_on_bad_params => 1,
+ global_vars => 1,
+ case_sensitive => 1,
+ path => ["$htdocs/$theme/$lang/$path"]
+ );
+
+ $template->param(
+ themelang => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
+ . "/$theme/$lang",
+ interface => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
+ theme => $theme,
+ opacstylesheet => $opacstylesheet,
+ opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
+ opacsmallimage => C4::Context->preference('opacsmallimage'),
+ lang => $lang
+ );
+
+ return $template;
}
#---------------------------------------------------------------------------------------------------------
# FIXME - POD
sub themelanguage {
- my ($htdocs, $tmpl, $section, $query) = @_;
-# if (!$query) {
-# warn "no query";
-# }
- my $dbh = C4::Context->dbh;
- my @languages;
- my @themes;
-my ($theme, $lang);
- if ($section eq "intranet"){
- $lang=$query->cookie('KohaOpacLanguage');
-
- if ($lang){
-
- push @languages,$lang;
- @themes = split " ", C4::Context->preference("template");
- }
- else {
- @languages = split " ", C4::Context->preference("opaclanguages");
- @themes = split " ", C4::Context->preference("template");
+ my ( $htdocs, $tmpl, $section, $query ) = @_;
+
+ # if (!$query) {
+ # warn "no query";
+ # }
+ my $dbh = C4::Context->dbh;
+ my @languages;
+ my @themes;
+ if ( $section eq "intranet" ) {
+ @languages = split " ", C4::Context->preference("opaclanguages");
+ @themes = split " ", C4::Context->preference("template");
}
- }else{
- $lang=$query->cookie('KohaOpacLanguage');
-
- if ($lang){
-
- push @languages,$lang;
- @themes = split " ", C4::Context->preference("opacthemes");
- }
- else {
- @languages = split " ", C4::Context->preference("opaclanguages");
- @themes = split " ", C4::Context->preference("opacthemes");
+ else {
+
+ # we are in the opac here, what im trying to do is let the individual user
+ # set the theme they want to use.
+ # and perhaps the them as well.
+ my $lang = $query->cookie('KohaOpacLanguage');
+ if ($lang) {
+
+ push @languages, $lang;
+ @themes = split " ", C4::Context->preference("opacthemes");
+ }
+ else {
+ @languages = split " ", C4::Context->preference("opaclanguages");
+ @themes = split " ", C4::Context->preference("opacthemes");
+ }
}
-}
-
-# searches through the themes and languages. First template it find it returns.
-# Priority is for getting the theme right.
+ my ( $theme, $lang );
+
+ # searches through the themes and languages. First template it find it returns.
+ # Priority is for getting the theme right.
THEME:
- foreach my $th (@themes) {
- foreach my $la (@languages) {
- for (my $pass = 1; $pass <= 2; $pass += 1) {
- $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
- if (-e "$htdocs/$th/$la/$tmpl") {
- $theme = $th;
- $lang = $la;
- last THEME;
- }
- last unless $la =~ /[-_]/;
- }
+ foreach my $th (@themes) {
+ foreach my $la (@languages) {
+ for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
+ $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
+ if ( -e "$htdocs/$th/$la/$tmpl" ) {
+ $theme = $th;
+ $lang = $la;
+ last THEME;
+ }
+ last unless $la =~ /[-_]/;
+ }
+ }
+ }
+ if ( $theme and $lang ) {
+ return ( $theme, $lang );
+ }
+ else {
+ return ( 'prog', 'en' );
}
- }
- if ($theme and $lang) {
- return ($theme, $lang);
- } else {
- return ('default', 'en');
- }
}
-
sub setlanguagecookie {
- my ($query,$language,$uri)=@_;
- my $cookie=$query->cookie(-name => 'KohaOpacLanguage',
- -value => $language,
- -expires => '');
- print $query->redirect(-uri=>$uri,
- -cookie=>$cookie);
-}
+ my ( $query, $language, $uri ) = @_;
+ my $cookie = $query->cookie(
+ -name => 'KohaOpacLanguage',
+ -value => $language,
+ -expires => ''
+ );
+ print $query->redirect(
+ -uri => $uri,
+ -cookie => $cookie
+ );
+}
=item pagination_bar
=cut
sub pagination_bar {
- my ($base_url, $nb_pages, $current_page, $startfrom_name) = @_;
+ my ( $base_url, $nb_pages, $current_page, $startfrom_name ) = @_;
# how many pages to show before and after the current page?
my $pages_around = 2;
my $url =
- $base_url
- .($base_url =~ m/&/ ? '&' : '?')
- .$startfrom_name.'='
- ;
+ $base_url . ( $base_url =~ m/&/ ? '&' : '?' ) . $startfrom_name . '=';
my $pagination_bar = '';
# current page detection
- if (not defined $current_page) {
+ if ( not defined $current_page ) {
$current_page = 1;
}
# navigation bar useful only if more than one page to display !
- if ($nb_pages > 1) {
+ if ( $nb_pages > 1 ) {
+
# link to first page?
- if ($current_page > 1) {
- $pagination_bar.=
- "\n".' '
- .'<a href="'.$url.'1" rel="start">'
- .'<<'
- .'</a>'
- ;
+ if ( $current_page > 1 ) {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . '1" rel="start">'
+ . '<<' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive"><<</span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><<</span>';
}
# link on previous page ?
- if ($current_page > 1) {
+ if ( $current_page > 1 ) {
my $previous = $current_page - 1;
- $pagination_bar.=
- "\n".' '
- .'<a href="'
- .$url.$previous
- .'" rel="prev">'
- .'<'
- .'</a>'
- ;
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $previous
+ . '" rel="prev">' . '<' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive"><</span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><</span>';
}
- my $min_to_display = $current_page - $pages_around;
- my $max_to_display = $current_page + $pages_around;
+ my $min_to_display = $current_page - $pages_around;
+ my $max_to_display = $current_page + $pages_around;
my $last_displayed_page = undef;
- for my $page_number (1..$nb_pages) {
- if ($page_number == 1
+ for my $page_number ( 1 .. $nb_pages ) {
+ if (
+ $page_number == 1
or $page_number == $nb_pages
- or ($page_number >= $min_to_display and $page_number <= $max_to_display)
- ) {
- if (defined $last_displayed_page
- and $last_displayed_page != $page_number - 1
- ) {
- $pagination_bar.=
- "\n".' <span class="inactive">...</span>'
- ;
+ or ( $page_number >= $min_to_display
+ and $page_number <= $max_to_display )
+ )
+ {
+ if ( defined $last_displayed_page
+ and $last_displayed_page != $page_number - 1 )
+ {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">...</span>';
}
- if ($page_number == $current_page) {
- $pagination_bar.=
- "\n".' '
- .'<span class="currentPage">'.$page_number.'</span>'
- ;
+ if ( $page_number == $current_page ) {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<span class="currentPage">'
+ . $page_number
+ . '</span>';
}
else {
- $pagination_bar.=
- "\n".' '
- .'<a href="'.$url.$page_number.'">'.$page_number.'</a>'
- ;
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $page_number . '">'
+ . $page_number . '</a>';
}
$last_displayed_page = $page_number;
}
}
# link on next page?
- if ($current_page < $nb_pages) {
+ if ( $current_page < $nb_pages ) {
my $next = $current_page + 1;
- $pagination_bar.=
- "\n".' <a href="'.$url.$next.'" rel="next">'
- .'>'
- .'</a>'
- ;
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $next
+ . '" rel="next">' . '>' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive">></span>'
- ;
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">></span>';
}
# link to last page?
- if ($current_page != $nb_pages) {
- $pagination_bar.=
- "\n".' <a href="'.$url.$nb_pages.'" rel="last">'
- .'>>'
- .'</a>'
- ;
+ if ( $current_page != $nb_pages ) {
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $nb_pages
+ . '" rel="last">'
+ . '>>' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive">>></span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">>></span>';
}
}
return $pagination_bar;
}
-
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
-package C4::Print; #assumes C4/Print.pm
-
+package C4::Print;
# Copyright 2000-2002 Katipo Communications
#
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
require Exporter;
-
use C4::Context;
use C4::Circulation::Circ2;
-use C4::Members;
+
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+# set the version for version checking
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(&remoteprint &printreserve &printslip);
=item remoteprint
from C<¤tissues>.
=cut
+
#'
# FIXME - It'd be nifty if this could generate pretty PostScript.
sub remoteprint {
- my ($env,$items,$borrower)=@_;
-
- (return) unless (C4::Context->boolean_preference('printcirculationslips'));
- my $queue = $env->{'queue'};
- # FIXME - If 'queue' is undefined or empty, then presumably it should
- # mean "use the default queue", whatever the default is. Presumably
- # the default depends on the physical location of the machine.
- # FIXME - Perhaps "print to file" should be a supported option. Just
- # set the queue to "file" (or " file", if real queues aren't allowed
- # to have spaces in them). Or perhaps if $queue eq "" and
- # $env->{file} ne "", then that should mean "print to $env->{file}".
- if ($queue eq "" || $queue eq 'nulllp') {
- open (PRINTER,">/tmp/kohaiss");
- } else {
- # FIXME - This assumes that 'lpr' exists, and works as expected.
- # This is a reasonable assumption, but only because every other
- # printing package has a wrapper script called 'lpr'. It'd still
- # be better to be able to customize this.
- open(PRINTER, "| lpr -P $queue > /dev/null") or die "Couldn't write to queue:$queue!\n";
- }
-# print $queue;
- #open (FILE,">/tmp/$file");
- my $i=0;
- my $brdata = $env->{'brdata'}; # FIXME - Not used
- # FIXME - This is HLT-specific. Put this stuff in a customizable
- # site-specific file somewhere.
- print PRINTER "Horowhenua Library Trust\r\n";
-# print PRINTER "$brdata->{'branchname'}\r\n";
- print PRINTER "Phone: 368-1953\r\n";
- print PRINTER "Fax: 367-9218\r\n";
- print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n";
- print PRINTER "$borrower->{'cardnumber'}\r\n";
- print PRINTER "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
- # FIXME - Use for ($i = 0; $items->[$i]; $i++)
- # Or better yet, foreach $item (@{$items})
- while ($items->[$i]){
-# print $i;
- my $itemdata = $items->[$i];
- # FIXME - This is just begging for a Perl format.
- print PRINTER "$i $itemdata->{'title'}\r\n";
- print PRINTER "$itemdata->{'barcode'}";
- print PRINTER " "x15;
- print PRINTER "$itemdata->{'date_due'}\r\n";
- $i++;
- }
- print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n";
- if ($env->{'printtype'} eq "docket"){
- #print chr(27).chr(105);
- }
- close PRINTER;
- #system("lpr /tmp/$file");
+ my ( $env, $items, $borrower ) = @_;
+
+ (return)
+ unless ( C4::Context->boolean_preference('printcirculationslips') );
+ my $queue = $env->{'queue'};
+
+ # FIXME - If 'queue' is undefined or empty, then presumably it should
+ # mean "use the default queue", whatever the default is. Presumably
+ # the default depends on the physical location of the machine.
+ # FIXME - Perhaps "print to file" should be a supported option. Just
+ # set the queue to "file" (or " file", if real queues aren't allowed
+ # to have spaces in them). Or perhaps if $queue eq "" and
+ # $env->{file} ne "", then that should mean "print to $env->{file}".
+ if ( $queue eq "" || $queue eq 'nulllp' ) {
+ open( PRINTER, ">/tmp/kohaiss" );
+ }
+ else {
+
+ # FIXME - This assumes that 'lpr' exists, and works as expected.
+ # This is a reasonable assumption, but only because every other
+ # printing package has a wrapper script called 'lpr'. It'd still
+ # be better to be able to customize this.
+ open( PRINTER, "| lpr -P $queue > /dev/null" )
+ or die "Couldn't write to queue:$queue!\n";
+ }
+
+ # print $queue;
+ #open (FILE,">/tmp/$file");
+ my $i = 0;
+ my $brdata = $env->{'brdata'}; # FIXME - Not used
+ # FIXME - This is HLT-specific. Put this stuff in a customizable
+ # site-specific file somewhere.
+ print PRINTER "Horowhenua Library Trust\r\n";
+
+ # print PRINTER "$brdata->{'branchname'}\r\n";
+ print PRINTER "Phone: 368-1953\r\n";
+ print PRINTER "Fax: 367-9218\r\n";
+ print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n";
+ print PRINTER "$borrower->{'cardnumber'}\r\n";
+ print PRINTER
+ "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
+
+ # FIXME - Use for ($i = 0; $items->[$i]; $i++)
+ # Or better yet, foreach $item (@{$items})
+ while ( $items->[$i] ) {
+
+ # print $i;
+ my $itemdata = $items->[$i];
+
+ # FIXME - This is just begging for a Perl format.
+ print PRINTER "$i $itemdata->{'title'}\r\n";
+ print PRINTER "$itemdata->{'barcode'}";
+ print PRINTER " " x 15;
+ print PRINTER "$itemdata->{'date_due'}\r\n";
+ $i++;
+ }
+ print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n";
+ if ( $env->{'printtype'} eq "docket" ) {
+
+ #print chr(27).chr(105);
+ }
+ close PRINTER;
+
+ #system("lpr /tmp/$file");
}
sub printreserve {
- my($env, $branchname, $bordata, $itemdata)=@_;
- my $file=time;
- my $printer = $env->{'printer'};
- (return) unless (C4::Context->boolean_preference('printreserveslips'));
- if ($printer eq "" || $printer eq 'nulllp') {
- open (PRINTER,">>/tmp/kohares");
- } else {
- open (PRINTER, "| lpr -P $printer >/dev/null") or die "Couldn't write to queue:$!\n";
- }
- my @da = localtime(time());
- my $todaysdate = "$da[2]:$da[1] $da[3]/$da[4]/$da[5]";
+ my ( $env, $branchname, $bordata, $itemdata ) = @_;
+ my $file = time;
+ my $printer = $env->{'printer'};
+ (return) unless ( C4::Context->boolean_preference('printreserveslips') );
+ if ( $printer eq "" || $printer eq 'nulllp' ) {
+ open( PRINTER, ">>/tmp/kohares" );
+ }
+ else {
+ open( PRINTER, "| lpr -P $printer >/dev/null" )
+ or die "Couldn't write to queue:$!\n";
+ }
+ my @da = localtime( time() );
+ my $todaysdate = "$da[2]:$da[1] $da[3]/$da[4]/$da[5]";
#(1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
- my $slip = <<"EOF";
+ my $slip = <<"EOF";
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Date: $todaysdate;
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
EOF
print PRINTER $slip;
- close PRINTER;
- return $slip;
+ close PRINTER;
+ return $slip;
}
=item printslip
print a slip for the given $borrowernumber
=cut
+
#'
sub printslip {
- my ($env,$borrowernumber)=@_;
- my ($borrower, $flags) = getpatroninformation($env,$borrowernumber,0);
- $env->{'todaysissues'}=1;
- my ($borrowerissues) = currentissues($env, $borrower);
- $env->{'nottodaysissues'}=1;
- $env->{'todaysissues'}=0;
- my ($borroweriss2)=currentissues($env, $borrower);
- $env->{'nottodaysissues'}=0;
- my $i=0;
+ my ( $env, $borrowernumber ) = @_;
+ my ( $borrower, $flags ) = getpatroninformation( $env, $borrowernumber, 0 );
+ $env->{'todaysissues'} = 1;
+ my ($borrowerissues) = currentissues( $env, $borrower );
+ $env->{'nottodaysissues'} = 1;
+ $env->{'todaysissues'} = 0;
+ my ($borroweriss2) = currentissues( $env, $borrower );
+ $env->{'nottodaysissues'} = 0;
+ my $i = 0;
my @issues;
- foreach (sort {$a <=> $b} keys %$borrowerissues) {
- $issues[$i]=$borrowerissues->{$_};
- my $dd=$issues[$i]->{'date_due'};
- #convert to nz style dates
- #this should be set with some kinda config variable
- my @tempdate=split(/-/,$dd);
- $issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
- $i++;
+
+ foreach ( sort { $a <=> $b } keys %$borrowerissues ) {
+ $issues[$i] = $borrowerissues->{$_};
+ my $dd = $issues[$i]->{'date_due'};
+
+ #convert to nz style dates
+ #this should be set with some kinda config variable
+ my @tempdate = split( /-/, $dd );
+ $issues[$i]->{'date_due'} = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
+ $i++;
}
- foreach (sort {$a <=> $b} keys %$borroweriss2) {
- $issues[$i]=$borroweriss2->{$_};
- my $dd=$issues[$i]->{'date_due'};
- #convert to nz style dates
- #this should be set with some kinda config variable
- my @tempdate=split(/-/,$dd);
- $issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
- $i++;
+ foreach ( sort { $a <=> $b } keys %$borroweriss2 ) {
+ $issues[$i] = $borroweriss2->{$_};
+ my $dd = $issues[$i]->{'date_due'};
+
+ #convert to nz style dates
+ #this should be set with some kinda config variable
+ my @tempdate = split( /-/, $dd );
+ $issues[$i]->{'date_due'} = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
+ $i++;
}
- remoteprint($env,\@issues,$borrower);
+ remoteprint( $env, \@issues, $borrower );
}
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
package C4::Reserves2;
-# $Id$
-
# Copyright 2000-2002 Katipo Communications
#
-# This file is hard coded with koha-reserves table to be used only by the OPAC -TG.
+# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
require Exporter;
-
use C4::Context;
-use C4::Search;
use C4::Biblio;
- # FIXME - C4::Reserves2 uses C4::Search, which uses C4::Reserves2.
- # So Perl complains that all of the functions here get redefined.
-#use C4::Accounts;
+use C4::Search;
+use C4::Circulation::Circ2;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+my $library_name = C4::Context->preference("LibraryName");
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
-C4::Reserves2 - FIXME
+C4::Reserves2 - Koha functions for dealing with reservation.
=head1 SYNOPSIS
=head1 DESCRIPTION
-FIXME
+this modules provides somes functions to deal with reservations.
=head1 FUNCTIONS
=cut
@ISA = qw(Exporter);
+
# FIXME Take out CalcReserveFee after it can be removed from opac-reserves.pl
-@EXPORT = qw(&FindReserves
- &FindAllReserves
- &CheckReserves
- &CheckWaiting
- &CancelReserve
- &CalcReserveFee
- &FillReserve
- &ReserveWaiting
- &CreateReserve
- &UpdateReserves
- &UpdateReserve
- &getreservetitle
- &Findgroupreserve
- &findActiveReserve
-
- );
+@EXPORT = qw(
+ &FindReserves
+ &CheckReserves
+ &GetWaitingReserves
+ &CancelReserve
+ &CalcReserveFee
+ &FillReserve
+ &ReserveWaiting
+ &CreateReserve
+ &UpdateReserve
+ &GetReserveTitle
+ &GetReservations
+ &SetWaitingStatus
+ &GlobalCancel
+ &MinusPriority
+ &OtherReserves
+ &GetFirstReserveDateFromItem
+ &CountReservesFromBorrower
+ &FixPriority
+ &FindReservesInQueue
+);
# make all your functions, whether exported or not;
+=item GlobalCancel
+
+($messages,$nextreservinfo) = &GlobalCancel($itemnumber,$borrowernumber);
+
+ New op dev for the circulation based on item, global is a function to cancel reserv,check other reserves, and transfer document if it's necessary
+
+=cut
+
+#'
+sub GlobalCancel {
+ my $messages;
+ my $nextreservinfo;
+ my ( $itemnumber, $borrowernumber ) = @_;
+
+ #step 1 : cancel the reservation
+ my $CancelReserve = CancelReserve( undef, $itemnumber, $borrowernumber );
+
+ #step 2 launch the subroutine of the others reserves
+ ( $messages, $nextreservinfo ) = OtherReserves($itemnumber);
+
+ return ( $messages, $nextreservinfo );
+}
+
+=item OtherReserves
+
+($messages,$nextreservinfo)=$OtherReserves(itemnumber);
+
+Check queued list of this document and check if this document must be transfered
+
+=cut
+
+#'
+sub OtherReserves {
+ my ($itemnumber) = @_;
+ my $messages;
+ my $nextreservinfo;
+ my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
+ if ($checkreserves) {
+ my $iteminfo = C4::Circulation::Circ2::getiteminformation($itemnumber,undef);
+ if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
+ $messages->{'transfert'} = $checkreserves->{'branchcode'};
+ #minus priorities of others reservs
+ MinusPriority(
+ $itemnumber,
+ $checkreserves->{'borrowernumber'},
+ $iteminfo->{'biblionumber'}
+ );
+
+ #launch the subroutine dotransfer
+ C4::Circulation::Circ2::dotransfer(
+ $itemnumber,
+ $iteminfo->{'holdingbranch'},
+ $checkreserves->{'branchcode'}
+ ),
+ ;
+ }
+
+ #step 2b : case of a reservation on the same branch, set the waiting status
+ else {
+ $messages->{'waiting'} = 1;
+ MinusPriority(
+ $itemnumber,
+ $checkreserves->{'borrowernumber'},
+ $iteminfo->{'biblionumber'}
+ );
+ SetWaitingStatus($itemnumber);
+ }
+
+ $nextreservinfo = $checkreserves->{'borrowernumber'};
+ }
+
+ return ( $messages, $nextreservinfo );
+}
+
+=item MinusPriority
+
+&MinusPriority($itemnumber,$borrowernumber,$biblionumber)
+
+Reduce the values of queuded list
+
+=cut
+
+#'
+sub MinusPriority {
+ my ( $itemnumber, $borrowernumber, $biblionumber ) = @_;
+
+ #first step update the value of the first person on reserv
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ UPDATE reserves
+ SET priority = 0 , itemnumber = ?
+ WHERE cancellationdate IS NULL
+ AND borrowernumber=?
+ AND biblionumber=?
+ /;
+ my $sth_upd = $dbh->prepare($query);
+ $sth_upd->execute( $itemnumber, $borrowernumber, $biblionumber );
+ $sth_upd->finish;
+ # second step update all others reservs
+ $query = qq/
+ SELECT priority,borrowernumber,biblionumber,reservedate
+ FROM reserves
+ WHERE priority !='0'
+ AND biblionumber = ?
+ AND cancellationdate IS NULL
+ /;
+ my $sth_oth = $dbh->prepare($query);
+ $sth_oth->execute($biblionumber);
+ while ( my ( $priority, $borrowernumber, $biblionumber, $reservedate ) =
+ $sth_oth->fetchrow_array )
+ {
+ $priority--;
+ $query = qq/
+ UPDATE reserves
+ SET priority = ?
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND reservedate = ?
+ /;
+ my $sth_upd_oth = $dbh->prepare($query);
+ $sth_upd_oth->execute( $priority, $biblionumber, $borrowernumber,
+ $reservedate );
+ $sth_upd_oth->finish;
+ }
+ $sth_oth->finish;
+}
+
+=item SetWaitingStatus
+
+&SetWaitingStatus($itemnumber);
+
+we check if we have a reserves with itemnumber (New op system of reserves), if we found one, we update the status of the reservation when we have : 'priority' = 0, and we have an itemnumber
+
+=cut
+
+sub SetWaitingStatus {
+
+ #first : check if we have a reservation for this item .
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ SELECT priority,borrowernumber
+ FROM reserves
+ WHERE itemnumber=?
+ AND cancellationdate IS NULL
+ AND found IS NULL AND priority='0'
+ /;
+ my $sth_find = $dbh->prepare($query);
+ $sth_find->execute($itemnumber);
+ my ( $priority, $borrowernumber ) = $sth_find->fetchrow_array;
+ $sth_find->finish;
+ return unless $borrowernumber;
+
+# step 2 : if we have a borrowernumber, we update the value found to 'W' to notify the borrower
+ $query = qq/
+ UPDATE reserves
+ SET found='W',waitingdate = now()
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND found IS NULL
+ /;
+ my $sth_set = $dbh->prepare($query);
+ $sth_set->execute( $borrowernumber, $itemnumber );
+ $sth_set->finish;
+}
+
+=item GetReservations
+
+@borrowerreserv=&GetReservations($itemnumber,$borrowernumber);
+
+this function get the list of reservation for an C<$itemnumber> or C<$borrowernumber>
+given on input arg. You should give $itemnumber OR $borrowernumber but not both.
+
+=cut
+
+sub GetReservations {
+ my ( $itemnumber, $borrowernumber ) = @_;
+ if ($itemnumber) {
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ SELECT reservedate,borrowernumber
+ FROM reserves
+ WHERE itemnumber=?
+ AND cancellationdate IS NULL
+ AND (found <> 'F' OR found IS NULL)
+ /;
+ my $sth_res = $dbh->prepare($query);
+ $sth_res->execute($itemnumber);
+ my ( $reservedate, $borrowernumber ) = $sth_res->fetchrow_array;
+ return ( $reservedate, $borrowernumber );
+ }
+ if ($borrowernumber) {
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ SELECT *
+ FROM reserves
+ WHERE borrowernumber=?
+ AND cancellationdate IS NULL
+ AND (found != 'F' or found is null)
+ ORDER BY reservedate
+ /;
+
+ my $sth_find = $dbh->prepare($query);
+ $sth_find->execute($borrowernumber);
+ my @borrowerreserv;
+ while ( my $data = $sth_find->fetchrow_hashref ) {
+ push @borrowerreserv, $data;
+ }
+ return @borrowerreserv;
+ }
+}
+
=item FindReserves
- ($count, $results) = &FindReserves($biblionumber, $borrowernumber);
+ $results = &FindReserves($biblionumber, $borrowernumber);
Looks books up in the reserves. C<$biblionumber> is the biblionumber
of the book to look up. C<$borrowernumber> is the borrower number of a
that patron's reserves. If neither is specified, C<&FindReserves>
barfs.
-C<&FindReserves> returns a two-element array:
+For each book thus found, C<&FindReserves> checks the reserve
+constraints and does something I don't understand.
-C<$count> is the number of elements in C<$results>.
+C<&FindReserves> returns a two-element array:
-C<$results> is a reference-to-array; each element is a
-reference-to-hash, whose keys are (I think) all of the fields of the
-reserves, borrowers, and biblio tables of the Koha database.
+C<$results> is a reference to an array of references of hashes. Each hash
+has for keys a list of column from reserves table (see details in function).
=cut
+
#'
sub FindReserves {
- my ($bib, $bor) = @_;
- my @params;
-
- my $dbh = C4::Context->dbh;
- # Find the desired items in the reserves
- my $query="SELECT *, reserves.branchcode, reserves.timestamp as rtimestamp, DATE_FORMAT(reserves.timestamp, '%T') AS time
- FROM reserves,borrowers,items ";
- if ($bib ne ''){
- #$bib = $dbh->quote($bib);
- if ($bor ne ''){
- # Both $bib and $bor specified
- # Find a particular book for a particular patron
- #$bor = $dbh->quote($bor);
- $query .= "WHERE (reserves.biblionumber = ?) and
- (borrowers.borrowernumber = ?) and
- (reserves.borrowernumber = borrowers.borrowernumber) and
- (reserves.itemnumber=items.itemnumber) and
- (cancellationdate IS NULL) and
- (found <> 1) ";
-
- push @params, $bib, $bor;
- } else {
- # $bib specified, but not $bor
- # Find a particular book for all patrons
- $query .= "WHERE (reserves.borrowernumber = borrowers.borrowernumber) and
- (reserves.biblionumber = ?) and
- (reserves.itemnumber=items.itemnumber) and
- (cancellationdate IS NULL) and
- (found <> 1) ";
-
- push @params, $bib;
- }
- } else {
- $query .= "WHERE (reserves.biblionumber = items.biblionumber) and
- (borrowers.borrowernumber = ?) and
- (reserves.borrowernumber = borrowers.borrowernumber) and
- (reserves.itemnumber=items.itemnumber) and
- (cancellationdate IS NULL) and
- (found <> 1)";
-
- push @params, $bor;
- }
- $query.=" order by reserves.timestamp";
- my $sth = $dbh->prepare($query);
- $sth->execute(@params);
-
- my $i = 0;
- my @results;
- while (my $data = $sth->fetchrow_hashref){
- my ($bibdata) =XMLgetbibliohash($dbh,$data->{'biblionumber'});
- my ($itemhash)=XMLgetitemhash($dbh,$data->{'itemnumber'});
- $data->{'holdingbranch'}=XML_readline_onerecord($itemhash,"holdingbranch","holdings");
- $data->{'author'} =XML_readline_onerecord($bibdata,"author","biblios");
- $data->{'publishercode'} = XML_readline_onerecord($bibdata,"publishercode","biblios");
- $data->{'publicationyear'} = XML_readline_onerecord($bibdata,"publicationyear","biblios");
- $data->{'title'} = XML_readline_onerecord($bibdata,"title","biblios");
- push @results, $data;
- $i++;
- }
- $sth->finish;
-
- return($i,\@results);
+ my ( $biblionumber, $bor ) = @_;
+ my $dbh = C4::Context->dbh;
+ my @bind;
+
+ # Find the desired items in the reserves
+ my $query = qq/
+ SELECT branchcode,
+ timestamp AS rtimestamp,
+ priority,
+ biblionumber,
+ borrowernumber,
+ reservedate,
+ constrainttype,
+ found,
+ itemnumber
+ FROM reserves
+ WHERE cancellationdate IS NULL
+ AND (found <> \'F\' OR found IS NULL)
+ /;
+
+ if ( $biblionumber ne '' ) {
+ $query .= '
+ AND biblionumber = ?
+ ';
+ push @bind, $biblionumber;
+ }
+
+ if ( $bor ne '' ) {
+ $query .= '
+ AND borrowernumber = ?
+ ';
+ push @bind, $bor;
+ }
+
+ $query .= '
+ ORDER BY priority
+ ';
+ my $sth = $dbh->prepare($query);
+ $sth->execute(@bind);
+ my @results;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # FIXME - What is this if-statement doing? How do constraints work?
+ if ( $data->{constrainttype} eq 'o' ) {
+ $query = '
+ SELECT biblioitemnumber
+ FROM reserveconstraints
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND reservedate = ?
+ ';
+ my $csth = $dbh->prepare($query);
+ $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
+ $data->{reservedate}, );
+
+ my @bibitemno;
+ while ( my $bibitemnos = $csth->fetchrow_array ) {
+ push( @bibitemno, $bibitemnos );
+ }
+ my $count = @bibitemno;
+
+ # if we have two or more different specific itemtypes
+ # reserved by same person on same day
+ my $bdata;
+ if ( $count > 1 ) {
+ $bdata = GetBiblioItemData( $bibitemno[$i] );
+ $i++;
+ }
+ else {
+
+ # Look up the book we just found.
+ $bdata = GetBiblioItemData( $bibitemno[0] );
+ }
+ $csth->finish;
+
+ # Add the results of this latest search to the current
+ # results.
+ # FIXME - An 'each' would probably be more efficient.
+ foreach my $key ( keys %$bdata ) {
+ $data->{$key} = $bdata->{$key};
+ }
+ }
+ push @results, $data;
+ }
+ $sth->finish;
+
+ return ( $#results + 1, \@results );
}
-=item FindAllReserves
+#-------------------------------------------------------------------------------------
- ($count, $results) = &FindAllReserves($biblionumber, $borrowernumber);
+=item CountReservesFromBorrower
-Looks books up in the reserves. C<$biblionumber> is the biblionumber
-of the book to look up. C<$borrowernumber> is the borrower number of a
-patron whose books to look up.
+$number = &CountReservesFromBorrower($borrowernumber);
-Either C<$biblionumber> or C<$borrowernumber> may be the empty string,
-but not both. If both are specified, C<&FindReserves> looks up the
-given book for the given patron. If only C<$biblionumber> is
-specified, C<&FindReserves> looks up that book for all patrons. If
-only C<$borrowernumber> is specified, C<&FindReserves> looks up all of
-that patron's reserves. If neither is specified, C<&FindReserves>
-barfs.
+this function returns the number of reservation for a borrower given on input arg.
+
+=cut
-C<&FindAllReserves> returns a two-element array:
+sub CountReservesFromBorrower {
+ my ($borrowernumber) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = '
+ SELECT COUNT(*) AS counter
+ FROM reserves
+ WHERE borrowernumber = ?
+ AND cancellationdate IS NULL
+ AND (found != \'F\' OR found IS NULL)
+ ';
+ my $sth = $dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my $row = $sth->fetchrow_hashref;
+ $sth->finish;
+
+ return $row->{counter};
+}
-C<$count> is the number of elements in C<$results>.
+#-------------------------------------------------------------------------------------
-C<$results> is a reference-to-array; each element is a
-reference-to-hash, whose keys are (I think) all of the fields of the
-reserves, borrowers, and biblio tables of the Koha database.
+=item GetFirstReserveDateFromItem
+
+$date = GetFirstReserveDateFromItem($itemnumber)
+
+this function returns the first date a item has been reserved.
=cut
-#'
-sub FindAllReserves {
- my ($bib, $bor) = @_;
- my @params;
-
-my $dbh;
-
- $dbh = C4::Context->dbh;
-
- # Find the desired items in the reserves
- my $query="SELECT *,
- reserves.branchcode,
- biblio.title AS btitle,
- reserves.timestamp as rtimestamp,
- DATE_FORMAT(reserves.timestamp, '%T') AS time
- FROM reserves,
- borrowers,
- biblio ";
- if ($bib ne ''){
- #$bib = $dbh->quote($bib);
- if ($bor ne ''){
- # Both $bib and $bor specified
- # Find a particular book for a particular patron
- #$bor = $dbh->quote($bor);
- $query .= "WHERE (reserves.biblionumber = ?) and
- (borrowers.borrowernumber = ?) and
- (reserves.borrowernumber = borrowers.borrowernumber) and
- (biblio.biblionumber = ?) and
- (cancellationdate IS NULL) and
- (found <> 1) and
- (reservefrom > NOW())";
- push @params, $bib, $bor, $bib;
- } else {
- # $bib specified, but not $bor
- # Find a particular book for all patrons
- $query .= "WHERE (reserves.borrowernumber = borrowers.borrowernumber) and
- (biblio.biblionumber = ?) and
- (reserves.biblionumber = ?) and
- (cancellationdate IS NULL) and
- (found <> 1) and
- (reservefrom > NOW())";
- push @params, $bib, $bib;
- }
- } else {
- $query .= "WHERE (reserves.biblionumber = biblio.biblionumber) and
- (borrowers.borrowernumber = ?) and
- (reserves.borrowernumber = borrowers.borrowernumber) and
- (reserves.biblionumber = biblio.biblionumber) and
- (cancellationdate IS NULL) and
- (found <> 1) and
- (reservefrom > NOW())";
- push @params, $bor;
- }
- $query.=" order by reserves.timestamp";
- my $sth = $dbh->prepare($query);
- $sth->execute(@params);
-
- my $i = 0;
- my @results;
- while (my $data = $sth->fetchrow_hashref){
- my $bibdata = C4::Search::bibdata($data->{'biblionumber'});
- $data->{'author'} = $bibdata->{'author'};
- $data->{'publishercode'} = $bibdata->{'publishercode'};
- $data->{'publicationyear'} = $bibdata->{'publicationyear'};
- $data->{'title'} = $bibdata->{'title'};
- push @results, $data;
- $i++;
- }
- $sth->finish;
-
- return($i,\@results);
+
+sub GetFirstReserveDateFromItem {
+ my ($itemnumber) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $query = '
+ SELECT reservedate,
+ borrowernumber,
+ branchcode
+ FROM reserves
+ WHERE itemnumber = ?
+ AND cancellationdate IS NULL
+ AND (found != \'F\' OR found IS NULL)
+ ';
+ my $sth = $dbh->prepare($query);
+ $sth->execute($itemnumber);
+ my $row = $sth->fetchrow_hashref;
+
+ return ($row->{reservedate},$row->{borrowernumber},$row->{branchcode});
}
+#-------------------------------------------------------------------------------------
+
=item CheckReserves
($status, $reserve) = &CheckReserves($itemnumber, $barcode);
table in the Koha database.
=cut
+
#'
sub CheckReserves {
- my ($item, $barcode) = @_;
-# warn "In CheckReserves: itemnumber = $item";
+ my ( $item, $barcode ) = @_;
my $dbh = C4::Context->dbh;
my $sth;
if ($item) {
-
- } else {
- my $qbc=$dbh->quote($barcode);
- # Look up the item by barcode
- $sth=$dbh->prepare("SELECT items.itemnumber
- FROM items
- WHERE barcode=$qbc");
- $sth->execute;
- ($item) = $sth->fetchrow;
- $sth->finish;
+ my $qitem = $dbh->quote($item);
+ # Look up the item by itemnumber
+ my $query = qq(
+ SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
+ FROM items, biblioitems, itemtypes
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND biblioitems.itemtype = itemtypes.itemtype
+ AND itemnumber=$qitem
+ );
+ $sth = $dbh->prepare($query);
+ }
+ else {
+ my $qbc = $dbh->quote($barcode);
+ # Look up the item by barcode
+ my $query = qq(
+ SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
+ FROM items, biblioitems, itemtypes
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND biblioitems.itemtype = itemtypes.itemtype
+ AND barcode=$qbc
+ );
+ $sth = $dbh->prepare($query);
+
+ # FIXME - This function uses $item later on. Ought to set it here.
}
+ $sth->execute;
+ my ( $biblio, $bibitem, $notforloan ) = $sth->fetchrow_array;
+ $sth->finish;
-
-# if item is not for loan it cannot be reserved either.....
-# return (0, 0) if ($notforloan);
-# get the reserves...
+ # if item is not for loan it cannot be reserved either.....
+ return ( 0, 0 ) if $notforloan;
+
+ # get the reserves...
# Find this item in the reserves
- my ($count, @reserves) = Findgroupreserve($item);
+ my @reserves = Findgroupreserve( $bibitem, $biblio );
+ my $count = scalar @reserves;
+
# $priority and $highest are used to find the most important item
# in the list returned by &Findgroupreserve. (The lower $priority,
# the more important the item.)
my $priority = 10000000;
my $highest;
if ($count) {
- foreach my $res (@reserves) {
- if ($res->{found} eq "W"){
- return ("Waiting", $res);
- }else{
- # See if this item is more important than what we've got
- # so far.
- if ($res->{'priority'} != 0 && $res->{'priority'} < $priority) {
- $priority = $res->{'priority'};
- $highest = $res;
- }
- }
- }
+ foreach my $res (@reserves) {
+ # FIXME - $item might be undefined or empty: the caller
+ # might be searching by barcode.
+ if ( $res->{'itemnumber'} == $item ) {
+ # Found it
+ return ( "Waiting", $res );
+ }
+ else {
+ # See if this item is more important than what we've got
+ # so far.
+ if ( $res->{'priority'} != 0 && $res->{'priority'} < $priority )
+ {
+ $priority = $res->{'priority'};
+ $highest = $res;
+ }
+ }
+ }
}
# If we get this far, then no exact match was found. Print the
# most important item on the list. I think this tells us who's
# next in line to get this book.
- if ($highest) { # FIXME - $highest might be undefined
- $highest->{'itemnumber'} = $item;
- return ("Reserved", $highest);
- } else {
- return (0, 0);
+ if ($highest) { # FIXME - $highest might be undefined
+ $highest->{'itemnumber'} = $item;
+ return ( "Reserved", $highest );
+ }
+ else {
+ return ( 0, 0 );
}
}
+#-------------------------------------------------------------------------------------
+
=item CancelReserve
- &CancelReserve($reserveid);
+ &CancelReserve($biblionumber, $itemnumber, $borrowernumber);
Cancels a reserve.
-Use reserveid to cancel the reservation.
+Use either C<$biblionumber> or C<$itemnumber> to specify the item to
+cancel, but not both: if both are given, C<&CancelReserve> does
+nothing.
-C<$reserveid> is the reserve ID to cancel.
+C<$borrowernumber> is the borrower number of the patron on whose
+behalf the book was reserved.
+
+If C<$biblionumber> was given, C<&CancelReserve> also adjusts the
+priorities of the other people who are waiting on the book.
=cut
+
#'
sub CancelReserve {
- my ($biblio, $item, $borr) = @_;
-
-my $dbh;
-
- $dbh = C4::Context->dbh;
-
- #warn "In CancelReserve";
- if (($item and $borr) and (not $biblio)) {
- # removing a waiting reserve record....
- # update the database...
- my $sth = $dbh->prepare("update reserves set cancellationdate = now(),
- found = Null,
- priority = 0
- where itemnumber = ?
- and borrowernumber = ?");
- $sth->execute($item,$borr);
- $sth->finish;
- }
- if (($biblio and $borr) and (not $item)) {
- # removing a reserve record....
- # get the prioritiy on this record....
- my $priority;
- my $sth=$dbh->prepare("SELECT priority FROM reserves
- WHERE biblionumber = ?
- AND borrowernumber = ?
- AND cancellationdate is NULL
- AND (found <> 1 )");
- $sth->execute($biblio,$borr);
- ($priority) = $sth->fetchrow_array;
- $sth->finish;
-
- # update the database, removing the record...
- $sth = $dbh->prepare("update reserves set cancellationdate = now(),
- found = 0,
- priority = 0
- where biblionumber = ?
- and borrowernumber = ?
- and cancellationdate is NULL
- and (found <> 1 )");
- $sth->execute($biblio,$borr);
- $sth->finish;
- # now fix the priority on the others....
- fixpriority($priority, $biblio);
+ my ( $biblio, $item, $borr ) = @_;
+ my $dbh = C4::Context->dbh;
+ if ( ( $item and $borr ) and ( not $biblio ) ) {
+ # removing a waiting reserve record....
+ # update the database...
+ my $query = qq/
+ UPDATE reserves
+ SET cancellationdate = now(),
+ found = Null,
+ priority = 0
+ WHERE itemnumber = ?
+ AND borrowernumber = ?
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $item, $borr );
+ $sth->finish;
+ }
+ if ( ( $biblio and $borr ) and ( not $item ) ) {
+ # removing a reserve record....
+ # get the prioritiy on this record....
+ my $priority;
+ my $query = qq/
+ SELECT priority FROM reserves
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND cancellationdate IS NULL
+ AND itemnumber IS NULL
+ AND (found <> 'F' OR found IS NULL)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borr );
+ ($priority) = $sth->fetchrow_array;
+ $sth->finish;
+ $query = qq/
+ UPDATE reserves
+ SET cancellationdate = now(),
+ found = Null,
+ priority = 0
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND cancellationdate IS NULL
+ AND (found <> 'F' or found IS NULL)
+ /;
+
+ # update the database, removing the record...
+ $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borr );
+ $sth->finish;
+
+ # now fix the priority on the others....
+ FixPriority( $priority, $biblio );
}
}
+
+#-------------------------------------------------------------------------------------
+
=item FillReserve
- &FillReserve($reserveid, $itemnumber);
+ &FillReserve($reserve);
Fill a reserve. If I understand this correctly, this means that the
reserved book has been found and given to the patron who reserved it.
-C<$reserve> specifies the reserve id to fill.
-
-C<$itemnumber> specifies the borrowed itemnumber for the reserve.
+C<$reserve> specifies the reserve to fill. It is a reference-to-hash
+whose keys are fields from the reserves table in the Koha database.
=cut
+
#'
sub FillReserve {
my ($res) = @_;
-my $dbh;
- $dbh = C4::Context->dbh;
+ my $dbh = C4::Context->dbh;
# fill in a reserve record....
- # FIXME - Remove some of the redundancy here
- my $biblio = $res->{'biblionumber'}; my $qbiblio =$biblio;
- my $borr = $res->{'borrowernumber'};
- my $resdate = $res->{'reservedate'};
+ my $qbiblio = $res->{'biblionumber'};
+ my $borr = $res->{'borrowernumber'};
+ my $resdate = $res->{'reservedate'};
# get the priority on this record....
my $priority;
- {
- my $query = "SELECT priority FROM reserves
- WHERE biblionumber = ?
- AND borrowernumber = ?
- AND reservedate = ?";
- my $sth=$dbh->prepare($query);
- $sth->execute($qbiblio,$borr,$resdate);
+ my $query = "SELECT priority
+ FROM reserves
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND reservedate = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $qbiblio, $borr, $resdate );
($priority) = $sth->fetchrow_array;
$sth->finish;
- }
# update the database...
- {
- my $query = "UPDATE reserves SET found = 1,
- priority = 0
- WHERE biblionumber = ?
- AND reservedate = ?
- AND borrowernumber = ?";
- my $sth = $dbh->prepare($query);
- $sth->execute($qbiblio,$resdate,$borr);
+ $query = "UPDATE reserves
+ SET found = 'F',
+ priority = 0
+ WHERE biblionumber = ?
+ AND reservedate = ?
+ AND borrowernumber = ?
+ ";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $qbiblio, $resdate, $borr );
$sth->finish;
- }
# now fix the priority on the others (if the priority wasn't
# already sorted!)....
- unless ($priority == 0) {
- fixpriority($priority, $biblio);
+ unless ( $priority == 0 ) {
+ FixPriority( $priority, $qbiblio );
}
}
-# Only used internally
-# Decrements (makes more important) the reserves for all of the
-# entries waiting on the given book, if their priority is > $priority.
-sub fixpriority {
- my ($priority, $biblio) = @_;
-my $dbh;
- $dbh = C4::Context->dbh;
-
- my ($count, $reserves) = FindReserves($biblio);
- foreach my $rec (@$reserves) {
- if ($rec->{'priority'} > $priority) {
- my $sth = $dbh->prepare("UPDATE reserves SET priority = ?
- WHERE biblionumber = ?
- AND borrowernumber = ?
- AND reservedate = ?");
- $sth->execute($rec->{'priority'},$rec->{'biblionumber'},$rec->{'borrowernumber'},$rec->{'reservedate'});
- $sth->finish;
- }
+#-------------------------------------------------------------------------------------
+
+=item FixPriority
+
+&FixPriority($biblio,$borrowernumber,$rank);
+
+ Only used internally (so don't export it)
+ Changed how this functions works #
+ Now just gets an array of reserves in the rank order and updates them with
+ the array index (+1 as array starts from 0)
+ and if $rank is supplied will splice item from the array and splice it back in again
+ in new priority rank
+
+=cut
+
+sub FixPriority {
+ my ( $biblio, $borrowernumber, $rank ) = @_;
+ my $dbh = C4::Context->dbh;
+ if ( $rank eq "del" ) {
+ CancelReserve( $biblio, undef, $borrowernumber );
+ }
+ if ( $rank eq "W" || $rank eq "0" ) {
+
+ # make sure priority for waiting items is 0
+ my $query = qq/
+ UPDATE reserves
+ SET priority = 0
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND cancellationdate IS NULL
+ AND found ='W'
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borrowernumber );
+ }
+ my @priority;
+ my @reservedates;
+
+ # get whats left
+# FIXME adding a new security in returned elements for changing priority,
+# now, we don't care anymore any reservations with itemnumber linked (suppose a waiting reserve)
+ my $query = qq/
+ SELECT borrowernumber, reservedate, constrainttype
+ FROM reserves
+ WHERE biblionumber = ?
+ AND cancellationdate IS NULL
+ AND itemnumber IS NULL
+ AND ((found <> 'F' and found <> 'W') or found is NULL)
+ ORDER BY priority ASC
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblio);
+ while ( my $line = $sth->fetchrow_hashref ) {
+ push( @reservedates, $line );
+ push( @priority, $line );
+ }
+
+ # To find the matching index
+ my $i;
+ my $key = -1; # to allow for 0 to be a valid result
+ for ( $i = 0 ; $i < @priority ; $i++ ) {
+ if ( $borrowernumber == $priority[$i]->{'borrowernumber'} ) {
+ $key = $i; # save the index
+ last;
+ }
+ }
+
+ # if index exists in array then move it to new position
+ if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
+ my $new_rank = $rank -
+ 1; # $new_rank is what you want the new index to be in the array
+ my $moving_item = splice( @priority, $key, 1 );
+ splice( @priority, $new_rank, 0, $moving_item );
+ }
+
+ # now fix the priority on those that are left....
+ $query = "
+ UPDATE reserves
+ SET priority = ?
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND reservedate = ?
+ AND found IS NULL
+ ";
+ $sth = $dbh->prepare($query);
+ for ( my $j = 0 ; $j < @priority ; $j++ ) {
+ $sth->execute(
+ $j + 1, $biblio,
+ $priority[$j]->{'borrowernumber'},
+ $priority[$j]->{'reservedate'}
+ );
+ $sth->finish;
}
}
-# XXX - POD
+#-------------------------------------------------------------------------------------
+
+=item ReserveWaiting
+
+branchcode = &ReserveWaiting($item,$borr);
+this function set FOUND to 'W' for Waiting into the database.
+
+=cut
+
sub ReserveWaiting {
- my ($item, $borr) = @_;
-
-my $dbh;
-
- $dbh = C4::Context->dbh;
-
-# get priority and biblionumber....
- my $sth = $dbh->prepare("SELECT reserves.priority as priority,
- reserves.biblionumber as biblionumber,
- reserves.branchcode as branchcode,
- reserves.timestamp as timestamp
- FROM reserves
- WHERE reserves.itemnumber = ?
- AND reserves.borrowernumber = ?
- AND reserves.cancellationdate is NULL
- AND (reserves.found <> '1' or reserves.found is NULL)");
- $sth->execute($item,$borr);
+ my ( $item, $borr,$diffBranchSend ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # get priority and biblionumber....
+ my $query = qq/
+ SELECT reserves.priority as priority,
+ reserves.biblionumber as biblionumber,
+ reserves.branchcode as branchcode,
+ reserves.timestamp as timestamp
+ FROM reserves,items
+ WHERE reserves.biblionumber = items.biblionumber
+ AND items.itemnumber = ?
+ AND reserves.borrowernumber = ?
+ AND reserves.cancellationdate IS NULL
+ AND (reserves.found <> 'F' OR reserves.found IS NULL)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $item, $borr );
my $data = $sth->fetchrow_hashref;
$sth->finish;
- my $biblio = $data->{'biblionumber'};
+ my $biblio = $data->{'biblionumber'};
my $timestamp = $data->{'timestamp'};
-# update reserves record....
- $sth = $dbh->prepare("UPDATE reserves SET priority = 0, found = 'W'
- WHERE borrowernumber = ?
- AND itemnumber = ?
- AND timestamp = ?");
- $sth->execute($borr,$item,$timestamp);
+
+ # update reserves record....
+ if ($diffBranchSend) {
+ $query = qq/
+ UPDATE reserves
+ SET priority = 0,
+ itemnumber = ?
+ WHERE borrowernumber = ?
+ AND biblionumber = ?
+ AND timestamp = ?
+ /;
+ }
+ else {
+ $query = qq/
+ UPDATE reserves
+ SET priority = 0,
+ found = 'W',
+ waitingdate=now(),
+ itemnumber = ?
+ WHERE borrowernumber = ?
+ AND biblionumber = ?
+ AND timestamp = ?
+ /;
+ }
+ $sth = $dbh->prepare($query);
+ $sth->execute( $item, $borr, $biblio, $timestamp );
$sth->finish;
-# now fix up the remaining priorities....
- fixpriority($data->{'priority'}, $biblio);
+
+ # now fix up the remaining priorities....
+ FixPriority( $data->{'priority'}, $biblio );
my $branchcode = $data->{'branchcode'};
return $branchcode;
}
-# XXX - POD
-sub CheckWaiting {
- my ($borr)=@_;
-
-my $dbh;
- $dbh = C4::Context->dbh;
+#-------------------------------------------------------------------------------------
+
+=item GetWaitingReserves
+
+\@itemswaiting=GetWaitingReserves($borr);
+
+this funtion fetch the list of waiting reserves from database.
+
+=cut
+
+sub GetWaitingReserves {
+ my ($borr) = @_;
+ my $dbh = C4::Context->dbh;
my @itemswaiting;
- my $sth = $dbh->prepare("SELECT * FROM reserves
- WHERE borrowernumber = ?
- AND reserves.found = 'W'
- AND cancellationdate is NULL");
+ my $query = qq/
+ SELECT *
+ FROM reserves
+ WHERE borrowernumber = ?
+ AND reserves.found = 'W'
+ AND cancellationdate IS NULL
+ /;
+ my $sth = $dbh->prepare($query);
$sth->execute($borr);
- while (my $data=$sth->fetchrow_hashref) {
- push(@itemswaiting,$data);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @itemswaiting, $data );
}
$sth->finish;
- return (scalar(@itemswaiting),\@itemswaiting);
+ return \@itemswaiting;
}
+#-------------------------------------------------------------------------------------
+
=item Findgroupreserve
- ($count, @results) = &Findgroupreserve($biblioitemnumber, $biblionumber);
+ @results = &Findgroupreserve($biblioitemnumber, $biblionumber);
+****** FIXME ******
I don't know what this does, because I don't understand how reserve
constraints work. I think the idea is that you reserve a particular
biblio, and the constraint allows you to restrict it to a given
biblioitem (e.g., if you want to borrow the audio book edition of "The
Prophet", rather than the first available publication).
-C<&Findgroupreserve> returns a two-element array:
-
-C<$count> is the number of elements in C<@results>.
-
+C<&Findgroupreserve> returns :
C<@results> is an array of references-to-hash whose keys are mostly
fields from the reserves table of the Koha database, plus
C<biblioitemnumber>.
=cut
+
#'
sub Findgroupreserve {
- my ($itemnumber)=@_;
-
-my $dbh = C4::Context->dbh;
-
- my $sth = $dbh->prepare("SELECT *
- FROM reserves
- WHERE (itemnumber = ?) AND
- (cancellationdate IS NULL) AND
- (found <> 1)
- ORDER BY timestamp");
- $sth->execute($itemnumber);
- my @results;
- while (my $data = $sth->fetchrow_hashref) {
- push(@results,$data);
- }
- $sth->finish;
- return(scalar(@results),@results);
+ my ( $bibitem, $biblio ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ SELECT reserves.biblionumber AS biblionumber,
+ reserves.borrowernumber AS borrowernumber,
+ reserves.reservedate AS reservedate,
+ reserves.branchcode AS branchcode,
+ reserves.cancellationdate AS cancellationdate,
+ reserves.found AS found,
+ reserves.reservenotes AS reservenotes,
+ reserves.priority AS priority,
+ reserves.timestamp AS timestamp,
+ reserveconstraints.biblioitemnumber AS biblioitemnumber,
+ reserves.itemnumber AS itemnumber
+ FROM reserves
+ LEFT JOIN reserveconstraints ON reserves.biblionumber = reserveconstraints.biblionumber
+ WHERE reserves.biblionumber = ?
+ AND ( ( reserveconstraints.biblioitemnumber = ?
+ AND reserves.borrowernumber = reserveconstraints.borrowernumber
+ AND reserves.reservedate =reserveconstraints.reservedate )
+ OR reserves.constrainttype='a' )
+ AND reserves.cancellationdate is NULL
+ AND (reserves.found <> 'F' or reserves.found is NULL)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $bibitem );
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
+ }
+ $sth->finish;
+ return @results;
}
-# FIXME - A somewhat different version of this function appears in
-# C4::Reserves. Pick one and stick with it.
-# XXX - POD
+=item CreateReserve
+
+CreateReserve($env,$branch,$borrowernumber,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)
+
+FIXME - A somewhat different version of this function appears in
+C4::Reserves. Pick one and stick with it.
+
+=cut
+
sub CreateReserve {
- my ($env, $borrnum,$registeredby ,$biblionumber,$reservefrom, $reserveto, $branch,
- $constraint, $priority, $notes, $title,$bibitems,$itemnumber) = @_;
-
-my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("INSERT INTO reserves
- (borrowernumber, registeredby, reservedate, biblionumber, reservefrom,
- reserveto, branchcode, constrainttype, priority, found, reservenotes,itemnumber)
- VALUES (?, ?, NOW(),?,?,?,?,?,?,0,?,?)");
- $sth->execute($borrnum, $registeredby, $biblionumber, $reservefrom, $reserveto, $branch, $constraint, $priority, $notes,$itemnumber);
-my $fee=CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems);
- if ($fee > 0) {
-
- my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
- my $usth = $dbh->prepare("insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values
- (?,?,now(),?,?,'Res',?)");
- $usth->execute($borrnum,$nextacctno,$fee,'Reserve Charge -'. $title,$fee);
- $usth->finish;
- }
- return 1;
+ my (
+ $env, $branch, $borrowernumber, $biblionumber,
+ $constraint, $bibitems, $priority, $notes,
+ $title, $checkitem, $found
+ ) = @_;
+ my $fee;
+ if ( $library_name =~ /Horowhenua/ ) {
+ $fee =
+ CalcHLTReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
+ $bibitems );
+ }
+ else {
+ $fee =
+ CalcReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
+ $bibitems );
+ }
+ my $dbh = C4::Context->dbh;
+ my $const = lc substr( $constraint, 0, 1 );
+ my @datearr = localtime(time);
+ my $resdate =
+ ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
+ my $waitingdate;
+
+ # If the reserv had the waiting status, we had the value of the resdate
+ if ( $found eq 'W' ) {
+ $waitingdate = $resdate;
+ }
+
+ #eval {
+ # updates take place here
+ if ( $fee > 0 ) {
+ my $nextacctno = &getnextacctno( $env, $borrowernumber, $dbh );
+ my $query = qq/
+ INSERT INTO accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ VALUES
+ (?,?,now(),?,?,'Res',?)
+ /;
+ my $usth = $dbh->prepare($query);
+ $usth->execute( $borrowernumber, $nextacctno, $fee,
+ "Reserve Charge - $title", $fee );
+ $usth->finish;
+ }
+
+ #if ($const eq 'a'){
+ my $query = qq/
+ INSERT INTO reserves
+ (borrowernumber,biblionumber,reservedate,branchcode,constrainttype,
+ priority,reservenotes,itemnumber,found,waitingdate)
+ VALUES
+ (?,?,?,?,?,
+ ?,?,?,?,?)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $borrowernumber, $biblionumber, $resdate, $branch,
+ $const, $priority, $notes, $checkitem,
+ $found, $waitingdate
+ );
+ $sth->finish;
+
+ #}
+ if ( ( $const eq "o" ) || ( $const eq "e" ) ) {
+ my $numitems = @$bibitems;
+ my $i = 0;
+ while ( $i < $numitems ) {
+ my $biblioitem = @$bibitems[$i];
+ my $query = qq/
+ INSERT INTO reserveconstraints
+ (borrowernumber,biblionumber,reservedate,biblioitemnumber)
+ VALUES
+ (?,?,?,?)
+ /;
+ my $sth = $dbh->prepare("");
+ $sth->execute( $borrowernumber, $biblionumber, $resdate,
+ $biblioitem );
+ $sth->finish;
+ $i++;
+ }
+ }
+ return;
}
# FIXME - A functionally identical version of this function appears in
# FIXME - opac-reserves.pl need to use it, temporarily put into @EXPORT
sub CalcReserveFee {
- my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_;
- #check for issues;
-my $dbh = C4::Context->dbh;
-
-
- my $const = lc substr($constraint,0,1);
- my $sth = $dbh->prepare("SELECT * FROM borrowers,categories
- WHERE (borrowernumber = ?)
- AND (borrowers.categorycode = categories.categorycode)");
- $sth->execute($borrnum);
- my $data = $sth->fetchrow_hashref;
- $sth->finish();
- my $fee = $data->{'reservefee'};
-
- if ($fee > 0) {
- # check for items on issue
-
-
- my $issues = 0;
- my $x = 0;
- my $allissued = 1;
-
- my $sth2 = $dbh->prepare("SELECT * FROM items
- WHERE biblionumber = ?");
- $sth2->execute($biblionumber);
- while (my $itdata=$sth2->fetchrow_hashref) {
- my $sth3 = $dbh->prepare("SELECT * FROM issues
+ my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
+
+ #check for issues;
+ my $dbh = C4::Context->dbh;
+ my $const = lc substr( $constraint, 0, 1 );
+ my $query = qq/
+ SELECT * FROM borrowers,categories
+ WHERE borrowernumber = ?
+ AND borrowers.categorycode = categories.categorycode
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish();
+ my $fee = $data->{'reservefee'};
+ my $cntitems = @- > $bibitems;
+
+ if ( $fee > 0 ) {
+
+ # check for items on issue
+ # first find biblioitem records
+ my @biblioitems;
+ my $sth1 = $dbh->prepare(
+ "SELECT * FROM biblio,biblioitems
+ WHERE (biblio.biblionumber = ?)
+ AND (biblio.biblionumber = biblioitems.biblionumber)"
+ );
+ $sth1->execute($biblionumber);
+ while ( my $data1 = $sth1->fetchrow_hashref ) {
+ if ( $const eq "a" ) {
+ push @biblioitems, $data1;
+ }
+ else {
+ my $found = 0;
+ my $x = 0;
+ while ( $x < $cntitems ) {
+ if ( @$bibitems->{'biblioitemnumber'} ==
+ $data->{'biblioitemnumber'} )
+ {
+ $found = 1;
+ }
+ $x++;
+ }
+ if ( $const eq 'o' ) {
+ if ( $found == 1 ) {
+ push @biblioitems, $data1;
+ }
+ }
+ else {
+ if ( $found == 0 ) {
+ push @biblioitems, $data1;
+ }
+ }
+ }
+ }
+ $sth1->finish;
+ my $cntitemsfound = @biblioitems;
+ my $issues = 0;
+ my $x = 0;
+ my $allissued = 1;
+ while ( $x < $cntitemsfound ) {
+ my $bitdata = $biblioitems[$x];
+ my $sth2 = $dbh->prepare(
+ "SELECT * FROM items
+ WHERE biblioitemnumber = ?"
+ );
+ $sth2->execute( $bitdata->{'biblioitemnumber'} );
+ while ( my $itdata = $sth2->fetchrow_hashref ) {
+ my $sth3 = $dbh->prepare(
+ "SELECT * FROM issues
WHERE itemnumber = ?
- AND returndate IS NULL");
- $sth3->execute($itdata->{'itemnumber'});
- if (my $isdata=$sth3->fetchrow_hashref) {
- } else {
- $allissued = 0;
- }
- }
-
-
- if ($allissued == 0) {
- my $rsth = $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
- $rsth->execute($biblionumber);
- if (my $rdata = $rsth->fetchrow_hashref) {
- } else {
+ AND returndate IS NULL"
+ );
+ $sth3->execute( $itdata->{'itemnumber'} );
+ if ( my $isdata = $sth3->fetchrow_hashref ) {
+ }
+ else {
+ $allissued = 0;
+ }
+ }
+ $x++;
+ }
+ if ( $allissued == 0 ) {
+ my $rsth =
+ $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
+ $rsth->execute($biblionumber);
+ if ( my $rdata = $rsth->fetchrow_hashref ) {
+ }
+ else {
+ $fee = 0;
+ }
+ }
+ }
+
+ # print "fee $fee";
+ return $fee;
+}
+
+# The following are junior and young adult item types that should not incur a
+# reserve charge.
+#
+# Juniors: BJC, BJCN, BJF, BJK, BJM, BJN, BJP, BJSF, BJSN, DJ, DJP, FJ, JVID,
+# VJ, VJP, PJ, TJ, TJP, VJ, VJP.
+#
+# Young adults: BYF, BYN, BYP, DY, DYP, PY, PYP, TY, TYP, VY, VYP.
+#
+# All other item types should incur a reserve charge.
+sub CalcHLTReserveFee {
+ my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT * FROM borrowers,categories
+ WHERE (borrowernumber = ?)
+ AND (borrowers.categorycode = categories.categorycode)"
+ );
+ $sth->execute($borrowernumber);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish();
+ my $fee = $data->{'reservefee'};
+
+ my $matchno;
+ my @nocharge =
+ qw/BJC BJCN BJF BJK BJM BJN BJP BJSF BJSN DJ DJP FJ NJ CJ VJ VJP PJ TJ TJP BYF BYN BYP DY DYP PY PYP TY TYP VY VYP/;
+ $sth = $dbh->prepare(
+ "SELECT * FROM biblio,biblioitems
+ WHERE (biblio.biblionumber = ?)
+ AND (biblio.biblionumber = biblioitems.biblionumber)"
+ );
+ $sth->execute($biblionumber);
+ $data = $sth->fetchrow_hashref;
+ my $itemtype = $data->{'itemtype'};
+ for ( my $i = 0 ; $i < @nocharge ; $i++ ) {
+ if ( $itemtype eq $nocharge[$i] ) {
+ $matchno++;
+ last;
+ }
+ }
+
+ if ( $matchno > 0 ) {
$fee = 0;
- }
}
- }
-# print "fee $fee";
-
- return $fee;
+ return $fee;
}
-# XXX - Internal use
-sub getnextacctno {
- my ($env,$bornumber,$dbh)=@_;
- my $nextaccntno = 1;
- my $sth = $dbh->prepare("select * from accountlines
+=item GetNextAccountNumber
+
+GetNextAccountNumber()
+
+=cut
+
+sub GetNextAccountNumber {
+ my ( $env, $borrowernumber, $dbh ) = @_;
+ my $nextaccntno = 1;
+ my $sth = $dbh->prepare(
+ "select * from accountlines
where (borrowernumber = ?)
- order by accountno desc");
- $sth->execute($bornumber);
- if (my $accdata=$sth->fetchrow_hashref){
- $nextaccntno = $accdata->{'accountno'} + 1;
- }
- $sth->finish;
- return($nextaccntno);
+ order by accountno desc"
+ );
+ $sth->execute($borrowernumber);
+ if ( my $accdata = $sth->fetchrow_hashref ) {
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return ($nextaccntno);
}
-# XXX - POD
-sub UpdateReserves {
+#-------------------------------------------------------------------------------------
+
+=item UpdateReserve
+
+&UpdateReserve($rank,$biblio,$borrower,$branch)
+
+=cut
+
+sub UpdateReserve {
#subroutine to update a reserve
- my ($rank,$biblio,$borrower,$branch,$cataloger)=@_;
- return if $rank eq "W";
- return if $rank eq "n";
-my $dbh;
- $dbh = C4::Context->dbh;
-
- if ($rank eq "del") {
- my $sth=$dbh->prepare("UPDATE reserves SET cancellationdate=now(),registeredby=?
- WHERE biblionumber = ?
- AND borrowernumber = ?
- AND cancellationdate is NULL
- AND (found <> 1 )");
- $sth->execute($cataloger,$biblio, $borrower);
- $sth->finish;
- } else {
- my $sth=$dbh->prepare("UPDATE reserves SET priority = ? ,branchcode = ?, found = 0
- WHERE biblionumber = ?
- AND borrowernumber = ?
- AND cancellationdate is NULL
- AND (found <> 1)");
- $sth->execute($rank, $branch, $biblio, $borrower);
- $sth->finish;
+ my ( $rank, $biblio, $borrower, $branch , $itemnumber) = @_;
+ return if $rank eq "W";
+ return if $rank eq "n";
+ my $dbh = C4::Context->dbh;
+ if ( $rank eq "del" ) {
+ my $query = qq/
+ UPDATE reserves
+ SET cancellationdate=now()
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND cancellationdate is NULL
+ AND (found <> 'F' or found is NULL)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borrower );
+ $sth->finish;
+
+ }
+ else {
+ my $query = qq/
+ UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = ?, found = NULL
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND cancellationdate is NULL
+ AND (found <> 'F' or found is NULL)
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $rank, $branch,$itemnumber, $biblio, $borrower);
+ $sth->finish;
+ FixPriority( $biblio, $borrower, $rank);
}
}
-# XXX - POD
-sub UpdateReserve {
- #subroutine to update a reserve
- my ($reserveid, $timestamp) = @_;
+=item GetReserveTitle
-my $dbh;
- $dbh = C4::Context->dbh;
+$data = GetReserveTitle($biblio,$bor,$date,$timestamp);
+=cut
- my $sth=$dbh->prepare("UPDATE reserves
- SET timestamp = $timestamp,
- reservedate = DATE_FORMAT($timestamp, '%Y-%m-%d')
- WHERE (reserveid = $reserveid)");
- $sth->execute();
- $sth->finish;
+sub GetReserveTitle {
+ my ( $biblio, $bor, $date, $timestamp ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq/
+ SELECT *
+ FROM reserveconstraints,biblioitems
+ WHERE reserveconstraints.biblioitemnumber=biblioitems.biblioitemnumber
+ AND reserveconstraints.biblionumber=?
+ AND reserveconstraints.borrowernumber = ?
+ AND reserveconstraints.reservedate=?
+ AND reserveconstraints.timestamp=?
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $bor, $date, $timestamp );
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $data;
}
-# XXX - POD
-sub getreservetitle {
- my ($biblio,$bor,$date,$timestamp)=@_;
-my $dbh = C4::Context->dbh;
+=item FindReservesInQueue
+ $results = &FindReservesInQueue($biblionumber);
- my $sth=$dbh->prepare("Select * from reserveconstraints where
- reserveconstraints.biblionumber=? and reserveconstraints.borrowernumber
- = ? and reserveconstraints.reservedate=? and
- reserveconstraints.timestamp=?");
- $sth->execute($biblio,$bor,$date,$timestamp);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data);
-}
+Simple variant of FindReserves, exept the result is now displaying only the queue list of reservations with the same biblionumber (At this time only displayed in request.pl)
+
+C<&FindReservesInQueue> returns a two-element array:
+
+C<$results> is a reference to an array of references of hashes. Each hash
+has for keys a list of column from reserves table (see details in function).
+
+=cut
+
+#'
+
+sub FindReservesInQueue {
+ my ($biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # Find the desired items in the reserves
+ my $query = qq/
+ SELECT branchcode,
+ timestamp AS rtimestamp,
+ priority,
+ biblionumber,
+ borrowernumber,
+ reservedate,
+ constrainttype,
+ found,
+ itemnumber
+ FROM reserves
+ WHERE cancellationdate IS NULL
+ AND biblionumber = ?
+ AND (found <> \'F\' OR found IS NULL)
+ AND priority <> \'0\'
+ ORDER BY priority
+ /;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ my @results;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # FIXME - What is this if-statement doing? How do constraints work?
+ if ( $data->{constrainttype} eq 'o' ) {
+ $query = '
+ SELECT biblioitemnumber
+ FROM reserveconstraints
+ WHERE biblionumber = ?
+ AND borrowernumber = ?
+ AND reservedate = ?
+ ';
+ my $csth = $dbh->prepare($query);
+ $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
+ $data->{reservedate}, );
+
+ my @bibitemno;
+ while ( my $bibitemnos = $csth->fetchrow_array ) {
+ push( @bibitemno, $bibitemnos );
+ }
+ my $count = @bibitemno;
+
+ # if we have two or more different specific itemtypes
+ # reserved by same person on same day
+ my $bdata;
+ if ( $count > 1 ) {
+ $bdata = GetBiblioItemData( $bibitemno[$i] );
+ $i++;
+ }
+ else {
+ # Look up the book we just found.
+ $bdata = GetBiblioItemData( $bibitemno[0] );
+ }
+ $csth->finish;
+
+ # Add the results of this latest search to the current
+ # results.
+ # FIXME - An 'each' would probably be more efficient.
+ foreach my $key ( keys %$bdata ) {
+ $data->{$key} = $bdata->{$key};
+ }
+ }
+ push @results, $data;
+ }
+ $sth->finish;
-sub findActiveReserve {
- my ($borrowernumber, $biblionumber, $from, $days) = @_;
-my $dbh = C4::Context->dbh;
-
- my $sth = $dbh->prepare("SELECT *
- FROM reserves
- WHERE
- borrowernumber = ?
- AND biblionumber = ?
- AND (cancellationdate IS NULL)
- AND (found <> 1)
- AND ((? BETWEEN reservefrom AND reserveto)
- OR (ADDDATE(?, INTERVAL ? DAY) BETWEEN reservefrom AND reserveto))
- ");
- $sth->execute($borrowernumber, $biblionumber, $from, $from, $days);
- return ($sth->rows);
+ return ( $#results + 1, \@results );
}
-1;
\ No newline at end of file
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+=cut
+
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 0.01;
+# set the version for version checking
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
=head1 FUNCTIONS
-=over 2
-
=cut
@ISA = qw(Exporter);
my $sth = $dbh->prepare($query);
$sth->execute( $review, 0, $borrowernumber, $biblionumber );
$sth->finish();
-
}
sub numberofreviews {
Takes a reviewid and marks that review approved
-
=cut
sub approvereview {
Takes a reviewid and deletes it
-
=cut
sub deletereview {
1;
__END__
-=back
-
=head1 AUTHOR
Koha Team
package C4::Search;
-# Copyright 2000-2002 Katipo Communications
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
use strict;
require Exporter;
use C4::Context;
-use C4::Reserves2;
-use C4::Biblio;
-use ZOOM;
-use Encode;
-use C4::Date;
+use C4::Biblio; # MARCfind_marc_from_kohafield
+use C4::Koha; # getFacets
+use Lingua::Stem;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
- shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
-C4::Search - Functions for searching the Koha catalog and other databases
+C4::Search - Functions for searching the Koha catalog.
=head1 SYNOPSIS
- use C4::Search;
-
- my ($count, @results) = catalogsearch4($env, $type, $search, $num, $offset);
+see opac/opac-search.pl or catalogue/search.pl for example of usage
=head1 DESCRIPTION
-This module provides the searching facilities for the Koha catalog and
-ZEBRA databases.
-
-
+This module provides the searching facilities for the Koha into a zebra catalog.
=head1 FUNCTIONS
-=over 2
-
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &barcodes &ItemInfo &itemcount
- &getcoverPhoto &add_query_line
- &FindDuplicate &ZEBRAsearch_kohafields &convertPQF &sqlsearch &cataloguing_search
-&getMARCnotes &getMARCsubjects &getMARCurls &getMARCadditional_authors &parsefields &spellSuggest);
-# make all your functions, whether exported or not;
-
-=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
-So you give an array of @kohafieldnames,@values, what relation they have @relations (equal, truncation etc) @and_or and
-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.
-This routine will also take CCL,CQL or PQF queries and pass them straight to the server
-See sub FindDuplicates for an example;
-=cut
+ &SimpleSearch
+ &findseealso
+ &FindDuplicate
+ &searchResults
+ &getRecords
+ &buildQuery
+);
+# make all your functions, whether exported or not;
+=head2 findseealso($dbh,$fields);
+C<$dbh> is a link to the DB handler.
-sub ZEBRAsearch_kohafields{
-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++){
- next if (@$value[$i] eq "");
- my $keyattr=MARCfind_attr_from_kohafield(@$kohafield[$i]) if (@$kohafield[$i]);
- if (!$keyattr){$keyattr=" \@attr 1=any";}
- @$value[$i]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/|\")/ /g;
- my $weighted=weightRank(@$kohafield[$i],@$value[$i],$i) unless($sort || $reorder);
- $query.=$weighted.@$relation[$i]." ".$keyattr." \"".@$value[$i]."\" " if @$value[$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);
-my @sortpart;
-if ($reorder ){
- (@sortpart)=split /,/,$reorder;
-}elsif ($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," "; ##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
- }
-}
-
-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;
-
-my $numresults;
-
-retry:
-$oResult= $oConnection[0]->search($query);
-my $i;
-my $event;
- while (($i = ZOOM::event(\@oConnection)) != 0) {
- $event = $oConnection[$i-1]->last_event();
- last if $event == ZOOM::Event::ZEND;
- }# while
-
- my($error, $errmsg, $addinfo, $diagset) = $oConnection[0]->error_x();
- if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update
- $tried=$tried+1;
- goto "retry";
- }elsif ($error==2 && $tried<2) {## timeout --temporary zebra error !whatever that means
- $tried=$tried+1;
- goto "retry";
- }elsif ($error){
- warn "Error-$server /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
- $oResult->destroy();
- $oConnection[0]->destroy();
- return (undef,undef);
- }
-my $dbh=C4::Context->dbh;
- $numresults=$oResult->size() ;
-
- if ($numresults>0){
- my $ri=0;
- my $z=0;
-
- $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 ($facets,@parsed)=parsefields($dbh,$searchfrom,@results);
- return ($numresults,$facets,@parsed) ;
- }
- }# if numresults
-
-$oResult->destroy();
-$oConnection[0]->destroy();
-EXITING:
-return ($numresults,@results) ;
-}
-
-sub weightRank {
-my ($kohafield,$value,$i)=@_;
-### If a multi query is received weighting is reduced from 1st query being highest rank to last query being lowest;
-my $weighted;
-my $weight=1000 -($i*100);
-$weight=100 if $weight==0;
- return "" if $value eq "";
- my $keyattr=MARCfind_attr_from_kohafield($kohafield) if ($kohafield);
- return "" if($keyattr=~/4=109/ || $keyattr=~/4=4/ || $keyattr=~/4=5/); ###ranked sort not valid for numeric fields
- my $fullfield; ### not all indexes are Complete-field. Use only for title||author
- if ($kohafield eq "title" || $kohafield eq "" || $kohafield eq "any"){
- $keyattr=" \@attr 1=title-cover";
- $fullfield="\@attr 6=3 ";
- }elsif ($kohafield eq "author"){
- $fullfield="\@attr 6=3 ";
- }
- $weighted.="\@attr 2=102 ".$keyattr." \@attr 3=1 $fullfield \@attr 9=$weight \"".$value."\" " ;
- $weighted=" \@or ".$weighted;
- return $weighted;
-}
-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;
-}
+use C4::Context;
+my $dbh =C4::Context->dbh;
-return $pqf_query;
-}
+C<$fields> is a reference to the fields array
+This function modify the @$fields array and add related fields to search on.
-=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
=cut
-sub add_html_bold_fields {
- my ($type, $data, $search) = @_;
- foreach my $key ('title', 'author') {
- my $new_key;
-
- $new_key = 'bold_' . $key;
- $data->{$new_key} = $data->{$key};
- my $key1;
-
- $key1 = $key;
-
-
- my @keys;
- my $i = 1;
- if ($type eq 'keyword') {
- my $newkey=$search->{'keyword'};
- $newkey=~s /\++//g;
- @keys = split " ", $newkey;
- }
- my $count = @keys;
- for ($i = 0; $i < $count ; $i++) {
-
- if (($data->{$new_key} =~ /($keys[$i])/i) && (lc($keys[$i]) ne 'b') ) {
- my $word = $1;
- $data->{$new_key} =~ s/$word/<b>$word<\/b>/;
- }
-
- }
- }
-
-}
- sub sqlsearch{
-## This searches the SQL database only for biblionumber,itemnumber,barcode
-### Not very useful on production but as a debug tool useful during system maturing for ZEBRA operations
-
-my ($dbh,$search)=@_;
-my $sth;
-if ($search->{'barcode'} ne '') {
- $sth=$dbh->prepare("SELECT biblionumber from items where barcode=?");
- $sth->execute($search->{'barcode'});
-}elsif ($search->{'itemnumber'} ne '') {
- $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?");
- $sth->execute($search->{'itemnumber'});
-}elsif ($search->{'biblionumber'} ne '') {
- $sth=$dbh->prepare("SELECT biblionumber from biblio where biblionumber=?");
- $sth->execute($search->{'biblionumber'});
-}else{
-return (undef,undef);
-}
-
- my $result=$sth->fetchrow_hashref;
-return (1,$result) if $result;
+sub findseealso {
+ my ( $dbh, $fields ) = @_;
+ my $tagslib = MARCgettagslib( $dbh, 1 );
+ for ( my $i = 0 ; $i <= $#{$fields} ; $i++ ) {
+ my ($tag) = substr( @$fields[$i], 1, 3 );
+ my ($subfield) = substr( @$fields[$i], 4, 1 );
+ @$fields[$i] .= ',' . $tagslib->{$tag}->{$subfield}->{seealso}
+ if ( $tagslib->{$tag}->{$subfield}->{seealso} );
+ }
}
-sub cataloguing_search{
-## This is an SQL based search designed to be used when adding a new biblio incase library sets
-## preference zebraorsql to sql when adding a new biblio
-my ($search,$num,$offset) = @_;
- my ($count,@results);
-my $dbh=C4::Context->dbh;
-#Prepare search
-my $query;
-my $condition="select SQL_CALC_FOUND_ROWS marcxml from biblio where ";
-if ($search->{'isbn'} ne''){
-$search->{'isbn'}=$search->{'isbn'}."%";
-$query=$search->{'isbn'};
-$condition.= " isbn like ? ";
-}else{
-return (0,undef) unless $search->{title};
-$query=$search->{'title'};
-$condition.= " MATCH (title) AGAINST(? in BOOLEAN MODE ) ";
-}
-my $sth=$dbh->prepare($condition);
-$sth->execute($query);
- my $nbresult=$dbh->prepare("SELECT FOUND_ROWS()");
- $nbresult->execute;
- my $count=$nbresult->fetchrow;
-my $limit = $num + $offset;
-my $startfrom = $offset;
-my $i=0;
-my @results;
-while (my $marc=$sth->fetchrow){
- if (($i >= $startfrom) && ($i < $limit)) {
- my $record=XML_xml2hash_onerecord($marc);
- my $data=XMLmarc2koha_onerecord($dbh,$record,"biblios");
- push @results,$data;
- }
-$i++;
-last if $i==$limit;
-}
-return ($count,@results);
-}
+=head2 FindDuplicate
+($biblionumber,$biblionumber,$title) = FindDuplicate($record);
+=cut
sub FindDuplicate {
- my ($xml)=@_;
-my $dbh=C4::Context->dbh;
- my ($result) = XMLmarc2koha_onerecord($dbh,$xml,"biblios");
- my @kohafield;
- my @value;
- my @relation;
- my @and_or;
-
- # search duplicate on ISBN, easy and fast..
-
- if ($result->{isbn}) {
- push @kohafield,"isbn";
-###Temporary fix for ISBN
-my $isbn=$result->{isbn};
-$isbn=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\!|\'|,|\-|\"|\*|\(|\)|\[|\]|\{|\}|\/)//g;
- push @value,$isbn;
- }else{
-$result->{title}=~s /\\//g;
-$result->{title}=~s /\"//g;
-$result->{title}=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\-|\(|\)|\[|\]|\{|\}|\/)/ /g;
-
- push @kohafield,"title";
- push @value,$result->{title};
- push @relation,"\@attr 6=3 \@attr 4=1 \@attr 5=1"; ## right truncated,phrase,whole field
-
- }
- my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value,\@relation,"",\@and_or,0,"",0,1);
-if ($total){
-my $title=XML_readline($result[0],"title","biblios") ;
-my $biblionumber=XML_readline($result[0],"biblionumber","biblios") ;
- return $biblionumber,$title ;
-}
-
-}
-
-
-sub add_query_line {
-
- my ($type,$search,$results)=@_;
- my $dbh = C4::Context->dbh;
- my $searchdesc = '';
- my $from;
- my $borrowernumber = $search->{'borrowernumber'};
- my $remote_IP = $search->{'remote_IP'};
- my $remote_URL= $search->{'remote_URL'};
- my $searchdesc = $search->{'searchdesc'};
-
-my $sth = $dbh->prepare("INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip,user,actual) VALUES(?,?,?,?,?)");
-
-
-$sth->execute($searchdesc,$results,$remote_IP,$borrowernumber,$remote_URL);
-$sth->finish;
-
+ my ($record) = @_;
+ return;
+ my $dbh = C4::Context->dbh;
+ my $result = MARCmarc2koha( $dbh, $record, '' );
+ my $sth;
+ my $query;
+ my $search;
+ my $type;
+ my ( $biblionumber, $title );
+
+ # search duplicate on ISBN, easy and fast..
+ #$search->{'avoidquerylog'}=1;
+ if ( $result->{isbn} ) {
+ $query = "isbn=$result->{isbn}";
+ }
+ else {
+ $result->{title} =~ s /\\//g;
+ $result->{title} =~ s /\"//g;
+ $result->{title} =~ s /\(//g;
+ $result->{title} =~ s /\)//g;
+ $query = "ti,ext=$result->{title}";
+ }
+ my ($possible_duplicate_record) =
+ C4::Biblio::getRecord( "biblioserver", $query, "usmarc" ); # FIXME :: hardcoded !
+ if ($possible_duplicate_record) {
+ my $marcrecord =
+ MARC::Record->new_from_usmarc($possible_duplicate_record);
+ my $result = MARCmarc2koha( $dbh, $marcrecord, '' );
+
+ # FIXME :: why 2 $biblionumber ?
+ return $result->{'biblionumber'}, $result->{'biblionumber'},
+ $result->{'title'}
+ if $result;
+ }
}
+=head2 SimpleSearch
-=item ItemInfo
-
- @results = &ItemInfo($env, $biblionumber, $type);
-
-Returns information about books with the given biblionumber.
-
-C<$type> may be either C<intra> or anything else. If it is not set to
-C<intra>, then the search will exclude lost, very overdue, and
-withdrawn items.
-
-C<$env> is ignored.
-
-C<&ItemInfo> returns a list of references-to-hash. Each element
-contains a number of keys. Most of them are table items from the
-C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
-Koha database. Other keys include:
+($error,$results) = SimpleSearch($query,@servers);
-=over 4
+this function performs a simple search on the catalog using zoom.
-=item C<$data-E<gt>{branchname}>
-
-The name (not the code) of the branch to which the book belongs.
-
-=item C<$data-E<gt>{datelastseen}>
-
-This is simply C<items.datelastseen>, except that while the date is
-stored in YYYY-MM-DD format in the database, here it is converted to
-DD/MM/YYYY format. A NULL date is returned as C<//>.
-
-=item C<$data-E<gt>{datedue}>
-
-=item C<$data-E<gt>{class}>
-
-This is the concatenation of C<biblioitems.classification>, the book's
-Dewey code, and C<biblioitems.subclass>.
+=over 2
-=item C<$data-E<gt>{ocount}>
+=item C<input arg:>
-I think this is the number of copies of the book available.
+ * $query could be a simple keyword or a complete CCL query wich is depending on your ccl file.
+ * @servers is optionnal. default one is read on koha.xml
-=item C<$data-E<gt>{order}>
+=item C<Output arg:>
+ * $error is a string which containt the description error if there is one. Else it's empty.
+ * \@results is an array of marc record.
-If this is set, it is set to C<One Order>.
+=item C<usage in the script:>
=back
-=cut
-#'
-sub ItemInfo {
- my ($dbh,$data) = @_;
- my $i=0;
- my @results;
-my ($date_due, $count_reserves);
- my $datedue = '';
- my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
- $isth->execute($data->{'itemnumber'});
- if (my $idata=$isth->fetchrow_hashref){
- $data->{borrowernumber} = $idata->{borrowernumber};
- $data->{cardnumber} = $idata->{cardnumber};
- $datedue = format_date($idata->{'date_due'});
- }
- if ($datedue eq '' || $datedue eq "0000-00-00"){
- $datedue="";
- my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
- if ($restype) {
- $count_reserves = $restype;
- }
- }
- $isth->finish;
- #get branch information.....
- my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
- $bsth->execute($data->{'holdingbranch'});
- if (my $bdata=$bsth->fetchrow_hashref){
- $data->{'branchname'} = $bdata->{'branchname'};
- }
-
- $data->{'datelastseen'}=format_date($data->{'datelastseen'});
- $data->{'datedue'}=$datedue;
- $data->{'count_reserves'} = $count_reserves;
- # get notforloan complete status if applicable
- my ($tagfield,$tagsub)=MARCfind_marc_from_kohafield("notforloan","holdings");
- my $sthnflstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsub'");
- $sthnflstatus->execute;
- my ($authorised_valuecode) = $sthnflstatus->fetchrow;
- if ($authorised_valuecode) {
- $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
- $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
- my ($lib) = $sthnflstatus->fetchrow;
- $data->{notforloan} = $lib;
- }
-
-# my shelf procedures
- my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
-
- my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
-$shelfstatus->execute;
- $authorised_valuecode = $shelfstatus->fetchrow;
- if ($authorised_valuecode) {
- $shelfstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
- $shelfstatus->execute($authorised_valuecode,$data->{shelf});
-
- my ($lib) = $shelfstatus->fetchrow;
- $data->{shelf} = $lib;
- }
-
-
-
- return($data);
+my ($error, $marcresults) = SimpleSearch($query);
+
+if (defined $error) {
+ $template->param(query_error => $error);
+ warn "error: ".$error;
+ output_html_with_http_headers $input, $cookie, $template->output;
+ exit;
}
+my $hits = scalar @$marcresults;
+my @results;
+for(my $i=0;$i<$hits;$i++) {
+ my %resultsloop;
+ my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
+ my $biblio = MARCmarc2koha(C4::Context->dbh,$marcrecord,'');
+
+ #build the hash for the template.
+ $resultsloop{highlight} = ($i % 2)?(1):(0);
+ $resultsloop{title} = $biblio->{'title'};
+ $resultsloop{subtitle} = $biblio->{'subtitle'};
+ $resultsloop{biblionumber} = $biblio->{'biblionumber'};
+ $resultsloop{author} = $biblio->{'author'};
+ $resultsloop{publishercode} = $biblio->{'publishercode'};
+ $resultsloop{publicationyear} = $biblio->{'publicationyear'};
+
+ push @results, \%resultsloop;
+}
+$template->param(result=>\@results);
+=cut
+sub SimpleSearch {
+ my $query = shift;
+ my @servers = @_;
+ my @results;
+ my @tmpresults;
+ my @zconns;
+ return ( "No query entered", undef ) unless $query;
+
+ #@servers = (C4::Context->config("biblioserver")) unless @servers;
+ @servers =
+ ("biblioserver") unless @servers
+ ; # FIXME hardcoded value. See catalog/search.pl & opac-search.pl too.
+
+ # Connect & Search
+ for ( my $i = 0 ; $i < @servers ; $i++ ) {
+ $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
+ $tmpresults[$i] =
+ $zconns[$i]
+ ->search( new ZOOM::Query::CCL2RPN( $query, $zconns[$i] ) );
+
+ # getting error message if one occured.
+ my $error =
+ $zconns[$i]->errmsg() . " ("
+ . $zconns[$i]->errcode() . ") "
+ . $zconns[$i]->addinfo() . " "
+ . $zconns[$i]->diagset();
+
+ return ( $error, undef ) if $zconns[$i]->errcode();
+ }
+ my $hits;
+ my $ev;
+ while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
+ $ev = $zconns[ $i - 1 ]->last_event();
+ if ( $ev == ZOOM::Event::ZEND ) {
+ $hits = $tmpresults[ $i - 1 ]->size();
+ }
+ if ( $hits > 0 ) {
+ for ( my $j = 0 ; $j < $hits ; $j++ ) {
+ my $record = $tmpresults[ $i - 1 ]->record($j)->raw();
+ push @results, $record;
+ }
+ }
+ }
+ return ( undef, \@results );
+}
-=item barcodes
+# performs the search
+sub getRecords {
+ my (
+ $koha_query, $federated_query, $sort_by_ref,
+ $servers_ref, $results_per_page, $offset,
+ $expanded_facet, $branches, $query_type,
+ $scan
+ ) = @_;
+
+ my @servers = @$servers_ref;
+ my @sort_by = @$sort_by_ref;
+
+ # create the zoom connection and query object
+ my $zconn;
+ my @zconns;
+ my @results;
+ my $results_hashref = ();
+
+ ### FACETED RESULTS
+ my $facets_counter = ();
+ my $facets_info = ();
+ my $facets = getFacets();
+
+ #### INITIALIZE SOME VARS USED CREATE THE FACETED RESULTS
+ my @facets_loop; # stores the ref to array of hashes for template
+ for ( my $i = 0 ; $i < @servers ; $i++ ) {
+ $zconns[$i] = C4::Context->Zconn( $servers[$i], 1 );
+
+# perform the search, create the results objects
+# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
+ my $query_to_use;
+ if ( $servers[$i] =~ /biblioserver/ ) {
+ $query_to_use = $koha_query;
+ }
+ else {
+ $query_to_use = $federated_query;
+ }
- @barcodes = &barcodes($biblioitemnumber);
+ # warn "HERE : $query_type => $query_to_use";
+ # check if we've got a query_type defined
+ eval {
+ if ($query_type)
+ {
+ if ( $query_type =~ /^ccl/ ) {
+ $query_to_use =~
+ s/\:/\=/g; # change : to = last minute (FIXME)
+
+ # warn "CCL : $query_to_use";
+ $results[$i] =
+ $zconns[$i]->search(
+ new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
+ );
+ }
+ elsif ( $query_type =~ /^cql/ ) {
-Given a biblioitemnumber, looks up the corresponding items.
+ # warn "CQL : $query_to_use";
+ $results[$i] =
+ $zconns[$i]->search(
+ new ZOOM::Query::CQL( $query_to_use, $zconns[$i] ) );
+ }
+ elsif ( $query_type =~ /^pqf/ ) {
-Returns an array of references-to-hash; the keys are C<barcode> and
-C<itemlost>.
+ # warn "PQF : $query_to_use";
+ $results[$i] =
+ $zconns[$i]->search(
+ new ZOOM::Query::PQF( $query_to_use, $zconns[$i] ) );
+ }
+ }
+ else {
+ if ($scan) {
+
+ # warn "preparing to scan";
+ $results[$i] =
+ $zconns[$i]->scan(
+ new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
+ );
+ }
+ else {
-The returned items include very overdue items, but not lost ones.
+ # warn "LAST : $query_to_use";
+ $results[$i] =
+ $zconns[$i]->search(
+ new ZOOM::Query::CCL2RPN( $query_to_use, $zconns[$i] )
+ );
+ }
+ }
+ };
+ if ($@) {
+ warn "prob with query toto $query_to_use " . $@;
+ }
-=cut
-#'
-sub barcodes{
- #called from request.pl
- my ($biblionumber)=@_;
-#warn $biblionumber;
- my $dbh = C4::Context->dbh;
- my @kohafields;
- my @values;
- my @relations;
- my $sort;
- my @and_or;
- my @fields;
- push @kohafields, "biblionumber";
- push @values,$biblionumber;
- push @relations, " "," \@attr 2=1"; ## selecting wthdrawn less then 1
- push @and_or, "\@and";
- $sort="";
- my ($count,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,"","");
-push @fields,"barcode","itemlost","itemnumber","date_due","wthdrawn","notforloan";
- my ($biblio,@items)=XMLmarc2koha($dbh,$results[0],"holdings", @fields);
-return(@items);
+ # concatenate the sort_by limits and pass them to the results object
+ my $sort_by;
+ foreach my $sort (@sort_by) {
+ $sort_by .= $sort . " "; # used to be $sort,
+ }
+ $results[$i]->sort( "yaz", $sort_by ) if $sort_by;
+ }
+ while ( ( my $i = ZOOM::event( \@zconns ) ) != 0 ) {
+ my $ev = $zconns[ $i - 1 ]->last_event();
+ if ( $ev == ZOOM::Event::ZEND ) {
+ my $size = $results[ $i - 1 ]->size();
+ if ( $size > 0 ) {
+ my $results_hash;
+ #$results_hash->{'server'} = $servers[$i-1];
+ # loop through the results
+ $results_hash->{'hits'} = $size;
+ my $times;
+ if ( $offset + $results_per_page <= $size ) {
+ $times = $offset + $results_per_page;
+ }
+ else {
+ $times = $size;
+ }
+ for ( my $j = $offset ; $j < $times ; $j++ )
+ { #(($offset+$count<=$size) ? ($offset+$count):$size) ; $j++){
+ my $records_hash;
+ my $record;
+ my $facet_record;
+ ## This is just an index scan
+ if ($scan) {
+ my ( $term, $occ ) = $results[ $i - 1 ]->term($j);
+
+ # here we create a minimal MARC record and hand it off to the
+ # template just like a normal result ... perhaps not ideal, but
+ # it works for now
+ my $tmprecord = MARC::Record->new();
+ $tmprecord->encoding('UTF-8');
+ my $tmptitle;
+
+ # srote the minimal record in author/title (depending on MARC flavour)
+ if ( C4::Context->preference("marcflavour") eq
+ "UNIMARC" )
+ {
+ $tmptitle = MARC::Field->new(
+ '200', ' ', ' ',
+ a => $term,
+ f => $occ
+ );
+ }
+ else {
+ $tmptitle = MARC::Field->new(
+ '245', ' ', ' ',
+ a => $term,
+ b => $occ
+ );
+ }
+ $tmprecord->append_fields($tmptitle);
+ $results_hash->{'RECORDS'}[$j] =
+ $tmprecord->as_usmarc();
+ }
+ else {
+ $record = $results[ $i - 1 ]->record($j)->raw();
+
+ #warn "RECORD $j:".$record;
+ $results_hash->{'RECORDS'}[$j] =
+ $record; # making a reference to a hash
+ # Fill the facets while we're looping
+ $facet_record = MARC::Record->new_from_usmarc($record);
+
+ #warn $servers[$i-1].$facet_record->title();
+ for ( my $k = 0 ; $k <= @$facets ; $k++ ) {
+ if ( $facets->[$k] ) {
+ my @fields;
+ for my $tag ( @{ $facets->[$k]->{'tags'} } ) {
+ push @fields, $facet_record->field($tag);
+ }
+ for my $field (@fields) {
+ my @subfields = $field->subfields();
+ for my $subfield (@subfields) {
+ my ( $code, $data ) = @$subfield;
+ if ( $code eq
+ $facets->[$k]->{'subfield'} )
+ {
+ $facets_counter->{ $facets->[$k]
+ ->{'link_value'} }->{$data}++;
+ }
+ }
+ }
+ $facets_info->{ $facets->[$k]->{'link_value'} }
+ ->{'label_value'} =
+ $facets->[$k]->{'label_value'};
+ $facets_info->{ $facets->[$k]->{'link_value'} }
+ ->{'expanded'} = $facets->[$k]->{'expanded'};
+ }
+ }
+ }
+ }
+ $results_hashref->{ $servers[ $i - 1 ] } = $results_hash;
+ }
+
+ #print "connection ", $i-1, ": $size hits";
+ #print $results[$i-1]->record(0)->render() if $size > 0;
+ # BUILD FACETS
+ for my $link_value (
+ sort { $facets_counter->{$b} <=> $facets_counter->{$a} }
+ keys %$facets_counter
+ )
+ {
+ my $expandable;
+ my $number_of_facets;
+ my @this_facets_array;
+ for 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 < 6 )
+ || ( $expanded_facet eq $link_value )
+ || ( $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}->{'branchname'};
+ }
+
+ # 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,
+ },
+ );
+ }
+ }
+ unless ( $facets_info->{$link_value}->{'expanded'} ) {
+ $expandable = 1
+ if ( ( $number_of_facets > 6 )
+ && ( $expanded_facet ne $link_value ) );
+ }
+ 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 ( undef, $results_hashref, \@facets_loop );
}
+# build the query itself
+sub buildQuery {
+ my ( $query, $operators, $operands, $indexes, $limits, $sort_by ) = @_;
+
+ my @operators = @$operators if $operators;
+ my @indexes = @$indexes if $indexes;
+ my @operands = @$operands if $operands;
+ my @limits = @$limits if $limits;
+ my @sort_by = @$sort_by if $sort_by;
+
+ my $human_search_desc; # a human-readable query
+ my $machine_search_desc; #a machine-readable query
+ # FIXME: the locale should be set based on the syspref
+ my $stemmer = Lingua::Stem->new( -locale => 'EN-US' );
+
+# FIXME: these should be stored in the db so the librarian can modify the behavior
+ $stemmer->add_exceptions(
+ {
+ 'and' => 'and',
+ 'or' => 'or',
+ 'not' => 'not',
+ }
+ );
+
+# STEP I: determine if this is a form-based / simple query or if it's complex (if complex,
+# we can't handle field weighting, stemming until a formal query parser is written
+# I'll work on this soon -- JF
+#if (!$query) { # form-based
+# check if this is a known query language query, if it is, return immediately:
+ if ( $query =~ /^ccl=/ ) {
+ return ( undef, $', $', $', 'ccl' );
+ }
+ if ( $query =~ /^cql=/ ) {
+ return ( undef, $', $', $', 'cql' );
+ }
+ if ( $query =~ /^pqf=/ ) {
+ return ( undef, $', $', $', 'pqf' );
+ }
+ if ( $query =~ /(\(|\))/ ) { # sorry, too complex
+ return ( undef, $query, $query, $query, 'ccl' );
+ }
+# form-based queries are limited to non-nested a specific depth, so we can easily
+# modify the incoming query operands and indexes to do stemming and field weighting
+# Once we do so, we'll end up with a value in $query, just like if we had an
+# incoming $query from the user
+ else {
+ $query = ""
+ ; # clear it out so we can populate properly with field-weighted stemmed query
+ my $previous_operand
+ ; # a flag used to keep track if there was a previous query
+ # if there was, we can apply the current operator
+ for ( my $i = 0 ; $i <= @operands ; $i++ ) {
+ my $operand = $operands[$i];
+ my $index = $indexes[$i];
+ my $stemmed_operand;
+ my $stemming = C4::Context->parameters("Stemming") || 0;
+ my $weight_fields = C4::Context->parameters("WeightFields") || 0;
+
+ if ( $operands[$i] ) {
+
+# STEMMING FIXME: need to refine the field weighting so stemmed operands don't disrupt the query ranking
+ if ($stemming) {
+ my @words = split( / /, $operands[$i] );
+ my $stems = $stemmer->stem(@words);
+ foreach my $stem (@$stems) {
+ $stemmed_operand .= "$stem";
+ $stemmed_operand .= "?"
+ unless ( $stem =~ /(and$|or$|not$)/ )
+ || ( length($stem) < 3 );
+ $stemmed_operand .= " ";
+
+ #warn "STEM: $stemmed_operand";
+ }
+
+ #$operand = $stemmed_operand;
+ }
+# FIELD WEIGHTING - This is largely experimental stuff. What I'm committing works
+# pretty well but will work much better when we have an actual query parser
+ my $weighted_query;
+ if ($weight_fields) {
+ $weighted_query .=
+ " rk=("; # Specifies that we're applying rank
+ # keyword has different weight properties
+ if ( ( $index =~ /kw/ ) || ( !$index ) )
+ { # FIXME: do I need to add right-truncation in the case of stemming?
+ # a simple way to find out if this query uses an index
+ if ( $operand =~ /(\=|\:)/ ) {
+ $weighted_query .= " $operand";
+ }
+ else {
+ $weighted_query .=
+ " Title-cover,ext,r1=\"$operand\""
+ ; # index label as exact
+ $weighted_query .=
+ " or ti,ext,r2=$operand"; # index as exact
+ #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase
+ #$weighted_query .= " or any,ext,r4=$operand"; # index as exact
+ $weighted_query .=
+ " or kw,wrdl,r5=$operand"; # index as exact
+ $weighted_query .= " or wrd,fuzzy,r9=$operand";
+ $weighted_query .= " or wrd=$stemmed_operand"
+ if $stemming;
+ }
+ }
+ elsif ( $index =~ /au/ ) {
+ $weighted_query .=
+ " $index,ext,r1=$operand"; # index label as exact
+ #$weighted_query .= " or (title-sort-az=0 or $index,startswithnt,st-word,r3=$operand #)";
+ $weighted_query .=
+ " or $index,phr,r3=$operand"; # index as phrase
+ $weighted_query .= " or $index,rt,wrd,r3=$operand";
+ }
+ elsif ( $index =~ /ti/ ) {
+ $weighted_query .=
+ " Title-cover,ext,r1=$operand"; # index label as exact
+ $weighted_query .= " or Title-series,ext,r2=$operand";
+
+ #$weighted_query .= " or ti,ext,r2=$operand";
+ #$weighted_query .= " or ti,phr,r3=$operand";
+ #$weighted_query .= " or ti,wrd,r3=$operand";
+ $weighted_query .=
+" or (title-sort-az=0 or Title-cover,startswithnt,st-word,r3=$operand #)";
+ $weighted_query .=
+" or (title-sort-az=0 or Title-cover,phr,r6=$operand)";
+
+ #$weighted_query .= " or Title-cover,wrd,r5=$operand";
+ #$weighted_query .= " or ti,ext,r6=$operand";
+ #$weighted_query .= " or ti,startswith,phr,r7=$operand";
+ #$weighted_query .= " or ti,phr,r8=$operand";
+ #$weighted_query .= " or ti,wrd,r9=$operand";
+
+ #$weighted_query .= " or ti,ext,r2=$operand"; # index as exact
+ #$weighted_query .= " or ti,phr,r3=$operand"; # index as phrase
+ #$weighted_query .= " or any,ext,r4=$operand"; # index as exact
+ #$weighted_query .= " or kw,wrd,r5=$operand"; # index as exact
+ }
+ else {
+ $weighted_query .=
+ " $index,ext,r1=$operand"; # index label as exact
+ #$weighted_query .= " or $index,ext,r2=$operand"; # index as exact
+ $weighted_query .=
+ " or $index,phr,r3=$operand"; # index as phrase
+ $weighted_query .= " or $index,rt,wrd,r3=$operand";
+ $weighted_query .=
+ " or $index,wrd,r5=$operand"
+ ; # index as word right-truncated
+ $weighted_query .= " or $index,wrd,fuzzy,r8=$operand";
+ }
+ $weighted_query .= ")"; # close rank specification
+ $operand = $weighted_query;
+ }
+ # only add an operator if there is a previous operand
+ if ($previous_operand) {
+ if ( $operators[ $i - 1 ] ) {
+ $query .= " $operators[$i-1] $index: $operand";
+ if ( !$index ) {
+ $human_search_desc .=
+ " $operators[$i-1] $operands[$i]";
+ }
+ else {
+ $human_search_desc .=
+ " $operators[$i-1] $index: $operands[$i]";
+ }
+ }
+
+ # the default operator is and
+ else {
+ $query .= " and $index: $operand";
+ $human_search_desc .= " and $index: $operands[$i]";
+ }
+ }
+ else {
+ if ( !$index ) {
+ $query .= " $operand";
+ $human_search_desc .= " $operands[$i]";
+ }
+ else {
+ $query .= " $index: $operand";
+ $human_search_desc .= " $index: $operands[$i]";
+ }
+ $previous_operand = 1;
+ }
+ } #/if $operands
+ } # /for
+ }
-sub getMARCnotes {
-##Requires a MARCXML as $record
- my ($dbh, $record, $marcflavour) = @_;
-
- my ($mintag, $maxtag);
- 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=();
-
- foreach my $field ($mintag..$maxtag) {
- 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
-
-
-sub getMARCsubjects {
-
- my ($dbh, $record, $marcflavour) = @_;
- my ($mintag, $maxtag);
- if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") {
- $mintag = "600";
- $maxtag = "699";
- } else { # assume unimarc if not marc21
- $mintag = "600";
- $maxtag = "619";
- }
- my @marcsubjcts;
- my $subjct = "";
- my $subfield = "";
- my $marcsubjct;
-
- foreach my $field ($mintag..$maxtag) {
- my @value =XML_readline_asarray($record,"","",$field,"a");
- foreach my $subject (@value){
- $marcsubjct = {MARCSUBJCT => $subject,};
- push @marcsubjcts, $marcsubjct;
- }
-
- }
- my $marcsubjctsarray=\@marcsubjcts;
- return $marcsubjctsarray;
-} #end getMARCsubjects
-
-
-sub getMARCurls {
- my ($dbh, $record, $marcflavour) = @_;
- my ($mintag, $maxtag);
- if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") {
- $mintag = "856";
- $maxtag = "856";
- } else { # assume unimarc if not marc21
- $mintag = "600";
- $maxtag = "619";
- }
-
- my @marcurls;
- my $url = "";
- my $subfil = "";
- my $marcurl;
- my $value;
- foreach my $field ($mintag..$maxtag) {
- my @value =XML_readline_asarray($record,"","",$field,"u");
- foreach my $url (@value){
- if ( $value ne $url) {
- $marcurl = {MARCURL => $url,};
- push @marcurls, $marcurl;
- $value=$url;
- }
- }
- }
-
-
- my $marcurlsarray=\@marcurls;
- return $marcurlsarray;
-} #end getMARCurls
-
-sub getMARCadditional_authors {
- my ($dbh, $record, $marcflavour) = @_;
- my ($mintag, $maxtag);
- if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") {
- $mintag = "700";
- $maxtag = "700";
- } else { # assume unimarc if not marc21
-###FIX ME Correct tag to UNIMARC additional authors
- $mintag = "200";
- $maxtag = "200";
- }
-
- my @marcauthors;
-
- my $subfil = "";
- my $marcauth;
- my $value;
- foreach my $field ($mintag..$maxtag) {
- my @value =XML_readline_asarray($record,"","",$field,"a");
- foreach my $author (@value){
- if ( $value ne $author) {
- $marcauth = {MARCAUTHOR => $author,};
- push @marcauthors, $marcauth;
- $value=$author;
- }
- }
- }
-
-
- my $marcauthsarray=\@marcauthors;
- return $marcauthsarray;
-} #end getMARCurls
-
-sub parsefields{
-#pass this a MARC record and it will parse it for display purposes
-my ($dbh,$intranet,@marcrecords)=@_;
-my @results;
-my @items;
-my $retrieve_from=C4::Context->preference('retrieve_from');
-#Build brancnames hash for displaying in OPAC - more user friendly
-#find branchname
-#get branch information.....
-my %branches;
- my $bsth=$dbh->prepare("SELECT branchcode,branchname FROM branches");
- $bsth->execute();
- while (my $bdata=$bsth->fetchrow_hashref){
- $branches{$bdata->{'branchcode'}}= $bdata->{'branchname'};
- }
-
-#Building shelving hash if library has shelves defined like junior section, non-fiction, audio-visual room etc
-my %shelves;
-#find shelvingname
-my ($tagfield,$tagsubfield)=MARCfind_marc_from_kohafield("shelf","holdings");
-my $shelfstatus = $dbh->prepare("select authorised_value from holdings_subfield_structure where tagfield='$tagfield' and tagsubfield='$tagsubfield'");
- $shelfstatus->execute;
- my ($authorised_valuecode) = $shelfstatus->fetchrow;
- if ($authorised_valuecode) {
- $shelfstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? ");
- $shelfstatus->execute($authorised_valuecode);
- while (my $lib = $shelfstatus->fetchrow_hashref){
- $shelves{$lib->{'authorised_value'}} = $lib->{'lib'};
- }
- }
-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){
-
- 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","subclass","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn";
-my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields);
-my $bibliorecord;
-
-my %counts;
-
-$counts{'total'}=0;
-my $noitems = 1;
-my $norequests = 1;
- ##Loop for each item field
-
- foreach my $item (@itemrecords) {
- $norequests = 0 unless $item->{'itemnotforloan'};
- $noitems = 0;
- my $status;
- #renaming some fields according to templates
- $item->{'branchname'}=$branches{$item->{'holdingbranch'}};
- $item->{'shelves'}=$shelves{$item->{'shelf'}};
- $status="Lost" if ($item->{'itemlost'}>0);
- $status="Withdrawn" if ($item->{'wthdrawn'}>0);
- if ($intranet eq "intranet"){ ## we give full itemcallnumber detail in intranet
- $status="Due:".format_date($item->{'date_due'}) if ($item->{'date_due'} gt "0000-00-00");
- $status = $item->{'holdingbranch'}."-".$item->{'shelf'}."[".$item->{'itemcallnumber'}."]" unless defined $status;
- }else{
- $status="On Loan" if ($item->{'date_due'} gt "0000-00-00");
- $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status;
- }
-
- $counts{$status}++;
- $counts{'total'}++;
- }
- $oldbiblio->{'noitems'} = $noitems;
- $oldbiblio->{'norequests'} = $norequests;
- $oldbiblio->{'even'} = $even;
- $even= not $even;
- if ($even){
- $oldbiblio->{'toggle'}="#ffffcc";
- } else {
- $oldbiblio->{'toggle'}="white";
- } ; ## some forms seems to use toggle
-
- $oldbiblio->{'itemcount'} = $counts{'total'};
- my $totalitemcounts = 0;
- foreach my $key (keys %counts){
- if ($key ne 'total'){
- $totalitemcounts+= $counts{$key};
- $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
-
- }
- }
- my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
- foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
-
- if ($_ eq 'notavailable') {
- $notavailabletext="Not available";
- my $c=$oldbiblio->{'locationhash'}->{$_};
- $oldbiblio->{'not-available-p'}=$c;
- } else {
- $locationtext.="$_";
- my $c=$oldbiblio->{'locationhash'}->{$_};
- if ($_ eq 'Lost') {
- $oldbiblio->{'lost-p'} = $c;
- } elsif ($_ eq 'Withdrawn') {
- $oldbiblio->{'withdrawn-p'} = $c;
- } elsif ($_ =~/\^Due:/) {
-
- $oldbiblio->{'on-loan-p'} = $c;
- } else {
- $locationtextonly.= $_;
- $locationtextonly.= " ($c)<br> " if $totalitemcounts > 1;
- }
- if ($totalitemcounts>1) {
- $locationtext.=" ($c)<br> ";
- }
- }
- }
- if ($notavailabletext) {
- $locationtext.= $notavailabletext;
- } else {
- $locationtext=~s/, $//;
- }
- $oldbiblio->{'location'} = $locationtext;
- $oldbiblio->{'location-only'} = $locationtextonly;
- $oldbiblio->{'use-location-flags-p'} = 1;
- push @results,$oldbiblio;
-
-}## For each record received
-@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){
- for (my $z=0; $z<@$subfields;$z++) {
- my $data=XML_readline_onerecord($holding,"","holdings",@$tags[$i],@$subfields[$z]);
- $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data;
- }
- }
- }else{
- for (my $z=0; $z<@$subfields;$z++) {
- my $data=XML_readline($facet_record,"","biblios",@$tags[$i],@$subfields[$z]);
- $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);
-}
+ # add limits
+ my $limit_query;
+ my $limit_search_desc;
+ foreach my $limit (@limits) {
-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};
- }
+ # FIXME: not quite right yet ... will work on this soon -- JF
+ my $type = $1 if $limit =~ m/([^:]+):([^:]*)/;
+ if ( $limit =~ /available/ ) {
+ $limit_query .=
+" (($query and datedue=0000-00-00) or ($query and datedue=0000-00-00 not lost=1) or ($query and datedue=0000-00-00 not lost=2))";
- # 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);
+ #$limit_search_desc.=" and available";
+ }
+ elsif ( ($limit_query) && ( index( $limit_query, $type, 0 ) > 0 ) ) {
+ if ( $limit_query !~ /\(/ ) {
+ $limit_query =
+ substr( $limit_query, 0, index( $limit_query, $type, 0 ) )
+ . "("
+ . substr( $limit_query, index( $limit_query, $type, 0 ) )
+ . " or $limit )"
+ if $limit;
+ $limit_search_desc =
+ substr( $limit_search_desc, 0,
+ index( $limit_search_desc, $type, 0 ) )
+ . "("
+ . substr( $limit_search_desc,
+ index( $limit_search_desc, $type, 0 ) )
+ . " or $limit )"
+ if $limit;
+ }
+ else {
+ chop $limit_query;
+ chop $limit_search_desc;
+ $limit_query .= " or $limit )" if $limit;
+ $limit_search_desc .= " or $limit )" if $limit;
+ }
+ }
+ elsif ( ($limit_query) && ( $limit =~ /mc/ ) ) {
+ $limit_query .= " or $limit" if $limit;
+ $limit_search_desc .= " or $limit" if $limit;
}
- 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;
-}
+ # these are treated as AND
+ elsif ($limit_query) {
+ $limit_query .= " and $limit" if $limit;
+ $limit_search_desc .= " and $limit" if $limit;
+ }
-sub getcoverPhoto {
-## return the address of a cover image if defined otherwise the amazon cover images
- my $record =shift ;
+ # otherwise, there is nothing but the limit
+ else {
+ $limit_query .= "$limit" if $limit;
+ $limit_search_desc .= "$limit" if $limit;
+ }
+ }
- my $image=XML_readline_onerecord($record,"coverphoto","biblios");
- if ($image){
- return $image;
- }
-# if there is no image put the amazon cover image adress
+ # if there's also a query, we need to AND the limits to it
+ if ( ($limit_query) && ($query) ) {
+ $limit_query = " and (" . $limit_query . ")";
+ $limit_search_desc = " and ($limit_search_desc)" if $limit_search_desc;
-my $isbn=XML_readline_onerecord($record,"isbn","biblios");
-return "http://images.amazon.com/images/P/".$isbn.".01.MZZZZZZZ.jpg";
+ }
+ $query .= $limit_query;
+ $human_search_desc .= $limit_search_desc;
+
+ # now normalize the strings
+ $query =~ s/ / /g; # remove extra spaces
+ $query =~ s/^ //g; # remove any beginning spaces
+ $query =~ s/:/=/g; # causes probs for server
+ $query =~ s/==/=/g; # remove double == from query
+
+ my $federated_query = $human_search_desc;
+ $federated_query =~ s/ / /g;
+ $federated_query =~ s/^ //g;
+ $federated_query =~ s/:/=/g;
+ my $federated_query_opensearch = $federated_query;
+
+# my $federated_query_RPN = new ZOOM::Query::CCL2RPN( $query , C4::Context->ZConn('biblioserver'));
+
+ $human_search_desc =~ s/ / /g;
+ $human_search_desc =~ s/^ //g;
+ my $koha_query = $query;
+
+ #warn "QUERY:".$koha_query;
+ #warn "SEARCHDESC:".$human_search_desc;
+ #warn "FEDERATED QUERY:".$federated_query;
+ return ( undef, $human_search_desc, $koha_query, $federated_query );
}
-=item itemcount
-
- ($count, $lcount, $nacount, $fcount, $scount, $lostcount,
- $mending, $transit,$ocount) =
- &itemcount($env, $biblionumber, $type);
-
-Counts the number of items with the given biblionumber, broken down by
-category.
-
-C<$env> is ignored.
+# IMO this subroutine is pretty messy still -- it's responsible for
+# building the HTML output for the template
+sub searchResults {
+ my ( $searchdesc, $hits, $results_per_page, $offset, @marcresults ) = @_;
-If C<$type> is not set to C<intra>, lost, very overdue, and withdrawn
-items will not be counted.
-
-C<&itemcount> returns a nine-element list:
-
-C<$count> is the total number of items with the given biblionumber.
+ my $dbh = C4::Context->dbh;
+ my $toggle;
+ my $even = 1;
+ my @newresults;
+ my $span_terms_hashref;
+ for my $span_term ( split( / /, $searchdesc ) ) {
+ $span_term =~ s/(.*=|\)|\(|\+|\.)//g;
+ $span_terms_hashref->{$span_term}++;
+ }
-C<$lcount> is the number of items at the Levin branch.
+ #Build brancnames hash
+ #find branchname
+ #get branch information.....
+ my %branches;
+ my $bsth =
+ $dbh->prepare("SELECT branchcode,branchname FROM branches")
+ ; # FIXME : use C4::Koha::GetBranches
+ $bsth->execute();
+ while ( my $bdata = $bsth->fetchrow_hashref ) {
+ $branches{ $bdata->{'branchcode'} } = $bdata->{'branchname'};
+ }
-C<$nacount> is the number of items that are neither borrowed, lost,
-nor withdrawn (and are therefore presumably on a shelf somewhere).
+ #Build itemtype hash
+ #find itemtype & itemtype image
+ my %itemtypes;
+ $bsth =
+ $dbh->prepare("SELECT itemtype,description,imageurl,summary FROM itemtypes");
+ $bsth->execute();
+ while ( my $bdata = $bsth->fetchrow_hashref ) {
+ $itemtypes{ $bdata->{'itemtype'} }->{description} =
+ $bdata->{'description'};
+ $itemtypes{ $bdata->{'itemtype'} }->{imageurl} = $bdata->{'imageurl'};
+ $itemtypes{ $bdata->{'itemtype'} }->{summary} = $bdata->{'summary'};
+ }
-C<$fcount> is the number of items at the Foxton branch.
+ #search item field code
+ my $sth =
+ $dbh->prepare(
+"select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'"
+ );
+ $sth->execute;
+ my ($itemtag) = $sth->fetchrow;
+
+ ## find column names of items related to MARC
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
+ $sth2->execute;
+ my %subfieldstosearch;
+ while ( ( my $column ) = $sth2->fetchrow ) {
+ my ( $tagfield, $tagsubfield ) =
+ &MARCfind_marc_from_kohafield( $dbh, "items." . $column, "" );
+ $subfieldstosearch{$column} = $tagsubfield;
+ }
+ my $times;
-C<$scount> is the number of items at the Shannon branch.
+ if ( $hits && $offset + $results_per_page <= $hits ) {
+ $times = $offset + $results_per_page;
+ }
+ else {
+ $times = $hits;
+ }
-C<$lostcount> is the number of lost and very overdue items.
+ for ( my $i = $offset ; $i <= $times - 1 ; $i++ ) {
+ my $marcrecord;
+ $marcrecord = MARC::File::USMARC::decode( $marcresults[$i] );
-C<$mending> is the number of items at the Mending branch (being
-mended?).
+ my $oldbiblio = MARCmarc2koha( $dbh, $marcrecord, '' );
-C<$transit> is the number of items at the Transit branch (in transit
-between branches?).
+ # add image url if there is one
+ if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} =~ /^http:/ ) {
+ $oldbiblio->{imageurl} =
+ $itemtypes{ $oldbiblio->{itemtype} }->{imageurl};
+ $oldbiblio->{description} =
+ $itemtypes{ $oldbiblio->{itemtype} }->{description};
+ }
+ else {
+ $oldbiblio->{imageurl} =
+ getitemtypeimagesrc() . "/"
+ . $itemtypes{ $oldbiblio->{itemtype} }->{imageurl}
+ if ( $itemtypes{ $oldbiblio->{itemtype} }->{imageurl} );
+ $oldbiblio->{description} =
+ $itemtypes{ $oldbiblio->{itemtype} }->{description};
+ }
+ #
+ # build summary if there is one (the summary is defined in itemtypes table
+ #
+ if ($itemtypes{ $oldbiblio->{itemtype} }->{summary}) {
+ my $summary = $itemtypes{ $oldbiblio->{itemtype} }->{summary};
+ my @fields = $marcrecord->fields();
+ foreach my $field (@fields) {
+ my $tag = $field->tag();
+ my $tagvalue = $field->as_string();
+ $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
+ unless ($tag<10) {
+ my @subf = $field->subfields;
+ for my $i (0..$#subf) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue = $subf[$i][1];
+ my $tagsubf = $tag.$subfieldcode;
+ $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
+ }
+ }
+ }
+ $summary =~ s/\[(.*?)]//g;
+ $summary =~ s/\n/<br>/g;
+ $oldbiblio->{summary} = $summary;
+ }
+ # add spans to search term in results
+ foreach my $term ( keys %$span_terms_hashref ) {
+
+ #warn "term: $term";
+ my $old_term = $term;
+ if ( length($term) > 3 ) {
+ $term =~ s/(.*=|\)|\(|\+|\.|\?)//g;
+
+ #FIXME: is there a better way to do this?
+ $oldbiblio->{'title'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'subtitle'} =~
+ s/$term/<span class=term>$&<\/span>/gi;
+
+ $oldbiblio->{'author'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'publishercode'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'place'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'pages'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'notes'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ $oldbiblio->{'size'} =~ s/$term/<span class=term>$&<\/span>/gi;
+ }
+ }
-C<$ocount> is the number of items that haven't arrived yet
-(aqorders.quantity - aqorders.quantityreceived).
+ if ( $i % 2 ) {
+ $toggle = "#ffffcc";
+ }
+ else {
+ $toggle = "white";
+ }
+ $oldbiblio->{'toggle'} = $toggle;
+ my @fields = $marcrecord->field($itemtag);
+ my @items_loop;
+ my $items;
+ my $ordered_count = 0;
+ my $onloan_count = 0;
+ my $wthdrawn_count = 0;
+ my $itemlost_count = 0;
+ my $itembinding_count = 0;
+ my $norequests = 1;
+
+ foreach my $field (@fields) {
+ my $item;
+ foreach my $code ( keys %subfieldstosearch ) {
+ $item->{$code} = $field->subfield( $subfieldstosearch{$code} );
+ }
+ if ( $item->{wthdrawn} ) {
+ $wthdrawn_count++;
+ }
+ elsif ( $item->{notforloan} == -1 ) {
+ $ordered_count++;
+ $norequests = 0;
+ }
+ elsif ( $item->{itemlost} ) {
+ $itemlost_count++;
+ }
+ elsif ( $item->{binding} ) {
+ $itembinding_count++;
+ }
+ elsif ( ( $item->{onloan} ) && ( $item->{onloan} != '0000-00-00' ) )
+ {
+ $onloan_count++;
+ $norequests = 0;
+ }
+ else {
+ $norequests = 0;
+ if ( $item->{'homebranch'} ) {
+ $items->{ $item->{'homebranch'} }->{count}++;
+ }
-=cut
-#'
-
-
-
-sub itemcount {
- my ($env,$bibnum,$type)=@_;
- my $dbh = C4::Context->dbh;
-my @kohafield;
-my @value;
-my @relation;
-my @and_or;
-my $sort;
- my $query="Select * from items where
- biblionumber=? ";
-push @kohafield,"biblionumber";
-push @value,$bibnum;
-
-my ($total,@result)=ZEBRAsearch_kohafields(\@kohafield,\@value, \@relation,"", \@and_or, 0);## there is only one record no need for $num or $offset
-my @fields;## extract only the fields required
-push @fields,"itemnumber","itemlost","wthdrawn","holdingbranch","date_due";
-my ($biblio,@items)=XMLmarc2koha ($dbh,$result[0],"holdings",\@fields);
- my $count=0;
- my $lcount=0;
- my $nacount=0;
- my $fcount=0;
- my $scount=0;
- my $lostcount=0;
- my $mending=0;
- my $transit=0;
- my $ocount=0;
- foreach my $data(@items){
- if ($type ne "intra"){
- next if ($data->{itemlost} || $data->{wthdrawn});
- } ## Probably trying to hide lost item from opac ?
- $count++;
-
-## Now it seems we want to find those which are onloan
-
-
- if ( $data->{date_due} gt "0000-00-00"){
- $nacount++;
- next;
- }
-### The rest of this code is hardcoded for Foxtrot Shanon etc. We urgently need a global understanding of these terms--TG
- if ($data->{'holdingbranch'} eq 'C' || $data->{'holdingbranch'} eq 'LT'){
- $lcount++;
- }
- if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){
- $fcount++;
- }
- if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){
- $scount++;
- }
- if ($data->{'itemlost'} eq '1'){
- $lostcount++;
- }
- if ($data->{'itemlost'} eq '2'){
- $lostcount++;
- }
- if ($data->{'holdingbranch'} eq 'FM'){
- $mending++;
- }
- if ($data->{'holdingbranch'} eq 'TR'){
- $transit++;
- }
-
- }
-# if ($count == 0){
- my $sth2=$dbh->prepare("Select * from aqorders where biblionumber=?");
- $sth2->execute($bibnum);
- if (my $data=$sth2->fetchrow_hashref){
- $ocount=$data->{'quantity'} - $data->{'quantityreceived'};
+ # Last resort
+ elsif ( $item->{'holdingbranch'} ) {
+ $items->{ $item->{'homebranch'} }->{count}++;
+ }
+ $items->{ $item->{homebranch} }->{itemcallnumber} =
+ $item->{itemcallnumber};
+ $items->{ $item->{homebranch} }->{location} =
+ $item->{location};
+ }
+ } # notforloan, item level and biblioitem level
+ for my $key ( keys %$items ) {
+
+ #warn "key: $key";
+ my $this_item = {
+ branchname => $branches{$key},
+ branchcode => $key,
+ count => $items->{$key}->{count},
+ itemcallnumber => $items->{$key}->{itemcallnumber},
+ location => $items->{$key}->{location},
+ };
+ push @items_loop, $this_item;
+ }
+ $oldbiblio->{norequests} = $norequests;
+ $oldbiblio->{items_loop} = \@items_loop;
+ $oldbiblio->{onloancount} = $onloan_count;
+ $oldbiblio->{wthdrawncount} = $wthdrawn_count;
+ $oldbiblio->{itemlostcount} = $itemlost_count;
+ $oldbiblio->{bindingcount} = $itembinding_count;
+ $oldbiblio->{orderedcount} = $ordered_count;
+
+# FIXME
+# Ugh ... this is ugly, I'll re-write it better above then delete it
+# my $norequests = 1;
+# my $noitems = 1;
+# if (@items) {
+# $noitems = 0;
+# foreach my $itm (@items) {
+# $norequests = 0 unless $itm->{'itemnotforloan'};
+# }
+# }
+# $oldbiblio->{'noitems'} = $noitems;
+# $oldbiblio->{'norequests'} = $norequests;
+# $oldbiblio->{'even'} = $even = not $even;
+# $oldbiblio->{'itemcount'} = $counts{'total'};
+# my $totalitemcounts = 0;
+# foreach my $key (keys %counts){
+# if ($key ne 'total'){
+# $totalitemcounts+= $counts{$key};
+# $oldbiblio->{'locationhash'}->{$key}=$counts{$key};
+# }
+# }
+# my ($locationtext, $locationtextonly, $notavailabletext) = ('','','');
+# foreach (sort keys %{$oldbiblio->{'locationhash'}}) {
+# if ($_ eq 'notavailable') {
+# $notavailabletext="Not available";
+# my $c=$oldbiblio->{'locationhash'}->{$_};
+# $oldbiblio->{'not-available-p'}=$c;
+# } else {
+# $locationtext.="$_";
+# my $c=$oldbiblio->{'locationhash'}->{$_};
+# if ($_ eq 'Item Lost') {
+# $oldbiblio->{'lost-p'} = $c;
+# } elsif ($_ eq 'Withdrawn') {
+# $oldbiblio->{'withdrawn-p'} = $c;
+# } elsif ($_ eq 'On Loan') {
+# $oldbiblio->{'on-loan-p'} = $c;
+# } else {
+# $locationtextonly.= $_;
+# $locationtextonly.= " ($c)<br/> " if $totalitemcounts > 1;
+# }
+# if ($totalitemcounts>1) {
+# $locationtext.=" ($c)<br/> ";
+# }
+# }
+# }
+# if ($notavailabletext) {
+# $locationtext.= $notavailabletext;
+# } else {
+# $locationtext=~s/, $//;
+# }
+# $oldbiblio->{'location'} = $locationtext;
+# $oldbiblio->{'location-only'} = $locationtextonly;
+# $oldbiblio->{'use-location-flags-p'} = 1;
+
+ push( @newresults, $oldbiblio );
}
-# $count+=$ocount;
-
- return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount);
+ return @newresults;
}
-sub spellSuggest {
-my ($kohafield,$value)=@_;
- if (@$kohafield[0] eq "title" || @$kohafield[0] eq "author" || @$kohafield eq "subject"){
-## pass them through
-}else{
- @$kohafield[0]="any";
-}
-my $kohaattr=MARCfind_attr_from_kohafield(@$kohafield[0]);
-@$value[0]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)/ /g;
-my $query= $kohaattr." \@attr 6=3 \"".@$value[0]."\"";
-my @zconn;
- $zconn[0]=C4::Context->Zconn("biblioserver");
-$zconn[0]->option(number=>5);
-my $result=$zconn[0]->scan_pqf($query);
-my $i;
-my $event;
- while (($i = ZOOM::event(\@zconn)) != 0) {
- $event = $zconn[$i-1]->last_event();
- last if $event == ZOOM::Event::ZEND;
- }# whilemy $i;
-
-my $n=$result->size();
-
-my @suggestion;
-for (my $i=0; $i<$n; $i++){
-my ($term,$occ)=$result->term($i);
-push @suggestion, {kohafield=>@$kohafield[0], value=>$term,occ=>$occ} unless $term=~/\@/;
-}
-$zconn[0]->destroy();
-return @suggestion;
-}
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
__END__
-=back
-
=head1 AUTHOR
Koha Developement team <info@koha.org>
-# New functions to comply with ZEBRA search and new KOHA 3 XML API added 2006 Tumer Garip tgarip@neu.edu.tr
=cut
-package C4::Serials; #assumes C4/Serials.pm
+package C4::Serials; #assumes C4/Serials.pm
# Copyright 2000-2002 Katipo Communications
#
use strict;
use C4::Date;
+use Date::Calc qw(:all);
+use POSIX qw(strftime);
use C4::Suggestions;
+use C4::Koha;
use C4::Biblio;
use C4::Search;
use C4::Letters;
+use C4::Log; # logaction
+
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
- shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
-
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
=head1 FUNCTIONS
=cut
-@ISA = qw(Exporter);
+
+@ISA = qw(Exporter);
@EXPORT = qw(
- &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
- &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
- &GetFullSubscriptionsFromBiblionumber &GetNextSeq
- &ModSubscriptionHistory &NewIssue
- &GetSerials &GetLatestSerials &ModSerialStatus
- &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
- &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
- &GetDistributedTo &SetDistributedto
- &getroutinglist &delroutingmember &addroutingmember &reorder_members
- &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
- &Get_Next_Date
+
+ &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
+ &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
+ &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
+ &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
+
+ &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
+ &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
+ &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
+ &GetSerialInformation &AddItem2Serial
+ &PrepareSerialsData
+
+ &UpdateClaimdateIssues
+ &GetSuppliersWithLateIssues &getsupplierbyserialid
+ &GetDistributedTo &SetDistributedTo
+ &getroutinglist &delroutingmember &addroutingmember
+ &reorder_members
+ &check_routing &updateClaim &removeMissingIssue
+
+ &old_newsubscription &old_modsubscription &old_getserials
);
=head2 GetSuppliersWithLateIssues
=back
=cut
+
sub GetSuppliersWithLateIssues {
- my $dbh = C4::Context->dbh;
+ my $dbh = C4::Context->dbh;
my $query = qq|
SELECT DISTINCT id, name
FROM subscription, serial
my $sth = $dbh->prepare($query);
$sth->execute;
my %supplierlist;
- while (my ($id,$name) = $sth->fetchrow) {
+ while ( my ( $id, $name ) = $sth->fetchrow ) {
$supplierlist{$id} = $name;
}
- if(C4::Context->preference("RoutingSerials")){
- $supplierlist{''} = "All Suppliers";
+ if ( C4::Context->preference("RoutingSerials") ) {
+ $supplierlist{''} = "All Suppliers";
}
return %supplierlist;
}
=back
=cut
+
sub GetLateIssues {
- my ($supplierid) = shift;
+ my ($supplierid) = @_;
my $dbh = C4::Context->dbh;
my $sth;
if ($supplierid) {
- my $query = qq |
+ my $query = qq|
SELECT name,title,planneddate,serialseq,serial.subscriptionid
FROM subscription, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
ORDER BY title
|;
$sth = $dbh->prepare($query);
- } else {
+ }
+ else {
my $query = qq|
SELECT name,title,planneddate,serialseq,serial.subscriptionid
FROM subscription, serial, biblio
$sth->execute;
my @issuelist;
my $last_title;
- my $odd=0;
- my $count=0;
- while (my $line = $sth->fetchrow_hashref) {
+ my $odd = 0;
+ my $count = 0;
+ while ( my $line = $sth->fetchrow_hashref ) {
$odd++ unless $line->{title} eq $last_title;
$line->{title} = "" if $line->{title} eq $last_title;
- $last_title = $line->{title} if ($line->{title});
- $line->{planneddate} = format_date($line->{planneddate});
- $line->{'odd'} = 1 if $odd %2 ;
- $count++;
- push @issuelist,$line;
+ $last_title = $line->{title} if ( $line->{title} );
+ $line->{planneddate} = format_date( $line->{planneddate} );
+ $count++;
+ push @issuelist, $line;
}
- return $count,@issuelist;
+ return $count, @issuelist;
}
=head2 GetSubscriptionHistoryFromSubscriptionId
=back
=cut
+
sub GetSubscriptionHistoryFromSubscriptionId() {
- my $dbh = C4::Context->dbh;
+ my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM subscriptionhistory
=back
=cut
-sub GetSerialStatusFromSerialId(){
- my $dbh = C4::Context->dbh;
+
+sub GetSerialStatusFromSerialId() {
+ my $dbh = C4::Context->dbh;
my $query = qq|
SELECT status
FROM serial
return $dbh->prepare($query);
}
+=head2 GetSerialInformation
+
+=over 4
+
+$data = GetSerialInformation($serialid);
+returns a hash containing :
+ items : items marcrecord (can be an array)
+ serial table field
+ subscription table field
+ + information about subscription expiration
+
+=back
+
+=cut
+
+sub GetSerialInformation {
+ my ($serialid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
+ FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
+ WHERE serialid = ?
+ |;
+ my $rq = $dbh->prepare($query);
+ $rq->execute($serialid);
+ my $data = $rq->fetchrow_hashref;
+
+ if ( C4::Context->preference("serialsadditems") ) {
+ if ( $data->{'itemnumber'} ) {
+ my @itemnumbers = split /,/, $data->{'itemnumber'};
+ foreach my $itemnum (@itemnumbers) {
+
+ #It is ASSUMED that MARCgetitem ALWAYS WORK...
+ #Maybe MARCgetitem should return values on failure
+# warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
+ my $itemprocessed =
+ PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
+ $itemprocessed->{'itemnumber'} = $itemnum;
+ $itemprocessed->{'itemid'} = $itemnum;
+ $itemprocessed->{'serialid'} = $serialid;
+ $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
+ push @{ $data->{'items'} }, $itemprocessed;
+ }
+ }
+ else {
+ my $itemprocessed =
+ PrepareItemrecordDisplay( $data->{'biblionumber'} );
+ $itemprocessed->{'itemid'} = "N$serialid";
+ $itemprocessed->{'serialid'} = $serialid;
+ $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
+ $itemprocessed->{'countitems'} = 0;
+ push @{ $data->{'items'} }, $itemprocessed;
+ }
+ }
+ $data->{ "status" . $data->{'serstatus'} } = 1;
+ $data->{'subscriptionexpired'} =
+ HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
+ $data->{'abouttoexpire'} =
+ abouttoexpire( $data->{'subscriptionid'} );
+ return $data;
+}
+
+=head2 GetSerialInformation
+
+=over 4
+
+$data = AddItem2Serial($serialid,$itemnumber);
+Adds an itemnumber to Serial record
+=back
+
+=cut
+
+sub AddItem2Serial {
+ my ( $serialid, $itemnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
+ WHERE serialid = ?
+ |;
+ my $rq = $dbh->prepare($query);
+ $rq->execute($serialid);
+ return $rq->rows;
+}
+
+=head2 UpdateClaimdateIssues
+
+=over 4
+
+UpdateClaimdateIssues($serialids,[$date]);
+
+Update Claimdate for issues in @$serialids list with date $date
+(Take Today if none)
+=back
+
+=cut
+
+sub UpdateClaimdateIssues {
+ my ( $serialids, $date ) = @_;
+ my $dbh = C4::Context->dbh;
+ $date = strftime("%Y-%m-%d",localtime) unless ($date);
+ my $query = "
+ UPDATE serial SET claimdate=$date,status=7
+ WHERE serialid in ".join (",",@$serialids);
+ ;
+ my $rq = $dbh->prepare($query);
+ $rq->execute;
+ return $rq->rows;
+}
=head2 GetSubscription
=back
=cut
+
sub GetSubscription {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $query =qq(
+ my $dbh = C4::Context->dbh;
+ my $query = qq(
SELECT subscription.*,
subscriptionhistory.*,
aqbudget.bookfundid,
aqbooksellers.name AS aqbooksellername,
- biblio.title AS bibliotitle
+ biblio.title AS bibliotitle,
+ subscription.biblionumber as bibnum
FROM subscription
LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
WHERE subscription.subscriptionid = ?
);
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+# warn "flags: ".C4::Context->userenv->{'flags'};
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+# warn "query : $query";
my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $subs = $sth->fetchrow_hashref;
return $subs;
}
-=head2 GetSubscriptionsFromBiblionumber
+=head2 GetFullSubscription
+
+=over 4
+
+ \@res = GetFullSubscription($subscriptionid)
+ this function read on serial table.
+
+=back
+
+=cut
+
+sub GetFullSubscription {
+ my ($subscriptionid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT serial.serialid,
+ serial.serialseq,
+ serial.planneddate,
+ serial.publisheddate,
+ serial.status,
+ serial.notes as notes,
+ year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
+ aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
+ biblio.title as bibliotitle,
+ subscription.branchcode AS branchcode,
+ subscription.subscriptionid AS subscriptionid
+ FROM serial
+ LEFT JOIN subscription ON
+ (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
+ LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
+ LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
+ LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
+ WHERE serial.subscriptionid = ? |;
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.="
+ AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query .=qq|
+ ORDER BY year DESC,
+ IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
+ serial.subscriptionid
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my $subs = $sth->fetchall_arrayref({});
+ return $subs;
+}
+
+
+=head2 PrepareSerialsData
=over 4
+ \@res = PrepareSerialsData($serialinfomation)
+ where serialinformation is a hashref array
+
+=back
+
+=cut
+
+sub PrepareSerialsData{
+ my ($lines)=@_;
+ my %tmpresults;
+ my $year;
+ my @res;
+ my $startdate;
+ my $aqbooksellername;
+ my $bibliotitle;
+ my @loopissues;
+ my $first;
+ my $previousnote = "";
+
+ foreach my $subs ( @$lines ) {
+ $subs->{'publisheddate'} =
+ ( $subs->{'publisheddate'}
+ ? format_date( $subs->{'publisheddate'} )
+ : "XXX" );
+ $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
+ $subs->{ "status" . $subs->{'status'} } = 1;
+
+# $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
+ if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
+ $year = $subs->{'year'};
+ }
+ else {
+ $year = "manage";
+ }
+ if ( $tmpresults{$year} ) {
+ push @{ $tmpresults{$year}->{'serials'} }, $subs;
+ }
+ else {
+ $tmpresults{$year} = {
+ 'year' => $year,
+
+ # 'startdate'=>format_date($subs->{'startdate'}),
+ 'aqbooksellername' => $subs->{'aqbooksellername'},
+ 'bibliotitle' => $subs->{'bibliotitle'},
+ 'serials' => [$subs],
+ 'first' => $first,
+ 'branchcode' => $subs->{'branchcode'},
+ 'subscriptionid' => $subs->{'subscriptionid'},
+ };
+ }
+
+ # $previousnote=$subs->{notes};
+ }
+ foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
+ push @res, $tmpresults{$key};
+ }
+ return \@res;
+}
+
+=head2 GetSubscriptionsFromBiblionumber
+
\@res = GetSubscriptionsFromBiblionumber($biblionumber)
this function get the subscription list. it reads on subscription table.
return :
table of subscription which has the biblionumber given on input arg.
each line of this table is a hashref. All hashes containt
-planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate
-
-=back
+startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
=cut
+
sub GetSubscriptionsFromBiblionumber {
my ($biblionumber) = @_;
- my $dbh = C4::Context->dbh;
- my $query = qq(
+ my $dbh = C4::Context->dbh;
+ my $query = qq(
SELECT subscription.*,
+ branches.branchname,
subscriptionhistory.*,
aqbudget.bookfundid,
aqbooksellers.name AS aqbooksellername,
LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
+ LEFT JOIN branches ON branches.branchcode=subscription.branchcode
WHERE subscription.biblionumber = ?
);
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
my @res;
- while (my $subs = $sth->fetchrow_hashref) {
- $subs->{planneddate} = format_date($subs->{planneddate});
- $subs->{publisheddate} = format_date($subs->{publisheddate});
- $subs->{histstartdate} = format_date($subs->{histstartdate});
- $subs->{opacnote} =~ s/\n/\<br\/\>/g;
- $subs->{missinglist} =~ s/\n/\<br\/\>/g;
- $subs->{receivedlist} =~ s/\n/\<br\/\>/g;
- $subs->{"periodicity".$subs->{periodicity}} = 1;
- $subs->{"status".$subs->{'status'}} = 1;
- if ($subs->{enddate} eq '0000-00-00') {
- $subs->{enddate}='';
- } else {
- $subs->{enddate} = format_date($subs->{enddate});
+ while ( my $subs = $sth->fetchrow_hashref ) {
+ $subs->{startdate} = format_date( $subs->{startdate} );
+ $subs->{histstartdate} = format_date( $subs->{histstartdate} );
+ $subs->{opacnote} =~ s/\n/\<br\/\>/g;
+ $subs->{missinglist} =~ s/\n/\<br\/\>/g;
+ $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
+ $subs->{ "periodicity" . $subs->{periodicity} } = 1;
+ $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
+ $subs->{ "status" . $subs->{'status'} } = 1;
+ if ( $subs->{enddate} eq '0000-00-00' ) {
+ $subs->{enddate} = '';
}
- push @res,$subs;
+ else {
+ $subs->{enddate} = format_date( $subs->{enddate} );
+ }
+ $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
+ $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
+ push @res, $subs;
}
return \@res;
}
+
=head2 GetFullSubscriptionsFromBiblionumber
=over 4
=back
=cut
+
sub GetFullSubscriptionsFromBiblionumber {
my ($biblionumber) = @_;
- my $dbh = C4::Context->dbh;
- my $query=qq|
- SELECT serial.serialseq,
- serial.planneddate,
- serial.publisheddate,
- serial.status,
- serial.notes,
- year(serial.publisheddate) AS year,
- aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
- biblio.title AS bibliotitle
- FROM serial
- LEFT JOIN subscription ON
- (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
- LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
- LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
- LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
- WHERE subscription.biblionumber = ?
- ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
- |;
-
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT serial.serialid,
+ serial.serialseq,
+ serial.planneddate,
+ serial.publisheddate,
+ serial.status,
+ serial.notes as notes,
+ year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
+ aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
+ biblio.title as bibliotitle,
+ subscription.branchcode AS branchcode,
+ subscription.subscriptionid AS subscriptionid
+ FROM serial
+ LEFT JOIN subscription ON
+ (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
+ LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
+ LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
+ LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
+ WHERE subscription.biblionumber = ? |;
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.="
+ AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query .=qq|
+ ORDER BY year DESC,
+ IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
+ serial.subscriptionid
+ |;
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
- my @res;
- my $year;
- my $startdate;
- my $aqbooksellername;
- my $bibliotitle;
- my @loopissues;
- my $first;
- my $previousnote="";
- while (my $subs = $sth->fetchrow_hashref) {
- ### BUG To FIX: When there is no published date, will create many null ids!!!
-
- if ($year and ($year==$subs->{year})){
- if ($first eq 1){$first=0;}
- my $temp=$res[scalar(@res)-1]->{'serials'};
- push @$temp,
- {'publisheddate' =>format_date($subs->{'publisheddate'}),
- 'planneddate' => format_date($subs->{'planneddate'}),
- 'serialseq' => $subs->{'serialseq'},
- "status".$subs->{'status'} => 1,
- 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
- };
- } else {
- $first=1 if (not $year);
- $year= $subs->{'year'};
- $startdate= format_date($subs->{'startdate'});
- $aqbooksellername= $subs->{'aqbooksellername'};
- $bibliotitle= $subs->{'bibliotitle'};
- my @temp;
- push @temp,
- {'publisheddate' =>format_date($subs->{'publisheddate'}),
- 'planneddate' => format_date($subs->{'planneddate'}),
- 'serialseq' => $subs->{'serialseq'},
- "status".$subs->{'status'} => 1,
- 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
- };
-
- push @res,{
- 'year'=>$year,
- 'startdate'=>$startdate,
- 'aqbooksellername'=>$aqbooksellername,
- 'bibliotitle'=>$bibliotitle,
- 'serials'=>\@temp,
- 'first'=>$first
- };
- }
- $previousnote=$subs->{notes};
- }
- return \@res;
+ my $subs= $sth->fetchall_arrayref({});
+ return $subs;
}
-
=head2 GetSubscriptions
=over 4
=back
=cut
+
sub GetSubscriptions {
- my ($title,$ISSN,$biblionumber,$supplierid) = @_;
- return unless $title or $ISSN or $biblionumber or $supplierid;
+ my ( $title, $ISSN, $biblionumber ) = @_;
+ #return unless $title or $ISSN or $biblionumber;
my $dbh = C4::Context->dbh;
my $sth;
if ($biblionumber) {
my $query = qq(
- SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
- FROM subscription,biblio
- WHERE biblio.biblionumber = subscription.biblionumber
+ SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
+ FROM subscription,biblio,biblioitems
+ WHERE biblio.biblionumber = biblioitems.biblionumber
+ AND biblio.biblionumber = subscription.biblionumber
AND biblio.biblionumber=?
- ORDER BY title
);
- $sth = $dbh->prepare($query);
- $sth->execute($biblionumber);
- } elsif ($ISSN and $title){
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query.=" ORDER BY title";
+# warn "query :$query";
+ $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ }
+ else {
+ if ( $ISSN and $title ) {
my $query = qq|
- SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber,aqbooksellerid
- FROM subscription,biblio
- WHERE biblio.biblionumber= subscription.biblionumber
- AND (biblio.title LIKE ? or biblio.issn = ?)
- ORDER BY title
+ SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
+ FROM subscription,biblio,biblioitems
+ WHERE biblio.biblionumber = biblioitems.biblionumber
+ AND biblio.biblionumber= subscription.biblionumber
+ AND (biblio.title LIKE ? or biblioitems.issn = ?)
|;
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query.=" ORDER BY title";
$sth = $dbh->prepare($query);
- $sth->execute("%$title%",$ISSN);
- } elsif ($ISSN){
- my $query = qq(
- SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber,aqbooksellerid
- FROM subscription,biblio
- WHERE biblio.biblionumber=subscription.biblionumber
- AND biblio.issn = ?
- ORDER BY title
- );
- $sth = $dbh->prepare($query);
- $sth->execute($ISSN);
- }elsif ($supplierid){
+ $sth->execute( "%$title%", $ISSN );
+ }
+ else {
+ if ($ISSN) {
my $query = qq(
- SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber,aqbooksellerid
- FROM subscription,biblio
- WHERE biblio.biblionumber=subscription.biblionumber
- AND subscription.aqbooksellerid = ?
- ORDER BY title
+ SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
+ FROM subscription,biblio,biblioitems
+ WHERE biblio.biblionumber = biblioitems.biblionumber
+ AND biblio.biblionumber=subscription.biblionumber
+ AND biblioitems.issn LIKE ?
);
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query.=" ORDER BY title";
+# warn "query :$query";
$sth = $dbh->prepare($query);
- $sth->execute($supplierid);
- } else {
+ $sth->execute( "%" . $ISSN . "%" );
+ }
+ else {
my $query = qq(
- SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber,aqbooksellerid
- FROM subscription,biblio
- WHERE biblio.biblionumber=subscription.biblionumber
+ SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
+ FROM subscription,biblio,biblioitems
+ WHERE biblio.biblionumber = biblioitems.biblionumber
+ AND biblio.biblionumber=subscription.biblionumber
AND biblio.title LIKE ?
- ORDER BY title
);
+ if (C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{'flags'} != 1){
+ $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
+ }
+ $query.=" ORDER BY title";
$sth = $dbh->prepare($query);
- $sth->execute("%$title%");
+ $sth->execute( "%" . $title . "%" );
+ }
}
-
-
+ }
my @results;
- my $previoustitle="";
- my $odd=1;
- while (my $line = $sth->fetchrow_hashref) {
- if ($previoustitle eq $line->{title}) {
- $line->{title}="";
- $line->{issn}="";
- $line->{toggle} = 1 if $odd==1;
- } else {
- $previoustitle=$line->{title};
- $odd=-$odd;
- $line->{toggle} = 1 if $odd==1;
+ my $previoustitle = "";
+ my $odd = 1;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ if ( $previoustitle eq $line->{title} ) {
+ $line->{title} = "";
+ $line->{issn} = "";
+ $line->{toggle} = 1 if $odd == 1;
+ }
+ else {
+ $previoustitle = $line->{title};
+ $odd = -$odd;
+ $line->{toggle} = 1 if $odd == 1;
}
push @results, $line;
}
=back
=cut
+
sub GetSerials {
- my ($subscriptionid) = @_;
+ my ($subscriptionid,$count) = @_;
my $dbh = C4::Context->dbh;
-
- my $counter=0;
- my @serials;
-
+
# status = 2 is "arrived"
- my $query = qq|
- SELECT *
- FROM serial
- WHERE subscriptionid = ? AND status NOT IN (2,4,5)
- |;
- my $sth=$dbh->prepare($query);
+ my $counter = 0;
+ $count=5 unless ($count);
+ my @serials;
+ my $query =
+ "SELECT serialid,serialseq, status, publisheddate, planneddate,notes
+ FROM serial
+ WHERE subscriptionid = ? AND status NOT IN (2,4,5)
+ ORDER BY publisheddate,serialid DESC";
+ my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- while(my $line = $sth->fetchrow_hashref) {
- $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
- $line->{"publisheddate"} = format_date($line->{"publisheddate"});
- $line->{"planneddate"} = format_date($line->{"planneddate"});
- push @serials,$line;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ $line->{ "status" . $line->{status} } =
+ 1; # fills a "statusX" value, used for template status select list
+ $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
+ $line->{"planneddate"} = format_date( $line->{"planneddate"} );
+ push @serials, $line;
}
- # OK, now add the last 5 issues arrived/missing
- my $query = qq|
- SELECT *
- FROM serial
- WHERE subscriptionid = ?
- AND (status in (2,4,5))
- ORDER BY serialid DESC
- |;
- my $sth=$dbh->prepare($query);
+ # OK, now add the last 5 issues arrives/missing
+ $query =
+ "SELECT serialid,serialseq, status, planneddate, publisheddate,notes
+ FROM serial
+ WHERE subscriptionid = ?
+ AND (status in (2,4,5))
+ ORDER BY publisheddate,serialid DESC
+ ";
+ $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- while((my $line = $sth->fetchrow_hashref) && $counter <5) {
+ while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
$counter++;
+ $line->{ "status" . $line->{status} } =
+ 1; # fills a "statusX" value, used for template status select list
+ $line->{"planneddate"} = format_date( $line->{"planneddate"} );
+ $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
+ push @serials, $line;
+ }
+
+ $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
+ $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my ($totalissues) = $sth->fetchrow;
+ return ( $totalissues, @serials );
+}
+
+=head2 GetSerials
+
+=over 4
+
+($totalissues,@serials) = GetSerials2($subscriptionid,$status);
+this function get every serial waited for a given subscription
+as well as the number of issues registered in the database (all types)
+this number is used to see if a subscription can be deleted (=it must have only 1 issue)
+
+=back
+
+=cut
+sub GetSerials2 {
+ my ($subscription,$status) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT serialid,serialseq, status, planneddate, publisheddate,notes
+ FROM serial
+ WHERE subscriptionid=$subscription AND status=$status
+ ORDER BY publisheddate,serialid DESC
+ |;
+# warn $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @serials;
+ while(my $line = $sth->fetchrow_hashref) {
$line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
$line->{"planneddate"} = format_date($line->{"planneddate"});
$line->{"publisheddate"} = format_date($line->{"publisheddate"});
push @serials,$line;
}
- my $query = qq|
- SELECT count(*)
- FROM serial
- WHERE subscriptionid=?
- |;
- $sth=$dbh->prepare($query);
- $sth->execute($subscriptionid);
- my ($totalissues) = $sth->fetchrow;
+ my ($totalissues) = scalar(@serials);
return ($totalissues,@serials);
}
=back
=cut
+
sub GetLatestSerials {
- my ($subscriptionid,$limit) = @_;
+ my ( $subscriptionid, $limit ) = @_;
my $dbh = C4::Context->dbh;
+
# status = 2 is "arrived"
- my $strsth=qq(
- SELECT serialid,serialseq, status, planneddate
- FROM serial
- WHERE subscriptionid = ?
- AND (status =2 or status=4)
- ORDER BY planneddate DESC LIMIT 0,$limit
- );
- my $sth=$dbh->prepare($strsth);
+ my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
+ FROM serial
+ WHERE subscriptionid = ?
+ AND (status =2 or status=4)
+ ORDER BY planneddate DESC LIMIT 0,$limit
+ ";
+ my $sth = $dbh->prepare($strsth);
$sth->execute($subscriptionid);
my @serials;
- while(my $line = $sth->fetchrow_hashref) {
- $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
- $line->{"planneddate"} = format_date($line->{"planneddate"});
- push @serials,$line;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ $line->{ "status" . $line->{status} } =
+ 1; # fills a "statusX" value, used for template status select list
+ $line->{"planneddate"} = format_date( $line->{"planneddate"} );
+ push @serials, $line;
}
-# my $query = qq|
-# SELECT count(*)
-# FROM serial
-# WHERE subscriptionid=?
-# |;
-# $sth=$dbh->prepare($query);
-# $sth->execute($subscriptionid);
-# my ($totalissues) = $sth->fetchrow;
+
+ # my $query = qq|
+ # SELECT count(*)
+ # FROM serial
+ # WHERE subscriptionid=?
+ # |;
+ # $sth=$dbh->prepare($query);
+ # $sth->execute($subscriptionid);
+ # my ($totalissues) = $sth->fetchrow;
return \@serials;
}
=back
=cut
+
sub GetDistributedTo {
my $dbh = C4::Context->dbh;
my $distributedto;
my $subscriptionid = @_;
- my $query = qq|
- SELECT distributedto
- FROM subscription
- WHERE subscriptionid=?
- |;
- my $sth = $dbh->prepare($query);
+ my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
+ my $sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
return ($distributedto) = $sth->fetchrow;
}
=back
=cut
-sub Get_Next_Seq {
- my ($val) =@_;
- my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
- $calculated = $val->{numberingmethod};
-# calculate the (expected) value of the next issue received.
- $newlastvalue1 = $val->{lastvalue1};
-# check if we have to increase the new value.
- $newinnerloop1 = $val->{innerloop1}+1;
- $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
- $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
- $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
- $calculated =~ s/\{X\}/$newlastvalue1/g;
-
- $newlastvalue2 = $val->{lastvalue2};
-# check if we have to increase the new value.
- $newinnerloop2 = $val->{innerloop2}+1;
- $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
- $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
- $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
- $calculated =~ s/\{Y\}/$newlastvalue2/g;
-
- $newlastvalue3 = $val->{lastvalue3};
-# check if we have to increase the new value.
- $newinnerloop3 = $val->{innerloop3}+1;
- $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
- $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
- $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
- $calculated =~ s/\{Z\}/$newlastvalue3/g;
- return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
-}
+# sub GetNextSeq {
+# my ($val) =@_;
+# my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
+# $calculated = $val->{numberingmethod};
+# # calculate the (expected) value of the next issue recieved.
+# $newlastvalue1 = $val->{lastvalue1};
+# # check if we have to increase the new value.
+# $newinnerloop1 = $val->{innerloop1}+1;
+# $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
+# $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
+# $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
+# $calculated =~ s/\{X\}/$newlastvalue1/g;
+#
+# $newlastvalue2 = $val->{lastvalue2};
+# # check if we have to increase the new value.
+# $newinnerloop2 = $val->{innerloop2}+1;
+# $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
+# $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
+# $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
+# $calculated =~ s/\{Y\}/$newlastvalue2/g;
+#
+# $newlastvalue3 = $val->{lastvalue3};
+# # check if we have to increase the new value.
+# $newinnerloop3 = $val->{innerloop3}+1;
+# $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
+# $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
+# $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
+# $calculated =~ s/\{Z\}/$newlastvalue3/g;
+# return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
+# }
sub GetNextSeq {
- my ($val) =@_;
- my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
+ my ($val) = @_;
+ my (
+ $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
+ $newinnerloop1, $newinnerloop2, $newinnerloop3
+ );
my $pattern = $val->{numberpattern};
- my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
- my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
- $calculated = $val->{numberingmethod};
+ my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
+ my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
+ $calculated = $val->{numberingmethod};
$newlastvalue1 = $val->{lastvalue1};
$newlastvalue2 = $val->{lastvalue2};
$newlastvalue3 = $val->{lastvalue3};
- if($newlastvalue3 > 0){ # if x y and z columns are used
- $newlastvalue3 = $newlastvalue3+1;
- if($newlastvalue3 > $val->{whenmorethan3}){
- $newlastvalue3 = $val->{setto3};
- $newlastvalue2++;
- if($newlastvalue2 > $val->{whenmorethan2}){
- $newlastvalue1++;
- $newlastvalue2 = $val->{setto2};
- }
- }
- $calculated =~ s/\{X\}/$newlastvalue1/g;
- if($pattern == 6){
- if($val->{hemisphere} == 2){
- my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- } else {
- my $newlastvalue2seq = $seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- }
- } else {
- $calculated =~ s/\{Y\}/$newlastvalue2/g;
- }
- $calculated =~ s/\{Z\}/$newlastvalue3/g;
+
+ if ( $newlastvalue3 > 0 ) { # if x y and z columns are used
+ $newlastvalue3 = $newlastvalue3 + 1;
+ if ( $newlastvalue3 > $val->{whenmorethan3} ) {
+ $newlastvalue3 = $val->{setto3};
+ $newlastvalue2++;
+ if ( $newlastvalue2 > $val->{whenmorethan2} ) {
+ $newlastvalue1++;
+ $newlastvalue2 = $val->{setto2};
+ }
+ }
+ $calculated =~ s/\{X\}/$newlastvalue1/g;
+ if ( $pattern == 6 ) {
+ if ( $val->{hemisphere} == 2 ) {
+ my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ else {
+ my $newlastvalue2seq = $seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ }
+ else {
+ $calculated =~ s/\{Y\}/$newlastvalue2/g;
+ }
+ $calculated =~ s/\{Z\}/$newlastvalue3/g;
}
- if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
- $newlastvalue2 = $newlastvalue2+1;
- if($newlastvalue2 > $val->{whenmorethan2}){
- $newlastvalue2 = $val->{setto2};
- $newlastvalue1++;
- }
- $calculated =~ s/\{X\}/$newlastvalue1/g;
- if($pattern == 6){
- if($val->{hemisphere} == 2){
- my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- } else {
- my $newlastvalue2seq = $seasons[$newlastvalue2];
- $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
- }
- } else {
- $calculated =~ s/\{Y\}/$newlastvalue2/g;
- }
+ if ( $newlastvalue2 > 0 && $newlastvalue3 < 1 )
+ { # if x and y columns are used
+ $newlastvalue2 = $newlastvalue2 + 1;
+ if ( $newlastvalue2 > $val->{whenmorethan2} ) {
+ $newlastvalue2 = $val->{setto2};
+ $newlastvalue1++;
+ }
+ $calculated =~ s/\{X\}/$newlastvalue1/g;
+ if ( $pattern == 6 ) {
+ if ( $val->{hemisphere} == 2 ) {
+ my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ else {
+ my $newlastvalue2seq = $seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ }
+ else {
+ $calculated =~ s/\{Y\}/$newlastvalue2/g;
+ }
}
- if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
- $newlastvalue1 = $newlastvalue1+1;
- if($newlastvalue1 > $val->{whenmorethan1}){
- $newlastvalue1 = $val->{setto2};
- }
- $calculated =~ s/\{X\}/$newlastvalue1/g;
+ if ( $newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1 )
+ { # if column x only
+ $newlastvalue1 = $newlastvalue1 + 1;
+ if ( $newlastvalue1 > $val->{whenmorethan1} ) {
+ $newlastvalue1 = $val->{setto2};
+ }
+ $calculated =~ s/\{X\}/$newlastvalue1/g;
}
- return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
+ return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 );
}
-
-=head2 GetNextDate
-
-=over 4
-
-$resultdate = GetNextDate($planneddate,$subscription)
-
-this function get the date after $planneddate.
-return:
-the date on ISO format.
-
-=back
-
-=cut
-
=head2 GetSeq
=over 4
=back
=cut
+
sub GetSeq {
- my ($val) =@_;
+ my ($val) = @_;
+ my $pattern = $val->{numberpattern};
+ my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
+ my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
my $calculated = $val->{numberingmethod};
- my $x=$val->{'lastvalue1'};
+ my $x = $val->{'lastvalue1'};
$calculated =~ s/\{X\}/$x/g;
- my $y=$val->{'lastvalue2'};
- $calculated =~ s/\{Y\}/$y/g;
- my $z=$val->{'lastvalue3'};
+ my $newlastvalue2 = $val->{'lastvalue2'};
+ if ( $pattern == 6 ) {
+ if ( $val->{hemisphere} == 2 ) {
+ my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ else {
+ my $newlastvalue2seq = $seasons[$newlastvalue2];
+ $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
+ }
+ }
+ else {
+ $calculated =~ s/\{Y\}/$newlastvalue2/g;
+ }
+ my $z = $val->{'lastvalue3'};
$calculated =~ s/\{Z\}/$z/g;
return $calculated;
}
-=head2 GetSubscriptionExpirationDate
-
-=over 4
+=head2 GetExpirationDate
-$sensddate = GetSubscriptionExpirationDate($subscriptionid)
+$sensddate = GetExpirationDate($subscriptionid)
this function return the expiration date for a subscription given on input args.
return
the enddate
-=back
-
=cut
-sub GetSubscriptionExpirationDate {
+
+sub GetExpirationDate {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $subscription = GetSubscription($subscriptionid);
- my $enddate=$subscription->{startdate};
- # we don't do the same test if the subscription is based on X numbers or on X weeks/months
- if ($subscription->{numberlength}) {
+ my $dbh = C4::Context->dbh;
+ my $subscription = GetSubscription($subscriptionid);
+ my $enddate = $subscription->{startdate};
+
+# we don't do the same test if the subscription is based on X numbers or on X weeks/months
+# warn "SUBSCRIPTIONID :$subscriptionid";
+# use Data::Dumper; warn Dumper($subscription);
+
+ if ( $subscription->{numberlength} ) {
#calculate the date of the last issue.
- for (my $i=1;$i<=$subscription->{numberlength};$i++) {
- $enddate = GetNextDate($enddate,$subscription);
+ my $length = $subscription->{numberlength};
+# warn "ENDDATE ".$enddate;
+ for ( my $i = 1 ; $i <= $length ; $i++ ) {
+ $enddate = GetNextDate( $enddate, $subscription );
+# warn "AFTER ENDDATE ".$enddate;
}
}
- else {
- my $duration;
- $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
- $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
- $enddate = DATE_Add_Duration($subscription->{startdate},$duration) ;
+ elsif ( $subscription->{monthlength} ){
+# warn "dateCHECKRESERV :".$subscription->{startdate};
+ my @date=split (/-/,$subscription->{startdate});
+ my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
+ $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
+ } elsif ( $subscription->{weeklength} ){
+ my @date=split (/-/,$subscription->{startdate});
+# warn "dateCHECKRESERV :".$subscription->{startdate};
+#### An other way to do it
+# if ( $subscription->{weeklength} ){
+# my ($weeknb,$year)=Week_of_Year(@startdate);
+# $weeknb += $subscription->{weeklength};
+# my $weeknbcalc= $weeknb % 52;
+# $year += int($weeknb/52);
+# # warn "year : $year weeknb :$weeknb weeknbcalc $weeknbcalc";
+# @endofsubscriptiondate=Monday_of_Week($weeknbcalc,$year);
+# }
+ my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
+ $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
}
+# warn "date de fin :$enddate";
return $enddate;
}
=back
=cut
+
sub CountSubscriptionFromBiblionumber {
my ($biblionumber) = @_;
my $dbh = C4::Context->dbh;
- my $query = qq|
- SELECT count(*)
- FROM subscription
- WHERE biblionumber=?
- |;
- my $sth = $dbh->prepare($query);
+ my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
+ my $sth = $dbh->prepare($query);
$sth->execute($biblionumber);
my $subscriptionsnumber = $sth->fetchrow;
return $subscriptionsnumber;
}
-
=head2 ModSubscriptionHistory
=over 4
-ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
+ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
this function modify the history of a subscription. Put your new values on input arg.
=back
=cut
+
sub ModSubscriptionHistory {
- my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
- my $dbh=C4::Context->dbh;
- my $query = qq(
- UPDATE subscriptionhistory
- SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
- WHERE subscriptionid=?
- );
+ my (
+ $subscriptionid, $histstartdate, $enddate, $recievedlist,
+ $missinglist, $opacnote, $librariannote
+ ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "UPDATE subscriptionhistory
+ SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
+ WHERE subscriptionid=?
+ ";
my $sth = $dbh->prepare($query);
- $receivedlist =~ s/^,//g;
- $missinglist =~ s/^,//g;
- $opacnote =~ s/^,//g;
- $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
+ $recievedlist =~ s/^,//g;
+ $missinglist =~ s/^,//g;
+ $opacnote =~ s/^,//g;
+ $sth->execute(
+ $histstartdate, $enddate, $recievedlist, $missinglist,
+ $opacnote, $librariannote, $subscriptionid
+ );
+ return $sth->rows;
}
=head2 ModSerialStatus
=back
=cut
+
sub ModSerialStatus {
- my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
+ my ( $serialid, $serialseq, $publisheddate, $planneddate, $status, $notes )
+ = @_;
+ #It is a usual serial
# 1st, get previous status :
- my $dbh = C4::Context->dbh;
- my $query = qq|
- SELECT subscriptionid,status
- FROM serial
- WHERE serialid=?
- |;
- my $sth = $dbh->prepare($query);
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
+ my $sth = $dbh->prepare($query);
$sth->execute($serialid);
- my ($subscriptionid,$oldstatus) = $sth->fetchrow;
+ my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
+
# change status & update subscriptionhistory
- if ($status eq 6){
- DelIssue($serialseq, $subscriptionid)
- } else {
- my $query = qq(
- UPDATE serial
- SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
- WHERE serialid = ?
- );
+ my $val;
+ if ( $status eq 6 ) {
+ DelIssue( $serialseq, $subscriptionid );
+ }
+ else {
+ my $query =
+"UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
$sth = $dbh->prepare($query);
- $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
- my $query = qq(
- SELECT missinglist,receivedlist
- FROM subscriptionhistory
- WHERE subscriptionid=?
- );
+ $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
+ $notes, $serialid );
+ $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- my ($missinglist,$receivedlist) = $sth->fetchrow;
- if ($status == 2 && $oldstatus != 2) {
- $receivedlist .= ",$serialseq";
+ my $val = $sth->fetchrow_hashref;
+ unless ( $val->{manualhistory} ) {
+ $query =
+"SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
+ $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my ( $missinglist, $recievedlist ) = $sth->fetchrow;
+ if ( $status eq 2 ) {
+
+# warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
+ $recievedlist .= ",$serialseq"
+ unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
+ }
+
+# warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
+ $missinglist .= ",$serialseq"
+ if ( $status eq 4
+ and not index( "$missinglist", "$serialseq" ) >= 0 );
+ $missinglist .= ",not issued $serialseq"
+ if ( $status eq 5
+ and index( "$missinglist", "$serialseq" ) >= 0 );
+ $query =
+"UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $recievedlist, $missinglist, $subscriptionid );
}
- $missinglist .= ",$serialseq" if ($status eq 4) ;
- $missinglist .= ",not issued $serialseq" if ($status eq 5);
- my $query = qq(
- UPDATE subscriptionhistory
- SET receivedlist=?, missinglist=?
- WHERE subscriptionid=?
- );
- $sth=$dbh->prepare($query);
- $sth->execute($receivedlist,$missinglist,$subscriptionid);
}
- # create new waited entry if needed (ie : was a "waited" and has changed)
- if ($oldstatus eq 1 && $status ne 1) {
- my $query = qq(
- SELECT *
- FROM subscription
- WHERE subscriptionid = ?
- );
+
+ # create new waited entry if needed (ie : was a "waited" and has changed)
+ if ( $oldstatus eq 1 && $status ne 1 ) {
+ my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
my $val = $sth->fetchrow_hashref;
+
# next issue number
- my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
+ my (
+ $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
+ $newinnerloop1, $newinnerloop2, $newinnerloop3
+ ) = GetNextSeq($val);
+
# next date (calculated from actual date & frequency parameters)
- my $nextplanneddate = GetNextDate($planneddate,$val);
- my $nextpublisheddate = GetNextDate($publisheddate,$val);
- NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
- my $query = qq|
- UPDATE subscription
- SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
- innerloop1=?, innerloop2=?, innerloop3=?
- WHERE subscriptionid = ?
- |;
+# warn "publisheddate :$publisheddate ";
+ my $nextpublisheddate = GetNextDate( $publisheddate, $val );
+ NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
+ 1, $nextpublisheddate, $nextpublisheddate );
+ $query =
+"UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
+ WHERE subscriptionid = ?";
$sth = $dbh->prepare($query);
- $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
+ $sth->execute(
+ $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
+ $newinnerloop2, $newinnerloop3, $subscriptionid
+ );
+
+# check if an alert must be sent... (= a letter is defined & status became "arrived"
+ if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
+ SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
+ }
}
}
=back
=cut
+
sub ModSubscription {
- my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
- $periodicity,$dow,$numberlength,$weeklength,$monthlength,
- $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
- $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
- $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
- $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
- my $dbh = C4::Context->dbh;
- my $query = qq|
- UPDATE subscription
- SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
- periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
- add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
- add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
- add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
- numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
- WHERE subscriptionid = ?
- |;
- my $sth=$dbh->prepare($query);
- $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
- $periodicity,$dow,$numberlength,$weeklength,$monthlength,
- $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
- $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
- $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
- $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
+ my (
+ $auser, $branchcode, $aqbooksellerid, $cost,
+ $aqbudgetid, $startdate, $periodicity, $firstacquidate,
+ $dow, $irregularity, $numberpattern, $numberlength,
+ $weeklength, $monthlength, $add1, $every1,
+ $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
+ $add2, $every2, $whenmorethan2, $setto2,
+ $lastvalue2, $innerloop2, $add3, $every3,
+ $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
+ $numberingmethod, $status, $biblionumber, $callnumber,
+ $notes, $letter, $hemisphere, $manualhistory,
+ $internalnotes,
+ $subscriptionid
+ ) = @_;
+# warn $irregularity;
+ my $dbh = C4::Context->dbh;
+ my $query = "UPDATE subscription
+ SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
+ periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
+ add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
+ add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
+ add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
+ numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
+ WHERE subscriptionid = ?";
+# warn "query :".$query;
+ my $sth = $dbh->prepare($query);
+ $sth->execute(
+ $auser, $branchcode, $aqbooksellerid, $cost,
+ $aqbudgetid, $startdate, $periodicity, $firstacquidate,
+ $dow, "$irregularity", $numberpattern, $numberlength,
+ $weeklength, $monthlength, $add1, $every1,
+ $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
+ $add2, $every2, $whenmorethan2, $setto2,
+ $lastvalue2, $innerloop2, $add3, $every3,
+ $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
+ $numberingmethod, $status, $biblionumber, $callnumber,
+ $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
+ $internalnotes,
+ $subscriptionid
+ );
+ my $rows=$sth->rows;
$sth->finish;
+
+ &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
+ if C4::Context->preference("SubscriptionLog");
+ return $rows;
}
-
=head2 NewSubscription
=over 4
-$subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
+$subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
=back
=cut
-sub NewSubscription {
- my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
- $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
- $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
- $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
- $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
- $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
+sub NewSubscription {
+ my (
+ $auser, $branchcode, $aqbooksellerid, $cost,
+ $aqbudgetid, $biblionumber, $startdate, $periodicity,
+ $dow, $numberlength, $weeklength, $monthlength,
+ $add1, $every1, $whenmorethan1, $setto1,
+ $lastvalue1, $innerloop1, $add2, $every2,
+ $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
+ $add3, $every3, $whenmorethan3, $setto3,
+ $lastvalue3, $innerloop3, $numberingmethod, $status,
+ $notes, $letter, $firstacquidate, $irregularity,
+ $numberpattern, $callnumber, $hemisphere, $manualhistory,
+ $internalnotes
+ ) = @_;
my $dbh = C4::Context->dbh;
-#save subscription (insert into database)
+
+ #save subscription (insert into database)
my $query = qq|
INSERT INTO subscription
- (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
+ (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
startdate,periodicity,dow,numberlength,weeklength,monthlength,
- add1,every1,whenmorethan1,setto1,lastvalue1,
- add2,every2,whenmorethan2,setto2,lastvalue2,
- add3,every3,whenmorethan3,setto3,lastvalue3,
- numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
- |;
- my $sth=$dbh->prepare($query);
+ add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
+ add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
+ add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
+ numberingmethod, status, notes, letter,firstacquidate,irregularity,
+ numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ |;
+ my $sth = $dbh->prepare($query);
$sth->execute(
- $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
- format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
- $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
- $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
- $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
- $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
-
+ $auser, $branchcode,
+ $aqbooksellerid, $cost,
+ $aqbudgetid, $biblionumber,
+ format_date_in_iso($startdate), $periodicity,
+ $dow, $numberlength,
+ $weeklength, $monthlength,
+ $add1, $every1,
+ $whenmorethan1, $setto1,
+ $lastvalue1, $innerloop1,
+ $add2, $every2,
+ $whenmorethan2, $setto2,
+ $lastvalue2, $innerloop2,
+ $add3, $every3,
+ $whenmorethan3, $setto3,
+ $lastvalue3, $innerloop3,
+ $numberingmethod, "$status",
+ $notes, $letter,
+ $firstacquidate, $irregularity,
+ $numberpattern, $callnumber,
+ $hemisphere, $manualhistory,
+ $internalnotes
+ );
-#then create the 1st waited number
+ #then create the 1st waited number
my $subscriptionid = $dbh->{'mysql_insertid'};
- my $enddate = GetSubscriptionExpirationDate($subscriptionid);
- my $query = qq(
+ $query = qq(
INSERT INTO subscriptionhistory
- (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
+ (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
VALUES (?,?,?,?,?,?,?,?)
);
$sth = $dbh->prepare($query);
- $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
-## User may have subscriptionid stored in MARC so check and fill it
-my $record=XMLgetbiblio($dbh,$biblionumber);
-$record=XML_xml2hash_onerecord($record);
-XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
-my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
-NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
-# reread subscription to get a hash (for calculation of the 1st issue number)
- my $query = qq(
+ $sth->execute( $biblionumber, $subscriptionid,
+ format_date_in_iso($startdate),
+ 0, "", "", "", "$notes" );
+
+ # reread subscription to get a hash (for calculation of the 1st issue number)
+ $query = qq(
SELECT *
FROM subscription
WHERE subscriptionid = ?
$sth->execute($subscriptionid);
my $val = $sth->fetchrow_hashref;
-# calculate issue number
+ # calculate issue number
my $serialseq = GetSeq($val);
- my $query = qq|
+ $query = qq|
INSERT INTO serial
- (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
+ (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
VALUES (?,?,?,?,?,?)
|;
-
$sth = $dbh->prepare($query);
- $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
+ $sth->execute(
+ "$serialseq", $subscriptionid, $biblionumber, 1,
+ format_date_in_iso($startdate),
+ format_date_in_iso($startdate)
+ );
+
+ &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
+ if C4::Context->preference("SubscriptionLog");
+
return $subscriptionid;
}
-
=head2 ReNewSubscription
=over 4
=back
=cut
+
sub ReNewSubscription {
- my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
- my $dbh = C4::Context->dbh;
+ my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
+ $monthlength, $note )
+ = @_;
+ my $dbh = C4::Context->dbh;
my $subscription = GetSubscription($subscriptionid);
- my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
- $record=XML_xml2hash_onerecord($record);
- my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
- NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
+ my $query = qq|
+ SELECT *
+ FROM biblio,biblioitems
+ WHERE biblio.biblionumber=biblioitems.biblionumber
+ AND biblio.biblionumber=?
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $subscription->{biblionumber} );
+ my $biblio = $sth->fetchrow_hashref;
+ NewSuggestion(
+ $user, $subscription->{bibliotitle},
+ $biblio->{author}, $biblio->{publishercode},
+ $biblio->{note}, '',
+ '', '',
+ '', '',
+ $subscription->{biblionumber}
+ );
+
# renew subscription
- my $query = qq|
+ $query = qq|
UPDATE subscription
SET startdate=?,numberlength=?,weeklength=?,monthlength=?
WHERE subscriptionid=?
|;
-my $sth=$dbh->prepare($query);
- $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
+ $sth = $dbh->prepare($query);
+ $sth->execute( format_date_in_iso($startdate),
+ $numberlength, $weeklength, $monthlength, $subscriptionid );
+
+ &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
+ if C4::Context->preference("SubscriptionLog");
}
-
=head2 NewIssue
=over 4
NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
Create a new issue stored on the database.
-Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
+Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
=back
=cut
+
sub NewIssue {
- my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
- my $dbh = C4::Context->dbh;
+ my ( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate,
+ $planneddate, $notes )
+ = @_;
+ ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
+
+ my $dbh = C4::Context->dbh;
my $query = qq|
INSERT INTO serial
- (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
+ (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
VALUES (?,?,?,?,?,?,?)
|;
my $sth = $dbh->prepare($query);
- $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
-
- my $query = qq|
- SELECT missinglist,receivedlist
+ $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
+ $publisheddate, $planneddate,$notes );
+ my $serialid=$dbh->{'mysql_insertid'};
+ $query = qq|
+ SELECT missinglist,recievedlist
FROM subscriptionhistory
WHERE subscriptionid=?
|;
$sth = $dbh->prepare($query);
$sth->execute($subscriptionid);
- my ($missinglist,$receivedlist) = $sth->fetchrow;
- if ($status eq 2) {
- $receivedlist .= ",$serialseq";
+ my ( $missinglist, $recievedlist ) = $sth->fetchrow;
+
+ if ( $status eq 2 ) {
+ ### TODO Add a feature that improves recognition and description.
+ ### As such count (serialseq) i.e. : N°18,2(N°19),N°20
+ ### Would use substr and index But be careful to previous presence of ()
+ $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
}
- if ($status eq 4) {
- $missinglist .= ",$serialseq";
+ if ( $status eq 4 ) {
+ $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
}
- my $query = qq|
+ $query = qq|
UPDATE subscriptionhistory
- SET receivedlist=?, missinglist=?
+ SET recievedlist=?, missinglist=?
WHERE subscriptionid=?
|;
- $sth=$dbh->prepare($query);
- $sth->execute($receivedlist,$missinglist,$subscriptionid);
+ $sth = $dbh->prepare($query);
+ $sth->execute( $recievedlist, $missinglist, $subscriptionid );
+ return $serialid;
}
-=head2 serialchangestatus
+=head2 ItemizeSerials
=over 4
-serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
-
-Change the status of a serial issue.
-Note: this was the older subroutine
+ItemizeSerials($serialid, $info);
+$info is a hashref containing barcode branch, itemcallnumber, status, location
+$serialid the serialid
+return :
+1 if the itemize is a succes.
+0 and @error else. @error containts the list of errors found.
=back
=cut
-sub serialchangestatus {
- my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
- # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
- $sth->execute($serialid);
- my ($subscriptionid,$oldstatus) = $sth->fetchrow;
- # change status & update subscriptionhistory
- if ($status eq 6){
- delissue($serialseq, $subscriptionid)
- }else{
- $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
- $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
- $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
- $sth->execute($subscriptionid);
- my ($missinglist,$receivedlist) = $sth->fetchrow;
- if ($status eq 2) {
- $receivedlist .= "| $serialseq";
- $receivedlist =~ s/^\| //g;
+sub ItemizeSerials {
+ my ( $serialid, $info ) = @_;
+ my $now = POSIX::strftime( "%Y-%m-%d",localtime );
+
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT *
+ FROM serial
+ WHERE serialid=?
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($serialid);
+ my $data = $sth->fetchrow_hashref;
+ if ( C4::Context->preference("RoutingSerials") ) {
+
+ # check for existing biblioitem relating to serial issue
+ my ( $count, @results ) =
+ GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
+ my $bibitemno = 0;
+ for ( my $i = 0 ; $i < $count ; $i++ ) {
+ if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
+ . $data->{'planneddate'}
+ . ')' )
+ {
+ $bibitemno = $results[$i]->{'biblioitemnumber'};
+ last;
+ }
+ }
+ if ( $bibitemno == 0 ) {
+
+ # warn "need to add new biblioitem so copy last one and make minor changes";
+ my $sth =
+ $dbh->prepare(
+"SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
+ );
+ $sth->execute( $data->{'biblionumber'} );
+ my $biblioitem = $sth->fetchrow_hashref;
+ $biblioitem->{'volumedate'} =
+ format_date_in_iso( $data->{planneddate} );
+ $biblioitem->{'volumeddesc'} =
+ $data->{serialseq} . ' ('
+ . format_date( $data->{'planneddate'} ) . ')';
+ $biblioitem->{'dewey'} = $info->{itemcallnumber};
+
+ #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
+ # so I comment it, we can speak of it when you want
+ # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
+# if ( $info->{barcode} )
+# { # only make biblioitem if we are going to make item also
+# $bibitemno = newbiblioitem($biblioitem);
+# }
}
- $missinglist .= "| $serialseq" if ($status eq 4) ;
- $missinglist .= "| not issued $serialseq" if ($status eq 5);
- $missinglist =~ s/^\| //g;
- $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
- $sth->execute($receivedlist,$missinglist,$subscriptionid);
- }
- # create new waited entry if needed (ie : was a "waited" and has changed)
- if ($oldstatus eq 1 && $status ne 1) {
- $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
- $sth->execute($subscriptionid);
- my $val = $sth->fetchrow_hashref;
- # next issue number
- my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
- my $nextplanneddate = GetNextDate($planneddate,$val);
- NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
- $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
- $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
}
- # check if an alert must be sent... (= a letter is defined & status became "arrived"
- $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
- $sth->execute($subscriptionid);
- my $subscription = $sth->fetchrow_hashref;
- if ($subscription->{letter} && $status eq 2) {
- sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
+
+ my $fwk = MARCfind_frameworkcode( $data->{'biblionumber'} );
+ if ( $info->{barcode} ) {
+ my @errors;
+ my $exists = itemdata( $info->{'barcode'} );
+ push @errors, "barcode_not_unique" if ($exists);
+ unless ($exists) {
+ my $marcrecord = MARC::Record->new();
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.barcode", $fwk );
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{barcode} );
+ $marcrecord->insert_fields_ordered($newField);
+ if ( $info->{branch} ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.homebranch",
+ $fwk );
+
+ #warn "items.homebranch : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{branch} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{branch} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.holdingbranch",
+ $fwk );
+
+ #warn "items.holdingbranch : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{branch} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{branch} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ if ( $info->{itemcallnumber} ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.itemcallnumber",
+ $fwk );
+
+ #warn "items.itemcallnumber : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{itemcallnumber} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{itemcallnumber} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ if ( $info->{notes} ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.itemnotes", $fwk );
+
+ # warn "items.itemnotes : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{notes} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{notes} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ if ( $info->{location} ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.location", $fwk );
+
+ # warn "items.location : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{location} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{location} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ if ( $info->{status} ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.notforloan",
+ $fwk );
+
+ # warn "items.notforloan : $tag , $subfield";
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $info->{status} );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '',
+ "$subfield" => $info->{status} );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ if ( C4::Context->preference("RoutingSerials") ) {
+ my ( $tag, $subfield ) =
+ MARCfind_marc_from_kohafield( $dbh, "items.dateaccessioned",
+ $fwk );
+ if ( $marcrecord->field($tag) ) {
+ $marcrecord->field($tag)
+ ->add_subfields( "$subfield" => $now );
+ }
+ else {
+ my $newField =
+ MARC::Field->new( "$tag", '', '', "$subfield" => $now );
+ $marcrecord->insert_fields_ordered($newField);
+ }
+ }
+ AddItem( $marcrecord, $data->{'biblionumber'} );
+ return 1;
+ }
+ return ( 0, @errors );
}
}
-
-
-
=head2 HasSubscriptionExpired
=over 4
=back
=cut
+
sub HasSubscriptionExpired {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $subscription = GetSubscription($subscriptionid);
- # we don't do the same test if the subscription is based on X numbers or on X weeks/months
- if ($subscription->{numberlength} ) {
- my $query = qq|
- SELECT count(*)
- FROM serial
- WHERE subscriptionid=? AND planneddate>=?
- |;
- my $sth = $dbh->prepare($query);
- $sth->execute($subscriptionid,$subscription->{startdate});
- my $res = $sth->fetchrow;
- if ($subscription->{numberlength}>=$res) {
- return 0;
- } else {
- return 1;
- }
- } else {
- #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
- my $query = qq|
+ my $dbh = C4::Context->dbh;
+ my $subscription = GetSubscription($subscriptionid);
+ my $expirationdate = GetExpirationDate($subscriptionid);
+ my $query = qq|
SELECT max(planneddate)
FROM serial
WHERE subscriptionid=?
- |;
- my $sth = $dbh->prepare($query);
- $sth->execute($subscriptionid);
- my $res = $sth->fetchrow;
- my $endofsubscriptiondate;
- my $duration;
- $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
- $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
-
- $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
- return 1 if ($res ge $endofsubscriptiondate);
- return 0;
- }
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my ($res) = $sth->fetchrow ;
+ my @res=split (/-/,$res);
+ my @endofsubscriptiondate=split(/-/,$expirationdate);
+ return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
+ $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
+ || (!$res));
+ return 0;
}
=head2 SetDistributedto
=back
=cut
+
sub SetDistributedto {
- my ($distributedto,$subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
+ my ( $distributedto, $subscriptionid ) = @_;
+ my $dbh = C4::Context->dbh;
my $query = qq|
UPDATE subscription
SET distributedto=?
WHERE subscriptionid=?
|;
my $sth = $dbh->prepare($query);
- $sth->execute($distributedto,$subscriptionid);
+ $sth->execute( $distributedto, $subscriptionid );
}
=head2 DelSubscription
=back
=cut
+
sub DelSubscription {
- my ($subscriptionid,$biblionumber) = @_;
+ my ($subscriptionid) = @_;
my $dbh = C4::Context->dbh;
-## User may have subscriptionid stored in MARC so check and remove it
-my $record=XMLgetbibliohash($dbh,$biblionumber);
-XML_writeline( $record, "subscriptionid", "","biblios" );
-my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
-NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
- $subscriptionid=$dbh->quote($subscriptionid);
+ $subscriptionid = $dbh->quote($subscriptionid);
$dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
- $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
+ $dbh->do(
+ "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
$dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
-
+
+ &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
+ if C4::Context->preference("SubscriptionLog");
}
=head2 DelIssue
=back
=cut
+
sub DelIssue {
- my ($serialseq,$subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
+ my ( $serialseq, $subscriptionid ) = @_;
+ my $dbh = C4::Context->dbh;
my $query = qq|
DELETE FROM serial
WHERE serialseq= ?
AND subscriptionid= ?
|;
- my $sth = $dbh->prepare($query);
- $sth->execute($serialseq,$subscriptionid);
+ my $mainsth = $dbh->prepare($query);
+ $mainsth->execute( $serialseq, $subscriptionid );
+
+ #Delete element from subscription history
+ $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my $val = $sth->fetchrow_hashref;
+ unless ( $val->{manualhistory} ) {
+ my $query = qq|
+ SELECT * FROM subscriptionhistory
+ WHERE subscriptionid= ?
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($subscriptionid);
+ my $data = $sth->fetchrow_hashref;
+ $data->{'missinglist'} =~ s/$serialseq//;
+ $data->{'recievedlist'} =~ s/$serialseq//;
+ my $strsth = "UPDATE subscriptionhistory SET "
+ . join( ",",
+ map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
+ . " WHERE subscriptionid=?";
+ $sth = $dbh->prepare($strsth);
+ $sth->execute($subscriptionid);
+ }
+ ### TODO Add itemdeletion. Should be in a pref ?
+
+ return $mainsth->rows;
}
-=head2 GetMissingIssues
+=head2 GetLateOrMissingIssues
=over 4
-($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
+($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
-this function select missing issues on database - where serial.status = 4
+this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
return :
a count of the number of missing issues
=back
=cut
-sub GetMissingIssues {
- my ($supplierid,$serialid) = @_;
+
+sub GetLateOrMissingIssues {
+ my ( $supplierid, $serialid,$order ) = @_;
my $dbh = C4::Context->dbh;
my $sth;
- my $byserial='';
- if($serialid) {
- $byserial = "and serialid = ".$serialid;
+ my $byserial = '';
+ if ($serialid) {
+ $byserial = "and serialid = " . $serialid;
}
- if ($supplierid) {
- $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
- FROM subscription, serial, biblio
- LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE subscription.subscriptionid = serial.subscriptionid AND
- serial.STATUS = 4 and
- subscription.aqbooksellerid=$supplierid and
- biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
- ");
+ if ($order){
+ $order.=", title";
} else {
- $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
- FROM subscription, serial, biblio
- LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
- WHERE subscription.subscriptionid = serial.subscriptionid AND
- serial.STATUS =4 and
- biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
- ");
+ $order="title";
+ }
+ if ($supplierid) {
+ $sth = $dbh->prepare(
+"SELECT
+ serialid,
+ aqbooksellerid,
+ name,
+ biblio.title,
+ planneddate,
+ serialseq,
+ serial.status,
+ serial.subscriptionid,
+ claimdate
+FROM serial
+LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
+LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
+LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
+WHERE subscription.subscriptionid = serial.subscriptionid
+AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
+AND subscription.aqbooksellerid=$supplierid
+$byserial
+ORDER BY $order"
+ );
+ }
+ else {
+ $sth = $dbh->prepare(
+"SELECT
+ serialid,
+ aqbooksellerid,
+ name,
+ biblio.title,
+ planneddate,
+ serialseq,
+ serial.status,
+ serial.subscriptionid,
+ claimdate
+FROM serial
+LEFT JOIN subscription
+ON serial.subscriptionid=subscription.subscriptionid
+LEFT JOIN biblio
+ON serial.biblionumber=biblio.biblionumber
+LEFT JOIN aqbooksellers
+ON subscription.aqbooksellerid = aqbooksellers.id
+WHERE
+ subscription.subscriptionid = serial.subscriptionid
+AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
+AND biblio.biblionumber = subscription.biblionumber
+$byserial
+ORDER BY $order"
+ );
}
$sth->execute;
my @issuelist;
my $last_title;
- my $odd=0;
- my $count=0;
- while (my $line = $sth->fetchrow_hashref) {
- $odd++ unless $line->{title} eq $last_title;
- $last_title = $line->{title} if ($line->{title});
- $line->{planneddate} = format_date($line->{planneddate});
- $line->{claimdate} = format_date($line->{claimdate});
- $line->{'odd'} = 1 if $odd %2 ;
- $count++;
- push @issuelist,$line;
+ my $odd = 0;
+ my $count = 0;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ $odd++ unless $line->{title} eq $last_title;
+ $last_title = $line->{title} if ( $line->{title} );
+ $line->{planneddate} = format_date( $line->{planneddate} );
+ $line->{claimdate} = format_date( $line->{claimdate} );
+ $line->{"status".$line->{status}} = 1;
+ $line->{'odd'} = 1 if $odd % 2;
+ $count++;
+ push @issuelist, $line;
}
- return $count,@issuelist;
+ return $count, @issuelist;
}
=head2 removeMissingIssue
this function removes an issue from being part of the missing string in
subscriptionlist.missinglist column
-called when a missing issue is found from the statecollection.pl file
+called when a missing issue is found from the serials-recieve.pl file
=back
=cut
+
sub removeMissingIssue {
- my ($sequence,$subscriptionid) = @_;
+ my ( $sequence, $subscriptionid ) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
$sth->execute($subscriptionid);
- my $data = $sth->fetchrow_hashref;
- my $missinglist = $data->{'missinglist'};
+ my $data = $sth->fetchrow_hashref;
+ my $missinglist = $data->{'missinglist'};
my $missinglistbefore = $missinglist;
+
# warn $missinglist." before";
$missinglist =~ s/($sequence)//;
+
# warn $missinglist." after";
- if($missinglist ne $missinglistbefore){
- $missinglist =~ s/\|\s\|/\|/g;
- $missinglist =~ s/^\| //g;
- $missinglist =~ s/\|$//g;
- my $sth2= $dbh->prepare("UPDATE subscriptionhistory
+ if ( $missinglist ne $missinglistbefore ) {
+ $missinglist =~ s/\|\s\|/\|/g;
+ $missinglist =~ s/^\| //g;
+ $missinglist =~ s/\|$//g;
+ my $sth2 = $dbh->prepare(
+ "UPDATE subscriptionhistory
SET missinglist = ?
- WHERE subscriptionid = ?");
- $sth2->execute($missinglist,$subscriptionid);
+ WHERE subscriptionid = ?"
+ );
+ $sth2->execute( $missinglist, $subscriptionid );
}
}
=back
=cut
+
sub updateClaim {
my ($serialid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "UPDATE serial SET claimdate = now()
WHERE serialid = ?
- ");
+ "
+ );
$sth->execute($serialid);
}
=back
=cut
+
sub getsupplierbyserialid {
my ($serialid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT serialid, serial.subscriptionid, aqbooksellerid
FROM serial, subscription
WHERE serial.subscriptionid = subscription.subscriptionid
AND serialid = ?
- ");
+ "
+ );
$sth->execute($serialid);
- my $line = $sth->fetchrow_hashref;
+ my $line = $sth->fetchrow_hashref;
my $result = $line->{'aqbooksellerid'};
return $result;
}
=back
=cut
+
sub check_routing {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+"SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
AND subscription.subscriptionid = ? ORDER BY ranking ASC
- ");
+ "
+ );
$sth->execute($subscriptionid);
- my $line = $sth->fetchrow_hashref;
+ my $line = $sth->fetchrow_hashref;
my $result = $line->{'routingids'};
return $result;
}
=over 4
-&addroutingmember($bornum,$subscriptionid)
+&addroutingmember($borrowernumber,$subscriptionid)
this function takes a borrowernumber and subscriptionid and add the member to the
routing list for that serial subscription and gives them a rank on the list
=back
=cut
+
sub addroutingmember {
- my ($bornum,$subscriptionid) = @_;
+ my ( $borrowernumber, $subscriptionid ) = @_;
my $rank;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
+ my $sth =
+ $dbh->prepare(
+"SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
+ );
$sth->execute($subscriptionid);
- while(my $line = $sth->fetchrow_hashref){
- if($line->{'rank'}>0){
- $rank = $line->{'rank'}+1;
- } else {
- $rank = 1;
- }
+ while ( my $line = $sth->fetchrow_hashref ) {
+ if ( $line->{'rank'} > 0 ) {
+ $rank = $line->{'rank'} + 1;
+ }
+ else {
+ $rank = 1;
+ }
}
- $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
- $sth->execute($subscriptionid,$bornum,$rank);
+ $sth =
+ $dbh->prepare(
+"INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
+ );
+ $sth->execute( $subscriptionid, $borrowernumber, $rank );
}
=head2 reorder_members
=back
=cut
+
sub reorder_members {
- my ($subscriptionid,$routingid,$rank) = @_;
+ my ( $subscriptionid, $routingid, $rank ) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
+ my $sth =
+ $dbh->prepare(
+"SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
+ );
$sth->execute($subscriptionid);
my @result;
- while(my $line = $sth->fetchrow_hashref){
- push(@result,$line->{'routingid'});
+ while ( my $line = $sth->fetchrow_hashref ) {
+ push( @result, $line->{'routingid'} );
}
+
# To find the matching index
my $i;
- my $key = -1; # to allow for 0 being a valid response
- for ($i = 0; $i < @result; $i++) {
- if ($routingid == $result[$i]) {
- $key = $i; # save the index
- last;
- }
+ my $key = -1; # to allow for 0 being a valid response
+ for ( $i = 0 ; $i < @result ; $i++ ) {
+ if ( $routingid == $result[$i] ) {
+ $key = $i; # save the index
+ last;
+ }
}
+
# if index exists in array then move it to new position
- if($key > -1 && $rank > 0){
- my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
- my $moving_item = splice(@result, $key, 1);
- splice(@result, $new_rank, 0, $moving_item);
+ if ( $key > -1 && $rank > 0 ) {
+ my $new_rank = $rank -
+ 1; # $new_rank is what you want the new index to be in the array
+ my $moving_item = splice( @result, $key, 1 );
+ splice( @result, $new_rank, 0, $moving_item );
}
- for(my $j = 0; $j < @result; $j++){
- my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
- $sth->execute;
+ for ( my $j = 0 ; $j < @result ; $j++ ) {
+ my $sth =
+ $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
+ . ( $j + 1 )
+ . "' WHERE routingid = '"
+ . $result[$j]
+ . "'" );
+ $sth->execute;
}
}
=back
=cut
+
sub delroutingmember {
- # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
- my ($routingid,$subscriptionid) = @_;
+
+# if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
+ my ( $routingid, $subscriptionid ) = @_;
my $dbh = C4::Context->dbh;
- if($routingid){
- my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
- $sth->execute($routingid);
- reorder_members($subscriptionid,$routingid);
- } else {
- my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
- $sth->execute($subscriptionid);
+ if ($routingid) {
+ my $sth =
+ $dbh->prepare(
+ "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
+ $sth->execute($routingid);
+ reorder_members( $subscriptionid, $routingid );
+ }
+ else {
+ my $sth =
+ $dbh->prepare(
+ "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
+ $sth->execute($subscriptionid);
}
}
=back
=cut
+
sub getroutinglist {
my ($subscriptionid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT routingid, borrowernumber,
ranking, biblionumber FROM subscriptionroutinglist, subscription
WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
AND subscription.subscriptionid = ? ORDER BY ranking ASC
- ");
+ "
+ );
$sth->execute($subscriptionid);
my @routinglist;
- my $count=0;
- while (my $line = $sth->fetchrow_hashref) {
- $count++;
- push(@routinglist,$line);
+ my $count = 0;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ $count++;
+ push( @routinglist, $line );
}
- return ($count,@routinglist);
+ return ( $count, @routinglist );
}
=head2 abouttoexpire
=cut
-sub abouttoexpire {
+sub abouttoexpire {
my ($subscriptionid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $subscription = GetSubscription($subscriptionid);
+ my $expirationdate = GetExpirationDate($subscriptionid);
+ my $sth =
+ $dbh->prepare(
+ "select max(planneddate) from serial where subscriptionid=?");
+ $sth->execute($subscriptionid);
+ my ($res) = $sth->fetchrow ;
+# warn "date expiration : ".$expirationdate." date courante ".$res;
+ my @res=split /-/,$res;
+ my @endofsubscriptiondate=split/-/,$expirationdate;
+ my $per = $subscription->{'periodicity'};
+ my $x;
+ if ( $per == 1 ) {$x=7;}
+ if ( $per == 2 ) {$x=7; }
+ if ( $per == 3 ) {$x=14;}
+ if ( $per == 4 ) { $x = 21; }
+ if ( $per == 5 ) { $x = 31; }
+ if ( $per == 6 ) { $x = 62; }
+ if ( $per == 7 || $per == 8 ) { $x = 93; }
+ if ( $per == 9 ) { $x = 190; }
+ if ( $per == 10 ) { $x = 365; }
+ if ( $per == 11 ) { $x = 730; }
+ my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
+ - (3 * $x)) if (@endofsubscriptiondate);
+ # warn "DATE BEFORE END: $datebeforeend";
+ return 1 if ( @res &&
+ (@datebeforeend &&
+ Delta_Days($res[0],$res[1],$res[2],
+ $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
+ (@endofsubscriptiondate &&
+ Delta_Days($res[0],$res[1],$res[2],
+ $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
+ return 0;
+}
+
+=head2 old_newsubscription
+
+=over 4
+
+($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
+ $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
+ $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
+ $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
+ $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
+ $numberingmethod, $status, $callnumber, $notes, $hemisphere)
+
+this function is similar to the NewSubscription subroutine but has a few different
+values passed in
+$firstacquidate - date of first serial issue to arrive
+$irregularity - the issues not expected separated by a '|'
+- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
+$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
+ subscription-add.tmpl file
+$callnumber - display the callnumber of the serial
+$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
+
+return :
+the $subscriptionid number of the new subscription
+
+=back
+
+=cut
+
+sub old_newsubscription {
+ my (
+ $auser, $aqbooksellerid, $cost, $aqbudgetid,
+ $biblionumber, $startdate, $periodicity, $firstacquidate,
+ $dow, $irregularity, $numberpattern, $numberlength,
+ $weeklength, $monthlength, $add1, $every1,
+ $whenmorethan1, $setto1, $lastvalue1, $add2,
+ $every2, $whenmorethan2, $setto2, $lastvalue2,
+ $add3, $every3, $whenmorethan3, $setto3,
+ $lastvalue3, $numberingmethod, $status, $callnumber,
+ $notes, $hemisphere
+ ) = @_;
my $dbh = C4::Context->dbh;
- my $subscription = GetSubscription($subscriptionid);
- # we don't do the same test if the subscription is based on X numbers or on X weeks/months
- if ($subscription->{numberlength}) {
- my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
- $sth->execute($subscriptionid,$subscription->{startdate});
- my $res = $sth->fetchrow;
- # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
- if ($subscription->{numberlength}==$res) {
- return 1;
- } else {
- return 0;
- }
- } else {
- # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
- my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
- $sth->execute($subscriptionid);
- my $res = $sth->fetchrow;
- my $endofsubscriptiondate;
-my $duration;
- $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
- $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
-
- $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
- my $per = $subscription->{'periodicity'};
- my $x = 0;
- if ($per == 1) { $x = '1 days'; }
- if ($per == 2) { $x = '1 weeks'; }
- if ($per == 3) { $x = '2 weeks'; }
- if ($per == 4) { $x = '3 weeks'; }
- if ($per == 5) { $x = '1 months'; }
- if ($per == 6) { $x = '2 months'; }
- if ($per == 7 || $per == 8) { $x = '3 months'; }
- if ($per == 9) { $x = '6 months'; }
- if ($per == 10) { $x = '1 years'; }
- if ($per == 11) { $x = '2 years'; }
- my $duration=get_duration("-".$x) ;
- my $datebeforeend = DATE_Add_Duration($endofsubscriptiondate,$duration); # if ($subscription->{weeklength});
- # warn "DATE BEFORE END: $datebeforeend";
- return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
- return 0;
- }
+
+ #save subscription
+ my $sth = $dbh->prepare(
+"insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
+ startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
+ add1,every1,whenmorethan1,setto1,lastvalue1,
+ add2,every2,whenmorethan2,setto2,lastvalue2,
+ add3,every3,whenmorethan3,setto3,lastvalue3,
+ numberingmethod, status, callnumber, notes, hemisphere) values
+ (?,?,?,?,?,?,?,?,?,?,?,
+ ?,?,?,?,?,?,?,?,?,?,?,
+ ?,?,?,?,?,?,?,?,?,?,?,?)"
+ );
+ $sth->execute(
+ $auser, $aqbooksellerid,
+ $cost, $aqbudgetid,
+ $biblionumber, format_date_in_iso($startdate),
+ $periodicity, format_date_in_iso($firstacquidate),
+ $dow, $irregularity,
+ $numberpattern, $numberlength,
+ $weeklength, $monthlength,
+ $add1, $every1,
+ $whenmorethan1, $setto1,
+ $lastvalue1, $add2,
+ $every2, $whenmorethan2,
+ $setto2, $lastvalue2,
+ $add3, $every3,
+ $whenmorethan3, $setto3,
+ $lastvalue3, $numberingmethod,
+ $status, $callnumber,
+ $notes, $hemisphere
+ );
+
+ #then create the 1st waited number
+ my $subscriptionid = $dbh->{'mysql_insertid'};
+ my $enddate = GetExpirationDate($subscriptionid);
+
+ $sth =
+ $dbh->prepare(
+"insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
+ );
+ $sth->execute(
+ $biblionumber, $subscriptionid,
+ format_date_in_iso($startdate),
+ format_date_in_iso($enddate),
+ "", "", "", $notes
+ );
+
+ # reread subscription to get a hash (for calculation of the 1st issue number)
+ $sth =
+ $dbh->prepare("select * from subscription where subscriptionid = ? ");
+ $sth->execute($subscriptionid);
+ my $val = $sth->fetchrow_hashref;
+
+ # calculate issue number
+ my $serialseq = GetSeq($val);
+ $sth =
+ $dbh->prepare(
+"insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
+ );
+ $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
+ 1, format_date_in_iso($startdate) );
+ return $subscriptionid;
}
+=head2 old_modsubscription
+=over 4
-=head2 GetNextDate
+($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
+ $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
+ $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
+ $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
+ $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
+ $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
+
+this function is similar to the ModSubscription subroutine but has a few different
+values passed in
+$firstacquidate - date of first serial issue to arrive
+$irregularity - the issues not expected separated by a '|'
+- eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
+$numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
+ subscription-add.tmpl file
+$callnumber - display the callnumber of the serial
+$hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
+
+=back
+
+=cut
+
+sub old_modsubscription {
+ my (
+ $auser, $aqbooksellerid, $cost, $aqbudgetid,
+ $startdate, $periodicity, $firstacquidate, $dow,
+ $irregularity, $numberpattern, $numberlength, $weeklength,
+ $monthlength, $add1, $every1, $whenmorethan1,
+ $setto1, $lastvalue1, $innerloop1, $add2,
+ $every2, $whenmorethan2, $setto2, $lastvalue2,
+ $innerloop2, $add3, $every3, $whenmorethan3,
+ $setto3, $lastvalue3, $innerloop3, $numberingmethod,
+ $status, $biblionumber, $callnumber, $notes,
+ $hemisphere, $subscriptionid
+ ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+"update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
+ periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
+ add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
+ add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
+ add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
+ numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
+ );
+ $sth->execute(
+ $auser, $aqbooksellerid, $cost, $aqbudgetid,
+ $startdate, $periodicity, $firstacquidate, $dow,
+ $irregularity, $numberpattern, $numberlength, $weeklength,
+ $monthlength, $add1, $every1, $whenmorethan1,
+ $setto1, $lastvalue1, $innerloop1, $add2,
+ $every2, $whenmorethan2, $setto2, $lastvalue2,
+ $innerloop2, $add3, $every3, $whenmorethan3,
+ $setto3, $lastvalue3, $innerloop3, $numberingmethod,
+ $status, $biblionumber, $callnumber, $notes,
+ $hemisphere, $subscriptionid
+ );
+ $sth->finish;
+
+ $sth =
+ $dbh->prepare("select * from subscription where subscriptionid = ? ");
+ $sth->execute($subscriptionid);
+ my $val = $sth->fetchrow_hashref;
+
+ # calculate issue number
+ my $serialseq = Get_Seq($val);
+ $sth =
+ $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
+ $sth->execute( $serialseq, $subscriptionid );
+
+ my $enddate = subscriptionexpirationdate($subscriptionid);
+ $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
+ $sth->execute( format_date_in_iso($enddate) );
+}
+
+=head2 old_getserials
=over 4
+($totalissues,@serials) = &old_getserials($subscriptionid)
+
+this function get a hashref of serials and the total count of them
+
+return :
+$totalissues - number of serial lines
+the serials into a table. Each line of this table containts a ref to a hash which it containts
+serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
+
+=back
+
+=cut
+
+sub old_getserials {
+ my ($subscriptionid) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # status = 2 is "arrived"
+ my $sth =
+ $dbh->prepare(
+"select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
+ );
+ $sth->execute($subscriptionid);
+ my @serials;
+ my $num = 1;
+ while ( my $line = $sth->fetchrow_hashref ) {
+ $line->{ "status" . $line->{status} } =
+ 1; # fills a "statusX" value, used for template status select list
+ $line->{"planneddate"} = format_date( $line->{"planneddate"} );
+ $line->{"num"} = $num;
+ $num++;
+ push @serials, $line;
+ }
+ $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
+ $sth->execute($subscriptionid);
+ my ($totalissues) = $sth->fetchrow;
+ return ( $totalissues, @serials );
+}
+
+=head2 GetNextDate
+
($resultdate) = &GetNextDate($planneddate,$subscription)
-this function takes the planneddate and will return the next issue's date and will skip dates if there
+this function is an extension of GetNextDate which allows for checking for irregularity
+
+it takes the planneddate and will return the next issue's date and will skip dates if there
exists an irregularity
- eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
skipped then the returned date will be 2007-05-10
return :
$resultdate - then next date in the sequence
-=back
+FIXME : have to replace Date::Manip by Date::Calc in this function to improve performances.
=cut
-sub GetNextDate {
- my ($planneddate,$subscription) = @_;
- my @irreg = split(/\|/,$subscription->{irregularity});
- my $dateobj=DATE_obj($planneddate);
- my $dayofweek = $dateobj->day_of_week;
- my $month=$dateobj->month;
- my $resultdate;
-
- if ($subscription->{periodicity} == 1) {
- my %irreghash;
- for(my $i=0;$i<@irreg;$i++){
- $irreghash{$irreg[$i]}=1;
- }
-my $duration=get_duration("1 days");
- for(my $i=0;$i<@irreg;$i++){
- if($dayofweek == 7){ $dayofweek = 0; }
-
- if($irreghash{$dayofweek+1}){
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $dayofweek++;
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+sub in_array { # used in next sub down
+ my ($val,@elements) = @_;
+ foreach my $elem(@elements) {
+ if($val == $elem) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+sub GetNextDate(@) {
+ my ( $planneddate, $subscription ) = @_;
+ my @irreg = split( /\,/, $subscription->{irregularity} );
+
+ #date supposed to be in ISO.
+
+ my ( $year, $month, $day ) = split(/-/, $planneddate);
+ $month=1 unless ($month);
+ $day=1 unless ($day);
+ my @resultdate;
+
+ # warn "DOW $dayofweek";
+ if ( $subscription->{periodicity} == 1 ) {
+ my $dayofweek = Day_of_Week( $year,$month, $day );
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ $dayofweek = 0 if ( $dayofweek == 7 );
+ if ( in_array( ($dayofweek + 1), @irreg ) ) {
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
+ $dayofweek++;
+ }
+ }
+ @resultdate = Add_Delta_Days($year,$month, $day , 1 );
+ }
+ if ( $subscription->{periodicity} == 2 ) {
+ my ($wkno,$year) = Week_of_Year( $year,$month, $day );
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
+ $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
+ }
+ }
+ @resultdate = Add_Delta_Days( $year,$month, $day, 7);
}
- if ($subscription->{periodicity} == 2) {
- my $wkno = $dateobj->week_number;
-my $duration=get_duration("1 weeks");
- for(my $i = 0;$i < @irreg; $i++){
- if($wkno > 52) { $wkno = 0; } # need to rollover at January
- if($irreg[$i] == ($wkno+1)){
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $wkno++;
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 3 ) {
+ my ($wkno,$year) = Week_of_Year( $year,$month, $day );
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
+ ### BUGFIX was previously +1 ^
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
+ $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
+ }
+ }
+ @resultdate = Add_Delta_Days($year,$month, $day , 14 );
}
- if ($subscription->{periodicity} == 3) {
- my $wkno = $dateobj->week_number;
-my $duration=get_duration("2 weeks");
- for(my $i = 0;$i < @irreg; $i++){
- if($wkno > 52) { $wkno = 0; } # need to rollover at January
- if($irreg[$i] == ($wkno+1)){
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $wkno++;
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 4 ) {
+ my ($wkno,$year) = Week_of_Year( $year,$month, $day );
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
+ ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
+ $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
+ }
+ }
+ @resultdate = Add_Delta_Days($year,$month, $day , 21 );
}
- if ($subscription->{periodicity} == 4) {
- my $wkno = $dateobj->week_number;
-my $duration=get_duration("3 weeks");
- for(my $i = 0;$i < @irreg; $i++){
- if($wkno > 52) { $wkno = 0; } # need to rollover at January
- if($irreg[$i] == ($wkno+1)){
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $wkno++;
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ my $tmpmonth=$month;
+ if ( $subscription->{periodicity} == 5 ) {
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
+ ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
+ $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
+ }
+ }
+ @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
}
- if ($subscription->{periodicity} == 5) {
-my $duration=get_duration("1 months");
- for(my $i = 0;$i < @irreg; $i++){
- # warn $irreg[$i];
- # warn $month;
- if($month == 12) { $month = 0; } # need to rollover to check January
- if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $month++; # to check if following ones are to be skipped too
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 6 ) {
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
+ ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
+ $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
+ }
+ }
+ @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
}
- if ($subscription->{periodicity} == 6) {
-my $duration=get_duration("2 months");
- for(my $i = 0;$i < @irreg; $i++){
- # warn $irreg[$i];
- # warn $month;
- if($month == 12) { $month = 0; } # need to rollover to check January
- if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $month++; # to check if following ones are to be skipped too
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 7 ) {
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
+ ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
+ $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
+ }
+ }
+ @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
}
- if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8 ) {
-my $duration=get_duration("3 months");
- for(my $i = 0;$i < @irreg; $i++){
- # warn $irreg[$i];
- # warn $month;
- if($month == 12) { $month = 0; } # need to rollover to check January
- if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $month++; # to check if following ones are to be skipped too
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 8 ) {
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
+ ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
+ $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
+ }
+ }
+ @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
}
-
- if ($subscription->{periodicity} == 9) {
-my $duration=get_duration("6 months");
- for(my $i = 0;$i < @irreg; $i++){
- # warn $irreg[$i];
- # warn $month;
- if($month == 12) { $month = 0; } # need to rollover to check January
- if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
- $planneddate = DATE_Add_Duration($planneddate,$duration);
- $month++; # to check if following ones are to be skipped too
- }
- }
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 9 ) {
+ for ( my $i = 0 ; $i < @irreg ; $i++ ) {
+ if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
+ ### BUFIX Seems to need more Than One ?
+ ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
+ $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
+ }
+ }
+ @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
}
- if ($subscription->{periodicity} == 10) {
-my $duration=get_duration("1 years");
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 10 ) {
+ @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
}
- if ($subscription->{periodicity} == 11) {
- my $duration=get_duration("2 years");
- $resultdate=DATE_Add_Duration($planneddate,$duration);
+ if ( $subscription->{periodicity} == 11 ) {
+ @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
}
- # warn "date: ".$resultdate;
- return $resultdate;
+ my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
+# warn "dateNEXTSEQ : ".$resultdate;
+ return "$resultdate";
}
+=head2 itemdata
+
+ $item = &itemdata($barcode);
+
+Looks up the item with the given barcode, and returns a
+reference-to-hash containing information about that item. The keys of
+the hash are the fields from the C<items> and C<biblioitems> tables in
+the Koha database.
+
+=cut
+
+#'
+sub itemdata {
+ my ($barcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "Select * from items,biblioitems where barcode=?
+ and items.biblioitemnumber=biblioitems.biblioitemnumber"
+ );
+ $sth->execute($barcode);
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ($data);
+}
-
-END { } # module clean-up code here (global destructor)
+END { } # module clean-up code here (global destructor)
1;
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+=cut
package C4::Stats;
# $Id$
-# Modified by TG
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
use strict;
require Exporter;
-
+use DBI;
use C4::Context;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(&UpdateStats &statsreport &TotalOwing
-&TotalPaid &getcharges &Getpaidbranch &unfilledreserves &getcredits &getinvoices);
+ &TotalPaid &getcharges &Getpaidbranch &unfilledreserves &getcredits
+ getrefunds);
=item UpdateStats
C<$env-E<gt>{usercode}> specifies the value of the C<usercode> field.
=cut
+
#'
sub UpdateStats {
- #module to insert stats data into stats table
- my ($env,$branch,$type,$amount,$other,$itemnum,$itemtype,$borrowernumber,$accountno)=@_;
- my $dbh = C4::Context->dbh;
- $env=C4::Context->userenv unless $env;
- if ($branch eq ''){
- $branch=$env->{'branchcode'};
- }
- my $user = C4::Context->userenv;
-# print $borrowernumber;
- my $userid=$user->{'cardnumber'} if $user;
- # FIXME - Use $dbh->do() instead
- my $sth=$dbh->prepare("Insert into statistics (datetime,branch,type,usercode,value,
- other,itemnumber,itemtype,borrowernumber,proccode) values (now(),?,?,?,?,?,?,?,?,?)");
- $sth->execute($branch,$type,$userid,$amount,$other,$itemnum,$itemtype,$borrowernumber,$accountno);
- $sth->finish;
+
+ #module to insert stats data into stats table
+ my (
+ $env, $branch, $type,
+ $amount, $other, $itemnum,
+ $itemtype, $borrowernumber, $accountno
+ )
+ = @_;
+ my $dbh = C4::Context->dbh;
+ if ( $branch eq '' ) {
+ $branch = $env->{'branchcode'};
+ }
+ my $user = $env->{'usercode'};
+ my $organisation = $env->{'organisation'};
+
+ # FIXME - Use $dbh->do() instead
+ my $sth = $dbh->prepare(
+ "Insert into statistics (datetime,branch,type,usercode,value,
+ other,itemnumber,itemtype,borrowernumber,proccode,associatedborrower) values (now(),?,?,?,?,?,?,?,?,?,?)"
+ );
+ $sth->execute(
+ $branch, $type, $user, $amount,
+ $other, $itemnum, $itemtype, $borrowernumber,
+ $accountno, $organisation
+ );
+ $sth->finish;
}
# Otherwise, it'd need a POD.
sub TotalPaid {
- my ($time,$time2)=@_;
- $time2=$time unless $time2;
- my $dbh = C4::Context->dbh;
-
-
- my $query="Select * from accountlines,borrowers where (accounttype = 'Pay' or accounttype='W')
- and accountlines.borrowernumber = borrowers.borrowernumber";
- my @bind = ();
- if ($time eq 'today'){
- $query .= " and date = now()";
- } else {
- $query.=" and date>=? and date<=?";
- @bind = ($time,$time2);
- }
-
-
-
-
- $query.=" order by timestamp";
-
- # print $query;
-
- my $sth=$dbh->prepare($query);
-
- # $sth->execute();
- $sth->execute(@bind);
- my @results;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $results[$i]=$data;
- $i++;
- }
- $sth->finish;
- # print $query;
- return(@results);
+ my ( $time, $time2, $spreadsheet ) = @_;
+ $time2 = $time unless $time2;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT * FROM statistics,borrowers
+ WHERE statistics.borrowernumber= borrowers.borrowernumber
+ AND (statistics.type='payment' OR statistics.type='writeoff') ";
+ if ( $time eq 'today' ) {
+ $query = $query . " AND datetime = now()";
+ }
+ else {
+ $query .= " AND datetime > '$time'";
+ }
+ if ( $time2 ne '' ) {
+ $query .= " AND datetime < '$time2'";
+ }
+ if ($spreadsheet) {
+ $query .= " ORDER BY branch, type";
+ }
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
+ }
+ $sth->finish;
+ return (@results);
}
# Otherwise, it needs a POD.
-sub getcharges{
- my($borrowerno,$offset,$accountno)=@_;
- my $dbh = C4::Context->dbh;
- my $query="";
- my $sth;
-
- # getcharges is now taking accountno. as an argument
- if ($offset){
- $sth=$dbh->prepare("Select * from accountlines where borrowernumber=?
- and accountno = ? and amount>0");
- $sth->execute($borrowerno,$offset);
+sub getcharges {
+ my ( $borrowerno, $timestamp, $accountno ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $timestamp2 = $timestamp - 1;
+ my $query = "";
+ my $sth;
+
+ # getcharges is now taking accountno. as an argument
+ if ($accountno) {
+ $sth = $dbh->prepare(
+ "Select * from accountlines where borrowernumber=?
+ and accountno = ?"
+ );
+ $sth->execute( $borrowerno, $accountno );
# this bit left in for old 2 arg usage of getcharges
- } else {
- $sth=$dbh->prepare("Select * from accountlines where borrowernumber=?
- and accountno = ?");
- $sth->execute($borrowerno,$accountno);
- }
-
- # print $query,"<br>";
- my $i=0;
- my @results;
- while (my $data=$sth->fetchrow_hashref){
+ }
+ else {
+ $sth = $dbh->prepare(
+ "Select * from accountlines where borrowernumber=?
+ and timestamp = ? and accounttype <> 'Pay' and
+ accounttype <> 'W'"
+ );
+ $sth->execute( $borrowerno, $timestamp );
+ }
+
+ # print $query,"<br>";
+ my $i = 0;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+
# if ($data->{'timestamp'} == $timestamp){
- $results[$i]=$data;
- $i++;
+ $results[$i] = $data;
+ $i++;
+
# }
- }
- return(@results);
+ }
+ return (@results);
}
# Otherwise, it needs a POD.
-sub getcredits{
- my ($date,$date2)=@_;
- my $dbh = C4::Context->dbh;
-
-
-
- my $sth=$dbh->prepare("Select * from accountlines,borrowers where (( (accounttype <> 'Pay'))
+sub getcredits {
+ my ( $date, $date2 ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ #takes date converts to timestamps
+ my $padding = "000000";
+ ( my $a, my $b, my $c ) = unpack( "A4 x1 A2 x1 A2", $date );
+ ( my $x, my $y, my $z ) = unpack( "A4 x1 A2 x1 A2", $date2 );
+ my $timestamp = $a . $b . $c . $padding;
+ my $timestamp2 = $x . $y . $z . $padding;
+
+ my $sth = $dbh->prepare(
+"Select * from accountlines,borrowers where (((accounttype = 'LR') or (accounttype <> 'Pay'))
and amount < 0 and accountlines.borrowernumber = borrowers.borrowernumber
- and date >=? and date <=?)");
- $sth->execute($date, $date2);
-
- my $i=0;
- my @results;
- while (my $data=$sth->fetchrow_hashref){
- $results[$i]=$data;
- $i++;
- }
- return(@results);
+ and timestamp >=? and timestamp <?)"
+ );
+ $sth->execute( $timestamp, $timestamp2 );
+
+ my $i = 0;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
+ $i++;
+ }
+ return (@results);
}
-sub getinvoices{
- my ($date,$date2)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from accountlines,borrowers where amount>0 and amountoutstanding > 0 and accountlines.borrowernumber = borrowers.borrowernumber
- and (date >=? and date <=?)");
- $sth->execute($date, $date2);
-
- my $i=0;
- my @results;
- while (my $data=$sth->fetchrow_hashref){
- $results[$i]=$data;
- $i++;
- }
- return(@results);
+sub getrefunds {
+ my ( $date, $date2 ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ #takes date converts to timestamps
+ my $padding = "000000";
+ ( my $a, my $b, my $c ) = unpack( "A4 x1 A2 x1 A2", $date );
+ ( my $x, my $y, my $z ) = unpack( "A4 x1 A2 x1 A2", $date2 );
+ my $timestamp = $a . $b . $c . $padding;
+ my $timestamp2 = $x . $y . $z . $padding;
+
+ my $sth = $dbh->prepare(
+"Select * from accountlines,borrowers where (accounttype = 'REF'
+ and accountlines.borrowernumber = borrowers.borrowernumber
+ and timestamp >=? and timestamp <?)"
+ );
+ $sth->execute( $timestamp, $timestamp2 );
+
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
+ }
+ return (@results);
}
-
# Otherwise, this needs a POD.
-sub Getpaidbranch{
- my($date,$borrno)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from statistics where type='payment' and datetime >? and borrowernumber=?");
- $sth->execute($date,$borrno);
- # print $query;
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data->{'branch'});
+sub Getpaidbranch {
+ my ( $date, $borrno ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select * from statistics where type='payment' and datetime >? and borrowernumber=?"
+ );
+ $sth->execute( $date, $borrno );
+
+ # print $query;
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ( $data->{'branch'} );
}
# FIXME - This is only used in reservereport.pl and reservereport.xls,
# neither of which is used.
# Otherwise, it needs a POD.
sub unfilledreserves {
- my $dbh = C4::Context->dbh;
-
- my $i=0;
- my @results;
-
- my $sth=$dbh->prepare("select *,biblio.title from reserves,biblio,borrowers where (found <> '1' or found is NULL) and cancellationdate
- is NULL and biblio.biblionumber=reserves.biblionumber and
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+"select *,biblio.title from reserves,reserveconstraints,biblio,borrowers,biblioitems where (found <> 'F' or
+ found is NULL) and cancellationdate
+ is NULL and biblio.biblionumber=reserves.biblionumber and
+ reserves.constrainttype='o'
+ and (reserves.biblionumber=reserveconstraints.biblionumber
+ and reserves.borrowernumber=reserveconstraints.borrowernumber)
+ and
+ reserves.borrowernumber=borrowers.borrowernumber and
+ biblioitems.biblioitemnumber=reserveconstraints.biblioitemnumber order by
+ biblio.title,reserves.reservedate"
+ );
+ $sth->execute;
+ my $i = 0;
+ my @results;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ $sth = $dbh->prepare(
+"select *,biblio.title from reserves,biblio,borrowers where (found <> 'F' or found is NULL) and cancellationdate
+ is NULL and biblio.biblionumber=reserves.biblionumber and reserves.constrainttype='a' and
reserves.borrowernumber=borrowers.borrowernumber
order by
- reserves.reservedate,biblio.title");
- $sth->execute;
- while (my $data=$sth->fetchrow_hashref){
- $results[$i]=$data;
- $i++;
- }
- $sth->finish;
- return($i,\@results);
+ biblio.title,reserves.reservedate"
+ );
+ $sth->execute;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return ( $i, \@results );
}
1;
require Exporter;
use C4::Context;
use C4::Output;
+use C4::Date;
use Mail::Sendmail;
use vars qw($VERSION @ISA @EXPORT);
=head1 DESCRIPTION
-=over 4
-
The functions in this module deal with the suggestions in OPAC and in librarian interface
A suggestion is done in the OPAC. It has the status "ASKED"
All suggestions of a borrower can be seen by the borrower itself.
Suggestions done by other borrowers can be seen when not "AVAILABLE"
-=back
-
=head1 FUNCTIONS
=cut
&NewSuggestion
&SearchSuggestion
&GetSuggestion
+ &GetSuggestionByStatus
&DelSuggestion
&CountSuggestion
&ModStatus
=head2 SearchSuggestion
-=over 4
-
(\@array) = &SearchSuggestion($user,$author,$title,$publishercode,$status,$suggestedbyme)
searches for a suggestion
* in the status field
* as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
-=back
-
=cut
sub SearchSuggestion {
my ($user,$author,$title,$publishercode,$status,$suggestedbyme)=@_;
my $dbh = C4::Context->dbh;
- my $query = qq|
+ my $query = "
SELECT suggestions.*,
U1.surname AS surnamesuggestedby,
U1.firstname AS firstnamesuggestedby,
FROM suggestions
LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
- WHERE 1=1 |;
+ WHERE 1=1 ";
my @sql_params;
if ($author) {
push @sql_params,"%".$publishercode."%";
$query .= " and publishercode like ?";
}
- if ($status) {
- push @sql_params,$status;
- $query .= " and status=?";
- }
-
if (C4::Context->preference("IndependantBranches")) {
my $userenv = C4::Context->userenv;
if ($userenv) {
}
}
}
+ if ($status) {
+ push @sql_params,$status;
+ $query .= " and status=?";
+ }
if ($suggestedbyme) {
unless ($suggestedbyme eq -1) {
push @sql_params,$user;
=head2 GetSuggestion
-=over 4
-
\%sth = &GetSuggestion($suggestionid)
this function get the detail of the suggestion $suggestionid (input arg)
return :
the result of the SQL query as a hash : $sth->fetchrow_hashref.
-=back
-
=cut
+
sub GetSuggestion {
my ($suggestionid) = @_;
my $dbh = C4::Context->dbh;
- my $query = qq|
+ my $query = "
SELECT *
FROM suggestions
WHERE suggestionid=?
- |;
+ ";
my $sth = $dbh->prepare($query);
$sth->execute($suggestionid);
return($sth->fetchrow_hashref);
=head2 GetSuggestionFromBiblionumber
-=over 4
-
$suggestionid = &GetSuggestionFromBiblionumber($dbh,$biblionumber)
Get a suggestion from it's biblionumber.
return :
the id of the suggestion which is related to the biblionumber given on input args.
-=back
-
=cut
+
sub GetSuggestionFromBiblionumber {
my ($dbh,$biblionumber) = @_;
my $query = qq|
return $suggestionid;
}
+=head2 GetSuggestionByStatus
-=head2 CountSuggestion
+$suggestions = &GetSuggestionByStatus($status)
-=over 4
+Get a suggestion from it's status
+
+return :
+all the suggestion with C<$status>
+
+=cut
+
+sub GetSuggestionByStatus {
+ my $status = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT suggestions.*,
+ U1.surname AS surnamesuggestedby,
+ U1.firstname AS firstnamesuggestedby,
+ U2.surname AS surnamemanagedby,
+ U2.firstname AS firstnamemanagedby
+ FROM suggestions
+ LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
+ LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
+ WHERE status = ?
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($status);
+
+ my @results;
+ while(my $data = $sth->fetchrow_hashref){
+ $data->{date} = format_date($data->{date});
+ push @results,$data;
+ }
+ return \@results;
+}
+
+=head2 CountSuggestion
&CountSuggestion($status)
Count the number of suggestions with the status given on input argument.
the arg status can be :
-=over
-
-=over
+=over 2
=item * ASKED : asked by the user, not dealed by the librarian
=back
-=back
-
return :
the number of suggestion with this status.
-=back
-
=cut
+
sub CountSuggestion {
my ($status) = @_;
my $dbh = C4::Context->dbh;
=head2 NewSuggestion
-=over 4
-
&NewSuggestion($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber)
Insert a new suggestion on database with value given on input arg.
-=back
-
=cut
+
sub NewSuggestion {
- my ($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber) = @_;
+ my ($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber,$reason) = @_;
my $dbh = C4::Context->dbh;
-
my $query = qq |
INSERT INTO suggestions
(status,suggestedby,title,author,publishercode,note,copyrightdate,
- volumedesc,publicationyear,place,isbn,biblionumber)
- VALUES ('ASKED',?,?,?,?,?,?,?,?,?,?,?)
+ volumedesc,publicationyear,place,isbn,biblionumber,reason)
+ VALUES ('ASKED',?,?,?,?,?,?,?,?,?,?,?,?)
|;
my $sth = $dbh->prepare($query);
- $sth->execute($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber);
+ $sth->execute($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber,$reason);
}
=head2 ModStatus
-=over 4
-
&ModStatus($suggestionid,$status,$managedby,$biblionumber)
Modify the status (status can be 'ASKED', 'ACCEPTED', 'REJECTED', 'ORDERED')
Note that there is no function to modify a suggestion : only the status can be modified, thus the name of the function.
-=back
-
=cut
+
sub ModStatus {
- my ($suggestionid,$status,$managedby,$biblionumber,$input) = @_;
+ my ($suggestionid,$status,$managedby,$biblionumber,$reason) = @_;
my $dbh = C4::Context->dbh;
my $sth;
if ($managedby>0) {
if ($biblionumber) {
my $query = qq|
UPDATE suggestions
- SET status=?,managedby=?,biblionumber=?
+ SET status=?,managedby=?,biblionumber=?,reason=?
WHERE suggestionid=?
|;
$sth = $dbh->prepare($query);
- $sth->execute($status,$managedby,$biblionumber,$suggestionid);
+ $sth->execute($status,$managedby,$biblionumber,$reason,$suggestionid);
} else {
my $query = qq|
UPDATE suggestions
- SET status=?,managedby=?
+ SET status=?,managedby=?,reason=?
WHERE suggestionid=?
|;
$sth = $dbh->prepare($query);
- $sth->execute($status,$managedby,$suggestionid);
+ $sth->execute($status,$managedby,$reason,$suggestionid);
}
} else {
if ($biblionumber) {
my $query = qq|
UPDATE suggestions
- SET status=?,biblionumber=?
+ SET status=?,biblionumber=?,reason=?
WHERE suggestionid=?
|;
$sth = $dbh->prepare($query);
- $sth->execute($status,$biblionumber,$suggestionid);
+ $sth->execute($status,$biblionumber,$reason,$suggestionid);
}
else {
my $query = qq|
UPDATE suggestions
- SET status=?
+ SET status=?,reason=?
WHERE suggestionid=?
|;
$sth = $dbh->prepare($query);
- $sth->execute($status,$suggestionid);
+ $sth->execute($status,$reason,$suggestionid);
}
}
# check mail sending.
- my $queryMail = qq|
+ my $queryMail = "
SELECT suggestions.*,
boby.surname AS bysurname,
boby.firstname AS byfirstname,
- boby.emailaddress AS byemail,
+ boby.email AS byemail,
lib.surname AS libsurname,
lib.firstname AS libfirstname,
- lib.emailaddress AS libemail
+ lib.email AS libemail
FROM suggestions
LEFT JOIN borrowers AS boby ON boby.borrowernumber=suggestedby
LEFT JOIN borrowers AS lib ON lib.borrowernumber=managedby
WHERE suggestionid=?
- |;
+ ";
$sth = $dbh->prepare($queryMail);
$sth->execute($suggestionid);
my $emailinfo = $sth->fetchrow_hashref;
-if ($emailinfo->{byemail}){
- my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet",$input);
+ my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet");
$template->param(
byemail => $emailinfo->{byemail},
libfirstname => $emailinfo->{libfirstname},
byfirstname => $emailinfo->{byfirstname},
bysurname => $emailinfo->{bysurname},
+ reason => $emailinfo->{reason}
);
my %mail = (
To => $emailinfo->{byemail},
);
sendmail(%mail);
}
-}
=head2 ConnectSuggestionAndBiblio
-=over 4
&ConnectSuggestionAndBiblio($suggestionid,$biblionumber)
connect a suggestion to an existing biblio
-=back
-
=cut
+
sub ConnectSuggestionAndBiblio {
my ($suggestionid,$biblionumber) = @_;
my $dbh=C4::Context->dbh;
- my $query = qq |
+ my $query = "
UPDATE suggestions
SET biblionumber=?
WHERE suggestionid=?
- |;
+ ";
my $sth = $dbh->prepare($query);
$sth->execute($biblionumber,$suggestionid);
}
=head2 DelSuggestion
-=over 4
-
&DelSuggestion($borrowernumber,$suggestionid)
Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
-=back
-
=cut
sub DelSuggestion {
my ($borrowernumber,$suggestionid) = @_;
my $dbh = C4::Context->dbh;
# check that the suggestion comes from the suggestor
- my $query = qq |
+ my $query = "
SELECT suggestedby
FROM suggestions
WHERE suggestionid=?
- |;
+ ";
my $sth = $dbh->prepare($query);
$sth->execute($suggestionid);
my ($suggestedby) = $sth->fetchrow;
if ($suggestedby eq $borrowernumber) {
- my $queryDelete = qq|
+ my $queryDelete = "
DELETE FROM suggestions
WHERE suggestionid=?
- |;
+ ";
$sth = $dbh->prepare($queryDelete);
$sth->execute($suggestionid);
}
-}
\ No newline at end of file
+}
+
+1;
+__END__
+
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
+
+=cut
+
use strict;
# standard or CPAN modules used
+use DBI;
# Koha modules used
-use C4::Context;
use C4::Input;
use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
#--------------------------------------
# $Log$
-# Revision 1.13 2006/09/06 16:21:03 tgarip1957
-# Clean up before final commits
+# Revision 1.14 2007/03/09 14:31:47 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.10.10.1 2006/12/22 15:09:54 toins
+# removing C4::Database;
#
# Revision 1.10 2003/10/01 15:08:14 tipaul
# fix fog bug #622 : processz3950queue fails
=item C<ecost>
-=item C<gst>
+=item C<GST>
=item C<budget>
use strict;
use CGI;
use C4::Auth;
+use C4::Output;
use C4::Acquisition;
use C4::Suggestions;
use C4::Biblio;
+use C4::Output;
use C4::Interface::CGI::Output;
+
+
+#use Date::Manip;
+
my $input = new CGI;
+
# get_template_and_user used only to check auth & get user id
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
}
);
-
# get CGI parameters
my $ordnum = $input->param('ordnum');
my $basketno = $input->param('basketno');
my $quantity = $input->param('quantity');
my $listprice = $input->param('list_price');
my $branch = $input->param('branch');
-my $discount=$input->param('discount');
if ( $listprice eq '' ) {
$listprice = 0;
}
my $series = $input->param('series');
my $notes = $input->param('notes');
-my $bookfundid = $input->param('bookfundid');
+my $bookfund = $input->param('bookfund');
my $sort1 = $input->param('sort1');
my $sort2 = $input->param('sort2');
my $rrp = $input->param('rrp');
my $ecost = $input->param('ecost');
-my $gst = $input->param('gstrate');
+my $gst = $input->param('GST');
my $budget = $input->param('budget');
-my $unitprice = $input->param('unitprice');
+my $cost = $input->param('cost');
my $sub = $input->param('sub');
-my $purchaseordernumber = $input->param('purchaseordernumber');
+my $invoice = $input->param('invoice');
my $publishercode = $input->param('publishercode');
my $suggestionid = $input->param('suggestionid');
-my $donation = $input->param('donation');
my $user = $input->remote_user;
-my $biblionumber=$input->param('biblionumber');
+
+#warn "CREATEBIBITEM = $input->param('createbibitem')";
+#warn Dumper $input->param('createbibitem');
my $createbibitem = $input->param('createbibitem');
# create, modify or delete biblio
# create if $quantity>=0 and $existing='no'
# modify if $quantity>=0 and $existing='yes'
# delete if $quantity has been se to 0 by the librarian
-my $dbh=C4::Context->dbh;
-
-if ($quantity ne '0'){
+my $biblionumber=$input->param('biblionumber');
+my $bibitemnum;
+if ( $quantity ne '0' ) {
#check to see if biblio exists
if ( $existing eq 'no' ) {
- #if it doesnt its created on template
- # change suggestion status if applicable
- if ($suggestionid) {
-my $data=GetSuggestion($suggestionid);
- my $biblio={title=>$data->{title},author=>$data->{author},publishercode=>$data->{publishercode},copyrightdate=>$data->{copyrightdate},isbn=>$data->{isbn},place=>$data->{place},};
-my $xmlhash=XMLkoha2marc($dbh,$biblio,"biblios");
-$biblionumber = NEWnewbiblio($dbh,$xmlhash,"");
+ #if it doesnt create it
+ my $record = Koha2Marc(
+ {
+ "biblio.title" => "$title",
+ "biblio.author" => "$author",
+ "biblio.copyrightdate" => $copyrightdate ? $copyrightdate : "",
+ "biblio.series" => $series ? $series : "",
+ "biblioitems.itemtype" => $itemtype ? $itemtype : "",
+ "biblioitems.isbn" => $isbn ? $isbn : "",
+ "biblioitems.publishercode" => $publishercode ? $publishercode : "",
+ });
+ # create the record in catalogue, with framework ''
+ ($biblionumber,$bibitemnum) = AddBiblio($record,'');
- ModStatus( $suggestionid, 'ORDERED', '', $biblionumber,$input );
+ # change suggestion status if applicable
+ if ($suggestionid) {
+ ModStatus( $suggestionid, 'ORDERED', '', $biblionumber );
}
- }## biblio didnot exist now created
-
-
-
-
+ }
+ # if we already have $ordnum, then it's an ordermodif
if ($ordnum) {
-
- # warn "MODORDER $title / $ordnum / $quantity / $bookfund";
ModOrder(
$title, $ordnum, $quantity, $listprice,
$biblionumber, $basketno, $booksellerid, $loggedinuser,
- $notes, $bookfundid, $rrp,
- $ecost, $gst, $budget, $unitprice,
- $purchaseordernumber, $sort1, $sort2,$discount,$branch
+ $notes, $bookfund, $bibitemnum, $rrp,
+ $ecost, $gst, $budget, $cost,
+ $invoice, $sort1, $sort2
);
}
- else {
+ else { # else, it's a new line
( $basketno, $ordnum ) = NewOrder(
$basketno, $biblionumber, $title, $quantity,
$listprice, $booksellerid, $loggedinuser, $notes,
- $bookfundid, $rrp, $ecost,
- $gst, $budget, $unitprice, $sub,
- $purchaseordernumber, $sort1, $sort2, $discount,$branch
+ $bookfund, $bibitemnum, $rrp, $ecost,
+ $gst, $budget, $cost, $sub,
+ $invoice, $sort1, $sort2
);
}
-
}
-else {
-# $biblionumber = $input->param('biblionumber');
- DelOrder( $biblionumber, $ordnum,$loggedinuser );
+else { # qty=0, delete the line
+ $biblionumber = $input->param('biblionumber');
+ DelOrder( $biblionumber, $ordnum );
}
-
print $input->redirect("basket.pl?basketno=$basketno");
use strict;
use C4::Auth;
use C4::Koha;
+use C4::Output;
use CGI;
use C4::Interface::CGI::Output;
+
+
use C4::Acquisition;
use C4::Bookfund;
use C4::Bookseller;
);
my $basket = GetBasket($basketno);
-$basket->{authorisedbyname};
+
# FIXME : the query->param('supplierid') below is probably useless. The bookseller is always known from the basket
# if no booksellerid in parameter, get it from basket
+# warn "=>".$basket->{booksellerid};
$booksellerid = $basket->{booksellerid} unless $booksellerid;
my @booksellers = GetBookSeller($booksellerid);
my $count2 = scalar @booksellers;
my ( $count, @results );
@results = GetOrders( $basketno, $order );
$count = scalar @results;
+
my $line_total; # total of each line
-my $gist =C4::Context->preference('gist'); # GST
+my $sub_total; # total of line totals
+my $gist; # GST
+my $grand_total; # $subttotal + $gist
my $toggle = 0;
+
# my $line_total_est; # total of each line
my $sub_total_est; # total of line totals
my $gist_est; # GST
-my $grand_total_est; # $subttotal + $gist_est - $disc_est
-my $disc_est;
+my $grand_total_est; # $subttotal + $gist
+
my $qty_total;
my @books_loop;
for ( my $i = 0 ; $i < $count ; $i++ ) {
- $line_total = $results[$i]->{'quantity'} * $results[$i]->{'rrp'};
- $sub_total_est += $line_total ;
- $disc_est +=$line_total *$results[$i]->{'discount'}/100;
- $gist_est +=($line_total - ($line_total *$results[$i]->{'discount'}/100))*$results[$i]->{'gst'}/100;
-
-
+ my $rrp = $results[$i]->{'listprice'};
+ $rrp = ConvertCurrency( $results[$i]->{'currency'}, $rrp );
+
+ $sub_total_est += $results[$i]->{'quantity'} * $results[$i]->{'rrp'};
+ $line_total = $results[$i]->{'quantity'} * $results[$i]->{'ecost'};
+ $sub_total += $line_total;
$qty_total += $results[$i]->{'quantity'};
my %line;
+ %line=%{$results[$i]};
if ( $toggle == 0 ) {
$line{color} = '#EEEEEE';
$toggle = 1;
$line{color} = 'white';
$toggle = 0;
}
- $line{ordernumber} = $results[$i]->{'ordernumber'};
- $line{publishercode} = $results[$i]->{'publishercode'};
- $line{isbn} = $results[$i]->{'isbn'};
- $line{booksellerid} = $booksellers[0]->{'id'};
$line{basketno} = $basketno;
- $line{title} = $results[$i]->{'title'};
- $line{notes} = $results[$i]->{'notes'};
- $line{author} = $results[$i]->{'author'};
$line{i} = $i;
- $line{rrp} = sprintf( "%.2f", $results[$i]->{'rrp'} );
- $line{ecost} = sprintf( "%.2f", $results[$i]->{'ecost'} );
- $line{discount} = sprintf( "%.2f", $results[$i]->{'discount'} );
- $line{quantity} = $results[$i]->{'quantity'};
- $line{quantityrecieved} = $results[$i]->{'quantityreceived'};
+ $line{rrp} = sprintf( "%.2f", $line{'rrp'} );
+ $line{ecost} = sprintf( "%.2f", $line{'ecost'} );
$line{line_total} = sprintf( "%.2f", $line_total );
- $line{biblionumber} = $results[$i]->{'biblionumber'};
- $line{bookfundid} = $results[$i]->{'bookfundid'};
$line{odd} = $i % 2;
-if ($line{quantityrecieved}>0){$line{donotdelete}=1;}
push @books_loop, \%line;
-$template->param(purchaseordernumber => $results[0]->{'purchaseordernumber'},
- booksellerinvoicenumber=>$results[0]->{booksellerinvoicenumber},);
}
-$grand_total_est = sprintf( "%.2f", $sub_total_est - $disc_est+$gist_est );
-
+my $prefgist = C4::Context->preference("gist");
+$gist = sprintf( "%.2f", $sub_total * $prefgist );
+$grand_total = $sub_total + $gist;
+$grand_total_est =
+ $sub_total_est + sprintf( "%.2f", $sub_total_est * $prefgist );
+$gist_est = sprintf( "%.2f", $sub_total_est * $prefgist );
$template->param(
basketno => $basketno,
creationdate => format_date( $basket->{creationdate} ),
entrydate => format_date( $results[0]->{'entrydate'} ),
books_loop => \@books_loop,
count => $count,
+ sub_total => $sub_total,
gist => $gist,
- sub_total_est => sprintf( "%.2f",$sub_total_est),
- gist_est => sprintf( "%.2f",$gist_est),
- disc_est => sprintf( "%.2f",$disc_est),
+ grand_total => $grand_total,
+ sub_total_est => $sub_total_est,
+ gist_est => $gist_est,
grand_total_est => $grand_total_est,
currency => $booksellers[0]->{'listprice'},
qty_total => $qty_total,
-#!/usr/bin/perl -w
+#!/usr/bin/perl
# Copyright 2006 Katipo Communications
#
ON aqorderbreakdown.ordernumber = aqorders.ordernumber
INNER JOIN aqbasket
ON aqbasket.basketno = aqorders.basketno
- LEFT JOIN biblio
- ON biblio.biblionumber = aqorders.biblionumber
+ LEFT JOIN biblioitems
+ ON biblioitems.biblioitemnumber = aqorders.biblioitemnumber
WHERE bookfundid = ?
AND budgetdate >= ?
AND budgetdate < ?
AND (datecancellationprinted IS NULL
OR datecancellationprinted = \'0000-00-00\')
';
-##warn $query;
my $sth = $dbh->prepare($query);
$sth->execute( $bookfund, $start, $end );
my @commited_loop;
total => $total
);
$sth->finish;
-#$dbh->disconnect;
+$dbh->disconnect;
output_html_with_http_headers $input, $cookie, $template->output;
use strict;
use C4::Auth;
+use C4::Biblio;
+use C4::Output;
use CGI;
use C4::Interface::CGI::Output;
+
+
use C4::Acquisition;
use C4::Date;
use C4::Bookseller;
# check if we have to "close" a basket before building page
my $op = $query->param('op');
-my $basketno = $query->param('basketno');
+my $basket = $query->param('basketno');
if ( $op eq 'close' ) {
- CloseBasket($basketno);
+ CloseBasket($basket);
}
#build result page
my $toggle = 0;
- my $ordcount;
my @loop_suppliers;
for ( my $i = 0 ; $i < $count ; $i++ ) {
- my $orders = GetPendingOrders( $suppliers[$i]->{'id'} );
- my $ordercount = scalar @$orders;
-$ordcount+=$ordercount;
+ my $orders = GetPendingOrders( $suppliers[$i]->{'id'}, "grouped" );
+ my $ordcount = scalar @$orders;
my %line;
if ( $toggle == 0 ) {
$line{even} = 1;
$toggle = 1;
- }
- else {
+ } else {
$line{even} = 0;
$toggle = 0;
}
$line{supplierid} = $suppliers[$i]->{'id'};
$line{name} = $suppliers[$i]->{'name'};
$line{active} = $suppliers[$i]->{'active'};
- $line{ordcount}=$ordercount;
my @loop_basket;
- foreach my $order(@$orders){
- push @loop_basket, $order;
+ for ( my $i2 = 0 ; $i2 < $ordcount ; $i2++ ) {
+ my %inner_line;
+ $inner_line{basketno} = $orders->[$i2]{'basketno'};
+ $inner_line{total} = $orders->[$i2]{'count(*)'};
+ $inner_line{authorisedby} = $orders->[$i2]{'authorisedby'};
+ $inner_line{surname} = $orders->[$i2]{'firstname'};
+ $inner_line{firstname} = $orders->[$i2]{'surname'};
+ $inner_line{creationdate} = format_date( $orders->[$i2]{'creationdate'} );
+ $inner_line{closedate} = format_date( $orders->[$i2]{'closedate'} );
+ push @loop_basket, \%inner_line;
}
$line{loop_basket} = \@loop_basket;
push @loop_suppliers, \%line;
$template->param(
loop_suppliers => \@loop_suppliers,
supplier => $supplier,
- count => $ordcount,
+ count => $count,
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
foreach my $param (@params){
if ($param ne 'type' && $param !~ /submit/){
my $data=$input->param($param);
-# warn "$data / $param";
ModCurrencies($param,$data);
}
}
#script to add a new item and to mark orders as received
#written 1/3/00 by chris@katipo.co.nz
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# this script makes the items, addorder.pl has already made the biblio and biblioitem records: MASON
-
-
-=head1 NAME
-
-finishreceive.pl
-
-=head1 DESCRIPTION
-TODO
-
-=head1 CGI PARAMETERS
-
-=over 4
-
-TODO
-
-=back
-
-=cut
-
use strict;
+use C4::Output;
use C4::Acquisition;
+use C4::Biblio;
use CGI;
-use C4::Interface::CGI::Output;
-use C4::Auth;
-use C4::Bookseller;
-
-my $input = new CGI;
-
-my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
- {
- template_name => "acqui/finishreceive.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => { editcatalogue => 1 },
- debug => 1,
- }
-);
-
-my @biblionumber = $input->param('biblionumber');
-my @ordnum = $input->param('ordernumber');
-my $cost = $input->param('invoicetotal');
-my $locacost = $input->param('localtotal');
-my $invoiceno = $input->param('invoice');
-my @replacement = $input->param('actual');
-my @gst = $input->param('gstrate');
-my $freight = $input->param('actualfreight');
-my @freightperitem = $input->param('freight');
-my $supplierid = $input->param('supplierid');
-my @title = $input->param('title');
-my $currencyrate=$input->param('currencyrate');
-my @bookfund = $input->param('bookfund');
-my @discount = $input->param('discount');
-my @quantrec = $input->param('received');
-my $totalreceived=$input->param('totalreceived');
-my $incgst=$input->param('incgst');
-my $ecost;
-my $unitprice;
-my $listprice;
-
-my @supplier=GetBookSeller($supplierid);
-my $count=scalar @quantrec;
-my @additems;
-
- for (my $i=0; $i<$count;$i++){
- $freightperitem[$i]=$freight/$totalreceived unless $freightperitem[$i];
-$listprice=$replacement[$i];
- $replacement[$i]= $replacement[$i]*$currencyrate;
- if ($incgst){
- $ecost= ($replacement[$i]*100/($gst[$i]+100))*(100 - $discount[$i])/100;
- }else{
- $ecost= $replacement[$i]*(100 - $discount[$i])/100;
- }
-$unitprice=$ecost + $ecost*$gst[$i]/100;
- if ( $quantrec[$i] != 0 ) {
- # save the quantity recieved.
- ModReceiveOrder( $biblionumber[$i], $ordnum[$i], $quantrec[$i], $unitprice,
- $invoiceno, $freightperitem[$i], $replacement[$i] ,$listprice,$input );
- push @additems,{biblionumber=>$biblionumber[$i],itemcount=>$quantrec[$i], title=>$title[$i],supplier=>$supplier[0]->{name},rrp=>$replacement[$i],};
-
- }
+use C4::Search;
+
+my $input=new CGI;
+
+my $user=$input->remote_user;
+my $biblionumber = $input->param('biblionumber');
+my $biblioitemnumber=$input->param('biblioitemnumber');
+my $ordnum=$input->param('ordnum');
+my $quantrec=$input->param('quantityrec');
+my $quantity=$input->param('quantity');
+my $cost=$input->param('cost');
+my $invoiceno=$input->param('invoice');
+my $datereceived=$input->param('datereceived');
+my $replacement=$input->param('rrp');
+my $gst=$input->param('gst');
+my $freight=$input->param('freight');
+my $supplierid = $input->param('supplierid');
+my $branch=$input->param('branch');
+
+# if ($quantrec != 0){
+# $cost /= $quantrec;
+# }
+
+if ($quantity != 0) {
+ # save the quantity recieved.
+ $datereceived = ModReceiveOrder($biblionumber,$ordnum,$quantrec,$user,$cost,$invoiceno,$datereceived,$freight,$replacement);
+ # create items if the user has entered barcodes
+ my $barcode=$input->param('barcode');
+ my @barcodes=split(/\,| |\|/,$barcode);
+ my ($error) = newitems({ biblioitemnumber => $biblioitemnumber,
+ biblionumber => $biblionumber,
+ replacementprice => $replacement,
+ price => $cost,
+ booksellerid => $supplierid,
+ homebranch => $branch,
+ loan => 0 },
+ @barcodes);
+ print $input->redirect("/cgi-bin/koha/acqui/parcel.pl?invoice=$invoiceno&supplierid=$supplierid&freight=$freight&gst=$gst&datereceived=$datereceived");
+} else {
+ print $input->header;
+ delorder($biblionumber,$ordnum);
+ print $input->redirect("/acquisitions/");
}
-$template->param(loopbiblios => \@additems,);
-
- output_html_with_http_headers $input, $cookie, $template->output;
\ No newline at end of file
# $Id$
-
=head1 NAME
histsearch.pl
=head1 DESCRIPTION
-this script offer a interface to search among order.
+this script offer a interface to search among order.
=head1 CGI PARAMETERS
use strict;
require Exporter;
use CGI;
-use C4::Auth; # get_template_and_user
+use C4::Auth; # get_template_and_user
use C4::Interface::CGI::Output;
use C4::Acquisition;
-my $input = new CGI;
-my $title = $input->param('title');
-my $author = $input->param('author');
-my $name = $input->param('name');
+my $input = new CGI;
+my $title = $input->param('title');
+my $author = $input->param('author');
+my $name = $input->param('name');
my $from_placed_on = $input->param('fromplacedon');
-my $to_placed_on = $input->param('toplacedon');
+my $to_placed_on = $input->param('toplacedon');
my $dbh = C4::Context->dbh;
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "acqui/histsearch.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {acquisition => 1},
- debug => 1,
- });
-my ($order_loop,$total_qty,$total_price,$total_qtyreceived)= &GetHistory($title,$author,$name,$from_placed_on,$to_placed_on);
-$template->param(suggestions_loop => $order_loop,
- total_qty => $total_qty,
- total_qtyreceived => $total_qtyreceived,
- total_price => sprintf ("%.2f",$total_price),
- numresults => scalar(@$order_loop),
- title => $title,
- author => $author,
- name => $name,
- from_placed_on =>$from_placed_on,
- to_placed_on =>$to_placed_on,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "acqui/histsearch.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { acquisition => 1 },
+ debug => 1,
+ }
);
+
+my ( $order_loop, $total_qty, $total_price, $total_qtyreceived ) =
+ &GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
+
+$template->param(
+ suggestions_loop => $order_loop,
+ total_qty => $total_qty,
+ total_qtyreceived => $total_qtyreceived,
+ total_price => sprintf( "%.2f", $total_price ),
+ numresults => scalar(@$order_loop),
+ title => $title,
+ author => $author,
+ name => $name,
+ from_placed_on => $from_placed_on,
+ to_placed_on => $to_placed_on,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+
output_html_with_http_headers $input, $cookie, $template->output;
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Acquisition;
+use C4::Letters;
+use C4::Branch; # GetBranches
-my $query = new CGI;
+my $input = new CGI;
my ($template, $loggedinuser, $cookie)
= get_template_and_user(
{template_name => "acqui/lateorders.tmpl",
- query => $query,
+ query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {acquisition => 1},
debug => 1,
});
-my $supplierid = $query->param('supplierid');
-my $delay = $query->param('delay');
-my $branch = $query->param('branch');
+my $supplierid = $input->param('supplierid');
+my $delay = $input->param('delay');
+my $branch = $input->param('branch');
#default value for delay
$delay = 30 unless $delay;
$template->param(Supplier=>$supplierlist{$supplierid}) if ($supplierid);
-my $branches = GetBranches;
-
-my @branchloop;
-foreach my $thisbranch (sort keys %$branches) {
- my %row =(value => $thisbranch,
- branchname => $branches->{$thisbranch}->{'branchname'},
- );
- push @branchloop, \%row;
-}
-my $CGIbranch=CGI::scrolling_list( -name => 'branch',
- -values => \@branchloop,
- -labels => $branches,
- -size => 1,
- -tabindex=>'',
- -multiple => 0 );
-
my @lateorders = GetLateOrders($delay,$supplierid,$branch);
my $count = scalar @lateorders;
foreach my $lateorder (@lateorders){
$total+=$lateorder->{subtotal};
}
+
+my @letters;
+my $letters=GetLetters("claimacquisition");
+foreach (keys %$letters){
+ push @letters ,{code=>$_,name=>$letters->{$_}};
+}
+
+$template->param(letters=>\@letters) if (@letters);
+my $op=$input->param("op");
+if ($op eq "send_alert"){
+ my @ordernums=$input->param("claim_for");
+ SendAlerts('claimacquisition',\@ordernums,$input->param("letter_code"));
+}
+
$template->param(delay=>$delay) if ($delay);
$template->param(
- branchloop => \@branchloop,
CGIsupplier => $CGIsupplier,
lateorders => \@lateorders,
total=>$total,
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
);
-output_html_with_http_headers $query, $cookie, $template->output;
+output_html_with_http_headers $input, $cookie, $template->output;
use strict;
use CGI;
use C4::Context;
+use C4::Input;
+
use C4::Auth;
use C4::Bookfund;
use C4::Bookseller;
use C4::Acquisition;
use C4::Suggestions;
use C4::Biblio;
-use C4::Search;
+use C4::Output;
+use C4::Input;
use C4::Koha;
use C4::Interface::CGI::Output;
+use C4::Branch; # GetBranches
use C4::Members;
-use C4::Input;
-use C4::Date;
my $input = new CGI;
my $booksellerid = $input->param('booksellerid');
my $biblionumber = $input->param('biblionumber');
my $basketno = $input->param('basketno');
my $suggestionid = $input->param('suggestionid');
+# my $donation = $input->param('donation');
my $close = $input->param('close');
my $data;
my $new;
-
my $dbh = C4::Context->dbh;
+if ( $ordnum eq '' ) { # create order
+ $new = 'yes';
+
+ # $ordnum=newordernum;
+ if ( $biblionumber && !$suggestionid ) {
+ $data = GetBiblioData($biblionumber);
+ }
+
+# get suggestion fields if applicable. If it's a subscription renewal, then the biblio already exists
+# otherwise, retrieve suggestion information.
+ if ($suggestionid) {
+ if ($biblionumber) {
+ $data = GetBiblioData($biblionumber);
+ }
+ else {
+ $data = GetSuggestion($suggestionid);
+ }
+ }
+}
+else { #modify order
+ $data = GetOrder($ordnum);
+ $biblionumber = $data->{'biblionumber'};
+ #get basketno and suppleirno. too!
+ my $data2 = GetBasket( $data->{'basketno'} );
+ $basketno = $data2->{'basketno'};
+ $booksellerid = $data2->{'booksellerid'};
+}
+
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "acqui/neworderempty.tmpl",
debug => 1,
}
);
-my $me= C4::Context->userenv;
-my $homebranch=$me->{'branch'} ;
-my $branch;
-my $bookfundid;
-my $discount= $booksellers[0]->{'discount'};
-my $gstrate=C4::Context->preference('gist')*100;
-if ( $ordnum eq '' ) { # create order
- $new = 'yes';
- if ( $biblionumber ) {
- my $record=XMLgetbibliohash($dbh,$biblionumber);
- ###Error checking if a non existent biblionumber given manually
- if (!$record){
- print $input->redirect("/cgi-bin/koha/acqui/basket.pl?supplierid=$booksellerid");
- }
- $data = XMLmarc2koha_onerecord($dbh,$record,"biblios");
- }elsif($suggestionid){
- $data = GetSuggestion($suggestionid);
-
- if ( $data->{'title'} eq '' ) {
- $data->{'title'} = $title;
- $data->{'author'} = $author;
- $data->{'copyrightdate'} = $copyright;
- }
- }### if biblionumber
- if ($basketno){
- my $basket = GetBasket( $basketno);
- my @orders=GetOrders($basketno);
- if (@orders){
- $template->param(
- purchaseordernumber => $orders[0]->{purchaseordernumber}, );
- }
- $template->param(
- creationdate => format_date( $basket->{creationdate} ),
- authorisedbyname => $basket->{authorisedbyname},);
- }else{
-
- my $date = get_today();
- $template->param(
- creationdate => format_date($date),
- authorisedbyname => $loggedinuser,);
- }
-}else { #modify order
- $data = GetSingleOrder($ordnum);
- $biblionumber = $data->{'biblionumber'};
- #get basketno and suppleirno. too!
- my $data2 = GetBasket( $data->{'basketno'} );
- $basketno = $data->{'basketno'};
- $booksellerid = $data2->{'booksellerid'};
- $discount=$data->{'discount'};
- $gstrate=$data->{'gst'} ;
- $bookfundid =$data->{'bookfundid'};
- my $aqbookfund=GetBookFund($data->{'bookfundid'});
-$branch=$aqbookfund->{branchcode};
-$template->param(
- purchaseordernumber => $data->{purchaseordernumber},
- creationdate => format_date( $data2->{creationdate} ),
- authorisedbyname => $data2->{authorisedbyname},);
-
-}
-
-
-# get currencies (for exchange rates calcs if needed)
+# get currencies (for change rates calcs if needed)
my @rates = GetCurrencies();
-my $count = scalar @rates;
+$count = scalar @rates;
my @loop_currency = ();
for ( my $i = 0 ; $i < $count ; $i++ ) {
push @loop_currency, \%line;
}
+# build itemtype list
+my $itemtypes = GetItemTypes;
+my @itemtypesloop;
+my %itemtypesloop;
+foreach my $thisitemtype (sort keys %$itemtypes) {
+ push @itemtypesloop, $itemtypes->{$thisitemtype}->{'itemtype'};
+ $itemtypesloop{$itemtypes->{$thisitemtype}->{'itemtype'}} = $itemtypes->{$thisitemtype}->{'description'};
+}
-
+my $CGIitemtype = CGI::scrolling_list(
+ -name => 'format',
+ -values => \@itemtypesloop,
+ -default => $data->{'itemtype'},
+ -labels => \%itemtypesloop,
+ -size => 1,
+ -tabindex=>'',
+ -multiple => 0
+);
# build branches list
-my $branches = GetBranches;
+my $onlymine=C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{flags}!=1 &&
+ C4::Context->userenv->{branch};
+my $branches = GetBranches($onlymine);
my @branchloop;
foreach my $thisbranch ( sort keys %$branches ) {
-my $selected=1 if $thisbranch eq $branch;
- my %row = (
+ my %row = (
value => $thisbranch,
branchname => $branches->{$thisbranch}->{'branchname'},
- selected=>$selected ,
);
push @branchloop, \%row;
}
$template->param( branchloop => \@branchloop );
# build bookfund list
+my ($flags, $homebranch) = GetFlagsAndBranchFromBorrower($loggedinuser);
my $count2;
my @bookfund;
my @select_bookfund;
my %select_bookfunds;
-my $selbookfund;
+
@bookfund = GetBookFunds($homebranch);
$count2 = scalar @bookfund;
push @select_bookfund, $bookfund[$i]->{'bookfundid'};
$select_bookfunds{ $bookfund[$i]->{'bookfundid'} } =
$bookfund[$i]->{'bookfundname'};
- if ($bookfund[$i]->{'bookfundid'} eq $bookfundid){
- $selbookfund=1;
- }
}
my $CGIbookfund = CGI::scrolling_list(
- -name => 'bookfundid',
+ -name => 'bookfund',
-values => \@select_bookfund,
-default => $data->{'bookfundid'},
-labels => \%select_bookfunds,
-size => 1,
- -selected =>$selbookfund,
+ -tabindex=>'',
-multiple => 0
);
my $bookfundname;
-
+my $bookfundid;
if ($close) {
$bookfundid = $data->{'bookfundid'};
$bookfundname = $select_bookfunds{$bookfundid};
my $bibitemsexists;
-#
-
- $template->param( bibitemexists => "1" ) if $biblionumber;
- my @bibitemloop;
- my %line;
- $line{isbn} = $data->{'isbn'};
- $line{itemtype} = $data->{'itemtype'};
- $line{volumeddesc} = $data->{'volumeddesc'};
+#do a biblioitems lookup on bib
+my @bibitems = GetBiblioItemByBiblioNumber($biblionumber);
+my $bibitemscount = scalar @bibitems;
+
+if ( $bibitemscount > 0 ) {
+ # warn "NEWBIBLIO: bibitems for $biblio exists\n";
+ $bibitemsexists = 1;
+
+ my @bibitemloop;
+ for ( my $i = 0 ; $i < $bibitemscount ; $i++ ) {
+ my %line;
+ $line{biblioitemnumber} = $bibitems[$i]->{'biblioitemnumber'};
+ $line{isbn} = $bibitems[$i]->{'isbn'};
+ $line{itemtype} = $bibitems[$i]->{'itemtype'};
+ $line{volumeddesc} = $bibitems[$i]->{'volumeddesc'};
push( @bibitemloop, \%line );
$template->param( bibitemloop => \@bibitemloop );
-
-
+ }
+ $template->param( bibitemexists => "1" );
+}
# fill template
$template->param(
booksellerid => $booksellerid,
suggestionid => $suggestionid,
biblionumber => $biblionumber,
+ biblioitemnumber => $data->{'biblioitemnumber'},
itemtype => $data->{'itemtype'},
- discount => $discount,
+ discount => $booksellers[0]->{'discount'},
listincgst => $booksellers[0]->{'listincgst'},
listprice => $booksellers[0]->{'listprice'},
gstreg => $booksellers[0]->{'gstreg'},
nocalc => $booksellers[0]->{'nocalc'},
name => $booksellers[0]->{'name'},
currency => $booksellers[0]->{'listprice'},
- gstrate =>$gstrate,
+ gstrate => C4::Context->preference("gist"),
loop_currencies => \@loop_currency,
orderexists => ( $new eq 'yes' ) ? 0 : 1,
title => $data->{'title'},
author => $data->{'author'},
copyrightdate => $data->{'copyrightdate'},
+ CGIitemtype => $CGIitemtype,
CGIbookfund => $CGIbookfund,
isbn => $data->{'isbn'},
seriestitle => $data->{'seriestitle'},
quantity => $data->{'quantity'},
listprice => $data->{'listprice'},
rrp => $data->{'rrp'},
+ total => $data->{ecost}*$data->{quantity},
invoice => $data->{'booksellerinvoicenumber'},
ecost => $data->{'ecost'},
- total =>$data->{'unitprice'}* $data->{'quantity'},
- unitprice => $data->{'unitprice'},
- gst => $data->{'ecost'}*$gstrate/100,
notes => $data->{'notes'},
publishercode => $data->{'publishercode'},
# donation => $donation
# $Id$
=head1 NAME
+
newordersuggestion.pl
=head1 DESCRIPTION
+
this script allow to add an order from a existing suggestion.
+The suggestion must have 'ACCEPTED' as status.
=head1 CGI PARAMETERS
=over 4
=item basketno
-the number of this basket.
+
+ the number of this basket.
=item booksellerid
-the bookseller who sells this record.
+
+ the bookseller who sells this record.
=item title
-the title of this record suggested.
+
+ to filter on title when searching among ACCEPTED suggestion.
=item author
-the author of this suggestion.
+
+ to filter on author when searching among ACCEPTED suggestion.
=item note
-this param allow to enter a note with this suggestion.
+
+ to filter on note when searching among ACCEPTED suggestion.
=item copyrightdate
-the copyright date for this suggestion.
=item publishercode
=item volumedesc
=item publicationyear
+
the publication year of this record.
=item place
=item isbn
+
the isbn of this suggestion.
=item duplicateNumber
+
is the biblionumber to put to the new suggestion.
=item suggestionid
+
the id of the suggestion to select.
=item op
+
can be equal to
* connectDuplicate :
then call to the function : ConnectSuggestionAndBiblio.
i.e set the biblionumber of this suggestion.
* else :
is the default value.
+
=back
=cut
use strict;
require Exporter;
use CGI;
-use C4::Auth; # get_template_and_user
+use C4::Auth; # get_template_and_user
use C4::Interface::CGI::Output;
use C4::Suggestions;
use C4::Biblio;
-use C4::Search;
my $input = new CGI;
-my $basketno = $input->param('basketno');
-my $supplierid = $input->param('booksellerid');
-my $title = $input->param('title');
-my $author = $input->param('author');
-my $note = $input->param('note');
-my $copyrightdate =$input->param('copyrightdate');
-my $publishercode = $input->param('publishercode');
-my $volumedesc = $input->param('volumedesc');
-my $publicationyear = $input->param('publicationyear');
-my $place = $input->param('place');
-my $isbn = $input->param('isbn');
+# getting the CGI params
+my $basketno = $input->param('basketno');
+my $supplierid = $input->param('booksellerid');
+my $author = $input->param('author');
+my $title = $input->param('title');
+my $publishercode = $input->param('publishercode');
+my $op = $input->param('op');
+my $suggestionid = $input->param('suggestionid');
my $duplicateNumber = $input->param('duplicateNumber');
-my $suggestionid = $input->param('suggestionid');
-my $status = 'ACCEPTED'; # the suggestion had to be accepeted before to order it.
-my $suggestedbyme = -1; # search ALL suggestors
-my $op = $input->param('op');
$op = 'else' unless $op;
my $dbh = C4::Context->dbh;
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "acqui/newordersuggestion.tmpl",
- type => "intranet",
- query => $input,
- authnotrequired => 1,
- flagsrequired => {acquisition => 1},
- });
-
-if ($op eq 'connectDuplicate') {
- ConnectSuggestionAndBiblio($suggestionid,$duplicateNumber);
-}
-my $suggestions_loop= &SearchSuggestion($borrowernumber,$author,$title,$publishercode,$status,$suggestedbyme);
-foreach (@$suggestions_loop) {
- unless ($_->{biblionumber}) {
- my (@kohafields, @and_or, @value, @relation, $offset,$length);
- # search on biblio.title
- if ($_->{title}) {
- push @kohafields, "title";
- push @and_or, "\@and";
- push @relation, "\@attr 5=1";
- push @value, $_->{title};
- }
- if ($_->{author}) {
- push @kohafields, "author";
- push @and_or, "\@and";
- push @relation, "";
- push @value, $_->{author};
- }
- # ... and on publicationyear.
- if ($_->{publicationyear}) {
- push @kohafields, "copyrightdate";
- push @and_or, "\@and";
- push @relation, "";
- push @value, $_->{publicationyear};
- }
- # ... and on publisher.
- if ($_->{publishercode}) {
- push @kohafields, "publishercode";
- push @and_or, "\@and";
- push @relation, "";
- push @value, $_->{publishercode};
- }
-
- my ($nbresult,$facets,@finalresult) = ZEBRAsearch_kohafields(\@kohafields,\@value,\@relation,"",\@and_or,0,"",0,1);
-
- # there is at least 1 result => return the 1st one
- if ($nbresult) {
- $_->{duplicateBiblionumber} = $finalresult[0]->{biblionumber};
- }
- }
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "acqui/newordersuggestion.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 1,
+ flagsrequired => { acquisition => 1 },
+ }
+);
+
+if ( $op eq 'connectDuplicate' ) {
+ ConnectSuggestionAndBiblio( $suggestionid, $duplicateNumber );
}
-$template->param(suggestions_loop => $suggestions_loop,
- title => $title,
- author => $author,
- publishercode => $publishercode,
- status => $status,
- suggestedbyme => $suggestedbyme,
- basketno => $basketno,
- supplierid => $supplierid,
- "op_$op" => 1,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
+
+# getting all suggestions.
+my $suggestions_loop =
+ &SearchSuggestion( $borrowernumber, $author, $title, $publishercode,'ACCEPTED',
+ -1 );
+
+$template->param(
+ suggestions_loop => $suggestions_loop,
+ basketno => $basketno,
+ supplierid => $supplierid,
+ "op_$op" => 1,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
);
+
output_html_with_http_headers $input, $cookie, $template->output;
=back
=cut
-use strict;
+
use C4::Auth;
use C4::Acquisition;
use C4::Bookseller;
-use C4::Bookfund;
use C4::Biblio;
+use C4::Output;
use CGI;
use C4::Interface::CGI::Output;
use C4::Date;
-use Time::localtime;
+use strict;
my $input=new CGI;
my $supplierid=$input->param('supplierid');
-my $basketno=$input->param('basketno');
my @booksellers=GetBookSeller($supplierid);
my $count = scalar @booksellers;
-my @datetoday = localtime();
-my $date = (1900+$datetoday[5])."-".($datetoday[4]+1)."-". $datetoday[3];
+my $invoice=$input->param('invoice') || '';
+my $freight=$input->param('freight');
+my $gst=$input->param('gst');
+my $datereceived=$input->param('datereceived') || format_date(join "-",Date::Calc::Today());
+my $code=$input->param('code');
+
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "acqui/parcel.tmpl",
query => $input,
flagsrequired => {acquisition => 1},
debug => 1,
});
+my @parcelitems=GetParcel($supplierid,$invoice,$datereceived);
+my $countlines = scalar @parcelitems;
-my @booksellers=GetBookSeller($supplierid);
-
-my $gstreg=$booksellers[0]->{gstreg};
-my $incgst=$booksellers[0]->{'invoiceincgst'};
-my $invcurrency=$booksellers[0]->{'invoiceprice'};
-my $discount=$booksellers[0]->{'discount'};
-my $currencyrate;
-# get currencies (for exchange rates calcs if needed)
-my @rates = GetCurrencies();
-my $count = scalar @rates;
-
-for ( my $i = 0 ; $i < $count ; $i++ ) {
- if ($rates[$i]->{'currency'} eq $invcurrency){
- $currencyrate = $rates[$i]->{'rate'};
- }
-}
-my $me=C4::Context->userenv;
-my $user=$me->{'cardnumber'};
my $totalprice=0;
my $totalfreight=0;
my $totalquantity=0;
-my $totaldiscount=0;
my $total;
my $tototal;
my $toggle;
-my $totalgst;
-my $totaltoreceive;
-my $totaltoprice;
-my $totaltogst;
-my $totaltodiscount;
-my @loop_orders;
-my $countpendings;
-my $invoice;
-##Receiving a single basket or all baskets of a supplier
-unless($basketno){
-my $pendingorders = GetPendingOrders($supplierid);
-$countpendings = scalar @$pendingorders;
-foreach my $pendingorder (@$pendingorders){
- my @orders=GetOrders($pendingorder->{basketno});
- foreach my $order(@orders){
- $order->{toreceive}=$order->{quantity} - $order->{quantityreceived};
- $totalquantity+=$order->{quantity};
- $totaltoreceive+=$order->{toreceive};
- $totalprice+=$order->{rrp}*$order->{quantity};
- $totaltoprice+=$order->{rrp}*$order->{toreceive};
- $totalgst+=(($order->{rrp}*$order->{quantity}) -($order->{rrp}*$order->{quantity}*$order->{discount}/100))* $order->{gst}/100;
- $totaltogst+=(($order->{rrp}*$order->{toreceive}) -($order->{rrp}*$order->{toreceive}*$order->{discount}/100))* $order->{gst}/100;
- $totaldiscount +=$order->{rrp}*$order->{quantity}*$order->{discount}/100;
- $totaltodiscount +=$order->{rrp}*$order->{toreceive}*$order->{discount}/100;
- $order->{actualrrp}=sprintf( "%.2f",$order->{rrp}/$currencyrate);
- push @loop_orders, $order;
- }
+my @loop_received = ();
+for (my $i=0;$i<$countlines;$i++){
+ $total=($parcelitems[$i]->{'unitprice'} + $parcelitems[$i]->{'freight'}) * $parcelitems[$i]->{'quantityreceived'}; #weird, are the freight fees counted by book? (pierre)
+ $parcelitems[$i]->{'unitprice'}+=0;
+ my %line;
+ if ($toggle==0){
+ $line{color}='#EEEEEE';
+ $toggle=1;
+ } else {
+ $line{color}='white';
+ $toggle=0;
+ }
+ %line = %{$parcelitems[$i]};
+ $line{invoice} = $invoice;
+ $line{gst} = $gst;
+ $line{total} = $total;
+ $line{supplierid} = $supplierid;
+ push @loop_received, \%line;
+ $totalprice+=$parcelitems[$i]->{'unitprice'};
+ $totalfreight+=$parcelitems[$i]->{'freight'};
+ $totalquantity+=$parcelitems[$i]->{'quantityreceived'};
+ $tototal+=$total;
}
-
-}else{
-## one basket
-$countpendings=1;
-
-my @orders=GetOrders($basketno);
- foreach my $order(@orders){
-$invoice=$order->{booksellerinvoicenumber} unless $invoice;
- $order->{toreceive}=$order->{quantity} - $order->{quantityreceived};
- $totalquantity+=$order->{quantity};
- $totaltoreceive+=$order->{toreceive};
- $totalprice+=$order->{rrp}*$order->{quantity};
- $totaltoprice+=$order->{rrp}*$order->{toreceive};
- $totalgst+=(($order->{rrp}*$order->{quantity}) -($order->{rrp}*$order->{quantity}*$order->{discount}/100))* $order->{gst}/100;
- $totaltogst+=(($order->{rrp}*$order->{toreceive}) -($order->{rrp}*$order->{toreceive}*$order->{discount}/100))* $order->{gst}/100;
- $totaldiscount +=$order->{rrp}*$order->{quantity}*$order->{discount}/100;
- $totaltodiscount +=$order->{rrp}*$order->{toreceive}*$order->{discount}/100;
- $order->{actualrrp}=sprintf( "%.2f",$order->{rrp}/$currencyrate);
- push @loop_orders, $order;
- }
+my $pendingorders = GetPendingOrders($supplierid);
+my $countpendings = scalar @$pendingorders;
+
+my @loop_orders = ();
+for (my $i=0;$i<$countpendings;$i++){
+ my %line;
+ if ($toggle==0){
+ $line{color}='#EEEEEE';
+ $toggle=1;
+ } else {
+ $line{color}='white';
+ $toggle=0;
+ }
+ %line = %{$pendingorders->[$i]};
+ $line{ecost} = sprintf("%.2f",$line{ecost});
+ $line{unitprice} = sprintf("%.2f",$line{unitprice});
+ $line{invoice} = $invoice;
+ $line{gst} = $gst;
+ $line{total} = $total;
+ $line{supplierid} = $supplierid;
+ push @loop_orders, \%line;
}
-undef $invcurrency if ($currencyrate ==1);
-$template->param( invoice=>$invoice,
- date => format_date($date),
+$totalfreight=$freight;
+$tototal=$tototal+$freight;
+
+$template->param(invoice => $invoice,
+ datereceived => $datereceived,
+ formatteddatereceived => format_date($datereceived),
name => $booksellers[0]->{'name'},
supplierid => $supplierid,
+ gst => $gst,
+ freight => $freight,
+ invoice => $invoice,
+ countreceived => $countlines,
+ loop_received => \@loop_received,
countpending => $countpendings,
loop_orders => \@loop_orders,
- user=>$user,
- totalquantity=>$totalquantity,
- totaltoreceive=>$totaltoreceive,
- totalprice=>sprintf( "%.2f",$totalprice),
- totalactual =>sprintf( "%.2f",$totaltoprice/$currencyrate),
- totalgst=>sprintf( "%.2f",$totalgst),
- actualgst=>sprintf( "%.2f",$totaltogst/$currencyrate),
- totaldiscount=>sprintf( "%.2f",$totaldiscount),
- actualdiscount=>sprintf( "%.2f",$totaltodiscount/$currencyrate),
- total=>sprintf( "%.2f",$totalprice+$totalgst-$totaldiscount),
- gstreg=>$gstreg,
- gstrate=>C4::Context->preference('gist')*100,
- currencyrate=>$currencyrate,
- incgst =>$incgst,
- invcurrency=>$invcurrency ,
+ totalprice => $totalprice,
+ totalfreight => $totalfreight,
+ totalquantity => $totalquantity,
+ tototal => $tototal,
+ gst => $gst,
+ grandtot => $tototal+$gst,
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
use C4::Auth;
use C4::Acquisition;
use C4::Biblio;
+use C4::Output;
use CGI;
use C4::Interface::CGI::Output;
+
+
use C4::Bookseller;
use C4::Bookfund;
my $query=new CGI;
my $id=$query->param('supplierid');
-my @booksellers = GetBookSeller($id);
+my @booksellers = GetBookSeller($id) if $id;
my $count = scalar @booksellers;
+my $op=$query->param('op') || "display";
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "acqui/supplier.tmpl",
authnotrequired => 0,
flagsrequired => {acquisition => 1},
debug => 1,
- });
+ });
#build array for currencies
-my @currencies = GetCurrencies();
-my $count = scalar @currencies;
-
-my @loop_pricescurrency;
-my @loop_invoicecurrency;
-for (my $i=0;$i<$count;$i++) {
- if ($booksellers[0]->{'listprice'} eq $currencies[$i]->{'currency'}) {
- push @loop_pricescurrency, { currency => "<option selected=\"selected\" value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>" };
- } else {
- push @loop_pricescurrency, { currency => "<option value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
- }
- if ($booksellers[0]->{'invoiceprice'} eq $currencies[$i]->{'currency'}) {
- push @loop_invoicecurrency, { currency => "<option selected=\"selected\" value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
- } else {
- push @loop_invoicecurrency, { currency => "<option value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
- }
+if ($op eq "display"){
+ $template->param(id => $id,
+ name => $booksellers[0]->{'name'},
+ postal =>$booksellers[0]->{'postal'},
+ address1 => $booksellers[0]->{'address1'},
+ address2 => $booksellers[0]->{'address2'},
+ address3 => $booksellers[0]->{'address3'},
+ address4 => $booksellers[0]->{'address4'},
+ phone =>$booksellers[0]->{'phone'},
+ fax => $booksellers[0]->{'fax'},
+ url => $booksellers[0]->{'url'},
+ contact => $booksellers[0]->{'contact'},
+ contpos => $booksellers[0]->{'contpos'},
+ contphone => $booksellers[0]->{'contphone'},
+ contaltphone => $booksellers[0]->{'contaltphone'},
+ contfax => $booksellers[0]->{'contfax'},
+ contemail => $booksellers[0]->{'contemail'},
+ contnotes => $booksellers[0]->{'contnotes'},
+ notes => $booksellers[0]->{'notes'},
+ active => $booksellers[0]->{'active'},
+ specialty => $booksellers[0]->{'specialty'},
+ gstreg => $booksellers[0]->{'gstreg'},
+ listincgst => $booksellers[0]->{'listincgst'},
+ invoiceincgst => $booksellers[0]->{'invoiceincgst'},
+ discount => $booksellers[0]->{'discount'},
+ invoiceprice=>$booksellers[0]->{'invoiceprice'},
+ listprice=>$booksellers[0]->{'listprice'},
+ GST => C4::Context->preference("gist"),
+ );
+}else{
+ my @currencies = GetCurrencies();
+ my $count = scalar @currencies;
+
+ my @loop_pricescurrency;
+ my @loop_invoicecurrency;
+ for (my $i=0;$i<$count;$i++) {
+ if ($booksellers[0]->{'listprice'} eq $currencies[$i]->{'currency'}) {
+ push @loop_pricescurrency, { currency => "<option selected=\"selected\" value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>" };
+ } else {
+ push @loop_pricescurrency, { currency => "<option value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
+ }
+ if ($booksellers[0]->{'invoiceprice'} eq $currencies[$i]->{'currency'}) {
+ push @loop_invoicecurrency, { currency => "<option selected=\"selected\" value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
+ } else {
+ push @loop_invoicecurrency, { currency => "<option value=\"$currencies[$i]->{'currency'}\">$currencies[$i]->{'currency'}</option>"};
+ }
+ }
+ $template->param(id => $id,
+ name => $booksellers[0]->{'name'},
+ postal =>$booksellers[0]->{'postal'},
+ address1 => $booksellers[0]->{'address1'},
+ address2 => $booksellers[0]->{'address2'},
+ address3 => $booksellers[0]->{'address3'},
+ address4 => $booksellers[0]->{'address4'},
+ phone =>$booksellers[0]->{'phone'},
+ fax => $booksellers[0]->{'fax'},
+ url => $booksellers[0]->{'url'},
+ contact => $booksellers[0]->{'contact'},
+ contpos => $booksellers[0]->{'contpos'},
+ contphone => $booksellers[0]->{'contphone'},
+ contaltphone => $booksellers[0]->{'contaltphone'},
+ contfax => $booksellers[0]->{'contfax'},
+ contemail => $booksellers[0]->{'contemail'},
+ contnotes => $booksellers[0]->{'contnotes'},
+ notes => $booksellers[0]->{'notes'},
+ active => $booksellers[0]->{'active'},
+ specialty => $booksellers[0]->{'specialty'},
+ gstreg => $booksellers[0]->{'gstreg'},
+ listincgst => $booksellers[0]->{'listincgst'},
+ invoiceincgst => $booksellers[0]->{'invoiceincgst'},
+ discount => $booksellers[0]->{'discount'},
+ loop_pricescurrency => \@loop_pricescurrency,
+ loop_invoicecurrency => \@loop_invoicecurrency,
+ GST => C4::Context->preference("gist"),
+ enter=>1,
+ );
}
-$template->param(id => $id,
- name => $booksellers[0]->{'name'},
- postal =>$booksellers[0]->{'postal'},
- address1 => $booksellers[0]->{'address1'},
- address2 => $booksellers[0]->{'address2'},
- address3 => $booksellers[0]->{'address3'},
- address4 => $booksellers[0]->{'address4'},
- phone =>$booksellers[0]->{'phone'},
- fax => $booksellers[0]->{'fax'},
- url => $booksellers[0]->{'url'},
- contact => $booksellers[0]->{'contact'},
- contpos => $booksellers[0]->{'contpos'},
- contphone => $booksellers[0]->{'contphone'},
- contaltphone => $booksellers[0]->{'contaltphone'},
- contfax => $booksellers[0]->{'contfax'},
- contemail => $booksellers[0]->{'contemail'},
- contnotes => $booksellers[0]->{'contnotes'},
- notes => $booksellers[0]->{'notes'},
- active => $booksellers[0]->{'active'},
- specialty => $booksellers[0]->{'specialty'},
- gstreg => $booksellers[0]->{'gstreg'},
- listincgst => $booksellers[0]->{'listincgst'},
- invoiceincgst => $booksellers[0]->{'invoiceincgst'},
- discount => $booksellers[0]->{'discount'},
- loop_pricescurrency => \@loop_pricescurrency,
- loop_invoicecurrency => \@loop_invoicecurrency,);
-
output_html_with_http_headers $query, $cookie, $template->output;
$data{'invoiceprice'}=$input->param('invoice_currency');
$data{'gstreg'}=$input->param('gst');
$data{'listincgst'}=$input->param('list_gst');
-$data{'invoiceincgst'}=$input->param('invoiceincgst');
+$data{'invoiceincgst'}=$input->param('invoice_gst');
$data{'discount'}=$input->param('discount');
-my $id=$input->param('id');
-if ($data{'id'} != 0){
- ModBookseller(\%data);
+if ($data{'id'}){
+ ModBookseller(\%data);
} else {
- $id=AddBookseller(\%data);
+ $data{id}=AddBookseller(\%data);
}
#redirect to booksellers.pl
-print $input->redirect("booksellers.pl?supplier=$id");
+print $input->redirect("booksellers.pl?supplier=".$data{id});
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
use CGI;
use C4::Auth;
+use C4::Output;
use C4::Interface::CGI::Output;
+
my $query = new CGI;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "admin/admin-home.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1, tools => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
use strict;
use CGI;
-use C4::Output;
+use C4::Branch; # GetBranches
use List::Util qw/min/;
use C4::Auth;
use C4::Koha;
use C4::Context;
use C4::Bookfund;
+use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
use C4::Date;
my $dbh = C4::Context->dbh;
my $input = new CGI;
my $script_name="/cgi-bin/koha/admin/aqbookfund.pl";
my $bookfundid=$input->param('bookfundid');
+my $branchcodeid=$input->param('branchcode')|'';
my $pagesize = 10;
my $op = $input->param('op') || '';
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
}
);
my $dataaqbookfund;
my $header;
if ($bookfundid) {
- $dataaqbookfund = GetBookFund($bookfundid);
+ $dataaqbookfund = GetBookFund($bookfundid,$branchcodeid);
}
if ($bookfundid) {
$header = "Modify book fund";
$template->param('header-is-add-p' => 1);
}
$template->param('use-header-flags-p' => 1);
- $template->param(header => $header);
+ $template->param(header => $header); # NOTE deprecated
my $add_or_modify=0;
if ($bookfundid) {
$add_or_modify=1;
$template->param(add_or_modify => $add_or_modify);
$template->param(bookfundid =>$bookfundid);
$template->param(bookfundname =>$dataaqbookfund->{'bookfundname'});
-warn $dataaqbookfund->{'bookfundname'};
+
my @branchloop;
foreach my $branchcode (sort keys %{$branches}) {
my $row = {
branchname => $branches->{$branchcode}->{branchname},
};
- if ( $bookfundid && $dataaqbookfund->{branchcode} eq $branchcode) {
+ if (defined $bookfundid
+ and defined $dataaqbookfund->{branchcode}
+ and $dataaqbookfund->{branchcode} eq $branchcode) {
$row->{selected} = 1;
}
elsif ($op eq 'add_validate') {
my $bookfundid = uc $input->param('bookfundid');
- my $number = Countbookfund($bookfundid);
+ my $number = Countbookfund($bookfundid,$branchcodeid);
my $bookfund_already_exists = $number > 0 ? 1 : 0;
if ($bookfund_already_exists) {
my $bookfundname = $input->param('bookfundname');
my $branchcode = $input->param('branchcode') || undef;
-
- ModBookFund($bookfundname,$branchcode,$bookfundid);
+ warn "name :$bookfundname branch:$branchcode";
+ ModBookFund($bookfundname,$bookfundid,$branchcode);
}
else {
NewBookFund(
$bookfundid,
$input->param('bookfundname'),
- $input->param('branchcode')
+ $input->param('branchcode')||''
);
}
$input->redirect('aqbookfund.pl');
# called by default form, used to confirm deletion of data in DB
elsif ($op eq 'delete_confirm') {
- my $data = GetBookFund($bookfundid);
+ my $data = GetBookFund($bookfundid,$branchcodeid);
$template->param(bookfundid => $bookfundid);
$template->param(bookfundname => $data->{'bookfundname'});
+ $template->param(branchcode => $data->{'branchcode'});
} # END $OP eq DELETE_CONFIRM
################## DELETE_CONFIRMED ##################################
# called by delete_confirm, used to effectively confirm deletion of data in DB
elsif ($op eq 'delete_confirmed') {
- DelBookFund(uc($input->param('bookfundid')));
+ DelBookFund(uc($input->param('bookfundid')),$branchcodeid);
}# END $OP eq DELETE_CONFIRMED
use strict;
use CGI;
+use C4::Branch; # GetBranches
use List::Util qw/min/;
+
use C4::Date;
use C4::Auth;
use C4::Acquisition;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
use C4::Koha;
-use C4::Output;
my $input = new CGI;
my $script_name="/cgi-bin/koha/admin/aqbudget.pl";
my $bookfundid=$input->param('bookfundid');
my $aqbudgetid=$input->param('aqbudgetid');
+my $branchcodeid=$input->param('branchcode');
my $pagesize = 20;
my $op = $input->param('op');
budgetamount,
aqbudget.branchcode
FROM aqbudget
- INNER JOIN aqbookfund ON aqbudget.bookfundid = aqbookfund.bookfundid
+ INNER JOIN aqbookfund ON (aqbudget.bookfundid = aqbookfund.bookfundid AND
+ aqbudget.branchcode = aqbookfund.branchcode)
WHERE aqbudgetid = ?
';
$sth=$dbh->prepare($query);
aqbookfund.bookfundname
FROM aqbookfund
LEFT JOIN branches ON aqbookfund.branchcode = branches.branchcode
- WHERE bookfundid = ?
+ WHERE bookfundid = ? AND aqbookfund.branchcode=?
';
$sth=$dbh->prepare($query);
$sth->execute(
defined $aqbudgetid ? $dataaqbudget->{bookfundid} : $bookfundid,
+ $branchcodeid
);
$dataaqbookfund=$sth->fetchrow_hashref;
$sth->finish;
if (defined $aqbudgetid) {
$template->param(
bookfundid => $dataaqbudget->{'bookfundid'},
+ branchcode => $dataaqbudget->{'branchcode'},
bookfundname => $dataaqbudget->{'bookfundname'}
);
}
else {
$template->param(
bookfundid => $bookfundid,
+ branchcode => $dataaqbookfund->{'branchcode'},
bookfundname => $dataaqbookfund->{bookfundname},
);
}
format_date_in_iso($input->param('startdate')),
format_date_in_iso($input->param('enddate')),
$input->param('budgetamount'),
- $input->param('branch') || undef,
+ $input->param('branch') || '',
$aqbudgetid,
);
$sth->finish;
format_date_in_iso($input->param('startdate')),
format_date_in_iso($input->param('enddate')),
$input->param('budgetamount'),
- $input->param('branch') || undef,
+ $input->param('branch') || '',
);
$sth->finish;
}
use C4::Interface::CGI::Output;
use C4::Auth;
use CGI;
-use C4::Search;
use C4::Context;
my $data;
my $dbh = C4::Context->dbh;
my $more_subfields = $input->param("more_subfields")+1;
+ # builds kohafield tables
+ my @kohafields;
+ push @kohafields, "";
+ my $sth2=$dbh->prepare("SHOW COLUMNS from auth_header");
+ $sth2->execute;
+ while ((my $field) = $sth2->fetchrow_array) {
+ push @kohafields, "auth_header.".$field;
+ }
# build authorised value list
-
-my $sth2 = $dbh->prepare("select distinct category from authorised_values");
+ $sth2->finish;
+ $sth2 = $dbh->prepare("select distinct category from authorised_values");
$sth2->execute;
my @authorised_values;
push @authorised_values,"";
}
push (@authorised_values,"branches");
push (@authorised_values,"itemtypes");
+
+ # build thesaurus categories list
+ $sth2->finish;
+ $sth2 = $dbh->prepare("select authtypecode from auth_types");
+ $sth2->execute;
+ my @authtypes;
+ push @authtypes, "";
+ while ( ( my $authtypecode ) = $sth2->fetchrow_array ) {
+ push @authtypes, $authtypecode;
+ }
# build value_builder list
my @value_builder=('');
# on a standard install, /cgi-bin need to be added.
# test one, then the other
my $cgidir = C4::Context->intranetdir ."/cgi-bin";
- unless (opendir(DIR, "$cgidir/value_builder")) {
+ unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
$cgidir = C4::Context->intranetdir;
- opendir(DIR, "$cgidir/value_builder") || die "can't opendir $cgidir/value_builder: $!";
+ opendir(DIR, "$cgidir/cataloguing/value_builder") || die "can't opendir $cgidir/value_builder: $!";
}
while (my $line = readdir(DIR)) {
if ($line =~ /\.pl$/) {
}
$row_data{tab} = CGI::scrolling_list(-name=>'tab',
-id=>"tab$i",
- -values=>['-1','0','1','2','3','4','5','6','7','8','9'],
- -labels => {'-1' =>'ignore','0'=>'0','1'=>'1','2' =>'2','3'=>'3','4'=>'4',
- '5' =>'5','6'=>'6','7'=>'7',
- '8' =>'8','9'=>'9',},
+ -values=>['-1','0'],
+ -labels => {'-1' =>'ignore','0'=>'0',
+ },
-default=>$data->{'tab'},
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
$row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden',
-id=>"ohidden$i",
- -values=>['0','2'],
- -labels => {'0'=>'Show','2' =>'Hide',},
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show Collapsed',
+ '2' =>'Hide',
+ },
-default=>substr($data->{'hidden'},0,1),
-size=>1,
-multiple=>0,
);
$row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden',
-id=>"ihidden$i",
- -values=>['0','2'],
- -labels => {'0'=>'Show',
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show Collapsed',
'2' =>'Hide',
},
-default=>substr($data->{'hidden'},1,1),
-labels => {'0'=>'Show','1'=>'Show Collapsed',
'2' =>'Hide',
},
- -default=>substr($data->{'hidden'},2,1),
+ -default=>substr($data->{'hidden'}." ",2,1),
-size=>1,
-multiple=>0,
);
$row_data{liblibrarian} = CGI::escapeHTML($data->{'liblibrarian'});
$row_data{libopac} = CGI::escapeHTML($data->{'libopac'});
$row_data{seealso} = CGI::escapeHTML($data->{'seealso'});
+ $row_data{kohafield}= CGI::scrolling_list( -name=>"kohafield",
+ -id=>"kohafield$i",
+ -values=> \@kohafields,
+ -default=> "$data->{'kohafield'}",
+ -size=>1,
+ -multiple=>0,
+ );
$row_data{authorised_value} = CGI::scrolling_list(-name=>'authorised_value',
-id=>'authorised_value',
-values=> \@authorised_values,
-default=>$data->{'authorised_value'},
-size=>1,
+ -tabindex=>'',
+ -multiple=>0,
+ );
+ $row_data{frameworkcode} = CGI::scrolling_list(-name=>'frameworkcode',
+ -id=>'frameworkcode',
+ -values=> \@authtypes,
+ -default=>$data->{'frameworkcode'},
+ -size=>1,
+ -tabindex=>'',
-multiple=>0,
);
$row_data{value_builder} = CGI::scrolling_list(-name=>'value_builder',
-values=> \@value_builder,
-default=>$data->{'value_builder'},
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
for (my $i=1;$i<=$more_subfields;$i++) {
my %row_data; # get a fresh hash for the row data
$row_data{tab} = CGI::scrolling_list(-name=>'tab',
- -id=>"tab$i",
- -values=>['-1','0','1','2','3','4','5','6','7','8','9'],
- -labels => {'-1' =>'ignore','0'=>'0','1'=>'1','2' =>'2','3'=>'3','4'=>'4',
- '5' =>'5','6'=>'6','7'=>'7',
- '8' =>'8','9'=>'9',},
+ -id => "tab$i",
+ -values=>['-1','0'],
+ -labels => {'-1' =>'ignore','0'=>'0',
+ },
-default=>"",
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
$row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden',
-id=>"ohidden$i",
- -values=>['0','2'],
- -labels => {'0'=>'Show','2' =>'Hide',},
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show Collapsed',
+ '2' =>'Hide',
+ },
-default=>"0",
-size=>1,
-multiple=>0,
$row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden',
-id=>"ihidden$i",
- -values=>['0','2'],
- -labels => {'0'=>'Show','2' =>'Hide',},
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show Collapsed',
+ '2' =>'Hide',
+ },
-default=>"0",
-size=>1,
-multiple=>0,
-checked => '',
-value => 1,
-label => '');
-
+ $row_data{kohafield}= CGI::scrolling_list( -name=>'kohafield',
+ -id => "kohafield$i",
+ -values=> \@kohafields,
+ -default=> "",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{frameworkcode} = CGI::scrolling_list(-name=>'frameworkcode',
+ -id=>'frameworkcode',
+ -values=> \@authtypes,
+ -default=>$data->{'frameworkcode'},
+ -size=>1,
+ -tabindex=>'',
+ -multiple=>0,
+ );
$row_data{authorised_value} = CGI::scrolling_list(-name=>'authorised_value',
-id => 'authorised_value',
-values=> \@authorised_values,
-size=>1,
+ -tabindex=>'',
+ -multiple=>0,
+ );
+ $row_data{value_builder} = CGI::scrolling_list(-name=>'value_builder',
+ -id=>'value_builder',
+ -values=> \@value_builder,
+ -default=>$data->{'value_builder'},
+ -size=>1,
+ -tabindex=>'',
-multiple=>0,
);
$row_data{link} = CGI::checkbox( -name => "link",
$template->param('use-heading-flags-p' => 1);
$template->param('heading-edit-subfields-p' => 1);
$template->param(action => "Edit subfields",
- tagfield => "<input type=\"hidden\" name=\"tagfield\" value=\"$tagfield\">$tagfield",
+ tagfield => "<input type=\"hidden\" name=\"tagfield\" value=\"$tagfield\" />$tagfield",
loop => \@loop_data,
more_subfields => $more_subfields,
more_tag => $tagfield);
} elsif ($op eq 'add_validate') {
my $dbh = C4::Context->dbh;
$template->param(tagfield => "$input->param('tagfield')");
- my $sth=$dbh->prepare("replace auth_subfield_structure (tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,seealso,authorised_value,authtypecode,value_builder,hidden,isurl, link)
- values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
+ my $sth=$dbh->prepare("replace auth_subfield_structure (authtypecode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,seealso,authorised_value,frameworkcode,value_builder,hidden,isurl, link)
+ values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
my @tagsubfield = $input->param('tagsubfield');
my @liblibrarian = $input->param('liblibrarian');
my @libopac = $input->param('libopac');
+ my @kohafield = $input->param('kohafield');
my @tab = $input->param('tab');
my @seealso = $input->param('seealso');
- #my @hidden = $input->param('hidden');
my @hidden;
my @ohidden = $input->param('ohidden');
my @ihidden = $input->param('ihidden');
my @ehidden = $input->param('ehidden');
my @authorised_values = $input->param('authorised_value');
-# my $authtypecodes = $input->param('authtypecode');
+ my $authtypecode = $input->param('authtypecode');
+ my @frameworkcodes = $input->param('frameworkcode');
my @value_builder =$input->param('value_builder');
my @link =$input->param('link');
for (my $i=0; $i<= $#tagsubfield ; $i++) {
my $libopac =$libopac[$i];
my $repeatable =$input->param("repeatable$i")?1:0;
my $mandatory =$input->param("mandatory$i")?1:0;
-
+ my $kohafield =$kohafield[$i];
my $tab =$tab[$i];
my $seealso =$seealso[$i];
my $authorised_value =$authorised_values[$i];
-# my $authtypecode =$authtypecodes;
+ my $frameworkcode =$frameworkcodes[$i];
my $value_builder=$value_builder[$i];
my $hidden = $ohidden[$i].$ihidden[$i].$ehidden[$i]; #collate from 3 hiddens;
my $isurl = $input->param("isurl$i")?1:0;
my $link = $input->param("link$i")?1:0;
if ($liblibrarian) {
unless (C4::Context->config('demo') eq 1) {
- $sth->execute ($tagfield,
- $tagsubfield,
- $liblibrarian,
- $libopac,
- $repeatable,
- $mandatory,
- $tab,
- $seealso,
- $authorised_value,
- $authtypecode,
- $value_builder,
- $hidden,
- $isurl,
-
-
- $link,
+ $sth->execute($authtypecode,
+ $tagfield,
+ $tagsubfield,
+ $liblibrarian,
+ $libopac,
+ $repeatable,
+ $mandatory,
+ $kohafield,
+ $tab,
+ $seealso,
+ $authorised_value,
+ $frameworkcode,
+ $value_builder,
+ $hidden,
+ $isurl,
+ $link,
);
}
}
$row_data{tagfield} = $results->[$i]{'tagfield'};
$row_data{tagsubfield} = $results->[$i]{'tagsubfield'};
$row_data{liblibrarian} = $results->[$i]{'liblibrarian'};
+ $row_data{kohafield} = $results->[$i]{'kohafield'};
$row_data{repeatable} = $results->[$i]{'repeatable'};
$row_data{mandatory} = $results->[$i]{'mandatory'};
$row_data{tab} = $results->[$i]{'tab'};
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
use C4::Context;
my $authorised_value = CGI::scrolling_list(-name=>'authorised_value',
-values=> \@authorised_values,
-size=>1,
+ -tabindex=>'',
-multiple=>0,
-default => $data->{'authorised_value'},
);
$template->param('use-heading-flags-p' => 1);
$template->param(liblibrarian => $data->{'liblibrarian'},
libopac => $data->{'libopac'},
- repeatable => CGI::checkbox('repeatable',$data->{'repeatable'}?'checked':'',1,''),
- mandatory => CGI::checkbox('mandatory',$data->{'mandatory'}?'checked':'',1,''),
+ repeatable => "".$data->{'repeatable'},
+ mandatory => "".$data->{'mandatory'},
authorised_value => $authorised_value,
authtypecode => $authtypecode,
);
);
}
$sth->finish;
- print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=auth_tag_structure.pl?tagfield=$tagfield&authtypecode=$authtypecode\"></html>";
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=auth_tag_structure.pl?searchfield=$tagfield&authtypecode=$authtypecode\">";
exit;
# END $OP eq ADD_VALIDATE
################## DELETE_CONFIRM ##################################
}
my $env;
my ($count,$results)=StringSearch($env,$searchfield,$authtypecode);
- my $toggle="white";
+ my $toggle=1;
my @loop_data = ();
for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
- if ($toggle eq 'white'){
- $toggle="#ffffcc";
+ if ($toggle eq 1){
+ $toggle=0;
} else {
- $toggle="white";
+ $toggle=1;
}
my %row_data; # get a fresh hash for the row data
$row_data{tagfield} = $results->[$i]{'tagfield'};
$row_data{subfield_link} ="auth_subfields_structure.pl?tagfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
$row_data{edit} = "$script_name?op=add_form&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
$row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
- $row_data{bgcolor} = $toggle;
+ $row_data{toggle} = $toggle;
push(@loop_data, \%row_data);
}
$template->param(loop => \@loop_data,
}
} #---- END $OP eq DEFAULT
-$template->param(loggeninuser => $loggedinuser);
+$template->param(loggeninuser => $loggedinuser,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+
output_html_with_http_headers $input, $cookie, $template->output;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
+
use C4::Context;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
my $pagesize=20;
} else {
$data->{'category'} = $input->param('category');
}
- if ($searchfield) {
- $template->param(action => "Modify authorised value");
+ if ($id) {
+ $template->param(action_modify => 1);
$template->param('heading-modify-authorized-value-p' => 1);
} elsif ( ! $data->{'category'} ) {
- $template->param(action => "Add new category");
+ $template->param(action_add_category => 1);
$template->param('heading-add-new-category-p' => 1);
} else {
- $template->param(action => "Add authorised value");
+ $template->param(action_add_value => 1);
$template->param('heading-add-authorized-value-p' => 1);
}
$template->param('use-heading-flags-p' => 1);
$sth->execute($id);
my $data=$sth->fetchrow_hashref;
$sth->finish;
-
+ $id = $input->param('id') unless $id;
$template->param(searchfield => $searchfield,
Tvalue => $data->{'authorised_value'},
id =>$id,
# called by delete_confirm, used to effectively confirm deletion of data in DB
} elsif ($op eq 'delete_confirmed') {
my $dbh = C4::Context->dbh;
+ my $id = $input->param('id');
my $sth=$dbh->prepare("delete from authorised_values where id=?");
$sth->execute($id);
$sth->finish;
-
print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=authorised_values.pl?searchfield=$searchfield\"></html>";
exit;
-values=> \@category_list,
-default=>"",
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
if (!$searchfield) {
);
}
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
use C4::Auth;
use C4::Interface::CGI::Output;
+
sub StringSearch {
my ($env,$searchstring,$type)=@_;
my $dbh = C4::Context->dbh;
$op => 1); # we show only the TMPL_VAR names $op
} else {
$template->param(script_name => $script_name,
- else => 1); # we show only the TMPL_VAR names $op
+ 'else' => 1); # we show only the TMPL_VAR names $op
}
################## ADD_FORM ##################################
# called by default. Used to create form to add or modify a record
$data=$sth->fetchrow_hashref;
$sth->finish;
}
-# warn "=> $data->{'authtypetext'} : ".$data->{'summary'};
+ warn "=> $data->{'authtypetext'} : ".$data->{'summary'};
$template->param(authtypecode => $authtypecode,
authtypetext => $data->{'authtypetext'},
auth_tag_to_report => $data->{'auth_tag_to_report'},
$template->param(next => "$script_name?offset=".$nextpage);
}
} #---- END $OP eq DEFAULT
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
# Local Variables:
#!/usr/bin/perl
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 branches.pl
+
+ FIXME: individual fields in branch address need to be exported to templates,
+ in order to fix bug 180; need to notify translators
+FIXME: looped html (e.g., list of checkboxes) need to be properly
+ TMPL_LOOP'ized; doing this properly will fix bug 130; need to
+ notify translators
+ FIXME: need to implement the branch categories stuff
+ FIXME: there are too many TMPL_IF's; the proper way to do it is to have
+ separate templates for each individual action; need to notify
+ translators
+ FIXME: there are lots of error messages exported to the template; a lot
+ of these should be converted into exported booleans / counters etc
+ so that the error messages can be localized; need to notify translators
+
+ NOTE: heading() should now be called like this:
+ 1. Use heading() as before
+ 2. $template->param('heading-LISPISHIZED-HEADING-p' => 1);
+ 3. $template->param('use-heading-flags-p' => 1);
+ This ensures that both converted and unconverted templates work
+
+ Finlay working on this file from 26-03-2002
+ Reorganising this branches admin page.....
+
+=cut
+
use strict;
use CGI;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
-# Fixed variables
-my $linecolor1='#ffffcc';
-my $linecolor2='white';
-
-my $script_name="/cgi-bin/koha/admin/branches.pl";
-my $pagesize=20;
+use C4::Koha;
+use C4::Branch;
+# Fixed variables
+my $script_name = "/cgi-bin/koha/admin/branches.pl";
+my $pagesize = 20;
-#######################################################################################
+################################################################################
# Main loop....
-my $input = new CGI;
-my $branchcode=$input->param('branchcode');
-my $branchname=$input->param('branchname');
+my $input = new CGI;
+my $branchcode = $input->param('branchcode');
+my $branchname = $input->param('branchname');
my $categorycode = $input->param('categorycode');
-my $op = $input->param('op');
-
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "admin/branches.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
- debug => 1,
- });
+my $op = $input->param('op');
+
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "admin/branches.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { parameters => 1},
+ debug => 1,
+ }
+);
if ($op) {
- $template->param(script_name => $script_name,
- $op => 1); # we show only the TMPL_VAR names $op
-} else {
- $template->param(script_name => $script_name,
- else => 1); # we show only the TMPL_VAR names $op
+ $template->param(
+ script_name => $script_name,
+ $op => 1
+ ); # we show only the TMPL_VAR names $op
+}
+else {
+ $template->param(
+ script_name => $script_name,
+ else => 1
+ ); # we show only the TMPL_VAR names $op
+}
+$template->param( action => $script_name );
+if ( $op eq 'add' ) {
+
+ # If the user has pressed the "add new branch" button.
+ $template->param( 'heading-branches-add-branch-p' => 1 );
+ editbranchform($branchcode,$template);
+
+}
+elsif ( $op eq 'edit' ) {
+
+ # if the user has pressed the "edit branch settings" button.
+ $template->param( 'heading-branches-add-branch-p' => 0,
+ 'add' => 1, );
+ editbranchform($branchcode,$template);
+}
+elsif ( $op eq 'add_validate' ) {
+
+ # confirm settings change...
+ my $params = $input->Vars;
+ unless ( $params->{'branchcode'} && $params->{'branchname'} ) {
+ $template->param( else => 1 );
+ default("MESSAGE1",$template);
+ }
+ else {
+ ModBranch($params);
+ $template->param( else => 1 );
+ default("MESSAGE2",$template);
+ }
+}
+elsif ( $op eq 'delete' ) {
+ # if the user has pressed the "delete branch" button.
+
+ # check to see if the branchcode is being used in the database somewhere....
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select count(*) from items where holdingbranch=? or homebranch=?");
+ $sth->execute( $branchcode, $branchcode );
+ my ($total) = $sth->fetchrow_array;
+ $sth->finish;
+
+ my $message;
+
+ if ($total) {
+ $message = "MESSAGE7";
+ }
+
+ if ($message) {
+ $template->param( else => 1 );
+ default($message,$template);
+ }
+ else {
+ $template->param( branchname => $branchname );
+ $template->param( delete_confirm => 1 );
+ $template->param( branchcode => $branchcode );
+ }
+}
+elsif ( $op eq 'delete_confirmed' ) {
+
+ # actually delete branch and return to the main screen....
+ DelBranch($branchcode);
+ $template->param( else => 1 );
+ default("MESSAGE3",$template);
}
-$template->param(action => $script_name);
-if ($op eq 'add') {
- # If the user has pressed the "add new branch" button.
- heading("Branches: Add Branch");
- $template->param('heading-branches-add-branch-p' => 1);
- $template->param('use-heading-flags-p' => 1);
- editbranchform();
-
-} elsif ($op eq 'edit') {
- # if the user has pressed the "edit branch settings" button.
- heading("Branches: Edit Branch");
- $template->param('heading-branches-edit-branch-p' => 1);
- $template->param('use-heading-flags-p' => 1);
- $template->param(add => 1);
- editbranchform($branchcode);
-} elsif ($op eq 'add_validate') {
- # confirm settings change...
- my $params = $input->Vars;
- unless ($params->{'branchcode'} && $params->{'branchname'}) {
- default ("Cannot change branch record: You must specify a Branchname and a Branchcode");
- } else {
- setbranchinfo($params);
- $template->param(else => 1);
- default ("Branch record changed for branch: $params->{'branchname'}");
- }
-} elsif ($op eq 'delete') {
- # if the user has pressed the "delete branch" button.
- my $message = checkdatabasefor($branchcode);
- if ($message) {
- $template->param(else => 1);
- default($message);
- } else {
- $template->param(branchname => $branchname);
- $template->param(delete_confirm => 1);
- $template->param(branchcode => $branchcode);
- }
-} elsif ($op eq 'delete_confirmed') {
- # actually delete branch and return to the main screen....
- deletebranch($branchcode);
- $template->param(else => 1);
- default("The branch \"$branchname\" ($branchcode) has been deleted.");
-} elsif ($op eq 'editcategory') {
- # If the user has pressed the "add new category" or "modify" buttons.
- heading("Branches: Edit Category");
- $template->param('heading-branches-edit-category-p' => 1);
- $template->param('use-heading-flags-p' => 1);
- editcatform($categorycode);
-} elsif ($op eq 'addcategory_validate') {
- # confirm settings change...
- my $params = $input->Vars;
- unless ($params->{'categorycode'} && $params->{'categoryname'}) {
- default ("Cannot change branch record: You must specify a Branchname and a Branchcode");
- } else {
- setcategoryinfo($params);
- $template->param(else => 1);
- default ("Category record changed for category $params->{'categoryname'}");
- }
-} elsif ($op eq 'delete_category') {
- # if the user has pressed the "delete branch" button.
- my $message = checkcategorycode($categorycode);
- if ($message) {
- $template->param(else => 1);
- default($message);
- } else {
- $template->param(delete_category => 1);
- $template->param(categorycode => $categorycode);
- }
-} elsif ($op eq 'categorydelete_confirmed') {
- # actually delete branch and return to the main screen....
- deletecategory($categorycode);
- $template->param(else => 1);
- default("The category with code $categorycode has been deleted.");
-
-} else {
- # if no operation has been set...
- default();
+elsif ( $op eq 'editcategory' ) {
+
+ # If the user has pressed the "add new category" or "modify" buttons.
+ $template->param( 'heading-branches-edit-category-p' => 1 );
+ editcatform($categorycode,$template);
+}
+elsif ( $op eq 'addcategory_validate' ) {
+
+ # confirm settings change...
+ my $params = $input->Vars;
+ unless ( $params->{'categorycode'} && $params->{'categoryname'} ) {
+ $template->param( else => 1 );
+ default("MESSAGE4",$template);
+ }
+ else {
+ ModBranchCategoryInfo($params);
+ $template->param( else => 1 );
+ default("MESSAGE5",$template);
+ }
+}
+elsif ( $op eq 'delete_category' ) {
+
+ # if the user has pressed the "delete branch" button.
+ my $message = "MESSAGE8" if CheckBranchCategorycode($categorycode);
+ if ($message) {
+ $template->param( else => 1 );
+ default($message,$template);
+ }
+ else {
+ $template->param( delete_category => 1 );
+ $template->param( categorycode => $categorycode );
+ }
}
+elsif ( $op eq 'categorydelete_confirmed' ) {
+ # actually delete branch and return to the main screen....
+ DeleteBranchCategory($categorycode);
+ $template->param( else => 1 );
+ default("MESSAGE6",$template);
+}
+else {
+
+ # if no operation has been set...
+ default("",$template);
+}
-######################################################################################################
+################################################################################
#
# html output functions....
sub default {
- my ($message) = @_;
- heading("Branches");
- $template->param('heading-branches-p' => 1);
- $template->param('use-heading-flags-p' => 1);
- $template->param(message => $message);
- $template->param(action => $script_name);
- branchinfotable();
-}
-
-# FIXME: this function should not exist; otherwise headings are untranslatable
-sub heading {
- my ($head) = @_;
- $template->param(head => $head);
+ my ($message,$innertemplate) = @_;
+ $innertemplate->param( 'heading-branches-p' => 1 );
+ $innertemplate->param( "$message" => 1 );
+ $innertemplate->param( action => $script_name );
+ branchinfotable("",$innertemplate);
}
sub editbranchform {
- # prepares the edit form...
- my ($branchcode) = @_;
- my $data;
- if ($branchcode) {
- $data = getbranchinfo($branchcode);
- $data = $data->[0];
- $template->param(branchcode => $data->{'branchcode'});
- $template->param(branchname => $data->{'branchname'});
- $template->param(branchaddress1 => $data->{'branchaddress1'});
- $template->param(branchaddress2 => $data->{'branchaddress2'});
- $template->param(branchaddress3 => $data->{'branchaddress3'});
- $template->param(branchphone => $data->{'branchphone'});
- $template->param(branchfax => $data->{'branchfax'});
- $template->param(branchemail => $data->{'branchemail'});
+ my ($branchcode,$innertemplate) = @_;
+ # initiate the scrolling-list to select the printers
+ my %env;
+ my $printers = GetPrinters( \%env );
+ my @printerloop;
+ my $printercount = 0;
+ my $oldprinter;
+ my $CGIprinter;
+
+ my $data;
+
+ if ($branchcode) {
+ $data = GetBranchInfo($branchcode);
+ $data = $data->[0];
+
+ # get the old printer of the branch
+ $oldprinter = $data->{'branchprinter'};
+
+ # printer loop
+ foreach my $thisprinter ( keys %$printers ) {
+ my $selected = 1
+ if $oldprinter eq $printers->{$thisprinter}->{'printqueue'};
+ my %row = (
+ value => $thisprinter,
+ selected => $selected,
+ branchprinter => $printers->{$thisprinter}->{'printqueue'},
+ );
+ push @printerloop, \%row;
+ }
+
+ $innertemplate->param(
+ printerloop => \@printerloop,
+ branchcode => $data->{'branchcode'},
+ branch_name => $data->{'branchname'},
+ branchaddress1 => $data->{'branchaddress1'},
+ branchaddress2 => $data->{'branchaddress2'},
+ branchaddress3 => $data->{'branchaddress3'},
+ branchphone => $data->{'branchphone'},
+ branchfax => $data->{'branchfax'},
+ branchemail => $data->{'branchemail'},
+ branchip => $data->{'branchip'}
+ );
+ }
+ else { #case of an add branch select printer
+ foreach my $thisprinter ( keys %$printers ) {
+ my %row = (
+ value => $thisprinter,
+ branchprinter => $printers->{$thisprinter}->{'printqueue'},
+ );
+ push @printerloop, \%row;
+ }
+ $innertemplate->param( printerloop => \@printerloop );
}
# make the checkboxs.....
# 'checked' fields. The $checked field is either '' or 'checked'
# (see bug 130)
#
- my $catinfo = getcategoryinfo();
+ my $catinfo = GetBranchCategory();
my $catcheckbox;
-# print DEBUG "catinfo=".cvs($catinfo)."\n";
+
+ # print DEBUG "catinfo=".cvs($catinfo)."\n";
my @categoryloop = ();
foreach my $cat (@$catinfo) {
- my $checked = "";
- my $tmp = quotemeta($cat->{'categorycode'});
- if (grep {/^$tmp$/} @{$data->{'categories'}}) {
- $checked = "checked=\"checked\"";
- }
- push @categoryloop, {
- categoryname => $cat->{'categoryname'},
- categorycode => $cat->{'categorycode'},
- codedescription => $cat->{'codedescription'},
- checked => $checked,
- };
- }
- $template->param(categoryloop => \@categoryloop);
+ my $checked = "";
+ my $tmp = quotemeta( $cat->{'categorycode'} );
+ if ( grep { /^$tmp$/ } @{ $data->{'categories'} } ) {
+ $checked = "checked=\"checked\"";
+ }
+ push @categoryloop,
+ {
+ categoryname => $cat->{'categoryname'},
+ categorycode => $cat->{'categorycode'},
+ codedescription => $cat->{'codedescription'},
+ checked => $checked,
+ };
+ }
+ $innertemplate->param( categoryloop => \@categoryloop );
# {{{ Leave this here until bug 130 is completely resolved in the templates
- for my $obsolete ('categoryname', 'categorycode', 'codedescription') {
- $template->param($obsolete => 'Your template is out of date (bug 130)');
- }
+ for my $obsolete ( 'categoryname', 'categorycode', 'codedescription' ) {
+ $innertemplate->param(
+ $obsolete => 'Your template is out of date (bug 130)' );
+ }
+
# }}}
}
sub editcatform {
- # prepares the edit form...
- my ($categorycode) = @_;
- warn "cat : $categorycode";
- my $data;
- if ($categorycode) {
- $data = getcategoryinfo($categorycode);
- $data = $data->[0];
- $template->param(categorycode => $data->{'categorycode'});
- $template->param(categoryname => $data->{'categoryname'});
- $template->param(codedescription => $data->{'codedescription'});
+
+ # prepares the edit form...
+ my ($categorycode,$innertemplate) = @_;
+ warn "cat : $categorycode";
+ my $data;
+ if ($categorycode) {
+ $data = GetBranchCategory($categorycode);
+ $data = $data->[0];
+ $innertemplate->param( categorycode => $data->{'categorycode'} );
+ $innertemplate->param( categoryname => $data->{'categoryname'} );
+ $innertemplate->param( codedescription => $data->{'codedescription'} );
}
}
sub deleteconfirm {
-# message to print if the
+
+ # message to print if the
my ($branchcode) = @_;
}
-
sub branchinfotable {
-# makes the html for a table of branch info from reference to an array of hashs.
-
- my ($branchcode) = @_;
- my $branchinfo;
- if ($branchcode) {
- $branchinfo = getbranchinfo($branchcode);
- } else {
- $branchinfo = getbranchinfo();
- }
- my $color;
- my @loop_data =();
- foreach my $branch (@$branchinfo) {
- ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
- #
- # We export the following fields to the template. These are not
- # pre-composed as a single "address" field because the template
- # might (and should) escape what is exported here. (See bug 180)
- #
- # - color
- # - branch_name (Note: not "branchname")
- # - branch_code (Note: not "branchcode")
- # - address (containing a static error message)
- # - branchaddress1 \
- # - branchaddress2 |
- # - branchaddress3 | comprising the old "address" field
- # - branchphone |
- # - branchfax |
- # - branchemail /
- # - address-empty-p (1 if no address information, 0 otherwise)
- # - categories (containing a static error message)
- # - category_list (loop containing "categoryname")
- # - no-categories-p (1 if no categories set, 0 otherwise)
- # - value
- # - action
- #
- my %row = ();
-
- # Handle address fields separately
- my $address_empty_p = 1;
- for my $field ('branchaddress1', 'branchaddress2', 'branchaddress3',
- 'branchphone', 'branchfax', 'branchemail') {
- $row{$field} = $branch->{$field};
- if ( $branch->{$field} ) {
- $address_empty_p = 0;
- }
- }
- $row{'address-empty-p'} = $address_empty_p;
- # {{{ Leave this here until bug 180 is completely resolved in templates
- $row{'address'} = 'Your template is out of date (see bug 180)';
- # }}}
-
- # Handle categories
- my $no_categories_p = 1;
- my @categories = '';
- foreach my $cat (@{$branch->{'categories'}}) {
- my ($catinfo) = @{getcategoryinfo($cat)};
- push @categories, {'categoryname' => $catinfo->{'categoryname'}};
- $no_categories_p = 0;
- }
- # {{{ Leave this here until bug 180 is completely resolved in templates
- $row{'categories'} = 'Your template is out of date (see bug 180)';
- # }}}
- $row{'category_list'} = \@categories;
- $row{'no-categories-p'} = $no_categories_p;
-
- # Handle all other fields
- $row{'branch_name'} = $branch->{'branchname'};
- $row{'branch_code'} = $branch->{'branchcode'};
- $row{'color'} = $color;
- $row{'value'} = $branch->{'branchcode'};
- $row{'action'} = '/cgi-bin/koha/admin/branches.pl';
-
- push @loop_data, { %row };
- }
- my @branchcategories =();
- my $catinfo = getcategoryinfo();
- foreach my $cat (@$catinfo) {
- push @branchcategories, {
- categoryname => $cat->{'categoryname'},
- categorycode => $cat->{'categorycode'},
- codedescription => $cat->{'codedescription'},
- };
- }
-
- $template->param(branches => \@loop_data,
- branchcategories => \@branchcategories);
-
-}
-
-# FIXME logic seems wrong
-sub branchcategoriestable {
-#Needs to be implemented...
-
- my $categoryinfo = getcategoryinfo();
- my $color;
- foreach my $cat (@$categoryinfo) {
- ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
- $template->param(color => $color);
- $template->param(categoryname => $cat->{'categoryname'});
- $template->param(categorycode => $cat->{'categorycode'});
- $template->param(codedescription => $cat->{'codedescription'});
- }
-}
-
-######################################################################################################
-#
-# Database functions....
-sub getbranchinfo {
-# returns a reference to an array of hashes containing branches,
+# makes the html for a table of branch info from reference to an array of hashs.
- my ($branchcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
+ my ($branchcode,$innertemplate) = @_;
+ my $branchinfo;
if ($branchcode) {
- $sth = $dbh->prepare("Select * from branches where branchcode = ? order by branchcode");
- $sth->execute($branchcode);
- } else {
- $sth = $dbh->prepare("Select * from branches order by branchcode");
- $sth->execute();
+ $branchinfo = GetBranchInfo($branchcode);
}
- my @results;
- while (my $data = $sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $nsth->execute($data->{'branchcode'});;
- my @cats = ();
- while (my ($cat) = $nsth->fetchrow_array) {
- push(@cats, $cat);
- }
- $nsth->finish;
- $data->{'categories'} = \@cats;
- push(@results, $data);
+ else {
+ $branchinfo = GetBranchInfo();
+ }
+ my $toggle;
+ my $i;
+ my @loop_data = ();
+ foreach my $branch (@$branchinfo) {
+ ( $i % 2 ) ? ( $toggle = 1 ) : ( $toggle = 0 );
+
+ #
+ # We export the following fields to the template. These are not
+ # pre-composed as a single "address" field because the template
+ # might (and should) escape what is exported here. (See bug 180)
+ #
+ # - color
+ # - branch_name (Note: not "branchname")
+ # - branch_code (Note: not "branchcode")
+ # - address (containing a static error message)
+ # - branchaddress1 \
+ # - branchaddress2 |
+ # - branchaddress3 | comprising the old "address" field
+ # - branchphone |
+ # - branchfax |
+ # - branchemail /
+ # - address-empty-p (1 if no address information, 0 otherwise)
+ # - categories (containing a static error message)
+ # - category_list (loop containing "categoryname")
+ # - no-categories-p (1 if no categories set, 0 otherwise)
+ # - value
+ # - action
+ #
+ my %row = ();
+
+ # Handle address fields separately
+ my $address_empty_p = 1;
+ for my $field (
+ 'branchaddress1', 'branchaddress2',
+ 'branchaddress3', 'branchphone',
+ 'branchfax', 'branchemail',
+ 'branchip', 'branchprinter'
+ )
+ {
+ $row{$field} = $branch->{$field};
+ if ( $branch->{$field} ) {
+ $address_empty_p = 0;
+ }
+ }
+ $row{'address-empty-p'} = $address_empty_p;
+
+ # {{{ Leave this here until bug 180 is completely resolved in templates
+ $row{'address'} = 'Your template is out of date (see bug 180)';
+
+ # }}}
+
+ # Handle categories
+ my $no_categories_p = 1;
+ my @categories = '';
+ foreach my $cat ( @{ $branch->{'categories'} } ) {
+ my ($catinfo) = @{ GetBranchCategory($cat) };
+ push @categories, { 'categoryname' => $catinfo->{'categoryname'} };
+ $no_categories_p = 0;
+ }
+
+ # {{{ Leave this here until bug 180 is completely resolved in templates
+ $row{'categories'} = 'Your template is out of date (see bug 180)';
+
+ # }}}
+ $row{'category_list'} = \@categories;
+ $row{'no-categories-p'} = $no_categories_p;
+
+ # Handle all other fields
+ $row{'branch_name'} = $branch->{'branchname'};
+ $row{'branch_code'} = $branch->{'branchcode'};
+ $row{'toggle'} = $toggle;
+ $row{'value'} = $branch->{'branchcode'};
+ $row{'action'} = '/cgi-bin/koha/admin/branches.pl';
+
+ push @loop_data, {%row};
+ $i++;
+ }
+ my @branchcategories = ();
+ my $catinfo = GetBranchCategory();
+ $i = 0;
+ foreach my $cat (@$catinfo) {
+ ( $i % 2 ) ? ( $toggle = 1 ) : ( $toggle = 0 );
+ push @branchcategories,
+ {
+ toggle => $toggle,
+ categoryname => $cat->{'categoryname'},
+ categorycode => $cat->{'categorycode'},
+ codedescription => $cat->{'codedescription'},
+ };
+ $i++;
}
- $sth->finish;
- return \@results;
-}
-
-# FIXME This doesn't belong here; it should be moved into a module
-sub getcategoryinfo {
-# returns a reference to an array of hashes containing branches,
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- # print DEBUG "getcategoryinfo: entry: catcode=".cvs($catcode)."\n";
- if ($catcode) {
- $sth = $dbh->prepare("select * from branchcategories where categorycode = ?");
- $sth->execute($catcode);
- } else {
- $sth = $dbh->prepare("Select * from branchcategories");
- $sth->execute();
- }
- my @results;
- while (my $data = $sth->fetchrow_hashref) {
- push(@results, $data);
- }
- $sth->finish;
- # print DEBUG "getcategoryinfo: exit: returning ".cvs(\@results)."\n";
- return \@results;
-}
-
-# FIXME This doesn't belong here; it should be moved into a module
-sub setbranchinfo {
-# sets the data from the editbranch form, and writes to the database...
- my ($data) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail) values (?,?,?,?,?,?,?,?)");
- $sth->execute(uc($data->{'branchcode'}), $data->{'branchname'},
- $data->{'branchaddress1'}, $data->{'branchaddress2'},
- $data->{'branchaddress3'}, $data->{'branchphone'},
- $data->{'branchfax'}, $data->{'branchemail'});
-
- $sth->finish;
- # sort out the categories....
- my @checkedcats;
- my $cats = getcategoryinfo();
- foreach my $cat (@$cats) {
- my $code = $cat->{'categorycode'};
- if ($data->{$code}) {
- push(@checkedcats, $code);
- }
- }
- my $branchcode =uc($data->{'branchcode'});
- my $branch = getbranchinfo($branchcode);
- $branch = $branch->[0];
- my $branchcats = $branch->{'categories'};
- my @addcats;
- my @removecats;
- foreach my $bcat (@$branchcats) {
- unless (grep {/^$bcat$/} @checkedcats) {
- push(@removecats, $bcat);
- }
- }
- foreach my $ccat (@checkedcats){
- unless (grep {/^$ccat$/} @$branchcats) {
- push(@addcats, $ccat);
- }
- }
- foreach my $cat (@addcats) {
- my $sth = $dbh->prepare("insert into branchrelations (branchcode, categorycode) values(?, ?)");
- $sth->execute($branchcode, $cat);
- $sth->finish;
- }
- foreach my $cat (@removecats) {
- my $sth = $dbh->prepare("delete from branchrelations where branchcode=? and categorycode=?");
- $sth->execute($branchcode, $cat);
- $sth->finish;
- }
-}
-
-sub deletebranch {
-# delete branch...
- my ($branchcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("delete from branches where branchcode = ?");
- $sth->execute($branchcode);
- $sth->finish;
-}
-sub setcategoryinfo {
-# sets the data from the editbranch form, and writes to the database...
- my ($data) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace branchcategories (categorycode,categoryname,codedescription) values (?,?,?)");
- $sth->execute(uc($data->{'categorycode'}), $data->{'categoryname'},$data->{'codedescription'});
+ $innertemplate->param(
+ branches => \@loop_data,
+ branchcategories => \@branchcategories
+ );
- $sth->finish;
-}
-sub deletecategory {
-# delete branch...
- my ($categorycode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("delete from branchcategories where categorycode = ?");
- $sth->execute($categorycode);
- $sth->finish;
}
-sub checkdatabasefor {
-# check to see if the branchcode is being used in the database somewhere....
- my ($branchcode) = @_;
-my @kohafield;
-my @value;
-my @relation;
-my @and_or;
- push @kohafield, "holdingbranch","homebranch";
-push @value, $branchcode,$branchcode;
-push @and_or, "\@or";
-push @relation ,"\@attr 5=100","\@attr 5=100"; ##do not truncate
- my ($total,@results) =ZEBRAsearch_kohafields(\@kohafield,\@value, \@relation,"", \@and_or);
-
- my $message;
- if ($total) {
- # We do not return verbal messages but a flag. fix templates to accept $error=1 as a message
- $message = "Branch cannot be deleted because there are $total items using that branch.";
-
- }
- return $message;
-}
+# FIXME logic seems wrong
+sub branchcategoriestable {
+ my $innertemplate = shift;
+ #Needs to be implemented...
-sub checkcategorycode {
-# check to see if the branchcode is being used in the database somewhere....
- my ($categorycode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select count(*) from branchrelations where categorycode=?");
- $sth->execute($categorycode);
- my ($total) = $sth->fetchrow_array;
- $sth->finish;
- my $message;
- if ($total) {
- # FIXME: need to be replaced by an exported boolean parameter
- $message = "Category cannot be deleted because there are $total branches using that category.";
+ my $categoryinfo = GetBranchCategory();
+ my $color;
+ foreach my $cat (@$categoryinfo) {
+ $innertemplate->param( categoryname => $cat->{'categoryname'} );
+ $innertemplate->param( categorycode => $cat->{'categorycode'} );
+ $innertemplate->param( codedescription => $cat->{'codedescription'} );
}
- return $message;
}
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
output_html_with_http_headers $input, $cookie, $template->output;
# Local Variables:
use strict;
use CGI;
-
use C4::Context;
use C4::Output;
-use C4::Search;
+
use C4::Auth;
use C4::Interface::CGI::Output;
$searchstring=~ s/\'/\\\'/g;
my @data=split(' ',$searchstring);
my $count=@data;
- my $sth=$dbh->prepare("Select * from categories where (description like ?)");
+ my $sth=$dbh->prepare("Select * from categories where (description like ?) order by category_type,description");
$sth->execute("$data[0]%");
my @results;
while (my $data=$sth->fetchrow_hashref){
my $data;
if ($categorycode) {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,issuelimit,reservefee,overduenoticerequired, canmakepublicshelves, addRequestToShelves, allowrenewsfromopac from categories where categorycode=?");
+ my $sth=$dbh->prepare("select categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,issuelimit,reservefee,overduenoticerequired,category_type from categories where categorycode=?");
$sth->execute($categorycode);
$data=$sth->fetchrow_hashref;
$sth->finish;
}
- $template->param(description => $data->{'description'},
+ $template->param(description => $data->{'description'},
enrolmentperiod => $data->{'enrolmentperiod'},
upperagelimit => $data->{'upperagelimit'},
dateofbirthrequired => $data->{'dateofbirthrequired'},
- enrolmentfee => $data->{'enrolmentfee'},
+ enrolmentfee => sprintf("%.2f",$data->{'enrolmentfee'}),
overduenoticerequired => $data->{'overduenoticerequired'},
issuelimit => $data->{'issuelimit'},
- reservefee => $data->{'reservefee'},
- canmakepublicshelves => $data->{'canmakepublicshelves'},
- addRequestToShelves => $data->{'addRequestToShelves'},
- allowrenewsfromopac => $data->{'allowrenewsfromopac'}
- );
+ reservefee => sprintf("%.2f",$data->{'reservefee'}),
+ category_type => $data->{'category_type'},
+ "type_".$data->{'category_type'} => " SELECTED ",
+ );
# END $OP eq ADD_FORM
################## ADD_VALIDATE ##################################
# called by add_form, used to insert/modify data in DB
} elsif ($op eq 'add_validate') {
$template->param(add_validate => 1);
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace categories (categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,reservefee,overduenoticerequired, issuelimit, canmakepublicshelves, addRequestToShelves , allowrenewsfromopac) values (?,?,?,?,?,?,?,?,?,?,?,?)");
- $sth->execute(map { $input->param($_) } ('categorycode','description','enrolmentperiod','upperagelimit','dateofbirthrequired','enrolmentfee','reservefee','overduenoticerequired', 'issuelimit', 'canmakepublicshelves', 'addRequestToShelves', 'allowrenewsfromopac'));
+ my $sth=$dbh->prepare("replace categories (categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,reservefee,overduenoticerequired,category_type) values (?,?,?,?,?,?,?,?,?)");
+ $sth->execute(map { $input->param($_) } ('categorycode','description','enrolmentperiod','upperagelimit','dateofbirthrequired','enrolmentfee','reservefee','overduenoticerequired','category_type'));
$sth->finish;
-
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=categorie.pl\"></html>";
+ exit;
+
# END $OP eq ADD_VALIDATE
################## DELETE_CONFIRM ##################################
# called by default form, used to confirm deletion of data in DB
$sth->finish;
$template->param(total => $total->{'total'});
- my $sth2=$dbh->prepare("select categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,issuelimit,reservefee,overduenoticerequired, canmakepublicshelves, addRequestToShelves,allowrenewsfromopac from categories where categorycode=?");
+ my $sth2=$dbh->prepare("select categorycode,description,enrolmentperiod,upperagelimit,dateofbirthrequired,enrolmentfee,issuelimit,reservefee,overduenoticerequired,category_type from categories where categorycode=?");
$sth2->execute($categorycode);
my $data=$sth2->fetchrow_hashref;
$sth2->finish;
enrolmentperiod => $data->{'enrolmentperiod'},
upperagelimit => $data->{'upperagelimit'},
dateofbirthrequired => $data->{'dateofbirthrequired'},
- enrolmentfee => $data->{'enrolmentfee'},
+ enrolmentfee => sprintf("%.2f",$data->{'enrolmentfee'}),
overduenoticerequired => $data->{'overduenoticerequired'},
issuelimit => $data->{'issuelimit'},
- reservefee => $data->{'reservefee'},
- canmakepublicshelves => $data->{'canmakepublicshelves'},
- addRequestToShelves => $data->{'addRequestToShelves'},
- allowrenewsfromopac => $data->{'allowrenewsfromopac'},
-
- );
-
-
+ reservefee => sprintf("%.2f",$data->{'reservefee'}),
+ category_type => $data->{'category_type'},
+ );
# END $OP eq DELETE_CONFIRM
################## DELETE_CONFIRMED ##################################
# called by delete_confirm, used to effectively confirm deletion of data in DB
my $sth=$dbh->prepare("delete from categories where categorycode=?");
$sth->execute($categorycode);
$sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=categorie.pl\"></html>";
+ exit;
+
# END $OP eq DELETE_CONFIRMED
} else { # DEFAULT
$template->param(else => 1);
enrolmentperiod => $results->[$i]{'enrolmentperiod'},
upperagelimit => $results->[$i]{'upperagelimit'},
dateofbirthrequired => $results->[$i]{'dateofbirthrequired'},
- enrolmentfee => $results->[$i]{'enrolmentfee'},
+ enrolmentfee => sprintf("%.2f",$results->[$i]{'enrolmentfee'}),
overduenoticerequired => $results->[$i]{'overduenoticerequired'},
issuelimit => $results->[$i]{'issuelimit'},
- reservefee => $results->[$i]{'reservefee'},
- canmakepublicshelves => $results->[$i]{'canmakepublicshelves'},
- addRequestToShelves => $results->[$i]{'addRequestToShelves'},
- allowrenewsfromopac => $results->[$i]{'allowrenewsfromopac'},
- toggle => $toggle );
+ reservefee => sprintf("%.2f",$results->[$i]{'reservefee'}),
+ category_type => $results->[$i]{'category_type'},
+ "type_".$results->[$i]{'category_type'} => 1,
+ toggle => $toggle );
+ warn "ICI". $results->[$i]{'category_type'};
push @loop, \%row;
- $toggle = not $toggle;
+ if ( $toggle eq 0 )
+ {
+ $toggle = 1;
+ }
+ else
+ {
+ $toggle = 0;
+ }
}
$template->param(loop => \@loop);
# check that I (institution) and C (child) exists. otherwise => warning to the user
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select categorycode from categories where categorycode='C'");
+ my $sth=$dbh->prepare("select category_type from categories where category_type='C'");
$sth->execute;
my ($categoryChild) = $sth->fetchrow;
$template->param(categoryChild => $categoryChild);
- $sth=$dbh->prepare("select categorycode from categories where categorycode='I'");
+ $sth=$dbh->prepare("select category_type from categories where category_type='I'");
$sth->execute;
my ($categoryInstitution) = $sth->fetchrow;
$template->param(categoryInstitution => $categoryInstitution);
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use strict;
use CGI;
-
use C4::Context;
use C4::Output;
-use C4::Search;
+
use C4::Auth;
use C4::Interface::CGI::Output;
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use C4::Interface::CGI::Output;
use C4::Auth;
use CGI;
-use C4::Search;
use C4::Context;
use C4::Biblio;
+
my $input = new CGI;
my ($template, $borrowernumber, $cookie)
my $dbh = C4::Context->dbh;
my $total;
-# checks itemnumber field
-my $sth = $dbh->prepare("select tagfield from koha_attr where marctokoha=\"itemnumber\"");
+# checks itemnum field
+my $sth = $dbh->prepare("select tab from marc_subfield_structure where kohafield=\"items.itemnumber\"");
$sth->execute;
my ($res) = $sth->fetchrow;
-unless ($res) {
- $template->param(itemnumber => 1);
+if ($res==-1) {
+ $template->param(itemnum => 0);
+} else {
+ $template->param(itemnum => 1);
$total++;
}
-#check biblionumber
-my $sth = $dbh->prepare("select tagfield from koha_attr where marctokoha=\"biblionumber\"");
+
+# checks biblio.biblionumber and biblioitem.biblioitemnumber (same tag and tab=-1)
+$sth = $dbh->prepare("select tagfield,tab from marc_subfield_structure where kohafield=\"biblio.biblionumber\"");
$sth->execute;
-my ($res) = $sth->fetchrow;
-if ($res ){
- ($res) = $sth->fetchrow;
- unless ($res){
+my $tab;
+($res,$tab) = $sth->fetchrow;
+$sth = $dbh->prepare("select tagfield,tab from marc_subfield_structure where kohafield=\"biblioitems.biblioitemnumber\"");
+$sth->execute;
+my ($res2,$tab2) = $sth->fetchrow;
+if ($res && $res2 && $tab==-1 && $tab2==-1) {
+ $template->param(biblionumber => 0);
+} else {
$template->param(biblionumber => 1);
$total++;
- }
}
-#check barcode
-my $sth = $dbh->prepare("select tagfield from koha_attr where marctokoha=\"barcode\"");
+
+# checks all item fields are in the same tag and in tab 10
+
+$sth = $dbh->prepare("select tagfield,tab,kohafield from marc_subfield_structure where kohafield like \"items.%\"");
$sth->execute;
-my ($res) = $sth->fetchrow;
-unless ($res){
- $template->param(barcode=> 1);
+my $field;
+($res,$res2,$field) = $sth->fetchrow;
+my $tagfield = $res;
+my $tab = $res2;
+my $subtotal=0;
+#warn "TAGF : $tagfield";
+while (($res,$res2,$field) = $sth->fetchrow) {
+ # (ignore itemnumber, that must be in -1 tab)
+ if (($res ne $tagfield or $res2 ne $tab ) && $res2 ne -1) {
+ $subtotal++;
+ }
+}
+$sth = $dbh->prepare("select kohafield from marc_subfield_structure where tagfield=?");
+$sth->execute($tagfield);
+while (($res2) = $sth->fetchrow) {
+ if (!$res2 || $res2 =~ /^items/) {
+ } else {
+ $subtotal++;
+ }
+}
+if ($subtotal eq 0) {
+ $template->param(itemfields => 0);
+} else {
+ $template->param(itemfields => 1);
$total++;
}
-#check isbn
-my $sth = $dbh->prepare("select tagfield from koha_attr where marctokoha=\"isbn\"");
+
+$sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where tab = 10");
$sth->execute;
-my ($res) = $sth->fetchrow;
-unless ($res){
- $template->param(isbn => 1);
+my $totaltags = 0;
+my $list = "";
+while (($res2) = $sth->fetchrow) {
+ $totaltags++;
+ $list.=$res2.",";
+}
+if ($totaltags > 1) {
+ $template->param(itemtags => $list);
$total++;
+} else {
+ $template->param(itemtags => 0);
}
-## Check for itemtype
-my $sth = $dbh->prepare("select tagfield,tagsubfield from koha_attr where marctokoha=\"itemtype\"");
+
+
+# checks biblioitems.itemtype must be mapped and use authorised_value=itemtype
+$sth = $dbh->prepare("select tagfield,tab,authorised_value from marc_subfield_structure where kohafield = \"biblioitems.itemtype\"");
$sth->execute;
-my ($res,$res2) = $sth->fetchrow;
-if ($res) {
-$sth = $dbh->prepare("select authorised_value from biblios_subfield_structure where tagfield=? and tagsubfield=?");
-$sth->execute($res,$res2);
- my ($item)=$sth->fetchrow;
- unless ($item eq "itemtypes"){
+($res,$res2,$field) = $sth->fetchrow;
+if ($res && $res2>=0 && $field eq "itemtypes") {
+ $template->param(itemtype => 0);
+} else {
$template->param(itemtype => 1);
$total++;
- }
}
-## Check for homebranch
-my $sth = $dbh->prepare("select tagfield from koha_attr where marctokoha=\"homebranch\"");
+# checks items.homebranch must be mapped and use authorised_value=branches
+$sth = $dbh->prepare("select tagfield,tab,authorised_value from marc_subfield_structure where kohafield = \"items.homebranch\"");
$sth->execute;
-my ($res) = $sth->fetchrow;
-unless ($res) {
+($res,$res2,$field) = $sth->fetchrow;
+if ($res && $res2 eq 10 && $field eq "branches") {
+ $template->param(branch => 0);
+} else {
$template->param(branch => 1);
$total++;
-
}
-
-## Check for holdingbranch
-my $sth = $dbh->prepare("select tagfield,tagsubfield from koha_attr where marctokoha=\"holdingbranch\"");
+# checks items.homebranch must be mapped and use authorised_value=branches
+$sth = $dbh->prepare("select tagfield,tab,authorised_value from marc_subfield_structure where kohafield = \"items.holdingbranch\"");
$sth->execute;
-my ($res,$res2) = $sth->fetchrow;
-if ($res) {
-$sth = $dbh->prepare("select authorised_value from biblios_subfield_structure where tagfield=? and tagsubfield=?");
-$sth->execute($res,$res2);
- my ($item)=$sth->fetchrow;
- unless ($item eq "branches"){
+($res,$res2,$field) = $sth->fetchrow;
+if ($res && $res2 eq 10 && $field eq "branches") {
+ $template->param(holdingbranch => 0);
+} else {
$template->param(holdingbranch => 1);
$total++;
- }
}
-
-
# checks that itemtypes & branches tables are not empty
$sth = $dbh->prepare("select count(*) from itemtypes");
$sth->execute;
$total++;
}
-$template->param(total => $total);
+$sth = $dbh->prepare("select count(*) from marc_biblio where frameworkcode is NULL");
+$sth->execute;
+($res) = $sth->fetchrow;
+if ($res) {
+ $template->param(frameworknull =>1);
+ $total++;
+}
+$sth = $dbh->prepare("select count(*) from marc_subfield_structure where frameworkcode is NULL");
+$sth->execute;
+($res) = $sth->fetchrow;
+if ($res) {
+ $template->param(frameworknull =>1);
+ $total++;
+}
+$sth = $dbh->prepare("select count(*) from marc_tag_structure where frameworkcode is NULL");
+$sth->execute;
+($res) = $sth->fetchrow;
+if ($res) {
+ $template->param(frameworknull =>1);
+ $total++;
+}
+
+$template->param(total => $total,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
-use HTML::Template;
+
use C4::Auth;
use C4::Interface::CGI::Output;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
+
use C4::Auth;
use C4::Interface::CGI::Output;
= get_template_and_user({template_name => "admin/currency.tmpl",
query => $input,
type => "intranet",
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
authnotrequired => 0,
debug => 1,
});
nextpage => $offset+$pagesize);
}
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
+
use C4::Auth;
+use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
+use C4::Branch; # GetBranches
my $input = new CGI;
my $dbh = C4::Context->dbh;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
# save the values entered
my $sth_Fupdate=$dbh->prepare("Update issuingrules set fine=?,firstremind=?,chargeperiod=? where branchcode=? and categorycode=? and itemtype=?");
my $sth_Fdelete=$dbh->prepare("delete from issuingrules where branchcode=? and categorycode=? and itemtype=? and issuelength=0");
- my $sth_Iinsert = $dbh->prepare("insert into issuingrules (branchcode,categorycode,itemtype,maxissueqty,issuelength) values (?,?,?,?,?)");
- my $sth_Iupdate=$dbh->prepare("Update issuingrules set maxissueqty=?, issuelength=? where branchcode=? and categorycode=? and itemtype=?");
+ my $sth_Iinsert = $dbh->prepare("insert into issuingrules (branchcode,categorycode,itemtype,maxissueqty,issuelength,rentaldiscount) values (?,?,?,?,?,?)");
+ my $sth_Iupdate=$dbh->prepare("Update issuingrules set maxissueqty=?, issuelength=?, rentaldiscount=? where branchcode=? and categorycode=? and itemtype=?");
my $sth_Idelete=$dbh->prepare("delete from issuingrules where branchcode=? and categorycode=? and itemtype=? and fine=0");
foreach my $key (@names){
# ISSUES
my $bor = $2; # borrower category
my $cat = $3; # item type
my $data=$input->param($key);
- my ($issuelength,$maxissueqty)=split(',',$data);
+ my ($issuelength,$maxissueqty,$rentaldiscount)=split(',',$data);
# if ($maxissueqty >0) {
$sth_search->execute($br,$bor,$cat);
my $res = $sth_search->fetchrow_hashref();
if ($res->{total}) {
- $sth_Iupdate->execute($maxissueqty,$issuelength,$br,$bor,$cat);
+ $sth_Iupdate->execute($maxissueqty,$issuelength,$rentaldiscount,$br,$bor,$cat);
} else {
- $sth_Iinsert->execute($br,$bor,$cat,$maxissueqty,$issuelength);
+ $sth_Iinsert->execute($br,$bor,$cat,$maxissueqty,$issuelength,$rentaldiscount);
}
# } else {
# $sth_Idelete->execute($br,$bor,$cat);
my $sth=$dbh->prepare("Select description,categorycode from categories order by description");
$sth->execute;
- my @trow3;
+my @trow3;
my @title_loop;
# my $i=0;
while (my $data=$sth->fetchrow_hashref){
my $fine=$dat->{'fine'}+0;
my $maxissueqty = $dat->{'maxissueqty'}+0;
my $issuelength = $dat->{'issuelength'}+0;
+ my $rentaldiscount = $dat->{'rentaldiscount'}+0;
my $finesvalue;
$finesvalue= "$fine,$dat->{'firstremind'},$dat->{'chargeperiod'}" if $fine+$dat->{'firstremind'}+$dat->{'chargeperiod'}>0;
my $issuingvalue;
# if ($maxissueqty>0) {
- $issuingvalue = "$issuelength,$maxissueqty" if $issuelength+$maxissueqty>0;
+ $issuingvalue = "$issuelength,$maxissueqty,$rentaldiscount" if $issuelength+$maxissueqty>0;
# }
# else {
# $issuingvalue = "$issuelength, 5";
$template->param(title => \@title_loop,
row => \@row_loop,
branchloop => \@branchloop,
- branch => $branch);
+ branch => $branch,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
use C4::Auth;
use C4::Interface::CGI::Output;
-use HTML::Template;
+
sub StringSearch {
my ($env,$searchstring,$type)=@_;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
use strict;
use CGI;
+
+use List::Util qw/min/;
+
+use C4::Koha;
use C4::Context;
use C4::Output;
-use C4::Search;
use C4::Auth;
use C4::Interface::CGI::Output;
-
sub StringSearch {
my ($env,$searchstring,$type)=@_;
my $dbh = C4::Context->dbh;
my $input = new CGI;
my $searchfield=$input->param('description');
-my $offset=$input->param('offset');
my $script_name="/cgi-bin/koha/admin/itemtypes.pl";
my $itemtype=$input->param('itemtype');
-my $pagesize=20;
+my $pagesize=10;
my $op = $input->param('op');
$searchfield=~ s/\,//g;
my ($template, $borrowernumber, $cookie)
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
my $data;
if ($itemtype) {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select itemtype,description,renewalsallowed,rentalcharge,notforloan from itemtypes where itemtype=?");
+ my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
$sth->execute($itemtype);
$data=$sth->fetchrow_hashref;
$sth->finish;
}
- $template->param(itemtype => $itemtype,
- description => $data->{'description'},
- renewalsallowed => $data->{'renewalsallowed'},
- rentalcharge => sprintf("%.2f",$data->{'rentalcharge'}),
- notforloan => $data->{'notforloan'}
- );
-;
+ # build list of images
+ my $imagedir_filesystem = getitemtypeimagedir();
+ my $imagedir_web = getitemtypeimagesrc();
+ opendir(DIR, $imagedir_filesystem)
+ or warn "can't opendir ".$imagedir_filesystem.": ".$!;
+ my @imagelist;
+ my $i=0;
+ my $image_per_line=12;
+ while (my $line = readdir(DIR)) {
+ $i++;
+ if ($line =~ /\.(gif|png)$/i) {
+ if($i==$image_per_line){
+ $i=0;
+ push @imagelist,{KohaImage => '',KohaImageSrc => ''};
+ }
+ else{
+ push( @imagelist,
+ {
+ KohaImage => $line,
+ KohaImageSrc => $imagedir_web.'/'.$line,
+ checked => $line eq $data->{imageurl} ? 1 : 0,
+ }
+ );
+ }
+ }
+ }
+ closedir DIR;
+
+ my $remote_image = undef;
+ if (defined $data->{imageurl} and $data->{imageurl} =~ m/^http/) {
+ $remote_image = $data->{imageurl};
+ }
+
+ $template->param(
+ itemtype => $itemtype,
+ description => $data->{'description'},
+ renewalsallowed => $data->{'renewalsallowed'},
+ rentalcharge => sprintf("%.2f",$data->{'rentalcharge'}),
+ notforloan => $data->{'notforloan'},
+ imageurl => $data->{'imageurl'},
+ template => C4::Context->preference('template'),
+ summary => $data->{summary},
+ IMAGESLOOP => \@imagelist,
+ remote_image => $remote_image,
+ );
# END $OP eq ADD_FORM
################## ADD_VALIDATE ##################################
# called by add_form, used to insert/modify data in DB
} elsif ($op eq 'add_validate') {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace itemtypes (itemtype,description,renewalsallowed,rentalcharge,notforloan) values (?,?,?,?,?)");
- $sth->execute(
- $input->param('itemtype'),$input->param('description'),
- $input->param('renewalsallowed'),$input->param('rentalcharge'),
- $input->param('notforloan')?1:0);
- $sth->finish;
+
+ my $modif='';
+ my $query = "
+ SELECT itemtype
+ FROM itemtypes
+ WHERE itemtype = ?
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($itemtype);
+ if($sth->fetchrow){
+ $modif = 1;
+ }
+
+ if($modif){ # it 's a modification
+ my $query = '
+ UPDATE itemtypes
+ SET description = ?
+ , renewalsallowed = ?
+ , rentalcharge = ?
+ , notforloan = ?
+ , imageurl = ?
+ , summary = ?
+ WHERE itemtype = ?
+ ';
+ my $sth=$dbh->prepare($query);
+ $sth->execute(
+ $input->param('description'),
+ $input->param('renewalsallowed'),
+ $input->param('rentalcharge'),
+ ($input->param('notforloan') ? 1 : 0),
+ ($input->param('image') eq 'removeImage'
+ ?''
+ :($input->param('image') eq 'remoteImage'
+ ? $input->param('remoteImage')
+ :$input->param('image')."")
+ ),
+ $input->param('summary'),
+ $input->param('itemtype')
+ );
+ }
+ else { # add a new itemtype & not modif an old
+ my $query = "
+ INSERT INTO itemtypes
+ (itemtype,description,renewalsallowed,rentalcharge, notforloan, imageurl,summary)
+ VALUES
+ (?,?,?,?,?,?,?);
+ ";
+ my $sth=$dbh->prepare($query);
+ $sth->execute(
+ $input->param('itemtype'),
+ $input->param('description'),
+ $input->param('renewalsallowed'),
+ $input->param('rentalcharge'),
+ $input->param('notforloan') ? 1 : 0,
+ $input->param('image') eq 'removeImage'
+ ? undef
+ : $input->param('image') eq 'remoteImage'
+ ? $input->param('remoteImage')
+ : $input->param('image'),
+ $input->param('summary'),
+ );
+ }
+
print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=itemtypes.pl\"></html>";
exit;
- # END $OP eq ADD_VALIDATE
+ # END $OP eq ADD_VALIDATE
################## DELETE_CONFIRM ##################################
# called by default form, used to confirm deletion of data in DB
} elsif ($op eq 'delete_confirm') {
$sth->finish;
$template->param(itemtype => $itemtype,
- description => $data->{'description'},
- renewalsallowed => $data->{'renewalsallowed'},
- rentalcharge => sprintf("%.2f",$data->{'rentalcharge'}),
+ description => $data->{description},
+ renewalsallowed => $data->{renewalsallowed},
+ rentalcharge => sprintf("%.2f",$data->{rentalcharge}),
+ imageurl => $data->{imageurl},
total => $total);
# END $OP eq DELETE_CONFIRM
################## DELETE_CONFIRMED ##################################
# END $OP eq DELETE_CONFIRMED
################## DEFAULT ##################################
} else { # DEFAULT
- my $env;
- my ($count,$results)=StringSearch($env,$searchfield,'web');
- my $toggle=0;
- my @loop_data;
- for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
- my %row_data;
- if ($toggle eq 0){
- $toggle=1;
- } else {
- $toggle=0;
- }
- $row_data{toggle} = $toggle;
- $row_data{itemtype} = $results->[$i]{itemtype};
- $row_data{description} = $results->[$i]{description};
- $row_data{renewalsallowed} = $results->[$i]{renewalsallowed};
- $row_data{notforloan} = $results->[$i]{notforloan};
- $row_data{rentalcharge} = sprintf("%.2f",$results->[$i]{rentalcharge});
- push(@loop_data, \%row_data);
- }
- $template->param(loop => \@loop_data);
- if ($offset>0) {
- my $prevpage = $offset-$pagesize;
- $template->param(previous => "$script_name?offset=".$prevpage);
- }
- if ($offset+$pagesize<$count) {
- my $nextpage =$offset+$pagesize;
- $template->param(next => "$script_name?offset=".$nextpage);
- }
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,'web');
+
+ my $page = $input->param('page') || 1;
+ my $first = ($page - 1) * $pagesize;
+
+ # if we are on the last page, the number of the last word to display
+ # must not exceed the length of the results array
+ my $last = min(
+ $first + $pagesize - 1,
+ scalar @{$results} - 1,
+ );
+
+ my $toggle = 0;
+ my @loop;
+ foreach my $result (@{$results}[$first .. $last]) {
+ my $itemtype = $result;
+ $itemtype->{toggle} = ($toggle++%2 eq 0 ? 1 : 0);
+ $itemtype->{imageurl} =
+ getitemtypeimagesrcfromurl($itemtype->{imageurl});
+ $itemtype->{rentalcharge} = sprintf('%.2f', $itemtype->{rentalcharge});
+
+ push(@loop, $itemtype);
+ }
+
+ $template->param(
+ loop => \@loop,
+ pagination_bar => pagination_bar(
+ $script_name,
+ getnbpages(scalar @{$results}, $pagesize),
+ $page,
+ 'page'
+ )
+ );
} #---- END $OP eq DEFAULT
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
# Local Variables:
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
use C4::Auth;
use C4::Interface::CGI::Output;
-use HTML::Template;
+
sub StringSearch {
my ($env,$searchstring,$type)=@_;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
-use HTML::Template;
+
sub StringSearch {
my ($env,$searchstring,$type)=@_;
my $dbh = C4::Context->dbh;
my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "parameters/letter.tmpl",
+ = get_template_and_user({template_name => "tools/letter.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
use C4::Auth;
use C4::Interface::CGI::Output;
-use HTML::Template;
+
sub StringSearch {
my ($env,$searchstring,$type)=@_;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
+
use C4::Auth;
use C4::Interface::CGI::Output;
}
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
-use C4::Search;
-use HTML::Template;
+
use C4::Auth;
use C4::Interface::CGI::Output;
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => {parameters => 1},
debug => 1,
});
#written 20/02/2002 by paul.poulain@free.fr
# This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html)
-# ALGO :
-# this script use an $op to know what to do.
-# if $op is empty or none of the above values,
-# - the default screen is build (with all records, or filtered datas).
-# - the user can clic on add, modify or delete record.
-# if $op=add_form
-# - if primkey exists, this is a modification,so we read the $primkey record
-# - builds the add/modify form
-# if $op=add_validate
-# - the user has just send datas, so we create/modify the record
-# if $op=delete_form
-# - we show the record having primkey=$primkey and ask for deletion validation form
-# if $op=delete_confirm
-# - we delete the record having primkey=$primkey
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 systempreferences.pl
+
+ALGO :
+ this script use an $op to know what to do.
+ if $op is empty or none of the above values,
+ - the default screen is build (with all records, or filtered datas).
+ - the user can clic on add, modify or delete record.
+ if $op=add_form
+ - if primkey exists, this is a modification,so we read the $primkey record
+ - builds the add/modify form
+ if $op=add_validate
+ - the user has just send datas, so we create/modify the record
+ if $op=delete_form
+ - we show the record having primkey=$primkey and ask for deletion validation form
+ if $op=delete_confirm
+ - we delete the record having primkey=$primkey
+
+=cut
+
use strict;
use CGI;
use C4::Auth;
use C4::Context;
use C4::Koha;
+use C4::Languages;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Search;
use C4::Context;
+
+# FIXME, shouldnt we store this stuff in the systempreferences table?
+
my %tabsysprefs;
# Acquisitions
- $tabsysprefs{acquisitions}="Acquisitions";
- $tabsysprefs{gist}="Acquisitions";
+ $tabsysprefs{acquisitions}="Acquisitions";
+ $tabsysprefs{gist}="Acquisitions";
# Admin
- $tabsysprefs{dateformat}="Admin";
- $tabsysprefs{insecure}="Admin";
- $tabsysprefs{KohaAdmin}="Admin";
+ $tabsysprefs{dateformat}="Admin";
+ $tabsysprefs{delimiter}="Admin";
+ $tabsysprefs{IndependantBranches}="Admin";
+ $tabsysprefs{insecure}="Admin";
+ $tabsysprefs{KohaAdmin}="Admin";
+ $tabsysprefs{KohaAdminEmailAddress}="Admin";
+ $tabsysprefs{MIME}="Admin";
+ $tabsysprefs{timeout}="Admin";
+ $tabsysprefs{Intranet_includes}="Admin";
+ $tabsysprefs{AutoLocation}="Admin";
+
# Authorities
- $tabsysprefs{authoritysep}="Authorities";
+ $tabsysprefs{authoritysep}="Authorities";
+ $tabsysprefs{AuthDisplayHierarchy}="Authorities";
# Catalogue
- $tabsysprefs{advancedMARCEditor}="Catalogue";
- $tabsysprefs{autoBarcode}="Catalogue";
- $tabsysprefs{hide_marc}="Catalogue";
- $tabsysprefs{IntranetBiblioDefaultView} = "Catalogue";
- $tabsysprefs{ISBD}="Catalogue";
- $tabsysprefs{itemcallnumber}="Catalogue";
- $tabsysprefs{LabelMARCView}="Catalogue";
- $tabsysprefs{marc}="Catalogue";
- $tabsysprefs{marcflavour}="Catalogue";
- $tabsysprefs{serialsadditems}="Catalogue";
- $tabsysprefs{sortbynonfiling}="Catalogue";
- $tabsysprefs{MARCOrgCode}="Catalogue";
- $tabsysprefs{z3950AuthorAuthFields}="Catalogue";
- $tabsysprefs{z3950NormalizeAuthor}="Catalogue";
- $tabsysprefs{SQLorZEBRA}="Catalogue";
-
+ $tabsysprefs{advancedMARCEditor}="Catalogue";
+ $tabsysprefs{autoBarcode}="Catalogue";
+ $tabsysprefs{hide_marc}="Catalogue";
+ $tabsysprefs{IntranetBiblioDefaultView} = "Catalogue";
+ $tabsysprefs{ISBD}="Catalogue";
+ $tabsysprefs{itemcallnumber}="Catalogue";
+ $tabsysprefs{kohaspsuggest} = "Catalogue";
+ $tabsysprefs{LabelMARCView}="Catalogue";
+ $tabsysprefs{marc}="Catalogue";
+ $tabsysprefs{marcflavour}="Catalogue";
+ $tabsysprefs{serialsadditems}="Catalogue";
+ $tabsysprefs{sortbynonfiling}="Catalogue";
+ $tabsysprefs{MARCOrgCode}="Catalogue";
+ $tabsysprefs{z3950AuthorAuthFields}="Catalogue";
+ $tabsysprefs{z3950NormalizeAuthor}="Catalogue";
+ $tabsysprefs{Stemming}="Catalogue";
+ $tabsysprefs{WeightFields}="Catalogue";
+ $tabsysprefs{expandedSearchOption}="Catalogue";
+
# Circulation
- $tabsysprefs{maxoutstanding}="Circulation";
- $tabsysprefs{maxreserves}="Circulation";
- $tabsysprefs{noissuescharge}="Circulation";
- $tabsysprefs{patronimages}="Circulation";
- $tabsysprefs{printcirculationslips}="Circulation";
- $tabsysprefs{ReturnBeforeExpiry}="Circulation";
- $tabsysprefs{allowrenewalsbefore}="Circulation";
- $tabsysprefs{defaultBranch}="Circulation";
- $tabsysprefs{strictrenewals}="Circulation";
+ $tabsysprefs{maxoutstanding}="Circulation";
+ $tabsysprefs{maxreserves}="Circulation";
+ $tabsysprefs{noissuescharge}="Circulation";
+ $tabsysprefs{IssuingInProcess}="Circulation";
+ $tabsysprefs{patronimages}="Circulation";
+ $tabsysprefs{printcirculationslips}="Circulation";
+ $tabsysprefs{ReturnBeforeExpiry}="Circulation";
+ $tabsysprefs{SpecifyDueDate}="Circulation";
+ $tabsysprefs{AutomaticItemReturn}="Circulation";
+ $tabsysprefs{ReservesMaxPickUpDelay}="Circulation";
+ $tabsysprefs{TransfersMaxDaysWarning}="Circulation";
+ $tabsysprefs{useDaysMode}="Circulation";
+
# Intranet
- $tabsysprefs{TemplateEncoding}="Intranet";
- $tabsysprefs{template}="Intranet";
- $tabsysprefs{intranetstylesheet}="Intranet";
- $tabsysprefs{IntranetNav}="Intranet";
- $tabsysprefs{intranetcolorstylesheet}="Intranet";
- $tabsysprefs{Activate_Log}="Intranet";
- $tabsysprefs{allowrenewalsbefore}="Intranet";
-
- $tabsysprefs{zebrawait}="Intranet";
- $tabsysprefs{retrieve_from}="Intranet";
- $tabsysprefs{batchMode}="Intranet";
-
+ $tabsysprefs{TemplateEncoding}="Intranet";
+ $tabsysprefs{template}="Intranet";
+ $tabsysprefs{intranetstylesheet}="Intranet";
+ $tabsysprefs{IntranetNav}="Intranet";
+ $tabsysprefs{intranetcolorstylesheet}="Intranet";
+ $tabsysprefs{intranetuserjs}="Intranet";
# Members
- $tabsysprefs{automembernum}="Members";
- $tabsysprefs{checkdigit}="Members";
- $tabsysprefs{NotifyBorrowerDeparture}="Members";
+ $tabsysprefs{automembernum}="Members";
+ $tabsysprefs{checkdigit}="Members";
+ $tabsysprefs{intranetreadinghistory}="Members";
+ $tabsysprefs{NotifyBorrowerDeparture}="Members";
+ $tabsysprefs{memberofinstitution}="Members";
+ $tabsysprefs{ReadingHistory}="Members";
+ $tabsysprefs{BorrowerMandatoryField}="Members";
+ $tabsysprefs{borrowerRelationship}="Members";
+ $tabsysprefs{BorrowersTitles}="Members";
+ $tabsysprefs{patronimages}="Members";
+
# OPAC
- $tabsysprefs{AmazonAssocTag}="OPAC";
- $tabsysprefs{AmazonContent}="OPAC";
- $tabsysprefs{AmazonDevKey}="OPAC";
- $tabsysprefs{AnonSuggestions}="OPAC";
- $tabsysprefs{BiblioDefaultView}="OPAC";
- $tabsysprefs{Disable_Dictionary}="OPAC";
- $tabsysprefs{hidelostitems}="OPAC";
- $tabsysprefs{LibraryName}="OPAC";
- $tabsysprefs{opacbookbag}="OPAC";
- $tabsysprefs{opaccolorstylesheet}="OPAC";
- $tabsysprefs{opaccredits}="OPAC";
- $tabsysprefs{opaclanguages}="OPAC";
- $tabsysprefs{opaclanguagesdisplay}="OPAC";
- $tabsysprefs{opaclargeimage}="OPAC";
- $tabsysprefs{opaclayoutstylesheet}="OPAC";
- $tabsysprefs{OpacNav}="OPAC";
- $tabsysprefs{OpacPasswordChange}="OPAC";
- $tabsysprefs{opacreadinghistory}="OPAC";
- $tabsysprefs{opacsmallimage}="OPAC";
- $tabsysprefs{opacstylesheet}="OPAC";
- $tabsysprefs{opacthemes}="OPAC";
- $tabsysprefs{opacuserlogin}="OPAC";
- $tabsysprefs{SubscriptionHistory}="OPAC";
- $tabsysprefs{suggestion}="OPAC";
- $tabsysprefs{virtualshelves}="OPAC";
- $tabsysprefs{opacheader}="OPAC";
- $tabsysprefs{allowrenewsfromopac}="OPAC";
+ $tabsysprefs{AmazonAssocTag}="OPAC";
+ $tabsysprefs{AmazonContent}="OPAC";
+ $tabsysprefs{AmazonDevKey}="OPAC";
+ $tabsysprefs{BiblioDefaultView}="OPAC";
+ $tabsysprefs{LibraryName}="OPAC";
+ $tabsysprefs{opaccolorstylesheet}="OPAC";
+ $tabsysprefs{opaccredits}="OPAC";
+ $tabsysprefs{opaclanguages}="OPAC";
+ $tabsysprefs{opaclargeimage}="OPAC";
+ $tabsysprefs{opaclayoutstylesheet}="OPAC";
+ $tabsysprefs{OpacNav}="OPAC";
+ $tabsysprefs{opacsmallimage}="OPAC";
+ $tabsysprefs{opacstylesheet}="OPAC";
+ $tabsysprefs{opacthemes}="OPAC";
+ $tabsysprefs{opacuserjs}="OPAC";
+ $tabsysprefs{SubscriptionHistory}="OPAC";
+ $tabsysprefs{opacheader}="OPAC";
+
+# OPACFeatures
+ $tabsysprefs{Disable_Dictionary}="OPACFeatures";
+ $tabsysprefs{hidelostitems}="OPACFeatures";
+ $tabsysprefs{opacbookbag}="OPACFeatures";
+ $tabsysprefs{opaclanguagesdisplay}="OPACFeatures";
+ $tabsysprefs{OpacPasswordChange}="OPACFeatures";
+ $tabsysprefs{opacreadinghistory}="OPACFeatures";
+ $tabsysprefs{virtualshelves}="OPACFeatures";
+ $tabsysprefs{RequestOnOpac}="OPACFeatures";
+ $tabsysprefs{reviewson}="OPACFeatures";
+ $tabsysprefs{OpacTopissues}="OPACFeatures";
+ $tabsysprefs{OpacAuthorities}="OPACFeatures";
+ $tabsysprefs{OpacCloud}="OPACFeatures";
+ $tabsysprefs{opacuserlogin}="OPACFeatures";
+ $tabsysprefs{AnonSuggestions}="OPACFeatures";
+ $tabsysprefs{suggestion}="OPACFeatures";
+ $tabsysprefs{OpacTopissue}="OPACFeatures";
+ $tabsysprefs{OpacBrowser}="OPACFeatures";
+# LOGFeatures
+ $tabsysprefs{CataloguingLog} = "LOGFeatures";
+ $tabsysprefs{BorrowersLog} = "LOGFeatures";
+ $tabsysprefs{SubscriptionLog} = "LOGFeatures";
+ $tabsysprefs{IssueLog} = "LOGFeatures";
+ $tabsysprefs{ReturnLog} = "LOGFeatures";
+ $tabsysprefs{LetterLog} = "LOGFeatures";
+ $tabsysprefs{FinesLog} = "LOGFeatures";
+
sub StringSearch {
- my ($env,$searchstring,$type)=@_;
- my $dbh = C4::Context->dbh;
- $searchstring=~ s/\'/\\\'/g;
- my @data=split(' ',$searchstring);
- my $count=@data;
- my @results;
- my $cnt=0;
- if ($type){
- foreach my $syspref (sort keys %tabsysprefs){
- if ($tabsysprefs{$syspref} eq $type){
- my $sth=$dbh->prepare("Select variable,value,explanation,type,options from systempreferences where (variable like ?) order by variable");
- $sth->execute($syspref);
- while (my $data=$sth->fetchrow_hashref){
- $data->{value} =~ s/</</g;
- $data->{value} =~ s/>/</g;
- $data->{value}=substr($data->{value},0,100)."..." if length($data->{value}) >100;
- push(@results,$data);
- $cnt++;
- }
- $sth->finish;
- }
- }
- } else {
- my $strsth ="Select variable,value,explanation,type,options from systempreferences where variable not in (";
- foreach my $syspref (keys %tabsysprefs){
- $strsth .= $dbh->quote($syspref).",";
- }
- $strsth =~ s/,$/) /;
- $strsth .= " order by variable";
- #warn $strsth;
- my $sth=$dbh->prepare($strsth);
- $sth->execute();
- while (my $data=$sth->fetchrow_hashref){
- $data->{value}=substr($data->{value},0,100);
- push(@results,$data);
- $cnt++;
- }
- $sth->finish;
- }
- return ($cnt,\@results);
+ my ($env,$searchstring,$type)=@_;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my $count=@data;
+ my @results;
+ my $cnt=0;
+ if ($type){
+ foreach my $syspref (sort keys %tabsysprefs){
+ if ($tabsysprefs{$syspref} eq $type){
+ my $sth=$dbh->prepare("Select variable,value,explanation,type,options from systempreferences where (variable like ?) order by variable");
+ $sth->execute($syspref);
+ while (my $data=$sth->fetchrow_hashref){
+ $data->{value} =~ s/</</g;
+ $data->{value} =~ s/>/>/g;
+ $data->{value}=substr($data->{value},0,100)."..." if length($data->{value}) >100;
+ push(@results,$data);
+ $cnt++;
+ }
+ $sth->finish;
+ }
+ }
+ } else {
+ my $strsth ="Select variable,value,explanation,type,options from systempreferences where variable not in (";
+ foreach my $syspref (keys %tabsysprefs){
+ $strsth .= $dbh->quote($syspref).",";
+ }
+ $strsth =~ s/,$/) /;
+ $strsth .= " order by variable";
+ my $sth=$dbh->prepare($strsth);
+ $sth->execute();
+ while (my $data=$sth->fetchrow_hashref){
+ $data->{value}=substr($data->{value},0,100);
+ push(@results,$data);
+ $cnt++;
+ }
+ $sth->finish;
+ }
+ return ($cnt,\@results);
}
my $input = new CGI;
my ($template, $borrowernumber, $cookie)
= get_template_and_user({template_name => "admin/systempreferences.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {parameters => 1},
- debug => 1,
- });
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
my $pagesize=100;
my $op = $input->param('op');
$searchfield=~ s/\,//g;
if ($op) {
$template->param(script_name => $script_name,
- $op => 1); # we show only the TMPL_VAR names $op
+ $op => 1); # we show only the TMPL_VAR names $op
} else {
$template->param(script_name => $script_name,
- else => 1); # we show only the TMPL_VAR names $op
+ else => 1); # we show only the TMPL_VAR names $op
}
if ($op eq 'update_and_reedit') {
- foreach ($input->param) {
- }
- my $value='';
- if (my $currentorder=$input->param('currentorder')) {
- my @currentorder=split /\|/, $currentorder;
- my $orderchanged=0;
- foreach my $param ($input->param) {
- if ($param=~m#up-(\d+).x#) {
- my $temp=$currentorder[$1];
- $currentorder[$1]=$currentorder[$1-1];
- $currentorder[$1-1]=$temp;
- $orderchanged=1;
- last;
- } elsif ($param=~m#down-(\d+).x#) {
- my $temp=$currentorder[$1];
- $currentorder[$1]=$currentorder[$1+1];
- $currentorder[$1+1]=$temp;
- $orderchanged=1;
- last;
- }
- }
- $value=join ' ', @currentorder;
- if ($orderchanged) {
- $op='add_form';
- $template->param(script_name => $script_name,
- $op => 1); # we show only the TMPL_VAR names $op
- } else {
- $op='';
- $searchfield='';
- $template->param(script_name => $script_name,
- else => 1); # we show only the TMPL_VAR names $op
- }
- }
- my $dbh = C4::Context->dbh;
- my $query="select * from systempreferences where variable=?";
- my $sth=$dbh->prepare($query);
- $sth->execute($input->param('variable'));
- if ($sth->rows) {
- unless (C4::Context->config('demo') eq 1) {
- my $sth=$dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
- $sth->execute($value, $input->param('explanation'), $input->param('variable'), $input->param('preftype'), $input->param('prefoptions'));
- $sth->finish;
- }
+ foreach ($input->param) {
+ }
+ my $value='';
+ if (my $currentorder=$input->param('currentorder')) {
+ my @currentorder=split /\|/, $currentorder;
+ my $orderchanged=0;
+ foreach my $param ($input->param) {
+ if ($param=~m#up-(\d+).x#) {
+ my $temp=$currentorder[$1];
+ $currentorder[$1]=$currentorder[$1-1];
+ $currentorder[$1-1]=$temp;
+ $orderchanged=1;
+ last;
+ } elsif ($param=~m#down-(\d+).x#) {
+ my $temp=$currentorder[$1];
+ $currentorder[$1]=$currentorder[$1+1];
+ $currentorder[$1+1]=$temp;
+ $orderchanged=1;
+ last;
+ }
+ }
+ $value=join ' ', @currentorder;
+ if ($orderchanged) {
+ $op='add_form';
+ $template->param(script_name => $script_name,
+ $op => 1); # we show only the TMPL_VAR names $op
+ } else {
+ $op='';
+ $searchfield='';
+ $template->param(script_name => $script_name,
+ else => 1); # we show only the TMPL_VAR names $op
+ }
+ }
+ my $dbh = C4::Context->dbh;
+ my $query="select * from systempreferences where variable=?";
+ my $sth=$dbh->prepare($query);
+ $sth->execute($input->param('variable'));
+ if ($sth->rows) {
+ unless (C4::Context->config('demo') eq 1) {
+ my $sth=$dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
+ $sth->execute($value, $input->param('explanation'), $input->param('variable'), $input->param('preftype'), $input->param('prefoptions'));
+ $sth->finish;
+ }
} else {
- unless (C4::Context->config('demo') eq 1) {
- my $sth=$dbh->prepare("insert into systempreferences (variable,value,explanation) values (?,?,?,?,?)");
- $sth->execute($input->param('variable'), $input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'));
- $sth->finish;
- }
- }
- $sth->finish;
+ unless (C4::Context->config('demo') eq 1) {
+ my $sth=$dbh->prepare("insert into systempreferences (variable,value,explanation) values (?,?,?,?,?)");
+ $sth->execute($input->param('variable'), $input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'));
+ $sth->finish;
+ }
+ }
+ $sth->finish;
}
# called by default. Used to create form to add or modify a record
if ($op eq 'add_form') {
- #---- if primkey exists, it's a modify action, so read values to modify...
- my $data;
- if ($searchfield) {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select variable,value,explanation,type,options from systempreferences where variable=?");
- $sth->execute($searchfield);
- $data=$sth->fetchrow_hashref;
- $sth->finish;
- $template->param(modify => 1);
- }
+ #---- if primkey exists, it's a modify action, so read values to modify...
+ my $data;
+ if ($searchfield) {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select variable,value,explanation,type,options from systempreferences where variable=?");
+ $sth->execute($searchfield);
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(modify => 1);
+ }
- my @options;
- foreach my $option (split(/\|/, $data->{'options'})) {
- my $selected='0';
- $option eq $data->{'value'} and $selected=1;
- push @options, { option => $option, selected => $selected };
- }
- if ($data->{'type'} eq 'Choice') {
- $template->param('type-choice' => 1);
- } elsif ($data->{'type'} eq 'YesNo') {
- $template->param('type-yesno' => 1);
- $data->{'value'}=C4::Context->boolean_preference($data->{'variable'});
- ($data->{'value'} eq '1') ? ($template->param('value-yes'=>1)) : ($template->param('value-no'=>1));
- } elsif ($data->{'type'} eq 'Integer') {
- $template->param('type-free' => 1);
- $template->param('fieldlength' => $data->{'options'});
- } elsif ($data->{'type'} eq 'Textarea') {
- $template->param('type-textarea' => 1);
- $data->{options} =~ /(.*)\|(.*)/;
- $template->param('cols' => $1, 'rows' => $2);;
- } elsif ($data->{'type'} eq 'Float') {
- $template->param('type-free' => 1);
- $template->param('fieldlength' => $data->{'options'});
- } elsif ($data->{'type'} eq 'Themes') {
- $template->param('type-choice' => 1);
- my $type='';
- ($data->{'variable'}=~m#opac#i) ? ($type='opac') : ($type='intranet');
- @options=();
- my $currently_selected_themes;
- my $counter=0;
- foreach my $theme (split /\s+/, $data->{'value'}) {
- push @options, { option => $theme, counter => $counter };
- $currently_selected_themes->{$theme}=1;
- $counter++;
- }
- foreach my $theme (getallthemes($type)) {
- my $selected='0';
- next if $currently_selected_themes->{$theme};
- push @options, { option => $theme, counter => $counter };
- $counter++;
- }
- } elsif ($data->{'type'} eq 'Languages') {
- $template->param('type-choice' => 1);
- my $type='';
- @options=();
- my $currently_selected_languages;
- my $counter=0;
- foreach my $language (split /\s+/, $data->{'value'}) {
- next if $language eq 'images';
- push @options, { option => $language, counter => $counter };
- $currently_selected_languages->{$language}=1;
- $counter++;
- }
- foreach my $language (getalllanguages()) {
- next if $language eq 'images';
- my $selected='0';
- next if $currently_selected_languages->{$language};
- push @options, { option => $language, counter => $counter };
- $counter++;
- }
- } else {
- $template->param('type-free' => 1);
- $template->param('fieldlength' => $data->{'options'}>0?$data->{'options'}:60);
- }
- $template->param(explanation => $data->{'explanation'},
- value => $data->{'value'},
- type => $data->{'type'},
- options => \@options,
- preftype => $data->{'type'},
- prefoptions => $data->{'options'},
- searchfield => $searchfield);
+ my @options;
+ foreach my $option (split(/\|/, $data->{'options'})) {
+ my $selected='0';
+ $option eq $data->{'value'} and $selected=1;
+ push @options, { option => $option, selected => $selected };
+ }
+ if ($data->{'type'} eq 'Choice') {
+ $template->param('type-choice' => 1);
+ } elsif ($data->{'type'} eq 'YesNo') {
+ $template->param('type-yesno' => 1);
+ $data->{'value'}=C4::Context->boolean_preference($data->{'variable'});
+ ($data->{'value'} eq '1') ? ($template->param('value-yes'=>1)) : ($template->param('value-no'=>1));
+ } elsif ($data->{'type'} eq 'Integer') {
+ $template->param('type-free' => 1);
+ $template->param('fieldlength' => $data->{'options'});
+ } elsif ($data->{'type'} eq 'Textarea') {
+ $template->param('type-textarea' => 1);
+ $data->{options} =~ /(.*)\|(.*)/;
+ $template->param('cols' => $1, 'rows' => $2);;
+ } elsif ($data->{'type'} eq 'Float') {
+ $template->param('type-free' => 1);
+ $template->param('fieldlength' => $data->{'options'});
+ } elsif ($data->{'type'} eq 'Themes') {
+ $template->param('type-choice' => 1);
+ my $type='';
+ ($data->{'variable'}=~m#opac#i) ? ($type='opac') : ($type='intranet');
+ @options=();
+ my $currently_selected_themes;
+ my $counter=0;
+ foreach my $theme (split /\s+/, $data->{'value'}) {
+ push @options, { option => $theme, counter => $counter };
+ $currently_selected_themes->{$theme}=1;
+ $counter++;
+ }
+ foreach my $theme (getallthemes($type)) {
+ my $selected='0';
+ next if $currently_selected_themes->{$theme};
+ push @options, { option => $theme, counter => $counter };
+ $counter++;
+ }
+ } elsif ($data->{'type'} eq 'Languages') {
+ $template->param('type-choice' => 1);
+ my $type='';
+ @options=();
+ my $currently_selected_languages;
+ my $counter=0;
+ foreach my $language (split /\s+/, $data->{'value'}) {
+ next if $language eq 'images';
+ push @options, { option => $language, counter => $counter };
+ $currently_selected_languages->{$language}=1;
+ $counter++;
+ }
+ my $langavail = getTranslatedLanguages();
+ foreach my $language (@$langavail) {
+ my $selected='0';
+ next if $currently_selected_languages->{$language->{'language_code'}};
+ #FIXME: could add language_name and language_locale_name for better display
+ push @options, { option => $language->{'language_code'}, counter => $counter };
+ $counter++;
+ }
+ } else {
+ $template->param('type-free' => 1);
+ $template->param('fieldlength' => $data->{'options'}>0?$data->{'options'}:60);
+ }
+ $template->param(explanation => $data->{'explanation'},
+ value => $data->{'value'},
+ type => $data->{'type'},
+ options => \@options,
+ preftype => $data->{'type'},
+ prefoptions => $data->{'options'},
+ searchfield => $searchfield);
################## ADD_VALIDATE ##################################
# called by add_form, used to insert/modify data in DB
} elsif ($op eq 'add_validate') {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from systempreferences where variable=?");
- $sth->execute($input->param('variable'));
- if ($sth->rows) {
- unless (C4::Context->config('demo') eq 1) {
- my $sth=$dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
- $sth->execute($input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'), $input->param('variable'));
- $sth->finish;
- }
- } else {
- unless (C4::Context->config('demo') eq 1) {
- my $sth=$dbh->prepare("insert into systempreferences (variable,value,explanation,type,options) values (?,?,?,?,?)");
- $sth->execute($input->param('variable'), $input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'));
- $sth->finish;
- }
- }
- $sth->finish;
- print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=systempreferences.pl?tab=".$tabsysprefs{$input->param('variable')}."\"></html>";
- exit;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from systempreferences where variable=?");
+ $sth->execute($input->param('variable'));
+ if ($sth->rows) {
+ unless (C4::Context->config('demo') eq 1) {
+ my $sth=$dbh->prepare("update systempreferences set value=?,explanation=?,type=?,options=? where variable=?");
+ $sth->execute($input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'), $input->param('variable'));
+ $sth->finish;
+ }
+ } else {
+ unless (C4::Context->config('demo') eq 1) {
+ my $sth=$dbh->prepare("insert into systempreferences (variable,value,explanation,type,options) values (?,?,?,?,?)");
+ $sth->execute($input->param('variable'), $input->param('value'), $input->param('explanation'), $input->param('preftype'), $input->param('prefoptions'));
+ $sth->finish;
+ }
+ }
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=systempreferences.pl?tab=".$tabsysprefs{$input->param('variable')}."\"></html>";
+ exit;
################## DELETE_CONFIRM ##################################
# called by default form, used to confirm deletion of data in DB
} elsif ($op eq 'delete_confirm') {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select variable,value,explanation,type,options from systempreferences where variable=?");
- $sth->execute($searchfield);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- $template->param(searchfield => $searchfield,
- Tvalue => $data->{'value'},
- );
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select variable,value,explanation,type,options from systempreferences where variable=?");
+ $sth->execute($searchfield);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(searchfield => $searchfield,
+ Tvalue => $data->{'value'},
+ );
- # END $OP eq DELETE_CONFIRM
+ # END $OP eq DELETE_CONFIRM
################## DELETE_CONFIRMED ##################################
# called by delete_confirm, used to effectively confirm deletion of data in DB
} elsif ($op eq 'delete_confirmed') {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("delete from systempreferences where variable=?");
- $sth->execute($searchfield);
- $sth->finish;
- # END $OP eq DELETE_CONFIRMED
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("delete from systempreferences where variable=?");
+ $sth->execute($searchfield);
+ $sth->finish;
+ # END $OP eq DELETE_CONFIRMED
################## DEFAULT ##################################
} else { # DEFAULT
- #Adding tab management for system preferences
- my $tab=$input->param('tab');
-
- my $env;
- my ($count,$results)=StringSearch($env,$searchfield,$tab);
- my $toggle=0;
- my @loop_data = ();
- for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
- if ($toggle eq 0){
- $toggle=1;
- } else {
- $toggle=0;
- }
- my %row_data; # get a fresh hash for the row data
- $row_data{variable} = $results->[$i]{'variable'};
- $row_data{value} = $results->[$i]{'value'};
- $row_data{explanation} = $results->[$i]{'explanation'};
- $row_data{toggle} = $toggle;
- $row_data{edit} = "$script_name?op=add_form&searchfield=".$results->[$i]{'variable'};
- $row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results->[$i]{'variable'};
- push(@loop_data, \%row_data);
- }
- $tab=($tab?$tab:"Others");
- $template->param(loop => \@loop_data, $tab => 1);
- if ($offset>0) {
- my $prevpage = $offset-$pagesize;
- $template->param("<a href=$script_name?offset=".$prevpage.'<< Prev</a>');
- }
- if ($offset+$pagesize<$count) {
- my $nextpage =$offset+$pagesize;
- $template->param("a href=$script_name?offset=".$nextpage.'Next >></a>');
- }
+ #Adding tab management for system preferences
+ my $tab=$input->param('tab');
+
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,$tab);
+ my $toggle=0;
+ my @loop_data = ();
+ for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ if ($toggle eq 0){
+ $toggle=1;
+ } else {
+ $toggle=0;
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{variable} = $results->[$i]{'variable'};
+ $row_data{value} = $results->[$i]{'value'};
+ $row_data{explanation} = $results->[$i]{'explanation'};
+ $row_data{toggle} = $toggle;
+ $row_data{edit} = "$script_name?op=add_form&searchfield=".$results->[$i]{'variable'};
+ $row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results->[$i]{'variable'};
+ push(@loop_data, \%row_data);
+ }
+ $tab=($tab?$tab:"Others");
+ $template->param(loop => \@loop_data, $tab => 1);
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param("<a href=$script_name?offset=".$prevpage.'<< Prev</a>');
+ }
+ if ($offset+$pagesize<$count) {
+ my $nextpage =$offset+$pagesize;
+ $template->param("a href=$script_name?offset=".$nextpage.'Next >></a>');
+ }
+ $template->param( tab => $tab,
+ );
} #---- END $OP eq DEFAULT
-$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
output_html_with_http_headers $input, $cookie, $template->output;
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Output;
-use C4::Search;
-use C4::Authorities;
+
+use C4::AuthoritiesMarc;
my $input = new CGI;
my $search_category=$input->param('search_category');
-values=> \@category_list,
-default=>"$search_category",
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
if (!$search_category) {
-values=> \@category_list,
-default=>"$search_category",
-size=>1,
+ -tabindex=>'',
-multiple=>0,
);
if (!$search_category) {
$template->param(next => "$script_name?branch=$branch&search_category=$search_category&searchstring=$searchstring&offset=$nextpage");
}
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
use strict;
use C4::Output;
use CGI;
-use C4::Search;
+
use C4::Context;
+
use C4::Auth;
use C4::Interface::CGI::Output;
$searchstring=~ s/\'/\\\'/g;
my @data=split(' ',$searchstring);
my $count=@data;
- my $sth=$dbh->prepare("Select * from z3950servers where (name like ?) order by rank,name");
+ my $sth=$dbh->prepare("Select host,port,db,userid,password,name,id,checked,rank,syntax from z3950servers where (name like ?) order by rank,name");
$sth->execute("$data[0]\%");
my @results;
while (my $data=$sth->fetchrow_hashref) {
my $pagesize=20;
my $op = $input->param('op');
-$searchfield=~ s/\,//g;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "admin/z3950servers.tmpl",
my $data;
if ($searchfield) {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from z3950servers where (name = ?) order by rank,name");
+ my $sth=$dbh->prepare("select host,port,db,userid,password,name,id,checked,rank,syntax from z3950servers where (name = ?) order by rank,name");
$sth->execute($searchfield);
$data=$sth->fetchrow_hashref;
$sth->finish;
db => $data->{'db'},
userid => $data->{'userid'},
password => $data->{'password'},
-
- opacshow => CGI::checkbox(-name=>'opacshow',
- -checked=> $data->{'opacshow'}?'checked':'',
- -value=> 1,
- -label => '',
- -id=> 'opacshow'),
- checked => CGI::checkbox(-name=>'checked',
- -checked=> $data->{'checked'}?'checked':'',
- -value=> 1,
- -label => '',
- -id=> 'checked'),
+ checked => $data->{'checked'},
rank => $data->{'rank'});
# END $OP eq ADD_FORM
################## ADD_VALIDATE ##################################
my $sth=$dbh->prepare("select * from z3950servers where name=?");
$sth->execute($input->param('searchfield'));
if ($sth->rows) {
- $sth=$dbh->prepare("update z3950servers set host=?, port=?, db=?, userid=?, password=?, name=?, checked=?, rank=?,opacshow=?,syntax=? where name=?");
+ $sth=$dbh->prepare("update z3950servers set host=?, port=?, db=?, userid=?, password=?, name=?, checked=?, rank=?,syntax=? where name=?");
$sth->execute($input->param('host'),
$input->param('port'),
$input->param('db'),
$input->param('userid'),
$input->param('password'),
$input->param('searchfield'),
- $input->param('checked')?1:0,
+ $input->param('checked'),
$input->param('rank'),
- $input->param('opacshow')?1:0,
$input->param('syntax'),
$input->param('searchfield'),
);
} else {
- $sth=$dbh->prepare("insert into z3950servers (host,port,db,userid,password,name,checked,rank,opacshow,syntax) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ? )");
- $sth->execute($input->param('host'), $input->param('port'), $input->param('db'), $input->param('userid'),
- $input->param('password'), $input->param('searchfield'),$input->param('checked')?1:0, $input->param('rank'),
- $input->param('opacshow')?1:0,$input->param('syntax') );
+ $sth=$dbh->prepare("insert into z3950servers (host,port,db,userid,password,name,checked,rank,syntax) values (?, ?, ?, ?, ?, ?, ?, ?,?)");
+ $sth->execute($input->param('host'),
+ $input->param('port'),
+ $input->param('db'),
+ $input->param('userid'),
+ $input->param('password'),
+ $input->param('searchfield'),
+ $input->param('checked'),
+ $input->param('rank'),
+ $input->param('syntax'),
+ );
}
$sth->finish;
# END $OP eq ADD_VALIDATE
$template->param(delete_confirm => 1);
my $dbh = C4::Context->dbh;
- my $sth2=$dbh->prepare("select * from z3950servers where (name = ?) order by rank,name");
+ my $sth2=$dbh->prepare("select host,port,db,userid,password,name,id,checked,rank,syntax from z3950servers where (name = ?) order by rank,name");
$sth2->execute($searchfield);
my $data=$sth2->fetchrow_hashref;
$sth2->finish;
db => $data->{'db'},
userid => $data->{'userid'},
password => $data->{'password'},
- checked => CGI::checkbox(-name=>'checked',
- -checked=> $data->{'checked'}?'checked':'',
- -value=> 1,
- -label => '',
- -id=> 'checked'),
- opacshow => CGI::checkbox(-name=>'opacshow',
- -checked=> $data->{'opacshow'}?'checked':'',
- -value=> 1,
- -label => '',
- -id=> 'opacshow'),
+ checked => $data->{'checked'},
rank => $data->{'rank'});
# END $OP eq DELETE_CONFIRM
userid =>$results->[$i]{'userid'},
password => ($results->[$i]{'password'}) ? ('#######') : (' '),
checked => $results->[$i]{'checked'},
- opacshow => $results->[$i]{'opacshow'},
rank => $results->[$i]{'rank'},
syntax => $results->[$i]{'syntax'},
toggle => $toggle);
nextpage => $offset+$pagesize);
}
} #---- END $OP eq DEFAULT
-
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
# Suite 330, Boston, MA 02111-1307 USA
use strict;
-
+require Exporter;
use CGI;
+use C4::Interface::CGI::Output;
use C4::Auth;
+
use C4::Context;
-use C4::Search;
-use C4::Interface::CGI::Output;
use C4::AuthoritiesMarc;
+use C4::Acquisition;
use C4::Koha; # XXX subfield_is_koha_internal_p
my $query=new CGI;
my $op = $query->param('op');
my $authtypecode = $query->param('authtypecode');
my $index = $query->param('index');
+my $tagid=$query->param('tagid');
my $resultstring = $query->param('result');
my $dbh = C4::Context->dbh;
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (keys %$authtypes) {
- my $selected = 1 if $thisauthtype eq $authtypecode;
- my %row =(value => $thisauthtype,
- selected => $selected,
- authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
- index => $index,
- );
- push @authtypesloop, \%row;
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
+ index => $index,
+ );
+ push @authtypesloop, \%row;
}
if ($op eq "do_search") {
- my @marclist = $query->param('marclist');
-
- my @operator = $query->param('operator');
- my @value = $query->param('value');
-
- $resultsperpage= $query->param('resultsperpage');
- $resultsperpage = 10 ;
-
- my ($results,$total) = authoritysearch($dbh, \@marclist, \@operator, \@value,$startfrom*$resultsperpage, $resultsperpage,$authtypecode);# $orderby);
-
- ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "authorities/searchresultlist-auth.tmpl",
- query => $query,
- type => 'intranet',
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
+ my @marclist = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ $resultsperpage= $query->param('resultsperpage');
+ $resultsperpage = 19 if(!defined $resultsperpage);
+
+ my ($results,$total) = authoritysearch(\@marclist,\@and_or,
+ \@excluding, \@operator, \@value,
+ $startfrom*$resultsperpage, $resultsperpage,$authtypecode);# $orderby);
# multi page display gestion
my $displaynext=0;
my @marclist_ini = $query->param('marclist'); # get marclist again, as the previous one has been modified by catalogsearch (mainentry replaced by field name
for(my $i = 0 ; $i <= $#marclist ; $i++) {
push @field_data, { term => "marclist", val=>$marclist_ini[$i] };
+ push @field_data, { term => "and_or", val=>$and_or[$i] };
+ push @field_data, { term => "excluding", val=>$excluding[$i] };
push @field_data, { term => "operator", val=>$operator[$i] };
push @field_data, { term => "value", val=>$value[$i] };
}
} else {
$to = (($startfrom+1)*$resultsperpage);
}
- $template->param(result => $results) if $results;
- $template->param(index => $query->param('index')."");
- $template->param(startfrom=> $startfrom,
- displaynext=> $displaynext,
- displayprev=> $displayprev,
- resultsperpage => $resultsperpage,
- startfromnext => $startfrom+1,
- startfromprev => $startfrom-1,
- index => $index,
- searchdata=>\@field_data,
- total=>$total,
- from=>$from,
- to=>$to,
- numbers=>\@numbers,
- authtypecode =>$authtypecode,
- resultstring =>$value[0],
- );
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "authorities/searchresultlist-auth.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ $template->param(result => $results) if $results;
+ $template->param(index => $query->param('index')."");
+ $template->param(startfrom=> $startfrom,
+ displaynext=> $displaynext,
+ displayprev=> $displayprev,
+ resultsperpage => $resultsperpage,
+ startfromnext => $startfrom+1,
+ startfromprev => $startfrom-1,
+ index => $index,
+ tagid => $tagid,
+ searchdata=>\@field_data,
+ total=>$total,
+ from=>$from,
+ to=>$to,
+ numbers=>\@numbers,
+ authtypecode =>$authtypecode,
+ mainmainstring =>$value[0],
+ mainstring =>$value[1],
+ anystring =>$value[2],
+ );
} else {
- ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "authorities/auth_finder.tmpl",
- query => $query,
- type => 'intranet',
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
-
- $template->param(index=>$query->param('index')."",
- resultstring => $resultstring,
- );
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "authorities/auth_finder.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ $template->param(index=>$query->param('index')."",
+ tagid => $tagid,
+ resultstring => $resultstring,
+ );
}
$template->param(authtypesloop => \@authtypesloop,
- authtypecode => $authtypecode,
- nonav=>"1",);
+ authtypecode => $authtypecode,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
# Print the page
output_html_with_http_headers $query, $cookie, $template->output;
# Suite 330, Boston, MA 02111-1307 USA
use strict;
-
+require Exporter;
use CGI;
use C4::Auth;
-use C4::Context;
-use C4::Search;
+use C4::Context;
+use C4::Auth;
+use C4::Output;
use C4::Interface::CGI::Output;
use C4::AuthoritiesMarc;
+#use C4::Biblio;
+use C4::Acquisition;
use C4::Koha; # XXX subfield_is_koha_internal_p
my $query=new CGI;
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (keys %$authtypes) {
- my $selected = 1 if $thisauthtype eq $authtypecode;
- my %row =(value => $thisauthtype,
- selected => $selected,
- authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
- index => $index,
- );
- push @authtypesloop, \%row;
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
+ index => $index,
+ );
+ push @authtypesloop, \%row;
}
if ($op eq "do_search") {
- my @marclist = $query->param('marclist');
-
- my @operator = $query->param('operator');
- my @value = $query->param('value');
-
- $resultsperpage= $query->param('resultsperpage');
- $resultsperpage = 10 if(!defined $resultsperpage);
-
- my ($results,$total) = authoritysearch($dbh, \@marclist, \@operator, \@value,$startfrom*$resultsperpage, $resultsperpage,$authtypecode) ;
-
-
- ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "authorities/linkresultlist-auth.tmpl",
- query => $query,
- type => 'intranet',
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
-
- # multi page display gestion
- my $displaynext=0;
- my $displayprev=$startfrom;
- if(($total - (($startfrom+1)*($resultsperpage))) > 0 ) {
- $displaynext = 1;
- }
-
- my @field_data = ();
-
-
- my @marclist_ini = $query->param('marclist'); # get marclist again, as the previous one has been modified by authoritysearch (mainentry replaced by field name
- for(my $i = 0 ; $i <= $#marclist ; $i++) {
- push @field_data, { term => "marclist", val=>$marclist_ini[$i] };
- push @field_data, { term => "operator", val=>$operator[$i] };
- push @field_data, { term => "value", val=>$value[$i] };
- }
-
- my @numbers = ();
-
- if ($total>$resultsperpage) {
- for (my $i=1; $i<$total/$resultsperpage+1; $i++) {
- if ($i<16) {
- my $highlight=0;
- ($startfrom==($i-1)) && ($highlight=1);
- push @numbers, { number => $i,
- highlight => $highlight ,
- searchdata=> \@field_data,
- startfrom => ($i-1)};
- }
- }
- }
-
- my $from = $startfrom*$resultsperpage+1;
- my $to;
-
- if($total < (($startfrom+1)*$resultsperpage)) {
- $to = $total;
- } else {
- $to = (($startfrom+1)*$resultsperpage);
- }
- $template->param(result => $results) if $results;
- $template->param(index => $query->param('index')."");
- $template->param(startfrom=> $startfrom,
- displaynext=> $displaynext,
- displayprev=> $displayprev,
- resultsperpage => $resultsperpage,
- startfromnext => $startfrom+1,
- startfromprev => $startfrom-1,
- index => $index,
- searchdata=>\@field_data,
- total=>$total,
- from=>$from,
- to=>$to,
- numbers=>\@numbers,
- authtypecode =>$authtypecode,
- resultstring =>$value[0],
- );
+ my @marclist = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ $resultsperpage= $query->param('resultsperpage');
+ $resultsperpage = 19 if(!defined $resultsperpage);
+
+ my ($results,$total) = authoritysearch($dbh, \@marclist,\@and_or,
+ \@excluding, \@operator, \@value,
+ $startfrom*$resultsperpage, $resultsperpage,$authtypecode);# $orderby);
+
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "authorities/linkresultlist-auth.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ # multi page display gestion
+ my $displaynext=0;
+ my $displayprev=$startfrom;
+ if(($total - (($startfrom+1)*($resultsperpage))) > 0 ) {
+ $displaynext = 1;
+ }
+
+ my @field_data = ();
+
+ # get marclist again, as the previous one has been modified by catalogsearch
+ my @marclist_ini = $query->param('marclist');
+ for(my $i = 0 ; $i <= $#marclist ; $i++) {
+ push @field_data, { term => "marclist", val=>$marclist_ini[$i] };
+ push @field_data, { term => "and_or", val=>$and_or[$i] };
+ push @field_data, { term => "excluding", val=>$excluding[$i] };
+ push @field_data, { term => "operator", val=>$operator[$i] };
+ push @field_data, { term => "value", val=>$value[$i] };
+ }
+
+ my @numbers = ();
+
+ if ($total>$resultsperpage) {
+ for (my $i=1; $i<$total/$resultsperpage+1; $i++) {
+ if ($i<16) {
+ my $highlight=0;
+ ($startfrom==($i-1)) && ($highlight=1);
+ push @numbers, { number => $i,
+ highlight => $highlight ,
+ searchdata=> \@field_data,
+ startfrom => ($i-1)};
+ }
+ }
+ }
+
+ my $from = $startfrom*$resultsperpage+1;
+ my $to;
+
+ if($total < (($startfrom+1)*$resultsperpage)) {
+ $to = $total;
+ } else {
+ $to = (($startfrom+1)*$resultsperpage);
+ }
+ $template->param(result => $results) if $results;
+ $template->param(index => $query->param('index')."");
+ $template->param(startfrom=> $startfrom,
+ displaynext=> $displaynext,
+ displayprev=> $displayprev,
+ resultsperpage => $resultsperpage,
+ startfromnext => $startfrom+1,
+ startfromprev => $startfrom-1,
+ index => $index,
+ searchdata=>\@field_data,
+ total=>$total,
+ from=>$from,
+ to=>$to,
+ numbers=>\@numbers,
+ authtypecode =>$authtypecode,
+ resultstring =>$value[0],
+ );
} else {
- ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "authorities/auth_linker.tmpl",
- query => $query,
- type => 'intranet',
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
-
- $template->param(index=>$query->param('index')."",
- resultstring => $resultstring,
-
- );
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "authorities/auth_linker.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ $template->param(index=>$query->param('index')."",
+ resultstring => $resultstring,
+
+ );
}
$template->param(authtypesloop => \@authtypesloop,
- authtypecode => $authtypecode,
- nonav=>"1",);
+ authtypecode => $authtypecode,
+ nonav=>"1",);
# Print the page
output_html_with_http_headers $query, $cookie, $template->output;
# Suite 330, Boston, MA 02111-1307 USA
use strict;
+require Exporter;
use CGI;
use C4::Auth;
+
use C4::Context;
+use C4::Auth;
+use C4::Output;
use C4::Interface::CGI::Output;
use C4::AuthoritiesMarc;
+use C4::Acquisition;
use C4::Koha; # XXX subfield_is_koha_internal_p
use C4::Biblio;
-
my $query=new CGI;
my $op = $query->param('op');
my $authtypecode = $query->param('authtypecode');
my $dbh = C4::Context->dbh;
-my $mergefrom=$query->param('mergefrom');
-my $mergeto=$query->param('mergeto');
-my $startfrom=$query->param('startfrom');
+
my $authid=$query->param('authid');
-$startfrom=0 if(!defined $startfrom);
my ($template, $loggedinuser, $cookie);
-my $resultsperpage;
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (sort { $authtypes->{$a} <=> $authtypes->{$b} } keys %$authtypes) {
my $selected = 1 if $thisauthtype eq $authtypecode;
my %row =(value => $thisauthtype,
- selected => $selected,
+ selected => $selected,
authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
);
push @authtypesloop, \%row;
}
-
if ($op eq "do_search") {
my @marclist = $query->param('marclist');
-
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
my @operator = $query->param('operator');
+ my $orderby = $query->param('orderby');
my @value = $query->param('value');
- $resultsperpage= $query->param('resultsperpage');
- $resultsperpage = 10 unless $resultsperpage;
- my @tags;
- my ($results,$total) = authoritysearch($dbh, \@marclist, \@operator, \@value,$startfrom*$resultsperpage, $resultsperpage,$authtypecode) ;
- ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "authorities/searchresultlist.tmpl",
- query => $query,
- type => 'intranet',
- authnotrequired => 0,
- authtypecode=> $authtypecode,
- flagsrequired => {borrowers => 1},
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
+ my $startfrom = $query->param('startfrom') || 1;
+ my $resultsperpage = $query->param('resultsperpage') || 19;
- # multi page display gestion
- my $displaynext=0;
- my $displayprev=$startfrom;
- if(($total - (($startfrom+1)*($resultsperpage))) > 0 ){
- $displaynext = 1;
- }
+ my ($results,$total) = authoritysearch(
+ \@marclist,
+ \@and_or,
+ \@excluding,
+ \@operator,
+ \@value,
+ ($startfrom - 1)*$resultsperpage,
+ $resultsperpage,
+ $authtypecode,
+ $orderby
+ );
+
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({
+ template_name => "authorities/searchresultlist.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
my @field_data = ();
- # we must get parameters once again. Because if there is a mainentry, it has been replaced by something else during the search, thus the links next/previous would not work anymore
+ # we must get parameters once again. Because if there is a mainentry, it
+ # has been replaced by something else during the search, thus the links
+ # next/previous would not work anymore
my @marclist_ini = $query->param('marclist');
for(my $i = 0 ; $i <= $#marclist ; $i++)
{
- push @field_data, { term => "marclist", val=>$marclist_ini[$i] };
- push @field_data, { term => "operator", val=>$operator[$i] };
- push @field_data, { term => "value", val=>$value[$i] };
+ push @field_data, { term => "marclist" , val=>$marclist_ini[$i] };
+ push @field_data, { term => "and_or" , val=>$and_or[$i] };
+ push @field_data, { term => "excluding" , val=>$excluding[$i] };
+ push @field_data, { term => "operator" , val=>$operator[$i] };
+ push @field_data, { term => "value" , val=>$value[$i] };
}
- my @numbers = ();
-
- if ($total>$resultsperpage)
- {
- for (my $i=1; $i<$total/$resultsperpage+1; $i++)
- {
- if ($i<31)
- {
- my $highlight=0;
- ($startfrom==($i-1)) && ($highlight=1);
- push @numbers, { number => $i,
- highlight => $highlight ,
- searchdata=> \@field_data,
- startfrom => ($i-1)};
- }
- }
- }
+ # construction of the url of each page
+ my $base_url =
+ 'authorities-home.pl?'
+ .join(
+ '&',
+ map { $_->{term}.'='.$_->{val} } @field_data
+ )
+ .'&'
+ .join(
+ '&',
+ map { $_->{term}.'='.$_->{val} } (
+ {term => 'resultsperpage', val => $resultsperpage},
+ {term => 'type' , val => 'intranet'},
+ {term => 'op' , val => 'do_search'},
+ {term => 'authtypecode' , val => $authtypecode},
+ {term => 'orderby' , val => $orderby},
+ )
+ )
+ ;
- my $from = $startfrom*$resultsperpage+1;
+ my $from = ($startfrom - 1) * $resultsperpage + 1;
my $to;
- if($total < (($startfrom+1)*$resultsperpage))
- {
+ if ($total < $startfrom * $resultsperpage) {
$to = $total;
- } else {
- $to = (($startfrom+1)*$resultsperpage);
}
+ else {
+ $to = $startfrom * $resultsperpage;
+ }
+
$template->param(result => $results) if $results;
+
$template->param(
- startfrom=> $startfrom,
- displaynext=> $displaynext,
- displayprev=> $displayprev,
- resultsperpage => $resultsperpage,
- startfromnext => $startfrom+1,
- startfromprev => $startfrom-1,
- searchdata=>\@field_data,
- total=>$total,
- from=>$from,
- to=>$to,
- numbers=>\@numbers,
- authtypecode=>$authtypecode,
- );
+ pagination_bar => pagination_bar(
+ $base_url,
+ int($total/$resultsperpage)+1,
+ $startfrom,
+ 'startfrom'
+ ),
+ total=>$total,
+ from=>$from,
+ to=>$to,
+ isEDITORS => $authtypecode eq 'EDITORS',
+ );
} elsif ($op eq "delete") {
- &AUTHdelauthority($dbh,$authid);
+ &AUTHdelauthority($dbh,$authid, 1);
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/authorities-home.tmpl",
flagsrequired => {catalogue => 1},
debug => 1,
});
+# $template->param("statements" => \@statements,
+# "nbstatements" => $nbstatements);
+}
+elsif ($op eq "AddStatement") {
-
-}elsif ($op eq "merge") {
-
-
- my $MARCfrom = XMLgetauthorityhash($dbh,$mergefrom);
- my $MARCto = XMLgetauthorityhash($dbh,$mergeto);
- merge($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto);
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/authorities-home.tmpl",
query => $query,
flagsrequired => {catalogue => 1},
debug => 1,
});
-}else {
+
+ # Gets the entered information
+ my @marcfields = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ my @statements = ();
+
+ # List of the marc tags to display
+ my $marcarray = create_marclist();
+
+ my $nbstatements = $query->param('nbstatements');
+ $nbstatements = 1 if(!defined $nbstatements);
+
+ for(my $i = 0 ; $i < $nbstatements ; $i++)
+ {
+ my %fields = ();
+
+ # Recreates the old scrolling lists with the previously selected values
+ my $marclist = create_scrolling_list({name=>"marclist",
+ values=> $marcarray,
+ size=> 1,
+ -tabindex=>'',
+ default=>$marcfields[$i],
+ onChange => "sql_update()"}
+ );
+
+ $fields{'marclist'} = $marclist;
+ $fields{'first'} = 1 if($i == 0);
+
+ # Restores the and/or parameters (no need to test the 'and' for activation because it's the default value)
+ $fields{'or'} = 1 if($and_or[$i] eq "or");
+
+ #Restores the "not" parameters
+ $fields{'not'} = 1 if($excluding[$i]);
+
+ #Restores the operators (most common operators first);
+ if($operator[$i] eq "=") { $fields{'eq'} = 1; }
+ elsif($operator[$i] eq "contains") { $fields{'contains'} = 1; }
+ elsif($operator[$i] eq "start") { $fields{'start'} = 1; }
+ elsif($operator[$i] eq ">") { $fields{'gt'} = 1; } #greater than
+ elsif($operator[$i] eq ">=") { $fields{'ge'} = 1; } #greater or equal
+ elsif($operator[$i] eq "<") { $fields{'lt'} = 1; } #lower than
+ elsif($operator[$i] eq "<=") { $fields{'le'} = 1; } #lower or equal
+
+ #Restores the value
+ $fields{'value'} = $value[$i];
+
+ push @statements, \%fields;
+ }
+ $nbstatements++;
+
+ # The new scrolling list
+ my $marclist = create_scrolling_list({name=>"marclist",
+ values=> $marcarray,
+ size=>1,
+ -tabindex=>'',
+ onChange => "sql_update()"});
+ push @statements, {"marclist" => $marclist };
+
+ $template->param("statements" => \@statements,
+ "nbstatements" => $nbstatements);
+
+}
+else {
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/authorities-home.tmpl",
query => $query,
}
-
-
-$template->param(authtypesloop => \@authtypesloop);
+$template->param(authtypesloop => \@authtypesloop,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
# Print the page
output_html_with_http_headers $query, $cookie, $template->output;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::AuthoritiesMarc;
-use C4::Biblio;
use C4::Context;
use C4::Koha; # XXX subfield_is_koha_internal_p
-use Encode;
+use MARC::File::USMARC;
+use MARC::File::XML;
+use C4::Biblio;
use vars qw( $tagslib);
use vars qw( $authorised_values_sth);
use vars qw( $is_a_modif );
-my $input = new CGI;
-my $z3950 = $input->param('z3950');
-my $logstatus=C4::Context->preference('Activate_log');
-my $xml;
+
my $itemtype; # created here because it can be used in build_authorized_values_list sub
+=item find_value
+
+ ($indicators, $value) = find_value($tag, $subfield, $record,$encoding);
+Find the given $subfield in the given $tag in the given
+MARC::Record $record. If the subfield is found, returns
+the (indicators, value) pair; otherwise, (undef, undef) is
+returned.
+=cut
+
+sub find_value {
+ my ($tagfield,$insubfield,$record,$encoding) = @_;
+ my @result;
+ my $indicator;
+ if ($tagfield <10) {
+ if ($record->field($tagfield)) {
+ push @result, $record->field($tagfield)->data();
+ } else {
+ push @result,"";
+ }
+ } else {
+ foreach my $field ($record->field($tagfield)) {
+ my @subfields = $field->subfields();
+ foreach my $subfield (@subfields) {
+ if (@$subfield[0] eq $insubfield) {
+ push @result,@$subfield[1];
+ $indicator = $field->indicator(1).$field->indicator(2);
+ }
+ }
+ }
+ }
+ return($indicator,@result);
+}
=item build_authorized_values_list
-labels => \%authorised_lib,
-override => 1,
-size => 1,
+ -tabindex=>'',
-multiple => 0 );
}
builds the <input ...> entry for a subfield.
=cut
sub create_input () {
- my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth,$id) = @_;
- my $dbh=C4::Context->dbh;
+ my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth) = @_;
+ # must be encoded as utf-8 before it reaches the editor
+ my $dbh=C4::Context->dbh;
$value =~ s/"/"/g;
my %subfield_data;
- $subfield_data{id}=$id;
$subfield_data{tag}=$tag;
$subfield_data{subfield}=$subfield;
$subfield_data{marc_lib}="<span id=\"error$i\">".$tagslib->{$tag}->{$subfield}->{lib}."</span>";
$subfield_data{tag_mandatory}=$tagslib->{$tag}->{mandatory};
$subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
$subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{kohafield}=$tagslib->{$tag}->{$subfield}->{kohafield};
$subfield_data{index} = $i;
$subfield_data{visibility} = "display:none" if (substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "0") ; #check parity
# it's an authorised field
if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
$subfield_data{marc_value}= build_authorized_values_list($tag, $subfield, $value, $dbh,$authorised_values_sth);
- # it's linking authority field to another authority
+ # it's a thesaurus / authority field
+ } elsif ($tagslib->{$tag}->{$subfield}->{frameworkcode}) {
+ $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"67\" maxlength=\"255\" DISABLE READONLY> <a href=\"javascript:Dopop('../authorities/auth_finder.pl?authtypecode=".$tagslib->{$tag}->{$subfield}->{frameworkcode}."&index=$i',$i)\">...</a>";
} elsif ($tagslib->{$tag}->{$subfield}->{link}) {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff;'\" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY> <a style=\"cursor: help;\" href=\"javascript:Dopop('../authorities/auth_linker.pl?index=$id',$id);\">...</a>";
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff;'\" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY> <a style=\"cursor: help;\" href=\"javascript:Dopop('../authorities/auth_linker.pl?index=$i',$i)\">...</a>";
# it's a plugin field
} elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
# opening plugin. Just check wether we are on a developper computer on a production one
# (the cgidir differs)
- my $cgidir = C4::Context->intranetdir ."/cgi-bin/value_builder";
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin/cataloguing/value_builder";
unless (opendir(DIR, "$cgidir")) {
- $cgidir = C4::Context->intranetdir."/value_builder";
+ $cgidir = C4::Context->intranetdir."/cataloguing/value_builder";
}
my $plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
require $plugin;
my $extended_param = plugin_parameters($dbh,$rec,$tagslib,$i,$tabloop);
my ($function_name,$javascript) = plugin_javascript($dbh,$rec,$tagslib,$i,$tabloop);
- $subfield_data{marc_value}="<input tabindex=\"1\" type=\"text\"
name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\" href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
+ $subfield_data{marc_value}="<input tabindex=\"1\" type=\"text\"
name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\" href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
# it's an hidden field
} elsif ($tag eq '') {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"hidden\" name=\"field_value\" id=\"field_value$id\" value=\"$value\">";
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"hidden\" name=\"field_value\" value=\"$value\">";
} elsif (substr($tagslib->{$tag}->{$subfield}->{'hidden'},2,1) gt "1") {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" >";
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" >";
# it's a standard field
} else {
if (length($value) >100) {
- $subfield_data{marc_value}="<textarea tabindex=\"1\" name=\"field_value\" id=\"field_value$id\" cols=\"40\" rows=\"5\" >$value</textarea>";
+ $subfield_data{marc_value}="<textarea tabindex=\"1\" name=\"field_value\" cols=\"40\" rows=\"5\" >$value</textarea>";
} else {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"50\">"; #"
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"50\">"; #"
}
}
return \%subfield_data;
}
-sub build_tabs ($$$;$){
- my($template, $xmlhash, $dbh,$addedfield) = @_;
+sub build_tabs ($$$$) {
+ my($template, $record, $dbh,$encoding) = @_;
# fill arrays
my @loop_data =();
my $tag;
my $i=0;
-my $id=100;
-my ($authidtagfield,$authidtagsubfield)=MARCfind_marc_from_kohafield("authid","authorities");
my $authorised_values_sth = $dbh->prepare("select authorised_value,lib
from authorised_values
where category=? order by lib");
-my $author;
-my $controlfields;
-my $leader;
-if ($xmlhash){
- $author=$xmlhash->{'datafield'};
- $controlfields=$xmlhash->{'controlfield'};
- $leader=$xmlhash->{'leader'};
-}
- my @BIG_LOOP;
-my %built;
+
# loop through each tab 0 through 9
for (my $tabloop = 0; $tabloop <= 9; $tabloop++) {
my @loop_data = ();
foreach my $tag (sort(keys (%{$tagslib}))) {
my $indicator;
- # if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab.
- # if MARC::Record is empty => use tab as master loop.
- if ($xmlhash) {
- ####
-
- my %tagdefined;
- my %definedsubfields;
- my $hiddenrequired;
- my ($ind1,$ind2);
-
- if ($tag>9){
- next if ($tag eq $authidtagfield); #we do not want authid to duplicate
-
- foreach my $data (@$author){
- $hiddenrequired=0;
+ # if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab.
+ # if MARC::Record is empty => use tab as master loop.
+ if ($record ne -1 && ($record->field($tag) || $tag eq '000')) {
+ my @fields;
+ if ($tag ne '000') {
+ @fields = $record->field($tag);
+ } else {
+ push @fields,$record->leader();
+ }
+ foreach my $field (@fields) {
my @subfields_data;
- undef %definedsubfields;
- if ($data->{'tag'} eq $tag){
- $tagdefined{$tag}=1 ;
- if ($built{$tag}==1){
- $hiddenrequired=1;
- }
- $ind1=" ";
- $ind2=" ";
- foreach my $subfieldcode ( $data->{'subfield'}){
- foreach my $code ( @$subfieldcode){
- next if ($tagslib->{$tag}->{$code->{'code'}}->{tab} ne $tabloop);
- my $subfield=$code->{'code'} ;
- my $value=$code->{'content'};
- $definedsubfields{$tag.$subfield}=1 ;
- $built{$tag}=1;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id)) ;
- $i++ ;
- }
- } ##each subfield
- $ind1=$data->{'ind1'};
- $ind2= $data->{'ind2'};
-
- if ($hiddenrequired && $#loop_data >=0 && $loop_data[$#loop_data]->{'tag'} eq $tag) {
- my @hiddensubfields_data;
- my %tag_data;
- push(@hiddensubfields_data, &create_input('','','',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $tag_data{tag} = '';
- $tag_data{tag_lib} = '';
- $tag_data{indicator} = '';
- $tag_data{subfield_loop} = \@hiddensubfields_data;
- push (@loop_data, \%tag_data);
- $i++;
- }
- # now, loop again to add parameter subfield that are not in the MARC::Record
-
- foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if (length $subfield !=1);
+ if ($tag<10) {
+ my ($value,$subfield);
+ if ($tag ne '000') {
+ $value=$field->data();
+ $subfield="@";
+ } else {
+ $value = $field;
+ $subfield='@';
+ }
next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) >1) ); #check for visibility flag
- next if ($definedsubfields{$tag.$subfield} );
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $definedsubfields{$tag.$subfield}=1;
- $i++;
- }
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = $ind1.$ind2 if ($tag>=10);
- $tag_data{subfield_loop} = \@subfields_data;
- push (@loop_data, \%tag_data);
-
- }
- $id++;
- }## if tag matches
-
- }#eachdata
- }else{ ## tag <10
- next if ($tag eq $authidtagfield); #we do not want authid to duplicate
-
- if ($tag eq "000" || $tag eq "LDR"){
- my $subfield="@";
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- my @subfields_data;
- my $value=$leader->[0] if $leader->[0];
- $tagdefined{$tag}=1 ;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{subfield_loop} = \@subfields_data;
- $tag_data{fixedfield} = 1;
- push (@loop_data, \%tag_data);
- }
- }else{
- foreach my $control (@$controlfields){
- my $subfield="@";
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ($tagslib->{$tag} eq $authidtagfield);
- my @subfields_data;
- if ($control->{'tag'} eq $tag){
- $hiddenrequired=0;
- $tagdefined{$tag}=1;
- if ($built{$tag}==1){$hiddenrequired=1;}
- my $value=$control->{'content'} ;
- $definedsubfields{$tag.'@'}=1;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
+ # next if ($tagslib->{$tag}->{$subfield}->{kohafield} eq 'auth_header.authid');
+ push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
$i++;
-
- $built{$tag}=1;
- ###hiddenrequired
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{subfield_loop} = \@subfields_data;
- $tag_data{fixedfield} = 1;
- push (@loop_data, \%tag_data);
+ } else {
+ my @subfields=$field->subfields();
+ foreach my $subfieldcount (0..$#subfields) {
+ my $subfield=$subfields[$subfieldcount][0];
+ my $value=$subfields[$subfieldcount][1];
+ next if (length $subfield !=1);
+ next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
}
- $id++;
- }## tag matches
- }# each control
- }
- }##tag >9
-
-
- ##### Any remaining tag
- my @subfields_data;
- # now, loop again to add parameter subfield that are not in the MARC::Record
+# now, loop again to add parameter subfield that are not in the MARC::Record
foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if ($tagdefined{$tag} );
next if (length $subfield !=1);
next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) > 1) ); #check for visibility flag
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $tagdefined{$tag.$subfield}=1;
+ next if ($tag<10);
+ next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
+ next if (defined($field->subfield($subfield)));
+ push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
$i++;
}
if ($#subfields_data >= 0) {
$tag_data{tag} = $tag;
$tag_data{tag_lib} = $tagslib->{$tag}->{lib};
$tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = $ind1.$ind2 if ($tag>=10);
+ $tag_data{indicator} = $record->field($tag)->indicator(1). $record->field($tag)->indicator(2) if ($tag>=10);
$tag_data{subfield_loop} = \@subfields_data;
if ($tag<10) {
- $tag_data{fixedfield} = 1;
- }
+ $tag_data{fixedfield} = 1;
+ }
push (@loop_data, \%tag_data);
}
-
-
- if ($addedfield eq $tag) {
- my %tag_data;
+# If there is more than 1 field, add an empty hidden field as separator.
+ if ($#fields >=1 && $#loop_data >=0 && $loop_data[$#loop_data]->{'tag'} eq $tag) {
my @subfields_data;
- $id++;
- $tagdefined{$tag}=1 ;
- foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if (length $subfield !=1);
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) >1) ); #check for visibility flag
- $addedfield="";
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
- }
- if ($#subfields_data >= 0) {
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = ' ' if ($tag>=10);
+ my %tag_data;
+ push(@subfields_data, &create_input('','','',$i,$tabloop,$record,$authorised_values_sth));
+ $tag_data{tag} = '';
+ $tag_data{tag_lib} = '';
+ $tag_data{indicator} = '';
$tag_data{subfield_loop} = \@subfields_data;
- if ($tag<10) {
- $tag_data{fixedfield} = 1;
- }
+ if ($tag<10) {
+ $tag_data{fixedfield} = 1;
+ }
push (@loop_data, \%tag_data);
-
- }
-
+ $i++;
}
-
- # if breeding is empty
+ }
+
} else {
my @subfields_data;
foreach my $subfield (sort(keys %{$tagslib->{$tag}})) {
next if (length $subfield !=1);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) >1) ); #check for visibility flag
+ next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
+ push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
$i++;
}
if ($#subfields_data >= 0) {
push (@loop_data, \%tag_data);
}
}
- $id++;
+ }
+ $template->param($tabloop."XX" =>\@loop_data);
}
- if ($#loop_data >=0) {
- my %big_loop_line;
- $big_loop_line{number}=$tabloop;
- $big_loop_line{innerloop}=\@loop_data;
- push @BIG_LOOP,\%big_loop_line;
- }
-# $template->param($tabloop."XX" =>\@loop_data);
- $template->param(BIG_LOOP => \@BIG_LOOP);
-}## tab loop
}
$subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
$subfield_data{marc_mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
$subfield_data{marc_repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
- $subfield_data{marc_value}="<input type=\"hidden\" name=\"field_value[]\">";
+ $subfield_data{marc_value}="<input type=\"hidden\" name=\"field_value[]\">";
push(@loop_data, \%subfield_data);
$i++
}
# MAIN
#=========================
my $input = new CGI;
+my $z3950 = $input->param('z3950');
my $error = $input->param('error');
my $authid=$input->param('authid'); # if authid exists, it's a modif, not a new authority.
-my $z3950 = $input->param('z3950');
my $op = $input->param('op');
my $nonav = $input->param('nonav');
my $myindex = $input->param('index');
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {editauthorities => 1},
debug => 1,
});
$template->param(nonav => $nonav,index=>$myindex,authtypecode=>$authtypecode,);
$tagslib = AUTHgettagslib($dbh,1,$authtypecode);
-
-my $xmlhash;
-my $xml;
-$xmlhash = XMLgetauthorityhash($dbh,$authid) if ($authid);
-
-
+my $record=-1;
+my $encoding="";
+$record = AUTHgetauthority($dbh,$authid) if ($authid);
my ($oldauthnumtagfield,$oldauthnumtagsubfield);
my ($oldauthtypetagfield,$oldauthtypetagsubfield);
$is_a_modif=0;
if ($authid) {
$is_a_modif=1;
- ($oldauthnumtagfield,$oldauthnumtagsubfield) = MARCfind_marc_from_kohafield("authid","authorities");
- ($oldauthtypetagfield,$oldauthtypetagsubfield) = MARCfind_marc_from_kohafield("authtypecode","authorities");
+ ($oldauthnumtagfield,$oldauthnumtagsubfield) = &AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
+ ($oldauthtypetagfield,$oldauthtypetagsubfield) = &AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
}
#------------------------------------------------------------------------------------------------------------------------------
# build indicator hash.
my @ind_tag = $input->param('ind_tag');
my @indicator = $input->param('indicator');
-## check for malformed xml -- non UTF-8 like (MARC8) will break xml without warning
-### This usually happens with data coming from other Z3950 servers
-## Slows the saving process so comment out at your own risk
-eval{
- $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
-};
-
- if ($@){
-warn $@;
- $template->param(error =>1,xmlerror=>1,);
-goto FINAL;
- }; # check for a duplicate
-###Authorities need the XML header unlike biblios
-$xml='<?xml version="1.0" encoding="UTF-8"?>'.$xml;
- my $xmlhash=XML_xml2hash_onerecord($xml);
- my ($duplicateauthid,$duplicateauthvalue) = C4::AuthoritiesMarc::FindDuplicateauth($xmlhash,$authtypecode) if ($op eq "add") && (!$is_a_modif);
-#warn "duplicate:$duplicateauthid,$duplicateauthvalue";
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+# warn $record->as_formatted;
+ warn $xml;
+ my $record=MARC::Record->new_from_xml($xml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
+ $record->encoding('UTF-8');
+ #warn $record->as_formatted;
+ # check for a duplicate
+ my ($duplicateauthid,$duplicateauthvalue) = C4::AuthoritiesMarc::FindDuplicate($record,$authtypecode) if ($op eq "add") && (!$is_a_modif);
+warn "duplicate:$duplicateauthid,$duplicateauthvalue";
my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
- # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
+# it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
if (!$duplicateauthid or $confirm_not_duplicate) {
# warn "noduplicate";
if ($is_a_modif ) {
- $authid=AUTHmodauthority($dbh,$authid,$xmlhash,$authtypecode);
+ $authid=AUTHmodauthority($dbh,$authid,$record,$authtypecode,1);
} else {
- $authid = AUTHaddauthority($dbh,$xmlhash,'',$authtypecode);
+ ($authid) = AUTHaddauthority($dbh,$record,$authid,$authtypecode);
}
# now, redirect to detail page
- if ($nonav){
+# if ($nonav){
#warn ($myindex,$nonav);
- print $input->redirect("auth_finder.pl?index=$myindex&nonav=$nonav&authtypecode=$authtypecode");
- }else{
- print $input->redirect("detail.pl?nonav=$nonav&authid=$authid");
- }
+# print $input->redirect("auth_finder.pl?index=$myindex&nonav=$nonav&authtypecode=$authtypecode");
+# }else{
+ print $input->redirect("detail.pl?authid=$authid");
+# }
exit;
- } else {
-FINAL:
-#warn "duplicate";
+ } else {
# it may be a duplicate, warn the user and do nothing
- build_tabs ($template, $xmlhash, $dbh);
- build_hidden_data;
- $template->param(authid =>$authid,
- duplicateauthid => $duplicateauthid,
- duplicateauthvalue => $duplicateauthvalue,
- );
- }
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(authid =>$authid,
+ duplicateauthid => $duplicateauthid,
+ duplicateauthvalue => $duplicateauthvalue,
+ );
+ }
#------------------------------------------------------------------------------------------------------------------------------
} elsif ($op eq "addfield") {
#------------------------------------------------------------------------------------------------------------------------------
my $addedfield = $input->param('addfield_field');
+ my $tagaddfield_subfield = $input->param('addfield_subfield');
my @tags = $input->param('tag');
my @subfields = $input->param('subfield');
my @values = $input->param('field_value');
my @ind_tag = $input->param('ind_tag');
my @indicator = $input->param('indicator');
my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
- $xml='<?xml version="1.0" encoding="UTF-8"?>'.$xml;
- my $xmlhash=XML_xml2hash_onerecord($xml);
+ my $record=MARC::Record->new_from_xml($xml,'UTF-8');
+ $record->encoding('UTF-8');
# adding an empty field
- build_tabs ($template, $xmlhash, $dbh,$addedfield);
+ my $field = MARC::Field->new("$addedfield",'','','$tagaddfield_subfield' => "");
+ $record->append_fields($field);
+ build_tabs ($template, $record, $dbh,$encoding);
build_hidden_data;
$template->param(
authid => $authid,);
{
$authid = "";
}
- build_tabs ($template, $xmlhash, $dbh);
+ build_tabs ($template, $record, $dbh,$encoding);
build_hidden_data;
$template->param(oldauthtypetagfield=>$oldauthtypetagfield, oldauthtypetagsubfield=>$oldauthtypetagsubfield,
oldauthnumtagfield=>$oldauthnumtagfield, oldauthnumtagsubfield=>$oldauthnumtagsubfield,
authid => $authid , authtypecode=>$authtypecode, );
}
+#unless ($op) {
+# warn "BUILDING";
+# build_tabs ($template, $record, $dbh,$encoding);
+# build_hidden_data;
+#}
$template->param(
authid => $authid,
authtypecode => $authtypecode,
linkid=>$linkid,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
- );
+ );
my $authtypes = getauthtypes;
my @authtypesloop;
$template->param(authtypesloop => \@authtypesloop,
authtypetext => $authtypes->{$authtypecode}{'authtypetext'},
- nonav=>$nonav,);
+ hide_marc => C4::Context->preference('hide_marc'),
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
=head1 NAME
+etail.pl : script to show an authority in MARC format
=head1 SYNOPSIS
This script needs an authid
-
+It shows the authority in a (nice) MARC format depending on authority MARC
+parameters tables.
=head1 FUNCTIONS
use strict;
+require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
+use MARC::Record;
use C4::Koha;
-use C4::Biblio;
+
+
my $query=new CGI;
my $dbh=C4::Context->dbh;
my $authid = $query->param('authid');
-my $index=$query->param('index');
+my $index = $query->param('index');
+my $tagid = $query->param('tagid');
my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
-my ($dummyfield,$linkidsubfield)=MARCfind_marc_from_kohafield("auth_biblio_link_subf","biblios");
+
my $auth_type = AUTHgetauth_type($authtypecode);
-#warn "$authid =$authtypecode ".$auth_type->{auth_tag_to_report};
+ warn "XX = ".$auth_type->{auth_tag_to_report};
-my $record =XMLgetauthorityhash($dbh,$authid) if $authid;
+my $record =AUTHgetauthority($dbh,$authid);
+ warn "record auth :".$record->as_formatted;
# open template
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/blinddetail-biblio-search.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {catalogue => 1},
+ flagsrequired => {editauthorities => 1},
debug => 1,
});
my $tag;
my @loop_data =();
if ($authid) {
- my @record_subs=XML_readline_withtags($record,"","",$auth_type->{auth_tag_to_report});
- ##Put the result in a hash
- my %filled_subfield;
- foreach my $subfield (@record_subs) {
- $filled_subfield{$subfield->[0]}=$subfield->[1];
- }
- my @subfields_data;
-
+ foreach my $field ($record->field($auth_type->{auth_tag_to_report})) {
+ my @subfields_data;
+ my @subf=$field->subfields;
# loop through each subfield
- foreach my $subfield ('a'..'z') {
+ my %result;
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+ $result{$subf[$i][0]}.=$subf[$i][1]."|";
+ }
+ foreach (keys %result) {
my %subfield_data;
- $subfield_data{marc_value}=$filled_subfield{$subfield} ;
- $subfield_data{marc_subfield}=$subfield;
- $subfield_data{marc_tag}=$auth_type->{auth_tag_to_report};
+ chop $result{$_};
+ $subfield_data{marc_value}=$result{$_};
+ $subfield_data{marc_subfield}=$_;
+# $subfield_data{marc_tag}=$field->tag();
push(@subfields_data, \%subfield_data);
}
if ($#subfields_data>=0) {
my %tag_data;
- $tag_data{tag}=$auth_type->{auth_tag_to_report}.' -'. $tagslib->{$auth_type->{auth_tag_to_report}}->{lib};
+ $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
$tag_data{subfield} = \@subfields_data;
push (@loop_data, \%tag_data);
}
-
+ }
} else {
# authid is empty => the user want to empty the entry.
my @subfields_data;
$subfield_data{marc_subfield}=$subfield;
push(@subfields_data, \%subfield_data);
}
- foreach my $subfield ('0'..'9') {
- my %subfield_data;
- $subfield_data{marc_value}='';
- $subfield_data{marc_subfield}=$subfield;
- push(@subfields_data, \%subfield_data);
- }
+# if ($#subfields_data>=0) {
my %tag_data;
+# $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
$tag_data{subfield} = \@subfields_data;
push (@loop_data, \%tag_data);
+# }
}
$template->param("0XX" =>\@loop_data);
-
-
-$template->param(authid => $authid?$authid:"", linkidsubfield=>$linkidsubfield,index=>$index,);
+# my $authtypes = getauthtypes;
+# my @authtypesloop;
+# foreach my $thisauthtype (keys %$authtypes) {
+# my $selected = 1 if $thisauthtype eq $authtypecode;
+# my %row =(value => $thisauthtype,
+# selected => $selected,
+# authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
+# );
+# push @authtypesloop, \%row;
+# }
+
+$template->param(authid => $authid?$authid:"",
+# authtypesloop => \@authtypesloop,
+ index => $index,
+ tagid => $tagid,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $query, $cookie, $template->output;
This script needs an authid
+It shows the authority in a (nice) MARC format depending on authority MARC
+parameters tables.
=head1 FUNCTIONS
use strict;
+require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
+use MARC::Record;
use C4::Koha;
-use C4::Biblio;
+
+
my $query=new CGI;
my $dbh=C4::Context->dbh;
my $authtypecode=$query->param('authtypecode');
$authtypecode = &AUTHfind_authtypecode($dbh,$authid) if !$authtypecode;
my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
-my ($linkidfield,$linkidsubfield)=MARCfind_marc_from_kohafield("linkid","authorities");
+my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
my $auth_type = AUTHgetauth_type($authtypecode);
-my $record =XMLgetauthorityhash($dbh,$authid);
+my $record =AUTHgetauthority($dbh,$authid);
# open template
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/blinddetail-linker.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {catalogue => 1},
+ flagsrequired => {editauthorities => 1},
debug => 1,
});
my @loop_data =();
if ($authid) {
-# foreach my $field ($record->field($auth_type->{auth_tag_to_report})) {
-# my @subfields_data;
-# my @subf=$field->subfields;
-# # loop through each subfield
-# for my $i (0..$#subf) {
-# $subf[$i][0] = "@" unless $subf[$i][0];
-# my %subfield_data;
-# $subfield_data{marc_value}=$subf[$i][1];
-# $subfield_data{marc_subfield}=$subf[$i][0];
-# $subfield_data{marc_tag}=$field->tag();
-# push(@subfields_data, \%subfield_data);
-# }
-# if ($#subfields_data>=0) {
-# my %tag_data;
-# $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
-# $tag_data{subfield} = \@subfields_data;
-# push (@loop_data, \%tag_data);
-# }
-# }
-} else {
-# authid is empty => the user want to empty the entry.
- my @subfields_data;
- foreach my $subfield ('0'..'9') {
+ foreach my $field ($record->field($auth_type->{auth_tag_to_report})) {
+ my @subfields_data;
+ my @subf=$field->subfields;
+ # loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
my %subfield_data;
- $subfield_data{marc_value}='';
- $subfield_data{marc_subfield}=$subfield;
+ $subfield_data{marc_value}=$subf[$i][1];
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
push(@subfields_data, \%subfield_data);
}
+ if ($#subfields_data>=0) {
+ my %tag_data;
+ $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = \@subfields_data;
+ push (@loop_data, \%tag_data);
+ }
+ }
+} else {
+# authid is empty => the user want to empty the entry.
+ my @subfields_data;
foreach my $subfield ('a'..'z') {
my %subfield_data;
$subfield_data{marc_value}='';
$subfield_data{marc_subfield}=$subfield;
push(@subfields_data, \%subfield_data);
+
}
- if ($#subfields_data>=0) {
+# if ($#subfields_data>=0) {
my %tag_data;
+# $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
$tag_data{subfield} = \@subfields_data;
push (@loop_data, \%tag_data);
- }
+# }
}
$template->param("0XX" =>\@loop_data);
use strict;
+require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
+use MARC::Record;
use C4::Koha;
+# use C4::Biblio;
+# use C4::Catalogue;
+
my $query=new CGI;
my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
-my $record =XMLgetauthorityhash($dbh,$authid);
+my $record =AUTHgetauthority($dbh,$authid);
# open template
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/detail-biblio-search.tmpl",
# fill arrays
my @loop_data =();
my $tag;
-if ($xmlhash){
# loop through each tab 0 through 9
-my $author=$xmlhash->{'datafield'};
-my $controlfields=$xmlhash->{'controlfield'};
-my $leader=$xmlhash->{'leader'};
-for (my $tabloop = 0; $tabloop<10;$tabloop++) {
+# for (my $tabloop = 0; $tabloop<=10;$tabloop++) {
# loop through each tag
+ my @fields = $record->fields();
my @loop_data =();
- my @subfields_data;
-
- # deal with leader
- unless (($tagslib->{'000'}->{'@'}->{tab} ne $tabloop) || (substr($tagslib->{'000'}->{'@'}->{hidden},1,1)>0)) {
-
- my %subfield_data;
- $subfield_data{marc_value}=$leader->[0] ;
- push(@subfields_data, \%subfield_data);
- my %tag_data;
- $tag_data{tag}='000 -'. $tagslib->{'000'}->{lib};
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- ##Controlfields
-
- foreach my $control (@$controlfields){
+ foreach my $field (@fields) {
+ my @subfields_data;
+ # if tag <10, there's no subfield, use the "@" trick
+ if ($field->tag()<10) {
+# next if ($tagslib->{$field->tag()}->{'@'}->{tab} ne $tabloop);
+ next if ($tagslib->{$field->tag()}->{'@'}->{hidden});
my %subfield_data;
- my %tag_data;
- next if ($tagslib->{$control->{'tag'}}->{'@'}->{tab} ne $tabloop);
- next if (substr($tagslib->{$control->{'tag'}}->{'@'}->{hidden},1,1)>0);
- $subfield_data{marc_value}=$control->{'content'} ;
+ $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{'@'}->{lib};
+ $subfield_data{marc_value}=$field->data();
+ $subfield_data{marc_subfield}='@';
+ $subfield_data{marc_tag}=$field->tag();
push(@subfields_data, \%subfield_data);
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$control->{'tag'}}->{lib};
+ } else {
+ my @subf=$field->subfields;
+ # loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+# next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} ne $tabloop);
+ next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden});
+ my %subfield_data;
+ $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+ if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{isurl}) {
+ $subfield_data{marc_value}="<a href=\"$subf[$i][1]\">$subf[$i][1]</a>";
} else {
- $tag_data{tag}=$control->{'tag'}.' -'. $tagslib->{$control->{'tag'}}->{lib};
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- my $previoustag;
- my %datatags;
- my $i=0;
- foreach my $data (@$author){
- $datatags{$i++}=$data->{'tag'};
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- next if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{tab} ne $tabloop);
- next if (substr($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{hidden},1,1)>0);
- my %subfield_data;
- my $value=$code->{'content'};
- $subfield_data{marc_lib}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{lib};
- $subfield_data{link}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{link};
- if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{isurl}) {
- $subfield_data{marc_value}="<a href=\"$value]\">$value</a>";
- } else {
- $subfield_data{marc_value}=get_authorised_value_desc($data->{'tag'}, $code->{'code'}, $value, '', $dbh);
+ $subfield_data{marc_value}=$subf[$i][1];
+ }
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
}
- $subfield_data{marc_subfield}=$code->{'code'};
- $subfield_data{marc_tag}=$data->{'tag'};
- push(@subfields_data, \%subfield_data);
- }### $code
-
-
+ }
if ($#subfields_data>=0) {
my %tag_data;
- if (($datatags{$i} eq $datatags{$i-1}) && (C4::Context->preference('LabelMARCView') eq 'economical')) {
- $tag_data{tag}="";
- } else {
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$data->{'tag'}}->{lib};
- } else {
- $tag_data{tag}=$data->{'tag'}.' -'. $tagslib->{$data->{'tag'}}->{lib};
- }
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
+ $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = \@subfields_data;
push (@loop_data, \%tag_data);
- undef @subfields_data;
}
- }### each $subfield
}
-
- $template->param($tabloop."XX" =>\@loop_data);
-}
+ $template->param("0XX" =>\@loop_data);
+# }
+# now, build item tab !
+# the main difference is that datas are in lines and not in columns : thus, we build the <th> first, then the values...
+# loop through each tag
+# warning : we may have differents number of columns in each row. Thus, we first build a hash, complete it if necessary
+# then construct template.
+# my @fields = $record->fields();
+# my %witness; #---- stores the list of subfields used at least once, with the "meaning" of the code
+# my @big_array;
+# foreach my $field (@fields) {
+# next if ($field->tag()<10);
+# my @subf=$field->subfields;
+# my %this_row;
+# # loop through each subfield
+# for my $i (0..$#subf) {
+# next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} ne 10);
+# $witness{$subf[$i][0]} = $tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+# $this_row{$subf[$i][0]} =$subf[$i][1];
+# }
+# if (%this_row) {
+# push(@big_array, \%this_row);
+# }
+# }
+# #fill big_row with missing datas
+# foreach my $subfield_code (keys(%witness)) {
+# for (my $i=0;$i<=$#big_array;$i++) {
+# $big_array[$i]{$subfield_code}=" " unless ($big_array[$i]{$subfield_code});
+# }
+# }
+# # now, construct template !
+# my @item_value_loop;
+# my @header_value_loop;
+# for (my $i=0;$i<=$#big_array; $i++) {
+# my $items_data;
+# foreach my $subfield_code (keys(%witness)) {
+# $items_data .="<td>".$big_array[$i]{$subfield_code}."</td>";
+# }
+# my %row_data;
+# $row_data{item_value} = $items_data;
+# push(@item_value_loop,\%row_data);
+# }
+# foreach my $subfield_code (keys(%witness)) {
+# my %header_value;
+# $header_value{header_value} = $witness{$subfield_code};
+# push(@header_value_loop, \%header_value);
+# }
my $authtypes = getauthtypes;
my @authtypesloop;
}
$template->param(authid => $authid,
- authtypesloop => \@authtypesloop, index => $index);
-}
+ authtypesloop => \@authtypesloop, index => $index,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $query, $cookie, $template->output;
-sub get_authorised_value_desc ($$$$$) {
- my($tag, $subfield, $value, $framework, $dbh) = @_;
-
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- return getbranchname($value);
- }
-
- #---- itemtypes
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
- return ItemType($value);
- }
-
- #---- "true" authorized value
- my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
-
- if ($category ne "") {
- my $sth = $dbh->prepare("select lib from authorised_values where category = ? and authorised_value = ?");
- $sth->execute($category, $value);
- my $data = $sth->fetchrow_hashref;
- return $data->{'lib'};
- } else {
- return $value; # if nothing is found return the original value
- }
-}
use strict;
+require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
+use MARC::Record;
use C4::Koha;
+# use C4::Biblio;
+# use C4::Catalogue;
my $query=new CGI;
my $dbh=C4::Context->dbh;
-my $nonav = $query->param('nonav');
-my $authid = $query->param('authid');
-my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
-my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
-
-my $xmlhash =XMLgetauthorityhash($dbh,$authid);
-
-my ($count) = AUTHcount_usage($authid);
-
-#chop;
# open template
my ($template, $loggedinuser, $cookie)
debug => 1,
});
+my $authid = $query->param('authid');
+
+
+
+my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
+my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
+
+my $record;
+if (C4::Context->preference("AuthDisplayHierarchy")){
+ my $trees=BuildUnimarcHierarchies($authid);
+ my @trees = split /;/,$trees ;
+ push @trees,$trees unless (@trees);
+ my @loophierarchies;
+ foreach my $tree (@trees){
+ my @tree=split /,/,$tree;
+ push @tree,$tree unless (@tree);
+ my $cnt=0;
+ my @loophierarchy;
+ foreach my $element (@tree){
+ my %cell;
+ my $elementdata = AUTHgetauthority($dbh,$element);
+ $record= $elementdata if ($authid==$element);
+ push @loophierarchy, BuildUnimarcHierarchy($elementdata,"child".$cnt, $authid);
+ $cnt++;
+ }
+ push @loophierarchies, { 'loopelement' =>\@loophierarchy};
+ }
+ $template->param(
+ 'displayhierarchy' =>C4::Context->preference("AuthDisplayHierarchy"),
+ 'loophierarchies' =>\@loophierarchies,
+ );
+} else {
+ $record=AUTHgetauthority($dbh,$authid);
+}
+my $count = AUTHcount_usage($authid);
+
+# find the marc field/subfield used in biblio by this authority
+my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
+$sth->execute($authtypecode);
+my $biblio_fields;
+while (my ($tagfield) = $sth->fetchrow) {
+ $biblio_fields.= $tagfield."9,";
+}
+chop $biblio_fields;
+
# fill arrays
my @loop_data =();
my $tag;
-if ($xmlhash){
# loop through each tab 0 through 9
-my $author=$xmlhash->{'datafield'};
-my $controlfields=$xmlhash->{'controlfield'};
-my $leader=$xmlhash->{'leader'};
-for (my $tabloop = 0; $tabloop<10;$tabloop++) {
+# for (my $tabloop = 0; $tabloop<=10;$tabloop++) {
# loop through each tag
- my @loop_data =();
- my @subfields_data;
-
- # deal with leader
- unless (($tagslib->{'000'}->{'@'}->{tab} ne $tabloop) || (substr($tagslib->{'000'}->{'@'}->{hidden},1,1)>0)) {
-
+my @fields = $record->fields();
+my @loop_data =();
+foreach my $field (@fields) {
+ my @subfields_data;
+ # if tag <10, there's no subfield, use the "@" trick
+ if ($field->tag()<10) {
+ next if ($tagslib->{$field->tag()}->{'@'}->{hidden});
my %subfield_data;
- $subfield_data{marc_value}=$leader->[0] ;
+ $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{'@'}->{lib};
+ $subfield_data{marc_value}=$field->data();
+ $subfield_data{marc_subfield}='@';
+ $subfield_data{marc_tag}=$field->tag();
push(@subfields_data, \%subfield_data);
- my %tag_data;
- $tag_data{tag}='000 -'. $tagslib->{'000'}->{lib};
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- ##Controlfields
-
- foreach my $control (@$controlfields){
+ } else {
+ my @subf=$field->subfields;
+# loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+ next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden});
my %subfield_data;
- my %tag_data;
- next if ($tagslib->{$control->{'tag'}}->{'@'}->{tab} ne $tabloop);
- next if (substr($tagslib->{$control->{'tag'}}->{'@'}->{hidden},1,1)>0);
- $subfield_data{marc_value}=$control->{'content'} ;
- push(@subfields_data, \%subfield_data);
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$control->{'tag'}}->{lib};
- } else {
- $tag_data{tag}=$control->{'tag'}.' -'. $tagslib->{$control->{'tag'}}->{lib};
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- my $previoustag;
- my %datatags;
- my $i=0;
- foreach my $data (@$author){
- $datatags{$i++}=$data->{'tag'};
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- next if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{tab} ne $tabloop);
- next if (substr($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{hidden},1,1)>0);
- my %subfield_data;
- my $value=$code->{'content'};
- $subfield_data{marc_lib}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{lib};
- $subfield_data{link}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{link};
- if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{isurl}) {
- $subfield_data{marc_value}="<a href=\"$value]\">$value</a>";
+ $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+ if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{isurl}) {
+ $subfield_data{marc_value}="<a href=\"$subf[$i][1]\">$subf[$i][1]</a>";
} else {
- $subfield_data{marc_value}=get_authorised_value_desc($data->{'tag'}, $code->{'code'}, $value, '', $dbh);
+ $subfield_data{marc_value}=$subf[$i][1];
}
- $subfield_data{marc_subfield}=$code->{'code'};
- $subfield_data{marc_tag}=$data->{'tag'};
+ $subfield_data{short_desc} = substr(
+ $tagslib->{ $field->tag() }->{ $subf[$i][0] }->{lib},
+ 0, 20
+ );
+ $subfield_data{long_desc} =
+ $tagslib->{ $field->tag() }->{ $subf[$i][0] }->{lib};
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
push(@subfields_data, \%subfield_data);
- }### $code
-
-
- if ($#subfields_data>=0) {
- my %tag_data;
- if (($datatags{$i} eq $datatags{$i-1}) && (C4::Context->preference('LabelMARCView') eq 'economical')) {
- $tag_data{tag}="";
- } else {
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$data->{'tag'}}->{lib};
- } else {
- $tag_data{tag}=$data->{'tag'}.' -'. $tagslib->{$data->{'tag'}}->{lib};
- }
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
}
- }### each $subfield
}
-
- $template->param($tabloop."XX" =>\@loop_data);
+ if ($#subfields_data>=0) {
+ my %tag_data;
+ $tag_data{tag}=$field->tag().' -'. $tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = \@subfields_data;
+ push (@loop_data, \%tag_data);
+ }
}
+$template->param("0XX" =>\@loop_data);
+
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (keys %$authtypes) {
}
$template->param(authid => $authid,
- count => $count,
- authtypetext => $authtypes->{$authtypecode}{'authtypetext'},
- authtypecode => $authtypes->{$authtypecode}{'authtypecode'},
- authtypesloop => \@authtypesloop);
-$template->param(nonav =>$nonav);
-}### if $xmlash exist
+ count => $count,
+ biblio_fields => $biblio_fields,
+ authtypetext => $authtypes->{$authtypecode}{'authtypetext'},
+ authtypesloop => \@authtypesloop,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $query, $cookie, $template->output;
-sub get_authorised_value_desc ($$$$$) {
- my($tag, $subfield, $value, $framework, $dbh) = @_;
-
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- return getbranchname($value);
- }
-
- #---- itemtypes
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
- return ItemType($value);
- }
-
- #---- "true" authorized value
- my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
-
- if ($category ne "") {
- my $sth = $dbh->prepare("select lib from authorised_values where category = ? and authorised_value = ?");
- $sth->execute($category, $value);
- my $data = $sth->fetchrow_hashref;
- return $data->{'lib'};
- } else {
- return $value; # if nothing is found return the original value
- }
-}
\ No newline at end of file
use C4::Auth;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Database;
-use HTML::Template;
use C4::Context;
use C4::Barcodes::PrinterConfig;
-
-
# This function returns the path to deal with the correct files, considering
# templates set and language.
sub getPath {
- my $type = shift @_;
- my $templatesSet = C4::Context->preference('template');
- my $lang = C4::Context->preference('opaclanguages');
- if ($type eq "intranet") {
- return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
- } else {
- return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
- }
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ( $type eq "intranet" ) {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ }
+ else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
}
# Load a configuration file. Before use this function, check if that file exists.
sub loadConfFromFile {
- my $fileName = shift @_;
- my %keyValues;
- open FILE, "<$fileName";
- while (<FILE>) {
- chomp;
- if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
- $keyValues{$1} = $2;
- }
- }
- close FILE;
- return %keyValues;
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
}
# Save settings to a configuration file. It delete previous configuration settings.
sub saveConfToFile {
- my $fileName = shift @_;
- my %keyValues = %{shift @_};
- my $i;
- open FILE, ">$fileName";
- my $i;
- foreach $i (keys(%keyValues)) {
- print FILE $i." = ".$keyValues{$i}."\n";
- }
- close FILE;
+ my $fileName = shift @_;
+ my %keyValues = %{ shift @_ };
+ my $i;
+ open FILE, ">$fileName";
+ foreach $i ( keys(%keyValues) ) {
+ print FILE $i . " = " . $keyValues{$i} . "\n";
+ }
+ close FILE;
}
# Load the config file.
-my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my $filenameConf =
+ &getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
my %labelConfig = &loadConfFromFile($filenameConf);
my $input = new CGI;
+
# Defines type of page to use in the printer process
-my @labelTable = C4::Barcodes::PrinterConfig::labelsPage($labelConfig{'rows'}, $labelConfig{'columns'});
+my @labelTable =
+ C4::Barcodes::PrinterConfig::labelsPage( $labelConfig{'rows'},
+ $labelConfig{'columns'} );
# It creates a list of posible intervals to choose codes to generate
-my %list = ('continuous' => 'Continuous Range of items', 'individuals' => 'Individual Codes');
+my %list = (
+ 'continuous' => 'Continuous Range of items',
+ 'individuals' => 'Individual Codes'
+);
my @listValues = keys(%list);
-my $rangeType = CGI::scrolling_list(-name => 'rangeType',
- -values => \@listValues,
- -labels => \%list,
- -size => 1,
- -default => ['continuous'],
- -multiple => 0,
- -id => "rangeType",
- -onChange => "changeRange(this)");
+my $rangeType = CGI::scrolling_list(
+ -name => 'rangeType',
+ -values => \@listValues,
+ -labels => \%list,
+ -size => 1,
+ -default => ['continuous'],
+ -multiple => 0,
+ -id => "rangeType",
+ -onChange => "changeRange(this)"
+);
+
# It creates a list of posible standard codifications. First checks if the user has just added a new code.
-if ($input->param('addCode')) {
- my $newCountryName = $input->param('countryName');
- my $newCountryCode = $input->param('countryCode');
-
- my $countryCodesFilename = &getPath("intranet")."/includes/countryCodes/countryCodes.dat";
- open COUNTRY_CODES, ">>$countryCodesFilename";
- print COUNTRY_CODES $newCountryCode." = ".$newCountryName."\n";
- close COUNTRY_CODES;
+if ( $input->param('addCode') ) {
+ my $newCountryName = $input->param('countryName');
+ my $newCountryCode = $input->param('countryCode');
+
+ my $countryCodesFilename =
+ &getPath("intranet") . "/includes/countryCodes/countryCodes.dat";
+ open COUNTRY_CODES, ">>$countryCodesFilename";
+ print COUNTRY_CODES $newCountryCode . " = " . $newCountryName . "\n";
+ close COUNTRY_CODES;
}
# Takes the country codes from a file and use them to set the country list.
-my $countryCodes = &getPath("intranet")."/includes/countryCodes/countryCodes.dat";
-my %list = &loadConfFromFile($countryCodes);
+my $countryCodes =
+ &getPath("intranet") . "/includes/countryCodes/countryCodes.dat";
+%list = &loadConfFromFile($countryCodes);
@listValues = keys(%list);
-my $number_system = CGI::scrolling_list(-name => 'numbersystem',
- -values => \@listValues,
- -labels => \%list,
- -size => 1,
- -multiple => 0);
+my $number_system = CGI::scrolling_list(
+ -name => 'numbersystem',
+ -values => \@listValues,
+ -labels => \%list,
+ -size => 1,
+ -multiple => 0
+);
# Set the script name
my $script_name = "/cgi-bin/koha/barcodes/barcodesGenerator.pl";
-
# Get the template to use
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "barcodes/barcodes.tmpl",
- type => "intranet",
- query => $input,
- authnotrequired => 0,
- flagsrequired => {parameters => 1},
- debug => 1,
- });
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "barcodes/barcodes.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 0,
+ flagsrequired => { tools => 1 },
+ debug => 1,
+ }
+);
# Replace the template values with the real ones
-$template->param(SCRIPT_NAME => $script_name);
-$template->param(NUMBER_SYSTEM => $number_system);
-$template->param(PAGES => $labelConfig{'pageType'});
-$template->param(RANGE_TYPE => $rangeType);
-$template->param(LABEL_TABLE => \@labelTable);
-$template->param(COL_SPAN => $labelConfig{'columns'});
-if ($input->param('error')) {
- $template->param(ERROR => 1);
-} else {
- $template->param(ERROR => 0);
+$template->param( SCRIPT_NAME => $script_name );
+$template->param( NUMBER_SYSTEM => $number_system );
+$template->param( PAGES => $labelConfig{'pageType'} );
+$template->param( RANGE_TYPE => $rangeType );
+$template->param( LABEL_TABLE => \@labelTable );
+$template->param( COL_SPAN => $labelConfig{'columns'} );
+if ( $input->param('error') ) {
+ $template->param( ERROR => 1 );
+}
+else {
+ $template->param( ERROR => 0 );
}
-$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+
# Shows the template with the real values replaced
output_html_with_http_headers $input, $cookie, $template->output;
use CGI;
use C4::Context;
use C4::Output;
-use HTML::Template;
+
+
+#FIXME : module deprecated ?
use PDF::API2;
use PDF::API2::Page;
-use PDF::API2::PDF::Utils;
+use PDF::API2::Util;
use C4::Barcodes::PrinterConfig;
-use Time::localtime;
-
+use Time::localtime;
# This function returns the path to deal with the correct files, considering
# templates set and language.
sub getPath {
- my $type = shift @_;
- my $templatesSet = C4::Context->preference('template');
- my $lang = C4::Context->preference('opaclanguages');
- if ($type eq "intranet") {
- return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
- } else {
- return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
- }
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ( $type eq "intranet" ) {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ }
+ else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
}
# Load a configuration file. Before use this function, check if that file exists.
sub loadConfFromFile {
- my $fileName = shift @_;
- my %keyValues;
- open FILE, "<$fileName";
- while (<FILE>) {
- chomp;
- if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
- $keyValues{$1} = $2;
- }
- }
- close FILE;
- return %keyValues;
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
}
# Save settings to a configuration file. It delete previous configuration settings.
sub saveConfToFile {
- my $fileName = shift @_;
- my %keyValues = %{shift @_};
- my $i;
- open FILE, ">$fileName";
- my $i;
- foreach $i (keys(%keyValues)) {
- print FILE $i." = ".$keyValues{$i}."\n";
- }
- close FILE;
+ my $fileName = shift @_;
+ my %keyValues = %{ shift @_ };
+ my $i;
+ open FILE, ">$fileName";
+ foreach $i ( keys(%keyValues) ) {
+ print FILE $i . " = " . $keyValues{$i} . "\n";
+ }
+ close FILE;
}
# Load the config file.
-my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my $filenameConf =
+ &getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
my %labelConfig = &loadConfFromFile($filenameConf);
# Creates a CGI object and take its parameters
-my $cgi = new CGI;
-my $from = $cgi->param('from');
-my $to = $cgi->param('to');
-my $individualCodes = $cgi->param('individualCodes');
-my $rangeType = $cgi->param('rangeType');
-my $pageType = $cgi->param('pages');
-my $label = $cgi->param('label');
-my $numbersystem = $cgi->param('numbersystem');
+my $cgi = new CGI;
+my $from = $cgi->param('from');
+my $to = $cgi->param('to');
+my $individualCodes = $cgi->param('individualCodes');
+my $rangeType = $cgi->param('rangeType');
+my $pageType = $cgi->param('pages');
+my $label = $cgi->param('label');
+my $numbersystem = $cgi->param('numbersystem');
my $text_under_label = $cgi->param('text_under_label');
# Generate the checksum from an inventary code
sub checksum {
- sub calculateDigit {
- my $code = shift @_;
- my $sum = 0;
- my $odd_parity = 1;
- my $i;
- for ($i = length($code) - 1; $i >= 0; $i--){
- if ( $odd_parity ) {
- $sum = $sum + ( 3 * substr($code, $i, 1) );
- } else {
- $sum = $sum + substr($code, $i, 1); }
- $odd_parity = !$odd_parity;
- }
- my $check_digit = 10 - ($sum%10);
- if ($check_digit==10) {
- $check_digit=0;
- }
- return $code.$check_digit;
- }
-
- my $currentCode = shift @_;
- $currentCode = &calculateDigit($currentCode);
- return $currentCode;
+ sub calculateDigit {
+ my $code = shift @_;
+ my $sum = 0;
+ my $odd_parity = 1;
+ my $i;
+ for ( $i = length($code) - 1 ; $i >= 0 ; $i-- ) {
+ if ($odd_parity) {
+ $sum = $sum + ( 3 * substr( $code, $i, 1 ) );
+ }
+ else {
+ $sum = $sum + substr( $code, $i, 1 );
+ }
+ $odd_parity = !$odd_parity;
+ }
+ my $check_digit = 10 - ( $sum % 10 );
+ if ( $check_digit == 10 ) {
+ $check_digit = 0;
+ }
+ return $code . $check_digit;
+ }
+
+ my $currentCode = shift @_;
+ $currentCode = &calculateDigit($currentCode);
+ return $currentCode;
}
# Assigns a temporary name to the PDF file
sub assingFilename {
- my ($from, $to) = @_;
- my $ip = $cgi->remote_addr();
- my $random = int(rand(1000000));
+ my ( $from, $to ) = @_;
+ my $ip = $cgi->remote_addr();
+ my $random = int( rand(1000000) );
my $timeObj = localtime();
- my ($day, $month, $year, $hour, $min, $sec) = ($timeObj->mday,
- $timeObj->mon + 1,
- $timeObj->year + 1900,
- $timeObj->hour,
- $timeObj->min,
- $timeObj->sec);
- my $tmpFileName = $random.'-'.$ip.'-(From '.$from.' to '.$to.')-['.$day.'.'.$month.'.'.$year.']-['.$hour.':'.$min.':'.$sec.'].pdf';
- return $tmpFileName;
+ my ( $day, $month, $year, $hour, $min, $sec ) = (
+ $timeObj->mday,
+ $timeObj->mon + 1,
+ $timeObj->year + 1900,
+ $timeObj->hour, $timeObj->min, $timeObj->sec
+ );
+ my $tmpFileName =
+ $random . '-' . $ip
+ . '-(From '
+ . $from . ' to '
+ . $to . ')-['
+ . $day . '.'
+ . $month . '.'
+ . $year . ']-['
+ . $hour . ':'
+ . $min . ':'
+ . $sec . '].pdf';
+ return $tmpFileName;
}
+
sub getCallnum {
-#grabs a callnumber for the specified barcode
-my ($barcode) = @_;
-my $query = "select dewey from items,biblioitems where items.biblionumber=biblioitems.biblionumber and items.barcode=?";
-my $dbh = C4::Context->dbh;
-my $sth = $dbh->prepare($query);
-$sth->execute($barcode);
-my ($callnum) = $sth->fetchrow_array();
-warn "Call number is:".$barcode;
-return $callnum;
+
+ #grabs a callnumber for the specified barcode
+ my ($barcode) = @_;
+ my $query =
+"select dewey from items,biblioitems where items.biblionumber=biblioitems.biblionumber and items.barcode=?";
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare($query);
+ $sth->execute($barcode);
+ my ($callnum) = $sth->fetchrow_array();
+ warn "Call number is:" . $barcode;
+ return $callnum;
}
+
# Takes inventary codes from database and if they are between
# the interval specify by parameters, it generates the correspond barcodes
sub barcodesGenerator {
- my ($from, $to, $rangeType, $individualCodes,$text_under_label) = @_;
- # Returns a database handler
- my $dbh = C4::Context->dbh;
- # Create the query to database
- # Assigns a temporary filename for the pdf file
- my $tmpFileName = &assingFilename($from, $to);
- # warn "range type: ".$rangeType;
- if ($rangeType eq 'continuous') {
- # Set the temp directory for pdf´s files
- if (!defined($ENV{'TEMP'})) {
- $ENV{'TEMP'} = '/tmp/';
- }
- $tmpFileName = $ENV{'TEMP'}.$tmpFileName;
- # Creates a PDF object
- my $pdf = PDF::API2->new(-file => $tmpFileName);
- # Set the positions where barcodes are going to be placed
- C4::Barcodes::PrinterConfig::setPositionsForX($labelConfig{'marginLeft'}, $labelConfig{'labelWidth'}, $labelConfig{'columns'}, $labelConfig{'pageType'});
- C4::Barcodes::PrinterConfig::setPositionsForY($labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'}, $labelConfig{'rows'}, $labelConfig{'pageType'});
- # Creates a font object
- my $tr = $pdf->corefont('Helvetica-Bold');
- # Barcode position
- my ($page, $gfx, $text);
- for (my $code=$from; $code<=$to; $code++) {
- # Generetase checksum
- my $codeC = &checksum($code);
- # Generate the corresponde barcode to $code
- # warn "Code is :-->".$codeC."<--";
- my $barcode = $pdf->barcode(-font => $tr, # The font object to use
- -type => 'ean128', # Standard of codification
- -code => $codeC, # Text to codify
- -extn => '012345', # Barcode extension (if it is aplicable)
- -umzn => 10, # Top limit of the finished bar
- -lmzn => 10, # Bottom limit of the finished bar
- -zone => 15, # Bars size
- -quzn => 0, # Space destinated for legend
- -ofwt => 0.01, # Bars width
- -fnsz => 8, # Font size
- -text => ''
- );
-
- (my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label) = C4::Barcodes::PrinterConfig::getLabelPosition(
- $label,
- $pdf,
- $page,
- $gfx,
- $text,
- $tr,
- $pageType);
- # Assigns a barcodes to $gfx
- $gfx->barcode($barcode, $x, $y , (72/$labelConfig{'systemDpi'}));
- # Assigns the additional information to the barcode (Legend)
- $text->translate($x - 48, $y - 22);
- warn "code is ".$codeC;
- if ($text_under_label) {
- $text->text($text_under_label);
- } else {
- $text->text(getCallnum($code));
- }
- }
- # Writes the objects added in $gfx to $page
- $pdf->finishobjects($page,$gfx, $text);
- # Save changes to the PDF
- $pdf->saveas;
- # Close the conection with the PDF file
- $pdf->end;
- # Show the PDF file
- print $cgi->redirect("/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
- } else {
- my $rangeCondition;
- if ($individualCodes ne "") {
- $rangeCondition = "AND (I.barcode IN " . $individualCodes . ")";
- } else {
- $rangeCondition = "AND (I.barcode >= " . $from . " AND I.barcode <=" . $to . " )";
- }
- warn "above the query";
- my $query = "SELECT CONCAT('$numbersystem',REPEAT('0',((12 - LENGTH('$numbersystem')) - LENGTH(I.barcode))), I.barcode) AS Codigo, I.dewey as dewey B.title, B.author FROM biblio B, items I WHERE (I.biblionumber = B.biblioNumber ) " .$rangeCondition. " AND (I.barcode <> 'FALTA') ORDER BY Codigo";
-
- # Prepare the query
- my $sth = $dbh->prepare($query);
- # Executes the query
- $sth->execute;
- if ($sth->rows) { # There are inventary codes
- # Set the temp directory for pdf´s files
- if (!defined($ENV{'TEMP'})) {
- $ENV{'TEMP'} = '/tmp/';
- }
- # Assigns a temporary filename for the pdf file
- my $tmpFileName = &assingFilename($from, $to);
- $tmpFileName = $ENV{'TEMP'}.$tmpFileName;
- # Creates a PDF object
- my $pdf = PDF::API2->new(-file => $tmpFileName);
- # Set the positions where barcodes are going to be placed
- C4::Barcodes::PrinterConfig::setPositionsForX($labelConfig{'marginLeft'}, $labelConfig{'labelWidth'}, $labelConfig{'columns'}, $labelConfig{'pageType'});
- C4::Barcodes::PrinterConfig::setPositionsForY($labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'}, $labelConfig{'rows'}, $labelConfig{'pageType'});
- # Creates a font object
- my $tr = $pdf->corefont('Helvetica-Bold');
- # Barcode position
- my ($page, $gfx, $text);
- while (my ($code,$dewey,$title,$author) = $sth->fetchrow_array) {
- # Generetase checksum
- $code = &checksum($code);
- # Generate the corresponde barcode to $code
- my $barcode = $pdf->barcode(-font => $tr, # The font object to use
- -type => 'ean13', # Standard of codification
- -code => $code, # Text to codify
- -extn => '012345', # Barcode extension (if it is aplicable)
- -umzn => 10, # Top limit of the finished bar
- -lmzn => 10, # Bottom limit of the finished bar
- -zone => 15, # Bars size
- -quzn => 0, # Space destinated for legend
- -ofwt => 0.01, # Bars width
- -fnsz => 8, # Font size
- -text => ''
- );
-
- (my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label) = C4::Barcodes::PrinterConfig::getLabelPosition(
- $label,
- $pdf,
- $page,
- $gfx,
- $text,
- $tr,
- $pageType);
- # Assigns a barcodes to $gfx
- $gfx->barcode($barcode, $x, $y , (72/$labelConfig{'systemDpi'}));
- # Assigns the additional information to the barcode (Legend)
- $text->translate($x - 48, $y - 22);
- if ($text_under_label) {
- $text->text($text_under_label);
- } else {
- warn "here a dewey:".$dewey;
- $text->text(substr $dewey, 0, 30);
- $text->translate($x - 48, $y - 29);
- #$text->text(substr $author, 0, 30);
- }
- }
- # Writes the objects added in $gfx to $page
- $pdf->finishobjects($page,$gfx, $text);
- # Save changes to the PDF
- $pdf->saveas;
- # Close the conection with the PDF file
- $pdf->end;
- # Show the PDF file
- print $cgi->redirect("/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
- } else {
- # Rollback and shows the error legend
- print $cgi->redirect("/cgi-bin/koha/barcodes/barcodes.pl?error=1");
- }
- $sth->finish;
- }
+ my ( $from, $to, $rangeType, $individualCodes, $text_under_label ) = @_;
+
+ # Returns a database handler
+ my $dbh = C4::Context->dbh;
+
+ # Create the query to database
+ # Assigns a temporary filename for the pdf file
+ my $tmpFileName = &assingFilename( $from, $to );
+
+ # warn "range type: ".$rangeType;
+ if ( $rangeType eq 'continuous' ) {
+
+ # Set the temp directory for pdf´s files
+ if ( !defined( $ENV{'TEMP'} ) ) {
+ $ENV{'TEMP'} = '/tmp/';
+ }
+ $tmpFileName = $ENV{'TEMP'} . $tmpFileName;
+
+ # Creates a PDF object
+ my $pdf = PDF::API2->new( -file => $tmpFileName );
+
+ # Set the positions where barcodes are going to be placed
+ C4::Barcodes::PrinterConfig::setPositionsForX(
+ $labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
+ $labelConfig{'columns'}, $labelConfig{'pageType'}
+ );
+ C4::Barcodes::PrinterConfig::setPositionsForY(
+ $labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
+ $labelConfig{'rows'}, $labelConfig{'pageType'}
+ );
+
+ # Creates a font object
+ my $tr = $pdf->corefont('Helvetica-Bold');
+
+ # Barcode position
+ my ( $page, $gfx, $text );
+ for ( my $code = $from ; $code <= $to ; $code++ ) {
+
+ # Generetase checksum
+ my $codeC = &checksum($code);
+
+ # Generate the corresponde barcode to $code
+ # warn "Code is :-->".$codeC."<--";
+ my $barcode = $pdf->barcode(
+ -font => $tr, # The font object to use
+ -type => 'ean128', # Standard of codification
+ -code => $codeC, # Text to codify
+ -extn => '012345', # Barcode extension (if it is aplicable)
+ -umzn => 10, # Top limit of the finished bar
+ -lmzn => 10, # Bottom limit of the finished bar
+ -zone => 15, # Bars size
+ -quzn => 0, # Space destinated for legend
+ -ofwt => 0.01, # Bars width
+ -fnsz => 8, # Font size
+ -text => ''
+ );
+
+ ( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
+ C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
+ $page, $gfx, $text, $tr, $pageType );
+
+ # Assigns a barcodes to $gfx
+ $gfx->barcode( $barcode, $x, $y,
+ ( 72 / $labelConfig{'systemDpi'} ) );
+
+ # Assigns the additional information to the barcode (Legend)
+ $text->translate( $x - 48, $y - 22 );
+
+ #warn "code is ".$codeC;
+ if ($text_under_label) {
+ $text->text($text_under_label);
+ }
+ else {
+ $text->text( getCallnum($code) );
+ }
+ }
+
+ # Writes the objects added in $gfx to $page
+ $pdf->finishobjects( $page, $gfx, $text );
+
+ # Save changes to the PDF
+ $pdf->saveas;
+
+ # Close the conection with the PDF file
+ $pdf->end;
+
+ # Show the PDF file
+ print $cgi->redirect(
+ "/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
+ }
+ else {
+ my $rangeCondition;
+ if ( $individualCodes ne "" ) {
+ $rangeCondition = "AND (I.barcode IN " . $individualCodes . ")";
+ }
+ else {
+ $rangeCondition =
+ "AND (I.barcode >= " . $from . " AND I.barcode <=" . $to . " )";
+ }
+
+ my $query =
+"SELECT CONCAT('$numbersystem',REPEAT('0',((12 - LENGTH('$numbersystem')) - LENGTH(I.barcode))), I.barcode) AS Codigo, B.title, B.author FROM biblio B, items I WHERE (I.biblionumber = B.biblioNumber ) "
+ . $rangeCondition
+ . " AND (I.barcode <> 'FALTA') ORDER BY Codigo";
+
+ # Prepare the query
+ my $sth = $dbh->prepare($query);
+
+ # Executes the query
+ $sth->execute;
+ if ( $sth->rows ) { # There are inventary codes
+ # Set the temp directory for pdf´s files
+ if ( !defined( $ENV{'TEMP'} ) ) {
+ $ENV{'TEMP'} = '/tmp/';
+ }
+
+ # Assigns a temporary filename for the pdf file
+ my $tmpFileName = &assingFilename( $from, $to );
+ $tmpFileName = $ENV{'TEMP'} . $tmpFileName;
+
+ # Creates a PDF object
+ my $pdf = PDF::API2->new( -file => $tmpFileName );
+
+ # Set the positions where barcodes are going to be placed
+ C4::Barcodes::PrinterConfig::setPositionsForX(
+ $labelConfig{'marginLeft'}, $labelConfig{'labelWidth'},
+ $labelConfig{'columns'}, $labelConfig{'pageType'}
+ );
+ C4::Barcodes::PrinterConfig::setPositionsForY(
+ $labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'},
+ $labelConfig{'rows'}, $labelConfig{'pageType'}
+ );
+
+ # Creates a font object
+ my $tr = $pdf->corefont('Helvetica-Bold');
+
+ # Barcode position
+ my ( $page, $gfx, $text );
+ while ( my ( $code, $dewey, $title, $author ) =
+ $sth->fetchrow_array )
+ {
+
+ # Generetase checksum
+ $code = &checksum($code);
+
+ # Generate the corresponde barcode to $code
+ my $barcode = $pdf->barcode(
+ -font => $tr, # The font object to use
+ -type => 'ean13', # Standard of codification
+ -code => $code, # Text to codify
+ -extn => '012345', # Barcode extension (if it is aplicable)
+ -umzn => 10, # Top limit of the finished bar
+ -lmzn => 10, # Bottom limit of the finished bar
+ -zone => 15, # Bars size
+ -quzn => 0, # Space destinated for legend
+ -ofwt => 0.01, # Bars width
+ -fnsz => 8, # Font size
+ -text => ''
+ );
+
+ ( my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label ) =
+ C4::Barcodes::PrinterConfig::getLabelPosition( $label, $pdf,
+ $page, $gfx, $text, $tr, $pageType );
+
+ # Assigns a barcodes to $gfx
+ $gfx->barcode( $barcode, $x, $y,
+ ( 72 / $labelConfig{'systemDpi'} ) );
+
+ # Assigns the additional information to the barcode (Legend)
+ $text->translate( $x - 48, $y - 22 );
+ if ($text_under_label) {
+ $text->text($text_under_label);
+ }
+ else {
+ $text->text( substr $title, 0, 30 );
+ $text->translate( $x - 48, $y - 29 );
+
+ #$text->text(substr $author, 0, 30);
+ $text->text( substr $author, 0, 30 );
+ }
+ }
+
+ # Writes the objects added in $gfx to $page
+ $pdf->finishobjects( $page, $gfx, $text );
+
+ # Save changes to the PDF
+ $pdf->saveas;
+
+ # Close the conection with the PDF file
+ $pdf->end;
+
+ # Show the PDF file
+ print $cgi->redirect(
+ "/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
+ }
+ else {
+
+ # Rollback and shows the error legend
+ print $cgi->redirect("/cgi-bin/koha/barcodes/barcodes.pl?error=1");
+ }
+ $sth->finish;
+ }
}
-barcodesGenerator($from, $to, $rangeType, $individualCodes,$text_under_label);
+barcodesGenerator( $from, $to, $rangeType, $individualCodes,
+ $text_under_label );
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
use CGI;
use C4::Auth;
use C4::Output;
+use C4::Labels;
use C4::Interface::CGI::Output;
use C4::Context;
-use HTML::Template;
-#use Data::Dumper;
my $query = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => { catalogue => 1 },
+ flagsrequired => { tools => 1 },
debug => 1,
}
);
-my $dbh = C4::Context->dbh;
-my $query2 = "SELECT * FROM labels_conf LIMIT 1";
-my $sth = $dbh->prepare($query2);
-$sth->execute();
+my $data = get_label_options();
-my $data = $sth->fetchrow_hashref;
-$sth->finish;
+my $active_template = GetActiveLabelTemplate();
+my @label_templates = GetAllLabelTemplates();
$template->param( guidebox => 1 ) if ( $data->{'guidebox'} );
$data->{'printingtype'} = 'both' if ( !$data->{'printingtype'} );
$template->param( "printingtype_$data->{'printingtype'}" => 1 );
+$template->param( "papertype_$data->{'papertype'}" => 1 );
+
+$template->param( "$data->{'barcodetype'}_checked" => 1 );
-$template->param( "$data->{'barcodetype'}_checked" => 1 );
$template->param( "startrow" . $data->{'startrow'} . "_checked" => 1 );
$template->param(
- itemtype => $data->{'itemtype'},
- papertype => $data->{'papertype'},
- author => $data->{'author'},
- barcode => $data->{'barcode'},
- id => $data->{'id'},
- barcodetype => $data->{'barcodetype'},
- title => $data->{'title'},
- isbn => $data->{'isbn'},
- dewey => $data->{'dewey'},
- class => $data->{'class'},
- startrow => $data->{'startrow'},
+ itemtype => $data->{'itemtype'},
+ active_template => $data->{'active_template'},
+ label_templates => \@label_templates,
+
+ papertype => $data->{'papertype'},
+ author => $data->{'author'},
+ barcode => $data->{'barcode'},
+ id => $data->{'id'},
+ barcodetype => $data->{'barcodetype'},
+ title => $data->{'title'},
+ isbn => $data->{'isbn'},
+ dewey => $data->{'dewey'},
+ class => $data->{'class'},
+ startrow => $data->{'startrow'},
+ subclass => $data->{'subclass'},
+ itemcallnumber => $data->{'itemcallnumber'},
+ startlabel => $data->{'startlabel'},
+ fontsize => $active_template->{'fontsize'},
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
use CGI;
use C4::Koha;
use C4::Auth;
-use HTML::Template;
+
use C4::Context;
-use C4::Search;
use C4::Auth;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Biblio;
use C4::Acquisition;
-#use C4::SearchMarc;
use C4::Koha; # XXX subfield_is_koha_internal_p
# Creates a scrolling list with the associated default value.
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => { borrowers => 1 },
- flagsrequired => { catalogue => 1 },
+ flagsrequired => { tools => 1 },
debug => 1,
}
);
for ( $i = 0 ; $i <= ( $total - 1 ) ; $i++ )
{ #total-1 coz the array starts at 0
#warn $i;
- #warn Dumper $results->[$i]{'bibid'};
+
my $type = 'intra';
- my @item_results = &ItemInfo( 0, $results->[$i]{'biblionumber'}, $type );
+ my @item_results =
+ &GetItemsInfo( $results->[$i]{'biblionumber'}, $type );
foreach my $item (@item_results) {
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => { catalogue => 1 },
+ flagsrequired => { tools => 1 },
debug => 1,
}
);
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
use CGI;
use C4::Auth;
+use C4::Labels;
use C4::Output;
use C4::Interface::CGI::Output;
-use HTML::Template;
+
use POSIX;
-my $dbh = C4::Context->dbh;
-my $query = new CGI;
-my $op = $query->param('op');
-my $barcodetype = $query->param('barcodetype');
-my $title = $query->param('title');
-my $isbn = $query->param('isbn');
-my $itemtype = $query->param('itemtype');
-my $bcn = $query->param('bcn');
-my $dcn = $query->param('dcn');
-my $classif = $query->param('classif');
-my $author = $query->param('author');
-my $papertype = $query->param('papertype');
-my $itemnumber = $query->param('itemnumber');
-my $summary = $query->param('summary');
-my $startrow = $query->param('startrow');
-my $printingtype = $query->param('printingtype');
-my $guidebox = $query->param('guidebox');
-
-warn $printingtype;
+my $dbh = C4::Context->dbh;
+my $query = new CGI;
+my $op = $query->param('op');
+my $barcodetype = $query->param('barcodetype');
+my $title = $query->param('title');
+my $isbn = $query->param('isbn');
+my $itemtype = $query->param('itemtype');
+my $bcn = $query->param('bcn');
+my $dcn = $query->param('dcn');
+my $classif = $query->param('classif');
+my $itemcallnumber = $query->param('itemcallnumber');
+my $subclass = $query->param('subclass');
+my $author = $query->param('author');
+my $tmpl_id = $query->param('tmpl_id');
+my $itemnumber = $query->param('itemnumber');
+my $summary = $query->param('summary');
+my $startlabel = $query->param('startlabel');
+my $printingtype = $query->param('printingtype');
+my $guidebox = $query->param('guidebox');
+my $fontsize = $query->param('fontsize');
+
+#warn "ID =$tmpl_id";
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
query => $query,
type => "intranet",
authnotrequired => 1,
- flagsrequired => { catalogue => 1 },
+ flagsrequired => { tools => 1 },
debug => 1,
}
);
if ( $op eq 'save_conf' ) {
- my $query2 = "DELETE FROM labels_conf";
- my $sth2 = $dbh->prepare($query2);
- $sth2->execute();
- $sth2->finish;
- my $query2 = "INSERT INTO labels_conf
- ( barcodetype, title, isbn, itemtype, barcode,
- dewey, class, author, papertype, printingtype,
- guidebox, startrow)
- values ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
- my $sth2 = $dbh->prepare($query2);
- $sth2->execute(
- $barcodetype, $title, $isbn, $itemtype,
- $bcn, $dcn, $classif, $author,
- $papertype, $printingtype, $guidebox, $startrow
+ SaveConf(
+ $barcodetype, $title, $isbn, $itemtype,
+ $bcn, $dcn, $classif, $subclass,
+ $itemcallnumber, $author, $tmpl_id, $printingtype,
+ $guidebox, $startlabel
);
- $sth2->finish;
}
elsif ( $op eq 'add' ) {
# this script can be run from the side nav, and is not passed a value for $startrow
# so lets get it from the DB
-if ( !$startrow ) {
- my $dbh = C4::Context->dbh;
- my $query2 = "SELECT * FROM labels_conf LIMIT 1";
- my $sth = $dbh->prepare($query2);
- $sth->execute();
+my $dbh = C4::Context->dbh;
+my $query2 = "SELECT * FROM labels_conf LIMIT 1";
+my $sth = $dbh->prepare($query2);
+$sth->execute();
- my $data = $sth->fetchrow_hashref;
- $startrow = $data->{'startrow'};
- $sth->finish;
-}
+my $data = $sth->fetchrow_hashref;
+$sth->finish;
#calc-ing number of sheets
-my $number_of_results = scalar @resultsloop;
-my $sheets_needed = ( ( --$number_of_results + $startrow ) / 8 );
-$sheets_needed = ceil($sheets_needed); # rounding up int's
-my $tot_labels = ( $sheets_needed * 8 );
-my $start_results = ( $number_of_results + $startrow );
-my $labels_remaining = ( $tot_labels - $start_results );
+#$sheets_needed = ceil($sheets_needed); # rounding up int's
+
+#my $tot_labels = ( $sheets_needed * 8 );
+#my $start_results = ( $number_of_results + $startrow );
+#my $labels_remaining = ( $tot_labels - $start_results );
$template->param(
- resultsloop => \@resultsloop,
- startrow => $startrow,
- sheets => $sheets_needed,
- labels_remaining => $labels_remaining,
+ resultsloop => \@resultsloop,
+ # startrow => $startrow,
+ # sheets => $sheets_needed,
+ # labels_remaining => $labels_remaining,
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
#!/usr/bin/perl
-#use lib '/usr/local/opus-dev/intranet/modules';
-#use C4::Context("/etc/koha-opus-dev.conf");
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
use strict;
use CGI;
use C4::Labels;
use C4::Auth;
-use C4::Serials;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Context;
use PDF::Reuse;
use PDF::Reuse::Barcode;
-use PDF::Report;
-use PDF::Create;
-use PDF::Labels;
-use Acme::Comment;
-use Data::Dumper;
-warn "-------";
+use POSIX;
+use Text::Wrap;
+
+
+$Text::Wrap::columns = 39;
+$Text::Wrap::separator = "\n";
my $htdocs_path = C4::Context->config('intrahtdocs');
my $cgi = new CGI;
+my $spine_text = "";
-my $pdf = new PDF::Labels(
- $PDF::Labels::PageFormats[1],
- filename => "$htdocs_path/barcodes/opus.pdf",
- Author => 'PDF Labelmaker',
- 'PageMode' => 'UseOutlines',
- Title => 'My Labels'
-);
+# get the printing settings
+my $conf_data = get_label_options();
+my @resultsloop = get_label_items();
+my $barcodetype = $conf_data->{'barcodetype'};
+my $printingtype = $conf_data->{'printingtype'};
+my $guidebox = $conf_data->{'guidebox'};
+my $startrow = $conf_data->{'startrow'};
-warn "$htdocs_path/barcodes/opus.pdf";
+# if none selected, then choose 'both'
+if ( !$printingtype ) {
+ $printingtype = 'both';
+}
-my @resultsloop = get_label_items();
+# opus paper dims. in *millimeters*
+# multiply values by '2.83465', to find their value in Postscript points.
-#warn Dumper @resultsloop;
-warn Dumper $pdf->{'filename'};
+# $xmargin = 12;
+# $label_height = 34;
+# $label_width = 74;
+# $x_pos_spine = 12;
+# $pageheight = 304;
+# $pagewidth = 174;
+# $line_spacer = 10;
+# $label_rows = 8;
-$pdf->setlabel(0); # Start with label 5 on first page
+# sheet dimensions in PS points.
-foreach my $result (@resultsloop) {
- warn Dumper $result;
- $pdf->label( $result->{'itemtype'}, $result->{'number'}, 'LAK',
- $result->{'barcode'} );
- $pdf->label( $result->{'itemtype'}, $result->{'dewey'}, 'LAK',
- $result->{'barcode'} );
+my $top_margin = 7;
+my $left_margin = 34;
+my $top_text_margin = 20;
+my $left_text_margin = 10;
+my $label_height = 96;
+my $spine_width = 210;
+my $colspace = 9;
+my $rowspace = 11;
+my $x_pos_spine = 36;
+my $pageheight = 861;
+my $pagewidth = 493;
+my $line_spacer = 10;
+my $label_rows = 8;
-}
-warn "HERE";
-$pdf->close();
+# setting up the pdf doc
+#remove the file before write, for testing
+#unlink "$htdocs_path/barcodes/new.pdf";
+#prFile("$htdocs_path/barcodes/new.pdf");
+#prLogDir("$htdocs_path/barcodes");
-#--------------------------------------------------
+# fix, no longer writes to temp dir
+prInitVars(); # To initiate ALL global variables and tables
+$| = 1;
+print STDOUT "Content-Type: application/pdf \n\n";
+prFile();
-use PDF::Reuse;
-prFile("$htdocs_path/barcodes/opus1.pdf");
-prDoc("$htdocs_path/barcodes/opus.pdf");
+prMbox( 0, 0, $pagewidth, $pageheight );
+prFont('courier'); # Just setting a font
+prFontSize(9);
+
+my $str;
+
+my $y_pos_initial = ( ( $pageheight - $top_margin ) - $label_height );
+my $y_pos_initial_startrow =
+ ( ( $pageheight - $top_margin ) - ( $label_height * $startrow ) );
+my $y_pos = $y_pos_initial_startrow;
+
+my $page_break_count = $startrow;
+my $codetype = 'Code39';
+
+#do page border
+# commented out coz it was running into the side-feeds of the paper.
+# drawbox( 0, 0 , $pagewidth, $pageheight );
+
+my $item;
+
+# for loop
+my $i2 = 1;
+
+foreach $item (@resultsloop) {
+ my $x_pos_spine_tmp = $x_pos_spine;
+
+ for ( 1 .. 2 ) {
+
+ if ( $guidebox == 1 ) {
+ warn
+"COUNT1, PBREAKCNT=$page_break_count, y=$y_pos, labhght = $label_height";
+ drawbox( $x_pos_spine_tmp, $y_pos, $spine_width, $label_height );
+ }
+
+ #-----------------draw spine text
+ if ( $printingtype eq 'spine' || $printingtype eq 'both' ) {
+
+ #warn "PRINTTYPE = $printingtype";
+
+ # add your printable fields manually in here
+ my @fields = qw (itemtype dewey isbn classification);
+ my $vPos = ( $y_pos + ( $label_height - $top_text_margin ) );
+ my $hPos = ( $x_pos_spine_tmp + $left_text_margin );
+ foreach my $field (@fields) {
+
+ # if the display option for this field is selected in the DB,
+ # and the item record has some values for this field, display it.
+ if ( $conf_data->{"$field"} && $item->{"$field"} ) {
+
+ #warn "CONF_TYPE = $field";
+
+ # get the string
+ $str = $item->{"$field"};
+
+ # strip out naughty existing nl/cr's
+ $str =~ s/\n//g;
+ $str =~ s/\r//g;
+
+ # chop the string up into _upto_ 12 chunks
+ # and seperate the chunks with newlines
+
+ $str = wrap( "", "", "$str" );
+ $str = wrap( "", "", "$str" );
+
+ # split the chunks between newline's, into an array
+ my @strings = split /\n/, $str;
+
+ # then loop for each string line
+ foreach my $str (@strings) {
+
+ warn "HPOS , VPOS $hPos, $vPos ";
+ prText( $hPos, $vPos, $str );
+ $vPos = $vPos - $line_spacer;
+ }
+ } # if field is valid
+ } # foreach @field
+ } #if spine
+
+ $x_pos_spine_tmp = ( $x_pos_spine_tmp + $spine_width + $colspace );
+ } # for 1 ..2
+ warn " $y_pos - $label_height - $rowspace";
+ $y_pos = ( $y_pos - $label_height - $rowspace );
+ warn " $y_pos - $label_height - $rowspace";
+
+ #-----------------draw spine text
+
+ # the gaylord labels have 8 rows per sheet, this pagebreaks after 8 rows
+ if ( $page_break_count == $label_rows ) {
+ prPage();
+ $page_break_count = 0;
+ $i2 = 0;
+ $y_pos = $y_pos_initial;
+ }
+ $page_break_count++;
+ $i2++;
+}
prEnd();
-print $cgi->redirect("/intranet-tmpl/barcodes/opus1.pdf");
+#print $cgi->redirect("/intranet-tmpl/barcodes/new.pdf");
#!/usr/bin/perl
-#----------------------------------------------------------------------
-# this script is really divided into 2 differenvt section,
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
-# the first section creates, and defines the new PDF file the barcodes
-# using PDF::Reuse::Barcode, then saves the file to disk.
+# $Id$
-# the second section then opens the pdf file off disk, and places the spline label
-# text in the left-most column of the page. then save the file again.
+=head1 label-print-pdf.pl
-# the reason for this goofyness, it that i couldnt find a single perl package that handled both barcodes and decent text placement.
+ this script is really divided into 2 differenvt section,
-#use lib '/usr/local/hlt/intranet/modules';
-#use C4::Context("/etc/koha-hlt.conf");
+ the first section creates, and defines the new PDF file the barcodes
+ using PDF::Reuse::Barcode, then saves the file to disk.
-#use strict;
+ the second section then opens the pdf file off disk, and places the spline label
+ text in the left-most column of the page. then save the file again.
+
+ the reason for this goofyness, it that i couldnt find a single perl package that handled both barcodes and decent text placement.
+
+=cut
+
+use strict;
use CGI;
use C4::Labels;
use C4::Auth;
-use C4::Serials;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Context;
-use HTML::Template;
+
use PDF::Reuse;
use PDF::Reuse::Barcode;
-use PDF::Report;
-use Data::Dumper;
+use POSIX;
+use C4::Labels;
+use Acme::Comment;
-#use Acme::Comment;
-#use Data::Dumper;
my $htdocs_path = C4::Context->config('intrahtdocs');
my $cgi = new CGI;
-
-my $spine_text = "";
+my $spine_text = "";
# get the printing settings
-
-my $conf_data = get_label_options();
-my @resultsloop = get_label_items();
-
-warn Dumper $conf_data;
-
-
+my $template = GetActiveLabelTemplate();
+my $conf_data = get_label_options();
+my @resultsloop = get_label_items();
my $barcodetype = $conf_data->{'barcodetype'};
my $printingtype = $conf_data->{'printingtype'};
-my $guidebox = $conf_data->{'guidebox'};
-my $startrow = $conf_data->{'startrow'};
-
-if (!$printingtype) {
- $printingtype = 'both';
-}
-
-warn $printingtype;
-warn $guidebox;
-
+my $guidebox = $conf_data->{'guidebox'};
+my $start_label = $conf_data->{'startlabel'};
+my $fontsize = $template->{'fontsize'};
+my $units = $template->{'units'};
-#warn Dumper @resultsloop;
+warn "UNITS $units";
+warn "fontsize = $fontsize";
-# dimensions of gaylord paper
-my $lowerLeftX = 0;
-my $lowerLeftY = 0;
-my $upperRightX = 612;
-my $upperRightY = 792;
-
-#----------------------------------
-# setting up the pdf doc
-
-#remove the file before write, for testing
-unlink "$htdocs_path/barcodes/new.pdf";
+my $unitvalue = GetUnitsValue($units);
+warn $unitvalue;
+warn $units;
-prFile("$htdocs_path/barcodes/new.pdf");
-prLogDir("$htdocs_path/barcodes");
+my $tmpl_code = $template->{'tmpl_code'};
+my $tmpl_desc = $template->{'tmpl_desc'};
-#prMbox ( $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY );
-prMbox( 0, 0, 612, 792 );
+my $page_height = ( $template->{'page_height'} * $unitvalue );
+my $page_width = ( $template->{'page_width'} * $unitvalue );
+my $label_height = ( $template->{'label_height'} * $unitvalue );
+my $label_width = ( $template->{'label_width'} * $unitvalue );
+my $spine_width = ( $template->{'label_width'} * $unitvalue );
+my $circ_width = ( $template->{'label_width'} * $unitvalue );
+my $top_margin = ( $template->{'topmargin'} * $unitvalue );
+my $left_margin = ( $template->{'leftmargin'} * $unitvalue );
+my $colspace = ( $template->{'colgap'} * $unitvalue );
+my $rowspace = ( $template->{'rowgap'} * $unitvalue );
-prFont('Times-Roman'); # Just setting a font
-prFontSize(10);
+my $label_cols = $template->{'cols'};
+my $label_rows = $template->{'rows'};
-my $margin = 36;
+my $text_wrap_cols = GetTextWrapCols( $fontsize, $label_width );
-my $label_height = 90;
-my $spine_width = 72;
-my $circ_width = 207;
-my $colspace = 27;
+warn $label_cols, $label_rows;
-my $x_pos_spine = 36;
-my $x_pos_circ1 = 135;
-my $x_pos_circ2 = 369;
+# set the paper size
+my $lowerLeftX = 0;
+my $lowerLeftY = 0;
+my $upperRightX = $page_width;
+my $upperRightY = $page_height;
-my $pageheight = 792;
+prInitVars();
+$| = 1;
+print STDOUT "Content-Type: application/pdf \r\n\r\n";
+prFile();
-warn "STARTROW = $startrow\n";
+prMbox( $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY );
-#my $y_pos_initial = ( ( 792 - 36 ) - 90 );
-my $y_pos_initial = ( ( $pageheight - $margin ) - $label_height );
-my $y_pos_initial_startrow =
- ( ( $pageheight - $margin ) - ( $label_height * $startrow ) );
+# later feature, change the font-type and size?
+prFont('C'); # Just setting a font
+prFontSize($fontsize);
-my $y_pos = $y_pos_initial_startrow;
+my $margin = $top_margin;
+my $left_text_margin = 3;
-warn "Y POS INITAL : $y_pos_initial";
-warn "Y POS : $y_pos";
-warn "Y START ROW = $y_pos_initial_startrow";
+my $str;
-my $rowspace = 36;
-my $page_break_count = $startrow;
-my $codetype = 'Code39';
+#warn "STARTROW = $startrow\n";
-# do border---------------
-my $str = "q\n"; # save the graphic state
-$str .= "4 w\n"; # border color red
-$str .= "0.0 0.0 0.0 RG\n"; # border color red
-$str .= "1 1 1 rg\n"; # fill color blue
-$str .= "0 0 612 792 re\n"; # a rectangle
-$str .= "B\n"; # fill (and a little more)
-$str .= "Q\n"; # save the graphic state
+#my $page_break_count = $startrow;
+my $codetype = 'Code39';
-# do border---------------
+#do page border
+#drawbox( $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY );
-prAdd($str);
my $item;
+my ( $i, $i2 ); # loop counters
-# for loop
-
-my $i2 = 1;
-foreach $item (@resultsloop) {
- if ( $i2 == 1 && $guidebox == 1) {
- draw_boundaries(
- $x_pos_spine, $x_pos_circ1, $x_pos_circ2, $y_pos,
- $spine_width, $label_height, $circ_width
- );
- }
-
- #warn Dumper $item->{'itemtype'};
- #warn "COUNT = $cnt1";
-
- #building up spine text
- my $line = 75;
- my $line_spacer = 16;
-
- $DB::single = 1;
-
- warn
-"COUNT=$i2, PBREAKCNT=$page_break_count, X,Y POS x=$x_pos_circ1, y=$y_pos";
- if ( $printingtype eq 'barcode' || $printingtype eq 'both' ) {
- build_circ_barcode( $x_pos_circ1, $y_pos, $item->{'barcode'},
- $conf_data->{'barcodetype'}, \$item );
- build_circ_barcode( $x_pos_circ2, $y_pos, $item->{'barcode'},
- $conf_data->{'barcodetype'}, \$item );
-}
-# added for xpdf compat. doesnt use type3 fonts., but increases filesize from 20k to 200k
-# i think its embedding extra fonts in the pdf file.
-# mode => 'graphic',
+# big row loop
- $y_pos = ( $y_pos - $label_height );
+warn " $lowerLeftX, $lowerLeftY, $upperRightX, $upperRightY";
+warn "$label_rows, $label_cols\n";
+warn "$label_height, $label_width\n";
+warn "$page_height, $page_width\n";
- # the gaylord labels have 8 rows per sheet, this pagebreaks after 8 rows
- if ( $page_break_count == 8 ) {
- prPage();
+my ( $rowcount, $colcount, $x_pos, $y_pos, $rowtemp, $coltemp );
- #warn "############# PAGEBREAK ###########";
- $page_break_count = 0;
- $i2 = 0;
- $y_pos = $y_pos_initial;
- }
- $page_break_count++;
- $i2++;
+if ( $start_label eq 1 ) {
+ $rowcount = 1;
+ $colcount = 1;
+ $x_pos = $left_margin;
+ $y_pos = ( $page_height - $top_margin - $label_height );
}
-############## end of loop
-
-
-prEnd();
-
-#----------------------------------------------------------------------------
-# this second section of the script uses a diff perl class than the previous section
-# it opens the 'new.pdf' file that the previous section has just saved
-
-if ( $printingtype eq 'spine' || $printingtype eq 'both' ) {
-
- $file = "$htdocs_path/barcodes/new.pdf";
- my $pdf = new PDF::Report( File => $file );
+else {
+ $rowcount = ceil( $start_label / $label_cols );
+ $colcount = ( $start_label - ( ( $rowcount - 1 ) * $label_cols ) );
- # my $pdf = new PDF::Report(PageSize => "letter",
- # PageOrientation => "Landscape");
+ $x_pos = $left_margin + ( $label_width * ( $colcount - 1 ) ) +
+ ( $colspace * ( $colcount - 1 ) );
- #$pdf->newpage($nopage);
- my $pagenumber = 1;
- $pdf->openpage($pagenumber);
+ $y_pos = $page_height - $top_margin - ( $label_height * $rowcount ) -
+ ( $rowspace * ( $rowcount - 1 ) );
- ( $pagewidth, $pageheight ) = $pdf->getPageDimensions();
-
- #warn "PAGE DIM = $pagewidth, $pageheight";
- #warn "Y START ROW = $y_pos_initial_startrow";
- my $y_pos = ( $y_pos_initial_startrow + 90 );
-
- #my $y_pos = ( $y_pos_initial_startrow );
- #warn "Y POS = $y_pos";
-
- # now needed now we are using centerString().
- #$pdf->setAlign('left');
-
- # SET THE FONT SIZE
- $pdf->setSize(9);
-
- my $page_break_count = $startrow;
-
- #warn "INIT PAGEBREAK COUNT = $page_break_count";
-
- #warn "#----------------------------------\n";
- #warn "INIT VPOS = $vPos, hPos = $hPos";
+}
- my $vPosSpacer = 15;
- my $start_text_pos = 39; # ( 36 - 5 = 31 ) 5 is an inside border for text.
- my $spine_label_text_with = 67;
+warn "ROW COL $rowcount, $colcount";
- foreach $item (@resultsloop) {
+#my $barcodetype = 'Code39';
- #warn Dumper $item;
- #warn "START Y_POS=$y_pos";
- my $firstrow = 0;
+foreach $item (@resultsloop) {
- $pdf->setAddTextPos( $start_text_pos, ( $y_pos - 20 ) )
- ; # INIT START POS
- ( $hPos, $vPos ) = $pdf->getAddTextPos();
+ warn "-----------------";
+ if ($guidebox) {
+ drawbox( $x_pos, $y_pos, $label_width, $label_height );
+ }
- my $hPosEnd = ( $hPos + $spine_label_text_with ); # 72
- if ( $conf_data->{'dewey'} && $item->{'dewey'} ) {
- ( $hPos, $vPos1 ) = $pdf->getAddTextPos();
- $pdf->centerString( $hPos, $hPosEnd, $vPos, $item->{'dewey'} );
- $vPos = $vPos - $vPosSpacer;
+ if ( $printingtype eq 'spine' || $printingtype eq 'both' ) {
+ if ($guidebox) {
+ drawbox( $x_pos, $y_pos, $label_width, $label_height );
}
- if ( $conf_data->{'isbn'} && $item->{'isbn'} ) {
- ( $hPos, $vPos1 ) = $pdf->getAddTextPos();
- $pdf->centerString( $hPos, $hPosEnd, $vPos, $item->{'isbn'} );
- $vPos = $vPos - $vPosSpacer;
- }
+ DrawSpineText( $y_pos, $label_height, $fontsize, $x_pos,
+ $left_text_margin, $text_wrap_cols, \$item, \$conf_data );
+ CalcNextLabelPos();
+ }
- if ( $conf_data->{'class'} && $item->{'classification'} ) {
- ( $hPos, $vPos1 ) = $pdf->getAddTextPos();
- $pdf->centerString( $hPos, $hPosEnd, $vPos,
- $item->{'classification'} );
- $vPos = $vPos - $vPosSpacer;
+ if ( $printingtype eq 'barcode' || $printingtype eq 'both' ) {
+ if ($guidebox) {
+ drawbox( $x_pos, $y_pos, $label_width, $label_height );
}
- if ( $conf_data->{'itemtype'} && $item->{'itemtype'} ) {
- ( $hPos, $vPos1 ) = $pdf->getAddTextPos();
- $pdf->centerString( $hPos, $hPosEnd, $vPos, $item->{'itemtype'} );
- $vPos = $vPos - $vPosSpacer;
- }
+ DrawBarcode( $x_pos, $y_pos, $label_height, $label_width,
+ $item->{'barcode'}, $barcodetype );
+ CalcNextLabelPos();
+ }
- #$pdf->drawRect(
- # $x_pos_spine, $y_pos,
- # ( $x_pos_spine + $spine_width ),
- # ( $y_pos - $label_height )
- #);
+} # end for item loop
+prEnd();
- $y_pos = ( $y_pos - $label_height );
+print $cgi->redirect("/intranet-tmpl/barcodes/new.pdf");
- #warn "END LOOP Y_POS =$y_pos";
- # warn "PAGECOUNT END LOOP=$page_break_count";
- if ( $page_break_count == 8 ) {
- $pagenumber++;
- $pdf->openpage($pagenumber);
+sub CalcNextLabelPos {
+ if ( $colcount lt $label_cols ) {
- #warn "############# PAGEBREAK ###########";
- $page_break_count = 0;
- $i2 = 0;
- $y_pos = ( $y_pos_initial + 90 );
- }
+ # warn "new col";
+ $x_pos = ( $x_pos + $label_width + $colspace );
+ $colcount++;
+ }
- $page_break_count++;
- $i2++;
+ else {
+ $x_pos = $left_margin;
+ if ( $rowcount eq $label_rows ) {
- #warn "#----------------------------------\n";
+ # warn "new page";
+ prPage();
+ $y_pos = ( $page_height - $top_margin - $label_height );
+ $rowcount = 1;
+ }
+ else {
+ # warn "new row";
+ $y_pos = ( $y_pos - $rowspace - $label_height );
+ $rowcount++;
+ }
+ $colcount = 1;
}
- $DB::single = 1;
- $pdf->saveAs($file);
}
-#------------------------------------------------
-
-print $cgi->redirect("/intranet-tmpl/barcodes/new.pdf");
#!/usr/bin/perl
+# This file is part of koha
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
use CGI;
use C4::Auth;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Context;
-use HTML::Template;
+
use GD::Barcode::UPCE;
use Data::Random qw(:all);
my $htdocs_path = C4::Context->config('intrahtdocs');
-use Data::Dumper;
-
my $query = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => { catalogue => 1 },
+ flagsrequired => { tools => 1 },
debug => 1,
}
);
my $conf_data = $sth->fetchrow_hashref;
-#warn Dumper $conf_data;
-
$sth->finish;
my @data;
}
$sth->finish;
-#warn Dumper @resultsloop;
-
-
-
-
#------------------------------------------------------
#lets write barcode files to tmp dir for every item in @resultsloop
-
-
binmode(FILE);
-foreach my $item (@resultsloop){
+foreach my $item (@resultsloop) {
+ my $random = int( rand(100000000000) ) + 999999999999;
-my $random = int( rand(100000000000)) + 999999999999;
-#warn "$random\n";
+ #warn "$random\n";
- $item->{'barcode'} = $random;
+ $item->{'barcode'} = $random;
-# my $itembarcode = $item->{'barcode'};
-# warn $item->{'barcode'};
+ # my $itembarcode = $item->{'barcode'};
+ # warn $item->{'barcode'};
+ my $filename = "$htdocs_path/barcodes/$item->{'barcode'}.png";
- my $filename = "$htdocs_path/barcodes/$item->{'barcode'}.png";
- #warn $filename;
- open(FILE, ">$filename");
+ #warn $filename;
+ open( FILE, ">$filename" );
- print FILE GD::Barcode->new('EAN13', $item->{'barcode'})->plot->png;
-# warn $GD::Barcode::errStr;
-
- close(FILE);
-
-#warn Dumper $item->{'barcode'};
-
-}
+ print FILE GD::Barcode->new( 'EAN13', $item->{'barcode'} )->plot->png;
+ # warn $GD::Barcode::errStr;
+ close(FILE);
+ #warn Dumper $item->{'barcode'};
+}
# lets pass the config setting
$template->param(
- resultsloop => \@resultsloop,
-
-
- itemtype_opt => $conf_data->{'itemtype'},
- papertype_opt => $conf_data->{'papertype'},
- author_opt => $conf_data->{'author'},
- barcode_opt => $conf_data->{'barcode'},
- id_opt => $conf_data->{'id'},
- type_opt => $conf_data->{'type'},
- title_opt => $conf_data->{'title'},
- isbn_opt => $conf_data->{'isbn'},
- dewey_opt => $conf_data->{'dewey'},
- class_opt => $conf_data->{'class'},
-
-
-
+ resultsloop => \@resultsloop,
+
+ itemtype_opt => $conf_data->{'itemtype'},
+ papertype_opt => $conf_data->{'papertype'},
+ author_opt => $conf_data->{'author'},
+ barcode_opt => $conf_data->{'barcode'},
+ id_opt => $conf_data->{'id'},
+ type_opt => $conf_data->{'type'},
+ title_opt => $conf_data->{'title'},
+ isbn_opt => $conf_data->{'isbn'},
+ dewey_opt => $conf_data->{'dewey'},
+ class_opt => $conf_data->{'class'},
+ subclass_opt => $conf_data->{'subclass'},
+ itemcallnumber_opt => $conf_data->{'itemcallnumber'},
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
);
output_html_with_http_headers $query, $cookie, $template->output;
-
use CGI;
# This script take a pdf filename as a parameter and output it to the browser.
-my $cgi = new CGI;
-my $filename = "barcodes.pdf";
+my $cgi = new CGI;
+my $filename = "barcodes.pdf";
my $tmpFileName = $cgi->param('tmpFileName');
print "Content-Disposition: attachment; filename = $filename\n\n";
-print $cgi->header(-type => 'application/pdf'),
- $cgi->start_html(-title=>"Codify to PDF");
+print $cgi->header( -type => 'application/pdf' ),
+ $cgi->start_html( -title => "Codify to PDF" );
open fh, "<$tmpFileName";
while (<fh>) {
- print;
+ print;
}
print $cgi->end_html();
use C4::Context;
use C4::Output;
use C4::Auth;
-use HTML::Template;
+
use PDF::API2;
use PDF::API2::Page;
-use PDF::API2::PDF::Utils;
+use PDF::API2::Util;
use C4::Interface::CGI::Output;
# This function returns the path to deal with the correct files, considering
# templates set and language.
sub getPath {
- my $type = shift @_;
- my $templatesSet = C4::Context->preference('template');
- my $lang = C4::Context->preference('opaclanguages');
- if ($type eq "intranet") {
- return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
- } else {
- return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
- }
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ( $type eq "intranet" ) {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ }
+ else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
}
# Load a configuration file.
sub loadConfFromFile {
- my $fileName = shift @_;
- my %keyValues;
- open FILE, "<$fileName";
- while (<FILE>) {
- chomp;
- if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
- $keyValues{$1} = $2;
- }
- }
- close FILE;
- return %keyValues;
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
}
# Save settings to a configuration file.
sub saveConfToFile {
- my $fileName = shift @_;
- my %keyValues = %{shift @_};
- my $i;
- open FILE, ">$fileName";
- my $i;
- foreach $i (keys(%keyValues)) {
- print FILE $i." = ".$keyValues{$i}."\n";
- }
- close FILE;
+ my $fileName = shift @_;
+ my %keyValues = %{ shift @_ };
+ my $i;
+ open FILE, ">$fileName";
+ my $i;
+ foreach $i ( keys(%keyValues) ) {
+ print FILE $i . " = " . $keyValues{$i} . "\n";
+ }
+ close FILE;
}
# Creates a CGI object and take his parameters
my $input = new CGI;
-if ($input->param('saveSettings')) {
- my $labelConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
- my %newConfiguration = (pageType => $input->param('pageType'),
- columns => $input->param('columns'),
- rows => $input->param('rows'),
- systemDpi => $input->param('systemDpi'),
- labelWidth => $input->param('labelWidth'),
- labelHeigth => $input->param('labelHeigth'),
- marginBottom => $input->param('marginBottom'),
- marginLeft => $input->param('marginLeft'));
- saveConfToFile($labelConf, \%newConfiguration);
- print $input->redirect('/cgi-bin/koha/barcodes/barcodes.pl')
+if ( $input->param('saveSettings') ) {
+ my $labelConf =
+ &getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
+ my %newConfiguration = (
+ pageType => $input->param('pageType'),
+ columns => $input->param('columns'),
+ rows => $input->param('rows'),
+ systemDpi => $input->param('systemDpi'),
+ labelWidth => $input->param('labelWidth'),
+ labelHeigth => $input->param('labelHeigth'),
+ marginBottom => $input->param('marginBottom'),
+ marginLeft => $input->param('marginLeft')
+ );
+ saveConfToFile( $labelConf, \%newConfiguration );
+ print $input->redirect('/cgi-bin/koha/barcodes/barcodes.pl');
}
# Get the template to use
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "barcodes/printerConfig.tmpl",
- type => "intranet",
- query => $input,
- authnotrequired => 0,
- flagsrequired => {parameters => 1},
- debug => 1,
- });
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "barcodes/printerConfig.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 0,
+ flagsrequired => { tools => 1 },
+ debug => 1,
+ }
+);
-my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my $filenameConf =
+ &getPath("intranet") . "/includes/labelConfig/itemsLabelConfig.conf";
my %labelConfig = &loadConfFromFile($filenameConf);
-$template->param(COLUMNS => $labelConfig{'columns'});
-$template->param(ROWS => $labelConfig{'rows'});
-$template->param(SYSTEM_DPI => $labelConfig{'systemDpi'});
-$template->param(LABEL_WIDTH => $labelConfig{'labelWidth'});
-$template->param(LABEL_HEIGTH => $labelConfig{'labelHeigth'});
-$template->param(MARGIN_TOP => $labelConfig{'marginBottom'});
-$template->param(MARGIN_LEFT => $labelConfig{'marginLeft'});
-$template->param(SCRIPT_NAME => '/cgi-bin/koha/barcodes/printerConfig.pl');
-$template->param("$labelConfig{'pageType'}" => 1);
-$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
+$template->param( COLUMNS => $labelConfig{'columns'} );
+$template->param( ROWS => $labelConfig{'rows'} );
+$template->param( SYSTEM_DPI => $labelConfig{'systemDpi'} );
+$template->param( LABEL_WIDTH => $labelConfig{'labelWidth'} );
+$template->param( LABEL_HEIGTH => $labelConfig{'labelHeigth'} );
+$template->param( MARGIN_TOP => $labelConfig{'marginBottom'} );
+$template->param( MARGIN_LEFT => $labelConfig{'marginLeft'} );
+$template->param( SCRIPT_NAME => '/cgi-bin/koha/barcodes/printerConfig.pl' );
+$template->param( "$labelConfig{'pageType'}" => 1 );
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
output_html_with_http_headers $input, $cookie, $template->output;
my $pdf = PDF::API2->new();
#$pdf->mediabox(612,792);
-my $fnt = $pdf->corefont('Helvetica-Bold');
-my $page = $pdf->page; # returns the last page
+my $fnt = $pdf->corefont('Helvetica-Bold');
+my $page = $pdf->page; # returns the last page
my $txt = $page->text;
-$txt->{' font'}=$fnt;
+$txt->{' font'} = $fnt;
$text_to_place = "moo moo";
-($width_of_last_line, $ypos_of_last_line, $left_over_text) =
+( $width_of_last_line, $ypos_of_last_line, $left_over_text ) =
$pdftable->text_block(
$txt,
$text_to_place,
-y => 300,
-w => 50,
-h => 40,
-
+
# -lead => 13,
# -font_size => 12,
# -parspace => 0,
# -align => "left",
# -hang => 1,
-);
+ );
$pdf->saveas("$htdocs_path/barcodes/foo.pdf");
#!/usr/bin/perl
+
#script to provide bookshelf management
-# WARNING: This file uses 4-character tabs!
#
-# $Header$
#
# Copyright 2000-2002 Katipo Communications
#
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
+=head1 NAME
+
+ addbookbybiblionumber.pl
+
+=head1 DESCRIPTION
+
+ This script allow to add a book in a virtual shelf from a biblionumber.
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item biblionumber
+
+ The biblionumber
+
+=item shelfnumber
+
+ the shelfnumber where to add the book.
+
+=item newbookshelf
+
+ if this parameter exists, then it must be equals to the name of the shelf
+ to add.
+
+=item category
+
+ if this script has to add a shelf, it add one with this category.
+
+=back
+
+=cut
+
use strict;
-use C4::Search;
use C4::Biblio;
use CGI;
+use C4::Output;
use C4::BookShelves;
use C4::Circulation::Circ2;
use C4::Auth;
use C4::Interface::CGI::Output;
-my $env;
+#use it only to debug !
+use CGI::Carp qw/fatalsToBrowser/;
+use warnings;
+
my $query = new CGI;
my $biblionumber = $query->param('biblionumber');
my $shelfnumber = $query->param('shelfnumber');
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "bookshelves/addbookbybiblionumber.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- });
-
-my $x; # for trash
-($x,$x,$shelfnumber) = AddShelf('',$newbookshelf,$loggedinuser,$category) if $newbookshelf;
-
-if ($shelfnumber) {
- &AddToShelfFromBiblio($env, $biblionumber, $shelfnumber);
- print "Content-Type: text/html\n\n<html><body onload=\"window.close()\"></body></html>";
- exit;
-} else {
-
- my ( $bibliocount, @biblios ) = getbiblio($biblionumber);
-
- my ($shelflist) = GetShelfList($loggedinuser,3);
- my @shelvesloop;
- my %shelvesloop;
- foreach my $element (sort keys %$shelflist) {
- push (@shelvesloop, $element);
- $shelvesloop{$element} = $shelflist->{$element}->{'shelfname'};
- }
-
- my $CGIbookshelves=CGI::scrolling_list( -name => 'shelfnumber',
- -values => \@shelvesloop,
- -labels => \%shelvesloop,
- -size => 1,
- -tabindex=>'',
- -multiple => 0 );
-
- $template->param(biblionumber => $biblionumber,
- title => $biblios[0]->{'title'},
- author => $biblios[0]->{'author'},
- CGIbookshelves => $CGIbookshelves,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
-
- output_html_with_http_headers $query, $cookie, $template->output;
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ });
+
+$shelfnumber = AddShelf($newbookshelf,$loggedinuser,$category) if $newbookshelf;
+
+if ($shelfnumber || ($shelfnumber == -1)) { # the shelf already exist.
+ &AddToShelfFromBiblio($biblionumber, $shelfnumber);
+ print "Content-Type: text/html\n\n<html><body onload=\"window.close()\"></body></html>";
+ exit;
+} else { # this shelf doesn't already exist.
+ my ( $bibliocount, @biblios ) = GetBiblio($biblionumber);
+
+ my ($shelflist) = GetShelves($loggedinuser,3);
+ my @shelvesloop;
+ my %shelvesloop;
+ foreach my $element (sort keys %$shelflist) {
+ push (@shelvesloop, $element);
+ $shelvesloop{$element} = $shelflist->{$element}->{'shelfname'};
+ }
+
+ my $CGIbookshelves=CGI::scrolling_list(
+ -name => 'shelfnumber',
+ -values => \@shelvesloop,
+ -labels => \%shelvesloop,
+ -size => 1,
+ -tabindex=>'',
+ -multiple => 0 );
+
+ $template->param(
+ biblionumber => $biblionumber,
+ title => $biblios[0]->{'title'},
+ author => $biblios[0]->{'author'},
+ CGIbookshelves => $CGIbookshelves,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+
+ output_html_with_http_headers $query, $cookie, $template->output;
}
+
# $Log$
-# Revision 1.5 2006/09/27 21:19:21 tgarip1957
-# Finalized XML version for intranet
+# Revision 1.6 2007/03/09 14:32:26 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.4.2.6 2006/12/18 16:35:17 toins
+# removing use HTML::Template from *.pl.
+#
+# Revision 1.4.2.5 2006/12/05 11:35:29 toins
+# Biblio.pm cleaned.
+# additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
+# Some functions renamed according to the coding guidelines.
+#
+# Revision 1.4.2.4 2006/11/30 18:23:51 toins
+# theses scripts don't need to use C4::Search.
+#
+# Revision 1.4.2.3 2006/10/30 09:48:19 tipaul
+# samll bugfix to create a bookshelf correctly
+#
+# Revision 1.4.2.2 2006/08/30 16:13:54 toins
+# correct an error in the "if condition".
+#
+# Revision 1.4.2.1 2006/08/30 15:59:14 toins
+# Code cleaned according to coding guide lines.
#
# Revision 1.4 2006/07/04 14:36:51 toins
# Head & rel_2_2 merged
# Revision 1.3.2.2 2006/02/05 21:45:25 kados
# Adds support for intranetstylesheet system pref in Koha scripts
#
-# Revision 1.3.2.1 2006/02/04 21:26:47 kados
-# Adds support for intranetcolorstylesheet
-#
-# Revision 1.3 2004/12/15 17:28:22 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf (this being not finished, will commit the rest soon)
-#
-# Revision 1.2 2004/11/19 16:31:30 tipaul
-# bugfix for bookshelves not in official CVS
-#
-# Revision 1.1.2.2 2004/03/10 15:08:18 tipaul
-# modifying shelves : introducing category of shelf : private, public, free for all
-#
-# Revision 1.1.2.1 2004/02/19 10:14:36 tipaul
-# new feature : adding book to bookshelf from biblio detail screen.
-#
# Local Variables:
# tab-width: 4
#!/usr/bin/perl
-#script to provide bookshelf management
-# WARNING: This file uses 4-character tabs!
-#
-# $Header$
+
#
# Copyright 2000-2002 Katipo Communications
#
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 NAME
+
+ shelves.pl
+
+=head1 DESCRIPTION
+
+ this script is used to script to provide bookshelf management
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item C<modifyshelfcontents>
+
+ if this script has to modify the shelve content.
+
+=item C<shelfnumber>
+
+ to know on which shelve this script has to work.
+
+=item C<addbarcode>
+
+=item C<op>
+
+ op can be equals to:
+ * modifsave to save change on the shelves
+ * modif to change the template to allow to modify the shelves.
+
+=item C<viewshelf>
+
+ to load the template with 'viewshelves param' which allow to read the shelves information.
+
+=item C<shelves>
+
+ if equals to 1. then call the function shelves which add
+ or delete a shelf.
+
+=item C<addshelf>
+
+ if the param shelves = 1 then addshelf must be equals to the name of the shelf to add.
+
+=back
+
+=cut
+
use strict;
-use C4::Search;
use CGI;
+use C4::Output;
use C4::BookShelves;
use C4::Circulation::Circ2;
use C4::Auth;
use C4::Interface::CGI::Output;
-
-my $env;
my $query = new CGI;
-my $headerbackgroundcolor='#663266';
-my $circbackgroundcolor='#555555';
-my $circbackgroundcolor='#550000';
-my $linecolor1='#bbbbbb';
-my $linecolor2='#dddddd';
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "bookshelves/shelves.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- });
-
-if ($query->param('modifyshelfcontents')) {
- my $shelfnumber=$query->param('shelfnumber');
- my $barcode=$query->param('addbarcode');
- my ($item) = getiteminformation($env, 0, $barcode);
- if (ShelfPossibleAction($loggedinuser,$shelfnumber,'manage')) {
- AddToShelf($env, $item->{'itemnumber'}, $shelfnumber);
- foreach ($query->param) {
- if (/REM-(\d*)/) {
- my $itemnumber=$1;
- RemoveFromShelf($env, $itemnumber, $shelfnumber);
- }
- }
- }
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "bookshelves/shelves.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { catalogue => 1 },
+ }
+);
+
+if ( $query->param('modifyshelfcontents') ) {
+ my $shelfnumber = $query->param('viewshelf');
+ my $barcode = $query->param('addbarcode');
+ my ($item) = getiteminformation( 0, $barcode );
+ if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ) ) {
+ AddToShelf( $item->{'itemnumber'}, $shelfnumber );
+ foreach ( $query->param ) {
+ if (/REM-(\d*)/) {
+ my $itemnumber = $1;
+ DelFromShelf( $itemnumber, $shelfnumber );
+ }
+ }
+ }
}
-my ($shelflist) = GetShelfList($loggedinuser,2);
-$template->param({ loggedinuser => $loggedinuser,
- headerbackgroundcolor => $headerbackgroundcolor,
- circbackgroundcolor => $circbackgroundcolor });
+# getting the Shelves list
+my $shelflist = GetShelves( $loggedinuser, 2 );
+$template->param( { loggedinuser => $loggedinuser } );
+my $op = $query->param('op');
+
SWITCH: {
- if ($query->param('op') eq 'modifsave') {
- ModifShelf($query->param('shelfnumber'),$query->param('shelfname'),$loggedinuser,$query->param('category'));
- last SWITCH;
- }
- if ($query->param('op') eq 'modif') {
- my ($shelfnumber,$shelfname,$owner,$category) = GetShelf($query->param('shelf'));
- $template->param(edit => 1,
- shelfnumber => $shelfnumber,
- shelfname => $shelfname,
- "category$category" => 1);
-# editshelf($query->param('shelf'));
- last SWITCH;
- }
- if ($query->param('viewshelf')) {
- viewshelf($query->param('viewshelf'));
- last SWITCH;
- }
- if ($query->param('shelves')) {
- shelves();
- last SWITCH;
- }
+ if ( $op && ( $op eq 'modifsave' ) ) {
+ ModShelf(
+ $query->param('shelfnumber'), $query->param('shelfname'),
+ $loggedinuser, $query->param('category')
+ );
+ last SWITCH;
+ }
+ if ( $op && ( $op eq 'modif' ) ) {
+ my ( $shelfnumber, $shelfname, $owner, $category ) =
+ GetShelf( $query->param('shelf') );
+ $template->param(
+ edit => 1,
+ shelfnumber => $shelfnumber,
+ shelfname => $shelfname,
+ "category$category" => 1
+ );
+
+ # editshelf($query->param('shelf'));
+ last SWITCH;
+ }
+ if ( $query->param('viewshelf') ) {
+ #check that the user can view the shelf
+ my $shelfnumber = $query->param('viewshelf');
+ if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'view' ) ) {
+ my $items = GetShelfContents($shelfnumber);
+ $template->param(
+ shelfname => $shelflist->{$shelfnumber}->{'shelfname'},
+ shelfnumber => $shelfnumber,
+ viewshelf => $query->param('viewshelf'),
+ manageshelf => &ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ),
+ itemsloop => $items,
+ );
+ }
+ last SWITCH;
+ }
+ if ( $query->param('shelves') ) {
+ if ( my $newshelf = $query->param('addshelf') ) {
+ my $shelfnumber = AddShelf(
+ $newshelf,
+ $query->param('owner'),
+ $query->param('category')
+ );
+
+ if ( $shelfnumber == -1 ) { #shelf already exists.
+ $template->param(
+ {
+ shelfnumber => $shelfnumber,
+ already => 1
+ }
+ );
+ }
+ }
+ my @paramsloop;
+ foreach ( $query->param() ) {
+ my %line;
+ if (/DEL-(\d+)/) {
+ my $delshelf = $1;
+ my ( $status, $count ) = DelShelf($delshelf);
+ if ($status) {
+ $line{'status'} = $status;
+ $line{'count'} = $count;
+ }
+ }
+
+ #if the shelf is not deleted, %line points on null
+ push( @paramsloop, \%line );
+ }
+ $template->param( paramsloop => \@paramsloop );
+ my ($shelflist) = GetShelves( $loggedinuser, 2 );
+ my $color = '';
+ my @shelvesloop;
+ foreach my $element ( sort keys %$shelflist ) {
+ my %line;
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ push( @shelvesloop, \%line );
+ }
+ $template->param(
+ shelvesloop => \@shelvesloop,
+ shelves => 1,
+ );
+ last SWITCH;
+ }
}
-($shelflist) = GetShelfList($loggedinuser,2); # rebuild shelflist in case a shelf has been added
+($shelflist) =
+ GetShelves( $loggedinuser, 2 )
+ ; # rebuild shelflist in case a shelf has been added
-my $color='';
+my $color = '';
my @shelvesloop;
-foreach my $element (sort keys %$shelflist) {
- my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'shelf'}=$element;
- $line{'shelfname'}=$shelflist->{$element}->{'shelfname'};
- $line{"category".$shelflist->{$element}->{'category'}} = 1;
- $line{'mine'} = 1 if $shelflist->{$element}->{'owner'} eq $loggedinuser;
- $line{'shelfbookcount'}=$shelflist->{$element}->{'count'};
- $line{'canmanage'} = ShelfPossibleAction($loggedinuser,$element,'manage');
- $line{'firstname'}=$shelflist->{$element}->{'firstname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
- $line{'surname'}=$shelflist->{$element}->{'surname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
-;
- push (@shelvesloop, \%line);
- }
-$template->param(shelvesloop => \@shelvesloop,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
+my $numberCanManage = 0;
+
+foreach my $element ( sort keys %$shelflist ) {
+ my %line;
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{ "category" . $shelflist->{$element}->{'category'} } = 1;
+ $line{'mine'} = 1 if $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ $line{'canmanage'} = ShelfPossibleAction( $loggedinuser, $element, 'manage' );
+ $line{'firstname'} = $shelflist->{$element}->{'firstname'}
+ unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ $line{'surname'} = $shelflist->{$element}->{'surname'}
+ unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+
+ $numberCanManage++ if $line{'canmanage'};
+
+ push( @shelvesloop, \%line );
+}
+
+$template->param(
+ shelvesloop => \@shelvesloop,
+ numberCanManage => $numberCanManage,
+);
output_html_with_http_headers $query, $cookie, $template->output;
-# sub editshelf {
-# my ($shelfnumber) = @_;
-# my ($shelfnumber,$shelfname,$owner,$category) = GetShelf($shelfnumber);
-# $template->param(edit => 1,
-# shelfnumber => $shelfnumber,
-# shelfname => $shelfname,
-# "category$category" => 1);
-# }
sub shelves {
- if (my $newshelf=$query->param('addshelf')) {
- my ($status, $string) = AddShelf($env,$newshelf,$query->param('owner'),$query->param('category'));
- if ($status) {
- $template->param(status1 => $status, string1 => $string);
- }
- }
- my @paramsloop;
- foreach ($query->param()) {
- my %line;
- if (/DEL-(\d+)/) {
- my $delshelf=$1;
- my ($status, $string) = RemoveShelf($env,$delshelf);
- if ($status) {
- $line{'status'}=$status;
- $line{'string'} = $string;
- }
- }
- #if the shelf is not deleted, %line points on null
- push(@paramsloop,\%line);
- }
- $template->param(paramsloop => \@paramsloop);
- my ($shelflist) = GetShelfList($loggedinuser,2);
- my $color='';
- my @shelvesloop;
- foreach my $element (sort keys %$shelflist) {
- my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'shelf'}=$element;
- $line{'shelfname'}=$shelflist->{$element}->{'shelfname'} ;
- $line{'shelfbookcount'}=$shelflist->{$element}->{'count'} ;
- push(@shelvesloop, \%line);
- }
- $template->param(shelvesloop=>\@shelvesloop,
- shelves => 1,
- );
-}
+ my $innertemplate = shift;
+ if ( my $newshelf = $query->param('addshelf') ) {
+ my $shelfnumber = AddShelf(
+ $newshelf,
+ $query->param('owner'),
+ $query->param('category')
+ );
-sub viewshelf {
- my $shelfnumber=shift;
- #check that the user can view the shelf
- return unless (ShelfPossibleAction($loggedinuser,$shelfnumber,'view'));
- my ($itemlist) = GetShelfContents($env, $shelfnumber);
- my $item='';
- my $color='';
- my @itemsloop;
- foreach $item (sort {$a->{'barcode'} cmp $b->{'barcode'}} @$itemlist) {
- my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'itemnumber'}=$item->{'itemnumber'};
- $line{'barcode'}=$item->{'barcode'};
- $line{'title'}=$item->{'title'};
- $line{'author'}=$item->{'author'};
- $line{'publicationyear'}=$item->{'publicationyear'};
- $line{'itemtype'}=$item->{'itemtype'};
- $line{biblionumber} = $item->{biblionumber};
- push(@itemsloop, \%line);
- }
- $template->param( itemsloop => \@itemsloop,
- shelfname => $shelflist->{$shelfnumber}->{'shelfname'},
- shelfnumber => $shelfnumber,
- viewshelf => $query->param('viewshelf'),
- manageshelf => &ShelfPossibleAction($loggedinuser,$shelfnumber,'manage'),
- );
+ if ( $shelfnumber == -1 ) { #shelf already exists.
+ $template->param(
+ {
+ shelfnumber => $shelfnumber,
+ already => 1
+ }
+ );
+ }
+ }
+ my @paramsloop;
+ foreach ( $query->param() ) {
+ my %line;
+ if (/DEL-(\d+)/) {
+ my $delshelf = $1;
+ my ( $status, $count ) = DelShelf($delshelf);
+ if ($status) {
+ $line{'status'} = $status;
+ $line{'count'} = $count;
+ }
+ }
+
+ #if the shelf is not deleted, %line points on null
+ push( @paramsloop, \%line );
+ }
+ $innertemplate->param( paramsloop => \@paramsloop );
+ my ($shelflist) = GetShelves( $loggedinuser, 2 );
+ my $color = '';
+ my @shelvesloop;
+ foreach my $element ( sort keys %$shelflist ) {
+ my %line;
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ push( @shelvesloop, \%line );
+ }
+ $innertemplate->param(
+ shelvesloop => \@shelvesloop,
+ shelves => 1,
+ );
}
#
# $Log$
-# Revision 1.10 2006/09/27 21:19:21 tgarip1957
-# Finalized XML version for intranet
-#
-# Revision 1.9 2006/07/04 14:36:51 toins
-# Head & rel_2_2 merged
-#
-# Revision 1.5.2.5 2006/02/05 21:59:21 kados
-# Adds script support for IntranetNav ... see mail to koha-devel for
-# details
-#
-# Revision 1.5.2.4 2006/02/05 21:45:25 kados
-# Adds support for intranetstylesheet system pref in Koha scripts
-#
-# Revision 1.5.2.3 2006/02/04 21:26:47 kados
-# Adds support for intranetcolorstylesheet
-#
-# Revision 1.5.2.2 2005/04/27 18:15:27 oleonard
-# Left out some instances in the previous update
-#
-# Revision 1.5.2.1 2005/04/27 16:55:38 oleonard
-# Moving alternating row colors to the template, adding publicationyear and itemtype variables
-#
-# Revision 1.5 2004/12/16 11:30:57 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf name & status
-#
-# Revision 1.4 2004/12/15 17:28:23 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf (this being not finished, will commit the rest soon)
-#
-# Revision 1.3 2004/12/02 16:38:50 tipaul
-# improvement in book shelves
-#
-# Revision 1.2 2004/11/19 16:31:30 tipaul
-# bugfix for bookshelves not in official CVS
+# Revision 1.11 2007/03/09 14:32:26 tipaul
+# rel_3_0 moved to HEAD
#
-# Revision 1.1.2.1 2004/03/10 15:08:18 tipaul
-# modifying shelves : introducing category of shelf : private, public, free for all
+# Revision 1.9.2.9 2007/02/05 15:54:30 toins
+# don't display "remove selected shelves" if the user logged has no shelf.
#
-# Revision 1.13 2004/02/11 08:35:31 tipaul
-# synch'ing 2.0.0 branch and head
+# Revision 1.9.2.8 2006/12/15 17:36:57 toins
+# - some change on the html param.
+# - Writing directly the code of a sub called only once.
+# - adding syspref: BiblioDefaultView.
#
-# Revision 1.12.2.1 2004/02/06 14:22:19 tipaul
-# fixing bugs in bookshelves management.
+# Revision 1.9.2.7 2006/12/14 17:22:55 toins
+# bookshelves work perfectly with mod_perl and are cleaned.
#
-# Revision 1.12 2003/02/05 10:04:14 acli
-# Worked around weirdness with HTML::Template; without the {}, it complains
-# of being passed an odd number of arguments even though we are not
+# Revision 1.9.2.6 2006/12/13 10:06:05 toins
+# fix a mod_perl specific bug.
#
-# Revision 1.11 2003/02/05 09:23:03 acli
-# Fixed a few minor errors to make it run
-# Noted correct tab size
+# Revision 1.9.2.5 2006/12/11 17:10:06 toins
+# fixing some bugs on bookshelves.
#
-# Revision 1.10 2003/02/02 07:18:37 acli
-# Moved C4/Charset.pm to C4/Interface/CGI/Output.pm
+# Revision 1.9.2.4 2006/11/30 18:23:51 toins
+# theses scripts don't need to use C4::Search.
#
-# Create output_html_with_http_headers function to contain the "print $query
-# ->header(-type => guesstype...),..." call. This is in preparation for
-# non-HTML output (e.g., text/xml) and charset conversion before output in
-# the future.
+# Revision 1.9.2.3 2006/10/30 09:50:45 tipaul
+# better perl writting
#
-# Created C4/Interface/CGI/Template.pm to hold convenience functions specific
-# to the CGI interface using HTML::Template
+# Revision 1.9.2.2 2006/10/17 07:59:35 toins
+# ccode added.
#
-# Modified moremembers.pl to make the "sex" field localizable for languages
-# where M and F doesn't make sense
-#
-# Revision 1.9 2002/12/19 18:55:40 hdl
-# Templating reservereport et shelves.
-#
-# Revision 1.9 2002/08/14 18:12:51 hdl
-# Templating files
-#
-# Revision 1.8 2002/08/14 18:12:51 tonnesen
-# Added copyright statement to all .pl and .pm files
-#
-# Revision 1.7 2002/07/05 05:03:37 tonnesen
-# Minor changes to authentication routines.
-#
-# Revision 1.5 2002/07/04 19:42:48 tonnesen
-# Minor changes
-#
-# Revision 1.4 2002/07/04 19:21:29 tonnesen
-# Beginning of authentication api. Applied to shelves.pl for now as a test case.
-#
-# Revision 1.2.2.1 2002/06/26 20:28:15 tonnesen
-# Some udpates that I made here locally a while ago. Still won't be useful, but
-# should be functional
-#
-#
-#
-
-
-
-
-# Local Variables:
-# tab-width: 4
-# End:
=head1 DESCRIPTION
-This script needs a biblionumber in bib parameter (bibnumber
-from koha style DB. Automaticaly maps to marc biblionumber).
+This script needs a biblionumber as parameter
=head1 FUNCTIONS
=cut
-
use strict;
-
+require Exporter;
use C4::Auth;
use C4::Context;
-use C4::AuthoritiesMarc;
+use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
-use C4::Biblio;
-use C4::Acquisition;
use C4::Koha;
+use C4::Biblio;
+use C4::Branch; # GetBranchDetail
+use C4::Serials; # CountSubscriptionFromBiblionumber
+
+
+#---- Internal function
+
+sub get_authorised_value_desc ($$$$$$$) {
+ my ( $itemtype, $tagslib, $tag, $subfield, $value, $framework, $dbh ) = @_;
+
+ #---- branch
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
+ return GetBranchDetail($value)->{branchname};
+ }
+
+ #---- itemtypes
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
+ my $itemtypedef = getitemtypeinfo($itemtype);
+ return $itemtypedef->{description};
+ }
+
+ #---- "true" authorized value
+ my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
+
+ if ( $category ne "" ) {
+ my $sth =
+ $dbh->prepare(
+"select lib from authorised_values where category = ? and authorised_value = ?"
+ );
+ $sth->execute( $category, $value );
+ my $data = $sth->fetchrow_hashref;
+ return $data->{'lib'};
+ }
+ else {
+ return $value; # if nothing is found return the original value
+ }
+}
+# ------
-my $query=new CGI;
-my $dbh=C4::Context->dbh;
+my $query = new CGI;
+my $dbh = C4::Context->dbh;
-my $biblionumber=$query->param('biblionumber');
+my $biblionumber = $query->param('biblionumber');
+my $itemtype = &MARCfind_frameworkcode($biblionumber);
+my $tagslib = &MARCgettagslib( $dbh, 1, $itemtype );
-my $itemtype = &MARCfind_frameworkcode($dbh,$biblionumber);
-my $tagslib = &MARCgettagslib($dbh,1,$itemtype);
+my $record = GetMarcBiblio($biblionumber);
-my $record =XMLgetbibliohash($dbh,$biblionumber);
# open template
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "catalogue/ISBDdetail.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 1,
- debug => 1,
- });
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "catalogue/ISBDdetail.tmpl",
+ query => $query,
+ type => "intranet",
+ debug => 1,
+ }
+);
my $ISBD = C4::Context->preference('ISBD');
+
+# my @blocs = split /\@/,$ISBD;
+# my @fields = $record->fields();
my $res;
- my $bloc = $ISBD;
- my $blocres;
- foreach my $isbdfield (split /#/,$bloc) {
- $isbdfield =~ /(\d\d\d)\|(.*)\|(.*)\|(.*)/;
- my $fieldvalue=$1;
- my $textbefore=$2;
- my $analysestring=$3;
- my $textafter=$4;
- if ($fieldvalue>0) {
- my $hasputtextbefore=0;
-
- my $calculated = $analysestring;
- my $tag = $fieldvalue;
- if ($tag<10) {
- my $value=XML_readline_onerecord($record,"","",$tag);
- my $subfieldcode = "@";
- my $subfieldvalue = get_authorised_value_desc($tag, "", $value, '', $dbh);;
- my $tagsubf = $tag.$subfieldcode;
- $calculated =~ s/\{(.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue\{$1$tagsubf$2\}$2/g;
-
- } else {
- my @subf = XML_readline_withtags($record,"","",$tag);
-
- for my $i (0..$#subf) {
- my $subfieldcode = $subf[$i][0];
- my $subfieldvalue = get_authorised_value_desc($tag, $subf[$i][0], $subf[$i][1], '', $dbh);;
- my $tagsubf = $tag.$subfieldcode;
- $calculated =~ s/\{(.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue\{$1$tagsubf$2\}$2/g;
- }
- # field builded, store the result
- if ($calculated && !$hasputtextbefore) { # put textbefore if not done
- $blocres .=$textbefore;
- $hasputtextbefore=1
- }
- # remove punctuation at start
- $calculated =~ s/^( |;|:|\.|-)*//g;
- $blocres.=$calculated;
- }
-
- $blocres .=$textafter if $hasputtextbefore;
- } else {
- $blocres.=$isbdfield;
- }
- }
- $res.=$blocres;
+
+# foreach my $bloc (@blocs) {
+# $bloc =~ s/\n//g;
+my $bloc = $ISBD;
+my $blocres;
+foreach my $isbdfield ( split /#/, $bloc ) {
+
+ # $isbdfield= /(.?.?.?)/;
+ $isbdfield =~ /(\d\d\d)\|(.*)\|(.*)\|(.*)/;
+ my $fieldvalue = $1;
+ my $textbefore = $2;
+ my $analysestring = $3;
+ my $textafter = $4;
+
+ # warn "==> $1 / $2 / $3 / $4";
+ # my $fieldvalue=substr($isbdfield,0,3);
+ if ( $fieldvalue > 0 ) {
+
+ # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
+ # warn "FV : $fieldvalue";
+ my $hasputtextbefore = 0;
+ foreach my $field ( $record->field($fieldvalue) ) {
+ my $calculated = $analysestring;
+ my $tag = $field->tag();
+ if ( $tag < 10 ) {
+ }
+ else {
+ my @subf = $field->subfields;
+ for my $i ( 0 .. $#subf ) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue =
+ get_authorised_value_desc( $itemtype,$tagslib, $tag, $subf[$i][0],
+ $subf[$i][1], '', $dbh );
+ my $tagsubf = $tag . $subfieldcode;
+ $calculated =~
+s/\{(.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue\{$1$tagsubf$2\}$2/g;
+ }
+
+ # field builded, store the result
+ if ( $calculated && !$hasputtextbefore )
+ { # put textbefore if not done
+ $blocres .= $textbefore;
+ $hasputtextbefore = 1;
+ }
+
+ # remove punctuation at start
+ $calculated =~ s/^( |;|:|\.|-)*//g;
+ $blocres .= $calculated;
+ }
+ }
+ $blocres .= $textafter if $hasputtextbefore;
+ }
+ else {
+ $blocres .= $isbdfield;
+ }
+}
+$res .= $blocres;
+
# }
$res =~ s/\{(.*?)\}//g;
$res =~ s/\\n/\n/g;
$res =~ s/\n/<br\/>/g;
+
# remove empty ()
$res =~ s/\(\)//g;
-$template->param(ISBD => $res,
- biblionumber => $biblionumber);
-output_html_with_http_headers $query, $cookie, $template->output;
-
-sub get_authorised_value_desc ($$$$$) {
- my($tag, $subfield, $value, $framework, $dbh) = @_;
+my $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber);
+
+if ($subscriptionsnumber) {
+ my $subscriptions = GetSubscriptionsFromBiblionumber($biblionumber);
+ my $subscriptiontitle = $subscriptions->[0]{'bibliotitle'};
+ $template->param(
+ subscriptionsnumber => $subscriptionsnumber,
+ subscriptiontitle => $subscriptiontitle,
+ );
+}
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- return getbranchname($value);
- }
+$template->param (
+ ISBD => $res,
+ biblionumber => $biblionumber,
+);
- #---- itemtypes
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
- return ItemType($value);
- }
+output_html_with_http_headers $query, $cookie, $template->output;
- #---- "true" authorized value
- my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
-
- if ($category ne "") {
- my $sth = $dbh->prepare("select lib from authorised_values where category = ? and authorised_value = ?");
- $sth->execute($category, $value);
- my $data = $sth->fetchrow_hashref;
- return $data->{'lib'};
- } else {
- return $value; # if nothing is found return the original value
- }
-}
=head1 DESCRIPTION
-This script needs a biblionumber in bib parameter (bibnumber
-from koha style DB. Automaticaly maps to marc biblionumber).
+This script needs a biblionumber as parameter
It shows the biblio in a (nice) MARC format depending on MARC
parameters tables.
=cut
-
use strict;
+require Exporter;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
-use C4::Search;
+use C4::Koha;
+use MARC::Record;
use C4::Biblio;
use C4::Acquisition;
-use C4::Serials; #uses getsubscriptionsfrombiblionumber
-use C4::Koha;
+use C4::Serials; #uses getsubscriptionsfrombiblionumber GetSubscriptionsFromBiblionumber
-my $query=new CGI;
-
-my $dbh=C4::Context->dbh;
-my $retrieve_from=C4::Context->preference('retrieve_from');
-my $biblionumber=$query->param('biblionumber');
-my $frameworkcode = $query->param('frameworkcode');
-my $popup = $query->param('popup'); # if set to 1, then don't insert links, it's just to show the biblio
-my $record;
-my @itemrecords;
-my $xmlhash;
-$frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
-my $tagslib = &MARCgettagslib($dbh,1,$frameworkcode);
-my $itemstagslib = &MARCitemsgettagslib($dbh,1,$frameworkcode);
-
-if ($retrieve_from eq "zebra"){
-($xmlhash,@itemrecords)=ZEBRAgetrecord($biblionumber);
-
-}else{
- $record =XMLgetbiblio($dbh,$biblionumber);
-$xmlhash=XML_xml2hash_onerecord($record);
-my @itemxmls=XMLgetallitems($dbh,$biblionumber);
- foreach my $itemrecord(@itemxmls){
- my $itemhash=XML_xml2hash($itemrecord);
- push @itemrecords, $itemhash;
- }
+#---- Internal function ---
+sub get_authorised_value_desc ($$$$$$) {
+ my ( $tagslib, $tag, $subfield, $value, $framework, $dbh ) = @_;
+
+ #---- branch
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
+
+ # return GetBranchDetail($value)->{branchname};
+ }
+
+ #---- itemtypes
+ if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
+
+ # my $itemtypedef = getitemtypeinfo($itemtype);
+ # return $itemtypedef->{description};
+ }
+
+ #---- "true" authorized value
+ my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
+
+ if ( $category ne "" ) {
+ my $sth =
+ $dbh->prepare(
+"select lib from authorised_values where category = ? and authorised_value = ?"
+ );
+ $sth->execute( $category, $value );
+ my $data = $sth->fetchrow_hashref;
+ return $data->{'lib'};
+ }
+ else {
+ return $value; # if nothing is found return the original value
+ }
}
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "catalogue/MARCdetail.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- debug => 1,
- });
+#---------
+
+my $query = new CGI;
+my $dbh = C4::Context->dbh;
+my $biblionumber = $query->param('biblionumber');
+my $frameworkcode = MARCfind_frameworkcode( $biblionumber );
+my $popup =
+ $query->param('popup')
+ ; # if set to 1, then don't insert links, it's just to show the biblio
+my $subscriptionid = $query->param('subscriptionid');
+
+my $tagslib = &MARCgettagslib($dbh,1,$frameworkcode);
+
+my $record = GetMarcBiblio($biblionumber);
+
+# open template
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "catalogue/MARCdetail.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { catalogue => 1 },
+ debug => 1,
+ }
+);
#Getting the list of all frameworks
-my $queryfwk =$dbh->prepare("select frameworktext, frameworkcode from biblios_framework");
+my $queryfwk =
+ $dbh->prepare("select frameworktext, frameworkcode from biblio_framework");
$queryfwk->execute;
my %select_fwk;
my @select_fwk;
my $curfwk;
-push @select_fwk,"Default";
+push @select_fwk, "Default";
$select_fwk{"Default"} = "Default";
-while (my ($description, $fwk) =$queryfwk->fetchrow) {
- push @select_fwk, $fwk;
- $select_fwk{$fwk} = $description;
+
+while ( my ( $description, $fwk ) = $queryfwk->fetchrow ) {
+ push @select_fwk, $fwk;
+ $select_fwk{$fwk} = $description;
}
$curfwk=$frameworkcode;
my $framework=CGI::scrolling_list( -name => 'Frameworks',
- -id => 'Frameworks',
- -default => $curfwk,
- -OnChange => 'Changefwk(this);',
- -values => \@select_fwk,
- -labels => \%select_fwk,
- -size => 1,
- -multiple => 0 );
-
-$template->param( framework => $framework);
+ -id => 'Frameworks',
+ -default => $curfwk,
+ -OnChange => 'Changefwk(this);',
+ -values => \@select_fwk,
+ -labels => \%select_fwk,
+ -size => 1,
+ -multiple => 0 );
+$template->param(framework => $framework);
# fill arrays
-my @loop_data =();
+my @loop_data = ();
my $tag;
+
# loop through each tab 0 through 9
-##Only attempt to fill the template if we actually received a MARC record
-if ($xmlhash){
-my ($isbntag,$isbnsub)=MARCfind_marc_from_kohafield("isbn","biblios");
-my $biblio=$xmlhash->{'datafield'};
-my $controlfields=$xmlhash->{'controlfield'};
-my $leader=$xmlhash->{'leader'};
-for (my $tabloop = 0; $tabloop<10;$tabloop++) {
-# loop through each tag
- my @loop_data =();
- my @subfields_data;
-
- # deal with leader
- unless (($tagslib->{'000'}->{'@'}->{tab} ne $tabloop) || (substr($tagslib->{'000'}->{'@'}->{hidden},1,1)>0)) {
-
- my %subfield_data;
- $subfield_data{marc_value}=$leader->[0] ;
- push(@subfields_data, \%subfield_data);
- my %tag_data;
- $tag_data{tag}='000 -'. $tagslib->{'000'}->{lib};
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- ##Controlfields
-
- foreach my $control (@$controlfields){
- my %subfield_data;
- my %tag_data;
- next if ($tagslib->{$control->{'tag'}}->{'@'}->{tab} ne $tabloop);
- next if (substr($tagslib->{$control->{'tag'}}->{'@'}->{hidden},1,1)>0);
- $subfield_data{marc_value}=$control->{'content'} ;
- push(@subfields_data, \%subfield_data);
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$control->{'tag'}}->{lib};
- } else {
- $tag_data{tag}=$control->{'tag'}.' -'. $tagslib->{$control->{'tag'}}->{lib};
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- my $previoustag;
- my %datatags;
- my $i=0;
- foreach my $data (@$biblio){
- $datatags{$i++}=$data->{'tag'};
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- next if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{tab} ne $tabloop);
- next if (substr($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{hidden},1,1)>0);
- my %subfield_data;
- my $value=$code->{'content'};
- $subfield_data{marc_lib}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{lib};
- $subfield_data{link}=$tagslib->{$data->{'tag'}}->{$code->{'code'}}->{link};
- if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{isurl}) {
- $subfield_data{marc_value}="<a href=\"$value\">$value</a>";
- } elsif ($data->{'tag'} eq $isbntag && $code->{'code'} eq $isbnsub) {
- $subfield_data{marc_value}=DisplayISBN($value);
- } else {
- if ($tagslib->{$data->{'tag'}}->{$code->{'code'}}->{authtypecode}) {
- my ($authtag,$authtagsub)=MARCfind_marc_from_kohafield("auth_biblio_link_subf","biblios");
- $subfield_data{authority}=XML_readline_onerecord($xmlhash,"","",$data->{'tag'},$authtagsub);
- }
- $subfield_data{marc_value}=get_authorised_value_desc($data->{'tag'}, $code->{'code'}, $value, '', $dbh);
- }
- $subfield_data{marc_subfield}=$code->{'code'};
- $subfield_data{marc_tag}=$data->{'tag'};
- push(@subfields_data, \%subfield_data);
- }### $code
-
-
- if ($#subfields_data==0) {
- # $subfields_data[0]->{marc_lib}='';
- # $subfields_data[0]->{marc_subfield}='';
- }
- if ($#subfields_data>=0) {
- my %tag_data;
- if (($datatags{$i} eq $datatags{$i-1}) && (C4::Context->preference('LabelMARCView') eq 'economical')) {
- $tag_data{tag}="";
- } else {
- if (C4::Context->preference('hide_marc')) {
- $tag_data{tag}=$tagslib->{$data->{'tag'}}->{lib};
- } else {
- $tag_data{tag}=$data->{'tag'}.' -'. $tagslib->{$data->{'tag'}}->{lib};
- }
- }
- my @tmp = @subfields_data;
- $tag_data{subfield} = \@tmp;
- push (@loop_data, \%tag_data);
- undef @subfields_data;
- }
- }### each $subfield
- }
-
- $template->param($tabloop."XX" =>\@loop_data);
+for ( my $tabloop = 0 ; $tabloop <= 10 ; $tabloop++ ) {
+
+ # loop through each tag
+ my @fields = $record->fields();
+ my @loop_data = ();
+ my @subfields_data;
+
+ # deal with leader
+ unless ( $tagslib->{'000'}->{'@'}->{tab} ne $tabloop )
+ { # or ($tagslib->{'000'}->{'@'}->{hidden}==(-7|-4|-3|-2|2|3|5|8))) {
+ my %subfield_data;
+ $subfield_data{marc_lib} = $tagslib->{'000'}->{'@'}->{lib};
+ $subfield_data{marc_value} = $record->leader();
+ $subfield_data{marc_subfield} = '@';
+ $subfield_data{marc_tag} = '000';
+ push( @subfields_data, \%subfield_data );
+ my %tag_data;
+ $tag_data{tag} = '000 -' . $tagslib->{'000'}->{lib};
+ my @tmp = @subfields_data;
+ $tag_data{subfield} = \@tmp;
+ push( @loop_data, \%tag_data );
+ undef @subfields_data;
+ }
+ @fields = $record->fields();
+ for ( my $x_i = 0 ; $x_i <= $#fields ; $x_i++ ) {
+
+ # if tag <10, there's no subfield, use the "@" trick
+ if ( $fields[$x_i]->tag() < 10 ) {
+ next
+ if (
+ $tagslib->{ $fields[$x_i]->tag() }->{'@'}->{tab} ne $tabloop );
+ next if ( $tagslib->{ $fields[$x_i]->tag() }->{'@'}->{hidden} );
+ my %subfield_data;
+ $subfield_data{marc_lib} =
+ $tagslib->{ $fields[$x_i]->tag() }->{'@'}->{lib};
+ $subfield_data{marc_value} = $fields[$x_i]->data();
+ $subfield_data{marc_subfield} = '@';
+ $subfield_data{marc_tag} = $fields[$x_i]->tag();
+ push( @subfields_data, \%subfield_data );
+ }
+ else {
+ my @subf = $fields[$x_i]->subfields;
+
+ # loop through each subfield
+ for my $i ( 0 .. $#subf ) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+ next
+ if (
+ $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }->{tab}
+ ne $tabloop );
+ next
+ if ( $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }
+ ->{hidden} );
+ my %subfield_data;
+ $subfield_data{short_desc} = substr(
+ $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }->{lib},
+ 0, 20
+ );
+ $subfield_data{long_desc} =
+ $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }->{lib};
+ $subfield_data{link} =
+ $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }->{link};
+
+# warn "tag : ".$tagslib->{$fields[$x_i]->tag()}." subfield :".$tagslib->{$fields[$x_i]->tag()}->{$subf[$i][0]}."lien koha? : "$subfield_data{link};
+ if ( $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }
+ ->{isurl} )
+ {
+ $subfield_data{marc_value} =
+ "<a href=\"$subf[$i][1]\">$subf[$i][1]</a>";
+ }
+ elsif ( $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }
+ ->{kohafield} eq "biblioitems.isbn" )
+ {
+
+# warn " tag : ".$tagslib->{$fields[$x_i]->tag()}." subfield :".$tagslib->{$fields[$x_i]->tag()}->{$subf[$i][0]}. "ISBN : ".$subf[$i][1]."PosttraitementISBN :".DisplayISBN($subf[$i][1]);
+ $subfield_data{marc_value} = DisplayISBN( $subf[$i][1] );
+ }
+ else {
+ if ( $tagslib->{ $fields[$x_i]->tag() }->{ $subf[$i][0] }
+ ->{authtypecode} )
+ {
+ $subfield_data{authority} = $fields[$x_i]->subfield(9);
+ }
+ $subfield_data{marc_value} =
+ get_authorised_value_desc( $tagslib, $fields[$x_i]->tag(),
+ $subf[$i][0], $subf[$i][1], '', $dbh );
+ }
+ $subfield_data{marc_subfield} = $subf[$i][0];
+ $subfield_data{marc_tag} = $fields[$x_i]->tag();
+ push( @subfields_data, \%subfield_data );
+ }
+ }
+ if ( $#subfields_data == 0 ) {
+ $subfields_data[0]->{marc_lib} = '';
+ $subfields_data[0]->{marc_subfield} = '';
+ }
+ if ( $#subfields_data >= 0 ) {
+ my %tag_data;
+ if ( $fields[$x_i]->tag() eq $fields[ $x_i - 1 ]->tag() ) {
+ $tag_data{tag} = "";
+ }
+ else {
+ if ( C4::Context->preference('hide_marc') ) {
+ $tag_data{tag} = $tagslib->{ $fields[$x_i]->tag() }->{lib};
+ }
+ else {
+ $tag_data{tag} =
+ $fields[$x_i]->tag() . ' -'
+ . $tagslib->{ $fields[$x_i]->tag() }->{lib};
+ }
+ }
+ my @tmp = @subfields_data;
+ $tag_data{subfield} = \@tmp;
+ push( @loop_data, \%tag_data );
+ undef @subfields_data;
+ }
+ }
+ $template->param( $tabloop . "XX" => \@loop_data );
}
+
# now, build item tab !
# the main difference is that datas are in lines and not in columns : thus, we build the <th> first, then the values...
# loop through each tag
# warning : we may have differents number of columns in each row. Thus, we first build a hash, complete it if necessary
# then construct template.
-my @fields;
-my %witness; #---- stores the list of subfields used at least once, with the "meaning" of the code
+my @fields = $record->fields();
+my %witness
+ ; #---- stores the list of subfields used at least once, with the "meaning" of the code
my @big_array;
-foreach my $itemrecord (@itemrecords){
-my $item=$itemrecord->{'datafield'};
-my $controlfields=$itemrecord->{'controlfield'};
-my $leader=$itemrecord->{'leader'};
-my %this_row;
- ### The leader
- unless (substr($itemstagslib->{'000'}->{'@'}->{hidden},1,1)>0){
- my @datasub='000@';
- $witness{$datasub[0]} = $itemstagslib->{'000'}->{'@'}->{lib};
- $this_row{$datasub[0]} =$leader->[0];
- }
- foreach my $control (@$controlfields){
- next if ($itemstagslib->{$control->{'tag'}}->{'@'}->{tab} ne 10);
- next if (substr($itemstagslib->{$control->{'tag'}}->{'@'}->{hidden},1,1)>0);
- my @datasub=$control->{'tag'}.'@';
- $witness{$datasub[0]} = $itemstagslib->{$control->{'tag'}}->{'@'}->{lib};
- $this_row{$datasub[0]} =$control->{'content'};
- }
-
- foreach my $data (@$item){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- next if ($itemstagslib->{$data->{'tag'}}->{$code->{'code'}}->{tab} ne 10);
- next if (substr($itemstagslib->{$data->{'tag'}}->{$code->{'code'}}->{hidden},1,1)>0);
- $witness{$data->{'tag'}.$code->{'code'}} = $itemstagslib->{$data->{'tag'}}->{$code->{'code'}}->{lib};
- $this_row{$data->{'tag'}.$code->{'code'}} =$code->{'content'};
- }
- }# subfield
- }## each field
- if (%this_row) {
- push(@big_array, \%this_row);
- }
-}## each record
-my ($holdingbrtagf,$holdingbrtagsubf) = &MARCfind_marc_from_kohafield("holdingbranch","holdings");
+foreach my $field (@fields) {
+ next if ( $field->tag() < 10 );
+ my @subf = $field->subfields;
+ my %this_row;
+
+ # loop through each subfield
+ for my $i ( 0 .. $#subf ) {
+ next if ( $tagslib->{ $field->tag() }->{ $subf[$i][0] }->{tab} ne 10 );
+ next if ( $tagslib->{ $field->tag() }->{ $subf[$i][0] }->{hidden} );
+ $witness{ $subf[$i][0] } =
+ $tagslib->{ $field->tag() }->{ $subf[$i][0] }->{lib};
+ $this_row{ $subf[$i][0] } = $subf[$i][1];
+ }
+ if (%this_row) {
+ push( @big_array, \%this_row );
+ }
+}
+my ($holdingbrtagf,$holdingbrtagsubf) = &MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$frameworkcode);
@big_array = sort {$a->{$holdingbrtagsubf} cmp $b->{$holdingbrtagsubf}} @big_array;
#fill big_row with missing datas
-foreach my $subfield_code (keys(%witness)) {
- for (my $i=0;$i<=$#big_array;$i++) {
- $big_array[$i]{$subfield_code}=" " unless ($big_array[$i]{$subfield_code});
- }
+foreach my $subfield_code ( keys(%witness) ) {
+ for ( my $i = 0 ; $i <= $#big_array ; $i++ ) {
+ $big_array[$i]{$subfield_code} = " "
+ unless ( $big_array[$i]{$subfield_code} );
+ }
}
+
# now, construct template !
my @item_value_loop;
my @header_value_loop;
-for (my $i=0;$i<=$#big_array; $i++) {
- my $items_data;
- foreach my $subfield_code (keys(%witness)) {
- $items_data .="<td>".$big_array[$i]{$subfield_code}."</td>";
- }
- my %row_data;
- $row_data{item_value} = $items_data;
- push(@item_value_loop,\%row_data);
+for ( my $i = 0 ; $i <= $#big_array ; $i++ ) {
+ my $items_data;
+ foreach my $subfield_code ( keys(%witness) ) {
+ $items_data .= "<td>" . $big_array[$i]{$subfield_code} . "</td>";
+ }
+ my %row_data;
+ $row_data{item_value} = $items_data;
+ push( @item_value_loop, \%row_data );
}
-foreach my $subfield_code (keys(%witness)) {
- my %header_value;
- $header_value{header_value} = $witness{$subfield_code};
- push(@header_value_loop, \%header_value);
+foreach my $subfield_code ( keys(%witness) ) {
+ my %header_value;
+ $header_value{header_value} = $witness{$subfield_code};
+ push( @header_value_loop, \%header_value );
}
-my $subscriptionsnumber = GetSubscriptionsFromBiblionumber($biblionumber);
-$template->param(item_loop => \@item_value_loop,
- item_header_loop => \@header_value_loop,
- biblionumber => $biblionumber,
- subscriptionsnumber => $subscriptionsnumber,
- popup => $popup,
- hide_marc => C4::Context->preference('hide_marc'),
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
-}##if $xmlhash
-output_html_with_http_headers $query, $cookie, $template->output;
+my $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber);
-sub get_authorised_value_desc ($$$$$) {
- my($tag, $subfield, $value, $framework, $dbh) = @_;
+if ($subscriptionsnumber) {
+ my $subscriptions = GetSubscriptionsFromBiblionumber($biblionumber);
+ my $subscriptiontitle = $subscriptions->[0]{'bibliotitle'};
+ $template->param(
+ subscriptiontitle => $subscriptiontitle,
+ subscriptionsnumber => $subscriptionsnumber,
+ );
+}
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- return getbranchname($value);
- }
+$template->param (
+ item_loop => \@item_value_loop,
+ item_header_loop => \@header_value_loop,
+ biblionumber => $biblionumber,
+ popup => $popup,
+ hide_marc => C4::Context->preference('hide_marc'),
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
- #---- itemtypes
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
- return ItemType($value);
- }
+);
- #---- "true" authorized value
- my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
-
- if ($category ne "") {
- my $sth = $dbh->prepare("select lib from authorised_values where category = ? and authorised_value = ?");
- $sth->execute($category, $value);
- my $data = $sth->fetchrow_hashref;
- return $data->{'lib'};
- } else {
- return $value; # if nothing is found return the original value
- }
-}
+output_html_with_http_headers $query, $cookie, $template->output;
#!/usr/bin/perl
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+# $Id$
+
use strict;
require Exporter;
-use C4::Search;
+use CGI;
use C4::Auth;
-use C4::Serials; #uses getsubscriptionfrom biblionumber
+use C4::Serials; #uses getsubscriptionfrom biblionumber
use C4::Interface::CGI::Output;
-use CGI;
use C4::Biblio;
-use C4::Context;
-
-my $dbh=C4::Context->dbh;
-my $query=new CGI;
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "catalogue/detail.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 1,
- flagsrequired => {borrow => 1},
- });
-
-my $biblionumber=$query->param('biblionumber');
-$template->param(biblionumber => $biblionumber);
-my $retrieve_from=C4::Context->preference('retrieve_from');
-my ($record,$frameworkcode);
-my @itemrecords;
-my @items;
-if ($retrieve_from eq "zebra"){
-($record,@itemrecords)=ZEBRAgetrecord($biblionumber);
-}else{
- $record =XMLgetbiblio($dbh,$biblionumber);
-$record=XML_xml2hash_onerecord($record);
-my @itemxmls=XMLgetallitems($dbh,$biblionumber);
- foreach my $itemrecord(@itemxmls){
- my $itemhash=XML_xml2hash_onerecord($itemrecord);
- push @itemrecords, $itemhash;
- }
-}
-
-my $dat = XMLmarc2koha_onerecord($dbh,$record,"biblios");
-my $norequests = 1;
-foreach my $itemrecord (@itemrecords){
-
-my $item= XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
-$item=ItemInfo($dbh,$item);
-$item->{itemtype}=$dat->{itemtype};
- $norequests = 0 unless $item->{'notforloan'};
- $item->{$item->{'publictype'}} = 1; ## NOT sure what this is kept from old db probably useless now
-push @items,$item;
-}
+use C4::Serials;
+
+my $query = new CGI;
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "catalogue/detail.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { catalogue => 1 },
+ }
+);
+
+my $biblionumber = $query->param('biblionumber');
+
+# change back when ive fixed request.pl
+my @items = &GetItemsInfo( $biblionumber, 'intra' );
+my $dat = &GetBiblioData($biblionumber);
+#coping with subscriptions
+my $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber);
+my @subscriptions = GetSubscriptions( $dat->{title}, $dat->{issn}, $biblionumber );
+
+my @subs;
+foreach my $subscription (@subscriptions) {
+ my %cell;
+ $cell{subscriptionid} = $subscription->{subscriptionid};
+ $cell{subscriptionnotes} = $subscription->{notes};
-my $subscriptionsnumber = GetSubscriptionsFromBiblionumber($biblionumber);
+ #get the three latest serials.
+ $cell{latestserials} =
+ GetLatestSerials( $subscription->{subscriptionid}, 3 );
+ push @subs, \%cell;
+}
-$dat->{'count'}=@items;
-$template->param(count =>$dat->{'count'});
-$template->param(norequests => $norequests);
+$dat->{'count'} = @items;
- ## get notes subjects and URLS from MARC record
-
- my $marcflavour = C4::Context->preference("marcflavour");
- my $marcnotesarray = &getMARCnotes($dbh,$record,$marcflavour);
- my $marcsubjctsarray = &getMARCsubjects($dbh,$record,$marcflavour);
- my $marcurlssarray = &getMARCurls($dbh,$record,$marcflavour);
- $template->param(MARCURLS => $marcurlssarray);
- $template->param(MARCNOTES => $marcnotesarray);
- $template->param(MARCSUBJCTS => $marcsubjctsarray);
+my $norequests = 1;
+foreach my $itm (@items) {
+ $norequests = 0
+ unless ( ( $itm->{'notforloan'} > 0 )
+ || ( $itm->{'itemnotforloan'} > 0 ) );
+ $itm->{ $itm->{'publictype'} } = 1;
+}
+$template->param( norequests => $norequests );
-my @results = ($dat,);
+## get notes and subjects from MARC record
+ my $dbh = C4::Context->dbh;
+ my $marcflavour = C4::Context->preference("marcflavour");
+ my $record = GetMarcBiblio($biblionumber);
+ my $marcnotesarray = GetMarcNotes( $record, $marcflavour );
+ my $marcauthorsarray = GetMarcAuthors( $record, $marcflavour );
+ my $marcsubjctsarray = GetMarcSubjects( $record, $marcflavour );
-my $resultsarray=\@results;
-my $itemsarray=\@items;
+ $template->param(
+ MARCNOTES => $marcnotesarray,
+ MARCSUBJCTS => $marcsubjctsarray,
+ MARCAUTHORS => $marcauthorsarray
+ );
+my @results = ( $dat, );
+foreach ( keys %{$dat} ) {
+ $template->param( "$_" => $dat->{$_} . "" );
+}
-$template->param(BIBLIO_RESULTS => $resultsarray,
- ITEM_RESULTS => $itemsarray,
- subscriptionsnumber => $subscriptionsnumber,
+$template->param(
+ ITEM_RESULTS => \@items,
+ biblionumber => $biblionumber,
+ subscriptions => \@subs,
+ subscriptionsnumber => $subscriptionsnumber,
+ subscriptiontitle => $dat->{title},
);
output_html_with_http_headers $query, $cookie, $template->output;
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+
use strict;
require Exporter;
-use C4::Search;
-use C4::Auth;
-use C4::Serials; #uses getsubscriptionfrom biblionumber
-use C4::Interface::CGI::Output;
+use C4::Context;
+use C4::Output; # contains gettemplate
use CGI;
+use C4::Auth;
use C4::Biblio;
-use C4::Context;
+use C4::Interface::CGI::Output;
+use C4::Date;
-my $dbh=C4::Context->dbh;
my $query=new CGI;
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "catalogue/detailprint.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 1,
- flagsrequired => {borrow => 1},
- });
+my $type=$query->param('type');
+($type) || ($type='intra');
my $biblionumber=$query->param('biblionumber');
-$template->param(biblionumber => $biblionumber);
-my $retrieve_from=C4::Context->preference('retrieve_from');
-my ($record,$frameworkcode);
-my @itemrecords;
-my @items;
-if ($retrieve_from eq "zebra"){
-($record,@itemrecords)=ZEBRAgetrecord($biblionumber);
-}else{
- $record =XMLgetbiblio($dbh,$biblionumber);
-$record=XML_xml2hash_onerecord($record);
-my @itemxmls=XMLgetallitems($dbh,$biblionumber);
- foreach my $itemrecord(@itemxmls){
- my $itemhash=XML_xml2hash_onerecord($itemrecord);
- push @itemrecords, $itemhash;
- }
-}
-
-my $dat = XMLmarc2koha_onerecord($dbh,$record,"biblios");
+
+# change back when ive fixed request.pl
+my @items = GetItemsInfo($biblionumber, $type);
my $norequests = 1;
-foreach my $itemrecord (@itemrecords){
-
-my $item= XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
-$item=ItemInfo($dbh,$item);
-$item->{itemtype}=$dat->{itemtype};
- $norequests = 0 unless $item->{'notforloan'};
- $item->{$item->{'publictype'}} = 1; ## NOT sure what this is kept from old db probably useless now
-push @items,$item;
+foreach my $itm (@items) {
+ $norequests = 0 unless $itm->{'notforloan'};
}
-my $subscriptionsnumber = GetSubscriptionsFromBiblionumber($biblionumber);
+my $dat = GetBiblioData($biblionumber);
+my $record = GetMarcBiblio($biblionumber);
+my $addauthor = GetMarcAuthors($record,C4::Context->preference("marcflavour"));
+my $authorcount = scalar @$addauthor;
-$dat->{'count'}=@items;
-$template->param(count =>$dat->{'count'});
-$template->param(norequests => $norequests);
+$dat->{'additional'} ="";
+foreach (@$addauthor) {
+ $dat->{'additional'} .= "|" . $_->{'a'};
+} # for
- ## get notes subjects and URLS from MARC record
-
- my $marcflavour = C4::Context->preference("marcflavour");
- my $marcnotesarray = &getMARCnotes($dbh,$record,$marcflavour);
- my $marcsubjctsarray = &getMARCsubjects($dbh,$record,$marcflavour);
- my $marcurlssarray = &getMARCurls($dbh,$record,$marcflavour);
- $template->param(MARCURLS => $marcurlssarray);
- $template->param(MARCNOTES => $marcnotesarray);
- $template->param(MARCSUBJCTS => $marcsubjctsarray);
+$dat->{'count'}=@items;
+$dat->{'norequests'} = $norequests;
+
+my @results;
-my @results = ($dat,);
+$results[0]=$dat;
my $resultsarray=\@results;
my $itemsarray=\@items;
+my $startfrom=$query->param('startfrom');
+($startfrom) || ($startfrom=0);
+
+my ($template, $loggedinuser, $cookie) = get_template_and_user({
+ template_name => ('catalogue/detailprint.tmpl'),
+ query => $query,
+ type => "intranet",
+ authnotrequired => ($type eq 'opac'),
+ flagsrequired => {catalogue => 1},
+ });
+
+my $count=1;
-$template->param(BIBLIO_RESULTS => $resultsarray,
- ITEM_RESULTS => $itemsarray,
- subscriptionsnumber => $subscriptionsnumber,
-);
+# now to get the items into a hash we can use and whack that thru
+
+
+my $nextstartfrom=($startfrom+20<$count-20) ? ($startfrom+20) : ($count-20);
+my $prevstartfrom=($startfrom-20>0) ? ($startfrom-20) : (0);
+$template->param(startfrom => $startfrom+1,
+ endat => $startfrom+20,
+ numrecords => $count,
+ nextstartfrom => $nextstartfrom,
+ prevstartfrom => $prevstartfrom,
+ BIBLIO_RESULTS => $resultsarray,
+ ITEM_RESULTS => $itemsarray,
+ loggedinuser => $loggedinuser,
+ biblionumber => $biblionumber,
+ );
output_html_with_http_headers $query, $cookie, $template->output;
+
+
+# Local Variables:
+# tab-width: 8
+# End:
#!/usr/bin/perl
-# NOTE: Use standard 8-space tabs for this file (indents are 4 spaces)
-
-# $Id$
# Copyright 2000-2003 Katipo Communications
#
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id$
+
use strict;
require Exporter;
use C4::Koha;
use CGI;
-use C4::Search;
+use C4::Biblio; # to use &GetBiblioItemData &itemissues
use C4::Acquisition;
+use C4::Output; # contains gettemplate
use C4::Auth;
use C4::Interface::CGI::Output;
use C4::Date;
-use C4::Context;
-use C4::Biblio;
-use C4::Accounts2;
-use C4::Circulation::Circ2;
+use C4::Circulation::Circ2; # to use itemissues
-my $dbh=C4::Context->dbh;
my $query=new CGI;
+# FIXME subject is not exported to the template?
+my $subject=$query->param('subject');
+# if its a subject we need to use the subject.tmpl
my ($template, $loggedinuser, $cookie) = get_template_and_user({
- template_name => ( 'catalogue/moredetail.tmpl'),
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {catalogue => 1},
+ template_name => ($subject? 'catalogue/subject.tmpl':
+ 'catalogue/moredetail.tmpl'),
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
});
# get variables
-my $op=$query->param('op');
-my $lost=$query->param('lost');
-my $withdrawn=$query->param('withdrawn');
-my $override=$query->param('override');
-my $itemnumber=$query->param('itemnumber');
-my $barcode=$query->param('barcode');
-my $title=$query->param('title');
my $biblionumber=$query->param('biblionumber');
-my ($record)=XMLgetbibliohash($dbh,$biblionumber);
-my $data=XMLmarc2koha_onerecord($dbh,$record,"biblios");
+my $title=$query->param('title');
+my $bi=$query->param('bi');
+
+my $data=GetBiblioItemData($bi);
my $dewey = $data->{'dewey'};
# FIXME Dewey is a string, not a number, & we should use a function
$dewey =~ s/0+$//;
my @results;
-my @items;
-if ($op eq "update"){
-my $env;
-##Do Lost or Withdraw here
-my $flag=0;
- my ($resbor,$resrec)=C4::Reserves2::CheckReserves($env,$dbh,$itemnumber);
-if ($override ne "yes"){
- if ($resbor){
-# print $query->header;
- $template->param(error => "This item has a reserve on it");
- $template->param(biblionumber =>$biblionumber);
- $template->param(itemnumber =>$itemnumber);
- $template->param(lost =>$lost);
- $template->param(withdrawn =>$withdrawn);
- $flag=1;
- }
- my $sth=$dbh->prepare("Select * from issues where (itemnumber=?) and (returndate is null)");
- $sth->execute($itemnumber);
-
- if (my $data=$sth->fetchrow_hashref) {
- $template->param(biblionumber =>$biblionumber);
- $template->param(itemnumber =>$itemnumber);
- $template->param(error => "This item is On Loan to a member");
- $template->param(lost =>$lost);
- $template->param(withdrawn =>$withdrawn);
- $flag=2;
- }
-}
-if ($flag != 0 && $override ne "yes"){
-
- }else {
- ##UPDATE here
-
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'wthdrawn',$withdrawn,1);
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',$lost);
-
- if ($lost ==1 && $flag ==2){
- my $sth=$dbh->prepare("Select * from issues where (itemnumber=?) and (returndate is null)");
- $sth->execute($itemnumber);
- my $data=$sth->fetchrow_hashref;
- if ($data->{'borrowernumber'} ne '') {
- #item on issue add replacement cost to borrowers record
- my $accountno=getnextacctno($env,$data->{'borrowernumber'},$dbh);
- my $item=getiteminformation($env, $itemnumber);
- my $sth2=$dbh->prepare("Insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
- values
- (?,?,now(),?,?,'L',?,?)");
- $sth2->execute($data->{'borrowernumber'},$accountno,$item->{'replacementprice'},
- "Lost Item $item->{'title'} $item->{'barcode'}",
- $item->{'replacementprice'},$itemnumber);
- $sth2->finish;
- }
- }
- if ($flag==1){
- foreach my $res ($resrec){
- C4::Reserves2::CancelReseve(undef,$res->{itemnumber},$res->{borrowernumber});
- }
- }
-
- }
-}
-my @itemrecords=XMLgetallitems($dbh,$biblionumber);
-foreach my $itemrecord (@itemrecords){
-$itemrecord=XML_xml2hash_onerecord($itemrecord);
-my $items = XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
-$items->{itemtype}=$data->{itemtype};
-$items->{biblionumber}=$biblionumber;
-$items=itemissues($dbh,$items,$items->{'itemnumber'});
-push @items,$items;
-}
+my (@items)= itemissues($bi);
my $count=@items;
$data->{'count'}=$count;
-my ($order,$ordernum)=GetOrder($biblionumber,$barcode);
+
+my $ordernum = GetOrderNumber($biblionumber,$bi);
+my $order = GetOrder($ordernum);
my $env;
$env->{itemcount}=1;
$item->{'ordernumber'} = $ordernum;
$item->{'booksellerinvoicenumber'} = $order->{'booksellerinvoicenumber'};
- if ($item->{'date_due'} gt '0000-00-00'){
- $item->{'date_due'} = format_date($item->{'date_due'});
-$item->{'issue'}= 1;
- $item->{'borrowernumber'} = $item->{'borrower'};
- $item->{'cardnumber'} = $item->{'card'};
-
+ if ($item->{'date_due'} eq 'Available'){
+ $item->{'issue'}= 0;
} else {
- $item->{'issue'}= 0;
+ $item->{'date_due'} = format_date($item->{'date_due'});
+ $item->{'issue'}= 1;
+ $item->{'borrowernumber'} = $item->{'borrower'};
+ $item->{'cardnumber'} = $item->{'card'};
}
}
output_html_with_http_headers $query, $cookie, $template->output;
-
-# Local Variables:
-# tab-width: 8
-# End:
-#!/usr/bin/perl
+#!/usr/bin/perl
# $Id$
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Biblio;
-use C4::Search; # also includes Biblio.pm, Search is used to FindDuplicate
+use C4::Search;
use C4::Context;
-use C4::Koha; # XXX subfield_is_koha_internal_p
use MARC::Record;
+use C4::Log;
+use C4::Koha; # XXX subfield_is_koha_internal_p
+
use MARC::File::USMARC;
-my $format="USMARC";
-$format="UNIMARC" if (C4::Context->preference('marcflavour') eq 'UNIMARC');
-use MARC::File::XML(RecordFormat =>$format);
-use Encode;
+use MARC::File::XML;
+if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
+ MARC::File::XML->default_record_format( 'UNIMARC' );
+}
+
use vars qw( $tagslib);
use vars qw( $authorised_values_sth);
use vars qw( $is_a_modif );
-my $input = new CGI;
-my $z3950 = $input->param('z3950');
-my $logstatus=C4::Context->preference('Activate_log');
-my $xml;
+
my $itemtype; # created here because it can be used in build_authorized_values_list sub
-my $fromserials=$input->param('fromserials');## if a serial is being added do not display navigation menus
-###Find related tags for Z3950 searches- required by template
-my($isbntag,$isbnsub)=MARCfind_marc_from_kohafield("isbn","biblios");
-my($issntag,$issnsub)=MARCfind_marc_from_kohafield("issn","biblios");
-my($titletag,$titlesub)=MARCfind_marc_from_kohafield("title","biblios");
-my($authortag,$authorsub)=MARCfind_marc_from_kohafield("author","biblios");
+=item find_value
+
+ ($indicators, $value) = find_value($tag, $subfield, $record,$encoding);
+
+Find the given $subfield in the given $tag in the given
+MARC::Record $record. If the subfield is found, returns
+the (indicators, value) pair; otherwise, (undef, undef) is
+returned.
+
+=cut
+
+sub find_value {
+ my ($tagfield,$insubfield,$record,$encoding) = @_;
+ my @result;
+ my $indicator;
+ if ($tagfield <10) {
+ if ($record->field($tagfield)) {
+ push @result, $record->field($tagfield)->data();
+ } else {
+ push @result,"";
+ }
+ } else {
+ foreach my $field ($record->field($tagfield)) {
+ my @subfields = $field->subfields();
+ foreach my $subfield (@subfields) {
+ if (@$subfield[0] eq $insubfield) {
+ push @result,@$subfield[1];
+ $indicator = $field->indicator(1).$field->indicator(2);
+ }
+ }
+ }
+ }
+ return($indicator,@result);
+}
+
+
=item MARCfindbreeding
- $record = MARCfindbreeding($dbh, $breedingid,$frameworkcode);
+ $record = MARCfindbreeding($dbh, $breedingid);
Look up the breeding farm with database handle $dbh, for the
record with id $breedingid. If found, returns the decoded
=cut
sub MARCfindbreeding {
- my ($dbh,$id,$oldbiblionumber) = @_;
- my $sth = $dbh->prepare("select marc,encoding from marc_breeding where id=?");
- $sth->execute($id);
- my ($marc,$encoding) = $sth->fetchrow;
- $sth->finish;
- if ($marc) {
- my $record = MARC::File::USMARC::decode($marc);
- if (ref($record) eq undef) {
- return -1;
- }
- if (C4::Context->preference("z3950NormalizeAuthor") and C4::Context->preference("z3950AuthorAuthFields")){
- my ($tag,$subfield) = MARCfind_marc_from_kohafield("author","biblios");
- my $auth_fields = C4::Context->preference("z3950AuthorAuthFields");
- my @auth_fields= split /,/,$auth_fields;
- my $field;
- if ($record->field($tag)){
- foreach my $tmpfield ($record->field($tag)->subfields){
- my $subfieldcode=shift @$tmpfield;
- my $subfieldvalue=shift @$tmpfield;
- if ($field){
- $field->add_subfields("$subfieldcode"=>$subfieldvalue) if ($subfieldcode ne $subfield);
- } else {
- $field=MARC::Field->new($tag,"","",$subfieldcode=>$subfieldvalue) if ($subfieldcode ne $subfield);
- }
- }
- }
- $record->delete_field($record->field($tag));
- foreach my $fieldtag (@auth_fields){
- next unless ($record->field($fieldtag));
- my $lastname = $record->field($fieldtag)->subfield('a');
- my $firstname= $record->field($fieldtag)->subfield('b');
- my $title = $record->field($fieldtag)->subfield('c');
- my $number= $record->field($fieldtag)->subfield('d');
- if ($title){
- $field->add_subfields("$subfield"=>ucfirst($title)." ".ucfirst($firstname)." ".$number);
- }else{
- $field->add_subfields("$subfield"=>ucfirst($firstname).", ".ucfirst($lastname));
- }
- }
- $record->insert_fields_ordered($field);
+ my ($dbh,$id) = @_;
+ my $sth = $dbh->prepare("select file,marc,encoding from marc_breeding where id=?");
+ $sth->execute($id);
+ my ($file,$marc,$encoding) = $sth->fetchrow;
+ if ($marc) {
+ my $record = MARC::Record->new_from_usmarc($marc);
+ if ($record->field('010')){
+ foreach my $field ($record->field('010'))
+ {
+ foreach my $subfield ($field->subfield('a')){
+ my $newisbn = $field->subfield('a');
+ $newisbn =~ s/-//g;
+ $field->update( 'a' => $newisbn );
+
+
}
-##Delete biblionumber tag in case a similar tag is used in imported MARC ##
- my ( $tagfield, $tagsubfield ) =MARCfind_marc_from_kohafield("biblionumber","biblios");
- my $old_field = $record->field($tagfield);
- $record->delete_field($old_field);
- ##add the old biblionumber if a modif but coming from breedingfarm
- if ($oldbiblionumber){
- my $newfield;
- if ($tagfield<10){
- $newfield = MARC::Field->new($tagfield, $oldbiblionumber);
- }else{
- $newfield = MARC::Field->new($tagfield, '', '', "$tagsubfield" => $oldbiblionumber);
- }
- $record->insert_fields_ordered($newfield);
- }
- my $xml=MARC::File::XML::record($record);
- $xml=Encode::encode('utf8',$xml);
- my $xmlhash=XML_xml2hash_onerecord($xml);
- return $xmlhash,$encoding;
-
+# $record->insert_fields_ordered($record->field('010'));
+ }
}
- return -1;
+
+ if ($record->subfield(100,'a')){
+ my $f100a=$record->subfield(100,'a');
+ my $f100 = $record->field(100);
+ my $f100temp = $f100->as_string;
+ $record->delete_field($f100);
+ if (length($f100temp)>28){
+ substr($f100temp,26,2,"50");
+ $f100->update('a' => $f100temp);
+ my $f100 = MARC::Field->new('100','','','a' => $f100temp);
+ $record->insert_fields_ordered($f100);
+ }
+ }
+ if (ref($record) eq undef) {
+ return -1;
+ } else {
+ if (C4::Context->preference("z3950NormalizeAuthor") and C4::Context->preference("z3950AuthorAuthFields")){
+ my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author");
+# my $summary = C4::Context->preference("z3950authortemplate");
+ my $auth_fields = C4::Context->preference("z3950AuthorAuthFields");
+ my @auth_fields= split /,/,$auth_fields;
+ my $field;
+ #warn $record->as_formatted;
+ if ($record->field($tag)){
+ foreach my $tmpfield ($record->field($tag)->subfields){
+# foreach my $subfieldcode ($tmpfield->subfields){
+ my $subfieldcode=shift @$tmpfield;
+ my $subfieldvalue=shift @$tmpfield;
+ if ($field){
+ $field->add_subfields("$subfieldcode"=>$subfieldvalue) if ($subfieldcode ne $subfield);
+ } else {
+ $field=MARC::Field->new($tag,"","",$subfieldcode=>$subfieldvalue) if ($subfieldcode ne $subfield);
+ }
+ }
+# warn $field->as_formatted;
+# }
+ }
+ $record->delete_field($record->field($tag));
+ foreach my $fieldtag (@auth_fields){
+ next unless ($record->field($fieldtag));
+ my $lastname = $record->field($fieldtag)->subfield('a');
+ my $firstname= $record->field($fieldtag)->subfield('b');
+ my $title = $record->field($fieldtag)->subfield('c');
+ my $number= $record->field($fieldtag)->subfield('d');
+ if ($title){
+# $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
+ $field->add_subfields("$subfield"=>ucfirst($title)." ".ucfirst($firstname)." ".$number);
+ }else{
+# $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
+ $field->add_subfields("$subfield"=>ucfirst($firstname).", ".ucfirst($lastname));
+ }
+ }
+ $record->insert_fields_ordered($field);
+ }
+ return $record,$encoding;
+ }
+ }
+ return -1;
}
=cut
sub build_authorized_values_list ($$$$$) {
- my($tag, $subfield, $value, $dbh,$authorised_values_sth) = @_;
+ my($tag, $subfield, $value, $dbh,$authorised_values_sth) = @_;
- my @authorised_values;
- my %authorised_lib;
+ my @authorised_values;
+ my %authorised_lib;
- # builds list, depending on authorised value...
+ # builds list, depending on authorised value...
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- my $sth=$dbh->prepare("select branchcode,branchname from branches order by branchname");
- $sth->execute;
- push @authorised_values, ""
- unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+ #---- branch
+ if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
+ my $sth=$dbh->prepare("select branchcode,branchname from branches order by branchname");
+ $sth->execute;
+ push @authorised_values, ""
+ unless ($tagslib->{$tag}->{$subfield}->{mandatory});
- while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
- push @authorised_values, $branchcode;
- $authorised_lib{$branchcode}=$branchname;
- }
+ while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode}=$branchname;
+ }
- #----- itemtypes
- } elsif ($tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes") {
- my $sth=$dbh->prepare("select itemtype,description from itemtypes order by description");
- $sth->execute;
- push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
-
- while (my ($itemtype,$description) = $sth->fetchrow_array) {
- push @authorised_values, $itemtype;
- $authorised_lib{$itemtype}=$description;
- }
- $value=$itemtype unless ($value);
-
- #---- "true" authorised value
- } else {
- $authorised_values_sth->execute($tagslib->{$tag}->{$subfield}->{authorised_value});
-
- push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
-
- while (my ($value,$lib) = $authorised_values_sth->fetchrow_array) {
- push @authorised_values, $value;
- $authorised_lib{$value}=$lib;
- }
+ #----- itemtypes
+ } elsif ($tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes") {
+ my $sth=$dbh->prepare("select itemtype,description from itemtypes order by description");
+ $sth->execute;
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+
+ while (my ($itemtype,$description) = $sth->fetchrow_array) {
+ push @authorised_values, $itemtype;
+ $authorised_lib{$itemtype}=$description;
+ }
+ $value=$itemtype unless ($value);
+
+ #---- "true" authorised value
+ } else {
+ $authorised_values_sth->execute($tagslib->{$tag}->{$subfield}->{authorised_value});
+
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+
+ while (my ($value,$lib) = $authorised_values_sth->fetchrow_array) {
+ push @authorised_values, $value;
+ $authorised_lib{$value}=$lib;
+ }
}
return CGI::scrolling_list( -name => 'field_value',
- -values => \@authorised_values,
- -default => $value,
- -labels => \%authorised_lib,
- -override => 1,
- -size => 1,
- -multiple => 0 );
+ -values => \@authorised_values,
+ -default => $value,
+ -labels => \%authorised_lib,
+ -override => 1,
+ -size => 1,
+ -multiple => 0 );
}
=item create_input
+
builds the <input ...> entry for a subfield.
+
=cut
+
sub create_input () {
- my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth,$id) = @_;
- my $dbh=C4::Context->dbh;
- $value =~ s/"/"/g;
- my %subfield_data;
- $subfield_data{id}=$id;
- $subfield_data{tag}=$tag;
- $subfield_data{subfield}=$subfield;
- $subfield_data{marc_lib}="<span id=\"error$i\">".$tagslib->{$tag}->{$subfield}->{lib}."</span>";
- $subfield_data{marc_lib_plain}=$tagslib->{$tag}->{$subfield}->{lib};
- $subfield_data{tag_mandatory}=$tagslib->{$tag}->{mandatory};
- $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
- $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
- $subfield_data{index} = $i;
- $subfield_data{visibility} = "display:none" if (substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "0") ; #check parity
- if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
- $subfield_data{marc_value}= build_authorized_values_list($tag, $subfield, $value, $dbh,$authorised_values_sth);
- # it's an authority field
- } elsif ($tagslib->{$tag}->{$subfield}->{authtypecode}) {
-
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff;'\"\" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY> <a style=\"cursor: help;\" href=\"javascript:Dopop('../authorities/auth_finder.pl?authtypecode=".$tagslib->{$tag}->{$subfield}->{authtypecode}."&index=$id',$id);\">...</a>";
- # it's a plugin field
- } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
- # opening plugin. Just check wether we are on a developper computer on a production one
- # (the cgidir differs)
- my $cgidir = C4::Context->intranetdir ."/cgi-bin/value_builder";
- unless (opendir(DIR, "$cgidir")) {
- $cgidir = C4::Context->intranetdir."/value_builder";
- }
- my $plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
- require $plugin;
- my $extended_param = plugin_parameters($dbh,$rec,$tagslib,$i,$tabloop);
- my ($function_name,$javascript) = plugin_javascript($dbh,$rec,$tagslib,$i,$tabloop);
- $subfield_data{marc_value}="<input tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\" href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
- # it's an hidden field
- } elsif ($tag eq '') {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"hidden\" name=\"field_value\" id=\"field_value$id\" value=\"$value\">";
- } elsif (substr($tagslib->{$tag}->{$subfield}->{'hidden'},2,1) gt "1") {
-
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"40\" maxlength=\"255\" >";
- # it's a standard field
- } else {
- if (length($value) >100) {
- $subfield_data{marc_value}="<textarea tabindex=\"1\" name=\"field_value\" id=\"field_value$id\" cols=\"40\" rows=\"5\" >$value</textarea>";
- } else {
- $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" id=\"field_value$id\" value=\"$value\" size=\"50\">"; #"
- }
- }
- return \%subfield_data;
+ my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth) = @_;
+ # must be encoded as utf-8 before it reaches the editor
+ #use Encode;
+ #$value = encode('utf-8', $value);
+ $value =~ s/"/"/g;
+ my $dbh = C4::Context->dbh;
+ my %subfield_data;
+ $subfield_data{tag}=$tag;
+ $subfield_data{subfield}=$subfield;
+ $subfield_data{marc_lib}="<span id=\"error$i\" title=\"".$tagslib->{$tag}->{$subfield}->{lib}."\">".substr($tagslib->{$tag}->{$subfield}->{lib},0,15)."</span>";
+ $subfield_data{marc_lib_plain}=$tagslib->{$tag}->{$subfield}->{lib};
+ $subfield_data{tag_mandatory}=$tagslib->{$tag}->{mandatory};
+ $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
+ $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{kohafield}=$tagslib->{$tag}->{$subfield}->{kohafield};
+ $subfield_data{index} = $i;
+ $subfield_data{visibility} = "display:none" unless (($tagslib->{$tag}->{$subfield}->{hidden}%2==0) or $value ne ''); #check parity
+ # it's an authorised field
+ if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
+ $subfield_data{marc_value}= build_authorized_values_list($tag, $subfield, $value, $dbh,$authorised_values_sth);
+ # it's a thesaurus / authority field
+ } elsif ($tagslib->{$tag}->{$subfield}->{authtypecode}) {
+ $subfield_data{marc_value}="<input type=\"text\" onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffff00;'\"\" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"70\" maxlength=\"255\" DISABLE READONLY> <a style=\"cursor: help;\" href=\"javascript:Dopop('../authorities/auth_finder.pl?authtypecode=".$tagslib->{$tag}->{$subfield}->{authtypecode}."&index=$i',$i)\">...</a>";
+ # it's a plugin field
+ } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
+ # opening plugin. Just check wether we are on a developper computer on a production one
+ # (the cgidir differs)
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin/cataloguing/value_builder";
+ unless (opendir(DIR, "$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/cataloguing/value_builder";
+ }
+ my $plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
+ do $plugin;
+ my $extended_param = plugin_parameters($dbh,$rec,$tagslib,$i,$tabloop);
+ my ($function_name,$javascript) = plugin_javascript($dbh,$rec,$tagslib,$i,$tabloop);
+ $subfield_data{marc_value}="<input tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"70\" maxlength=\"255\" OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\" href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
+ # it's an hidden field
+ } elsif ($tag eq '') {
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffff00'; \" tabindex=\"1\" type=\"hidden\" name=\"field_value\" value=\"$value\">";
+ } elsif ($tagslib->{$tag}->{$subfield}->{'hidden'}) {
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffff00'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"70\" maxlength=\"255\" >";
+ # it's a standard field
+ } else {
+ if (length($value) >100 or (C4::Context->preference("marcflavour") eq "UNIMARC" && $tag >=300 and $tag <400 && $subfield eq 'a') or ($tag >=500 and $tag <600 && C4::Context->preference("marcflavour") eq "MARC21")) {
+ $subfield_data{marc_value}="<textarea tabindex=\"1\" name=\"field_value\" cols=\"70\" rows=\"5\" >$value</textarea>";
+ } else {
+ $subfield_data{marc_value}="<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffff00'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"70\">"; #"
+ }
+ }
+ return \%subfield_data;
}
-sub build_tabs ($$$;$){
- my($template, $xmlhash, $dbh,$addedfield) = @_;
+sub build_tabs ($$$$) {
+ my($template, $record, $dbh,$encoding) = @_;
# fill arrays
my @loop_data =();
my $tag;
my $i=0;
-my $id=100;
- my $authorised_values_sth = $dbh->prepare("select authorised_value,lib
- from authorised_values
- where category=? order by lib");
-my ($biblionumtagfield,$biblionumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblionumber","biblios");
-
-my $biblio;
-my $controlfields;
-my $leader;
-if ($xmlhash){
- $biblio=$xmlhash->{'datafield'};
- $controlfields=$xmlhash->{'controlfield'};
- $leader=$xmlhash->{'leader'};
-}
+ my $authorised_values_sth = $dbh->prepare("select authorised_value,lib
+ from authorised_values
+ where category=? order by lib");
+
+ # in this array, we will push all the 10 tabs
+ # to avoid having 10 tabs in the template : they will all be in the same BIG_LOOP
my @BIG_LOOP;
-my %built;
# loop through each tab 0 through 9
-for (my $tabloop = 0; $tabloop <= 9; $tabloop++) {
-
- my @loop_data = ();
- foreach my $tag (sort(keys (%{$tagslib}))) {
- next if ($tag eq $biblionumtagfield);## Otherwise biblionumber will be duplicated on modifs if user has set visibility to true
- my $indicator;
- # if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab.
- # if MARC::Record is empty => use tab as master loop.
- my @subfields_data;
-
- if ($xmlhash) {
- ####
-
- my %tagdefined;
- my %definedsubfields;
-
- my ($ind1,$ind2);
-
- if ($tag>9){
- foreach my $data (@$biblio){
- my @subfields_data;
- undef %definedsubfields;
- if ($data->{'tag'} eq $tag){
- $tagdefined{$tag}=1 ;
- $ind1=" ";
- $ind2=" ";
- foreach my $subfieldcode ( $data->{'subfield'}){
- foreach my $code ( @$subfieldcode){
- next if ($tagslib->{$tag}->{$code->{'code'}}->{tab} ne $tabloop);
- my $subfield=$code->{'code'} ;
- my $value=$code->{'content'};
- $definedsubfields{$tag.$subfield}=1 ;
- $built{$tag}=1;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id)) ;
- $i++ ;
- }
- } ##each subfield
- $ind1=$data->{'ind1'};
- $ind2= $data->{'ind2'};
-
-
- # now, loop again to add parameter subfield that are not in the MARC::Record
-
- foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if (length $subfield !=1);
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
- next if ($definedsubfields{$tag.$subfield} );
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $definedsubfields{$tag.$subfield}=1;
- $i++;
- }
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = $ind1.$ind2 if ($tag>=10);
- $tag_data{subfield_loop} = \@subfields_data;
- push (@loop_data, \%tag_data);
-
- }
- $id++;
- }## if tag matches
-
- }#eachdata
- }else{ ## tag <10
- if ($tag eq "000" || $tag eq "LDR"){
- my $subfield="@";
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- my @subfields_data;
- my $value=$leader->[0] if $leader->[0];
- $tagdefined{$tag}=1 ;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{subfield_loop} = \@subfields_data;
- $tag_data{fixedfield} = 1;
- push (@loop_data, \%tag_data);
- }
- }else{
- foreach my $control (@$controlfields){
- my $subfield="@";
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- my @subfields_data;
- if ($control->{'tag'} eq $tag){
- $tagdefined{$tag}=1 ;
- my $value=$control->{'content'} ;
- $definedsubfields{$tag.'@'}=1;
- push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
-
- $built{$tag}=1;
-
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{subfield_loop} = \@subfields_data;
- $tag_data{fixedfield} = 1;
- push (@loop_data, \%tag_data);
- }
- $id++;
- }## tag matches
- }# each control
- }
- }##tag >9
-
-
- ##### Any remaining tag
- my @subfields_data;
- # now, loop again to add parameter subfield that are not in the MARC::Record
- foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if ($tagdefined{$tag} );
- next if (length $subfield !=1);
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
-
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $tagdefined{$tag.$subfield}=1;
- $i++;
- }
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = $ind1.$ind2 if ($tag>=10);
- $tag_data{subfield_loop} = \@subfields_data;
- if ($tag<10) {
- $tag_data{fixedfield} = 1;
- }
-
- push (@loop_data, \%tag_data);
- }
-
-
- if ($addedfield eq $tag) {
- my %tag_data;
- my @subfields_data;
- $id++;
- $tagdefined{$tag}=1 ;
- foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
- next if (length $subfield !=1);
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
- $addedfield="";
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
- }
- if ($#subfields_data >= 0) {
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = ' ' if ($tag>=10);
- $tag_data{subfield_loop} = \@subfields_data;
- if ($tag<10) {
- $tag_data{fixedfield} = 1;
- }
- push (@loop_data, \%tag_data);
-
- }
-
- }
-
- # if breeding is empty
- } else {
- my @subfields_data;
- foreach my $subfield (sort(keys %{$tagslib->{$tag}})) {
- next if (length $subfield !=1);
- next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag
- next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
- push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$xmlhash,$authorised_values_sth,$id));
- $i++;
- }
- if ($#subfields_data >= 0) {
- my %tag_data;
- $tag_data{tag} = $tag;
- $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
- $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
- $tag_data{indicator} = $indicator;
- $tag_data{subfield_loop} = \@subfields_data;
- $tag_data{tagfirstsubfield} = $tag_data{subfield_loop}[0];
- if ($tag<10) {
- $tag_data{fixedfield} = 1;
- }
- push (@loop_data, \%tag_data);
- }
- }
- $id++;
- }
- if ($#loop_data >=0) {
+ for (my $tabloop = 0; $tabloop <= 9; $tabloop++) {
+ my @loop_data = ();
+ foreach my $tag (sort(keys (%{$tagslib}))) {
+ my $indicator;
+ # if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab.
+ # if MARC::Record is empty => use tab as master loop.
+ if ($record ne -1 && ($record->field($tag) || $tag eq '000')) {
+ my @fields;
+ if ($tag ne '000') {
+ @fields = $record->field($tag);
+ } else {
+ push @fields,$record->leader();
+ }
+ foreach my $field (@fields) {
+ my @subfields_data;
+ if ($tag<10) {
+ my ($value,$subfield);
+ if ($tag ne '000') {
+ $value=$field->data();
+ $subfield="@";
+ } else {
+ $value = $field;
+ $subfield='@';
+ }
+ next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ next if ($tagslib->{$tag}->{$subfield}->{kohafield} eq 'biblio.biblionumber');
+ push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ } else {
+ my @subfields=$field->subfields();
+ foreach my $subfieldcount (0..$#subfields) {
+ my $subfield=$subfields[$subfieldcount][0];
+ my $value=$subfields[$subfieldcount][1];
+ next if (length $subfield !=1);
+ next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ }
+# now, loop again to add parameter subfield that are not in the MARC::Record
+ foreach my $subfield (sort( keys %{$tagslib->{$tag}})) {
+ next if (length $subfield !=1);
+ next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ next if ($tag<10);
+ next if (($tagslib->{$tag}->{$subfield}->{hidden}<=-4) or ($tagslib->{$tag}->{$subfield}->{hidden}>=5) ); #check for visibility flag
+ next if (defined($field->subfield($subfield)));
+ push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ if ($#subfields_data >= 0) {
+ my %tag_data;
+ $tag_data{tag} = $tag;
+ $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
+ $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
+ $tag_data{indicator} = $record->field($tag)->indicator(1). $record->field($tag)->indicator(2) if ($tag>=10);
+ $tag_data{subfield_loop} = \@subfields_data;
+ if ($tag<10) {
+ $tag_data{fixedfield} = 1;
+ }
+
+ push (@loop_data, \%tag_data);
+ }
+# If there is more than 1 field, add an empty hidden field as separator.
+ if ($#fields >=1 && $#loop_data >=0 && $loop_data[$#loop_data]->{'tag'} eq $tag) {
+ my @subfields_data;
+ my %tag_data;
+ push(@subfields_data, &create_input('','','',$i,$tabloop,$record,$authorised_values_sth));
+ $tag_data{tag} = '';
+ $tag_data{tag_lib} = '';
+ $tag_data{indicator} = '';
+ $tag_data{subfield_loop} = \@subfields_data;
+ if ($tag<10) {
+ $tag_data{fixedfield} = 1;
+ }
+ push (@loop_data, \%tag_data);
+ $i++;
+ }
+ }
+ # if breeding is empty
+ } else {
+ my @subfields_data;
+ foreach my $subfield (sort(keys %{$tagslib->{$tag}})) {
+ next if (length $subfield !=1);
+ next if (($tagslib->{$tag}->{$subfield}->{hidden}<=-5) or ($tagslib->{$tag}->{$subfield}->{hidden}>=4) ); #check for visibility flag
+ next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ if ($#subfields_data >= 0) {
+ my %tag_data;
+ $tag_data{tag} = $tag;
+ $tag_data{tag_lib} = $tagslib->{$tag}->{lib};
+ $tag_data{repeatable} = $tagslib->{$tag}->{repeatable};
+ $tag_data{indicator} = $indicator;
+ $tag_data{subfield_loop} = \@subfields_data;
+ $tag_data{tagfirstsubfield} = $tag_data{subfield_loop}[0];
+ if ($tag<10) {
+ $tag_data{fixedfield} = 1;
+ }
+ push (@loop_data, \%tag_data);
+ }
+ }
+ }
+ if ($#loop_data >=0) {
my %big_loop_line;
$big_loop_line{number}=$tabloop;
$big_loop_line{innerloop}=\@loop_data;
push @BIG_LOOP,\%big_loop_line;
- }
- $template->param(BIG_LOOP => \@BIG_LOOP);
-}## tab loop
+ }
+# $template->param($tabloop."XX" =>\@loop_data);
+ }
+ $template->param(BIG_LOOP => \@BIG_LOOP);
}
+
sub build_hidden_data () {
# build hidden data =>
# we store everything, even if we show only requested subfields.
my @loop_data =();
my $i=0;
foreach my $tag (keys %{$tagslib}) {
- my $previous_tag = '';
-
- # loop through each subfield
- foreach my $subfield (keys %{$tagslib->{$tag}}) {
- next if ($subfield eq 'lib');
- next if ($subfield eq 'tab');
- next if ($subfield eq 'mandatory');
- next if ($subfield eq 'repeatable');
- next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "-1");
- my %subfield_data;
- $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
- $subfield_data{marc_mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
- $subfield_data{marc_repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
- $subfield_data{marc_value}="<input type=\"hidden\" name=\"field_value[]\">";
- push(@loop_data, \%subfield_data);
- $i++
- }
+ my $previous_tag = '';
+
+ # loop through each subfield
+ foreach my $subfield (keys %{$tagslib->{$tag}}) {
+ next if ($subfield eq 'lib');
+ next if ($subfield eq 'tab');
+ next if ($subfield eq 'mandatory');
+ next if ($subfield eq 'repeatable');
+ next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "-1");
+ my %subfield_data;
+ $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
+ $subfield_data{marc_mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
+ $subfield_data{marc_repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{marc_value}="<input type=\"hidden\" name=\"field_value[]\">";
+ push(@loop_data, \%subfield_data);
+ $i++
+ }
}
}
#=========================
my $input = new CGI;
my $error = $input->param('error');
-my $oldbiblionumber=$input->param('oldbiblionumber'); # if bib exists, it's a modif, not a new biblio.
+my $biblionumber=$input->param('biblionumber'); # if biblionumber exists, it's a modif, not a new biblio.
my $breedingid = $input->param('breedingid');
my $z3950 = $input->param('z3950');
my $op = $input->param('op');
-my $duplicateok = $input->param('duplicateok');
-my $suggestionid=$input->param('suggestionid');
my $frameworkcode = $input->param('frameworkcode');
my $dbh = C4::Context->dbh;
-my $biblionumber;
-$biblionumber=$oldbiblionumber if $oldbiblionumber;
+$frameworkcode = &MARCfind_frameworkcode($biblionumber) if ($biblionumber and not ($frameworkcode));
$frameworkcode='' if ($frameworkcode eq 'Default');
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/addbiblio.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
- debug => 1,
- });
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {editcatalogue => 1},
+ debug => 1,
+ });
#Getting the list of all frameworks
-my $queryfwk =$dbh->prepare("select frameworktext, frameworkcode from biblios_framework");
+my $queryfwk =$dbh->prepare("select frameworktext, frameworkcode from biblio_framework");
$queryfwk->execute;
my %select_fwk;
my @select_fwk;
push @select_fwk,"Default";
$select_fwk{"Default"} = "Default";
while (my ($description, $fwk) =$queryfwk->fetchrow) {
- push @select_fwk, $fwk;
- $select_fwk{$fwk} = $description;
+ push @select_fwk, $fwk;
+ $select_fwk{$fwk} = $description;
}
$curfwk=$frameworkcode;
-my $framework=CGI::scrolling_list( -name => 'Frameworks',
- -id => 'Frameworks',
- -default => $curfwk,
- -OnChange => 'Changefwk(this);',
- -values => \@select_fwk,
- -labels => \%select_fwk,
- -size => 1,
- -multiple => 0 );
-$template->param( framework => $framework);
-my $xmlhash;
-my $xml;
-#####DO NOT RETRIVE FROM ZEBRA######
-my $record =XMLgetbiblio($dbh,$biblionumber) if ($biblionumber);
-$xmlhash=XML_xml2hash_onerecord($record) if ($biblionumber);
-$frameworkcode=MARCfind_frameworkcode( $dbh, $biblionumber );
-###########
+my $framework=CGI::scrolling_list(
+ -name => 'Frameworks',
+ -id => 'Frameworks',
+ -default => $curfwk,
+ -OnChange => 'Changefwk(this);',
+ -values => \@select_fwk,
+ -labels => \%select_fwk,
+ -size => 1,
+ -multiple => 0 );
+$template->param( framework => $framework, breedingid => $breedingid);
+
$tagslib = &MARCgettagslib($dbh,1,$frameworkcode);
-if ($suggestionid && !$biblionumber){
-my $data=GetSuggestion($suggestionid) ;
-$xml=$data->{xml};
-$xmlhash=XML_xml2hash_onerecord($xml);
-}
+my $record=-1;
my $encoding="";
-($xmlhash,$encoding) = MARCfindbreeding($dbh,$breedingid,$oldbiblionumber) if ($breedingid);
+$record = GetMarcBiblio( $biblionumber ) if ($biblionumber);
+($record,$encoding) = MARCfindbreeding($dbh,$breedingid) if ($breedingid);
+# warn "biblionumber : $biblionumber = ".$record->as_formatted;
$is_a_modif=0;
-$is_a_modif=1 if $oldbiblionumber;
-my ($oldbiblionumtagfield,$oldbiblionumtagsubfield);
-if ($biblionumber && !$z3950) {
- $is_a_modif=1;
- # if it's a modif, retrieve old biblionumber for the future modification of old-DB.
- ($oldbiblionumtagfield,$oldbiblionumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblionumber","biblios");
-
-
+my ($biblionumtagfield,$biblionumtagsubfield);
+my ($biblioitemnumtagfield,$biblioitemnumtagsubfield,$bibitem,$biblioitemnumber);
+if ($biblionumber) {
+ $is_a_modif=1;
+ # if it's a modif, retrieve bibli and biblioitem numbers for the future modification of old-DB.
+ ($biblionumtagfield,$biblionumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblio.biblionumber",$frameworkcode);
+ ($biblioitemnumtagfield,$biblioitemnumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblioitems.biblioitemnumber",$frameworkcode);
+ # search biblioitems value
+ my $sth=$dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
+ $sth->execute($biblionumber);
+ ($biblioitemnumber) = $sth->fetchrow;
}
-#------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------
if ($op eq "addbiblio") {
-#------------------------------------------------------------------------------------------------------------------------------
- # rebuild
- my @tags = $input->param('tag');
- my @subfields =$input->param('subfield');
- my @values=$input->param('field_value');
- # build indicator hash.
- my @ind_tag = $input->param('ind_tag');
- my @indicator = $input->param('indicator');
- my @tagindex=$input->param('tagindex');
-
-
-## check for malformed xml -- non UTF-8 like (MARC8) will break xml without warning
-### This usually happens with data coming from other Z3950 servers
-## Slows the saving process so comment out at your own risk
-eval{
- $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag,\@tagindex);
-};
- if ($@){
-warn $@;
- $template->param(error =>1,xmlerror=>1,);
-goto FINAL;
- };
-my $xmlhash=XML_xml2hash_onerecord($xml);
- my ($duplicatebiblionumber,$duplicatetitle) = FindDuplicate($xmlhash) if (($op eq "addbiblio") && (!$is_a_modif) && (!$duplicateok));
- my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
- # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
- if (!$duplicatebiblionumber or $confirm_not_duplicate) {
- # MARC::Record built => now, record in DB
- my $oldbibnum;
- my $oldbibitemnum;
- if ($is_a_modif) {
- NEWmodbiblio($dbh,$biblionumber,$xmlhash,$frameworkcode);
-
- } else {
-
- ($biblionumber) = NEWnewbiblio($dbh,$xmlhash,$frameworkcode);
-
- }
- # now, redirect to additem page
- unless ($fromserials){
- print $input->redirect("additem.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode") unless $fromserials;
- exit;
- }else{
- my $title=XML_readline_onerecord($xmlhash,"title","biblios");
- $template->param(exit=>1,biblionumber=>$biblionumber,title=>$title);
- goto FINAL;
- }
-
- } else {
-FINAL:
- # it may be a duplicate, warn the user and do nothing
- build_tabs ($template, $xmlhash, $dbh);
- build_hidden_data;
- $template->param(fromserials=>$fromserials,
- oldbiblionumber => $oldbiblionumber,
- biblionumber => $biblionumber,
- oldbiblionumtagfield => $oldbiblionumtagfield,
- oldbiblionumtagsubfield => $oldbiblionumtagsubfield,
- duplicatebiblionumber => $duplicatebiblionumber,
- duplicatetitle => $duplicatetitle,
- );
- }
-#------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------------
+ # rebuild
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+ if (C4::Context->preference('TemplateEncoding') eq "iso-8859-1") {
+ $record = MARChtml2marc($dbh,\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ } else {
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ $record=MARC::Record->new_from_xml($xml,C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour'));
+# warn "MARC :".$record->as_formatted;
+# die;
+ }
+ # check for a duplicate
+ my ($duplicatebiblionumber,$duplicatebiblionumber,$duplicatetitle) = FindDuplicate($record) if ($op eq "addbiblio") && (!$is_a_modif);
+ my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
+ # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
+ if (!$duplicatebiblionumber or $confirm_not_duplicate) {
+ # MARC::Record built => now, record in DB
+ my $oldbibnum;
+ my $oldbibitemnum;
+ if ($is_a_modif) {
+ ModBiblioframework($biblionumber,$frameworkcode);
+ ModBiblio($record,$biblionumber,$frameworkcode);
+ }
+ else {
+ ($biblionumber,$oldbibitemnum) = AddBiblio($record,$frameworkcode);
+ }
+ # now, redirect to additem page
+ print $input->redirect("additem.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode");
+ exit;
+ } else {
+ # it may be a duplicate, warn the user and do nothing
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(
+ biblionumber => $biblionumber,
+ biblionumtagfield => $biblionumtagfield,
+ biblionumtagsubfield => $biblionumtagsubfield,
+ biblioitemnumtagfield => $biblioitemnumtagfield,
+ biblioitemnumtagsubfield => $biblioitemnumtagsubfield,
+ biblioitemnumber => $biblioitemnumber,
+ duplicatebiblionumber => $duplicatebiblionumber,
+ duplicatebibid => $duplicatebiblionumber,
+ duplicatetitle => $duplicatetitle,
+ );
+ }
+#--------------------------------------------------------------------------
} elsif ($op eq "addfield") {
-#------------------------------------------------------------------------------------------------------------------------------
- my $addedfield = $input->param('addfield_field');
- my @tags = $input->param('tag');
- my @subfields = $input->param('subfield');
- my @values = $input->param('field_value');
- # build indicator hash.
- my @ind_tag = $input->param('ind_tag');
- my @indicator = $input->param('indicator');
- my @tagindex=$input->param('tagindex');
- my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag,\@tagindex);
- my $xmlhash=XML_xml2hash_onerecord($xml);
- # adding an empty field
- build_tabs ($template, $xmlhash, $dbh,$addedfield);
- build_hidden_data;
- $template->param(
- oldbiblionumber => $oldbiblionumber,
- biblionumber => $biblionumber,
- oldbiblionumtagfield => $oldbiblionumtagfield,
- oldbiblionumtagsubfield => $oldbiblionumtagsubfield,
- fromserials=>$fromserials
- );
+#--------------------------------------------------------------------------
+ my $addedfield = $input->param('addfield_field');
+ my $cntrepeatfield=$input->param('repeat_field');
+ $cntrepeatfield=1 unless ($cntrepeatfield);
+ my $tagaddfield_subfield = $input->param('addfield_subfield');
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ my $record;
+ if (C4::Context->preference('TemplateEncoding') eq "iso-8859-1") {
+ my %indicators;
+ for (my $i=0;$i<=$#ind_tag;$i++) {
+ $indicators{$ind_tag[$i]} = $indicator[$i];
+ }
+ $record = MARChtml2marc($dbh,\@tags,\@subfields,\@values,%indicators);
+ } else {
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ $record=MARC::Record->new_from_xml($xml,C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour'));
+ }
+ for (my $i=1;$i<=$cntrepeatfield;$i++){
+ my $field = MARC::Field->new("$addedfield",'','',"$tagaddfield_subfield" => "");
+ $record->append_fields($field);
+ }
+ #warn "result : ".$record->as_formatted;
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(
+ biblionumber => $biblionumber,
+ biblionumtagfield => $biblionumtagfield,
+ biblionumtagsubfield => $biblionumtagsubfield,
+ biblioitemnumtagfield => $biblioitemnumtagfield,
+ biblioitemnumtagsubfield => $biblioitemnumtagsubfield,
+ biblioitemnumber => $biblioitemnumber );
} elsif ($op eq "delete") {
-#------------------------------------------------------------------------------------------------------------------------------
-my $sth=$dbh->prepare("select iss.itemnumber from items i ,issues iss where iss.itemnumber=i.itemnumber and iss.returndate is null and i.biblionumber=?");
- $sth->execute($biblionumber);
-my $onloan=$sth->fetchrow;
-
- if (!$onloan){
- NEWdelbiblio($dbh,$biblionumber);
-print $input->redirect("/cgi-bin/koha/catalogue/catalogue-search.pl");
- exit;
- }else{
-
-$template->param(error => 1, onloan=>1,);
- }
-#------------------------------------------------------------------------------------------------------------------------------
-#------------------------------------------------------------------------------------------------------------------------------
+#-----------------------------------------------------------------------------
+ my $error = &DelBiblio($biblionumber);
+ if ($error) {
+ warn "ERROR when DELETING BIBLIO $biblionumber : $error";
+ print "Content-Type: text/html\n\n<html><body><h1>ERROR when DELETING BIBLIO $biblionumber : $error</h1></body></html>";
+ } else {
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=/cgi-bin/koha/catalogue/search.pl?type=intranet\"></html>";
+ }
+ exit;
+#----------------------------------------------------------------------------
} else {
-#------------------------------------------------------------------------------------------------------------------------------
-
- # If we're in a duplication case, we have to set to "" the biblionumber
- # as we'll save the biblio as a new one.
- if ($op eq "duplicate")
- {
- $biblionumber = "";
- $oldbiblionumber= "";
- $template->param(duplicateok => 1);
- }
- build_tabs ($template, $xmlhash, $dbh);
- build_hidden_data;
- $template->param(
- oldbiblionumber => $oldbiblionumber,
- biblionumber => $biblionumber,
- oldbiblionumtagfield => $oldbiblionumtagfield,
- oldbiblionumtagsubfield => $oldbiblionumtagsubfield,
- fromserials=>$fromserials
- );
+#----------------------------------------------------------------------------
+ # If we're in a duplication case, we have to set to "" the biblionumber
+ # as we'll save the biblio as a new one.
+ if ($op eq "duplicate")
+ {
+ $biblionumber= "";
+ }
+ #FIXME: it's kind of silly to go from MARC::Record to MARC::File::XML and then back again just to fix the encoding
+ eval {
+ my $uxml = $record->as_xml;
+ MARC::Record::default_record_format("UNIMARC") if (C4::Context->preference("marcflavour") eq "UNIMARC");
+ my $urecord = MARC::Record::new_from_xml($uxml, 'UTF-8');
+ $record = $urecord;
+ };
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(
+ biblionumber => $biblionumber,
+ biblionumtagfield => $biblionumtagfield,
+ biblionumtagsubfield => $biblionumtagsubfield,
+ biblioitemnumtagfield => $biblioitemnumtagfield,
+ biblioitemnumtagsubfield => $biblioitemnumtagsubfield,
+ biblioitemnumber => $biblioitemnumber,
+ );
}
+$template->param( title => $record->title() ) if ($record ne "-1");
$template->param(
- isbntag => $isbntag,
- isbnsub => $isbnsub,
- issntag => $isbntag,
- issnsub => $issnsub,
- titletag => $titletag,
- titlesub => $titlesub,
- authortag => $authortag,
- authorsub => $authorsub,
- );
-
-$template->param(
- frameworkcode => $frameworkcode,
- itemtype => $frameworkcode, # HINT: if the library has itemtype = framework, itemtype is auto filled !
- hide_marc => C4::Context->preference('hide_marc'),
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
- );
-
+ frameworkcode => $frameworkcode,
+ itemtype => $frameworkcode, # HINT: if the library has itemtype = framework, itemtype is auto filled !
+ hide_marc => C4::Context->preference('hide_marc'),
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ advancedMARCEditor => C4::Context->preference("advancedMARCEditor"),
+ );
output_html_with_http_headers $input, $cookie, $template->output;
# $Id$
+#
+# Modified saas@users.sf.net 12:00 01 April 2001
+# The biblioitemnumber was not correctly initialised
+# The max(barcode) value was broken - koha 'barcode' is a string value!
+# - If left blank, barcode value now defaults to max(biblionumber)
+
+#
+# TODO
+#
+# Add info on biblioitems and items already entered as you enter new ones
+#
+# Add info on biblioitems and items already entered as you enter new ones
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
use CGI;
use C4::Auth;
use C4::Biblio;
+use C4::Breeding;
use C4::Output;
use C4::Interface::CGI::Output;
+
use C4::Koha;
+use C4::Search;
+
+my $input = new CGI;
-my $query = new CGI;
+my $success = $input->param('biblioitem');
+my $query = $input->param('q');
+my @value = $input->param('value');
-my $error = $query->param('error');
-my $success = $query->param('biblioitem');
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "cataloguing/addbooks.tmpl",
- query => $query,
+ query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1 },
push @frameworkcodeloop, \%row;
}
-my $marc_p = C4::Context->boolean_preference("marc");
-$template->param( NOTMARC => !$marc_p,
- frameworkcodeloop => \@frameworkcodeloop );
+# Searching the catalog.
+if($query) {
+ my ($error, $marcresults) = SimpleSearch($query);
+
+ if (defined $error) {
+ $template->param(error => $error);
+ warn "error: ".$error;
+ output_html_with_http_headers $input, $cookie, $template->output;
+ exit;
+ }
+
+ my $total = scalar @$marcresults;
+ my @results;
+
+ for(my $i=0;$i<$total;$i++) {
+ my %resultsloop;
+ my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
+ my $biblio = MARCmarc2koha(C4::Context->dbh,$marcrecord,'');
+
+ #hilight the result
+ $biblio->{'title'} =~ s/$query/<span class=term>$&<\/span>/gi;
+ $biblio->{'subtitle'} =~ s/$query/<span class=term>$&<\/span>/gi;
+ $biblio->{'biblionumber'} =~ s/$query/<span class=term>$&<\/span>/gi;
+ $biblio->{'author'} =~ s/$query/<span class=term>$&<\/span>/gi;
+ $biblio->{'publishercode'} =~ s/$query/<span class=term>$&<\/span>/gi;
+ $biblio->{'publicationyear'} =~ s/$query/<span class=term>$&<\/span>/gi;
+
+ #build the hash for the template.
+ $resultsloop{highlight} = ($i % 2)?(1):(0);
+ $resultsloop{title} = $biblio->{'title'};
+ $resultsloop{subtitle} = $biblio->{'subtitle'};
+ $resultsloop{biblionumber} = $biblio->{'biblionumber'};
+ $resultsloop{author} = $biblio->{'author'};
+ $resultsloop{publishercode} = $biblio->{'publishercode'};
+ $resultsloop{publicationyear} = $biblio->{'publicationyear'};
+
+ push @results, \%resultsloop;
+ }
+ $template->param(
+ total => $total,
+ query => $query,
+ resultsloop => \@results,
+ );
+}
+
+# fill with books in breeding farm
+my $toggle=0;
+my ($title,$isbn);
+# fill isbn or title, depending on what has been entered
+$isbn=$query if $query =~ /\d/;
+$title=$query unless $isbn;
+my ( $countbr, @resultsbr ) = BreedingSearch( $title, $isbn ) if $query;
+my @breeding_loop = ();
+for ( my $i = 0 ; $i <= $#resultsbr ; $i++ ) {
+ my %row_data;
+ if ( $i % 2 ) {
+ $toggle = 0;
+ }
+ else {
+ $toggle = 1;
+ }
+ $row_data{toggle} = $toggle;
+ $row_data{id} = $resultsbr[$i]->{'id'};
+ $row_data{isbn} = $resultsbr[$i]->{'isbn'};
+ $row_data{file} = $resultsbr[$i]->{'file'};
+ $row_data{title} = $resultsbr[$i]->{'title'};
+ $row_data{author} = $resultsbr[$i]->{'author'};
+ push ( @breeding_loop, \%row_data );
+}
+
+$template->param( frameworkcodeloop => \@frameworkcodeloop,
+ breeding_loop => \@breeding_loop,
+ );
-output_html_with_http_headers $query, $cookie, $template->output;
+output_html_with_http_headers $input, $cookie, $template->output;
use C4::Biblio;
use C4::Context;
use C4::Koha; # XXX subfield_is_koha_internal_p
-use C4::Search;
-use C4::Circulation::Circ2;
-use C4::Log;
-my $logstatus=C4::Context->preference('Activate_log');
+use MARC::File::XML;
sub find_value {
- my ($tagfield,$insubfield,$record) = @_;
- my $result;
- my $indicator;
-my $item=$record->{datafield};
-my $controlfield=$record->{controlfield};
-my $leader=$record->{leader};
- if ($tagfield eq '000'){
-## We are getting the leader
-$result=$leader->[0];
-return($indicator,$result);
+ my ($tagfield,$insubfield,$record) = @_;
+ my $result;
+ my $indicator;
+ foreach my $field ($record->field($tagfield)) {
+ my @subfields = $field->subfields();
+ foreach my $subfield (@subfields) {
+ if (@$subfield[0] eq $insubfield) {
+ $result .= @$subfield[1];
+ $indicator = $field->indicator(1).$field->indicator(2);
+ }
+ }
+ }
+ return($indicator,$result);
}
- if ($tagfield <10){
- foreach my $control (@$controlfield) {
- if ($control->{tag} eq $tagfield){
- $result.=$control->{content};
- }
- }
- }else{
- foreach my $field (@$item) {
- if ($field->{tag} eq $tagfield){
- foreach my $subfield ( $field->{'subfield'}){
- foreach my $code ( @$subfield){
- if ($code->{code} eq $insubfield) {
- $result .= $code->{content};
- $indicator = $field->{ind1}.$field->{ind2};
- }
- }## each code
- }##each subfield
- }## if tag
- }### $field
- }## tag<10
- return($indicator,$result);
+
+sub get_item_from_barcode {
+ my ($barcode)=@_;
+ my $dbh=C4::Context->dbh;
+ my $result;
+ my $rq=$dbh->prepare("SELECT itemnumber from items where items.barcode=?");
+ $rq->execute($barcode);
+ ($result)=$rq->fetchrow;
+ return($result);
}
+
my $input = new CGI;
my $dbh = C4::Context->dbh;
my $error = $input->param('error');
my $biblionumber = $input->param('biblionumber');
-my $oldbiblionumber =$biblionumber;
-my $frameworkcode=$input->param('frameworkcode');
-my $op = $input->param('op');
my $itemnumber = $input->param('itemnumber');
-my $fromserials=$input->param('fromserials');## if a serial is being added do not display navigation menus
-my $serialid=$input->param('serialid');
-my @itemrecords; ##Builds existing items
-my $bibliorecord; #Bibliorecord relared to this item
-my $newrecord; ## the new record buing built
-my $itemrecexist; #item record we are editing
-my $xml; ## data on html
- $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber) unless $frameworkcode;
-my $tagslib = &MARCitemsgettagslib($dbh,1,$frameworkcode);
-my $itemrecord;
-my $nextop="additem";
-my @errors; # store errors found while checking data BEFORE saving item.
+my $op = $input->param('op');
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "cataloguing/additem.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
- debug => 1,
- });
+# find itemtype
+my $frameworkcode = &MARCfind_frameworkcode($biblionumber);
-#------------------------------------------------------------------------------------------------------------------------------
+my $tagslib = &MARCgettagslib($dbh,1,$frameworkcode);
+my $record = GetMarcBiblio($biblionumber);
+# warn "==>".$record->as_formatted;
+my $oldrecord = MARCmarc2koha($dbh,$record);
+my $itemrecord;
+my $nextop="additem";
+my @errors; # store errors found while checking data BEFORE saving item.
+#-------------------------------------------------------------------------------
if ($op eq "additem") {
-#------------------------------------------------------------------------------------------------------------------------------
- # rebuild
-
- my @tags = $input->param('tag');
- my @subfields = $input->param('subfield');
- my @values = $input->param('field_value');
- # build indicator hash.
- my @ind_tag = $input->param('ind_tag');
- my @indicator = $input->param('indicator');
- my %indicators;
- for (my $i=0;$i<=$#ind_tag;$i++) {
- $indicators{$ind_tag[$i]} = $indicator[$i];
- }
-## check for malformed xml -- non UTF-8 like (MARC8) will break xml without warning
-### This usually happens with data coming from other Z3950 servers
-## Slows the saving process so comment out at your own risk
-eval{
- $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
-};
- if ($@){
-push @errors,"non_utf8" ;
-$nextop = "additem";
-goto FINAL;
- };
- my $newrecord=XML_xml2hash_onerecord($xml);
-my $newbarcode=XML_readline_onerecord($newrecord,"barcode","holdings");
-
- # if autoBarcode is ON, calculate barcode...
- if (C4::Context->preference('autoBarcode')) {
- unless ($newbarcode) {
- my $sth_barcode = $dbh->prepare("select max(abs(barcode)) from items");
- $sth_barcode->execute;
- ($newbarcode) = $sth_barcode->fetchrow;
- $newbarcode++;
- # OK, we have the new barcode, now create the entry in MARC record
- $newrecord=XML_writeline( $newrecord, "barcode", $newbarcode,"holdings" );
- }
- }
+#-------------------------------------------------------------------------------
+ # rebuild
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ my $record=MARC::Record::new_from_xml($xml, 'UTF-8');
+ # if autoBarcode is ON, calculate barcode...
+ if (C4::Context->preference('autoBarcode')) {
+ my ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.barcode");
+ unless ($record->field($tagfield)->subfield($tagsubfield)) {
+ my $sth_barcode = $dbh->prepare("select max(abs(barcode)) from items");
+ $sth_barcode->execute;
+ my ($newbarcode) = $sth_barcode->fetchrow;
+ $newbarcode++;
+ # OK, we have the new barcode, now create the entry in MARC record
+ my $fieldItem = $record->field($tagfield);
+ $record->delete_field($fieldItem);
+ $fieldItem->add_subfields($tagsubfield => $newbarcode);
+ $record->insert_fields_ordered($fieldItem);
+ }
+ }
# check for item barcode # being unique
- my ($oldrecord)=XMLgetitem($dbh,"",$newbarcode);
-
- push @errors,"barcode_not_unique" if($oldrecord);
-# MARC::Record builded => now, record in DB
-## User may be keeping serialids in marc records -- check and add it
-if ($fromserials){
-$newrecord=XML_writeline( $newrecord, "serialid", $serialid,"holdings" );
-}
- # if barcode exists, don't create, but report the problem.
- unless ($oldrecord){
- $itemnumber=NEWnewitem($dbh,$newrecord,$biblionumber) ;
- if ($fromserials){
- my $holdingbranch=XML_readline_onerecord($newrecord,"holdingbranch","holdings");
- $template->param(exit=>1,holdingbranch=>$holdingbranch);
- }
- $nextop = "additem";
- }
- else{
- $nextop = "additem";
- $itemrecexist = $newrecord;
- }
-#------------------------------------------------------------------------------------------------------------------------------
+ my $addedolditem = MARCmarc2koha($dbh,$record);
+ my $exists = get_item_from_barcode($addedolditem->{'barcode'});
+ push @errors,"barcode_not_unique" if($exists);
+ # if barcode exists, don't create, but report The problem.
+ my ($oldbiblionumber,$oldbibnum,$oldbibitemnum) = AddItem($record,$biblionumber) unless ($exists);
+ if ($exists) {
+ $nextop = "additem";
+ $itemrecord = $record;
+ } else {
+ $nextop = "additem";
+ }
+#-------------------------------------------------------------------------------
} elsif ($op eq "edititem") {
-#------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------
# retrieve item if exist => then, it's a modif
- ($itemrecexist) = XMLgetitemhash($dbh,$itemnumber);## item is already in our array-getit
- $nextop="saveitem";
-
-#logaction($loggedinuser,"acqui.simple","modify",$oldbiblionumber,"item : ".$itemnumber) if ($logstatus);
-
-#------------------------------------------------------------------------------------------------------------------------------
+ $itemrecord = MARCgetitem($biblionumber,$itemnumber);
+ $nextop="saveitem";
+#-------------------------------------------------------------------------------
} elsif ($op eq "delitem") {
-#------------------------------------------------------------------------------------------------------------------------------
-# retrieve item if exist => then, it's a modif
-my $sth=$dbh->prepare("select * from issues i where i.returndate is null and i.itemnumber=?");
- $sth->execute($itemnumber);
-my $onloan=$sth->fetchrow;
-push @errors,"book_on_loan" if ($onloan);
- if ($onloan){
- $nextop = "additem";
-}else{
- &NEWdelitem($dbh,$itemnumber);
- $nextop="additem";
-}
-#------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------
+ # check that there is no issue on this item before deletion.
+ my $sth=$dbh->prepare("select * from issues i where i.returndate is null and i.itemnumber=?");
+ $sth->execute($itemnumber);
+ my $onloan=$sth->fetchrow;
+ push @errors,"book_on_loan" if ($onloan); ##error book_on_loan added to template as well
+ if ($onloan){
+ $nextop="additem";
+ } else {
+ &DelItem($biblionumber,$itemnumber);
+ print $input->redirect("additem.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode");
+ #$nextop="additem";
+ }
+#-------------------------------------------------------------------------------
} elsif ($op eq "saveitem") {
-#------------------------------------------------------------------------------------------------------------------------------
- # rebuild
-#warn "save item";
- my @tags = $input->param('tag');
- my @subfields = $input->param('subfield');
- my @values = $input->param('field_value');
- # build indicator hash.
- my @ind_tag = $input->param('ind_tag');
- my @indicator = $input->param('indicator');
- my $itemnumber = $input->param('itemnumber');
- my %indicators;
- for (my $i=0;$i<=$#ind_tag;$i++) {
- $indicators{$ind_tag[$i]} = $indicator[$i];
- }
-## check for malformed xml -- non UTF-8 like (MARC8) will break xml without warning
-### This usually happens with data coming from other Z3950 servers
-## Slows the saving process so comment out at your own risk
-eval{
- $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
-};
- if ($@){
-push @errors,"non_utf8" ;
-$nextop = "edititem";
-goto FINAL;
- };
- my $newrecord=XML_xml2hash_onerecord($xml);
- my $newbarcode=XML_readline_onerecord($newrecord,"barcode","holdings");
- my ($oldrecord)=XMLgetitem($dbh,"",$newbarcode);
- $oldrecord=XML_xml2hash_onerecord($oldrecord);
- my $exist=XML_readline_onerecord($oldrecord,"itemnumber","holdings") if $oldrecord;
- if ($exist && ($exist ne $itemnumber)){
- push @errors,"barcode_not_unique" ; ## Although editing user may have changed the barcode
- $nextop="edititem";
- }else{
- NEWmoditem($dbh,$newrecord,$biblionumber,$itemnumber);
- $itemnumber="";
- $nextop="additem";
-
- }
+#-------------------------------------------------------------------------------
+ # rebuild
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+# my $itemnumber = $input->param('itemnumber');
+ my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
+ my $itemrecord=MARC::Record::new_from_xml($xml, 'UTF-8');
+# MARC::Record builded => now, record in DB
+# warn "R: ".$record->as_formatted;
+ my ($oldbiblionumber,$oldbibnum,$oldbibitemnum) = ModItem($itemrecord,$biblionumber,$itemnumber,0);
+ $itemnumber="";
+ $nextop="additem";
}
#
-#------------------------------------------------------------------------------------------------------------------------------
+#-------------------------------------------------------------------------------
# build screen with existing items. and "new" one
-#------------------------------------------------------------------------------------------------------------------------------
-FINAL:
+#-------------------------------------------------------------------------------
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "cataloguing/additem.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {editcatalogue => 1},
+ debug => 1,
+ });
+
my %indicators;
$indicators{995}=' ';
-# now, build existing item list
-###DO NOT CHANGE TO RETRIVE FROM ZEBRA#####
-my $record =XMLgetbiblio($dbh,$biblionumber);
-$bibliorecord=XML_xml2hash_onerecord($record);
-my @itemxmls=XMLgetallitems($dbh,$biblionumber);
- foreach my $itemrecord(@itemxmls){
- my $itemhash=XML_xml2hash($itemrecord);
- push @itemrecords, $itemhash;
- }
-####
-
-
-
-my ($itemtagfield,$itemtagsubfield) = &MARCfind_marc_from_kohafield("itemnumber","holdings");
-my @itemnums;
-my @fields;
+# now, build existiing item list
+my $temp = GetMarcBiblio( $biblionumber );
+my @fields = $temp->fields();
+#my @fields = $record->fields();
my %witness; #---- stores the list of subfields used at least once, with the "meaning" of the code
my @big_array;
-my @item_value_loop;
-my @header_value_loop;
-unless($fromserials){ ## do not display existing items if adding a serial. It could be a looong list
-foreach my $itemrecord (@itemrecords){
+#---- finds where items.itemnumber is stored
+my ($itemtagfield,$itemtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.itemnumber",$frameworkcode);
+my ($branchtagfield,$branchtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"items.homebranch",$frameworkcode);
-my $item=$itemrecord->{datafield};
-my $controlfield=$itemrecord->{controlfield};
-my $leader=$itemrecord->{leader};
-my %this_row;
- ### The leader
- unless ($tagslib->{'000'}->{'@'}->{tab} ne 10 || substr($tagslib->{'000'}->{'@'}->{hidden},1,1)>0){
- my @datasub='000@';
- $witness{$datasub[0]} = $tagslib->{'000'}->{'@'}->{lib};
- $this_row{$datasub[0]} =$leader->[0];
- }## leader
- foreach my $control (@$controlfield){
- push @itemnums,$control->{content} if ($control->{tag} eq $itemtagfield);
- next if ($tagslib->{$control->{tag}}->{'@'}->{tab} ne 10);
- next if (substr($tagslib->{$control->{tag}}->{'@'}->{hidden},1,1)>0);
-
- my @datasub=$control->{tag}.'@';
- $witness{$datasub[0]} = $tagslib->{$control->{tag}}->{'@'}->{lib};
- $this_row{$datasub[0]} =$control->{content};
- }## Controlfields
- foreach my $data (@$item){
- foreach my $subfield ( $data->{'subfield'}){
- foreach my $code ( @$subfield){
- # loop through each subfield
- push @itemnums,$code->{content} if ($data->{tag} eq $itemtagfield && $code->{code} eq $itemtagsubfield);
- next if ($tagslib->{$data->{tag}}->{$code->{code}}->{tab} ne 10);
- next if (substr($tagslib->{$data->{tag}}->{$code->{code}}->{hidden},1,1)>0);
- $witness{$data->{tag}.$code->{code}} = $tagslib->{$data->{tag}}->{$code->{code}}->{lib};
- $this_row{$data->{tag}.$code->{code}} =$code->{content};
- }
-
- }# subfield
-
- }## each data
- if (%this_row) {
- push(@big_array, \%this_row);
- }
-}## each record
+foreach my $field (@fields) {
+ next if ($field->tag()<10);
+ my @subf=$field->subfields;
+ my %this_row;
+# loop through each subfield
+ for my $i (0..$#subf) {
+ next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} ne 10 && ($field->tag() ne $itemtagfield && $subf[$i][0] ne $itemtagsubfield));
+ $witness{$subf[$i][0]} = $tagslib->{$field->tag()}->{$subf[$i][0]}->{lib} if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} eq 10);
+ $this_row{$subf[$i][0]} =$subf[$i][1] if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} eq 10);
+ if (($field->tag eq $branchtagfield) && ($subf[$i][$0] eq $branchtagsubfield) && C4::Context->preference("IndependantBranches")) {
+ #verifying rights
+ my $userenv = C4::Context->userenv;
+ unless (($userenv->{'flags'} == 1) or (($userenv->{'branch'} eq $subf[$i][1]))){
+ $this_row{'nomod'}=1;
+ }
+ }
+ $this_row{itemnumber} = $subf[$i][1] if ($field->tag() eq $itemtagfield && $subf[$i][0] eq $itemtagsubfield);
+ }
+ if (%this_row) {
+ push(@big_array, \%this_row);
+ }
+}
#fill big_row with missing datas
foreach my $subfield_code (keys(%witness)) {
- for (my $i=0;$i<=$#big_array;$i++) {
- $big_array[$i]{$subfield_code}=" " unless ($big_array[$i]{$subfield_code});
- }
+ for (my $i=0;$i<=$#big_array;$i++) {
+ $big_array[$i]{$subfield_code}=" " unless ($big_array[$i]{$subfield_code});
+ }
}
-# now, construct template !
+my ($holdingbrtagf,$holdingbrtagsubf) = &MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$frameworkcode);
+@big_array = sort {$a->{$holdingbrtagsubf} cmp $b->{$holdingbrtagsubf}} @big_array;
+# now, construct template !
+my @item_value_loop;
+my @header_value_loop;
for (my $i=0;$i<=$#big_array; $i++) {
- my $items_data;
- foreach my $subfield_code (sort keys(%witness)) {
- $items_data .="<td>".$big_array[$i]{$subfield_code}."</td>";
- }
- my %row_data;
- $row_data{item_value} = $items_data;
- $row_data{itemnumber} = $itemnums[$i];
- push(@item_value_loop,\%row_data);
+ my $items_data;
+ foreach my $subfield_code (sort keys(%witness)) {
+ $items_data .="<td>".$big_array[$i]{$subfield_code}."</td>";
+ }
+ my %row_data;
+ $items_data =~ s/"/"/g;
+ $row_data{item_value} = $items_data;
+ $row_data{itemnumber} = $big_array[$i]->{itemnumber};
+ #reporting this_row values
+ $row_data{'nomod'} = $big_array[$i]{'nomod'};
+ push(@item_value_loop,\%row_data);
}
foreach my $subfield_code (sort keys(%witness)) {
- my %header_value;
- $header_value{header_value} = $witness{$subfield_code};
- push(@header_value_loop, \%header_value);
+ my %header_value;
+ $header_value{header_value} = $witness{$subfield_code};
+ push(@header_value_loop, \%header_value);
}
-}## unless from serials
+
# next item form
my @loop_data =();
my $i=0;
my $authorised_values_sth = $dbh->prepare("select authorised_value,lib from authorised_values where category=? order by lib");
foreach my $tag (sort keys %{$tagslib}) {
- if ($itemtagfield <10){
-next if($tag==$itemtagfield);
-}
- my $previous_tag = '';
+ my $previous_tag = '';
# loop through each subfield
- foreach my $subfield (sort keys %{$tagslib->{$tag}}) {
- next if subfield_is_koha_internal_p($subfield);
- next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "10");
- next if ($tagslib->{$tag} eq $itemtagfield && $tagslib->{$tag}->{$subfield} eq $itemtagsubfield);
- my %subfield_data;
- $subfield_data{tag}=$tag;
- $subfield_data{subfield}=$subfield;
- $subfield_data{marc_lib}="<span id=\"error$i\">".$tagslib->{$tag}->{$subfield}->{lib}."</span>";
- $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
- $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
- $subfield_data{hidden}= "display:none" if (substr($tagslib->{$tag}->{$subfield}->{hidden},2,1)>0);
-
- my ($x,$value);
- ($x,$value) = find_value($tag,$subfield,$itemrecexist) if ($itemrecexist);
- # search for itemcallnumber if applicable
- my ($itemcntag,$itemcntagsub)=MARCfind_marc_from_kohafield("itemcallnumber","holdings");
- if ($tag eq $itemcntag && $subfield eq $itemcntagsub && C4::Context->preference('itemcallnumber')) {
- my $CNtag = substr(C4::Context->preference('itemcallnumber'),0,3);
- my $CNsubfield = substr(C4::Context->preference('itemcallnumber'),3,1);
+ foreach my $subfield (sort keys %{$tagslib->{$tag}}) {
+ next if subfield_is_koha_internal_p($subfield);
+ next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "10");
+ my %subfield_data;
+ $subfield_data{tag}=$tag;
+ $subfield_data{subfield}=$subfield;
+# $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
+ $subfield_data{marc_lib}="<span id=\"error$i\" title=\"".$tagslib->{$tag}->{$subfield}->{lib}."\">".substr($tagslib->{$tag}->{$subfield}->{lib},0,12)."</span>";
+ $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
+ $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{hidden}= "display:none" if $tagslib->{$tag}->{$subfield}->{hidden};
+ my ($x,$value);
+ ($x,$value) = find_value($tag,$subfield,$itemrecord) if ($itemrecord);
+ $value =~ s/"/"/g;
+ #testing branch value if IndependantBranches.
+ my $test = (C4::Context->preference("IndependantBranches")) &&
+ ($tag eq $branchtagfield) && ($subfield eq $branchtagsubfield) &&
+ (C4::Context->userenv->{flags} != 1) && ($value) && ($value ne C4::Context->userenv->{branch}) ;
+# print $input->redirect(".pl?biblionumber=$biblionumber") if ($test);
+ # search for itemcallnumber if applicable
+ if (!$value && $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber' && C4::Context->preference('itemcallnumber')) {
+ my $CNtag = substr(C4::Context->preference('itemcallnumber'),0,3);
+ my $CNsubfield = substr(C4::Context->preference('itemcallnumber'),3,1);
my $CNsubfield2 = substr(C4::Context->preference('itemcallnumber'),4,1);
- my $temp1 = XML_readline_onerecord($bibliorecord,"","",$CNtag,$CNsubfield);
- my $temp2 = XML_readline_onerecord($bibliorecord,"","",$CNtag,$CNsubfield2);
- $value = $temp1.' '.$temp2;
+ my $temp2 = $temp->field($CNtag);
+ if ($temp2) {
+ $value = ($temp2->subfield($CNsubfield)).' '.($temp2->subfield($CNsubfield2));
+#remove any trailing space incase one subfield is used
$value=~s/^\s+|\s+$//g;
-
- }
- if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
- my @authorised_values;
- my %authorised_lib;
- # builds list, depending on authorised value...
- #---- branch
- if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- my $sth=$dbh->prepare("select branchcode,branchname from branches order by branchname");
- $sth->execute;
- push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
- while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
- push @authorised_values, $branchcode;
- $authorised_lib{$branchcode}=$branchname;
- }
- #----- itemtypes
- } elsif ($tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes") {
- my $sth=$dbh->prepare("select itemtype,description from itemtypes order by description");
- $sth->execute;
- push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
- while (my ($itemtype,$description) = $sth->fetchrow_array) {
- push @authorised_values, $itemtype;
- $authorised_lib{$itemtype}=$description;
- }
- #---- "true" authorised value
- } else {
- $authorised_values_sth->execute($tagslib->{$tag}->{$subfield}->{authorised_value});
- push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
- while (my ($value,$lib) = $authorised_values_sth->fetchrow_array) {
- push @authorised_values, $value;
- $authorised_lib{$value}=$lib;
- }
- }
- $subfield_data{marc_value}= CGI::scrolling_list(-name=>'field_value',
- -values=> \@authorised_values,
- -default=>"$value", -labels => \%authorised_lib, -size=>1,
- -multiple=>0, );
- } elsif ($tagslib->{$tag}->{$subfield}->{thesaurus_category}) {
- $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" size=47 maxlength=255 DISABLE READONLY> <a href=\"javascript:Dopop('../authorities/auth_finder.pl?authtypecode=".$tagslib->{$tag}->{$subfield}->{authtypecode}."&index=$i',$i)\">...</a>";
- #"
- } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
- my $cgidir = C4::Context->intranetdir ."/cgi-bin/value_builder";
- unless (opendir(DIR, "$cgidir")) {
- $cgidir = C4::Context->intranetdir."/value_builder";
- }
- my $plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
- require $plugin;
- my $extended_param = plugin_parameters($dbh,$newrecord,$tagslib,$i,0);
- my ($function_name,$javascript) = plugin_javascript($dbh,$newrecord,$tagslib,$i,0);
- $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"47\" maxlength=\"255\" DISABLE READONLY OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i)\"> <a href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
- } else {
- $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
- }
-# $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\">";
- push(@loop_data, \%subfield_data);
- $i++
- }
+ }
+ }
+ if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
+ my @authorised_values;
+ my %authorised_lib;
+ # builds list, depending on authorised value...
+ #---- branch
+ if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
+ if ((C4::Context->preference("IndependantBranches")) && (C4::Context->userenv->{flags} != 1)){
+ my $sth=$dbh->prepare("select branchcode,branchname from branches where branchcode = ? order by branchname");
+ $sth->execute(C4::Context->userenv->{branch});
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+ while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode}=$branchname;
+ }
+ } else {
+ my $sth=$dbh->prepare("select branchcode,branchname from branches order by branchname");
+ $sth->execute;
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+ while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode}=$branchname;
+ }
+ }
+ #----- itemtypes
+ } elsif ($tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes") {
+ my $sth=$dbh->prepare("select itemtype,description from itemtypes order by description");
+ $sth->execute;
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+ while (my ($itemtype,$description) = $sth->fetchrow_array) {
+ push @authorised_values, $itemtype;
+ $authorised_lib{$itemtype}=$description;
+ }
+ #---- "true" authorised value
+ } else {
+ $authorised_values_sth->execute($tagslib->{$tag}->{$subfield}->{authorised_value});
+ push @authorised_values, "" unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+ while (my ($value,$lib) = $authorised_values_sth->fetchrow_array) {
+ push @authorised_values, $value;
+ $authorised_lib{$value}=$lib;
+ }
+ }
+ $subfield_data{marc_value}= CGI::scrolling_list(-name=>'field_value',
+ -values=> \@authorised_values,
+ -default=>"$value",
+ -labels => \%authorised_lib,
+ -size=>1,
+ -tabindex=>'',
+ -multiple=>0,
+ );
+ } elsif ($tagslib->{$tag}->{$subfield}->{thesaurus_category}) {
+ $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=$i',$i)\">...</a>";
+ #"
+ } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
+ my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
+ require $plugin;
+ my $extended_param = plugin_parameters($dbh,$record,$tagslib,$i,0);
+ my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
+ $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\" size=47 maxlength=255 OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i)\"> <a href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
+ } else {
+ $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
+ }
+# $subfield_data{marc_value}="<input type=\"text\" name=\"field_value\">";
+ push(@loop_data, \%subfield_data);
+ $i++
+ }
}
-
# what's the next op ? it's what we are not in : an add if we're editing, otherwise, and edit.
+$template->param( title => $record->title() ) if ($record ne "-1");
$template->param(item_loop => \@item_value_loop,
- item_header_loop => \@header_value_loop,
- biblionumber =>$biblionumber,
- title => &XML_readline_onerecord($bibliorecord,"title","biblios"),
- author => &XML_readline_onerecord($bibliorecord,"author","biblios"),
- item => \@loop_data,
- itemnumber => $itemnumber,
- itemtagfield => $itemtagfield,
- itemtagsubfield =>$itemtagsubfield,
- op => $nextop,
- opisadd => ($nextop eq "saveitem")?0:1,
- fromserials=>$fromserials, serialid=>$serialid,);
+ item_header_loop => \@header_value_loop,
+ biblionumber => $biblionumber,
+ title => $oldrecord->{title},
+ author => $oldrecord->{author},
+ item => \@loop_data,
+ itemnumber => $itemnumber,
+ itemtagfield => $itemtagfield,
+ itemtagsubfield =>$itemtagsubfield,
+ op => $nextop,
+ opisadd => ($nextop eq "saveitem")?0:1);
foreach my $error (@errors) {
- $template->param($error => 1);
-
+ $template->param($error => 1);
}
output_html_with_http_headers $input, $cookie, $template->output;
-
-sub XMLfinditem {
-my ($itemnumber,@itemrecords)=@_;
-foreach my $record (@itemrecords){
-my $inumber=XML_readline_onerecord($record,"itemnumber","holdings");
- if ($inumber ==$itemnumber){
- return $record;
- }
-}
-}
use strict;
use C4::Context;
+use C4::Output;
use CGI;
+use C4::Branch; # GetBranchName
use C4::Auth;
use C4::Date;
use C4::Circulation::Circ2;
+
+use Date::Calc qw(
+ Today
+ Add_Delta_YM
+ Date_to_Days
+);
use C4::Reserves2;
-use C4::Search;
use C4::Koha;
+use C4::Interface::CGI::Output;
my $input = new CGI;
-my $item=$input->param('itemnumber');
-my $borrowernumber=$input->param('borrowernumber');
-my $fbr=$input->param('fbr');
-my $tbr=$input->param('tbr');
+my $item = $input->param('itemnumber');
+my $borrowernumber = $input->param('borrowernumber');
+my $fbr = $input->param('fbr');
+my $tbr = $input->param('tbr');
my $cancel;
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
-my $theme = $input->param('theme'); # only used if allowthemeoverride is set
-
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "circ/branchreserves.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- debug => 1,
- });
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/branchreserves.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
my $default = C4::Context->userenv->{'branch'};
-my $dbh=C4::Context->dbh;
-my $todaysdate = get_today();
+my @datearr = localtime( time() );
+my $todaysdate =
+ ( 1900 + $datearr[5] ) . '-'
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-'
+ . sprintf( "%0.2d", $datearr[3] );
# if we have a return from the form we launch the subroutine CancelReserve
- if ($item){
- my $messages;
- my $nextreservinfo;
- my %env;
- my $waiting;
- ($messages,$nextreservinfo) = GlobalCancel($item,$borrowernumber);
-# if we have a result
- if ($nextreservinfo){
- my $borrowerinfo = getpatroninformation(\%env,$nextreservinfo);
- my $iteminfo = C4::Circulation::Circ2::getiteminformation(\%env,$item);
- if ($messages->{'transfert'}){
- my $branchname = getbranchname($messages->{'transfert'});
- $template->param(
- messagetransfert => $messages->{'transfert'},
- branchname => $branchname,
- );
- }
- if ($messages->{'waiting'}){
- $waiting = 1;
- }
-
- $template->param(
- message => 1,
- nextreservnumber => $nextreservinfo,
- nextreservsurname => $borrowerinfo->{'surname'},
- nextreservfirstname => $borrowerinfo->{'firstname'},
- nextreservitem => $item,
- nextreservtitle => $iteminfo->{'title'},
- waiting => $waiting
- );
- }
+if ($item) {
+ my $messages;
+ my $nextreservinfo;
+ my %env;
+ my $waiting;
+ ( $messages, $nextreservinfo ) = GlobalCancel( $item, $borrowernumber );
+
+ # if we have a result
+ if ($nextreservinfo) {
+ my $borrowerinfo = getpatroninformation( \%env, $nextreservinfo );
+ my $iteminfo = C4::Circulation::Circ2::getiteminformation($item);
+ if ( $messages->{'transfert'} ) {
+ my $branchname = GetBranchName( $messages->{'transfert'} );
+ $template->param(
+ messagetransfert => $messages->{'transfert'},
+ branchname => $branchname,
+ );
+ }
+ if ( $messages->{'waiting'} ) {
+ $waiting = 1;
+ }
+
+ $template->param(
+ message => 1,
+ nextreservnumber => $nextreservinfo,
+ nextreservsurname => $borrowerinfo->{'surname'},
+ nextreservfirstname => $borrowerinfo->{'firstname'},
+ nextreservitem => $item,
+ nextreservtitle => $iteminfo->{'title'},
+ waiting => $waiting
+ );
+ }
+
# if the document is not in his homebranch location and there is not reservation after, we transfer it
- if (($fbr ne $tbr) and (not $nextreservinfo)){
- C4::Circulation::Circ2::dotransfer($item,$fbr,$tbr);
- C4::Circulation::Circ2::itemseen($dbh,$itm);
- }
- }
-
+ if ( ( $fbr ne $tbr ) and ( not $nextreservinfo ) ) {
+ C4::Circulation::Circ2::dotransfer( $item, $fbr, $tbr );
+ }
+}
+
my @reservloop;
+
my @getreserves = GetReservesForBranch($default);
+
foreach my $num (@getreserves) {
- my %getreserv;
- my %env;
- my $gettitle = getiteminformation(\%env,$num->{'itemnumber'});
- my $getborrower = getpatroninformation (\%env,$num->{'borrowernumber'});
- my $itemtypeinfo = getitemtypeinfo($gettitle->{'itemtype'});
- $getreserv{'waitingdate'} = format_date($num->{'waitingdate'});
- my $calcDate=DateCalc($num->{'waitingdate'},"+".C4::Context->preference('ReservesMaxPickUpDelay')." days");
- my $warning=Date_Cmp(ParseDate("today"),$calcDate);
- if ($warning>0){
- $getreserv{'messcompa'} = 1;
- }
- $getreserv{'title'} = $gettitle->{'title'};
- $getreserv{'itemnumber'} = $gettitle->{'itemnumber'};
- $getreserv{'biblionumber'} = $gettitle->{'biblionumber'};
- $getreserv{'barcode'} = $gettitle->{'barcode'};
- $getreserv{'itemtype'} = $itemtypeinfo->{'description'};
- $getreserv{'homebranch'} = $gettitle->{'homebranch'};
- $getreserv{'holdingbranch'} = $gettitle->{'holdingbranch'};
- if ($gettitle->{'homebranch'} ne $gettitle->{'holdingbranch'}){
- $getreserv{'dotransfer'} = 1;
- }
- $getreserv{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
- $getreserv{'borrowernum'} = $getborrower->{'borrowernumber'};
- $getreserv{'borrowername'} = $getborrower->{'surname'};
- $getreserv{'borrowerfirstname'} = $getborrower->{'firstname'} ;
- if ($getborrower->{'emailaddress'}){
- $getreserv{'borrowermail'} = $getborrower->{'emailaddress'} ;
- }
- $getreserv{'borrowerphone'} = $getborrower->{'phone'};
- push(@reservloop, \%getreserv);
+ my %getreserv;
+ my %env;
+ my $gettitle = getiteminformation( $num->{'itemnumber'} );
+ my $getborrower = getpatroninformation( \%env, $num->{'borrowernumber'} );
+ my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
+ $getreserv{'waitingdate'} = format_date( $num->{'waitingdate'} );
+
+ next unless $num->{'waitingdate'} ne '0000-00-00';
+ my ( $waiting_year, $waiting_month, $waiting_day ) = split /-/,
+ $num->{'waitingdate'};
+ ( $waiting_year, $waiting_month, $waiting_day ) =
+ Add_Delta_YM( $waiting_year, $waiting_month, $waiting_day,
+ C4::Context->preference('ReservesMaxPickUpDelay'), 0 );
+ my $calcDate = Date_to_Days( $waiting_year, $waiting_month, $waiting_day );
+ my $today = Date_to_Days(&Today);
+ my $warning = ( $today > $calcDate );
+
+ if ( $warning > 0 ) {
+ $getreserv{'messcompa'} = 1;
+ }
+ $getreserv{'title'} = $gettitle->{'title'};
+ $getreserv{'itemnumber'} = $gettitle->{'itemnumber'};
+ $getreserv{'biblionumber'} = $gettitle->{'biblionumber'};
+ $getreserv{'barcode'} = $gettitle->{'barcode'};
+ $getreserv{'itemtype'} = $itemtypeinfo->{'description'};
+ $getreserv{'homebranch'} = $gettitle->{'homebranch'};
+ $getreserv{'holdingbranch'} = $gettitle->{'holdingbranch'};
+ if ( $gettitle->{'homebranch'} ne $gettitle->{'holdingbranch'} ) {
+ $getreserv{'dotransfer'} = 1;
+ }
+ $getreserv{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
+ $getreserv{'borrowernum'} = $getborrower->{'borrowernumber'};
+ $getreserv{'borrowername'} = $getborrower->{'surname'};
+ $getreserv{'borrowerfirstname'} = $getborrower->{'firstname'};
+ if ( $getborrower->{'emailaddress'} ) {
+ $getreserv{'borrowermail'} = $getborrower->{'emailaddress'};
+ }
+ $getreserv{'borrowerphone'} = $getborrower->{'phone'};
+ push( @reservloop, \%getreserv );
}
- $template->param( reserveloop => \@reservloop,
- show_date => format_date($todaysdate),
- );
-
-output_html_with_http_headers $input, $cookie, $template->output;
\ No newline at end of file
+$template->param(
+ reserveloop => \@reservloop,
+ show_date => format_date($todaysdate),
+);
+
+output_html_with_http_headers $input, $cookie, $template->output;
#written 11/3/2002 by Finlay
#script to execute branch transfers of books
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
use strict;
use CGI;
use C4::Circulation::Circ2;
+use C4::Output;
use C4::Reserves2;
use C4::Auth;
use C4::Interface::CGI::Output;
+use C4::Branch; # GetBranches
use C4::Koha;
-use C4::Members;
+
###############################################
# constants
my %env;
-my $linecolor1='#ffffcc';
-my $linecolor2='white';
-
-my $branches = GetBranches();
-my $printers = getprinters(\%env);
-
+my $branches = GetBranches;
+my $printers = GetPrinters( \%env );
###############################################
# Getting state
-my $query=new CGI;
+my $query = new CGI;
+my $branch = GetBranch( $query, $branches );
+my $printer = GetPrinter( $query, $printers );
-my $branch = getbranch($query, $branches);
-my $printer = getprinter($query, $printers);
-
-my $genbrname = $branches->{$branch}->{'branchname'} ;
+my $genbrname = $branches->{$branch}->{'branchname'};
my $genprname = $printers->{$printer}->{'printername'};
my $messages;
my $cancelled;
my $setwaiting;
my $reqbrchname;
-my $user=$query->param('loggedinuser');
-my $request=$query->param('request');
-my $borrnum = $query->param('borrowernumber');
+my $allmessages;
+
+my $request = $query->param('request');
+my $borrowernumber = $query->param('borrowernumber');
+
+my $tobranchcd = $query->param('tobranchcd');
+my $frbranchcd = '';
-my $tobranchcd=$query->param('tobranchcd');
-my $frbranchcd='';
-my $dbh=C4::Context->dbh;
############
# Deal with the requests....
-if ($request eq "KillWaiting") {
+if ( $request eq "KillWaiting" ) {
my $item = $query->param('itemnumber');
- CancelReserve(0, $item, $borrnum);
- $cancelled = 1;
- $reqmessage =1;
+
+ CancelReserve( 0, $item, $borrowernumber );
+ $cancelled = 1;
+ $reqmessage = 1;
+ $allmessages = 1;
}
my $ignoreRs = 0;
-if ($request eq "SetWaiting") {
+if ( $request eq "SetWaiting" ) {
my $item = $query->param('itemnumber');
- $tobranchcd = ReserveWaiting($item, $borrnum);
- $reqbrchname = $branches->{$tobranchcd}->{'branchname'};
- $ignoreRs = 1;
- $setwaiting = 1;
- $reqmessage =1;
+ $tobranchcd = ReserveWaiting( $item, $borrowernumber );
+ $reqbrchname = $branches->{$tobranchcd}->{'branchname'};
+ $ignoreRs = 1;
+ $setwaiting = 1;
+ $reqmessage = 1;
+ $allmessages = 1;
}
-if ($request eq 'KillReserved'){
+if ( $request eq 'KillReserved' ) {
my $biblio = $query->param('biblionumber');
- CancelReserve($biblio, 0, $borrnum);
- $cancelled = 1;
- $reqmessage =1;
+ CancelReserve( $biblio, 0, $borrowernumber );
+ $cancelled = 1;
+ $reqmessage = 1;
+ $allmessages = 1;
}
-
-
# set up the branchselect options....
my @branchoptionloop;
-foreach my $br (keys %$branches) {
+foreach my $br ( keys %$branches ) {
+
#(next) unless $branches->{$br}->{'CU'}; #FIXME disabled to fix bug 202
my %branch;
- $branch{selected}=($br eq $tobranchcd);
- $branch{code}=$br;
- $branch{name}=$branches->{$br}->{'branchname'};
- push (@branchoptionloop, \%branch);
+ $branch{selected} = ( $br eq $tobranchcd );
+ $branch{code} = $br;
+ $branch{name} = $branches->{$br}->{'branchname'};
+ push( @branchoptionloop, \%branch );
}
-
# collect the stack of books already transfered so they can printed...
my @trsfitemloop;
my %transfereditems;
my %frbranchcds;
my %tobranchcds;
-my $color=$linecolor2;
-
+my $transfered;
my $barcode = $query->param('barcode');
if ($barcode) {
- my $transfered;
- my $iteminformation;
- ($transfered, $messages, $iteminformation)
- = transferbook($tobranchcd, $barcode, $ignoreRs,$user);
- $found = $messages->{'ResFound'};
- if ($transfered) {
- my %item;
- my $frbranchcd = $iteminformation->{'holdingbranch'};
- if (not ($found)) {
- ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
- $item{'color'}=$color;
- $item{'biblionumber'}=$iteminformation->{'biblionumber'};
- $item{'title'}=$iteminformation->{'title'};
- $item{'author'}=$iteminformation->{'author'};
- $item{'itemtype'}=$iteminformation->{'itemtype'};
- $item{'frbrname'}=$branches->{$frbranchcd}->{'branchname'};
- $item{'tobrname'}=$branches->{$tobranchcd}->{'branchname'};
- }
- $item{counter}=0;
- $item{barcode}=$barcode;
- $item{frombrcd}=$frbranchcd;
- $item{tobrcd}=$tobranchcd;
+
+ my $iteminformation;
+ ( $transfered, $messages, $iteminformation ) =
+ transferbook( $tobranchcd, $barcode, $ignoreRs );
+ $found = $messages->{'ResFound'};
+ if ($transfered) {
+ my %item;
+ my $frbranchcd = $iteminformation->{'frbranchcd'};
+ if ( not($found) ) {
+ $item{'biblionumber'} = $iteminformation->{'biblionumber'};
+ $item{'title'} = $iteminformation->{'title'};
+ $item{'author'} = $iteminformation->{'author'};
+ $item{'itemtype'} = $iteminformation->{'itemtype'};
+ $item{'ccode'} = $iteminformation->{'ccode'};
+ $item{'frbrname'} = $branches->{$frbranchcd}->{'branchname'};
+ $item{'tobrname'} = $branches->{$tobranchcd}->{'branchname'};
+ }
+ $item{counter} = 0;
+ $item{barcode} = $barcode;
+ $item{frombrcd} = $frbranchcd;
+ $item{tobrcd} = $tobranchcd;
##########
-#Are these lines still useful ???
- $transfereditems{0}=$barcode;
- $frbranchcds{0}=$frbranchcd;
- $tobranchcds{0}=$tobranchcd;
+ #Are these lines still useful ???
+ $transfereditems{0} = $barcode;
+ $frbranchcds{0} = $frbranchcd;
+ $tobranchcds{0} = $tobranchcd;
##########
- push (@trsfitemloop, \%item);
- }
+ push( @trsfitemloop, \%item );
+ }
}
-foreach ($query->param){
- (next) unless (/bc-(\d*)/);
- my $counter=$1;
- my %item;
- my $bc=$query->param("bc-$counter");
- my $frbcd=$query->param("fb-$counter");
- my $tobcd=$query->param("tb-$counter");
- $counter++;
- $item{counter}=$counter;
- $item{barcode}=$bc;
- $item{frombrcd}=$frbcd;
- $item{tobrcd}=$tobcd;
- my ($iteminformation) = getiteminformation(\%env, 0, $bc);
- ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
- $item{'color'}=$color;
- $item{'biblionumber'}=$iteminformation->{'biblionumber'};
- $item{'title'}=$iteminformation->{'title'};
- $item{'author'}=$iteminformation->{'author'};
- $item{'itemtype'}=$iteminformation->{'itemtype'};
- $item{'frbrname'}=$branches->{$frbcd}->{'branchname'};
- $item{'tobrname'}=$branches->{$tobcd}->{'branchname'};
+foreach ( $query->param ) {
+ (next) unless (/bc-(\d*)/);
+ my $counter = $1;
+ my %item;
+ my $bc = $query->param("bc-$counter");
+ my $frbcd = $query->param("fb-$counter");
+ my $tobcd = $query->param("tb-$counter");
+ $counter++;
+ $item{counter} = $counter;
+ $item{barcode} = $bc;
+ $item{frombrcd} = $frbcd;
+ $item{tobrcd} = $tobcd;
+ my ($iteminformation) = getiteminformation( 0, $bc );
+ $item{'biblionumber'} = $iteminformation->{'biblionumber'};
+ $item{'title'} = $iteminformation->{'title'};
+ $item{'author'} = $iteminformation->{'author'};
+ $item{'itemtype'} = $iteminformation->{'itemtype'};
+ $item{'ccode'} = $iteminformation->{'ccode'};
+ $item{'frbrname'} = $branches->{$frbcd}->{'branchname'};
+ $item{'tobrname'} = $branches->{$tobcd}->{'branchname'};
##########
-#Are these lines still useful ???
- $transfereditems{$counter}=$bc;
- $frbranchcds{$counter}=$frbcd;
- $tobranchcds{$counter}=$tobcd;
+ #Are these lines still useful ???
+ $transfereditems{$counter} = $bc;
+ $frbranchcds{$counter} = $frbcd;
+ $tobranchcds{$counter} = $tobcd;
#########
- push (@trsfitemloop, \%item);
+ push( @trsfitemloop, \%item );
}
-
-my $name;
-my $bornum;
+my $title;
+my $surname;
+my $firstname;
+my $borphone;
+my $borstraddress;
+my $borcity;
+my $borzip;
+my $boremail;
my $borcnum;
my $itemnumber;
my $biblionum;
my $branchname;
-
+my $wastransferred;
#####################
if ($found) {
my $res = $messages->{'ResFound'};
- $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- my ($borr) = getpatroninformation(\%env, $res->{'borrowernumber'}, 0);
- $name = name($borr);
- $bornum = $borr->{'borrowernumber'}; #Hopefully, borr->{borrowernumber}=res->{borrowernumber}
- $borcnum = $borr->{'cardnumber'};
- $itemnumber = $res->{'itemnumber'};
-
- if ($res->{'ResFound'} eq "Waiting") {
- $waiting = 1;
- }
- if ($res->{'ResFound'} eq "Reserved") {
- $reserved = 1;
- $biblionum = $res->{'biblionumber'};
- }
+ $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
+ my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
+ $title = $borr->{'title'};
+ $surname = $borr->{'surname'};
+ $firstname = $borr->{'firstname'};
+ $borrowernumber = $borr->{'borrowernumber'};
+ $borphone = $borr->{'phone'};
+ $borstraddress = $borr->{'streetaddress'};
+ $borcity = $borr->{'city'};
+ $borzip = $borr->{'zipcode'};
+ $boremail = $borr->{'emailadress'};
+
+ #Hopefully, borr->{borrowernumber}=res->{borrowernumber}
+ $borcnum = $borr->{'cardnumber'};
+ $itemnumber = $res->{'itemnumber'};
+
+ if ( $res->{'ResFound'} eq "Waiting" ) {
+ $waiting = 1;
+ }
+ if ( $res->{'ResFound'} eq "Reserved" ) {
+ $reserved = 1;
+ $biblionum = $res->{'biblionumber'};
+ }
}
#####################
my @errmsgloop;
-foreach my $code (keys %$messages) {
- my %err;
- $err{errbadcode} = ($code eq 'BadBarcode');
- if ($code eq 'BadBarcode') {
- $err{msg}=$messages->{'BadBarcode'};
- }
-
- $err{errispermanent} = ($code eq 'IsPermanent');
- if ($code eq 'IsPermanent'){
- $err{msg} = $branches->{$messages->{'IsPermanent'}}->{'branchname'};
- # Here, msg contains the branchname
- # Not so satisfied with this... But should work
+foreach my $code ( keys %$messages ) {
+ my %err;
+
+ if ( $code eq 'BadBarcode' ) {
+ $err{msg} = $messages->{'BadBarcode'};
+ $err{errbadcode} = 1;
+ $allmessages = 1;
}
- $err{errdesteqholding} = ($code eq 'DestinationEqualsHolding');
-
- $err{errwasreturned} = ($code eq 'WasReturned');
- if ($code eq 'WasReturned') {
- my ($borrowerinfo) = getpatroninformation(\%env, $messages->{'WasReturned'}, 0);
- $name =name($borrowerinfo);
- $bornum =$borrowerinfo->{'borrowernumber'};
- $borcnum =$borrowerinfo->{'cardnumber'};
+
+ if ( $code eq 'IsPermanent' ) {
+ $err{errispermanent} = 1;
+ $err{msg} = $branches->{ $messages->{'IsPermanent'} }->{'branchname'};
+
+ # Here, msg contains the branchname
+ # Not so satisfied with this... But should work
+ $allmessages = 1;
}
- if ($code eq 'WasTransfered'){
-# Put code here if you want to notify the user that item was transfered...
+ $err{errdesteqholding} = ( $code eq 'DestinationEqualsHolding' );
+
+ if ( $code eq 'WasReturned' ) {
+ $err{errwasreturned} = 1;
+ $allmessages = 1;
+ my ($borrowerinfo) =
+ getpatroninformation( \%env, $messages->{'WasReturned'}, 0 );
+ $title = $borrowerinfo->{'title'};
+ $surname = $borrowerinfo->{'surname'};
+ $firstname = $borrowerinfo->{'firstname'};
+ $borrowernumber = $borrowerinfo->{'borrowernumber'};
+ $borcnum = $borrowerinfo->{'cardnumber'};
}
- push (@errmsgloop, \%err);
-}
+ # if ($code eq 'WasTransfered'){
+ # Put code here if you want to notify the user that item was transfered...
+ # $wastransferred = 1;
+ # }
+ push( @errmsgloop, \%err );
+}
#######################################################################################
# Make the page .....
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "circ/branchtransfers.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
- });
-$template->param( genbrname => $genbrname,
- genprname => $genprname,
- branch => $branch,
- printer => $printer,
- found => $found,
- reserved => $reserved,
- waiting => $waiting,
- name => $name,
- bornum => $bornum,
- borcnum => $borcnum,
- branchname => $branchname,
- itemnumber => $itemnumber,
- barcode => $barcode,
- biblionumber => $biblionum,
- tobranchcd => $tobranchcd,
- reqmessage => $reqmessage,
- cancelled => $cancelled,
- setwaiting => $setwaiting,
- trsfitemloop => \@trsfitemloop,
- branchoptionloop => \@branchoptionloop,
- errmsgloop => \@errmsgloop
- );
-output_html_with_http_headers $query, $cookie, $template->output;
+my ( $template, $cookie );
+( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/branchtransfers.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ }
+);
+if ($allmessages) {
+ $template->param( allmessages => 1 );
+}
+$template->param(
+ genbrname => $genbrname,
+ genprname => $genprname,
+ branch => $branch,
+ printer => $printer,
+ found => $found,
+ reserved => $reserved,
+ waiting => $waiting,
+ title => $title,
+ surname => $surname,
+ firstname => $firstname,
+ borphone => $borphone,
+ borstraddress => $borstraddress,
+ borcity => $borcity,
+ borzip => $borzip,
+ boremail => $boremail,
+ borrowernumber => $borrowernumber,
+ borcnum => $borcnum,
+ branchname => $branchname,
+ itemnumber => $itemnumber,
+ barcode => $barcode,
+ biblionumber => $biblionum,
+ tobranchcd => $tobranchcd,
+ reqmessage => $reqmessage,
+ cancelled => $cancelled,
+ setwaiting => $setwaiting,
+ wastransferred => $wastransferred,
+ trsfitemloop => \@trsfitemloop,
+ branchoptionloop => \@branchoptionloop,
+ errmsgloop => \@errmsgloop,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+output_html_with_http_headers $query, $cookie, $template->output;
sub name {
- my ($borinfo) = @_;
- return $borinfo->{'surname'}." ".$borinfo->{'title'}." ".$borinfo->{'firstname'};
+ my ($borinfo) = @_;
+ return $borinfo->{'surname'} . " "
+ . $borinfo->{'title'} . " "
+ . $borinfo->{'firstname'};
}
# Local Variables:
# Please use 8-character tabs for this file (indents are every 4 characters)
-#written 8/5/2002 by Finlay
-#script to execute issuing of books
-# New functions (renew etc.) added 07-08-2005 Tumer Garip tgarip@neu.edu.tr
+# written 8/5/2002 by Finlay
+# script to execute issuing of books
# Copyright 2000-2002 Katipo Communications
#
use strict;
use CGI;
use C4::Circulation::Circ2;
-use C4::Search;
+use C4::Members;
use C4::Output;
use C4::Print;
-
use C4::Auth;
use C4::Interface::CGI::Output;
-use C4::Koha;
-
-use C4::Date;
-use C4::Context;
-use C4::Members;
+use C4::Branch; # GetBranches
+use C4::Koha; # GetPrinter
+use Date::Calc qw(
+ Today
+ Today_and_Now
+ Add_Delta_YM
+ Add_Delta_Days
+ Date_to_Days
+);
+
+use C4::Biblio;
+use C4::Reserves2;
+use C4::Circulation::Date;
+#
# PARAMETERS READING
#
-my $query=new CGI;
-
-my ($template, $loggedinuser, $cookie) = get_template_and_user
- ({
- template_name => 'circ/circulation.tmpl',
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => { circulate => 1 },
- });
+my $query = new CGI;
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user (
+ {
+ template_name => 'circ/circulation.tmpl',
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ }
+);
my $branches = GetBranches();
-my $printers = getprinters();
-#my $branch = getbranch($query, $branches);
-my $branch=C4::Context->preference("defaultBranch");
-my $printer = getprinter($query, $printers);
+
+my $printers = GetPrinters();
+my $printer = GetPrinter($query, $printers);
my $findborrower = $query->param('findborrower');
$findborrower =~ s|,| |g;
$findborrower =~ s|'| |g;
-my $borrowernumber = $query->param('borrnumber');
-
-my $print=$query->param('print');
-my $barcode = $query->param('barcode');
-my $year=$query->param('year');
-my $month=$query->param('month');
-my $day=$query->param('day');
-my $stickyduedate=$query->param('stickyduedate');
+my $borrowernumber = $query->param('borrowernumber');
+
+# new op dev the branch and the printer are now defined by the userenv
+my $branch = C4::Context->userenv->{'branch'};
+my $printer = C4::Context->userenv->{'branchprinter'};
+
+# If Autolocated is not activated, we show the Circulation Parameters to chage settings of librarian
+ if (C4::Context->preference("AutoLocation") ne 1)
+ {
+ $template->param(
+ ManualLocation => 1,
+ );
+ }
+
+my $barcode = $query->param('barcode') || '';
+my $year = $query->param('year');
+my $month = $query->param('month');
+my $day = $query->param('day');
+my $stickyduedate = $query->param('stickyduedate');
my $issueconfirmed = $query->param('issueconfirmed');
-my $cancelreserve = $query->param('cancelreserve');
-my %error;
-my $errorflag=$query->param('error');
-## The following er
-if ( $errorflag gt "1"){
-%error=(TOO_EARLY=>{1},) if ($errorflag eq "2");
-%error=(NO_MORE_RENEWALS=>{1},) if ($errorflag eq "3");
-%error=(RESERVE_FOUND=>{1},) if ($errorflag eq "4");
-}elsif ( $errorflag eq "1"){
-%error=(SUCCESFULL_RENEW=>{1},)
-}
+my $cancelreserve = $query->param('cancelreserve');
+my $organisation = $query->param('organisations');
+my $print = $query->param('print');
+
#set up cookie.....
-my $branchcookie;
-my $printercookie;
-#if ($query->param('setcookies')) {
-# $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y');
-# $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y');
-#}
+# my $branchcookie;
+# my $printercookie;
+# if ($query->param('setcookies')) {
+# $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y');
+# $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y');
+# }
-my %env; # FIXME env is used as an "environment" variable. Could be dropped probably...
+my %env
+ ; # FIXME env is used as an "environment" variable. Could be dropped probably...
-$env{'branchcode'}=$branch;
-$env{'printer'}=$printer;
-$env{'queue'}=$printer;
+#
+$env{'branchcode'} = $branch;
+$env{'printer'} = $printer;
+$env{'organisation'} = $organisation;
+# $env{'queue'}=$printer;
-my $todaysdate =get_today();
+my @datearr = localtime( time() );
+# FIXME - Could just use POSIX::strftime("%Y%m%d", localtime);
+my $todaysdate =
+ ( 1900 + $datearr[5] )
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
+ . sprintf( "%0.2d", ( $datearr[3] ) );
# check and see if we should print
- if ($barcode eq '' && $print eq 'maybe'){
- $print = 'yes';
- }
- if ($print eq 'yes' && $borrowernumber ne ''){
- printslip(\%env,$borrowernumber);
- $query->param('borrnumber','');
- $borrowernumber='';
- }
+if ( $barcode eq '' && $print eq 'maybe' ) {
+ $print = 'yes';
+}
+
+my $inprocess = $query->param('inprocess');
+if ( $barcode eq '' ) {
+ $inprocess = '';
+}
+else {
+}
+
+if ( $barcode eq '' && $query->param('charges') eq 'yes' ) {
+ $template->param(
+ PAYCHARGES => 'yes',
+ borrowernumber => $borrowernumber
+ );
+}
+
+if ( $print eq 'yes' && $borrowernumber ne '' ) {
+ printslip( \%env, $borrowernumber );
+ $query->param( 'borrowernumber', '' );
+ $borrowernumber = '';
+}
#
# STEP 2 : FIND BORROWER
my $borrowerslist;
my $message;
if ($findborrower) {
- my ($count,$borrowers)=BornameSearch(\%env,$findborrower,'cardnumber','web');
- my @borrowers=@$borrowers;
- if ($#borrowers == -1) {
- $query->param('findborrower', '');
- $message = "'$findborrower'";
- } elsif ($#borrowers == 0) {
- $query->param('borrnumber', $borrowers[0]->{'borrowernumber'});
- $query->param('barcode','');
- $borrowernumber=$borrowers[0]->{'borrowernumber'};
- } else {
- $borrowerslist = \@borrowers;
- }
+ my ( $count, $borrowers ) =
+ BornameSearch( \%env, $findborrower, 'cardnumber', 'web' );
+ my @borrowers = @$borrowers;
+ if ( $#borrowers == -1 ) {
+ $query->param( 'findborrower', '' );
+ $message = "'$findborrower'";
+ }
+ elsif ( $#borrowers == 0 ) {
+ $query->param( 'borrowernumber', $borrowers[0]->{'borrowernumber'} );
+ $query->param( 'barcode', '' );
+ $borrowernumber = $borrowers[0]->{'borrowernumber'};
+ }
+ else {
+ $borrowerslist = \@borrowers;
+ }
}
# get the borrower information.....
my $borrower;
-my $bornum=$query->param('bornum');
-if ($bornum){
-$borrowernumber=$bornum;
-}
-my $issues;
+my @lines;
+
if ($borrowernumber) {
- $borrower = getpatroninformation(\%env,$borrowernumber,0);
- my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
-my $warning;
-
- $template->param(overduecount => $od,
- issuecount => $issue.$warning,
- finetotal => $fines);
-$issues=$issue;
-my $picture;
- my $htdocs = C4::Context->config('opacdir');
-
-$picture =$htdocs. "/htdocs/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg";
- if (-e $picture)
-{
- $template->param(borrowerphoto => "http://library.neu.edu.tr/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg");
- }else{
-$picture = "http://cc.neu.edu.tr/stdpictures/".$borrower->{'cardnumber'}.".jpg";
- $template->param(borrowerphoto => $picture);
-}
+ $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
+ my ( $od, $issue, $fines ) = borrdata2( \%env, $borrowernumber );
+
+ # Warningdate is the date that the warning starts appearing
+ my ( $today_year, $today_month, $today_day ) = Today();
+ my ( $warning_year, $warning_month, $warning_day ) = split /-/,
+ $borrower->{'dateexpiry'};
+
+ # Renew day is calculated by adding the enrolment period to today
+ my ( $renew_year, $renew_month, $renew_day ) =
+ Add_Delta_YM( $today_year, $today_month, $today_day,
+ $borrower->{'enrolmentperiod'}, 0 );
+ # if the expiry date is before today
+ if ( Date_to_Days( $today_year, $today_month, $today_day ) >
+ Date_to_Days( $warning_year, $warning_month, $warning_day ) )
+ {
+
+ #borrowercard expired or nearly expired, warn the librarian
+ $template->param(
+ flagged => "1",
+ warndeparture => "1",
+ renewaldate => "$renew_year-$renew_month-$renew_day"
+ );
+ }
+ # check for NotifyBorrowerDeparture
+ if (C4::Context->preference('NotifyBorrowerDeparture') &&
+ Date_to_Days(Add_Delta_Days($warning_year,$warning_month,$warning_day,- C4::Context->preference('NotifyBorrowerDeparture'))) <
+ Date_to_Days( $today_year, $today_month, $today_day ) )
+ {
+ $template->param("warndeparture" => 1);
+ }
+ $template->param(
+ overduecount => $od,
+ issuecount => $issue,
+ finetotal => $fines
+ );
}
#
# STEP 3 : ISSUING
#
-#Try to issue
-
+#
if ($barcode) {
-
- $barcode = cuecatbarcodedecode($barcode);
- my ($datedue, $invalidduedate) = fixdate($year, $month, $day);
- if ($issueconfirmed) {
- issuebook(\%env, $borrower, $barcode, $datedue,$cancelreserve);
- my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
- my $warning;
-
- $template->param(overduecount => $od,
- issuecount => $issue.$warning,
- finetotal => $fines);
-
- } else {
- my ($error, $question) = canbookbeissued(\%env, $borrower, $barcode, $year, $month, $day) unless %error;
- $error=\%error if %error;
-
- my $noerror=1;
- my $noquestion = 1;
- foreach my $impossible (keys %$error) {
- $template->param($impossible => $$error{$impossible},
- IMPOSSIBLE => 1) unless ($impossible eq 'SUCCESFULL_RENEW');
- $noerror = 0;
- }
- foreach my $needsconfirmation (keys %$question) {
- $template->param($needsconfirmation => $$question{$needsconfirmation},
- NEEDSCONFIRMATION => 1);
- $noquestion = 0;
- }
- $template->param(day => $day,
- month => $month,
- year => $year);
- if ($noerror && ($noquestion || $issueconfirmed)) {
-
- issuebook(\%env, $borrower, $barcode, $datedue);
- my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
- my $warning;
-
- $template->param(overduecount => $od,
- issuecount => $issue.$warning,
- finetotal => $fines);
- }
- }
-
+ $barcode = cuecatbarcodedecode($barcode);
+ my ( $datedue, $invalidduedate ) = fixdate( $year, $month, $day );
+ if ($issueconfirmed) {
+ issuebook( \%env, $borrower, $barcode, $datedue, $cancelreserve );
+ $inprocess = 1;
+ }
+ else {
+ my ( $error, $question ) =
+ canbookbeissued( \%env, $borrower, $barcode, $year, $month, $day,
+ $inprocess );
+ my $noerror = 1;
+ my $noquestion = 1;
+# Get the item title for more information
+ my $getmessageiteminfo = getiteminformation( undef, $barcode );
+
+ foreach my $impossible ( keys %$error ) {
+ $template->param(
+ $impossible => $$error{$impossible},
+ IMPOSSIBLE => 1
+ );
+ $noerror = 0;
+ }
+ foreach my $needsconfirmation ( keys %$question ) {
+ $template->param(
+ $needsconfirmation => $$question{$needsconfirmation},
+ getTitleMessageIteminfo => $getmessageiteminfo->{'title'},
+ NEEDSCONFIRMATION => 1
+ );
+ $noquestion = 0;
+ }
+ $template->param(
+ day => $day,
+ month => $month,
+ year => $year
+ );
+ if ( $noerror && ( $noquestion || $issueconfirmed ) ) {
+ issuebook( \%env, $borrower, $barcode, $datedue );
+ $inprocess = 1;
+ }
+ }
+
+# FIXME If the issue is confirmed, we launch another time borrdata2, now display the issue count after issue
+ my ( $od, $issue, $fines ) = borrdata2( \%env, $borrowernumber );
+ $template->param(
+ issuecount => $issue,
+ );
}
-
-
+# reload the borrower info for the sake of reseting the flags.....
+if ($borrowernumber) {
+ $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
+}
##################################################################################
# BUILD HTML
+# show all reserves of this borrower, and the position of the reservation ....
+if ($borrowernumber) {
+
+ # new op dev
+ # now we show the status of the borrower's reservations
+ my @borrowerreserv = GetReservations( 0, $borrowernumber );
+ my @reservloop;
+ my @WaitingReserveLoop;
+
+ foreach my $num_res (@borrowerreserv) {
+ my %getreserv;
+ my %getWaitingReserveInfo;
+ my %env;
+ my $getiteminfo = getiteminformation( $num_res->{'itemnumber'} );
+ my $itemtypeinfo = getitemtypeinfo( $getiteminfo->{'itemtype'} );
+ my ( $transfertwhen, $transfertfrom, $transfertto ) =
+ checktransferts( $num_res->{'itemnumber'} );
+
+ $getreserv{waiting} = 0;
+ $getreserv{transfered} = 0;
+ $getreserv{nottransfered} = 0;
+
+ $getreserv{reservedate} = format_date( $num_res->{'reservedate'} );
+ $getreserv{biblionumber} = $getiteminfo->{'biblionumber'};
+ $getreserv{title} = $getiteminfo->{'title'};
+ $getreserv{itemtype} = $itemtypeinfo->{'description'};
+ $getreserv{author} = $getiteminfo->{'author'};
+ $getreserv{barcodereserv} = $getiteminfo->{'barcode'};
+ $getreserv{itemcallnumber} = $getiteminfo->{'itemcallnumber'};
+
+ # check if we have a waiting status for reservations
+ if ( $num_res->{'found'} eq 'W' ) {
+ $getreserv{color} = 'reserved';
+ $getreserv{waiting} = 1;
+# genarate information displaying only waiting reserves
+ $getWaitingReserveInfo{title} = $getiteminfo->{'title'};
+ $getWaitingReserveInfo{itemtype} = $itemtypeinfo->{'description'};
+ $getWaitingReserveInfo{author} = $getiteminfo->{'author'};
+ $getWaitingReserveInfo{reservedate} = format_date( $num_res->{'reservedate'} );
+ if ($getiteminfo->{'holdingbranch'} ne $num_res->{'branchcode'} ) {
+ $getWaitingReserveInfo{waitingat} = GetBranchName( $num_res->{'branchcode'} );
+ }
+
+ }
+ # check transfers with the itemnumber foud in th reservation loop
+ if ($transfertwhen) {
+ $getreserv{color} = 'transfered';
+ $getreserv{transfered} = 1;
+ $getreserv{datesent} = format_date($transfertwhen);
+ $getreserv{frombranch} = GetBranchName($transfertfrom);
+ }
+
+ if ( ( $getiteminfo->{'holdingbranch'} ne $num_res->{'branchcode'} )
+ and not $transfertwhen )
+ {
+ $getreserv{nottransfered} = 1;
+ $getreserv{nottransferedby} =
+ GetBranchName( $getiteminfo->{'holdingbranch'} );
+ }
+
+# if we don't have a reserv on item, we put the biblio infos and the waiting position
+ if ( $getiteminfo->{'title'} eq '' ) {
+ my $getbibinfo = GetBiblioItemData( $num_res->{'biblionumber'} );
+ my $getbibtype = getitemtypeinfo( $getbibinfo->{'itemtype'} );
+ $getreserv{color} = 'inwait';
+ $getreserv{title} = $getbibinfo->{'title'};
+ $getreserv{waitingposition} = $num_res->{'priority'};
+ $getreserv{nottransfered} = 0;
+ $getreserv{itemtype} = $getbibtype->{'description'};
+ $getreserv{author} = $getbibinfo->{'author'};
+ $getreserv{itemcallnumber} = '----------';
+
+ }
+ push( @reservloop, \%getreserv );
+
+# if we have a reserve waiting, initiate waitingreserveloop
+ if ($getreserv{waiting} eq 1) {
+ push (@WaitingReserveLoop, \%getWaitingReserveInfo)
+ }
+
+ }
+
+ # return result to the template
+ $template->param(
+ countreserv => scalar @reservloop,
+ reservloop => \@reservloop ,
+ WaitingReserveLoop => \@WaitingReserveLoop,
+ );
+}
-# make the issued books table.....
-my $todaysissues='';
-my $previssues='';
+# make the issued books table.
+my $todaysissues = '';
+my $previssues = '';
my @realtodayissues;
my @realprevissues;
-#my @renewissues;
my $allowborrow;
+## ADDED BY JF: new itemtype issuingrules counter stuff
+my $issued_itemtypes_loop;
+my $issued_itemtypes_count;
+my $issued_itemtypes_allowed_count; # hashref with total allowed by itemtype
+my $issued_itemtypes_remaining; # hashref with remaining
+my $issued_itemtypes_flags; #hashref that stores flags
+
if ($borrower) {
# get each issue of the borrower & separate them in todayissues & previous issues
- my @todaysissues;
- my @previousissues;
- my $issueslist = getissues($borrower);
- # split in 2 arrays for today & previous
- foreach my $it (keys %$issueslist) {
- my $issuedate = $issueslist->{$it}->{'issue_date'};
-# $issuedate = substr($issuedate, 0, 10);
-
- if ($todaysdate eq $issuedate) {
- push @todaysissues, $issueslist->{$it};
- } else {
- push @previousissues, $issueslist->{$it};
- }
+ my @todaysissues;
+ my @previousissues;
+ my $issueslist = getissues($borrower);
+
+ # split in 2 arrays for today & previous
+ my $dbh = C4::Context->dbh;
+ foreach my $it ( keys %$issueslist ) {
+ my $issuedate = $issueslist->{$it}->{'timestamp'};
+ $issuedate =~ s/-//g;
+ $issuedate = substr( $issuedate, 0, 8 );
+
+ # to let perl sort this correctly
+ $issueslist->{$it}->{'timestamp'} =~ s/(-|\:| )//g;
+
+ if ( $todaysdate == $issuedate ) {
+ (
+ $issueslist->{$it}->{'charge'},
+ $issueslist->{$it}->{'itemtype_charge'}
+ )
+ = calc_charges(
+ $dbh,
+ $issueslist->{$it}->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ $issueslist->{$it}->{'charge'} =
+ sprintf( "%.2f", $issueslist->{$it}->{'charge'} );
+ (
+ $issueslist->{$it}->{'can_renew'},
+ $issueslist->{$it}->{'can_renew_error'}
+ )
+ = renewstatus(
+ \%env,
+ $borrower->{'borrowernumber'},
+ $issueslist->{$it}->{'itemnumber'}
+ );
+ my ( $restype, $reserves ) =
+ CheckReserves( $issueslist->{$it}->{'itemnumber'} );
+ if ($restype) {
+ $issueslist->{$it}->{'can_renew'} = 0;
+ }
+ push @todaysissues, $issueslist->{$it};
+ }
+ else {
+ (
+ $issueslist->{$it}->{'charge'},
+ $issueslist->{$it}->{'itemtype_charge'}
+ )
+ = calc_charges(
+ $dbh,
+ $issueslist->{$it}->{'itemnumber'},
+ $borrower->{'borrowernumber'}
+ );
+ $issueslist->{$it}->{'charge'} =
+ sprintf( "%.2f", $issueslist->{$it}->{'charge'} );
+ (
+ $issueslist->{$it}->{'can_renew'},
+ $issueslist->{$it}->{'can_renew_error'}
+ )
+ = renewstatus(
+ \%env,
+ $borrower->{'borrowernumber'},
+ $issueslist->{$it}->{'itemnumber'}
+ );
+ my ( $restype, $reserves ) =
+ CheckReserves( $issueslist->{$it}->{'itemnumber'} );
+ if ($restype) {
+ $issueslist->{$it}->{'can_renew'} = 0;
+ }
+ push @previousissues, $issueslist->{$it};
+ }
+ }
+ my $od; # overdues
+ my $i = 0;
+ my $togglecolor;
+
+ # parses today & build Template array
+ foreach my $book ( sort { $b->{'timestamp'} <=> $a->{'timestamp'} }
+ @todaysissues )
+ {
+ #warn "TIMESTAMP".$book->{'timestamp'};
+ # ADDED BY JF: NEW ITEMTYPE COUNT DISPLAY
+ $issued_itemtypes_count->{ $book->{'itemtype'} }++;
+
+ my $dd = $book->{'date_due'};
+ my $datedue = $book->{'date_due'};
+
+ #$dd=format_date($dd);
+ $datedue =~ s/-//g;
+ if ( $datedue < $todaysdate ) {
+ $od = 1;
+ }
+ else {
+ $od = 0;
+ }
+ if ( $i % 2 ) {
+ $togglecolor = 0;
+ }
+ else {
+ $togglecolor = 1;
+ }
+ $book->{'togglecolor'} = $togglecolor;
+ $book->{'od'} = format_date($od);
+ $book->{'dd'} = format_date($dd);
+ if ( $book->{'author'} eq '' ) {
+ $book->{'author'} = ' ';
+ }
+ push @realtodayissues, $book;
+ $i++;
}
+ # parses previous & build Template array
+ $i = 0;
+ foreach my $book ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
+ @previousissues )
+ {
+
+ # ADDED BY JF: NEW ITEMTYPE COUNT DISPLAY
+ $issued_itemtypes_count->{ $book->{'itemtype'} }++;
+
+ my $dd = format_date($book->{'date_due'});
+ my $datedue = format_date($book->{'date_due'});
+
+ #$dd=format_date($dd);
+ my $pcolor = '';
+ my $od = '';
+ $datedue =~ s/-//g;
+ if ( $datedue < $todaysdate ) {
+ $od = 1;
+ }
+ else {
+ $od = 0;
+ }
+ if ( $i % 2 ) {
+ $togglecolor = 0;
+ }
+ else {
+ $togglecolor = 1;
+ }
+ $book->{'togglecolor'} = $togglecolor;
+ $book->{'dd'} = $dd;
+ $book->{'od'} = $od;
+ if ( $book->{'author'} eq '' ) {
+ $book->{'author'} = ' ';
+ }
+ push @realprevissues, $book;
+ $i++;
+ }
+}
- my $od; # overdues
- my $i = 0;
- my $togglecolor;
- # parses today & build Template array
- foreach my $book (sort {$b->{'timestamp'} <=> $a->{'timestamp'}} @todaysissues){
- my $dd = $book->{'date_due'};
- my $datedue = $book->{'date_due'};
-
- $dd=format_date($dd);
-# $datedue=~s/-//g;
- if ($datedue lt $todaysdate) {
- $od = 1;
- } else {
- $od=0;
- }
- $book->{'od'}=$od;
- $book->{'dd'}=$dd;
-
- if ($togglecolor) {
- $togglecolor=0;
- } else {
- $togglecolor=1;
- }
- $book->{'tcolor'}=$togglecolor;
- if ($book->{'author'} eq ''){
- $book->{'author'}=' ';
- }
- push @realtodayissues,$book;
- $i++;
- }
-
-
-
- # parses previous & build Template array
- $i=0;
- foreach my $book (sort {$a->{'date_due'} cmp $b->{'date_due'}} @previousissues){
- my $dd = $book->{'date_due'};
- my $datedue = $book->{'date_due'};
- $dd=format_date($dd);
- my $pcolor = '';
- my $od = '';
-# $datedue=~s/-//g;
- if ($datedue lt $todaysdate) {
-
- $od = 1;
- } else {
- $od = 0;
- }
-
- if ($togglecolor) {
- $togglecolor=0;
- } else {
- $togglecolor=1;
- }
- $book->{'tcolor'}=$togglecolor;
- $book->{'dd'}=$dd;
- $book->{'od'}=$od;
- #$book->{'tcolor'}=$pcolor;
- if ($book->{'author'} eq ''){
- $book->{'author'}=' ';
- }
-
- push @realprevissues,$book;
- $i++;
- }
-
-}#borrower
+#### ADDED BY JF FOR COUNTS BY ITEMTYPE RULES
+# FIXME: This should utilize all the issuingrules options rather than just the defaults
+# and it should be moved to a module
+my $dbh = C4::Context->dbh;
+
+# how many of each is allowed?
+my $issueqty_sth = $dbh->prepare( "
+SELECT itemtypes.description AS description,issuingrules.itemtype,maxissueqty
+FROM issuingrules
+ LEFT JOIN itemtypes ON (itemtypes.itemtype=issuingrules.itemtype)
+ WHERE categorycode=?
+" );
+my @issued_itemtypes_count;
+$issueqty_sth->execute("*");
+while ( my $data = $issueqty_sth->fetchrow_hashref() ) {
+
+ # subtract how many of each this borrower has
+ $data->{'count'} = $issued_itemtypes_count->{ $data->{'description'} };
+ $data->{'left'} =
+ ( $data->{'maxissueqty'} -
+ $issued_itemtypes_count->{ $data->{'description'} } );
+
+ # can't have a negative number of remaining
+ if ( $data->{'left'} < 0 ) { $data->{'left'} = "0" }
+ $data->{'flag'} = 1 unless ( $data->{'maxissueqty'} > $data->{'count'} );
+ unless ( ( $data->{'maxissueqty'} < 1 )
+ || ( $data->{'itemtype'} eq "*" )
+ || ( $data->{'itemtype'} eq "CIRC" ) )
+ {
+ push @issued_itemtypes_count, $data;
+ }
+}
+$issued_itemtypes_loop = \@issued_itemtypes_count;
+#### / JF
my @values;
my %labels;
my $CGIselectborrower;
if ($borrowerslist) {
- foreach (sort {$a->{'surname'}.$a->{'firstname'} cmp $b->{'surname'}.$b->{'firstname'}} @$borrowerslist){
- push @values,$_->{'borrowernumber'};
- $labels{$_->{'borrowernumber'}} ="$_->{'surname'}, $_->{'firstname'} ... ($_->{'cardnumber'} - $_->{'categorycode'}) ... $_->{'streetaddress'} ";
- }
- $CGIselectborrower=CGI::scrolling_list( -name => 'borrnumber',
- -values => \@values,
- -labels => \%labels,
- -size => 7,
- -multiple => 0 );
+ foreach (
+ sort {
+ $a->{'surname'}
+ . $a->{'firstname'} cmp $b->{'surname'}
+ . $b->{'firstname'}
+ } @$borrowerslist
+ )
+ {
+ push @values, $_->{'borrowernumber'};
+ $labels{ $_->{'borrowernumber'} } =
+"$_->{'surname'}, $_->{'firstname'} ... ($_->{'cardnumber'} - $_->{'categorycode'}) ... $_->{'address'} ";
+ }
+ $CGIselectborrower = CGI::scrolling_list(
+ -name => 'borrowernumber',
+ -values => \@values,
+ -labels => \%labels,
+ -size => 7,
+ -tabindex => '',
+ -multiple => 0
+ );
}
+
#title
+my $flags = $borrower->{'flags'};
+my $flag;
+
+foreach $flag ( sort keys %$flags ) {
+
+ $flags->{$flag}->{'message'} =~ s/\n/<br>/g;
+ if ( $flags->{$flag}->{'noissues'} ) {
+ $template->param(
+ flagged => 1,
+ noissues => 'true',
+ );
+ if ( $flag eq 'GNA' ) {
+ $template->param( gna => 'true' );
+ }
+ if ( $flag eq 'LOST' ) {
+ $template->param( lost => 'true' );
+ }
+ if ( $flag eq 'DBARRED' ) {
+ $template->param( dbarred => 'true' );
+ }
+ if ( $flag eq 'CHARGES' ) {
+ $template->param(
+ charges => 'true',
+ chargesmsg => $flags->{'CHARGES'}->{'message'}
+ );
+ }
+ if ( $flag eq 'CREDITS' ) {
+ $template->param(
+ credits => 'true',
+ creditsmsg => $flags->{'CREDITS'}->{'message'}
+ );
+ }
+ }
+ else {
+ if ( $flag eq 'CHARGES' ) {
+ $template->param(
+ charges => 'true',
+ flagged => 1,
+ chargesmsg => $flags->{'CHARGES'}->{'message'}
+ );
+ }
+ if ( $flag eq 'CREDITS' ) {
+ $template->param(
+ credits => 'true',
+ creditsmsg => $flags->{'CREDITS'}->{'message'}
+ );
+ }
+ if ( $flag eq 'ODUES' ) {
+ $template->param(
+ odues => 'true',
+ flagged => 1,
+ oduesmsg => $flags->{'ODUES'}->{'message'}
+ );
+
+ my $items = $flags->{$flag}->{'itemlist'};
+ {
+ my @itemswaiting;
+ foreach my $item (@$items) {
+ my ($iteminformation) =
+ getiteminformation( $item->{'itemnumber'}, 0 );
+ push @itemswaiting, $iteminformation;
+ }
+ }
+ if ( $query->param('module') ne 'returns' ) {
+ $template->param( nonreturns => 'true' );
+ }
+ }
+ if ( $flag eq 'NOTES' ) {
+ $template->param(
+ notes => 'true',
+ flagged => 1,
+ notesmsg => $flags->{'NOTES'}->{'message'}
+ );
+ }
+ }
+}
-my ($patrontable, $flaginfotable) = patrontable($borrower);
-my $amountold=$borrower->{flags}->{'CHARGES'}->{'message'};
-my @temp=split(/\$/,$amountold);
-$amountold=$temp[1];
-$template->param( today=>format_date($todaysdate),
- findborrower => $findborrower,
- borrower => $borrower,
- borrowernumber => $borrowernumber,
- branch => $branch,
- printer => $printer,
- branchname => $branches->{$branch}->{'branchname'},
- printername => $printers->{$printer}->{'printername'},
- firstname => $borrower->{'firstname'},
- surname => $borrower->{'surname'},
- categorycode => getborrowercategory($borrower->{'categorycode'}),
- streetaddress => $borrower->{'streetaddress'},
- emailaddress => $borrower->{'emailaddress'},
- borrowernotes => $borrower->{'borrowernotes'},
- city => $borrower->{'city'},
- phone => $borrower->{'phone'},
- cardnumber => $borrower->{'cardnumber'},
- amountold => $amountold,
- barcode => $barcode,
- stickyduedate => $stickyduedate,
- message => $message,
- CGIselectborrower => $CGIselectborrower,
- todayissues => \@realtodayissues,
- previssues => \@realprevissues,
-
- );
-# set return date if stickyduedate
-if ($stickyduedate) {
- my $t_year = "year".$year;
- my $t_month = "month".$month;
- my $t_day = "day".$day;
- $template->param(
- $t_year => 1,
- $t_month => 1,
- $t_day => 1,
- );
+my $amountold = $borrower->{flags}->{'CHARGES'}->{'message'} || 0;
+my @temp = split( /\$/, $amountold );
+
+my $CGIorganisations;
+my $member_of_institution;
+if ( C4::Context->preference("memberofinstitution") ) {
+ my $organisations = get_institutions();
+ my @orgs;
+ my %org_labels;
+ foreach my $organisation ( keys %$organisations ) {
+ push @orgs, $organisation;
+ $org_labels{$organisation} =
+ $organisations->{$organisation}->{'surname'};
+ }
+ $member_of_institution = 1;
+ $CGIorganisations = CGI::popup_menu(
+ -id => 'organisations',
+ -name => 'organisations',
+ -labels => \%org_labels,
+ -values => \@orgs,
+ );
}
+$amountold = $temp[1];
+
+$template->param(
+ issued_itemtypes_count_loop => $issued_itemtypes_loop,
+ findborrower => $findborrower,
+ borrower => $borrower,
+ borrowernumber => $borrowernumber,
+ branch => $branch,
+ printer => $printer,
+ printername => $printer,
+ firstname => $borrower->{'firstname'},
+ surname => $borrower->{'surname'},
+ expiry =>
+ $borrower->{'dateexpiry'}, #format_date($borrower->{'dateexpiry'}),
+ categorycode => $borrower->{'categorycode'},
+ streetaddress => $borrower->{'address'},
+ emailaddress => $borrower->{'emailaddress'},
+ borrowernotes => $borrower->{'borrowernotes'},
+ city => $borrower->{'city'},
+ phone => $borrower->{'phone'},
+ cardnumber => $borrower->{'cardnumber'},
+ amountold => $amountold,
+ barcode => $barcode,
+ stickyduedate => $stickyduedate,
+ message => $message,
+ CGIselectborrower => $CGIselectborrower,
+ todayissues => \@realtodayissues,
+ previssues => \@realprevissues,
+ inprocess => $inprocess,
+ memberofinstution => $member_of_institution,
+ CGIorganisations => $CGIorganisations,
+);
-if ($branchcookie) {
- $cookie=[$cookie, $branchcookie, $printercookie];
+# set return date if stickyduedate
+if ($stickyduedate) {
+ my $t_year = "year" . $year;
+ my $t_month = "month" . $month;
+ my $t_day = "day" . $day;
+ $template->param(
+ $t_year => 1,
+ $t_month => 1,
+ $t_day => 1,
+ );
}
+#if ($branchcookie) {
+#$cookie=[$cookie, $branchcookie, $printercookie];
+#}
+
+$template->param(
+ SpecifyDueDate => C4::Context->preference("SpecifyDueDate")
+);
output_html_with_http_headers $query, $cookie, $template->output;
####################################################################
# Extra subroutines,,,
-sub patrontable {
- my ($borrower) = @_;
- my $flags = $borrower->{'flags'};
- my $flaginfotable='';
- my $flaginfotext;
- #my $flaginfotext='';
- my $flag;
- my $color='';
- foreach $flag (sort keys %$flags) {
-# my @itemswaiting='';
- $flags->{$flag}->{'message'}=~s/\n/<br>/g;
- if ($flags->{$flag}->{'noissues'}) {
- $template->param(
- flagged => 1,
- noissues => 'true',
- );
- if ($flag eq 'GNA'){
- $template->param(
- gna => 'true'
- );
- }
- if ($flag eq 'LOST'){
- $template->param(
- lost => 'true'
- );
- }
- if ($flag eq 'DBARRED'){
- $template->param(
- dbarred => 'true'
- );
- }
- if ($flag eq 'CHARGES') {
- $template->param(
- charges => 'true',
- chargesmsg => $flags->{'CHARGES'}->{'message'}
- );
- }
- } else {
- if ($flag eq 'CHARGES') {
- $template->param(
- charges => 'true',
- flagged => 1,
- chargesmsg => $flags->{'CHARGES'}->{'message'}
- );
- }
- if ($flag eq 'WAITING') {
- my $items=$flags->{$flag}->{'itemlist'};
- my @itemswaiting;
- foreach my $item (@$items) {
- my ($iteminformation) = getiteminformation(\%env, $item->{'itemnumber'}, 0);
- $iteminformation->{'branchname'} = $branches->{$iteminformation->{'holdingbranch'}}->{'branchname'};
- push @itemswaiting, $iteminformation;
- }
- $template->param(
- flagged => 1,
- waiting => 'true',
- waitingmsg => $flags->{'WAITING'}->{'message'},
- itemswaiting => \@itemswaiting,
- );
- }
- if ($flag eq 'ODUES') {
- $template->param(
- odues => 'true',
- flagged => 1,
- oduesmsg => $flags->{'ODUES'}->{'message'}
- );
-
- my $items=$flags->{$flag}->{'itemlist'};
- {
- my @itemswaiting;
- foreach my $item (@$items) {
- my ($iteminformation) = getiteminformation(\%env, $item->{'itemnumber'}, 0);
- push @itemswaiting, $iteminformation;
- }
- }
- if ($query->param('module') ne 'returns'){
- $template->param( nonreturns => 'true' );
- }
- }
- if ($flag eq 'NOTES') {
- $template->param(
- notes => 'true',
- flagged => 1,
- notesmsg => $flags->{'NOTES'}->{'message'}
- );
- }
- }
- }
- return($patrontable, $flaginfotext);
-}
-
sub cuecatbarcodedecode {
my ($barcode) = @_;
chomp($barcode);
- my @fields = split(/\./,$barcode);
- my @results = map(decode($_), @fields[1..$#fields]);
- if ($#results == 2){
- return $results[2];
- } else {
- return $barcode;
+ my @fields = split( /\./, $barcode );
+ my @results = map( decode($_), @fields[ 1 .. $#fields ] );
+ if ( $#results == 2 ) {
+ return $results[2];
+ }
+ else {
+ return $barcode;
}
}
-
-# Local Variables:
-# tab-width: 8
-# End:
# Suite 330, Boston, MA 02111-1307 USA
use strict;
+use CGI;
use C4::Context;
use C4::Output;
-use CGI;
-use HTML::Template;
+use C4::Branch;
use C4::Auth;
use C4::Date;
use C4::Circulation::Circ2;
-use Date::Manip;
+use C4::Interface::CGI::Output;
+use Date::Calc qw(
+ Today
+ Add_Delta_YM
+ Date_to_Days
+);
+
use C4::Koha;
-use C4::Search;
use C4::Reserves2;
my $input = new CGI;
-my $theme = $input->param('theme'); # only used if allowthemeoverride is set
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
my $itemnumber = $input->param('itemnumber');
+my $todaysdate = join "-", &Today;
+
# if we have a resturn of the form to delete the transfer, we launch the subrroutine
-if ($itemnumber){
- C4::Circulation::Circ2::DeleteTransfer($itemnumber);
+if ($itemnumber) {
+ C4::Circulation::Circ2::DeleteTransfer($itemnumber);
}
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "circ/currenttransfers.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- debug => 1,
- });
-
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/currenttransfers.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
# set the userenv branch
my $default = C4::Context->userenv->{'branch'};
-
-my @datearr = localtime(time());
-my $todaysdate = (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.sprintf ("%0.2d", $datearr[3]);
-
# get the all the branches for reference
my $branches = GetBranches();
my @branchesloop;
-foreach my $br (keys %$branches) {
- my @transferloop;
- my %branchloop;
- $branchloop{'branchname'} = $branches->{$br}->{'branchname'};
- $branchloop{'branchcode'} = $branches->{$br}->{'branchcode'};
- # # # # # # # # # # # # # # # # # # # # # #
- my @gettransfers = GetTransfersFromBib($branches->{$br}->{'branchcode'},$default);
- if (@gettransfers){
- foreach my $num (@gettransfers) {
- my %getransf;
- my %env;
- my $calcDate=DateCalc($num->{'datesent'},"+".C4::Context->preference('TransfersMaxDaysWarning')." days");
- my $warning=Date_Cmp(ParseDate("today"),$calcDate);
- if ($warning>0){
- $getransf{'messcompa'} = 1;
- }
- my $gettitle = getiteminformation(\%env,$num->{'itemnumber'});
- my $itemtypeinfo = getitemtypeinfo($gettitle->{'itemtype'});
-
- $getransf{'title'} = $gettitle->{'title'};
- $getransf{'datetransfer'} = format_date($num->{'datesent'});
- $getransf{'biblionumber'} = $gettitle->{'biblionumber'};
- $getransf{'itemnumber'} = $gettitle->{'itemnumber'};
- $getransf{'barcode'} = $gettitle->{'barcode'};
- $getransf{'itemtype'} = $itemtypeinfo->{'description'};
- $getransf{'homebranch'} = $gettitle->{'homebranch'};
- $getransf{'holdingbranch'} = $gettitle->{'holdingbranch'};
- $getransf{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
-
-# we check if we have a reserv for this transfer
- my @checkreserv = FastFindReserves($num->{'itemnumber'});
- if (@checkreserv[0]){
- my $getborrower = getpatroninformation (\%env,$checkreserv[1]);
- $getransf{'borrowernum'} = $getborrower->{'borrowernumber'};
- $getransf{'borrowername'} = $getborrower->{'surname'};
- $getransf{'borrowerfirstname'} = $getborrower->{'firstname'};
- if ($getborrower->{'emailaddress'}){
- $getransf{'borrowermail'} = $getborrower->{'emailaddress'} ;
- }
- $getransf{'borrowerphone'} = $getborrower->{'phone'};
-
- }
- push(@transferloop, \%getransf);
- }
-# If we have a return of reservloop we put it in the branchloop sequence
- $branchloop{'reserv'} = \@transferloop ;
- }
- else {
+foreach my $br ( keys %$branches ) {
+ my @transferloop;
+ my %branchloop;
+ $branchloop{'branchname'} = $branches->{$br}->{'branchname'};
+ $branchloop{'branchcode'} = $branches->{$br}->{'branchcode'};
+ my @gettransfers =
+ GetTransfersFromBib( $branches->{$br}->{'branchcode'}, $default );
+
+ if (@gettransfers) {
+ foreach my $num (@gettransfers) {
+ my %getransf;
+ my %env;
+
+ my ( $sent_year, $sent_month, $sent_day ) = split "-",
+ $num->{'datesent'};
+ $sent_day = ( split " ", $sent_day )[0];
+ ( $sent_year, $sent_month, $sent_day ) =
+ Add_Delta_YM( $sent_year, $sent_month, $sent_day,
+ C4::Context->preference('TransfersMaxDaysWarning'), 0 );
+ my $calcDate = Date_to_Days( $sent_year, $sent_month, $sent_day );
+ my $today = Date_to_Days(&Today);
+ my $warning = ( $today > $calcDate );
+
+ if ( $warning > 0 ) {
+ $getransf{'messcompa'} = 1;
+ }
+ my $gettitle = getiteminformation( $num->{'itemnumber'} );
+ my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
+
+ $getransf{'title'} = $gettitle->{'title'};
+ $getransf{'datetransfer'} = format_date( $num->{'datesent'} );
+ $getransf{'biblionumber'} = $gettitle->{'biblionumber'};
+ $getransf{'itemnumber'} = $gettitle->{'itemnumber'};
+ $getransf{'barcode'} = $gettitle->{'barcode'};
+ $getransf{'itemtype'} = $itemtypeinfo->{'description'};
+ $getransf{'homebranch'} = $gettitle->{'homebranch'};
+ $getransf{'holdingbranch'} = $gettitle->{'holdingbranch'};
+ $getransf{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
+
+ # we check if we have a reserv for this transfer
+ my @checkreserv = GetReservations( $num->{'itemnumber'} );
+ if ( $checkreserv[0] ) {
+ my $getborrower =
+ getpatroninformation( \%env, $checkreserv[1] );
+ $getransf{'borrowernum'} = $getborrower->{'borrowernumber'};
+ $getransf{'borrowername'} = $getborrower->{'surname'};
+ $getransf{'borrowerfirstname'} = $getborrower->{'firstname'};
+ if ( $getborrower->{'emailaddress'} ) {
+ $getransf{'borrowermail'} = $getborrower->{'emailaddress'};
+ }
+ $getransf{'borrowerphone'} = $getborrower->{'phone'};
+
+ }
+ push( @transferloop, \%getransf );
+ }
+
+ # If we have a return of reservloop we put it in the branchloop sequence
+ $branchloop{'reserv'} = \@transferloop;
+ }
+ else {
+
# if we don't have a retrun from reservestobranch we unset branchname and branchcode
- $branchloop{'branchname'} = 0;
- $branchloop{'branchcode'} = 0;
- }
-push(@branchesloop, \%branchloop);
+ $branchloop{'branchname'} = 0;
+ $branchloop{'branchcode'} = 0;
+ }
+ push( @branchesloop, \%branchloop );
}
- $template->param( branchesloop => \@branchesloop,
- show_date => format_date($todaysdate)
- );
-
- print "Content-Type: text/html\n\n", $template->output;
+$template->param(
+ branchesloop => \@branchesloop,
+ show_date => format_date($todaysdate),
+);
+output_html_with_http_headers $input, $cookie, $template->output;
use C4::Context;
use C4::Output;
use CGI;
-use HTML::Template;
use C4::Auth;
use C4::Date;
+use C4::Interface::CGI::Output;
my $input = new CGI;
-my $type=$input->param('type');
-my $order=$input->param('order');
-
-my $theme = $input->param('theme'); # only used if allowthemeoverride is set
-
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "circ/reserve.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- debug => 1,
- });
-# borrowernumber int(11)
-# reservedate date
-# biblionumber int(11)
-# constrainttype char(1)
-# branchcode varchar(4)
-# notificationdate date
-# reminderdate date
-# cancellationdate date
-# reservenotes text
-# priority smallint(6)
-# found char(1)
-# timestamp timestamp ON UPDATE CURRENT_TIMESTAMP Oui CURRENT_TIMESTAMP Modifier Supprimer Primaire Index Unique Texte entier
-# itemnumber int(11)
+my $order = $input->param('order');
+my $startdate=$input->param('from');
+my $enddate=$input->param('to');
+
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/reserve.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
+
my $duedate;
-my $bornum;
+my $borrowernumber;
my $itemnum;
my $data1;
my $data2;
my $biblionumber;
my $title;
my $author;
-my @datearr = localtime(time());
-my $todaysdate = (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.sprintf ("%0.2d", $datearr[3]);
-my $dbh = C4::Context->dbh;
-my $strsth="select reservedate,reserves.borrowernumber as bornum, concat(firstname,' ',surname) as borrower, borrowers.phone, borrowers.emailaddress,reserves.biblionumber, reserves.branchcode as branch, items.holdingbranch, items.itemcallnumber, items.itemnumber, notes, notificationdate, reminderdate, priority, reserves.found, biblio.title, biblio.author from reserves left join items on items.itemnumber=reserves.itemnumber, borrowers,biblio where isnull(cancellationdate) && reserves.borrowernumber=borrowers.borrowernumber && reserves.biblionumber=biblio.biblionumber order by reservedate, borrower ";
-$strsth="select reservedate,reserves.borrowernumber as bornum,concat(firstname,' ',surname) as borrower, borrowers.phone, borrowers.emailaddress,reserves.biblionumber, reserves.branchcode as branch, items.holdingbranch, items.itemcallnumber, items.itemnumber, notes, notificationdate, reminderdate, priority, reserves.found, biblio.title, biblio.author from reserves left join items on items.itemnumber=reserves.itemnumber , borrowers,biblio where isnull(cancellationdate) && reserves.borrowernumber=borrowers.borrowernumber && reserves.biblionumber=biblio.biblionumber order by borrower,reservedate " if ($order eq "borrower");
-$strsth="select reservedate,reserves.borrowernumber as bornum,concat(firstname,' ',surname) as borrower, borrowers.phone, borrowers.emailaddress,reserves.biblionumber, reserves.branchcode as branch, items.holdingbranch, items.itemcallnumber, items.itemnumber, notes, notificationdate, reminderdate, priority, reserves.found, biblio.title, biblio.author from reserves left join items on items.itemnumber=reserves.itemnumber, borrowers,biblio where isnull(cancellationdate) && reserves.borrowernumber=borrowers.borrowernumber && reserves.biblionumber=biblio.biblionumber order by biblio.title, priority,reservedate " if ($order eq "biblio");
-my $sth=$dbh->prepare($strsth);
-warn "".$strsth;
-$sth->execute();
+my @datearr = localtime( time() );
+my $todaysdate =
+ ( 1900 + $datearr[5] ) . '-'
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-'
+ . sprintf( "%0.2d", $datearr[3] );
-my @reservedata;
-while (my $data=$sth->fetchrow_hashref) {
- push (@reservedata,
- {
- reservedate => format_date($data->{reservedate}),
- priority => $data->{priority},
- name => $data->{borrower},
- title => $data->{title},
- author => $data->{author},
- bornum => $data->{bornum},
- itemnum => $data->{itemnumber},
- phone => $data->{phone},
- email => $data->{email},
- biblionumber => $data->{biblionumber},
- statusw => ($data->{found} eq "w"),
- statusf => ($data->{found} eq "f"),
- holdingbranch => $data->{holdingbranch},
- branch => $data->{branch},
- itemcallnumber => $data->{itemcallnumber},
- notes => $data->{notes},
- notificationdate => $data->{notificationdate},
- reminderdate => $data->{reminderdate}
- }
-
- );
+my $dbh = C4::Context->dbh;
+my ($sqlorderby, $sqldatewhere) = ("","");
+
+$sqldatewhere .= " && reservedate >= " . $dbh->quote($startdate) if ($startdate) ;
+$sqldatewhere .= " && reservedate <= " . $dbh->quote($enddate) if ($enddate) ;
+if ($order eq "borrower") {
+ $sqlorderby = " order by borrower, reservedate";
+} elsif ($order eq "biblio") {
+ $sqlorderby = " order by biblio.title, priority,reservedate";
+} elsif ($order eq "priority") {
+ $sqlorderby = "order by priority DESC";
+} else {
+ $sqlorderby = " order by reservedate, borrower";
+}
+my $strsth =
+"SELECT reservedate,
+ reserves.borrowernumber as borrowernumber,
+ concat(firstname,' ',surname) as borrower,
+ borrowers.phone,
+ borrowers.email,
+ reserves.biblionumber,
+ reserves.branchcode as branch,
+ items.holdingbranch,
+ items.itemcallnumber,
+ items.itemnumber,
+ notes,
+ notificationdate,
+ reminderdate,
+ priority,
+ reserves.found,
+ biblio.title,
+ biblio.author
+ FROM reserves
+ LEFT JOIN items ON items.biblionumber=reserves.biblionumber,
+ borrowers,biblio
+ WHERE isnull(cancellationdate)
+ && reserves.borrowernumber=borrowers.borrowernumber
+ && reserves.biblionumber=biblio.biblionumber
+ && reserves.found is NULL
+ && items.holdingbranch=?
+ ";
+
+$strsth .= $sqlorderby;
+
+my $sth = $dbh->prepare($strsth);
+
+$sth->execute(C4::Context->userenv->{'branch'});
+
+my @reservedata;
+my $previous;
+my $this;
+while ( my $data = $sth->fetchrow_hashref ) {
+ $this=$data->{biblionumber}.":".$data->{borrowernumber};
+ my @itemlist;
+ push(
+ @reservedata,
+ {
+ reservedate => $previous eq $this?"":format_date( $data->{reservedate} ),
+ priority => $previous eq $this?"":$data->{priority},
+ name => $previous eq $this?"":$data->{borrower},
+ title => $previous eq $this?"":$data->{title},
+ author => $previous eq $this?"":$data->{author},
+ borrowernumber => $previous eq $this?"":$data->{borrowernumber},
+ itemnum => $previous eq $this?"":$data->{itemnumber},
+ phone => $previous eq $this?"":$data->{phone},
+ email => $previous eq $this?"":$data->{email},
+ biblionumber => $previous eq $this?"":$data->{biblionumber},
+ statusw => ( $data->{found} eq "w" ),
+ statusf => ( $data->{found} eq "f" ),
+ holdingbranch => $data->{holdingbranch},
+ branch => $previous eq $this?"":$data->{branch},
+ itemcallnumber => $data->{itemcallnumber},
+ notes => $previous eq $this?"":$data->{notes},
+ notificationdate => $previous eq $this?"":$data->{notificationdate},
+ reminderdate => $previous eq $this?"":$data->{reminderdate}
+ }
+ );
+ $previous=$this;
}
$sth->finish;
-$template->param(todaysdate => format_date($todaysdate),
- reserveloop => \@reservedata,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
+$template->param(
+ todaysdate => format_date($todaysdate),
+ from => $startdate,
+ to => $enddate,
+ reserveloop => \@reservedata,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ "BiblioDefaultView".C4::Context->preference("BiblioDefaultView") => 1,
+);
-print "Content-Type: text/html\n\n", $template->output;
+output_html_with_http_headers $input, $cookie, $template->output;
#!/usr/bin/perl
-# WARNING: This file contains mixed-sized tabs! (some 4-character, some 8)
-# WARNING: Currently, 4-character tabs seem to be dominant
-# WARNING: But there are still lots of 8-character tabs
-
-#written 11/3/2002 by Finlay
-#script to execute returns of books
# Copyright 2000-2002 Katipo Communications
#
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 returns.pl
+
+script to execute returns of books
+
+written 11/3/2002 by Finlay
+
+=cut
+
use strict;
use CGI;
use C4::Circulation::Circ2;
-use C4::Search;
+use C4::Date;
use C4::Output;
use C4::Print;
use C4::Reserves2;
use C4::Auth;
use C4::Interface::CGI::Output;
-use C4::Koha;
-use C4::Members;
-use C4::Date;
+use C4::Branch; # GetBranchName
+use C4::Koha; # FIXME : is it still useful ?
+use C4::Context;
+
my $query = new CGI;
#getting the template
-my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+my ( $template, $librarian, $cookie ) = get_template_and_user(
{
template_name => "circ/returns.tmpl",
query => $query,
#####################
#Global vars
my %env;
-my $headerbackgroundcolor = '#99cc33';
-my $linecolor1 = '#ffffcc';
-my $linecolor2 = 'white';
-my $todaysdate =get_today();
+
my $branches = GetBranches();
-my $printers = getprinters( \%env );
+my $printers = GetPrinters( \%env );
-# my $branch = getbranch( $query, $branches );
-my $printer = getprinter( $query, $printers );
+#my $branch = C4::Context->userenv?C4::Context->userenv->{'branch'}:"";
+my $printer = C4::Context->userenv?C4::Context->userenv->{'branchprinter'}:"";
#
# Some code to handle the error if there is no branch or printer setting.....
#
-my $branch=C4::Context->preference("defaultBranch");
-$env{'branchcode'} = $branch;
+
+#$env{'branchcode'} = $branch;
$env{'printer'} = $printer;
$env{'queue'} = $printer;
+
# Set up the item stack ....
my %returneditems;
my %riduedate;
$riborrowernumber{$counter} = $borrowernumber;
#######################
- $input{counter} = $counter;
- $input{barcode} = $barcode;
- $input{duedate} = $duedate;
- $input{bornum} = $borrowernumber;
- push ( @inputloop, \%input );
+ $input{counter} = $counter;
+ $input{barcode} = $barcode;
+ $input{duedate} = $duedate;
+ $input{borrowernumber} = $borrowernumber;
+ push( @inputloop, \%input );
}
############
-my $item;
# Deal with the requests....
-if ( $query->param('resbarcode') ) {
- $item = $query->param('itemnumber');
- my $borrnum = $query->param('borrowernumber');
- my $resbarcode = $query->param('resbarcode');
+if ($query->param('WT-itemNumber')){
+updateWrongTransfer ($query->param('WT-itemNumber'),$query->param('WT-waitingAt'),$query->param('WT-From'));
+}
+
+
+if ( $query->param('resbarcode') ) {
+ my $item = $query->param('itemnumber');
+ my $borrowernumber = $query->param('borrowernumber');
+ my $resbarcode = $query->param('resbarcode');
+ my $diffBranchReturned = $query->param('diffBranch');
# set to waiting....
- my $iteminfo = getiteminformation( \%env, $item );
- my $tobranchcd = ReserveWaiting( $item, $borrnum );
- my $branchname = $branches->{$tobranchcd}->{'branchname'};
- my ($borr) = getpatroninformation( \%env, $borrnum, 0 );
+ my $iteminfo = getiteminformation($item);
+ my $diffBranchSend;
+
+# addin in ReserveWaiting the possibility to check if the document is expected in this library or not,
+# if not we send a value in reserve waiting for not implementting waiting status
+ if ($diffBranchReturned) {
+ $diffBranchSend = $diffBranchReturned;
+ }
+ else {
+ $diffBranchSend = undef;
+ }
+
+ my $tobranchcd = ReserveWaiting( $item, $borrowernumber,$diffBranchSend);
+# check if we have other reservs for this document, if we have a return send the message of transfer
+ my ( $messages, $nextreservinfo ) = OtherReserves($item);
+
+ my $branchname = GetBranchName( $messages->{'transfert'} );
+ my ($borr) = getpatroninformation( \%env, $nextreservinfo, 0 );
my $borcnum = $borr->{'cardnumber'};
my $name =
- $borr->{'surname'} . " " . $borr->{'title'} . " " . $borr->{'firstname'};
+ $borr->{'surname'} . ", " . $borr->{'title'} . " " . $borr->{'firstname'};
my $slip = $query->param('resslip');
- printslip( \%env, $slip ); #removed by paul
- if ( $tobranchcd ne $branch ) {
+
+ if ( $messages->{'transfert'} ) {
$template->param(
- itemtitle => $iteminfo->{'title'},
- iteminfo => $iteminfo->{'author'},
- branchname => $branchname,
- name => $name,
- bornum => $borrnum,
- borcnum => $borcnum,
- diffbranch => 1
+ itemtitle => $iteminfo->{'title'},
+ iteminfo => $iteminfo->{'author'},
+ tobranchname => $branchname,
+ name => $name,
+ borrowernumber => $borrowernumber,
+ borcnum => $borcnum,
+ borfirstname => $borr->{'firstname'},
+ borsurname => $borr->{'surname'},
+ diffbranch => 1
);
}
}
# actually return book and prepare item table.....
if ($barcode) {
-
# decode cuecat
$barcode = cuecatbarcodedecode($barcode);
( $returned, $messages, $iteminformation, $borrower ) =
- returnbook( $barcode, $branch );
+ returnbook( $barcode, C4::Context->userenv->{'branch'} );
if ($returned) {
$returneditems{0} = $barcode;
$riborrowernumber{0} = $borrower->{'borrowernumber'};
$riduedate{0} = $iteminformation->{'date_due'};
my %input;
- $input{counter} = 0;
- $input{first} = 1;
- $input{barcode} = $barcode;
- $input{duedate} = $riduedate{0};
- $input{bornum} = $riborrowernumber{0};
- push ( @inputloop, \%input );
+ $input{counter} = 0;
+ $input{first} = 1;
+ $input{barcode} = $barcode;
+ $input{duedate} = $riduedate{0};
+ $input{borrowernumber} = $riborrowernumber{0};
+ push( @inputloop, \%input );
+
+ # check if the branch is the same as homebranch
+ # if not, we want to put a message
+ if ( $iteminformation->{'homebranch'} ne C4::Context->userenv->{'branch'} ) {
+ $template->param( homebranch => $iteminformation->{'homebranch'} );
+ }
}
elsif ( !$messages->{'BadBarcode'} ) {
- if ( $messages->{'NotIssued'} ) {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select duetime from reserveissue where itemnumber=? and isnull(rettime)");
- $sth->execute($iteminformation->{'itemnumber'});
- my ($date_due) = $sth->fetchrow;
-
- $sth->finish;
- if ($date_due){
-# $messages->{'ReserveIssued'} =$barcode;
- print $query->redirect("/cgi-bin/koha/circ/resreturns.pl?barcode=$barcode");
- }
- }
my %input;
$input{counter} = 0;
$input{first} = 1;
$returneditems{0} = $barcode;
$riduedate{0} = 0;
if ( $messages->{'wthdrawn'} ) {
- $input{withdrawn} = 1;
- $input{bornum} = "Item Cancelled";
- $riborrowernumber{0} = 'Item Cancelled';
+ $input{withdrawn} = 1;
+ $input{borrowernumber} = "Item Cancelled";
+ $riborrowernumber{0} = 'Item Cancelled';
}
else {
- $input{bornum} = " ";
+ $input{borrowernumber} = " ";
$riborrowernumber{0} = ' ';
}
- push ( @inputloop, \%input );
+ push( @inputloop, \%input );
}
$template->param(
returned => $returned,
my $waiting = 0;
my $reserved = 0;
-if ( $messages->{'ResFound'} ) {
+# new op dev : we check if the document must be returned to his homebranch directly,
+# if the document is transfered, we have warning message .
+
+if ( $messages->{'WasTransfered'} ) {
+
+ my ($iteminfo) = getiteminformation( 0, $barcode );
+
+ $template->param(
+ found => 1,
+ transfer => 1,
+ itemhomebranch =>
+ $branches->{ $iteminfo->{'homebranch'} }->{'branchname'}
+ );
+
+}
+
+# adding a case of wrong transfert, if the document wasn't transfered in the good library (according to branchtransfer (tobranch) BDD)
+
+if ( $messages->{'WrongTransfer'} and not $messages->{'WasTransfered'}) {
+ $template->param(
+ WrongTransfer => 1,
+ TransferWaitingAt => $messages->{'WrongTransfer'},
+ WrongTransferItem => $messages->{'WrongTransferItem'},
+ );
+
my $res = $messages->{'ResFound'};
my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
my $name =
$borr->{'surname'} . " " . $borr->{'title'} . " " . $borr->{'firstname'};
- my ($iteminfo) = getiteminformation( \%env, 0, $barcode );
+ my ($iteminfo) = getiteminformation( 0, $barcode );
+
+ $template->param(
+ wname => $name,
+ wborfirstname => $borr->{'firstname'},
+ wborsurname => $borr->{'surname'},
+ wbortitle => $borr->{'title'},
+ wborphone => $borr->{'phone'},
+ wboremail => $borr->{'emailaddress'},
+ wborstraddress => $borr->{'streetaddress'},
+ wborcity => $borr->{'city'},
+ wborzip => $borr->{'zipcode'},
+ wborrowernumber => $res->{'borrowernumber'},
+ wborcnum => $borr->{'cardnumber'},
+ witemtitle => $iteminfo->{'title'},
+ witemauthor => $iteminfo->{'author'},
+ witembarcode => $iteminfo->{'barcode'},
+ witemtype => $iteminfo->{'itemtype'},
+ wccode => $iteminfo->{'ccode'},
+ witembiblionumber => $iteminfo->{'biblionumber'},
+ wtransfertFrom => C4::Context->userenv->{'branch'},
+ );
+}
+
+
+if ( $messages->{'ResFound'} and not $messages->{'WrongTransfer'}) {
+ my $res = $messages->{'ResFound'};
+ my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
+ my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
+ my $name =
+ $borr->{'surname'} . " " . $borr->{'title'} . " " . $borr->{'firstname'};
+ my ($iteminfo) = getiteminformation( 0, $barcode );
if ( $res->{'ResFound'} eq "Waiting" ) {
+ if ( C4::Context->userenv->{'branch'} eq $res->{'branchcode'} ) {
+ $template->param( waiting => 1 );
+ }
+ else {
+ $template->param( waiting => 0 );
+ }
+
$template->param(
- found => 1,
- name => $name,
- borfirstname => $borr->{'firstname'},
- borsurname => $borr->{'surname'},
- bortitle => $borr->{'title'},
- borphone => $borr->{'phone'},
- borstraddress => $borr->{'streetaddress'},
- borcity => $borr->{'city'},
- borzip => $borr->{'zipcode'},
- bornum => $res->{'borrowernumber'},
- borcnum => $borr->{'cardnumber'},
- branchname => $branches->{ $res->{'branchcode'} }->{'branchname'},
- waiting => 1,
- itemnumber => $res->{'itemnumber'},
- itemtitle => $iteminfo->{'title'},
- itemauthor => $iteminfo->{'author'},
- itembarcode => $iteminfo->{'barcode'},
- itemtype => $iteminfo->{'itemtype'},
+ found => 1,
+ name => $name,
+ borfirstname => $borr->{'firstname'},
+ borsurname => $borr->{'surname'},
+ bortitle => $borr->{'title'},
+ borphone => $borr->{'phone'},
+ boremail => $borr->{'emailaddress'},
+ borstraddress => $borr->{'streetaddress'},
+ borcity => $borr->{'city'},
+ borzip => $borr->{'zipcode'},
+ borrowernumber => $res->{'borrowernumber'},
+ borcnum => $borr->{'cardnumber'},
+ debarred => $borr->{'debarred'},
+ gonenoaddress => $borr->{'gonenoaddress'},
+ currentbranch => $branches->{C4::Context->userenv->{'branch'}}->{'branchname'},
+ itemnumber => $res->{'itemnumber'},
+ itemtitle => $iteminfo->{'title'},
+ itemauthor => $iteminfo->{'author'},
+ itembarcode => $iteminfo->{'barcode'},
+ itemtype => $iteminfo->{'itemtype'},
+ ccode => $iteminfo->{'ccode'},
itembiblionumber => $iteminfo->{'biblionumber'}
);
}
if ( $res->{'ResFound'} eq "Reserved" ) {
-
+ my @da = localtime( time() );
+ my $todaysdate =
+ sprintf( "%0.2d", ( $da[3] + 1 ) ) . "/"
+ . sprintf( "%0.2d", ( $da[4] + 1 ) ) . "/"
+ . ( $da[5] + 1900 );
+
+ if ( C4::Context->userenv->{'branch'} eq $res->{'branchcode'} ) {
+ $template->param( intransit => 0 );
+ }
+ else {
+ $template->param( intransit => 1 );
+ }
+
$template->param(
- found => 1,
- branchname => $branches->{ $res->{'branchcode'} }->{'branchname'},
- reserved => 1,
- today =>format_date( $todaysdate),
- itemnumber => $res->{'itemnumber'},
- itemtitle => $iteminfo->{'title'},
- itemauthor => $iteminfo->{'author'},
- itembarcode => $iteminfo->{'barcode'},
- itemtype => $iteminfo->{'itemtype'},
+ found => 1,
+ currentbranch => $branches->{C4::Context->userenv->{'branch'}}->{'branchname'},
+ name => $name,
+ destbranchname =>
+ $branches->{ $res->{'branchcode'} }->{'branchname'},
+ destbranch => $res->{'branchcode'},
+ transfertodo => ( C4::Context->userenv->{'branch'} eq $res->{'branchcode'} ? 0 : 1 ),
+ reserved => 1,
+ today => $todaysdate,
+ itemnumber => $res->{'itemnumber'},
+ itemtitle => $iteminfo->{'title'},
+ itemauthor => $iteminfo->{'author'},
+ itembarcode => $iteminfo->{'barcode'},
+ itemtype => $iteminfo->{'itemtype'},
+ ccode => $iteminfo->{'ccode'},
itembiblionumber => $iteminfo->{'biblionumber'},
borsurname => $borr->{'surname'},
bortitle => $borr->{'title'},
borfirstname => $borr->{'firstname'},
- bornum => $res->{'borrowernumber'},
+ borrowernumber => $res->{'borrowernumber'},
borcnum => $borr->{'cardnumber'},
borphone => $borr->{'phone'},
borstraddress => $borr->{'streetaddress'},
borsub => $borr->{'suburb'},
borcity => $borr->{'city'},
borzip => $borr->{'zipcode'},
- boremail => $borr->{'emailadress'},
+ boremail => $borr->{'emailaddress'},
+ debarred => $borr->{'debarred'},
+ gonenoaddress => $borr->{'gonenoaddress'},
barcode => $barcode
);
}
elsif ( $code eq 'WasTransfered' ) {
; # FIXME... anything to do here?
}
- elsif ( $code eq 'ReserveIssued' ) {
- $err{reserveissued} = 1;
- }
elsif ( $code eq 'wthdrawn' ) {
$err{withdrawn} = 1;
$exit_required_p = 1;
}
elsif ( ( $code eq 'IsPermanent' ) && ( not $messages->{'ResFound'} ) ) {
- if ( $messages->{'IsPermanent'} ne $branch ) {
+ if ( $messages->{'IsPermanent'} ne C4::Context->userenv->{'branch'} ) {
$err{ispermanent} = 1;
$err{msg} =
$branches->{ $messages->{'IsPermanent'} }->{'branchname'};
}
}
+ elsif ( $code eq 'WrongTransfer' ) {
+ ; # FIXME... anything to do here?
+ }
+ elsif ( $code eq 'WrongTransferItem' ) {
+ ; # FIXME... anything to do here?
+ }
else {
die "Unknown error code $code"; # XXX
}
if (%err) {
- push ( @errmsgloop, \%err );
+ push( @errmsgloop, \%err );
}
last if $exit_required_p;
}
# patrontable ....
if ($borrower) {
my $flags = $borrower->{'flags'};
- my $color = '';
my @flagloop;
my $flagset;
foreach my $flag ( sort keys %$flags ) {
my %flaginfo;
- ( $color eq $linecolor1 )
- ? ( $color = $linecolor2 )
- : ( $color = $linecolor1 );
unless ($flagset) { $flagset = 1; }
- $flaginfo{color} = $color;
$flaginfo{redfont} = ( $flags->{$flag}->{'noissues'} );
$flaginfo{flag} = $flag;
if ( $flag eq 'CHARGES' ) {
- $flaginfo{msg} = $flag;
- $flaginfo{charges} = 1;
- $flaginfo{bornum} = $borrower->{borrowernumber};
+ $flaginfo{msg} = $flag;
+ $flaginfo{charges} = 1;
+ $flaginfo{borrowernumber} = $borrower->{borrowernumber};
}
elsif ( $flag eq 'WAITING' ) {
$flaginfo{msg} = $flag;
my $items = $flags->{$flag}->{'itemlist'};
foreach my $item (@$items) {
my ($iteminformation) =
- getiteminformation( \%env, $item->{'itemnumber'}, 0 );
+ getiteminformation( $item->{'itemnumber'}, 0 );
my %waitingitem;
$waitingitem{biblionum} = $iteminformation->{'biblionumber'};
$waitingitem{barcode} = $iteminformation->{'barcode'};
$waitingitem{title} = $iteminformation->{'title'};
$waitingitem{brname} =
- $branches->{ $iteminformation->{'holdingbranch'} }->{
- 'branchname'};
- push ( @waitingitemloop, \%waitingitem );
+ $branches->{ $iteminformation->{'holdingbranch'} }
+ ->{'branchname'};
+ push( @waitingitemloop, \%waitingitem );
}
$flaginfo{itemloop} = \@waitingitemloop;
}
@$items )
{
my ($iteminformation) =
- getiteminformation( \%env, $item->{'itemnumber'}, 0 );
+ getiteminformation( $item->{'itemnumber'}, 0 );
my %overdueitem;
- $overdueitem{duedate} = $item->{'date_due'};
+ $overdueitem{duedate} = format_date( $item->{'date_due'} );
$overdueitem{biblionum} = $iteminformation->{'biblionumber'};
$overdueitem{barcode} = $iteminformation->{'barcode'};
$overdueitem{title} = $iteminformation->{'title'};
$overdueitem{brname} =
- $branches->{ $iteminformation->{'holdingbranch'} }->{
- 'branchname'};
- push ( @itemloop, \%overdueitem );
+ $branches->{ $iteminformation->{'holdingbranch'} }
+ ->{'branchname'};
+ push( @itemloop, \%overdueitem );
}
$flaginfo{itemloop} = \@itemloop;
$flaginfo{overdue} = 1;
$flaginfo{other} = 1;
$flaginfo{msg} = $flags->{$flag}->{'message'};
}
- push ( @flagloop, \%flaginfo );
+ push( @flagloop, \%flaginfo );
}
$template->param(
- flagset => $flagset,
- flagloop => \@flagloop,
- ribornum => $borrower->{'borrowernumber'},
- riborcnum => $borrower->{'cardnumber'},
- riborsurname => $borrower->{'surname'},
- ribortitle => $borrower->{'title'},
- riborfirstname => $borrower->{'firstname'}
+ flagset => $flagset,
+ flagloop => \@flagloop,
+ riborrowernumber => $borrower->{'borrowernumber'},
+ riborcnum => $borrower->{'cardnumber'},
+ riborsurname => $borrower->{'surname'},
+ ribortitle => $borrower->{'title'},
+ riborfirstname => $borrower->{'firstname'}
);
}
-my $color = '';
-
#set up so only the last 8 returned items display (make for faster loading pages)
my $count = 0;
my @riloop;
foreach ( sort { $a <=> $b } keys %returneditems ) {
my %ri;
if ( $count < 8 ) {
- ( $color eq $linecolor1 )
- ? ( $color = $linecolor2 )
- : ( $color = $linecolor1 );
- $ri{color} = $color;
my $barcode = $returneditems{$_};
my $duedate = $riduedate{$_};
my $overduetext;
my $borrowerinfo;
if ($duedate) {
-
-
- $ri{duedate}=format_date($duedate);
+ my @tempdate = split( /-/, $duedate );
+ $ri{year} = $tempdate[0];
+ $ri{month} = $tempdate[1];
+ $ri{day} = $tempdate[2];
+ my $duedatenz = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
+ my @datearr = localtime( time() );
+ my $todaysdate =
+ $datearr[5] . '-'
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-'
+ . sprintf( "%0.2d", $datearr[3] );
+ $ri{duedate} = format_date($duedate);
my ($borrower) =
getpatroninformation( \%env, $riborrowernumber{$_}, 0 );
- $ri{bornum} = $borrower->{'borrowernumber'};
- $ri{borcnum} = $borrower->{'cardnumber'};
- $ri{borfirstname} = $borrower->{'firstname'};
- $ri{borsurname} = $borrower->{'surname'};
- $ri{bortitle} = $borrower->{'title'};
+ $ri{borrowernumber} = $borrower->{'borrowernumber'};
+ $ri{borcnum} = $borrower->{'cardnumber'};
+ $ri{borfirstname} = $borrower->{'firstname'};
+ $ri{borsurname} = $borrower->{'surname'};
+ $ri{bortitle} = $borrower->{'title'};
}
else {
- $ri{bornum} = $riborrowernumber{$_};
+ $ri{borrowernumber} = $riborrowernumber{$_};
}
-# my %ri;
- my ($iteminformation) = getiteminformation( \%env, 0, $barcode );
- $ri{color} = $color;
+
+ # my %ri;
+ my ($iteminformation) = getiteminformation( 0, $barcode );
$ri{itembiblionumber} = $iteminformation->{'biblionumber'};
$ri{itemtitle} = $iteminformation->{'title'};
$ri{itemauthor} = $iteminformation->{'author'};
$ri{itemtype} = $iteminformation->{'itemtype'};
+ $ri{ccode} = $iteminformation->{'ccode'};
$ri{barcode} = $barcode;
}
else {
last;
}
$count++;
- push ( @riloop, \%ri );
+ push( @riloop, \%ri );
}
$template->param( riloop => \@riloop );
$template->param(
- genbrname => $branches->{$branch}->{'branchname'},
- genprname => $printers->{$printer}->{'printername'},
- branch => $branch,
- printer => $printer,
- errmsgloop => \@errmsgloop
+ genbrname => $branches->{C4::Context->userenv->{'branch'}}->{'branchname'},
+ genprname => $printers->{$printer}->{'printername'},
+ branchname => $branches->{C4::Context->userenv->{'branch'}}->{'branchname'},
+ printer => $printer,
+ errmsgloop => \@errmsgloop,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
);
# actually print the page!
sub cuecatbarcodedecode {
my ($barcode) = @_;
chomp($barcode);
- my @fields = split ( /\./, $barcode );
+ my @fields = split( /\./, $barcode );
my @results = map( decode($_), @fields[ 1 .. $#fields ] );
if ( $#results == 2 ) {
return $results[2];
return $barcode;
}
}
-
-# Local Variables:
-# tab-width: 4
-# End:
#!/usr/bin/perl
-# WARNING: This file uses 4-character tabs!
-
# Copyright 2000-2002 Katipo Communications
#
use C4::Auth;
use C4::Print;
use C4::Interface::CGI::Output;
-use HTML::Template;
-use DBI;
use C4::Koha;
-
+use C4::Branch; # GetBranches
# this is a reorganisation of circulationold.pl
# dividing it up into three scripts......
# this will be the first one that chooses branch and printer settings....
#general design stuff...
-my $headerbackgroundcolor='#99cc33';
-my $circbackgroundcolor='#ffffcc';
-my $circbackgroundcolor='white';
-my $linecolor1='#ffffcc';
-my $linecolor2='white';
-my $backgroundimage="/images/background-mem.gif";
# try to get the branch and printer settings from the http....
my %env;
-my $query=new CGI;
-my $branches=GetBranches('IS');
-my $printers=getprinters(\%env);
-my $branch=$query->param('branch');
-my $printer=$query->param('printer');
+my $query = new CGI;
+my $branches = GetBranches();
+my $printers = GetPrinters( \%env );
+my $branch = $query->param('branch');
+my $printer = $query->param('printer');
-($branch) || ($branch=$query->cookie('branch'));
-($printer) || ($printer=$query->cookie('printer'));
-
-($branches->{$branch}) || ($branch=(keys %$branches)[0]);
-($printers->{$printer}) || ($printer=(keys %$printers)[0]);
+my %cookie = $query->cookie('userenv');
+($branch) || ( $branch = $cookie{'branch'} );
+($printer) || ( $printer = $cookie{'printer'} );
+( $branches->{$branch} ) || ( $branch = ( keys %$branches )[0] );
+( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
# is you force a selection....
-my $oldbranch = $branch;
+my $oldbranch = $branch;
my $oldprinter = $printer;
-#$branch='';
-#$printer='';
-
-
-$env{'branchcode'}=$branch;
-$env{'printer'}=$printer;
-$env{'queue'}=$printer;
+$env{'branchcode'} = $branch;
+$env{'printer'} = $printer;
+$env{'queue'} = $printer;
# set up select options....
-my $branchcount=0;
-my $printercount=0;
+my $branchcount = 0;
+my $printercount = 0;
my @branchloop;
-foreach my $br (keys %$branches) {
- next unless $br =~ /\S/;
- #(next) unless ($branches->{$_}->{'IS'}); # FIXME disabled to fix bug 202
+foreach my $br ( keys %$branches ) {
+ next unless $br =~ /\S/; # next unless $br is not blank.
+
$branchcount++;
- my %branch;
- $branch{selected}=($br eq $oldbranch);
- $branch{name}=$branches->{$br}->{'branchname'};
- $branch{value}=$br;
- push(@branchloop,\%branch);
+ my %branch;
+ $branch{selected} = ( $br eq $oldbranch );
+ $branch{name} = $branches->{$br}->{'branchname'};
+ $branch{value} = $br;
+ push( @branchloop, \%branch );
}
my @printerloop;
-foreach (keys %$printers) {
- (next) unless ($_);
+foreach ( keys %$printers ) {
+ (next) unless ($_); # next unless if this printer is blank.
$printercount++;
- my %printer;
- $printer{selected}=($_ eq $oldprinter);
- $printer{name}=$printers->{$_}->{'printername'};
- $printer{value}=$_;
- push(@printerloop,\%printer);
+ my %printer;
+ $printer{selected} = ( $_ eq $oldprinter );
+ $printer{name} = $printers->{$_}->{'printername'};
+ $printer{value} = $_;
+ push( @printerloop, \%printer );
}
# if there is only one....
my $printername;
my $branchname;
-my $oneprinter=($printercount==1) ;
-my $onebranch=($branchcount==1) ;
-if ($printercount==1) {
- my ($tmpprinter)=keys %$printers;
- $printername=$printers->{$tmpprinter}->{printername};
+my $oneprinter = ( $printercount == 1 );
+my $onebranch = ( $branchcount == 1 );
+if ( $printercount == 1 ) {
+ my ($tmpprinter) = keys %$printers;
+ $printername = $printers->{$tmpprinter}->{printername};
}
-if ($branchcount==1) {
- my ($tmpbranch)=keys %$branches;
- $branchname=$branches->{$tmpbranch}->{branchname};
+if ( $branchcount == 1 ) {
+ my ($tmpbranch) = keys %$branches;
+ $branchname = $branches->{$tmpbranch}->{branchname};
}
-
-#############################################################################################
+################################################################################
# Start writing page....
# set header with cookie....
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "circ/selectbranchprinter.tmpl",
- query => $query,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {circulate => 1},
- });
-$template->param(headerbackgroundcolor => $headerbackgroundcolor,
- backgroundimage => $backgroundimage,
- oneprinter => $oneprinter,
- onebranch => $onebranch,
- printername => $printername,
- branchname => $branchname,
- printerloop => \@printerloop,
- branchloop => \@branchloop,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
-
-my $branchcookie=$query->cookie(-name => 'branch', -value => "$branch", -expires => '+1y');
-my $printercookie=$query->cookie(-name => 'printer', -value => "$printer", -expires => '+1y');
-
-my $cookies=[$cookie,$branchcookie, $printercookie];
-output_html_with_http_headers $query, $cookies, $template->output;
-
-
-# Local Variables:
-# tab-width: 4
-# End:
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/selectbranchprinter.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ }
+);
+$template->param(
+ oneprinter => $oneprinter,
+ onebranch => $onebranch,
+ printername => $printername,
+ branchname => $branchname,
+ printerloop => \@printerloop,
+ branchloop => \@branchloop,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+
+output_html_with_http_headers $query, $cookie, $template->output;
use C4::Context;
use C4::Output;
use CGI;
-use HTML::Template;
+use C4::Branch; # GetBranches
use C4::Auth;
use C4::Date;
use C4::Circulation::Circ2;
-use Date::Manip;
+use Date::Calc qw(
+ Today
+ Add_Delta_YM
+ Date_to_Days
+);
use C4::Koha;
use C4::Biblio;
my $input = new CGI;
-my $theme = $input->param('theme'); # only used if allowthemeoverride is set
-
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "circ/waitingreservestransfers.tmpl",
- query => $input,
- type => "intranet",
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
- debug => 1,
- });
+my $theme = $input->param('theme'); # only used if allowthemeoverride is set
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "circ/waitingreservestransfers.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ debug => 1,
+ }
+);
# set the userenv branch
my $default = C4::Context->userenv->{'branch'};
+my @datearr = localtime( time() );
+my $todaysdate =
+ ( 1900 + $datearr[5] ) . '-'
+ . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) . '-'
+ . sprintf( "%0.2d", $datearr[3] );
-my @datearr = localtime(time());
-my $todaysdate = (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.sprintf ("%0.2d", $datearr[3]);
+my $item = $input->param('itemnumber');
+my $fbr = $input->param('fbr');
+my $tbr = $input->param('tbr');
-my $item=$input->param('itemnumber');
-my $fbr=$input->param('fbr');
-my $tbr=$input->param('tbr');
# If we have a return of the form dotransfer, we launch the subroutine dotransfer
-if ($item){
- C4::Circulation::Circ2::dotransfer($item,$fbr,$tbr);
+if ($item) {
+ C4::Circulation::Circ2::dotransfer( $item, $fbr, $tbr );
}
# get the all the branches for reference
my $branches = GetBranches();
+
my @branchesloop;
-foreach my $br (keys %$branches) {
- my @reservloop;
- my %branchloop;
- $branchloop{'branchname'} = $branches->{$br}->{'branchname'};
- $branchloop{'branchcode'} = $branches->{$br}->{'branchcode'};
- my @getreserves = GetReservesToBranch($branches->{$br}->{'branchcode'},$default);
- if (@getreserves){
- foreach my $num (@getreserves) {
- my %getreserv;
- my %env;
- my $gettitle = getiteminformation(\%env,$num->{'itemnumber'});
- my $itemtypeinfo = getitemtypeinfo($gettitle->{'itemtype'});
- if ($gettitle->{'holdingbranch'} eq $default){
- my $getborrower = getpatroninformation (\%env,$num->{'borrowernumber'});
- $getreserv{'reservedate'} = format_date($num->{'reservedate'});
- my $calcDate=DateCalc($num->{'reservedate'},"+".C4::Context->preference('TransfersMaxDaysWarning')." days");
- my $warning=Date_Cmp(ParseDate("today"),$calcDate);
- if ($warning>0){
- $getreserv{'messcompa'} = 1;
- }
- $getreserv{'title'} = $gettitle->{'title'};
- $getreserv{'biblionumber'} = $gettitle->{'biblionumber'};
- $getreserv{'itemnumber'} = $gettitle->{'itemnumber'};
- $getreserv{'barcode'} = $gettitle->{'barcode'};
- $getreserv{'itemtype'} = $itemtypeinfo->{'description'};
- $getreserv{'holdingbranch'} = $gettitle->{'holdingbranch'};
- $getreserv{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
- $getreserv{'borrowernum'} = $getborrower->{'borrowernumber'};
- $getreserv{'borrowername'} = $getborrower->{'surname'};
- $getreserv{'borrowerfirstname'} = $getborrower->{'firstname'} ;
- if ($getborrower->{'emailaddress'}){
- $getreserv{'borrowermail'} = $getborrower->{'emailaddress'} ;
- }
- $getreserv{'borrowerphone'} = $getborrower->{'phone'};
- push(@reservloop, \%getreserv);
- }
- }
-# If we have a return of reservloop we put it in the branchloop sequence
- if (@reservloop){
- $branchloop{'reserv'} = \@reservloop ;
- }
-# else, we unset the value of the branchcode .
- else{
- $branchloop{'branchcode'} = 0;
- }
- }
- else {
+foreach my $br ( keys %$branches ) {
+ my @reservloop;
+ my %branchloop;
+ $branchloop{'branchname'} = $branches->{$br}->{'branchname'};
+ $branchloop{'branchcode'} = $branches->{$br}->{'branchcode'};
+
+ # warn " branch=>".$branches->{$br}->{'branchcode'};
+ my @getreserves =
+ GetReservesToBranch( $branches->{$br}->{'branchcode'}, $default );
+ if (@getreserves) {
+ foreach my $num (@getreserves) {
+ my %getreserv;
+ my %env;
+ my $gettitle = getiteminformation( $num->{'itemnumber'} );
+ my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
+ if ( $gettitle->{'holdingbranch'} eq $default ) {
+ my $getborrower =
+ getpatroninformation( \%env, $num->{'borrowernumber'} );
+ $getreserv{'reservedate'} =
+ format_date( $num->{'reservedate'} );
+
+#my $calcDate=DateCalc($num->{'reservedate'},"+".C4::Context->preference('TransfersMaxDaysWarning')." days");
+#my $warning=Date_Cmp(ParseDate("today"),$calcDate);
+
+ my ( $reserve_year, $reserve_month, $reserve_day ) = split /-/,
+ $num->{'reservedate'};
+ ( $reserve_year, $reserve_month, $reserve_day ) =
+ Add_Delta_YM( $reserve_year, $reserve_month, $reserve_day,
+ C4::Context->preference('ReservesMaxPickUpDelay'), 0 );
+ my $calcDate =
+ Date_to_Days( $reserve_year, $reserve_month, $reserve_day );
+ my $today = Date_to_Days(&Today);
+ my $warning = ( $today > $calcDate );
+
+ if ( $warning > 0 ) {
+ $getreserv{'messcompa'} = 1;
+ }
+ $getreserv{'title'} = $gettitle->{'title'};
+ $getreserv{'biblionumber'} = $gettitle->{'biblionumber'};
+ $getreserv{'itemnumber'} = $gettitle->{'itemnumber'};
+ $getreserv{'barcode'} = $gettitle->{'barcode'};
+ $getreserv{'itemtype'} = $itemtypeinfo->{'description'};
+ $getreserv{'holdingbranch'} = $gettitle->{'holdingbranch'};
+ $getreserv{'itemcallnumber'} = $gettitle->{'itemcallnumber'};
+ $getreserv{'borrowernum'} = $getborrower->{'borrowernumber'};
+ $getreserv{'borrowername'} = $getborrower->{'surname'};
+ $getreserv{'borrowerfirstname'} = $getborrower->{'firstname'};
+
+ if ( $getborrower->{'emailaddress'} ) {
+ $getreserv{'borrowermail'} = $getborrower->{'emailaddress'};
+ }
+ $getreserv{'borrowerphone'} = $getborrower->{'phone'};
+ push( @reservloop, \%getreserv );
+ }
+ }
+
+ # If we have a return of reservloop we put it in the branchloop sequence
+ if (@reservloop) {
+ $branchloop{'reserv'} = \@reservloop;
+ }
+
+ # else, we unset the value of the branchcode .
+ else {
+ $branchloop{'branchcode'} = 0;
+ }
+ }
+ else {
+
# if we don't have a retrun from reservestobranch we unset branchname and branchcode
- $branchloop{'branchname'} = 0;
- $branchloop{'branchcode'} = 0;
- }
- push(@branchesloop, \%branchloop);
+ $branchloop{'branchname'} = 0;
+ $branchloop{'branchcode'} = 0;
+ }
+ push( @branchesloop, \%branchloop );
}
- $template->param( branchesloop => \@branchesloop,
- show_date => format_date($todaysdate)
- );
-
- print "Content-Type: text/html\n\n", $template->output;
-
+$template->param(
+ branchesloop => \@branchesloop,
+ show_date => format_date($todaysdate)
+);
+print "Content-Type: text/html\n\n", $template->output;
projects / koha_gimpoz / commitdiff