[Koha-cvs] CVS: koha/C4 Acquisition.pm,1.2,1.3 Bull.pm,1.3,1.4

Paul POULAIN tipaul at users.sourceforge.net
Thu Aug 12 16:36:32 CEST 2004


Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27142/C4

Modified Files:
	Acquisition.pm Bull.pm 
Log Message:
serials : lot of bugfixes.
Works fine now. And is documented (clic Help)

Index: Acquisition.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Acquisition.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** Acquisition.pm	15 Jul 2004 09:41:03 -0000	1.2
--- Acquisition.pm	12 Aug 2004 14:36:29 -0000	1.3
***************
*** 222,229 ****
  cancelled.
  
- If there are no items remaining with the given biblionumber,
- C<&delorder> also deletes them from the marc_subfield_table and
- marc_biblio tables of the Koha database.
- 
  =cut
  #'
--- 222,225 ----
***************
*** 235,242 ****
    $sth->execute($bibnum,$ordnum);
    $sth->finish;
-   my $count=itemcount($bibnum);
-   if ($count == 0){
-     delbiblio($bibnum);
-   }
  }
  
--- 231,234 ----
***************
*** 318,332 ****
  #'
  sub receiveorder {
!   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
!   my $dbh = C4::Context->dbh;
!   my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
!   										biblioitemnumber=?,unitprice=?,freight=?,rrp=?
!   						where biblionumber=? and ordernumber=?");
!   $sth->execute($quantrec,$invoiceno,$bibitemno,$cost,$freight,$rrp,$biblio,$ordnum);
!   $sth->finish;
!   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
!   ordernumber=?");
!   $sth->execute($bookfund,$ordnum);
!   $sth->finish;
  }
  
--- 310,320 ----
  #'
  sub receiveorder {
! 	my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
! 	my $dbh = C4::Context->dbh;
! 	my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
! 											unitprice=?,freight=?,rrp=?
! 							where biblionumber=? and ordernumber=?");
! 	$sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
! 	$sth->finish;
  }
  
***************
*** 567,573 ****
  	map { push(@searchterms,"$_%","% $_%") } @data;
  	push(@searchterms,$search,$search,$biblio);
! 	my $sth=$dbh->prepare("Select *,biblio.title from aqorders,biblioitems,biblio
! 		where aqorders.biblioitemnumber = biblioitems.biblioitemnumber
! 		and aqorders.booksellerid = ?
  		and biblio.biblionumber=aqorders.biblionumber
  		and ((datecancellationprinted is NULL)
--- 555,562 ----
  	map { push(@searchterms,"$_%","% $_%") } @data;
  	push(@searchterms,$search,$search,$biblio);
! 	my $sth=$dbh->prepare("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)

Index: Bull.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Bull.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** Bull.pm	6 Aug 2004 16:38:41 -0000	1.3
--- Bull.pm	12 Aug 2004 14:36:29 -0000	1.4
***************
*** 21,24 ****
--- 21,26 ----
  use strict;
  use C4::Date;
+ use Date::Manip;
+ use C4::Suggestions;
  require Exporter;
  
***************
*** 43,50 ****
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&newsubscription &modsubscription &getsubscriptions &getsubscription
! 	&modsubscriptionhistory
  			&getserials &serialchangestatus
! 			&Find_Next_Date, &Get_Next_Seq);
  
  sub newsubscription {
--- 45,53 ----
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&newsubscription &modsubscription &getsubscriptions &getsubscription &getsubscriptionfrombiblionumber
! 			&modsubscriptionhistory
  			&getserials &serialchangestatus
! 			&Find_Next_Date, &Get_Next_Seq
! 			&hassubscriptionexpired &subscriptionexpirationdate &subscriptionrenew);
  
  sub newsubscription {
***************
*** 54,58 ****
  		$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  		$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 		$numberingmethod, $arrivalplanified, $status, $notes) = @_;
  	my $dbh = C4::Context->dbh;
  	#save subscription
--- 57,61 ----
  		$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  		$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 		$numberingmethod, $status, $notes) = @_;
  	my $dbh = C4::Context->dbh;
  	#save subscription
***************
*** 62,67 ****
  							add2,every2,whenmorethan2,setto2,lastvalue2,
  							add3,every3,whenmorethan3,setto3,lastvalue3,
! 							numberingmethod, arrivalplanified, status, notes) values 
! 							(?,?,?,?,?,?,?,?,?,?,
  							 ?,?,?,?,?,?,?,?,?,?,
  							 ?,?,?,?,?,?,?,?,?,?)");
--- 65,70 ----
  							add2,every2,whenmorethan2,setto2,lastvalue2,
  							add3,every3,whenmorethan3,setto3,lastvalue3,
! 							numberingmethod, status, notes) values 
! 							(?,?,?,?,?,?,?,?,?,
  							 ?,?,?,?,?,?,?,?,?,?,
  							 ?,?,?,?,?,?,?,?,?,?)");
***************
*** 71,98 ****
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 	 				$numberingmethod, format_date_in_iso($arrivalplanified), $status, $notes);
  	#then create the 1st waited number
  	my $subscriptionid = $dbh->{'mysql_insertid'};
! 	$sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, startdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
! 	$sth->execute($biblionumber, $subscriptionid, $startdate, 0, "", "", 0, $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;
! 	$sth = $dbh->prepare("insert into serial (biblionumber, subscriptionid, serialseq, status, planneddate) values (?,?,?,?,?)");
! 	$sth->execute($biblionumber, $subscriptionid,
! 					&Get_Next_Seq($val),
! 					$status, Find_Next_Date());
  	$sth->finish;  
  }
  sub getsubscription {
  	my ($subscriptionid) = @_;
  	my $dbh = C4::Context->dbh;
! 	my $sth = $dbh->prepare('select subscription.*,aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle 
  							from subscription 
  							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 subscriptionid = ?');
  	$sth->execute($subscriptionid);
  	my $subs = $sth->fetchrow_hashref;
--- 74,109 ----
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 	 				$numberingmethod, $status, $notes);
  	#then create the 1st waited number
  	my $subscriptionid = $dbh->{'mysql_insertid'};
! 	$sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
! 	$sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", 0, $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;
! 	# next issue number
! 	my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = Get_Next_Seq($val);
! 	# next date (calculated from actual date & frequency parameters)
! 	my $nextplanneddate = Get_Next_Date($startdate,$val);
! 	$sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
! 	$sth->execute($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
! 	$sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=?,
! 													innerloop1=?,innerloop2=?,innerloop3=?
! 													where subscriptionid = ?");
! 	$sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
  	$sth->finish;  
+ 	return $subscriptionid;
  }
  sub getsubscription {
  	my ($subscriptionid) = @_;
  	my $dbh = C4::Context->dbh;
! 	my $sth = $dbh->prepare('select subscription.*,subscriptionhistory.*,aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,biblio.title as bibliotitle 
  							from subscription 
+ 							left join subscriptionhistory on subscription.subscriptionid=subscriptionhistory.subscriptionid
  							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.subscriptionid = ?');
  	$sth->execute($subscriptionid);
  	my $subs = $sth->fetchrow_hashref;
***************
*** 100,103 ****
--- 111,123 ----
  }
  
+ sub getsubscriptionfrombiblionumber {
+ 	my ($biblionumber) = @_;
+ 	my $dbh = C4::Context->dbh;
+ 	my $sth = $dbh->prepare('select subscriptionid from subscription where biblionumber=?');
+ 	$sth->execute($biblionumber);
+ 	my $subscriptionid = $sth->fetchrow;
+ 	return $subscriptionid;
+ }
+ 
  sub modsubscription {
  	my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
***************
*** 106,110 ****
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 					$numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid)= @_;
  	my $dbh = C4::Context->dbh;
  	my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
--- 126,130 ----
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 					$numberingmethod, $status, $biblionumber, $notes, $subscriptionid)= @_;
  	my $dbh = C4::Context->dbh;
  	my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
***************
*** 113,117 ****
  						add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,
  						add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,
! 						numberingmethod=?, arrivalplanified=?, status=?, biblionumber=?, notes=? where subscriptionid = ?");
  	$sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
  					$periodicity,$dow,$numberlength,$weeklength,$monthlength,
--- 133,137 ----
  						add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,
  						add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,
! 						numberingmethod=?, status=?, biblionumber=?, notes=? where subscriptionid = ?");
  	$sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
  					$periodicity,$dow,$numberlength,$weeklength,$monthlength,
***************
*** 119,123 ****
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 					$numberingmethod, $arrivalplanified, $status, $biblionumber, $notes, $subscriptionid);
  	$sth->finish;
  
--- 139,143 ----
  					$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
  					$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
! 					$numberingmethod, $status, $biblionumber, $notes, $subscriptionid);
  	$sth->finish;
  
***************
*** 138,145 ****
  
  sub modsubscriptionhistory {
! 	my ($subscriptionid,$startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
  	my $dbh=C4::Context->dbh;
! 	my $sth = $dbh->prepare("update subscriptionhistory set startdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? where subscriptionid=?");
! 	$sth->execute($startdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
  }
  # get every serial not arrived for a given subscription.
--- 158,165 ----
  
  sub modsubscriptionhistory {
! 	my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
  	my $dbh=C4::Context->dbh;
! 	my $sth = $dbh->prepare("update subscriptionhistory set histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? where subscriptionid=?");
! 	$sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
  }
  # get every serial not arrived for a given subscription.
***************
*** 153,156 ****
--- 173,177 ----
  	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;
  	}
***************
*** 185,191 ****
  		$sth->execute($subscriptionid);
  		my $val = $sth->fetchrow_hashref;
  		my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = Get_Next_Seq($val);
  		$sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
! 		$sth->execute($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, 0);
  		$sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=?,
  														innerloop1=?,innerloop2=?,innerloop3=?
--- 206,215 ----
  		$sth->execute($subscriptionid);
  		my $val = $sth->fetchrow_hashref;
+ 		# next issue number
  		my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = Get_Next_Seq($val);
+ 		# next date (calculated from actual date & frequency parameters)
+ 		my $nextplanneddate = Get_Next_Date($planneddate,$val);
  		$sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
! 		$sth->execute($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
  		$sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=?,
  														innerloop1=?,innerloop2=?,innerloop3=?
***************
*** 195,206 ****
  }
  
! sub Find_Next_Date(@) {
!     return "2004-29-03";
  }
  
  sub Get_Next_Seq {
  	my ($val) =@_;
- #     return ("$sequence", $seqnum1, $seqnum2, $seqnum3)
- # 	if (!defined($seqnum1) && !defined($seqnum2) && !defined($seqnum3));
  	my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
  	$calculated = $val->{numberingmethod};
--- 219,263 ----
  }
  
! sub Get_Next_Date(@) {
! 	my ($planneddate,$subscription) = @_;
! 	my $resultdate;
! 	if ($subscription->{periodicity} == 1) {
! 		$resultdate=DateCalc($planneddate,"1 day");
! 	}
! 	if ($subscription->{periodicity} == 2) {
! 		$resultdate=DateCalc($planneddate,"1 week");
! 	}
! 	if ($subscription->{periodicity} == 3) {
! 		$resultdate=DateCalc($planneddate,"2 weeks");
! 	}
! 	if ($subscription->{periodicity} == 4) {
! 		$resultdate=DateCalc($planneddate,"3 weeks");
! 	}
! 	if ($subscription->{periodicity} == 5) {
! 		$resultdate=DateCalc($planneddate,"1 month");
! 	}
! 	if ($subscription->{periodicity} == 6) {
! 		$resultdate=DateCalc($planneddate,"2 months");
! 	}
! 	if ($subscription->{periodicity} == 7) {
! 		$resultdate=DateCalc($planneddate,"3 months");
! 	}
! 	if ($subscription->{periodicity} == 8) {
! 		$resultdate=DateCalc($planneddate,"1 quarter");
! 	}
! 	if ($subscription->{periodicity} == 9) {
! 		$resultdate=DateCalc($planneddate,"2 weeks");
! 	}
! 	if ($subscription->{periodicity} == 10) {
! 		$resultdate=DateCalc($planneddate,"1 year");
! 	}
! 	if ($subscription->{periodicity} == 11) {
! 		$resultdate=DateCalc($planneddate,"2 years");
! 	}
!     return format_date_in_iso($resultdate);
  }
  
  sub Get_Next_Seq {
  	my ($val) =@_;
  	my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
  	$calculated = $val->{numberingmethod};
***************
*** 232,234 ****
--- 289,351 ----
  }
  
+ # the subscription has expired when the next issue to arrive is out of subscription limit.
+ 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 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
+ 		$sth->execute($subscriptionid,$subscription->{planneddate});
+ 		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 $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
+ 		$sth->execute($subscriptionid);
+ 		my $res = ParseDate(format_date_in_iso($sth->fetchrow));
+ 		my $endofsubscriptiondate;
+ 		$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
+ 		$endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
+ 		return 1 if ($res >= $endofsubscriptiondate);
+ 		return 0;
+ 	}
+ }
+ 
+ sub subscriptionexpirationdate {
+ 	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}) {
+ 		#calculate the date of the last issue.
+ 		for (my $i=1;$i<=$subscription->{numberlength};$i++) {
+ 			$enddate = Get_Next_Date($enddate,$subscription);
+ 		}
+ 	} else {
+ 		$enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
+ 		$enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
+ 	}
+ # 	$enddate=format_date_in_iso($enddate);
+ # 	warn "END : $enddate";
+ 	return $enddate;
+ }
+ 
+ sub subscriptionrenew {
+ 	my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
+ 	my $dbh = C4::Context->dbh;
+ 	my $subscription = getsubscription($subscriptionid);
+ 	my $sth = $dbh->prepare("select * from biblio,biblioitems where biblio.biblionumber=biblioitems.biblionumber and biblio.biblionumber=?");
+ 	$sth->execute($subscription->{biblionumber});
+ 	my $biblio = $sth->fetchrow_hashref;
+ 	newsuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},,,,,$subscription->{biblionumber});
+ 	# renew subscription
+ 	$sth=$dbh->prepare("update subscription set startdate=?,numberlength=?,weeklength=?,monthlength=?");
+ 	$sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength);
+ }
  END { }       # module clean-up code here (global destructor)





More information about the Koha-cvs mailing list