[Koha-cvs] koha/C4 Serials.pm
Robert Lyon
bob at katipo.co.nz
Thu Jul 20 05:26:35 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Robert Lyon <bob_lyon> 06/07/20 03:26:35
Modified files:
C4 : Serials.pm
Log message:
Merging in katipo changes for serials - added in some new subroutines and resurrected some old ones but tried to make only minor changes to existing subroutines
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Serials.pm?cvsroot=koha&r1=1.2&r2=1.3
Patches:
Index: Serials.pm
===================================================================
RCS file: /sources/koha/koha/C4/Serials.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- Serials.pm 12 Jul 2006 10:49:39 -0000 1.2
+++ Serials.pm 20 Jul 2006 03:26:35 -0000 1.3
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Serials.pm,v 1.2 2006/07/12 10:49:39 toins Exp $
+# $Id: Serials.pm,v 1.3 2006/07/20 03:26:35 bob_lyon Exp $
use strict;
use C4::Date;
@@ -30,7 +30,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.2 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.3 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
@@ -57,8 +57,11 @@
&ModSubscriptionHistory &NewIssue &ItemizeSerials
&GetSerials &GetLatestSerials &ModSerialStatus
&HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
- &GetSuppliersWithLateIssues &GetLateIssues
- &GetDistributedTo &SetDistributedto
+ &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
+ &GetDistributedTo &SetDistributedto &serialchangestatus
+ &getroutinglist &delroutingmember &addroutingmember &reorder_members
+ &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
+ &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date
);
=head2 GetSuppliersWithLateIssues
@@ -82,7 +85,7 @@
FROM subscription, serial
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid
- AND (planneddate < now() OR serial.STATUS = 3)
+ AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
|;
my $sth = $dbh->prepare($query);
$sth->execute;
@@ -90,6 +93,9 @@
while (my ($id,$name) = $sth->fetchrow) {
$supplierlist{$id} = $name;
}
+ if(C4::Context->preference("RoutingSerials")){
+ $supplierlist{''} = "All Suppliers";
+ }
return %supplierlist;
}
@@ -130,7 +136,7 @@
FROM subscription, serial, biblio
LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
WHERE subscription.subscriptionid = serial.subscriptionid
- AND ((planneddate < now() AND serial.STATUS <=3) OR serial.STATUS = 3)
+ AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
AND biblio.biblionumber = subscription.biblionumber
ORDER BY title
|;
@@ -140,15 +146,17 @@
my @issuelist;
my $last_title;
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;
}
- return @issuelist;
+ return $count, at issuelist;
}
=head2 GetSubscriptionHistoryFromSubscriptionId
@@ -621,6 +629,71 @@
return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
}
+
+sub New_Get_Next_Seq {
+ 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};
+ $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($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;
+ }
+ return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
+}
+
+
=head2 GetNextDate
=over 4
@@ -1065,6 +1138,47 @@
$sth->execute($recievedlist,$missinglist,$subscriptionid);
}
+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,$planneddate,$status,$notes,$serialid);
+ $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
+ $sth->execute($subscriptionid);
+ my ($missinglist,$recievedlist) = $sth->fetchrow;
+ if ($status eq 2) {
+ $recievedlist .= "| $serialseq";
+ $recievedlist =~ s/^\| //g;
+ }
+ $missinglist .= "| $serialseq" if ($status eq 4) ;
+ $missinglist .= "| not issued $serialseq" if ($status eq 5);
+ $missinglist =~ s/^\| //g;
+ $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
+ $sth->execute($recievedlist,$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 = Get_Next_Date($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);
+ }
+}
+
+
=head2 ItemizeSerials
=over 4
@@ -1081,6 +1195,9 @@
=cut
sub ItemizeSerials {
my ($serialid, $info) =@_;
+ my $now = ParseDate("today");
+ $now = UnixDate($now,"%Y-%m-%d");
+
my $dbh= C4::Context->dbh;
my $query = qq|
SELECT *
@@ -1090,6 +1207,31 @@
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;
+ 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};
+ if ($info->{barcode}){ # only make biblioitem if we are going to make item also
+ $bibitemno = newbiblioitem($biblioitem);
+ }
+ }
+ }
+
my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
my $fwk=MARCfind_frameworkcode($dbh,$bibid);
if ($info->{barcode}){
@@ -1180,6 +1322,18 @@
$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);
+ }
+ }
NEWnewitem($dbh,$marcrecord,$bibid);
return 1;
}
@@ -1301,6 +1455,445 @@
$sth->execute($serialseq,$subscriptionid);
}
+sub GetMissingIssues {
+ my ($supplierid,$serialid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ 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
+ ");
+ } 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
+ ");
+ }
+ $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;
+ }
+ return $count, at issuelist;
+}
+
+sub removeMissingIssue {
+ my ($sequence,$subscriptionid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
+ $sth->execute($subscriptionid);
+ 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
+ SET missinglist = ?
+ WHERE subscriptionid = ?");
+ $sth2->execute($missinglist,$subscriptionid);
+ }
+}
+
+sub updateClaim {
+ my ($serialid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
+ WHERE serialid = ?
+ ");
+ $sth->execute($serialid);
+}
+
+sub getsupplierbyserialid {
+ my ($serialid) = @_;
+ 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 $result = $line->{'aqbooksellerid'};
+ return $result;
+}
+
+sub check_routing {
+ my ($subscriptionid) = @_;
+ 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 $result = $line->{'routingids'};
+ return $result;
+}
+
+sub addroutingmember {
+ my ($bornum,$subscriptionid) = @_;
+ my $rank;
+ my $dbh = C4::Context->dbh;
+ 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;
+ }
+ }
+ $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
+ $sth->execute($subscriptionid,$bornum,$rank);
+}
+
+sub reorder_members {
+ my ($subscriptionid,$routingid,$rank) = @_;
+ my $dbh = C4::Context->dbh;
+ 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'});
+ }
+ # 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;
+ }
+ }
+ # 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);
+ }
+ for(my $j = 0; $j < @result; $j++){
+ my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
+ $sth->execute;
+ }
+}
+
+sub delroutingmember {
+ # 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);
+ }
+}
+
+sub getroutinglist {
+ my ($subscriptionid) = @_;
+ 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);
+ }
+ return ($count, at routinglist);
+}
+
+# is the subscription about to expire? - check if penultimate issue.
+sub abouttoexpire {
+ 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->{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 = 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});
+ warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
+ my $per = $subscription->{'periodicity'};
+ my $x = 0;
+ if ($per == 1) { $x = '1 day'; }
+ if ($per == 2) { $x = '1 week'; }
+ if ($per == 3) { $x = '2 weeks'; }
+ if ($per == 4) { $x = '3 weeks'; }
+ if ($per == 5) { $x = '1 month'; }
+ 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 year'; }
+ if ($per == 11) { $x = '2 years'; }
+ my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
+ warn "DATE BEFORE END: $datebeforeend";
+ return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
+ return 0;
+ }
+}
+
+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;
+ #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 = subscriptionexpirationdate($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 = Get_Seq($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;
+}
+
+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));
+}
+
+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, at serials);
+}
+
+sub Get_Next_Date(@) {
+ my ($planneddate,$subscription) = @_;
+ my @irreg = split(/\|/,$subscription->{irregularity});
+
+ my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
+ my $dayofweek = Date_DayOfWeek($month,$day,$year);
+ my $resultdate;
+ # warn "DOW $dayofweek";
+ if ($subscription->{periodicity} == 1) {
+ for(my $i=0;$i<@irreg;$i++){
+ if($dayofweek == 7){ $dayofweek = 0; }
+ if(in_array(($dayofweek+1), @irreg)){
+ $planneddate = DateCalc($planneddate,"1 day");
+ $dayofweek++;
+ }
+ }
+ $resultdate=DateCalc($planneddate,"1 day");
+ }
+ if ($subscription->{periodicity} == 2) {
+ my $wkno = Date_WeekOfYear($month,$day,$year,1);
+ for(my $i = 0;$i < @irreg; $i++){
+ if($wkno > 52) { $wkno = 0; } # need to rollover at January
+ if($irreg[$i] == ($wkno+1)){
+ $planneddate = DateCalc($planneddate,"1 week");
+ $wkno++;
+ }
+ }
+ $resultdate=DateCalc($planneddate,"1 week");
+ }
+ if ($subscription->{periodicity} == 3) {
+ my $wkno = Date_WeekOfYear($month,$day,$year,1);
+ for(my $i = 0;$i < @irreg; $i++){
+ if($wkno > 52) { $wkno = 0; } # need to rollover at January
+ if($irreg[$i] == ($wkno+1)){
+ $planneddate = DateCalc($planneddate,"2 weeks");
+ $wkno++;
+ }
+ }
+ $resultdate=DateCalc($planneddate,"2 weeks");
+ }
+ if ($subscription->{periodicity} == 4) {
+ my $wkno = Date_WeekOfYear($month,$day,$year,1);
+ for(my $i = 0;$i < @irreg; $i++){
+ if($wkno > 52) { $wkno = 0; } # need to rollover at January
+ if($irreg[$i] == ($wkno+1)){
+ $planneddate = DateCalc($planneddate,"3 weeks");
+ $wkno++;
+ }
+ }
+ $resultdate=DateCalc($planneddate,"3 weeks");
+ }
+ if ($subscription->{periodicity} == 5) {
+ 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 = DateCalc($planneddate,"1 month");
+ $month++; # to check if following ones are to be skipped too
+ }
+ }
+ $resultdate=DateCalc($planneddate,"1 month");
+ # warn "Planneddate2: $planneddate";
+ }
+ if ($subscription->{periodicity} == 6) {
+ for(my $i = 0;$i < @irreg; $i++){
+ 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 = DateCalc($planneddate,"2 months");
+ $month++; # to check if following ones are to be skipped too
+ }
+ }
+ $resultdate=DateCalc($planneddate,"2 months");
+ }
+ if ($subscription->{periodicity} == 7) {
+ for(my $i = 0;$i < @irreg; $i++){
+ 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 = DateCalc($planneddate,"3 months");
+ $month++; # to check if following ones are to be skipped too
+ }
+ }
+ $resultdate=DateCalc($planneddate,"3 months");
+ }
+ if ($subscription->{periodicity} == 8) {
+ for(my $i = 0;$i < @irreg; $i++){
+ 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 = DateCalc($planneddate,"3 months");
+ $month++; # to check if following ones are to be skipped too
+ }
+ }
+ $resultdate=DateCalc($planneddate,"3 months");
+ }
+ if ($subscription->{periodicity} == 9) {
+ for(my $i = 0;$i < @irreg; $i++){
+ 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 = DateCalc($planneddate,"6 months");
+ $month++; # to check if following ones are to be skipped too
+ }
+ }
+ $resultdate=DateCalc($planneddate,"6 months");
+ }
+ if ($subscription->{periodicity} == 10) {
+ $resultdate=DateCalc($planneddate,"1 year");
+ }
+ if ($subscription->{periodicity} == 11) {
+ $resultdate=DateCalc($planneddate,"2 years");
+ }
+ # warn "date: ".$resultdate;
+ return format_date_in_iso($resultdate);
+}
+
+
END { } # module clean-up code here (global destructor)
1;
\ No newline at end of file
More information about the Koha-cvs
mailing list