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
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32 # set the version for version checking
33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
34 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
39 C4::Serials - Give functions for serializing.
47 Give all XYZ functions
54 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
55 &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
56 &GetFullSubscriptionsFromBiblionumber &GetNextSeq
57 &ModSubscriptionHistory &NewIssue &ItemizeSerials
58 &GetSerials &GetLatestSerials &ModSerialStatus
59 &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
60 &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
61 &GetDistributedTo &SetDistributedto &serialchangestatus
62 &getroutinglist &delroutingmember &addroutingmember &reorder_members
63 &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
64 &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date
67 =head2 GetSuppliersWithLateIssues
71 %supplierlist = &GetSuppliersWithLateIssues
73 this function get all suppliers with late issues.
76 the supplierlist into a hash. this hash containts id & name of the supplier
81 sub GetSuppliersWithLateIssues {
82 my $dbh = C4::Context->dbh;
84 SELECT DISTINCT id, name
85 FROM subscription, serial
86 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
87 WHERE subscription.subscriptionid = serial.subscriptionid
88 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
90 my $sth = $dbh->prepare($query);
93 while (my ($id,$name) = $sth->fetchrow) {
94 $supplierlist{$id} = $name;
96 if(C4::Context->preference("RoutingSerials")){
97 $supplierlist{''} = "All Suppliers";
106 @issuelist = &GetLateIssues($supplierid)
108 this function select late issues on database
111 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
112 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
118 my ($supplierid) = @_;
119 my $dbh = C4::Context->dbh;
123 SELECT name,title,planneddate,serialseq,serial.subscriptionid
124 FROM subscription, serial, biblio
125 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
126 WHERE subscription.subscriptionid = serial.subscriptionid
127 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
128 AND subscription.aqbooksellerid=$supplierid
129 AND biblio.biblionumber = subscription.biblionumber
132 $sth = $dbh->prepare($query);
135 SELECT name,title,planneddate,serialseq,serial.subscriptionid
136 FROM subscription, serial, biblio
137 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
138 WHERE subscription.subscriptionid = serial.subscriptionid
139 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
140 AND biblio.biblionumber = subscription.biblionumber
143 $sth = $dbh->prepare($query);
150 while (my $line = $sth->fetchrow_hashref) {
151 $odd++ unless $line->{title} eq $last_title;
152 $line->{title} = "" if $line->{title} eq $last_title;
153 $last_title = $line->{title} if ($line->{title});
154 $line->{planneddate} = format_date($line->{planneddate});
155 $line->{'odd'} = 1 if $odd %2 ;
157 push @issuelist,$line;
159 return $count,@issuelist;
162 =head2 GetSubscriptionHistoryFromSubscriptionId
166 $sth = GetSubscriptionHistoryFromSubscriptionId()
167 this function just prepare the SQL request.
168 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
170 $sth = $dbh->prepare($query).
175 sub GetSubscriptionHistoryFromSubscriptionId() {
176 my $dbh = C4::Context->dbh;
179 FROM subcriptionhistory
180 WHERE subscriptionid = ?
182 return $dbh->prepare($query);
185 =head2 GetSerialStatusFromSerialId
189 $sth = GetSerialStatusFromSerialId();
190 this function just prepare the SQL request.
191 After this function, don't forget to execute it by using $sth->execute($serialid)
193 $sth = $dbh->prepare($query).
198 sub GetSerialStatusFromSerialId(){
199 my $dbh = C4::Context->dbh;
205 return $dbh->prepare($query);
209 =head2 GetSubscription
213 $subs = GetSubscription($subscriptionid)
214 this function get the subscription which has $subscriptionid as id.
216 a hashref. This hash containts
217 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
222 sub GetSubscription {
223 my ($subscriptionid) = @_;
224 my $dbh = C4::Context->dbh;
226 SELECT subscription.*,
227 subscriptionhistory.*,
229 aqbooksellers.name AS aqbooksellername,
230 biblio.title AS bibliotitle
232 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
233 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
234 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
235 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
236 WHERE subscription.subscriptionid = ?
238 my $sth = $dbh->prepare($query);
239 $sth->execute($subscriptionid);
240 my $subs = $sth->fetchrow_hashref;
244 =head2 GetSubscriptionsFromBiblionumber
248 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
249 this function get the subscription list. it reads on subscription table.
251 table of subscription which has the biblionumber given on input arg.
252 each line of this table is a hashref. All hashes containt
253 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
258 sub GetSubscriptionsFromBiblionumber {
259 my ($biblionumber) = @_;
260 my $dbh = C4::Context->dbh;
262 SELECT subscription.*,
263 subscriptionhistory.*,
265 aqbooksellers.name AS aqbooksellername,
266 biblio.title AS bibliotitle
268 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
269 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
270 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
271 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
272 WHERE subscription.biblionumber = ?
274 my $sth = $dbh->prepare($query);
275 $sth->execute($biblionumber);
277 while (my $subs = $sth->fetchrow_hashref) {
278 $subs->{startdate} = format_date($subs->{startdate});
279 $subs->{histstartdate} = format_date($subs->{histstartdate});
280 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
281 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
282 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
283 $subs->{"periodicity".$subs->{periodicity}} = 1;
284 $subs->{"status".$subs->{'status'}} = 1;
285 if ($subs->{enddate} eq '0000-00-00') {
288 $subs->{enddate} = format_date($subs->{enddate});
294 =head2 GetFullSubscriptionsFromBiblionumber
298 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
299 this function read on serial table.
304 sub GetFullSubscriptionsFromBiblionumber {
305 my ($biblionumber) = @_;
306 my $dbh = C4::Context->dbh;
308 SELECT serial.serialseq,
310 serial.publisheddate,
313 year(serial.publisheddate) AS year,
314 aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
315 biblio.title AS bibliotitle
317 LEFT JOIN subscription ON
318 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
319 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
320 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
321 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
322 WHERE subscription.biblionumber = ?
323 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
326 my $sth = $dbh->prepare($query);
327 $sth->execute($biblionumber);
331 my $aqbooksellername;
336 while (my $subs = $sth->fetchrow_hashref) {
337 ### BUG To FIX: When there is no published date, will create many null ids!!!
339 if ($year and ($year==$subs->{year})){
340 if ($first eq 1){$first=0;}
341 my $temp=$res[scalar(@res)-1]->{'serials'};
343 {'publisheddate' =>format_date($subs->{'publisheddate'}),
344 'planneddate' => format_date($subs->{'planneddate'}),
345 'serialseq' => $subs->{'serialseq'},
346 "status".$subs->{'status'} => 1,
347 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
350 $first=1 if (not $year);
351 $year= $subs->{'year'};
352 $startdate= format_date($subs->{'startdate'});
353 $aqbooksellername= $subs->{'aqbooksellername'};
354 $bibliotitle= $subs->{'bibliotitle'};
357 {'publisheddate' =>format_date($subs->{'publisheddate'}),
358 'planneddate' => format_date($subs->{'planneddate'}),
359 'serialseq' => $subs->{'serialseq'},
360 "status".$subs->{'status'} => 1,
361 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
366 'startdate'=>$startdate,
367 'aqbooksellername'=>$aqbooksellername,
368 'bibliotitle'=>$bibliotitle,
373 $previousnote=$subs->{notes};
379 =head2 GetSubscriptions
383 @results = GetSubscriptions($title,$ISSN,$biblionumber);
384 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
386 a table of hashref. Each hash containt the subscription.
391 sub GetSubscriptions {
392 my ($title,$ISSN,$biblionumber) = @_;
393 return unless $title or $ISSN or $biblionumber;
394 my $dbh = C4::Context->dbh;
398 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
399 FROM subscription,biblio,biblioitems
400 WHERE biblio.biblionumber = biblioitems.biblionumber
401 AND biblio.biblionumber = subscription.biblionumber
402 AND biblio.biblionumber=?
405 $sth = $dbh->prepare($query);
406 $sth->execute($biblionumber);
408 if ($ISSN and $title){
410 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
411 FROM subscription,biblio,biblioitems
412 WHERE biblio.biblionumber = biblioitems.biblionumber
413 AND biblio.biblionumber= subscription.biblionumber
414 AND (biblio.title LIKE ? or biblioitems.issn = ?)
417 $sth = $dbh->prepare($query);
418 $sth->execute("%$title%",$ISSN);
423 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
424 FROM subscription,biblio,biblioitems
425 WHERE biblio.biblionumber = biblioitems.biblionumber
426 AND biblio.biblionumber=subscription.biblionumber
427 AND biblioitems.issn = ?
430 $sth = $dbh->prepare($query);
431 $sth->execute($ISSN);
434 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
435 FROM subscription,biblio,biblioitems
436 WHERE biblio.biblionumber = biblioitems.biblionumber
437 AND biblio.biblionumber=subscription.biblionumber
438 AND biblio.title LIKE ?
441 $sth = $dbh->prepare($query);
442 $sth->execute("%$title%");
447 my $previoustitle="";
449 while (my $line = $sth->fetchrow_hashref) {
450 if ($previoustitle eq $line->{title}) {
453 $line->{toggle} = 1 if $odd==1;
455 $previoustitle=$line->{title};
457 $line->{toggle} = 1 if $odd==1;
459 push @results, $line;
468 ($totalissues,@serials) = GetSerials($subscriptionid);
469 this function get every serial not arrived for a given subscription
470 as well as the number of issues registered in the database (all types)
471 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
477 my ($subscriptionid) = @_;
478 my $dbh = C4::Context->dbh;
479 # OK, now add the last 5 issues arrives/missing
481 SELECT serialid,serialseq, status, planneddate,notes
483 WHERE subscriptionid = ?
484 AND (status in (2,4,5))
485 ORDER BY serialid DESC
487 my $sth=$dbh->prepare($query);
488 $sth->execute($subscriptionid);
491 while((my $line = $sth->fetchrow_hashref) && $counter <5) {
493 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
494 $line->{"planneddate"} = format_date($line->{"planneddate"});
497 # status = 2 is "arrived"
499 SELECT serialid,serialseq, status, publisheddate, planneddate,notes
501 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
503 my $sth=$dbh->prepare($query);
504 $sth->execute($subscriptionid);
505 while(my $line = $sth->fetchrow_hashref) {
506 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
507 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
508 $line->{"planneddate"} = format_date($line->{"planneddate"});
514 WHERE subscriptionid=?
516 $sth=$dbh->prepare($query);
517 $sth->execute($subscriptionid);
518 my ($totalissues) = $sth->fetchrow;
519 return ($totalissues,@serials);
522 =head2 GetLatestSerials
526 \@serials = GetLatestSerials($subscriptionid,$limit)
527 get the $limit's latest serials arrived or missing for a given subscription
529 a ref to a table which it containts all of the latest serials stored into a hash.
534 sub GetLatestSerials {
535 my ($subscriptionid,$limit) = @_;
536 my $dbh = C4::Context->dbh;
537 # status = 2 is "arrived"
539 SELECT serialid,serialseq, status, planneddate
541 WHERE subscriptionid = ?
542 AND (status =2 or status=4)
543 ORDER BY planneddate DESC LIMIT 0,$limit
545 my $sth=$dbh->prepare($strsth);
546 $sth->execute($subscriptionid);
548 while(my $line = $sth->fetchrow_hashref) {
549 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
550 $line->{"planneddate"} = format_date($line->{"planneddate"});
556 # WHERE subscriptionid=?
558 # $sth=$dbh->prepare($query);
559 # $sth->execute($subscriptionid);
560 # my ($totalissues) = $sth->fetchrow;
564 =head2 GetDistributedTo
568 $distributedto=GetDistributedTo($subscriptionid)
569 This function select the old previous value of distributedto in the database.
574 sub GetDistributedTo {
575 my $dbh = C4::Context->dbh;
577 my $subscriptionid = @_;
581 WHERE subscriptionid=?
583 my $sth = $dbh->prepare($query);
584 $sth->execute($subscriptionid);
585 return ($distributedto) = $sth->fetchrow;
593 $val is a hashref containing all the attributes of the table 'subscription'
594 This function get the next issue for the subscription given on input arg
596 all the input params updated.
603 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
604 $calculated = $val->{numberingmethod};
605 # calculate the (expected) value of the next issue recieved.
606 $newlastvalue1 = $val->{lastvalue1};
607 # check if we have to increase the new value.
608 $newinnerloop1 = $val->{innerloop1}+1;
609 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
610 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
611 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
612 $calculated =~ s/\{X\}/$newlastvalue1/g;
614 $newlastvalue2 = $val->{lastvalue2};
615 # check if we have to increase the new value.
616 $newinnerloop2 = $val->{innerloop2}+1;
617 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
618 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
619 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
620 $calculated =~ s/\{Y\}/$newlastvalue2/g;
622 $newlastvalue3 = $val->{lastvalue3};
623 # check if we have to increase the new value.
624 $newinnerloop3 = $val->{innerloop3}+1;
625 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
626 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
627 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
628 $calculated =~ s/\{Z\}/$newlastvalue3/g;
629 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
633 sub New_Get_Next_Seq {
635 my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
636 my $pattern = $val->{numberpattern};
637 my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
638 my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
639 $calculated = $val->{numberingmethod};
640 $newlastvalue1 = $val->{lastvalue1};
641 $newlastvalue2 = $val->{lastvalue2};
642 $newlastvalue3 = $val->{lastvalue3};
643 if($newlastvalue3 > 0){ # if x y and z columns are used
644 $newlastvalue3 = $newlastvalue3+1;
645 if($newlastvalue3 > $val->{whenmorethan3}){
646 $newlastvalue3 = $val->{setto3};
648 if($newlastvalue2 > $val->{whenmorethan2}){
650 $newlastvalue2 = $val->{setto2};
653 $calculated =~ s/\{X\}/$newlastvalue1/g;
655 if($val->{hemisphere} == 2){
656 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
657 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
659 my $newlastvalue2seq = $seasons[$newlastvalue2];
660 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
663 $calculated =~ s/\{Y\}/$newlastvalue2/g;
665 $calculated =~ s/\{Z\}/$newlastvalue3/g;
667 if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
668 $newlastvalue2 = $newlastvalue2+1;
669 if($newlastvalue2 > $val->{whenmorethan2}){
670 $newlastvalue2 = $val->{setto2};
673 $calculated =~ s/\{X\}/$newlastvalue1/g;
675 if($val->{hemisphere} == 2){
676 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
677 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
679 my $newlastvalue2seq = $seasons[$newlastvalue2];
680 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
683 $calculated =~ s/\{Y\}/$newlastvalue2/g;
686 if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
687 $newlastvalue1 = $newlastvalue1+1;
688 if($newlastvalue1 > $val->{whenmorethan1}){
689 $newlastvalue1 = $val->{setto2};
691 $calculated =~ s/\{X\}/$newlastvalue1/g;
693 return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
701 $resultdate = GetNextDate($planneddate,$subscription)
703 this function get the date after $planneddate.
705 the date on ISO format.
711 my ($planneddate,$subscription) = @_;
713 if ($subscription->{periodicity} == 1) {
714 $resultdate=DateCalc($planneddate,"1 day");
716 if ($subscription->{periodicity} == 2) {
717 $resultdate=DateCalc($planneddate,"1 week");
719 if ($subscription->{periodicity} == 3) {
720 $resultdate=DateCalc($planneddate,"2 weeks");
722 if ($subscription->{periodicity} == 4) {
723 $resultdate=DateCalc($planneddate,"3 weeks");
725 if ($subscription->{periodicity} == 5) {
726 $resultdate=DateCalc($planneddate,"1 month");
728 if ($subscription->{periodicity} == 6) {
729 $resultdate=DateCalc($planneddate,"2 months");
731 if ($subscription->{periodicity} == 7) {
732 $resultdate=DateCalc($planneddate,"3 months");
734 if ($subscription->{periodicity} == 8) {
735 $resultdate=DateCalc($planneddate,"3 months");
737 if ($subscription->{periodicity} == 9) {
738 $resultdate=DateCalc($planneddate,"6 months");
740 if ($subscription->{periodicity} == 10) {
741 $resultdate=DateCalc($planneddate,"1 year");
743 if ($subscription->{periodicity} == 11) {
744 $resultdate=DateCalc($planneddate,"2 years");
746 return format_date_in_iso($resultdate);
753 $calculated = GetSeq($val)
754 $val is a hashref containing all the attributes of the table 'subscription'
755 this function transforms {X},{Y},{Z} to 150,0,0 for example.
757 the sequence in integer format
764 my $calculated = $val->{numberingmethod};
765 my $x=$val->{'lastvalue1'};
766 $calculated =~ s/\{X\}/$x/g;
767 my $y=$val->{'lastvalue2'};
768 $calculated =~ s/\{Y\}/$y/g;
769 my $z=$val->{'lastvalue3'};
770 $calculated =~ s/\{Z\}/$z/g;
774 =head2 GetSubscriptionExpirationDate
778 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
780 this function return the expiration date for a subscription given on input args.
788 sub GetSubscriptionExpirationDate {
789 my ($subscriptionid) = @_;
790 my $dbh = C4::Context->dbh;
791 my $subscription = GetSubscription($subscriptionid);
792 my $enddate=$subscription->{startdate};
793 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
794 if ($subscription->{numberlength}) {
795 #calculate the date of the last issue.
796 for (my $i=1;$i<=$subscription->{numberlength};$i++) {
797 $enddate = GetNextDate($enddate,$subscription);
801 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
802 $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
807 =head2 CountSubscriptionFromBiblionumber
811 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
812 this count the number of subscription for a biblionumber given.
814 the number of subscriptions with biblionumber given on input arg.
819 sub CountSubscriptionFromBiblionumber {
820 my ($biblionumber) = @_;
821 my $dbh = C4::Context->dbh;
827 my $sth = $dbh->prepare($query);
828 $sth->execute($biblionumber);
829 my $subscriptionsnumber = $sth->fetchrow;
830 return $subscriptionsnumber;
834 =head2 ModSubscriptionHistory
838 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
840 this function modify the history of a subscription. Put your new values on input arg.
845 sub ModSubscriptionHistory {
846 my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
847 my $dbh=C4::Context->dbh;
849 UPDATE subscriptionhistory
850 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
851 WHERE subscriptionid=?
853 my $sth = $dbh->prepare($query);
854 $recievedlist =~ s/^,//g;
855 $missinglist =~ s/^,//g;
856 $opacnote =~ s/^,//g;
857 $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
860 =head2 ModSerialStatus
864 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
866 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
867 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
872 sub ModSerialStatus {
873 my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
874 # 1st, get previous status :
875 my $dbh = C4::Context->dbh;
877 SELECT subscriptionid,status
881 my $sth = $dbh->prepare($query);
882 $sth->execute($serialid);
883 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
884 # change status & update subscriptionhistory
886 DelIssue($serialseq, $subscriptionid)
890 SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
893 $sth = $dbh->prepare($query);
894 $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
896 SELECT missinglist,recievedlist
897 FROM subscriptionhistory
898 WHERE subscriptionid=?
900 $sth = $dbh->prepare($query);
901 $sth->execute($subscriptionid);
902 my ($missinglist,$recievedlist) = $sth->fetchrow;
904 $recievedlist .= ",$serialseq";
906 $missinglist .= ",$serialseq" if ($status eq 4) ;
907 $missinglist .= ",not issued $serialseq" if ($status eq 5);
909 UPDATE subscriptionhistory
910 SET recievedlist=?, missinglist=?
911 WHERE subscriptionid=?
913 $sth=$dbh->prepare($query);
914 $sth->execute($recievedlist,$missinglist,$subscriptionid);
916 # create new waited entry if needed (ie : was a "waited" and has changed)
917 if ($oldstatus eq 1 && $status ne 1) {
921 WHERE subscriptionid = ?
923 $sth = $dbh->prepare($query);
924 $sth->execute($subscriptionid);
925 my $val = $sth->fetchrow_hashref;
927 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
928 # next date (calculated from actual date & frequency parameters)
929 my $nextpublisheddate = GetNextDate($publisheddate,$val);
930 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
933 SET lastvalue1=?, lastvalue2=?, lastvalue3=?,
934 innerloop1=?, innerloop2=?, innerloop3=?
935 WHERE subscriptionid = ?
937 $sth = $dbh->prepare($query);
938 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
942 =head2 ModSubscription
946 this function modify a subscription. Put all new values on input args.
951 sub ModSubscription {
952 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
953 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
954 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
955 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
956 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
957 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
958 my $dbh = C4::Context->dbh;
961 SET librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
962 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
963 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
964 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
965 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
966 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
967 WHERE subscriptionid = ?
969 my $sth=$dbh->prepare($query);
970 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
971 $periodicity,$dow,$numberlength,$weeklength,$monthlength,
972 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
973 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
974 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
975 $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
980 =head2 NewSubscription
984 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
985 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
986 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
987 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
988 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
989 $numberingmethod, $status, $notes)
991 Create a new subscription with value given on input args.
994 the id of this new subscription
999 sub NewSubscription {
1000 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1001 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1002 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1003 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1004 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1005 $numberingmethod, $status, $notes) = @_;
1006 my $dbh = C4::Context->dbh;
1007 #save subscription (insert into database)
1009 INSERT INTO subscription
1010 (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1011 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1012 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1013 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1014 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1015 numberingmethod, status, notes)
1016 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1018 my $sth=$dbh->prepare($query);
1020 $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1021 format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1022 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1023 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1024 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1025 $numberingmethod, $status, $notes);
1027 #then create the 1st waited number
1028 my $subscriptionid = $dbh->{'mysql_insertid'};
1030 INSERT INTO subscriptionhistory
1031 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1032 VALUES (?,?,?,?,?,?,?,?)
1034 $sth = $dbh->prepare($query);
1035 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
1037 # reread subscription to get a hash (for calculation of the 1st issue number)
1041 WHERE subscriptionid = ?
1043 $sth = $dbh->prepare($query);
1044 $sth->execute($subscriptionid);
1045 my $val = $sth->fetchrow_hashref;
1047 # calculate issue number
1048 my $serialseq = GetSeq($val);
1051 (serialseq,subscriptionid,biblionumber,status, planneddate)
1054 $sth = $dbh->prepare($query);
1055 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1056 return $subscriptionid;
1060 =head2 ReNewSubscription
1064 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1066 this function renew a subscription with values given on input args.
1071 sub ReNewSubscription {
1072 my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1073 my $dbh = C4::Context->dbh;
1074 my $subscription = GetSubscription($subscriptionid);
1077 FROM biblio,biblioitems
1078 WHERE biblio.biblionumber=biblioitems.biblionumber
1079 AND biblio.biblionumber=?
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($subscription->{biblionumber});
1083 my $biblio = $sth->fetchrow_hashref;
1084 NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1085 # renew subscription
1088 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1089 WHERE subscriptionid=?
1091 $sth=$dbh->prepare($query);
1092 $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1100 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1102 Create a new issue stored on the database.
1103 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1109 my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1110 my $dbh = C4::Context->dbh;
1113 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1114 VALUES (?,?,?,?,?,?)
1116 my $sth = $dbh->prepare($query);
1117 $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1119 SELECT missinglist,recievedlist
1120 FROM subscriptionhistory
1121 WHERE subscriptionid=?
1123 $sth = $dbh->prepare($query);
1124 $sth->execute($subscriptionid);
1125 my ($missinglist,$recievedlist) = $sth->fetchrow;
1127 $recievedlist .= ",$serialseq";
1130 $missinglist .= ",$serialseq";
1133 UPDATE subscriptionhistory
1134 SET recievedlist=?, missinglist=?
1135 WHERE subscriptionid=?
1137 $sth=$dbh->prepare($query);
1138 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1141 =head2 serialchangestatus
1145 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1147 Change the status of a serial issue.
1148 Note: this was the older subroutine
1153 sub serialchangestatus {
1154 my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1155 # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1156 my $dbh = C4::Context->dbh;
1157 my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1158 $sth->execute($serialid);
1159 my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1160 # change status & update subscriptionhistory
1162 delissue($serialseq, $subscriptionid)
1164 $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1165 $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1166 $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1167 $sth->execute($subscriptionid);
1168 my ($missinglist,$recievedlist) = $sth->fetchrow;
1170 $recievedlist .= "| $serialseq";
1171 $recievedlist =~ s/^\| //g;
1173 $missinglist .= "| $serialseq" if ($status eq 4) ;
1174 $missinglist .= "| not issued $serialseq" if ($status eq 5);
1175 $missinglist =~ s/^\| //g;
1176 $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1177 $sth->execute($recievedlist,$missinglist,$subscriptionid);
1179 # create new waited entry if needed (ie : was a "waited" and has changed)
1180 if ($oldstatus eq 1 && $status ne 1) {
1181 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1182 $sth->execute($subscriptionid);
1183 my $val = $sth->fetchrow_hashref;
1185 my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1186 my $nextplanneddate = Get_Next_Date($planneddate,$val);
1187 NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1188 $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1189 $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1194 =head2 ItemizeSerials
1198 ItemizeSerials($serialid, $info);
1199 $info is a hashref containing barcode branch, itemcallnumber, status, location
1200 $serialid the serialid
1202 1 if the itemize is a succes.
1203 0 and @error else. @error containts the list of errors found.
1208 sub ItemizeSerials {
1209 my ($serialid, $info) =@_;
1210 my $now = ParseDate("today");
1211 $now = UnixDate($now,"%Y-%m-%d");
1213 my $dbh= C4::Context->dbh;
1219 my $sth=$dbh->prepare($query);
1220 $sth->execute($serialid);
1221 my $data=$sth->fetchrow_hashref;
1222 if(C4::Context->preference("RoutingSerials")){
1223 # check for existing biblioitem relating to serial issue
1224 my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1226 for(my $i=0;$i<$count;$i++){
1227 if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1228 $bibitemno = $results[$i]->{'biblioitemnumber'};
1232 if($bibitemno == 0){
1233 # warn "need to add new biblioitem so copy last one and make minor changes";
1234 my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1235 $sth->execute($data->{'biblionumber'});
1237 my $biblioitem = $sth->fetchrow_hashref;
1238 $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1239 $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1240 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1241 if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1242 $bibitemno = newbiblioitem($biblioitem);
1247 my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1248 my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1249 if ($info->{barcode}){
1251 my $exists = itemdata($info->{'barcode'});
1252 push @errors,"barcode_not_unique" if($exists);
1254 my $marcrecord = MARC::Record->new();
1255 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1256 my $newField = MARC::Field->new(
1258 "$subfield" => $info->{barcode}
1260 $marcrecord->insert_fields_ordered($newField);
1261 if ($info->{branch}){
1262 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1263 #warn "items.homebranch : $tag , $subfield";
1264 if ($marcrecord->field($tag)) {
1265 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1267 my $newField = MARC::Field->new(
1269 "$subfield" => $info->{branch}
1271 $marcrecord->insert_fields_ordered($newField);
1273 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1274 #warn "items.holdingbranch : $tag , $subfield";
1275 if ($marcrecord->field($tag)) {
1276 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1278 my $newField = MARC::Field->new(
1280 "$subfield" => $info->{branch}
1282 $marcrecord->insert_fields_ordered($newField);
1285 if ($info->{itemcallnumber}){
1286 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1287 #warn "items.itemcallnumber : $tag , $subfield";
1288 if ($marcrecord->field($tag)) {
1289 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1291 my $newField = MARC::Field->new(
1293 "$subfield" => $info->{itemcallnumber}
1295 $marcrecord->insert_fields_ordered($newField);
1298 if ($info->{notes}){
1299 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1300 # warn "items.itemnotes : $tag , $subfield";
1301 if ($marcrecord->field($tag)) {
1302 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1304 my $newField = MARC::Field->new(
1306 "$subfield" => $info->{notes}
1308 $marcrecord->insert_fields_ordered($newField);
1311 if ($info->{location}){
1312 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1313 # warn "items.location : $tag , $subfield";
1314 if ($marcrecord->field($tag)) {
1315 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1317 my $newField = MARC::Field->new(
1319 "$subfield" => $info->{location}
1321 $marcrecord->insert_fields_ordered($newField);
1324 if ($info->{status}){
1325 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1326 # warn "items.notforloan : $tag , $subfield";
1327 if ($marcrecord->field($tag)) {
1328 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1330 my $newField = MARC::Field->new(
1332 "$subfield" => $info->{status}
1334 $marcrecord->insert_fields_ordered($newField);
1337 if(C4::Context->preference("RoutingSerials")){
1338 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1339 if ($marcrecord->field($tag)) {
1340 $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1342 my $newField = MARC::Field->new(
1346 $marcrecord->insert_fields_ordered($newField);
1349 NEWnewitem($dbh,$marcrecord,$bibid);
1356 =head2 HasSubscriptionExpired
1360 1 or 0 = HasSubscriptionExpired($subscriptionid)
1362 the subscription has expired when the next issue to arrive is out of subscription limit.
1365 1 if true, 0 if false.
1370 sub HasSubscriptionExpired {
1371 my ($subscriptionid) = @_;
1372 my $dbh = C4::Context->dbh;
1373 my $subscription = GetSubscription($subscriptionid);
1374 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1375 if ($subscription->{numberlength}) {
1379 WHERE subscriptionid=? AND planneddate>=?
1381 my $sth = $dbh->prepare($query);
1382 $sth->execute($subscriptionid,$subscription->{startdate});
1383 my $res = $sth->fetchrow;
1384 if ($subscription->{numberlength}>=$res) {
1390 #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1392 SELECT max(planneddate)
1394 WHERE subscriptionid=?
1396 my $sth = $dbh->prepare($query);
1397 $sth->execute($subscriptionid);
1398 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1399 my $endofsubscriptiondate;
1400 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1401 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1402 return 1 if ($res >= $endofsubscriptiondate);
1407 =head2 SetDistributedto
1411 SetDistributedto($distributedto,$subscriptionid);
1412 This function update the value of distributedto for a subscription given on input arg.
1417 sub SetDistributedto {
1418 my ($distributedto,$subscriptionid) = @_;
1419 my $dbh = C4::Context->dbh;
1423 WHERE subscriptionid=?
1425 my $sth = $dbh->prepare($query);
1426 $sth->execute($distributedto,$subscriptionid);
1429 =head2 DelSubscription
1433 DelSubscription($subscriptionid)
1434 this function delete the subscription which has $subscriptionid as id.
1439 sub DelSubscription {
1440 my ($subscriptionid) = @_;
1441 my $dbh = C4::Context->dbh;
1442 $subscriptionid=$dbh->quote($subscriptionid);
1443 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1444 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1445 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1452 DelIssue($serialseq,$subscriptionid)
1453 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1459 my ($serialseq,$subscriptionid) = @_;
1460 my $dbh = C4::Context->dbh;
1464 AND subscriptionid= ?
1466 my $sth = $dbh->prepare($query);
1467 $sth->execute($serialseq,$subscriptionid);
1470 =head2 GetMissingIssues
1474 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1476 this function select missing issues on database - where serial.status = 4
1479 a count of the number of missing issues
1480 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1481 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1486 sub GetMissingIssues {
1487 my ($supplierid,$serialid) = @_;
1488 my $dbh = C4::Context->dbh;
1492 $byserial = "and serialid = ".$serialid;
1495 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1496 FROM subscription, serial, biblio
1497 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1498 WHERE subscription.subscriptionid = serial.subscriptionid AND
1499 serial.STATUS = 4 and
1500 subscription.aqbooksellerid=$supplierid and
1501 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1504 $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1505 FROM subscription, serial, biblio
1506 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1507 WHERE subscription.subscriptionid = serial.subscriptionid AND
1508 serial.STATUS =4 and
1509 biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1517 while (my $line = $sth->fetchrow_hashref) {
1518 $odd++ unless $line->{title} eq $last_title;
1519 $last_title = $line->{title} if ($line->{title});
1520 $line->{planneddate} = format_date($line->{planneddate});
1521 $line->{claimdate} = format_date($line->{claimdate});
1522 $line->{'odd'} = 1 if $odd %2 ;
1524 push @issuelist,$line;
1526 return $count,@issuelist;
1529 =head2 removeMissingIssue
1533 removeMissingIssue($subscriptionid)
1535 this function removes an issue from being part of the missing string in
1536 subscriptionlist.missinglist column
1538 called when a missing issue is found from the statecollection.pl file
1543 sub removeMissingIssue {
1544 my ($sequence,$subscriptionid) = @_;
1545 my $dbh = C4::Context->dbh;
1546 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1547 $sth->execute($subscriptionid);
1548 my $data = $sth->fetchrow_hashref;
1549 my $missinglist = $data->{'missinglist'};
1550 my $missinglistbefore = $missinglist;
1551 # warn $missinglist." before";
1552 $missinglist =~ s/($sequence)//;
1553 # warn $missinglist." after";
1554 if($missinglist ne $missinglistbefore){
1555 $missinglist =~ s/\|\s\|/\|/g;
1556 $missinglist =~ s/^\| //g;
1557 $missinglist =~ s/\|$//g;
1558 my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1560 WHERE subscriptionid = ?");
1561 $sth2->execute($missinglist,$subscriptionid);
1569 &updateClaim($serialid)
1571 this function updates the time when a claim is issued for late/missing items
1573 called from claims.pl file
1579 my ($serialid) = @_;
1580 my $dbh = C4::Context->dbh;
1581 my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1584 $sth->execute($serialid);
1587 =head2 getsupplierbyserialid
1591 ($result) = &getsupplierbyserialid($serialid)
1593 this function is used to find the supplier id given a serial id
1596 hashref containing serialid, subscriptionid, and aqbooksellerid
1601 sub getsupplierbyserialid {
1602 my ($serialid) = @_;
1603 my $dbh = C4::Context->dbh;
1604 my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1605 FROM serial, subscription
1606 WHERE serial.subscriptionid = subscription.subscriptionid
1609 $sth->execute($serialid);
1610 my $line = $sth->fetchrow_hashref;
1611 my $result = $line->{'aqbooksellerid'};
1615 =head2 check_routing
1619 ($result) = &check_routing($subscriptionid)
1621 this function checks to see if a serial has a routing list and returns the count of routingid
1622 used to show either an 'add' or 'edit' link
1627 my ($subscriptionid) = @_;
1628 my $dbh = C4::Context->dbh;
1629 my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1630 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1631 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1633 $sth->execute($subscriptionid);
1634 my $line = $sth->fetchrow_hashref;
1635 my $result = $line->{'routingids'};
1639 =head2 addroutingmember
1643 &addroutingmember($bornum,$subscriptionid)
1645 this function takes a borrowernumber and subscriptionid and add the member to the
1646 routing list for that serial subscription and gives them a rank on the list
1647 of either 1 or highest current rank + 1
1652 sub addroutingmember {
1653 my ($bornum,$subscriptionid) = @_;
1655 my $dbh = C4::Context->dbh;
1656 my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1657 $sth->execute($subscriptionid);
1658 while(my $line = $sth->fetchrow_hashref){
1659 if($line->{'rank'}>0){
1660 $rank = $line->{'rank'}+1;
1665 $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1666 $sth->execute($subscriptionid,$bornum,$rank);
1669 =head2 reorder_members
1673 &reorder_members($subscriptionid,$routingid,$rank)
1675 this function is used to reorder the routing list
1677 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1678 - it gets all members on list puts their routingid's into an array
1679 - removes the one in the array that is $routingid
1680 - then reinjects $routingid at point indicated by $rank
1681 - then update the database with the routingids in the new order
1686 sub reorder_members {
1687 my ($subscriptionid,$routingid,$rank) = @_;
1688 my $dbh = C4::Context->dbh;
1689 my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1690 $sth->execute($subscriptionid);
1692 while(my $line = $sth->fetchrow_hashref){
1693 push(@result,$line->{'routingid'});
1695 # To find the matching index
1697 my $key = -1; # to allow for 0 being a valid response
1698 for ($i = 0; $i < @result; $i++) {
1699 if ($routingid == $result[$i]) {
1700 $key = $i; # save the index
1704 # if index exists in array then move it to new position
1705 if($key > -1 && $rank > 0){
1706 my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1707 my $moving_item = splice(@result, $key, 1);
1708 splice(@result, $new_rank, 0, $moving_item);
1710 for(my $j = 0; $j < @result; $j++){
1711 my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1716 =head2 delroutingmember
1720 &delroutingmember($routingid,$subscriptionid)
1722 this function either deletes one member from routing list if $routingid exists otherwise
1723 deletes all members from the routing list
1728 sub delroutingmember {
1729 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1730 my ($routingid,$subscriptionid) = @_;
1731 my $dbh = C4::Context->dbh;
1733 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1734 $sth->execute($routingid);
1735 reorder_members($subscriptionid,$routingid);
1737 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1738 $sth->execute($subscriptionid);
1742 =head2 getroutinglist
1746 ($count,@routinglist) = &getroutinglist($subscriptionid)
1748 this gets the info from the subscriptionroutinglist for $subscriptionid
1751 a count of the number of members on routinglist
1752 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1753 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1758 sub getroutinglist {
1759 my ($subscriptionid) = @_;
1760 my $dbh = C4::Context->dbh;
1761 my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1762 ranking, biblionumber FROM subscriptionroutinglist, subscription
1763 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1764 AND subscription.subscriptionid = ? ORDER BY ranking ASC
1766 $sth->execute($subscriptionid);
1769 while (my $line = $sth->fetchrow_hashref) {
1771 push(@routinglist,$line);
1773 return ($count,@routinglist);
1776 =head2 abouttoexpire
1780 $result = &abouttoexpire($subscriptionid)
1782 this function alerts you to the penultimate issue for a serial subscription
1784 returns 1 - if this is the penultimate issue
1792 my ($subscriptionid) = @_;
1793 my $dbh = C4::Context->dbh;
1794 my $subscription = getsubscription($subscriptionid);
1795 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1796 if ($subscription->{numberlength}) {
1797 my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=? and planneddate>=?");
1798 $sth->execute($subscriptionid,$subscription->{startdate});
1799 my $res = $sth->fetchrow;
1800 # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1801 if ($subscription->{numberlength}==$res) {
1807 # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1808 my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1809 $sth->execute($subscriptionid);
1810 my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1811 my $endofsubscriptiondate;
1812 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1813 $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1814 # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1815 my $per = $subscription->{'periodicity'};
1817 if ($per == 1) { $x = '1 day'; }
1818 if ($per == 2) { $x = '1 week'; }
1819 if ($per == 3) { $x = '2 weeks'; }
1820 if ($per == 4) { $x = '3 weeks'; }
1821 if ($per == 5) { $x = '1 month'; }
1822 if ($per == 6) { $x = '2 months'; }
1823 if ($per == 7 || $per == 8) { $x = '3 months'; }
1824 if ($per == 9) { $x = '6 months'; }
1825 if ($per == 10) { $x = '1 year'; }
1826 if ($per == 11) { $x = '2 years'; }
1827 my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1828 # warn "DATE BEFORE END: $datebeforeend";
1829 return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1834 =head2 old_newsubscription
1838 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1839 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1840 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1841 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1842 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1843 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
1845 this function is similar to the NewSubscription subroutine but has a few different
1847 $firstacquidate - date of first serial issue to arrive
1848 $irregularity - the issues not expected separated by a '|'
1849 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1850 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1851 alt_subscription-add.tmpl file
1852 $callnumber - display the callnumber of the serial
1853 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1856 the $subscriptionid number of the new subscription
1861 sub old_newsubscription {
1862 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1863 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1864 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1865 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1866 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1867 $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_;
1868 my $dbh = C4::Context->dbh;
1870 my $sth=$dbh->prepare("insert into subscription (librarian,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) values
1876 (?,?,?,?,?,?,?,?,?,?,?,
1877 ?,?,?,?,?,?,?,?,?,?,?,
1878 ?,?,?,?,?,?,?,?,?,?,?,?)");
1879 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1880 format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1881 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1882 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1883 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1884 $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1885 #then create the 1st waited number
1886 my $subscriptionid = $dbh->{'mysql_insertid'};
1887 my $enddate = subscriptionexpirationdate($subscriptionid);
1889 $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1890 $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1891 # reread subscription to get a hash (for calculation of the 1st issue number)
1892 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1893 $sth->execute($subscriptionid);
1894 my $val = $sth->fetchrow_hashref;
1896 # calculate issue number
1897 my $serialseq = Get_Seq($val);
1898 $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1899 $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1900 return $subscriptionid;
1903 =head2 old_modsubscription
1907 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1908 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1909 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1910 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1911 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1912 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
1914 this function is similar to the ModSubscription subroutine but has a few different
1916 $firstacquidate - date of first serial issue to arrive
1917 $irregularity - the issues not expected separated by a '|'
1918 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1919 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1920 alt_subscription-add.tmpl file
1921 $callnumber - display the callnumber of the serial
1922 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1927 sub old_modsubscription {
1928 my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1929 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1930 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1931 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1932 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1933 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1934 my $dbh = C4::Context->dbh;
1935 my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1936 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1937 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1938 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1939 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1940 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1941 $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1942 $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1943 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1944 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1945 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1946 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1950 $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1951 $sth->execute($subscriptionid);
1952 my $val = $sth->fetchrow_hashref;
1954 # calculate issue number
1955 my $serialseq = Get_Seq($val);
1956 $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1957 $sth->execute($serialseq,$subscriptionid);
1959 my $enddate = subscriptionexpirationdate($subscriptionid);
1960 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1961 $sth->execute(format_date_in_iso($enddate));
1964 =head2 old_getserials
1968 ($totalissues,@serials) = &old_getserials($subscriptionid)
1970 this function get a hashref of serials and the total count of them
1973 $totalissues - number of serial lines
1974 the serials into a table. Each line of this table containts a ref to a hash which it containts
1975 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
1980 sub old_getserials {
1981 my ($subscriptionid) = @_;
1982 my $dbh = C4::Context->dbh;
1983 # status = 2 is "arrived"
1984 my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1985 $sth->execute($subscriptionid);
1988 while(my $line = $sth->fetchrow_hashref) {
1989 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1990 $line->{"planneddate"} = format_date($line->{"planneddate"});
1991 $line->{"num"} = $num;
1993 push @serials,$line;
1995 $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
1996 $sth->execute($subscriptionid);
1997 my ($totalissues) = $sth->fetchrow;
1998 return ($totalissues,@serials);
2001 =head2 Get_Next_Date
2005 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
2007 this function is an extension of GetNextDate which allows for checking for irregularity
2009 it takes the planneddate and will return the next issue's date and will skip dates if there
2010 exists an irregularity
2011 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2012 skipped then the returned date will be 2007-05-10
2015 $resultdate - then next date in the sequence
2020 sub Get_Next_Date(@) {
2021 my ($planneddate,$subscription) = @_;
2022 my @irreg = split(/\|/,$subscription->{irregularity});
2024 my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
2025 my $dayofweek = Date_DayOfWeek($month,$day,$year);
2027 # warn "DOW $dayofweek";
2028 if ($subscription->{periodicity} == 1) {
2029 for(my $i=0;$i<@irreg;$i++){
2030 if($dayofweek == 7){ $dayofweek = 0; }
2031 if(in_array(($dayofweek+1), @irreg)){
2032 $planneddate = DateCalc($planneddate,"1 day");
2036 $resultdate=DateCalc($planneddate,"1 day");
2038 if ($subscription->{periodicity} == 2) {
2039 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2040 for(my $i = 0;$i < @irreg; $i++){
2041 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2042 if($irreg[$i] == ($wkno+1)){
2043 $planneddate = DateCalc($planneddate,"1 week");
2047 $resultdate=DateCalc($planneddate,"1 week");
2049 if ($subscription->{periodicity} == 3) {
2050 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2051 for(my $i = 0;$i < @irreg; $i++){
2052 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2053 if($irreg[$i] == ($wkno+1)){
2054 $planneddate = DateCalc($planneddate,"2 weeks");
2058 $resultdate=DateCalc($planneddate,"2 weeks");
2060 if ($subscription->{periodicity} == 4) {
2061 my $wkno = Date_WeekOfYear($month,$day,$year,1);
2062 for(my $i = 0;$i < @irreg; $i++){
2063 if($wkno > 52) { $wkno = 0; } # need to rollover at January
2064 if($irreg[$i] == ($wkno+1)){
2065 $planneddate = DateCalc($planneddate,"3 weeks");
2069 $resultdate=DateCalc($planneddate,"3 weeks");
2071 if ($subscription->{periodicity} == 5) {
2072 for(my $i = 0;$i < @irreg; $i++){
2075 if($month == 12) { $month = 0; } # need to rollover to check January
2076 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2077 $planneddate = DateCalc($planneddate,"1 month");
2078 $month++; # to check if following ones are to be skipped too
2081 $resultdate=DateCalc($planneddate,"1 month");
2082 # warn "Planneddate2: $planneddate";
2084 if ($subscription->{periodicity} == 6) {
2085 for(my $i = 0;$i < @irreg; $i++){
2086 if($month == 12) { $month = 0; } # need to rollover to check January
2087 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2088 $planneddate = DateCalc($planneddate,"2 months");
2089 $month++; # to check if following ones are to be skipped too
2092 $resultdate=DateCalc($planneddate,"2 months");
2094 if ($subscription->{periodicity} == 7) {
2095 for(my $i = 0;$i < @irreg; $i++){
2096 if($month == 12) { $month = 0; } # need to rollover to check January
2097 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2098 $planneddate = DateCalc($planneddate,"3 months");
2099 $month++; # to check if following ones are to be skipped too
2102 $resultdate=DateCalc($planneddate,"3 months");
2104 if ($subscription->{periodicity} == 8) {
2105 for(my $i = 0;$i < @irreg; $i++){
2106 if($month == 12) { $month = 0; } # need to rollover to check January
2107 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2108 $planneddate = DateCalc($planneddate,"3 months");
2109 $month++; # to check if following ones are to be skipped too
2112 $resultdate=DateCalc($planneddate,"3 months");
2114 if ($subscription->{periodicity} == 9) {
2115 for(my $i = 0;$i < @irreg; $i++){
2116 if($month == 12) { $month = 0; } # need to rollover to check January
2117 if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2118 $planneddate = DateCalc($planneddate,"6 months");
2119 $month++; # to check if following ones are to be skipped too
2122 $resultdate=DateCalc($planneddate,"6 months");
2124 if ($subscription->{periodicity} == 10) {
2125 $resultdate=DateCalc($planneddate,"1 year");
2127 if ($subscription->{periodicity} == 11) {
2128 $resultdate=DateCalc($planneddate,"2 years");
2130 # warn "date: ".$resultdate;
2131 return format_date_in_iso($resultdate);
2135 END { } # module clean-up code here (global destructor)