[Koha-cvs] CVS: koha/C4 Acquisition.pm,1.1,1.2 Suggestions.pm,1.1,1.2
Paul POULAIN
tipaul at users.sourceforge.net
Thu Jul 15 11:41:06 CEST 2004
- Previous message: [Koha-cvs] CVS: koha/opac opac-userdetails.pl,1.7,1.8
- Next message: [Koha-cvs] CVS: koha/acqui suggestion-select.pl,NONE,1.1 addorder.pl,1.19,1.20 basket.pl,1.18,1.19 newbiblio.pl,1.18,1.19 order.pl,1.11,1.12
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29334/C4
Modified Files:
Acquisition.pm Suggestions.pm
Log Message:
Acquisition & Suggestion :
* acquisition rewritte : create a aqbasket table to deal with "bookseller order header".
* add "close basket" feature : a closed basket can't be modified
* suggestion feature : manage suggestions in acquisition (after suggestion filled in OPAC)
Index: Acquisition.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Acquisition.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** Acquisition.pm 13 Jul 2004 12:52:13 -0000 1.1
--- Acquisition.pm 15 Jul 2004 09:41:03 -0000 1.2
***************
*** 1,11 ****
! package C4::Catalogue;
!
! # Continue working on updateItem!!!!!!
! #
! # updateItem is looking not bad. Need to add addSubfield and deleteSubfield
! # functions
! #
! # Trying to track down $dbh's that aren't disconnected....
!
# Copyright 2000-2002 Katipo Communications
--- 1,3 ----
! package C4::Acquisition;
# Copyright 2000-2002 Katipo Communications
***************
*** 30,34 ****
use C4::Context;
use MARC::Record;
! use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
--- 22,26 ----
use C4::Context;
use MARC::Record;
! # use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
***************
*** 39,47 ****
=head1 NAME
! C4::Catalogue - Koha functions for dealing with orders and acquisitions
=head1 SYNOPSIS
! use C4::Catalogue;
=head1 DESCRIPTION
--- 31,39 ----
=head1 NAME
! C4::Acquisition - Koha functions for dealing with orders and acquisitions
=head1 SYNOPSIS
! use C4::Acquisition;
=head1 DESCRIPTION
***************
*** 58,74 ****
@ISA = qw(Exporter);
@EXPORT = qw(
! &basket &newbasket
! &getorders &getallorders &getrecorders
! &getorder &neworder &delorder
! &ordersearch
! &modorder &getsingleorder &invoice &receiveorder
! &updaterecorder &newordernum
! &bookfunds &bookfundbreakdown &updatecost
! &curconvert &getcurrencies &updatecurrencies &getcurrency
! &findall &needsmod &branches &updatesup &insertsup
! &bookseller &breakdown &checkitems
);
--- 50,66 ----
@ISA = qw(Exporter);
@EXPORT = qw(
! &getbasket &getbasketcontent &newbasket &closebasket
! &getorders &getallorders &getrecorders
! &getorder &neworder &delorder
! &ordersearch
! &modorder &getsingleorder &invoice &receiveorder
! &updaterecorder &newordernum
! &bookfunds &curconvert &getcurrencies &bookfundbreakdown
! &updatecurrencies &getcurrency
! &branches &updatesup &insertsup
! &bookseller &breakdown
);
***************
*** 80,86 ****
#
#
! =item basket
! ($count, @orders) = &basket($basketnumber, $booksellerID);
Looks up the pending (non-cancelled) orders with the given basket
--- 72,93 ----
#
#
! =item getbasket
!
! $aqbasket = &getbasket($basketnumber);
! get all basket informations in aqbasket for a given basket
! =cut
!
! sub getbasket {
! my ($basketno)=@_;
! my $dbh=C4::Context->dbh;
! my $sth=$dbh->prepare("select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?");
! $sth->execute($basketno);
! return($sth->fetchrow_hashref);
! }
!
! =item getbasketcontent
!
! ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
Looks up the pending (non-cancelled) orders with the given basket
***************
*** 95,122 ****
=cut
#'
! sub basket {
! my ($basketno,$supplier)=@_;
! my $dbh = C4::Context->dbh;
! my $query="Select *,biblio.title from aqorders,biblio,biblioitems
! where basketno='$basketno'
! and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
! =aqorders.biblioitemnumber
! and (datecancellationprinted is NULL or datecancellationprinted =
! '0000-00-00')";
! if ($supplier ne ''){
! $query.=" and aqorders.booksellerid='$supplier'";
! }
! $query.=" order by biblioitems.publishercode";
! my $sth=$dbh->prepare($query);
! $sth->execute;
! my @results;
! # print $query;
! my $i=0;
! while (my $data=$sth->fetchrow_hashref){
! $results[$i]=$data;
! $i++;
! }
! $sth->finish;
! return($i, at results);
}
--- 102,129 ----
=cut
#'
! sub getbasketcontent {
! my ($basketno,$supplier)=@_;
! my $dbh = C4::Context->dbh;
! my $query="Select *,biblio.title from aqorders,biblio,biblioitems
! where basketno='$basketno'
! and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
! =aqorders.biblioitemnumber
! and (datecancellationprinted is NULL or datecancellationprinted =
! '0000-00-00')";
! if ($supplier ne ''){
! $query.=" and aqorders.booksellerid='$supplier'";
! }
! $query.=" order by biblioitems.publishercode";
! my $sth=$dbh->prepare($query);
! $sth->execute;
! my @results;
! # print $query;
! my $i=0;
! while (my $data=$sth->fetchrow_hashref){
! $results[$i]=$data;
! $i++;
! }
! $sth->finish;
! return($i, at results);
}
***************
*** 125,156 ****
$basket = &newbasket();
! Finds the next unused basket number in the aqorders table of the Koha
! database, and returns it.
!
=cut
! #'
! # FIXME - There's a race condition here:
! # A calls &newbasket
! # B calls &newbasket (gets the same number as A)
! # A updates the basket
! # B updates the basket, and clobbers A's result.
! # A better approach might be to create a dummy order (with, say,
! # requisitionedby == "Dummy-$$" or notes == "dummy <time> <pid>"), and
! # see which basket number it gets. Then have a cron job periodically
! # remove out-of-date dummy orders.
sub newbasket {
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("Select max(basketno) from aqorders");
! $sth->execute;
! my $data=$sth->fetchrow_arrayref;
! my $basket=$$data[0];
! $basket++;
! $sth->finish;
! return($basket);
}
=item neworder
! &neworder($biblionumber, $title, $ordnum, $basket, $quantity, $listprice,
$booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
$ecost, $gst, $budget, $unitprice, $subscription,
--- 132,164 ----
$basket = &newbasket();
! Create a new basket in aqbasket table
=cut
!
sub newbasket {
! my ($booksellerid,$authorisedby) = @_;
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
! #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
! my $basket = $dbh->{'mysql_insertid'};
! return($basket);
! }
!
! =item closebasket
!
! &newbasket($basketno);
!
! close a basket (becomes unmodifiable,except for recieves
! =cut
!
! sub closebasket {
! my ($basketno) = @_;
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
! $sth->execute($basketno);
}
=item neworder
! &neworder($basket, $biblionumber, $title, $quantity, $listprice,
$booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
$ecost, $gst, $budget, $unitprice, $subscription,
***************
*** 174,208 ****
#'
sub neworder {
! my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
! if ($budget eq 'now'){
! $budget="now()";
! } else {
! $budget="'2001-07-01'";
! }
! if ($sub eq 'yes'){
! $sub=1;
! } else {
! $sub=0;
! }
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("insert into aqorders (biblionumber,title,basketno,
! quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
! biblioitemnumber,rrp,ecost,gst,unitprice,subscription,booksellerinvoicenumber,sort1,sort2)
! values (?,?,?,?,?,?,now(),?,?,?,?,?,?,?,?,?,?,?,?)");
! $sth->execute($bibnum,$title,$basket,$quantity,$listprice,$supplier,
! $who,$who,$notes,$bibitemnum,$rrp,$ecost,$gst,$cost,
! $sub,$invoice,$sort1,$sort2);
! $sth->finish;
! $sth=$dbh->prepare("select * from aqorders where
! biblionumber=? and basketno=? and ordernumber >=?");
! $sth->execute($bibnum,$basket,$ordnum);
! my $data=$sth->fetchrow_hashref;
! $sth->finish;
! $ordnum=$data->{'ordernumber'};
! $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
! (?,?)");
! # print $query;
! $sth->execute($ordnum,$bookfund);
! $sth->finish;
}
--- 182,215 ----
#'
sub neworder {
! my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
! if ($budget eq 'now'){
! $budget="now()";
! } else {
! $budget="'2001-07-01'";
! }
! if ($sub eq 'yes'){
! $sub=1;
! } else {
! $sub=0;
! }
! # if $basket empty, it's also a new basket, create it
! unless ($basketno) {
! $basketno=newbasket($booksellerid,$authorisedby);
! }
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("insert into aqorders
! (biblionumber,title,basketno,quantity,listprice,notes,
! biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
! values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
! $sth->execute($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'};
! $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
! (?,?)");
! $sth->execute($ordnum,$bookfund);
! $sth->finish;
! return $basketno;
}
***************
*** 257,265 ****
quantity=?,listprice=?,basketno=?,
rrp=?,ecost=?,unitprice=?,
- booksellerinvoicenumber=?,
sort1=?, sort2=?
where
ordernumber=? and biblionumber=?");
! $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$sort1,$sort2,$ordnum,$bibnum);
$sth->finish;
$sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
--- 264,271 ----
quantity=?,listprice=?,basketno=?,
rrp=?,ecost=?,unitprice=?,
sort1=?, sort2=?
where
ordernumber=? and biblionumber=?");
! $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$sort1,$sort2,$ordnum,$bibnum);
$sth->finish;
$sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
***************
*** 393,410 ****
#'
sub getorders {
! my ($supplierid)=@_;
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("Select count(*),authorisedby,entrydate,basketno from aqorders where
! booksellerid=? and (quantity > quantityreceived or
! quantityreceived is NULL)
! and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')
! group by basketno order by entrydate desc");
! $sth->execute($supplierid);
! my @results = ();
! while (my $data=$sth->fetchrow_hashref){
! push(@results,$data);
! }
! $sth->finish;
! return (scalar(@results),\@results);
}
--- 399,415 ----
#'
sub getorders {
! my ($supplierid)=@_;
! my $dbh = C4::Context->dbh;
! my $sth=$dbh->prepare("Select count(*),authorisedby,creationdate,aqbasket.basketno,closedate from aqorders left join aqbasket on
! aqbasket.basketno=aqorders.basketno where booksellerid=? and (quantity > quantityreceived or
! quantityreceived is NULL)
! group by basketno order by aqbasket.basketno");
! $sth->execute($supplierid);
! my @results = ();
! while (my $data=$sth->fetchrow_hashref){
! push(@results,$data);
! }
! $sth->finish;
! return (scalar(@results),\@results);
}
***************
*** 421,427 ****
=cut
! #'
! # FIXME - This is effectively identical to &C4::Biblio::getorder.
! # Pick one and stick with it.
sub getorder{
my ($bi,$bib)=@_;
--- 426,430 ----
=cut
!
sub getorder{
my ($bi,$bib)=@_;
***************
*** 448,455 ****
=cut
! #'
! # FIXME - This is effectively identical to
! # &C4::Biblio::getsingleorder.
! # Pick one and stick with it.
sub getsingleorder {
my ($ordnum)=@_;
--- 451,455 ----
=cut
!
sub getsingleorder {
my ($ordnum)=@_;
***************
*** 660,665 ****
}
! # FIXME - POD. I can't figure out what this function is doing. Then
! # again, I don't think it's being used (anymore).
sub bookfundbreakdown {
my ($id)=@_;
--- 660,670 ----
}
! =item bookfundbreakdown
!
! returns the total comtd & spent for a given bookfund
! used in acqui-home.pl
! =cut
! #'
!
sub bookfundbreakdown {
my ($id)=@_;
***************
*** 686,689 ****
--- 691,696 ----
}
+
+
=item curconvert
***************
*** 751,763 ****
}
- # FIXME - This is never used
- sub updatecost{
- my($price,$rrp,$itemnum)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("update items set price=?,replacementprice=? where itemnumber=?");
- $sth->execute($price,$rrp,$itemnum);
- $sth->finish;
- }
-
#
#
--- 758,761 ----
***************
*** 843,879 ****
} # sub branches
- # FIXME - Never used
- sub findall {
- my ($biblionumber)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from biblioitems,items,itemtypes where
- biblioitems.biblionumber=?
- and biblioitems.biblioitemnumber=items.biblioitemnumber and
- itemtypes.itemtype=biblioitems.itemtype
- order by items.biblioitemnumber");
- $sth->execute($biblionumber);
- my @results;
- while (my $data=$sth->fetchrow_hashref){
- push(@results,$data);
- }
- $sth->finish;
- return(@results);
- }
-
- # FIXME - Never used
- sub needsmod{
- my ($bibitemnum,$itemtype)=@_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from biblioitems where biblioitemnumber=?
- and itemtype=?");
- $sth->execute($bibitemnum,$itemtype);
- my $result=0;
- if (my $data=$sth->fetchrow_hashref){
- $result=1;
- }
- $sth->finish;
- return($result);
- }
-
=item updatesup
--- 841,844 ----
***************
*** 912,916 ****
$data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
$sth->finish;
- # print $query;
}
--- 877,880 ----
Index: Suggestions.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Suggestions.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** Suggestions.pm 28 May 2004 08:28:22 -0000 1.1
--- Suggestions.pm 15 Jul 2004 09:41:03 -0000 1.2
***************
*** 24,27 ****
--- 24,29 ----
use DBI;
use C4::Context;
+ use C4::Output;
+ # use C4::Interface::CGI::Output;
use vars qw($VERSION @ISA @EXPORT);
***************
*** 58,62 ****
--- 60,67 ----
@EXPORT = qw( &newsuggestion
&searchsuggestion
+ &getsuggestion
&delsuggestion
+ &countsuggestion
+ &changestatus
);
***************
*** 82,88 ****
U1.surname as surnamesuggestedby,U1.firstname as firstnamesuggestedby,
U2.surname as surnamemanagedby,U2.firstname as firstnamemanagedby
! from suggestions,borrowers as U1
left join borrowers as U2 on managedby=U2.borrowernumber
! where suggestedby=U1.borrowernumber";
my @sql_params;
if ($author) {
--- 87,94 ----
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 1=1";
my @sql_params;
if ($author) {
***************
*** 126,146 ****
sub newsuggestion {
! my ($borrowernumber,$title,$author,$publishercode,$note) = @_;
my $dbh = C4::Context->dbh;
! my $sth = $dbh->prepare("insert into suggestions (suggestedby,title,author,publishercode,note) values (?,?,?,?,?)");
! $sth->execute($borrowernumber,$title,$author,$publishercode,$note);
}
sub delsuggestion {
! my ($borrowernumber,$suggestionnumber) = @_;
my $dbh = C4::Context->dbh;
# check that the suggestion comes from the suggestor
! my $sth = $dbh->prepare("select suggestedby from suggestions where suggestionnumber=?");
! $sth->execute($suggestionnumber);
my ($suggestedby) = $sth->fetchrow;
if ($suggestedby eq $borrowernumber) {
! $sth = $dbh->prepare("delete from suggestions where suggestionnumber=?");
! $sth->execute($suggestionnumber);
}
}
--- 132,206 ----
sub newsuggestion {
! my ($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn) = @_;
my $dbh = C4::Context->dbh;
! my $sth = $dbh->prepare("insert into suggestions (status,suggestedby,title,author,publishercode,note,copyrightdate,volumedesc,publicationyear,place,isbn) values ('ASKED',?,?,?,?,?,?,?,?,?,?)");
! $sth->execute($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn);
! }
!
! sub getsuggestion {
! my ($suggestionid) = @_;
! my $dbh = C4::Context->dbh;
! my $sth = $dbh->prepare("select * from suggestions where suggestionid=?");
! $sth->execute($suggestionid);
! return($sth->fetchrow_hashref);
}
sub delsuggestion {
! my ($borrowernumber,$suggestionid) = @_;
my $dbh = C4::Context->dbh;
# check that the suggestion comes from the suggestor
! my $sth = $dbh->prepare("select suggestedby from suggestions where suggestionid=?");
! $sth->execute($suggestionid);
my ($suggestedby) = $sth->fetchrow;
if ($suggestedby eq $borrowernumber) {
! $sth = $dbh->prepare("delete from suggestions where suggestionid=?");
! $sth->execute($suggestionid);
! }
! }
!
! sub countsuggestion {
! my ($status) = @_;
! my $dbh = C4::Context->dbh;
! my $sth = $dbh->prepare("select count(*) from suggestions where status=?");
! $sth->execute($status);
! my ($result) = $sth->fetchrow;
! return $result;
! }
!
! sub changestatus {
! my ($suggestionid,$status,$managedby) = @_;
! my $dbh = C4::Context->dbh;
! my $sth;
! if ($managedby>0) {
! $sth = $dbh->prepare("update suggestions set status=?,managedby=? where suggestionid=?");
! $sth->execute($status,$managedby,$suggestionid);
! } else {
! $sth = $dbh->prepare("update suggestions set status=? where suggestionid=?");
! $sth->execute($status,$suggestionid);
!
}
+ # check mail sending.
+ $sth = $dbh->prepare("select suggestions.*,
+ boby.surname as bysurname, boby.firstname as byfirstname, boby.emailaddress as byemail,
+ lib.surname as libsurname,lib.firstname as libfirstname,lib.emailaddress 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->execute($suggestionid);
+ my $emailinfo = $sth->fetchrow_hashref;
+ my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet");
+ # query =>'',
+ # authnotrequired => 1,
+ # });
+ $template->param(byemail => $emailinfo->{byemail},
+ libemail => $emailinfo->{libemail},
+ status => $emailinfo->{status},
+ title => $emailinfo->{title},
+ author =>$emailinfo->{author},
+ libsurname => $emailinfo->{libsurname},
+ libfirstname => $emailinfo->{libfirstname},
+ byfirstname => $emailinfo->{byfirstname},
+ bysurname => $emailinfo->{bysurname},
+ );
+ warn "mailing => ".$template->output;
+ # warn "sending email to $emailinfo->{byemail} from $emailinfo->{libemail} to notice new status $emailinfo->{status} for $emailinfo->{title} / $emailinfo->{author}";
}
- Previous message: [Koha-cvs] CVS: koha/opac opac-userdetails.pl,1.7,1.8
- Next message: [Koha-cvs] CVS: koha/acqui suggestion-select.pl,NONE,1.1 addorder.pl,1.19,1.20 basket.pl,1.18,1.19 newbiblio.pl,1.18,1.19 order.pl,1.11,1.12
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the Koha-cvs
mailing list