1 package C4::Serials; #assumes C4/Serials.pm
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 # set the version for version checking
34 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
35 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
40 C4::Serials - Give functions for serializing.
48 Give all XYZ functions
55 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
56 &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
57 &GetFullSubscriptionsFromBiblionumber &GetNextSeq
58 &ModSubscriptionHistory &NewIssue &ItemizeSerials
59 &GetSerials &GetLatestSerials &ModSerialStatus
60 &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
61 &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
62 &GetDistributedTo &SetDistributedto &serialchangestatus
63 &getroutinglist &delroutingmember &addroutingmember &reorder_members
64 &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
65 &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date
68 =head2 GetSuppliersWithLateIssues
72 %supplierlist = &GetSuppliersWithLateIssues
74 this function get all suppliers with late issues.
77 the supplierlist into a hash. this hash containts id & name of the supplier
82 sub GetSuppliersWithLateIssues {
83 my $dbh = C4::Context->dbh;
85 SELECT DISTINCT id, name
86 FROM subscription, serial
87 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
88 WHERE subscription.subscriptionid = serial.subscriptionid
89 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
91 my $sth = $dbh->prepare($query);
94 while (my ($id,$name) = $sth->fetchrow) {
95 $supplierlist{$id} = $name;
97 if(C4::Context->preference("RoutingSerials")){
98 $supplierlist{''} = "All Suppliers";
100 return %supplierlist;
107 @issuelist = &GetLateIssues($supplierid)
109 this function select late issues on database
112 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
113 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
119 my ($supplierid) = @_;
120 my $dbh = C4::Context->dbh;
124 SELECT name,title,planneddate,serialseq,serial.subscriptionid
125 FROM subscription, serial, biblio
126 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
127 WHERE subscription.subscriptionid = serial.subscriptionid
128 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
129 AND subscription.aqbooksellerid=$supplierid
130 AND biblio.biblionumber = subscription.biblionumber
133 $sth = $dbh->prepare($query);
136 SELECT name,title,planneddate,serialseq,serial.subscriptionid
137 FROM subscription, serial, biblio
138 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
139 WHERE subscription.subscriptionid = serial.subscriptionid
140 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
141 AND biblio.biblionumber = subscription.biblionumber
144 $sth = $dbh->prepare($query);
151 while (my $line = $sth->fetchrow_hashref) {
152 $odd++ unless $line->{title} eq $last_title;
153 $line->{title} = "" if $line->{title} eq $last_title;
154 $last_title = $line->{title} if ($line->{title});
155 $line->{planneddate} = format_date($line->{planneddate});
156 $line->{'odd'} = 1 if $odd %2 ;
158 push @issuelist,$line;
160 return $count,@issuelist;
163 =head2 GetSubscriptionHistoryFromSubscriptionId
167 $sth = GetSubscriptionHistoryFromSubscriptionId()
168 this function just prepare the SQL request.
169 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
171 $sth = $dbh->prepare($query).
176 sub GetSubscriptionHistoryFromSubscriptionId() {
177 my $dbh = C4::Context->dbh;
180 FROM subcriptionhistory
181 WHERE subscriptionid = ?
183 return $dbh->prepare($query);
186 =head2 GetSerialStatusFromSerialId
190 $sth = GetSerialStatusFromSerialId();
191 this function just prepare the SQL request.
192 After this function, don't forget to execute it by using $sth->execute($serialid)
194 $sth = $dbh->prepare($query).
199 sub GetSerialStatusFromSerialId(){
200 my $dbh = C4::Context->dbh;
206 return $dbh->prepare($query);
210 =head2 GetSubscription
214 $subs = GetSubscription($subscriptionid)
215 this function get the subscription which has $subscriptionid as id.
217 a hashref. This hash containts
218 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
223 sub GetSubscription {
224 my ($subscriptionid) = @_;
225 my $dbh = C4::Context->dbh;
227 SELECT subscription.*,
228 subscriptionhistory.*,
230 aqbooksellers.name AS aqbooksellername,
231 biblio.title AS bibliotitle
233 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
234 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
235 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
236 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
237 WHERE subscription.subscriptionid = ?
239 my $sth = $dbh->prepare($query);
240 $sth->execute($subscriptionid);
241 my $subs = $sth->fetchrow_hashref;
245 =head2 GetSubscriptionsFromBiblionumber
249 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
250 this function get the subscription list. it reads on subscription table.
252 table of subscription which has the biblionumber given on input arg.
253 each line of this table is a hashref. All hashes containt
254 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
259 sub GetSubscriptionsFromBiblionumber {
260 my ($biblionumber) = @_;
261 my $dbh = C4::Context->dbh;
263 SELECT subscription.*,
264 subscriptionhistory.*,
266 aqbooksellers.name AS aqbooksellername,
267 biblio.title AS bibliotitle
269 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
270 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
271 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
272 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
273 WHERE subscription.biblionumber = ?
275 my $sth = $dbh->prepare($query);
276 $sth->execute($biblionumber);
278 while (my $subs = $sth->fetchrow_hashref) {
279 $subs->{startdate} = format_date($subs->{startdate});
280 $subs->{histstartdate} = format_date($subs->{histstartdate});
281 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
282 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
283 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
284 $subs->{"periodicity".$subs->{periodicity}} = 1;
285 $subs->{"status".$subs->{'status'}} = 1;
286 if ($subs->{enddate} eq '0000-00-00') {
289 $subs->{enddate} = format_date($subs->{enddate});
295 =head2 GetFullSubscriptionsFromBiblionumber
299 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
300 this function read on serial table.
305 sub GetFullSubscriptionsFromBiblionumber {
306 my ($biblionumber) = @_;
307 my $dbh = C4::Context->dbh;
309 SELECT serial.serialseq,
311 serial.publisheddate,
314 year(serial.publisheddate) AS year,
315 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
316 biblio.title AS bibliotitle
318 LEFT JOIN subscription ON
319 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
320 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
321 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
322 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
323 WHERE subscription.biblionumber = ?
324 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
327 my $sth = $dbh->prepare($query);
328 $sth->execute($biblionumber);
332 my $aqbooksellername;
337 while (my $subs = $sth->fetchrow_hashref) {
338 ### BUG To FIX: When there is no published date, will create many null ids!!!
340 if ($year and ($year==$subs->{year})){
341 if ($first eq 1){$first=0;}
342 my $temp=$res[scalar(@res)-1]->{'serials'};
344 {'publisheddate' =>format_date($subs->{'publisheddate'}),
345 'planneddate' => format_date($subs->{'planneddate'}),
346 'serialseq' => $subs->{'serialseq'},
347 "status".$subs->{'status'} => 1,
348 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
351 $first=1 if (not $year);
352 $year= $subs->{'year'};
353 $startdate= format_date($subs->{'startdate'});
354 $aqbooksellername= $subs->{'aqbooksellername'};
355 $bibliotitle= $subs->{'bibliotitle'};
358 {'publisheddate' =>format_date($subs->{'publisheddate'}),
359 'planneddate' => format_date($subs->{'planneddate'}),
360 'serialseq' => $subs->{'serialseq'},
361 "status".$subs->{'status'} => 1,
362 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
367 'startdate'=>$startdate,
368 'aqbooksellername'=>$aqbooksellername,
369 'bibliotitle'=>$bibliotitle,
374 $previousnote=$subs->{notes};
380 =head2 GetSubscriptions
384 @results = GetSubscriptions($title,$ISSN,$biblionumber);
385 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
387 a table of hashref. Each hash containt the subscription.
392 sub GetSubscriptions {
393 my ($title,$ISSN,$biblionumber) = @_;
394 return unless $title or $ISSN or $biblionumber;
395 my $dbh = C4::Context->dbh;
399 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
400 FROM subscription,biblio,biblioitems
401 WHERE biblio.biblionumber = biblioitems.biblionumber
402 AND biblio.biblionumber = subscription.biblionumber
403 AND biblio.biblionumber=?
406 $sth = $dbh->prepare($query);
407 $sth->execute($biblionumber);
409 if ($ISSN and $title){
411 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
412 FROM subscription,biblio,biblioitems
413 WHERE biblio.biblionumber = biblioitems.biblionumber
414 AND biblio.biblionumber= subscription.biblionumber
415 AND (biblio.title LIKE ? or biblioitems.issn = ?)
418 $sth = $dbh->prepare($query);
419 $sth->execute("%$title%",$ISSN);
424 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
425 FROM subscription,biblio,biblioitems
426 WHERE biblio.biblionumber = biblioitems.biblionumber
427 AND biblio.biblionumber=subscription.biblionumber
428 AND biblioitems.issn = ?
431 $sth = $dbh->prepare($query);
432 $sth->execute($ISSN);
435 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
436 FROM subscription,biblio,biblioitems
437 WHERE biblio.biblionumber = biblioitems.biblionumber
438 AND biblio.biblionumber=subscription.biblionumber
439 AND biblio.title LIKE ?
442 $sth = $dbh->prepare($query);
443 $sth->execute("%$title%");
448 my $previoustitle="";
450 while (my $line = $sth->fetchrow_hashref) {
451 if ($previoustitle eq $line->{title}) {
454 $line->{toggle} = 1 if $odd==1;
456 $previoustitle=$line->{title};
458 $line->{toggle} = 1 if $odd==1;
460 push @results, $line;
469 ($totalissues,@serials) = GetSerials($subscriptionid);
470 this function get every serial not arrived for a given subscription
471 as well as the number of issues registered in the database (all types)
472 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
478 my ($subscriptionid) = @_;
479 my $dbh = C4::Context->dbh;
480 # OK, now add the last 5 issues arrives/missing
482 SELECT serialid,serialseq, status, planneddate,notes
484 WHERE subscriptionid = ?
485 AND (status in (2,4,5))
486 ORDER BY serialid DESC
488 my $sth=$dbh->prepare($query);
489 $sth->execute($subscriptionid);
492 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
494 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
495 $line->{"planneddate"} = format_date($line->{"planneddate"});
498 # status = 2 is "arrived"
500 SELECT serialid,serialseq, status, publisheddate, planneddate,notes
502 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
504 my $sth=$dbh->prepare($query);
505 $sth->execute($subscriptionid);
506 while(my $line = $sth->fetchrow_hashref) {
507 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
508 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
509 $line->{"planneddate"} = format_date($line->{"planneddate"});
515 WHERE subscriptionid=?
517 $sth=$dbh->prepare($query);
518 $sth->execute($subscriptionid);
519 my ($totalissues) = $sth->fetchrow;
520 return ($totalissues,@serials);
523 =head2 GetLatestSerials
527 \@serials = GetLatestSerials($subscriptionid,$limit)
528 get the $limit's latest serials arrived or missing for a given subscription
530 a ref to a table which it containts all of the latest serials stored into a hash.
535 sub GetLatestSerials {
536 my ($subscriptionid,$limit) = @_;
537 my $dbh = C4::Context->dbh;
538 # status = 2 is "arrived"
540 SELECT serialid,serialseq, status, planneddate
542 WHERE subscriptionid = ?
543 AND (status =2 or status=4)
544 ORDER BY planneddate DESC LIMIT 0,$limit
546 my $sth=$dbh->prepare($strsth);
547 $sth->execute($subscriptionid);
549 while(my $line = $sth->fetchrow_hashref) {
550 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
551 $line->{"planneddate"} = format_date($line->{"planneddate"});
557 # WHERE subscriptionid=?
559 # $sth=$dbh->prepare($query);
560 # $sth->execute($subscriptionid);
561 # my ($totalissues) = $sth->fetchrow;
565 =head2 GetDistributedTo
569 $distributedto=GetDistributedTo($subscriptionid)
570 This function select the old previous value of distributedto in the database.
575 sub GetDistributedTo {
576 my $dbh = C4::Context->dbh;
578 my $subscriptionid = @_;
582 WHERE subscriptionid=?
584 my $sth = $dbh->prepare($query);
585 $sth->execute($subscriptionid);
586 return ($distributedto) = $sth->fetchrow;
594 $val is a hashref containing all the attributes of the table 'subscription'
595 This function get the next issue for the subscription given on input arg
597 all the input params updated.
604 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
605 $calculated = $val->{numberingmethod};
606 # calculate the (expected) value of the next issue recieved.
607 $newlastvalue1 = $val->{lastvalue1};
608 # check if we have to increase the new value.
609 $newinnerloop1 = $val->{innerloop1}+1;
610 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
611 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
612 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
613 $calculated =~ s/\{X\}/$newlastvalue1/g;
615 $newlastvalue2 = $val->{lastvalue2};
616 # check if we have to increase the new value.
617 $newinnerloop2 = $val->{innerloop2}+1;
618 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
619 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
620 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
621 $calculated =~ s/\{Y\}/$newlastvalue2/g;
623 $newlastvalue3 = $val->{lastvalue3};
624 # check if we have to increase the new value.
625 $newinnerloop3 = $val->{innerloop3}+1;
626 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
627 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
628 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
629 $calculated =~ s/\{Z\}/$newlastvalue3/g;
630 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
634 sub New_Get_Next_Seq {
636 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
637 my $pattern = $val->{numberpattern};
638 my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
639 my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
640 $calculated = $val->{numberingmethod};
641 $newlastvalue1 = $val->{lastvalue1};
642 $newlastvalue2 = $val->{lastvalue2};
643 $newlastvalue3 = $val->{lastvalue3};
644 if($newlastvalue3 > 0){ # if x y and z columns are used
645 $newlastvalue3 = $newlastvalue3+1;
646 if($newlastvalue3 > $val->{whenmorethan3}){
647 $newlastvalue3 = $val->{setto3};
649 if($newlastvalue2 > $val->{whenmorethan2}){
651 $newlastvalue2 = $val->{setto2};
654 $calculated =~ s/\{X\}/$newlastvalue1/g;
656 if($val->{hemisphere} == 2){
657 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
658 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
660 my $newlastvalue2seq = $seasons[$newlastvalue2];
661 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
664 $calculated =~ s/\{Y\}/$newlastvalue2/g;
666 $calculated =~ s/\{Z\}/$newlastvalue3/g;
668 if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
669 $newlastvalue2 = $newlastvalue2+1;
670 if($newlastvalue2 > $val->{whenmorethan2}){
671 $newlastvalue2 = $val->{setto2};
674 $calculated =~ s/\{X\}/$newlastvalue1/g;
676 if($val->{hemisphere} == 2){
677 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
678 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
680 my $newlastvalue2seq = $seasons[$newlastvalue2];
681 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
684 $calculated =~ s/\{Y\}/$newlastvalue2/g;
687 if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
688 $newlastvalue1 = $newlastvalue1+1;
689 if($newlastvalue1 > $val->{whenmorethan1}){
690 $newlastvalue1 = $val->{setto2};
692 $calculated =~ s/\{X\}/$newlastvalue1/g;
694 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
702 $resultdate = GetNextDate($planneddate,$subscription)
704 this function get the date after $planneddate.
706 the date on ISO format.
712 my ($planneddate,$subscription) = @_;
714 if ($subscription->{periodicity} == 1) {
715 $resultdate=DateCalc($planneddate,"1 day");
717 if ($subscription->{periodicity} == 2) {
718 $resultdate=DateCalc($planneddate,"1 week");
720 if ($subscription->{periodicity} == 3) {
721 $resultdate=DateCalc($planneddate,"2 weeks");
723 if ($subscription->{periodicity} == 4) {
724 $resultdate=DateCalc($planneddate,"3 weeks");
726 if ($subscription->{periodicity} == 5) {
727 $resultdate=DateCalc($planneddate,"1 month");
729 if ($subscription->{periodicity} == 6) {
730 $resultdate=DateCalc($planneddate,"2 months");
732 if ($subscription->{periodicity} == 7) {
733 $resultdate=DateCalc($planneddate,"3 months");
735 if ($subscription->{periodicity} == 8) {
736 $resultdate=DateCalc($planneddate,"3 months");
738 if ($subscription->{periodicity} == 9) {
739 $resultdate=DateCalc($planneddate,"6 months");
741 if ($subscription->{periodicity} == 10) {
742 $resultdate=DateCalc($planneddate,"1 year");
744 if ($subscription->{periodicity} == 11) {
745 $resultdate=DateCalc($planneddate,"2 years");
747 return format_date_in_iso($resultdate);
754 $calculated = GetSeq($val)
755 $val is a hashref containing all the attributes of the table 'subscription'
756 this function transforms {X},{Y},{Z} to 150,0,0 for example.
758 the sequence in integer format
765 my $calculated = $val->{numberingmethod};
766 my $x=$val->{'lastvalue1'};
767 $calculated =~ s/\{X\}/$x/g;
768 my $y=$val->{'lastvalue2'};
769 $calculated =~ s/\{Y\}/$y/g;
770 my $z=$val->{'lastvalue3'};
771 $calculated =~ s/\{Z\}/$z/g;
775 =head2 GetSubscriptionExpirationDate
779 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
781 this function return the expiration date for a subscription given on input args.
789 sub GetSubscriptionExpirationDate {
790 my ($subscriptionid) = @_;
791 my $dbh = C4::Context->dbh;
792 my $subscription = GetSubscription($subscriptionid);
793 my $enddate=$subscription->{startdate};
794 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
795 if ($subscription->{numberlength}) {
796 #calculate the date of the last issue.
797 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
798 $enddate = GetNextDate($enddate,$subscription);
802 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
803 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
808 =head2 CountSubscriptionFromBiblionumber
812 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
813 this count the number of subscription for a biblionumber given.
815 the number of subscriptions with biblionumber given on input arg.
820 sub CountSubscriptionFromBiblionumber {
821 my ($biblionumber) = @_;
822 my $dbh = C4::Context->dbh;
828 my $sth = $dbh->prepare($query);
829 $sth->execute($biblionumber);
830 my $subscriptionsnumber = $sth->fetchrow;
831 return $subscriptionsnumber;
835 =head2 ModSubscriptionHistory
839 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
841 this function modify the history of a subscription. Put your new values on input arg.
846 sub ModSubscriptionHistory {
847 my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
848 my $dbh=C4::Context->dbh;
850 UPDATE subscriptionhistory
851 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
852 WHERE subscriptionid=?
854 my $sth = $dbh->prepare($query);
855 $recievedlist =~ s/^,//g;
856 $missinglist =~ s/^,//g;
857 $opacnote =~ s/^,//g;
858 $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
861 =head2 ModSerialStatus
865 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
867 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
868 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
873 sub ModSerialStatus {
874 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
875 # 1st, get previous status :
876 my $dbh = C4::Context->dbh;
878 SELECT subscriptionid,status
882 my $sth = $dbh->prepare($query);
883 $sth->execute($serialid);
884 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
885 # change status & update subscriptionhistory
887 DelIssue($serialseq, $subscriptionid)
891 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
894 $sth = $dbh->prepare($query);
895 $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
897 SELECT missinglist,recievedlist
898 FROM subscriptionhistory
899 WHERE subscriptionid=?
901 $sth = $dbh->prepare($query);
902 $sth->execute($subscriptionid);
903 my ($missinglist,$recievedlist) = $sth->fetchrow;
905 $recievedlist .= ",$serialseq";
907 $missinglist .= ",$serialseq" if ($status eq 4) ;
908 $missinglist .= ",not issued $serialseq" if ($status eq 5);
910 UPDATE subscriptionhistory
911 SET recievedlist=?, missinglist=?
912 WHERE subscriptionid=?
914 $sth=$dbh->prepare($query);
915 $sth->execute($recievedlist,$missinglist,$subscriptionid);
917 # create new waited entry if needed (ie : was a "waited" and has changed)
918 if ($oldstatus eq 1 && $status ne 1) {
922 WHERE subscriptionid = ?
924 $sth = $dbh->prepare($query);
925 $sth->execute($subscriptionid);
926 my $val = $sth->fetchrow_hashref;
928 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
929 # next date (calculated from actual date & frequency parameters)
930 my $nextpublisheddate = GetNextDate($publisheddate,$val);
931 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
934 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
935 innerloop1=?, innerloop2=?, innerloop3=?
936 WHERE subscriptionid = ?
938 $sth = $dbh->prepare($query);
939 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
943 =head2 ModSubscription
947 this function modify a subscription. Put all new values on input args.
952 sub ModSubscription {
953 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
954 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
955 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
956 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
957 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
958 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
959 my $dbh = C4::Context->dbh;
962 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
963 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
964 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
965 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
966 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
967 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
968 WHERE subscriptionid = ?
970 my $sth=$dbh->prepare($query);
971 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
972 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
973 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
974 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
975 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
976 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
981 =head2 NewSubscription
985 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
986 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
987 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
988 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
989 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
990 $numberingmethod, $status, $notes)
992 Create a new subscription with value given on input args.
995 the id of this new subscription
1000 sub NewSubscription {
1001 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1002 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1003 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1004 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1005 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1006 $numberingmethod, $status, $notes, $letter) = @_;
1007 my $dbh = C4::Context->dbh;
1008 #save subscription (insert into database)
1010 INSERT INTO subscription
1011 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1012 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1013 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1014 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1015 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1016 numberingmethod, status, notes, letter)
1017 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1019 my $sth=$dbh->prepare($query);
1021 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1022 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1023 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1024 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1025 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1026 $numberingmethod, $status, $notes, $letter);
1028 #then create the 1st waited number
1029 my $subscriptionid = $dbh->{'mysql_insertid'};
1031 INSERT INTO subscriptionhistory
1032 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1033 VALUES (?,?,?,?,?,?,?,?)
1035 $sth = $dbh->prepare($query);
1036 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
1038 # reread subscription to get a hash (for calculation of the 1st issue number)
1042 WHERE subscriptionid = ?
1044 $sth = $dbh->prepare($query);
1045 $sth->execute($subscriptionid);
1046 my $val = $sth->fetchrow_hashref;
1048 # calculate issue number
1049 my $serialseq = GetSeq($val);
1052 (serialseq,subscriptionid,biblionumber,status, planneddate)
1055 $sth = $dbh->prepare($query);
1056 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1057 return $subscriptionid;
1061 =head2 ReNewSubscription
1065 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1067 this function renew a subscription with values given on input args.
1072 sub ReNewSubscription {
1073 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1074 my $dbh = C4::Context->dbh;
1075 my $subscription = GetSubscription($subscriptionid);
1078 FROM biblio,biblioitems
1079 WHERE biblio.biblionumber=biblioitems.biblionumber
1080 AND biblio.biblionumber=?
1082 my $sth = $dbh->prepare($query);
1083 $sth->execute($subscription->{biblionumber});
1084 my $biblio = $sth->fetchrow_hashref;
1085 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1086 # renew subscription
1089 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1090 WHERE subscriptionid=?
1092 $sth=$dbh->prepare($query);
1093 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1101 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1103 Create a new issue stored on the database.
1104 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1110 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1111 my $dbh = C4::Context->dbh;
1114 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1115 VALUES (?,?,?,?,?,?)
1117 my $sth = $dbh->prepare($query);
1118 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1120 SELECT missinglist,recievedlist
1121 FROM subscriptionhistory
1122 WHERE subscriptionid=?
1124 $sth = $dbh->prepare($query);
1125 $sth->execute($subscriptionid);
1126 my ($missinglist,$recievedlist) = $sth->fetchrow;
1128 $recievedlist .= ",$serialseq";
1131 $missinglist .= ",$serialseq";
1134 UPDATE subscriptionhistory
1135 SET recievedlist=?, missinglist=?
1136 WHERE subscriptionid=?
1138 $sth=$dbh->prepare($query);
1139 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1142 =head2 serialchangestatus
1146 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1148 Change the status of a serial issue.
1149 Note: this was the older subroutine
1154 sub serialchangestatus {
1155 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1156 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1157 my $dbh = C4::Context->dbh;
1158 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1159 $sth->execute($serialid);
1160 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1161 # change status & update subscriptionhistory
1163 delissue($serialseq, $subscriptionid)
1165 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1166 $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1167 $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1168 $sth->execute($subscriptionid);
1169 my ($missinglist,$recievedlist) = $sth->fetchrow;
1171 $recievedlist .= "| $serialseq";
1172 $recievedlist =~ s/^\| //g;
1174 $missinglist .= "| $serialseq" if ($status eq 4) ;
1175 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1176 $missinglist =~ s/^\| //g;
1177 $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1178 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1180 # create new waited entry if needed (ie : was a "waited" and has changed)
1181 if ($oldstatus eq 1 && $status ne 1) {
1182 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1183 $sth->execute($subscriptionid);
1184 my $val = $sth->fetchrow_hashref;
1186 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1187 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1188 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1189 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1190 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1192 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1193 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1194 $sth->execute($subscriptionid);
1195 my $subscription = $sth->fetchrow_hashref;
1196 if ($subscription->{letter} && $status eq 2) {
1197 sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1202 =head2 ItemizeSerials
1206 ItemizeSerials($serialid, $info);
1207 $info is a hashref containing barcode branch, itemcallnumber, status, location
1208 $serialid the serialid
1210 1 if the itemize is a succes.
1211 0 and @error else. @error containts the list of errors found.
1216 sub ItemizeSerials {
1217 my ($serialid, $info) =@_;
1218 my $now = ParseDate("today");
1219 $now = UnixDate($now,"%Y-%m-%d");
1221 my $dbh= C4::Context->dbh;
1227 my $sth=$dbh->prepare($query);
1228 $sth->execute($serialid);
1229 my $data=$sth->fetchrow_hashref;
1230 if(C4::Context->preference("RoutingSerials")){
1231 # check for existing biblioitem relating to serial issue
1232 my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1234 for(my $i=0;$i<$count;$i++){
1235 if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1236 $bibitemno = $results[$i]->{'biblioitemnumber'};
1240 if($bibitemno == 0){
1241 # warn "need to add new biblioitem so copy last one and make minor changes";
1242 my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1243 $sth->execute($data->{'biblionumber'});
1245 my $biblioitem = $sth->fetchrow_hashref;
1246 $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1247 $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1248 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1249 if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1250 $bibitemno = newbiblioitem($biblioitem);
1255 my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1256 my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1257 if ($info->{barcode}){
1259 my $exists = itemdata($info->{'barcode'});
1260 push @errors,"barcode_not_unique" if($exists);
1262 my $marcrecord = MARC::Record->new();
1263 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1264 my $newField = MARC::Field->new(
1266 "$subfield" => $info->{barcode}
1268 $marcrecord->insert_fields_ordered($newField);
1269 if ($info->{branch}){
1270 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1271 #warn "items.homebranch : $tag , $subfield";
1272 if ($marcrecord->field($tag)) {
1273 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1275 my $newField = MARC::Field->new(
1277 "$subfield" => $info->{branch}
1279 $marcrecord->insert_fields_ordered($newField);
1281 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1282 #warn "items.holdingbranch : $tag , $subfield";
1283 if ($marcrecord->field($tag)) {
1284 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1286 my $newField = MARC::Field->new(
1288 "$subfield" => $info->{branch}
1290 $marcrecord->insert_fields_ordered($newField);
1293 if ($info->{itemcallnumber}){
1294 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1295 #warn "items.itemcallnumber : $tag , $subfield";
1296 if ($marcrecord->field($tag)) {
1297 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1299 my $newField = MARC::Field->new(
1301 "$subfield" => $info->{itemcallnumber}
1303 $marcrecord->insert_fields_ordered($newField);
1306 if ($info->{notes}){
1307 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1308 # warn "items.itemnotes : $tag , $subfield";
1309 if ($marcrecord->field($tag)) {
1310 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1312 my $newField = MARC::Field->new(
1314 "$subfield" => $info->{notes}
1316 $marcrecord->insert_fields_ordered($newField);
1319 if ($info->{location}){
1320 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1321 # warn "items.location : $tag , $subfield";
1322 if ($marcrecord->field($tag)) {
1323 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1325 my $newField = MARC::Field->new(
1327 "$subfield" => $info->{location}
1329 $marcrecord->insert_fields_ordered($newField);
1332 if ($info->{status}){
1333 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1334 # warn "items.notforloan : $tag , $subfield";
1335 if ($marcrecord->field($tag)) {
1336 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1338 my $newField = MARC::Field->new(
1340 "$subfield" => $info->{status}
1342 $marcrecord->insert_fields_ordered($newField);
1345 if(C4::Context->preference("RoutingSerials")){
1346 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1347 if ($marcrecord->field($tag)) {
1348 $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1350 my $newField = MARC::Field->new(
1354 $marcrecord->insert_fields_ordered($newField);
1357 NEWnewitem($dbh,$marcrecord,$bibid);
1364 =head2 HasSubscriptionExpired
1368 1 or 0 = HasSubscriptionExpired($subscriptionid)
1370 the subscription has expired when the next issue to arrive is out of subscription limit.
1373 1 if true, 0 if false.
1378 sub HasSubscriptionExpired {
1379 my ($subscriptionid) = @_;
1380 my $dbh = C4::Context->dbh;
1381 my $subscription = GetSubscription($subscriptionid);
1382 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1383 if ($subscription->{numberlength}) {
1387 WHERE subscriptionid=? AND planneddate>=?
1389 my $sth = $dbh->prepare($query);
1390 $sth->execute($subscriptionid,$subscription->{startdate});
1391 my $res = $sth->fetchrow;
1392 if ($subscription->{numberlength}>=$res) {
1398 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1400 SELECT max(planneddate)
1402 WHERE subscriptionid=?
1404 my $sth = $dbh->prepare($query);
1405 $sth->execute($subscriptionid);
1406 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1407 my $endofsubscriptiondate;
1408 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1409 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1410 return 1 if ($res >= $endofsubscriptiondate);
1415 =head2 SetDistributedto
1419 SetDistributedto($distributedto,$subscriptionid);
1420 This function update the value of distributedto for a subscription given on input arg.
1425 sub SetDistributedto {
1426 my ($distributedto,$subscriptionid) = @_;
1427 my $dbh = C4::Context->dbh;
1431 WHERE subscriptionid=?
1433 my $sth = $dbh->prepare($query);
1434 $sth->execute($distributedto,$subscriptionid);
1437 =head2 DelSubscription
1441 DelSubscription($subscriptionid)
1442 this function delete the subscription which has $subscriptionid as id.
1447 sub DelSubscription {
1448 my ($subscriptionid) = @_;
1449 my $dbh = C4::Context->dbh;
1450 $subscriptionid=$dbh->quote($subscriptionid);
1451 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1452 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1453 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1460 DelIssue($serialseq,$subscriptionid)
1461 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1467 my ($serialseq,$subscriptionid) = @_;
1468 my $dbh = C4::Context->dbh;
1472 AND subscriptionid= ?
1474 my $sth = $dbh->prepare($query);
1475 $sth->execute($serialseq,$subscriptionid);
1478 =head2 GetMissingIssues
1482 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1484 this function select missing issues on database - where serial.status = 4
1487 a count of the number of missing issues
1488 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1489 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1494 sub GetMissingIssues {
1495 my ($supplierid,$serialid) = @_;
1496 my $dbh = C4::Context->dbh;
1500 $byserial = "and serialid = ".$serialid;
1503 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1504 FROM subscription, serial, biblio
1505 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1506 WHERE subscription.subscriptionid = serial.subscriptionid AND
1507 serial.STATUS = 4 and
1508 subscription.aqbooksellerid=$supplierid and
1509 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1512 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1513 FROM subscription, serial, biblio
1514 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1515 WHERE subscription.subscriptionid = serial.subscriptionid AND
1516 serial.STATUS =4 and
1517 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1525 while (my $line = $sth->fetchrow_hashref) {
1526 $odd++ unless $line->{title} eq $last_title;
1527 $last_title = $line->{title} if ($line->{title});
1528 $line->{planneddate} = format_date($line->{planneddate});
1529 $line->{claimdate} = format_date($line->{claimdate});
1530 $line->{'odd'} = 1 if $odd %2 ;
1532 push @issuelist,$line;
1534 return $count,@issuelist;
1537 =head2 removeMissingIssue
1541 removeMissingIssue($subscriptionid)
1543 this function removes an issue from being part of the missing string in
1544 subscriptionlist.missinglist column
1546 called when a missing issue is found from the statecollection.pl file
1551 sub removeMissingIssue {
1552 my ($sequence,$subscriptionid) = @_;
1553 my $dbh = C4::Context->dbh;
1554 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1555 $sth->execute($subscriptionid);
1556 my $data = $sth->fetchrow_hashref;
1557 my $missinglist = $data->{'missinglist'};
1558 my $missinglistbefore = $missinglist;
1559 # warn $missinglist." before";
1560 $missinglist =~ s/($sequence)//;
1561 # warn $missinglist." after";
1562 if($missinglist ne $missinglistbefore){
1563 $missinglist =~ s/\|\s\|/\|/g;
1564 $missinglist =~ s/^\| //g;
1565 $missinglist =~ s/\|$//g;
1566 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1568 WHERE subscriptionid = ?");
1569 $sth2->execute($missinglist,$subscriptionid);
1577 &updateClaim($serialid)
1579 this function updates the time when a claim is issued for late/missing items
1581 called from claims.pl file
1587 my ($serialid) = @_;
1588 my $dbh = C4::Context->dbh;
1589 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1592 $sth->execute($serialid);
1595 =head2 getsupplierbyserialid
1599 ($result) = &getsupplierbyserialid($serialid)
1601 this function is used to find the supplier id given a serial id
1604 hashref containing serialid, subscriptionid, and aqbooksellerid
1609 sub getsupplierbyserialid {
1610 my ($serialid) = @_;
1611 my $dbh = C4::Context->dbh;
1612 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1613 FROM serial, subscription
1614 WHERE serial.subscriptionid = subscription.subscriptionid
1617 $sth->execute($serialid);
1618 my $line = $sth->fetchrow_hashref;
1619 my $result = $line->{'aqbooksellerid'};
1623 =head2 check_routing
1627 ($result) = &check_routing($subscriptionid)
1629 this function checks to see if a serial has a routing list and returns the count of routingid
1630 used to show either an 'add' or 'edit' link
1635 my ($subscriptionid) = @_;
1636 my $dbh = C4::Context->dbh;
1637 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1638 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1639 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1641 $sth->execute($subscriptionid);
1642 my $line = $sth->fetchrow_hashref;
1643 my $result = $line->{'routingids'};
1647 =head2 addroutingmember
1651 &addroutingmember($bornum,$subscriptionid)
1653 this function takes a borrowernumber and subscriptionid and add the member to the
1654 routing list for that serial subscription and gives them a rank on the list
1655 of either 1 or highest current rank + 1
1660 sub addroutingmember {
1661 my ($bornum,$subscriptionid) = @_;
1663 my $dbh = C4::Context->dbh;
1664 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1665 $sth->execute($subscriptionid);
1666 while(my $line = $sth->fetchrow_hashref){
1667 if($line->{'rank'}>0){
1668 $rank = $line->{'rank'}+1;
1673 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1674 $sth->execute($subscriptionid,$bornum,$rank);
1677 =head2 reorder_members
1681 &reorder_members($subscriptionid,$routingid,$rank)
1683 this function is used to reorder the routing list
1685 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1686 - it gets all members on list puts their routingid's into an array
1687 - removes the one in the array that is $routingid
1688 - then reinjects $routingid at point indicated by $rank
1689 - then update the database with the routingids in the new order
1694 sub reorder_members {
1695 my ($subscriptionid,$routingid,$rank) = @_;
1696 my $dbh = C4::Context->dbh;
1697 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1698 $sth->execute($subscriptionid);
1700 while(my $line = $sth->fetchrow_hashref){
1701 push(@result,$line->{'routingid'});
1703 # To find the matching index
1705 my $key = -1; # to allow for 0 being a valid response
1706 for ($i = 0; $i < @result; $i++) {
1707 if ($routingid == $result[$i]) {
1708 $key = $i; # save the index
1712 # if index exists in array then move it to new position
1713 if($key > -1 && $rank > 0){
1714 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1715 my $moving_item = splice(@result, $key, 1);
1716 splice(@result, $new_rank, 0, $moving_item);
1718 for(my $j = 0; $j < @result; $j++){
1719 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1724 =head2 delroutingmember
1728 &delroutingmember($routingid,$subscriptionid)
1730 this function either deletes one member from routing list if $routingid exists otherwise
1731 deletes all members from the routing list
1736 sub delroutingmember {
1737 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1738 my ($routingid,$subscriptionid) = @_;
1739 my $dbh = C4::Context->dbh;
1741 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1742 $sth->execute($routingid);
1743 reorder_members($subscriptionid,$routingid);
1745 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1746 $sth->execute($subscriptionid);
1750 =head2 getroutinglist
1754 ($count,@routinglist) = &getroutinglist($subscriptionid)
1756 this gets the info from the subscriptionroutinglist for $subscriptionid
1759 a count of the number of members on routinglist
1760 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1761 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1766 sub getroutinglist {
1767 my ($subscriptionid) = @_;
1768 my $dbh = C4::Context->dbh;
1769 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1770 ranking, biblionumber FROM subscriptionroutinglist, subscription
1771 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1772 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1774 $sth->execute($subscriptionid);
1777 while (my $line = $sth->fetchrow_hashref) {
1779 push(@routinglist,$line);
1781 return ($count,@routinglist);
1784 =head2 abouttoexpire
1788 $result = &abouttoexpire($subscriptionid)
1790 this function alerts you to the penultimate issue for a serial subscription
1792 returns 1 - if this is the penultimate issue
1800 my ($subscriptionid) = @_;
1801 my $dbh = C4::Context->dbh;
1802 my $subscription = getsubscription($subscriptionid);
1803 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1804 if ($subscription->{numberlength}) {
1805 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1806 $sth->execute($subscriptionid,$subscription->{startdate});
1807 my $res = $sth->fetchrow;
1808 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1809 if ($subscription->{numberlength}==$res) {
1815 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1816 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1817 $sth->execute($subscriptionid);
1818 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1819 my $endofsubscriptiondate;
1820 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1821 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1822 # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1823 my $per = $subscription->{'periodicity'};
1825 if ($per == 1) { $x = '1 day'; }
1826 if ($per == 2) { $x = '1 week'; }
1827 if ($per == 3) { $x = '2 weeks'; }
1828 if ($per == 4) { $x = '3 weeks'; }
1829 if ($per == 5) { $x = '1 month'; }
1830 if ($per == 6) { $x = '2 months'; }
1831 if ($per == 7 || $per == 8) { $x = '3 months'; }
1832 if ($per == 9) { $x = '6 months'; }
1833 if ($per == 10) { $x = '1 year'; }
1834 if ($per == 11) { $x = '2 years'; }
1835 my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1836 # warn "DATE BEFORE END: $datebeforeend";
1837 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1842 =head2 old_newsubscription
1846 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1847 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1848 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1849 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1850 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1851 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
1853 this function is similar to the NewSubscription subroutine but has a few different
1855 $firstacquidate - date of first serial issue to arrive
1856 $irregularity - the issues not expected separated by a '|'
1857 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1858 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1859 alt_subscription-add.tmpl file
1860 $callnumber - display the callnumber of the serial
1861 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1864 the $subscriptionid number of the new subscription
1869 sub old_newsubscription {
1870 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1871 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1872 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1873 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1874 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1875 $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_;
1876 my $dbh = C4::Context->dbh;
1878 my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1879 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
1880 add1,every1,whenmorethan1,setto1,lastvalue1,
1881 add2,every2,whenmorethan2,setto2,lastvalue2,
1882 add3,every3,whenmorethan3,setto3,lastvalue3,
1883 numberingmethod, status, callnumber, notes, hemisphere) values
1884 (?,?,?,?,?,?,?,?,?,?,?,
1885 ?,?,?,?,?,?,?,?,?,?,?,
1886 ?,?,?,?,?,?,?,?,?,?,?,?)");
1887 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1888 format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1889 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1890 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1891 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1892 $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1893 #then create the 1st waited number
1894 my $subscriptionid = $dbh->{'mysql_insertid'};
1895 my $enddate = subscriptionexpirationdate($subscriptionid);
1897 $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1898 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1899 # reread subscription to get a hash (for calculation of the 1st issue number)
1900 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1901 $sth->execute($subscriptionid);
1902 my $val = $sth->fetchrow_hashref;
1904 # calculate issue number
1905 my $serialseq = Get_Seq($val);
1906 $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1907 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1908 return $subscriptionid;
1911 =head2 old_modsubscription
1915 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1916 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1917 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1918 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1919 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1920 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
1922 this function is similar to the ModSubscription subroutine but has a few different
1924 $firstacquidate - date of first serial issue to arrive
1925 $irregularity - the issues not expected separated by a '|'
1926 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1927 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1928 alt_subscription-add.tmpl file
1929 $callnumber - display the callnumber of the serial
1930 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1935 sub old_modsubscription {
1936 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1937 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1938 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1939 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1940 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1941 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1942 my $dbh = C4::Context->dbh;
1943 my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1944 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1945 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1946 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1947 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1948 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1949 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1950 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1951 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1952 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1953 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1954 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1958 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1959 $sth->execute($subscriptionid);
1960 my $val = $sth->fetchrow_hashref;
1962 # calculate issue number
1963 my $serialseq = Get_Seq($val);
1964 $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1965 $sth->execute($serialseq,$subscriptionid);
1967 my $enddate = subscriptionexpirationdate($subscriptionid);
1968 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1969 $sth->execute(format_date_in_iso($enddate));
1972 =head2 old_getserials
1976 ($totalissues,@serials) = &old_getserials($subscriptionid)
1978 this function get a hashref of serials and the total count of them
1981 $totalissues - number of serial lines
1982 the serials into a table. Each line of this table containts a ref to a hash which it containts
1983 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
1988 sub old_getserials {
1989 my ($subscriptionid) = @_;
1990 my $dbh = C4::Context->dbh;
1991 # status = 2 is "arrived"
1992 my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1993 $sth->execute($subscriptionid);
1996 while(my $line = $sth->fetchrow_hashref) {
1997 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1998 $line->{"planneddate"} = format_date($line->{"planneddate"});
1999 $line->{"num"} = $num;
2001 push @serials,$line;
2003 $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
2004 $sth->execute($subscriptionid);
2005 my ($totalissues) = $sth->fetchrow;
2006 return ($totalissues,@serials);
2009 =head2 Get_Next_Date
2013 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
2015 this function is an extension of GetNextDate which allows for checking for irregularity
2017 it takes the planneddate and will return the next issue's date and will skip dates if there
2018 exists an irregularity
2019 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2020 skipped then the returned date will be 2007-05-10
2023 $resultdate - then next date in the sequence
2028 sub Get_Next_Date(@) {
2029 my ($planneddate,$subscription) = @_;
2030 my @irreg = split(/\|/,$subscription->{irregularity});
2032 my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
2033 my $dayofweek = Date_DayOfWeek($month,$day,$year);
2035 # warn "DOW $dayofweek";
2036 if ($subscription->{periodicity} == 1) {
2037 for(my $i=0;$i<@irreg;$i++){
2038 if($dayofweek == 7){ $dayofweek = 0; }
2039 if(in_array(($dayofweek+1), @irreg)){
2040 $planneddate = DateCalc($planneddate,"1 day");
2044 $resultdate=DateCalc($planneddate,"1 day");
2046 if ($subscription->{periodicity} == 2) {
2047 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2048 for(my $i = 0;$i < @irreg; $i++){
2049 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2050 if($irreg[$i] == ($wkno+1)){
2051 $planneddate = DateCalc($planneddate,"1 week");
2055 $resultdate=DateCalc($planneddate,"1 week");
2057 if ($subscription->{periodicity} == 3) {
2058 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2059 for(my $i = 0;$i < @irreg; $i++){
2060 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2061 if($irreg[$i] == ($wkno+1)){
2062 $planneddate = DateCalc($planneddate,"2 weeks");
2066 $resultdate=DateCalc($planneddate,"2 weeks");
2068 if ($subscription->{periodicity} == 4) {
2069 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2070 for(my $i = 0;$i < @irreg; $i++){
2071 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2072 if($irreg[$i] == ($wkno+1)){
2073 $planneddate = DateCalc($planneddate,"3 weeks");
2077 $resultdate=DateCalc($planneddate,"3 weeks");
2079 if ($subscription->{periodicity} == 5) {
2080 for(my $i = 0;$i < @irreg; $i++){
2083 if($month == 12) { $month = 0; } # need to rollover to check January
2084 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2085 $planneddate = DateCalc($planneddate,"1 month");
2086 $month++; # to check if following ones are to be skipped too
2089 $resultdate=DateCalc($planneddate,"1 month");
2090 # warn "Planneddate2: $planneddate";
2092 if ($subscription->{periodicity} == 6) {
2093 for(my $i = 0;$i < @irreg; $i++){
2094 if($month == 12) { $month = 0; } # need to rollover to check January
2095 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2096 $planneddate = DateCalc($planneddate,"2 months");
2097 $month++; # to check if following ones are to be skipped too
2100 $resultdate=DateCalc($planneddate,"2 months");
2102 if ($subscription->{periodicity} == 7) {
2103 for(my $i = 0;$i < @irreg; $i++){
2104 if($month == 12) { $month = 0; } # need to rollover to check January
2105 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2106 $planneddate = DateCalc($planneddate,"3 months");
2107 $month++; # to check if following ones are to be skipped too
2110 $resultdate=DateCalc($planneddate,"3 months");
2112 if ($subscription->{periodicity} == 8) {
2113 for(my $i = 0;$i < @irreg; $i++){
2114 if($month == 12) { $month = 0; } # need to rollover to check January
2115 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2116 $planneddate = DateCalc($planneddate,"3 months");
2117 $month++; # to check if following ones are to be skipped too
2120 $resultdate=DateCalc($planneddate,"3 months");
2122 if ($subscription->{periodicity} == 9) {
2123 for(my $i = 0;$i < @irreg; $i++){
2124 if($month == 12) { $month = 0; } # need to rollover to check January
2125 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2126 $planneddate = DateCalc($planneddate,"6 months");
2127 $month++; # to check if following ones are to be skipped too
2130 $resultdate=DateCalc($planneddate,"6 months");
2132 if ($subscription->{periodicity} == 10) {
2133 $resultdate=DateCalc($planneddate,"1 year");
2135 if ($subscription->{periodicity} == 11) {
2136 $resultdate=DateCalc($planneddate,"2 years");
2138 # warn "date: ".$resultdate;
2139 return format_date_in_iso($resultdate);
2143 END { } # module clean-up code here (global destructor)