C4/Serials.pm

   1 package C4::Serials; #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   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
  10 # version.
  11 #
  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.
  15 #
  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
  19
  20 # $Id$
  21
  22 use strict;
  23 use C4::Date;
  24 use Date::Manip;
  25 use C4::Suggestions;
  26 use C4::Biblio;
  27 use C4::Search;
  28 use C4::Letters;
  29 require Exporter;
  30
  31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  32
  33 # set the version for version checking
  34 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  35         shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  36
  37
  38 =head1 NAME
  39
  40 C4::Serials - Give functions for serializing.
  41
  42 =head1 SYNOPSIS
  43
  44   use C4::Serials;
  45
  46 =head1 DESCRIPTION
  47
  48 Give all XYZ functions
  49
  50 =head1 FUNCTIONS
  51
  52 =cut
  53 @ISA = qw(Exporter);
  54 @EXPORT = qw(
  55     &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
  56     &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
  57     &GetFullSubscriptionsFromBiblionumber &GetNextSeq
  58     &ModSubscriptionHistory &NewIssue
  59     &GetSerials &GetLatestSerials &ModSerialStatus
  60     &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
  61     &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
  62     &GetDistributedTo &SetDistributedto
  63     &getroutinglist &delroutingmember &addroutingmember &reorder_members
  64     &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
  65     &Get_Next_Date
  66 );
  67
  68 =head2 GetSuppliersWithLateIssues
  69
  70 =over 4
  71
  72 %supplierlist = &GetSuppliersWithLateIssues
  73
  74 this function get all suppliers with late issues.
  75
  76 return :
  77 the supplierlist into a hash. this hash containts id & name of the supplier
  78
  79 =back
  80
  81 =cut
  82 sub GetSuppliersWithLateIssues {
  83     my $dbh = C4::Context->dbh;
  84     my $query = qq|
  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)
  90     |;
  91     my $sth = $dbh->prepare($query);
  92     $sth->execute;
  93     my %supplierlist;
  94     while (my ($id,$name) = $sth->fetchrow) {
  95         $supplierlist{$id} = $name;
  96     }
  97     if(C4::Context->preference("RoutingSerials")){
  98         $supplierlist{''} = "All Suppliers";
  99     }
 100     return %supplierlist;
 101 }
 102
 103 =head2 GetLateIssues
 104
 105 =over 4
 106
 107 @issuelist = &GetLateIssues($supplierid)
 108
 109 this function select late issues on database
 110
 111 return :
 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
 114
 115 =back
 116
 117 =cut
 118 sub GetLateIssues {
 119     my ($supplierid) = @_;
 120     my $dbh = C4::Context->dbh;
 121     my $sth;
 122     if ($supplierid) {
 123         my $query = qq |
 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
 131             ORDER BY   title
 132         |;
 133         $sth = $dbh->prepare($query);
 134     } else {
 135         my $query = qq|
 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
 142             ORDER BY   title
 143         |;
 144         $sth = $dbh->prepare($query);
 145     }
 146     $sth->execute;
 147     my @issuelist;
 148     my $last_title;
 149     my $odd=0;
 150     my $count=0;
 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 ;
 157         $count++;
 158         push @issuelist,$line;
 159     }
 160     return $count,@issuelist;
 161 }
 162
 163 =head2 GetSubscriptionHistoryFromSubscriptionId
 164
 165 =over 4
 166
 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)
 170 return :
 171 $sth = $dbh->prepare($query).
 172
 173 =back
 174
 175 =cut
 176 sub GetSubscriptionHistoryFromSubscriptionId() {
 177     my $dbh = C4::Context->dbh;
 178     my $query = qq|
 179         SELECT *
 180         FROM   subscriptionhistory
 181         WHERE  subscriptionid = ?
 182     |;
 183     return $dbh->prepare($query);
 184 }
 185
 186 =head2 GetSerialStatusFromSerialId
 187
 188 =over 4
 189
 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)
 193 return :
 194 $sth = $dbh->prepare($query).
 195
 196 =back
 197
 198 =cut
 199 sub GetSerialStatusFromSerialId(){
 200     my $dbh = C4::Context->dbh;
 201     my $query = qq|
 202         SELECT status
 203         FROM   serial
 204         WHERE  serialid = ?
 205     |;
 206     return $dbh->prepare($query);
 207 }
 208
 209
 210 =head2 GetSubscription
 211
 212 =over 4
 213
 214 $subs = GetSubscription($subscriptionid)
 215 this function get the subscription which has $subscriptionid as id.
 216 return :
 217 a hashref. This hash containts
 218 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 219
 220 =back
 221
 222 =cut
 223 sub GetSubscription {
 224     my ($subscriptionid) = @_;
 225     my $dbh = C4::Context->dbh;
 226     my $query =qq(
 227         SELECT  subscription.*,
 228                 subscriptionhistory.*,
 229                 aqbudget.bookfundid,
 230                 aqbooksellers.name AS aqbooksellername,
 231                 biblio.title AS bibliotitle
 232        FROM subscription
 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 = ?
 238     );
 239     my $sth = $dbh->prepare($query);
 240     $sth->execute($subscriptionid);
 241     my $subs = $sth->fetchrow_hashref;
 242     return $subs;
 243 }
 244
 245 =head2 GetSubscriptionsFromBiblionumber
 246
 247 =over 4
 248
 249 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
 250 this function get the subscription list. it reads on subscription table.
 251 return :
 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 planned, histstartdate,opacnote,missinglist,receivedlist,periodicity,status & enddate
 255
 256 =back
 257
 258 =cut
 259 sub GetSubscriptionsFromBiblionumber {
 260     my ($biblionumber) = @_;
 261     my $dbh = C4::Context->dbh;
 262     my $query = qq(
 263         SELECT subscription.*,
 264                subscriptionhistory.*,
 265                aqbudget.bookfundid,
 266                aqbooksellers.name AS aqbooksellername,
 267                biblio.title AS bibliotitle
 268        FROM subscription
 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 = ?
 274     );
 275     my $sth = $dbh->prepare($query);
 276     $sth->execute($biblionumber);
 277     my @res;
 278     while (my $subs = $sth->fetchrow_hashref) {
 279         $subs->{planneddate} = format_date($subs->{planneddate});
 280           $subs->{publisheddate} = format_date($subs->{publisheddate});
 281         $subs->{histstartdate} = format_date($subs->{histstartdate});
 282         $subs->{opacnote} =~ s/\n/\<br\/\>/g;
 283         $subs->{missinglist} =~ s/\n/\<br\/\>/g;
 284         $subs->{receivedlist} =~ s/\n/\<br\/\>/g;
 285         $subs->{"periodicity".$subs->{periodicity}} = 1;
 286         $subs->{"status".$subs->{'status'}} = 1;
 287         if ($subs->{enddate} eq '0000-00-00') {
 288             $subs->{enddate}='';
 289         } else {
 290             $subs->{enddate} = format_date($subs->{enddate});
 291         }
 292         push @res,$subs;
 293     }
 294     return \@res;
 295 }
 296 =head2 GetFullSubscriptionsFromBiblionumber
 297
 298 =over 4
 299
 300    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
 301    this function read on serial table.
 302
 303 =back
 304
 305 =cut
 306 sub GetFullSubscriptionsFromBiblionumber {
 307     my ($biblionumber) = @_;
 308     my $dbh = C4::Context->dbh;
 309     my $query=qq|
 310                 SELECT  serial.serialseq,
 311                         serial.planneddate,
 312                         serial.publisheddate,
 313                         serial.status,
 314                         serial.notes,
 315                         year(serial.publisheddate) AS year,
 316                         aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
 317                         biblio.title AS bibliotitle
 318                 FROM serial
 319                 LEFT JOIN subscription ON
 320                     (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
 321                 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 322                 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 323                 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 324                 WHERE subscription.biblionumber = ?
 325                 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
 326     |;
 327
 328     my $sth = $dbh->prepare($query);
 329     $sth->execute($biblionumber);
 330     my @res;
 331     my $year;
 332     my $startdate;
 333     my $aqbooksellername;
 334     my $bibliotitle;
 335     my @loopissues;
 336     my $first;
 337     my $previousnote="";
 338     while (my $subs = $sth->fetchrow_hashref) {
 339         ### BUG To FIX: When there is no published date, will create many null ids!!!
 340
 341         if ($year and ($year==$subs->{year})){
 342             if ($first eq 1){$first=0;}
 343             my $temp=$res[scalar(@res)-1]->{'serials'};
 344             push @$temp,
 345                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 346                 'planneddate' => format_date($subs->{'planneddate'}),
 347                 'serialseq' => $subs->{'serialseq'},
 348                 "status".$subs->{'status'} => 1,
 349                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 350                 };
 351         } else {
 352             $first=1 if (not $year);
 353             $year= $subs->{'year'};
 354             $startdate= format_date($subs->{'startdate'});
 355             $aqbooksellername= $subs->{'aqbooksellername'};
 356             $bibliotitle= $subs->{'bibliotitle'};
 357             my @temp;
 358             push @temp,
 359                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 360                             'planneddate' => format_date($subs->{'planneddate'}),
 361                 'serialseq' => $subs->{'serialseq'},
 362                 "status".$subs->{'status'} => 1,
 363                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 364                 };
 365
 366             push @res,{
 367                 'year'=>$year,
 368                 'startdate'=>$startdate,
 369                 'aqbooksellername'=>$aqbooksellername,
 370                 'bibliotitle'=>$bibliotitle,
 371                 'serials'=>\@temp,
 372                 'first'=>$first
 373             };
 374         }
 375         $previousnote=$subs->{notes};
 376     }
 377     return \@res;
 378 }
 379
 380
 381 =head2 GetSubscriptions
 382
 383 =over 4
 384
 385 @results = GetSubscriptions($title,$ISSN,$biblionumber);
 386 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
 387 return:
 388 a table of hashref. Each hash containt the subscription.
 389
 390 =back
 391
 392 =cut
 393 sub GetSubscriptions {
 394     my ($title,$ISSN,$biblionumber) = @_;
 395     return unless $title or $ISSN or $biblionumber;
 396     my $dbh = C4::Context->dbh;
 397     my $sth;
 398     if ($biblionumber) {
 399         my $query = qq(
 400             SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
 401             FROM   subscription,biblio
 402             WHERE  biblio.biblionumber = subscription.biblionumber
 403                 AND biblio.biblionumber=?
 404             ORDER BY title
 405         );
 406     $sth = $dbh->prepare($query);
 407     $sth->execute($biblionumber);
 408     } else {
 409         if ($ISSN and $title){
 410             my $query = qq|
 411                 SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
 412                 FROM   subscription,biblio
 413                 WHERE biblio.biblionumber= subscription.biblionumber
 414                     AND (biblio.title LIKE ? or biblio.issn = ?)
 415                 ORDER BY title
 416             |;
 417             $sth = $dbh->prepare($query);
 418             $sth->execute("%$title%",$ISSN);
 419         }
 420         else{
 421             if ($ISSN){
 422                 my $query = qq(
 423                     SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
 424                     FROM   subscription,biblio
 425                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 426                         AND biblio.biblionumber=subscription.biblionumber
 427                         AND biblioitems.issn = ?
 428                     ORDER BY title
 429                 );
 430                 $sth = $dbh->prepare($query);
 431                 $sth->execute($ISSN);
 432             } else {
 433                 my $query = qq(
 434                     SELECT subscription.subscriptionid,biblio.title,biblio.issn,subscription.notes,biblio.biblionumber
 435                     FROM   subscription,biblio
 436                     WHERE biblio.biblionumber=subscription.biblionumber
 437                         AND biblio.title LIKE ?
 438                     ORDER BY title
 439                 );
 440                 $sth = $dbh->prepare($query);
 441                 $sth->execute("%$title%");
 442             }
 443         }
 444     }
 445     my @results;
 446     my $previoustitle="";
 447     my $odd=1;
 448     while (my $line = $sth->fetchrow_hashref) {
 449         if ($previoustitle eq $line->{title}) {
 450             $line->{title}="";
 451             $line->{issn}="";
 452             $line->{toggle} = 1 if $odd==1;
 453         } else {
 454             $previoustitle=$line->{title};
 455             $odd=-$odd;
 456             $line->{toggle} = 1 if $odd==1;
 457         }
 458         push @results, $line;
 459     }
 460     return @results;
 461 }
 462
 463 =head2 GetSerials
 464
 465 =over 4
 466
 467 ($totalissues,@serials) = GetSerials($subscriptionid);
 468 this function get every serial not arrived for a given subscription
 469 as well as the number of issues registered in the database (all types)
 470 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 471
 472 =back
 473
 474 =cut
 475 sub GetSerials {
 476     my ($subscriptionid) = @_;
 477     my $dbh = C4::Context->dbh;
 478
 479     my $counter=0;
 480     my @serials;
 481
 482     # status = 2 is "arrived"
 483     my $query = qq|
 484         SELECT *
 485         FROM   serial
 486         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 487     |;
 488     my $sth=$dbh->prepare($query);
 489     $sth->execute($subscriptionid);
 490     while(my $line = $sth->fetchrow_hashref) {
 491         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 492         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 493         $line->{"planneddate"} = format_date($line->{"planneddate"});
 494         push @serials,$line;
 495     }
 496  # OK, now add the last 5 issues arrived/missing
 497     my $query = qq|
 498         SELECT   *
 499         FROM     serial
 500         WHERE    subscriptionid = ?
 501         AND      (status in (2,4,5))
 502         ORDER BY serialid DESC
 503     |;
 504     my $sth=$dbh->prepare($query);
 505     $sth->execute($subscriptionid);
 506  while((my $line = $sth->fetchrow_hashref) && $counter <5) {
 507         $counter++;
 508         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 509         $line->{"planneddate"} = format_date($line->{"planneddate"});
 510         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 511         push @serials,$line;
 512     }
 513     my $query = qq|
 514         SELECT count(*)
 515         FROM   serial
 516         WHERE  subscriptionid=?
 517     |;
 518     $sth=$dbh->prepare($query);
 519     $sth->execute($subscriptionid);
 520     my ($totalissues) = $sth->fetchrow;
 521     return ($totalissues,@serials);
 522 }
 523
 524 =head2 GetLatestSerials
 525
 526 =over 4
 527
 528 \@serials = GetLatestSerials($subscriptionid,$limit)
 529 get the $limit's latest serials arrived or missing for a given subscription
 530 return :
 531 a ref to a table which it containts all of the latest serials stored into a hash.
 532
 533 =back
 534
 535 =cut
 536 sub GetLatestSerials {
 537     my ($subscriptionid,$limit) = @_;
 538     my $dbh = C4::Context->dbh;
 539     # status = 2 is "arrived"
 540     my $strsth=qq(
 541         SELECT   serialid,serialseq, status, planneddate
 542         FROM     serial
 543         WHERE    subscriptionid = ?
 544         AND      (status =2 or status=4)
 545         ORDER BY planneddate DESC LIMIT 0,$limit
 546     );
 547     my $sth=$dbh->prepare($strsth);
 548     $sth->execute($subscriptionid);
 549     my @serials;
 550     while(my $line = $sth->fetchrow_hashref) {
 551         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 552         $line->{"planneddate"} = format_date($line->{"planneddate"});
 553         push @serials,$line;
 554     }
 555 #     my $query = qq|
 556 #         SELECT count(*)
 557 #         FROM   serial
 558 #         WHERE  subscriptionid=?
 559 #     |;
 560 #     $sth=$dbh->prepare($query);
 561 #     $sth->execute($subscriptionid);
 562 #     my ($totalissues) = $sth->fetchrow;
 563     return \@serials;
 564 }
 565
 566 =head2 GetDistributedTo
 567
 568 =over 4
 569
 570 $distributedto=GetDistributedTo($subscriptionid)
 571 This function select the old previous value of distributedto in the database.
 572
 573 =back
 574
 575 =cut
 576 sub GetDistributedTo {
 577     my $dbh = C4::Context->dbh;
 578     my $distributedto;
 579     my $subscriptionid = @_;
 580     my $query = qq|
 581         SELECT distributedto
 582         FROM   subscription
 583         WHERE  subscriptionid=?
 584     |;
 585     my $sth = $dbh->prepare($query);
 586     $sth->execute($subscriptionid);
 587     return ($distributedto) = $sth->fetchrow;
 588 }
 589
 590 =head2 GetNextSeq
 591
 592 =over 4
 593
 594 GetNextSeq($val)
 595 $val is a hashref containing all the attributes of the table 'subscription'
 596 This function get the next issue for the subscription given on input arg
 597 return:
 598 all the input params updated.
 599
 600 =back
 601
 602 =cut
 603 sub GetNextSeq {
 604     my ($val) =@_;
 605     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 606     $calculated = $val->{numberingmethod};
 607 # calculate the (expected) value of the next issue received.
 608     $newlastvalue1 = $val->{lastvalue1};
 609 # check if we have to increase the new value.
 610     $newinnerloop1 = $val->{innerloop1}+1;
 611     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 612     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 613     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 614     $calculated =~ s/\{X\}/$newlastvalue1/g;
 615
 616     $newlastvalue2 = $val->{lastvalue2};
 617 # check if we have to increase the new value.
 618     $newinnerloop2 = $val->{innerloop2}+1;
 619     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 620     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 621     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 622     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 623
 624     $newlastvalue3 = $val->{lastvalue3};
 625 # check if we have to increase the new value.
 626     $newinnerloop3 = $val->{innerloop3}+1;
 627     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 628     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 629     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 630     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 631     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 632 }
 633
 634
 635 sub New_Get_Next_Seq {
 636     my ($val) =@_;
 637     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 638     my $pattern = $val->{numberpattern};
 639     my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
 640     my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
 641     $calculated = $val->{numberingmethod};
 642     $newlastvalue1 = $val->{lastvalue1};
 643     $newlastvalue2 = $val->{lastvalue2};
 644     $newlastvalue3 = $val->{lastvalue3};
 645     if($newlastvalue3 > 0){ # if x y and z columns are used
 646         $newlastvalue3 = $newlastvalue3+1;
 647         if($newlastvalue3 > $val->{whenmorethan3}){
 648             $newlastvalue3 = $val->{setto3};
 649             $newlastvalue2++;
 650             if($newlastvalue2 > $val->{whenmorethan2}){
 651                 $newlastvalue1++;
 652                 $newlastvalue2 = $val->{setto2};
 653             }
 654         }
 655         $calculated =~ s/\{X\}/$newlastvalue1/g;
 656         if($pattern == 6){
 657             if($val->{hemisphere} == 2){
 658                 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 659                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 660             } else {
 661                 my $newlastvalue2seq = $seasons[$newlastvalue2];
 662                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 663             }
 664         } else {
 665             $calculated =~ s/\{Y\}/$newlastvalue2/g;
 666         }
 667         $calculated =~ s/\{Z\}/$newlastvalue3/g;
 668     }
 669     if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
 670         $newlastvalue2 = $newlastvalue2+1;
 671         if($newlastvalue2 > $val->{whenmorethan2}){
 672             $newlastvalue2 = $val->{setto2};
 673             $newlastvalue1++;
 674         }
 675         $calculated =~ s/\{X\}/$newlastvalue1/g;
 676         if($pattern == 6){
 677             if($val->{hemisphere} == 2){
 678                 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 679                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 680             } else {
 681                 my $newlastvalue2seq = $seasons[$newlastvalue2];
 682                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 683             }
 684         } else {
 685             $calculated =~ s/\{Y\}/$newlastvalue2/g;
 686         }
 687     }
 688     if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
 689         $newlastvalue1 = $newlastvalue1+1;
 690         if($newlastvalue1 > $val->{whenmorethan1}){
 691             $newlastvalue1 = $val->{setto2};
 692         }
 693         $calculated =~ s/\{X\}/$newlastvalue1/g;
 694     }
 695     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
 696 }
 697
 698
 699 =head2 GetNextDate
 700
 701 =over 4
 702
 703 $resultdate = GetNextDate($planneddate,$subscription)
 704
 705 this function get the date after $planneddate.
 706 return:
 707 the date on ISO format.
 708
 709 =back
 710
 711 =cut
 712 sub GetNextDate(@) {
 713     my ($planneddate,$subscription) = @_;
 714     my $resultdate;
 715     if ($subscription->{periodicity} == 1) {
 716         $resultdate=DateCalc($planneddate,"1 day");
 717     }
 718     if ($subscription->{periodicity} == 2) {
 719         $resultdate=DateCalc($planneddate,"1 week");
 720     }
 721     if ($subscription->{periodicity} == 3) {
 722         $resultdate=DateCalc($planneddate,"2 weeks");
 723     }
 724     if ($subscription->{periodicity} == 4) {
 725         $resultdate=DateCalc($planneddate,"3 weeks");
 726     }
 727     if ($subscription->{periodicity} == 5) {
 728         $resultdate=DateCalc($planneddate,"1 month");
 729     }
 730     if ($subscription->{periodicity} == 6) {
 731         $resultdate=DateCalc($planneddate,"2 months");
 732     }
 733     if ($subscription->{periodicity} == 7) {
 734         $resultdate=DateCalc($planneddate,"3 months");
 735     }
 736     if ($subscription->{periodicity} == 8) {
 737         $resultdate=DateCalc($planneddate,"3 months");
 738     }
 739     if ($subscription->{periodicity} == 9) {
 740         $resultdate=DateCalc($planneddate,"6 months");
 741     }
 742     if ($subscription->{periodicity} == 10) {
 743         $resultdate=DateCalc($planneddate,"1 year");
 744     }
 745     if ($subscription->{periodicity} == 11) {
 746         $resultdate=DateCalc($planneddate,"2 years");
 747     }
 748     return format_date_in_iso($resultdate);
 749 }
 750
 751 =head2 GetSeq
 752
 753 =over 4
 754
 755 $calculated = GetSeq($val)
 756 $val is a hashref containing all the attributes of the table 'subscription'
 757 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 758 return:
 759 the sequence in integer format
 760
 761 =back
 762
 763 =cut
 764 sub GetSeq {
 765     my ($val) =@_;
 766     my $calculated = $val->{numberingmethod};
 767     my $x=$val->{'lastvalue1'};
 768     $calculated =~ s/\{X\}/$x/g;
 769     my $y=$val->{'lastvalue2'};
 770     $calculated =~ s/\{Y\}/$y/g;
 771     my $z=$val->{'lastvalue3'};
 772     $calculated =~ s/\{Z\}/$z/g;
 773     return $calculated;
 774 }
 775
 776 =head2 GetSubscriptionExpirationDate
 777
 778 =over 4
 779
 780 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
 781
 782 this function return the expiration date for a subscription given on input args.
 783
 784 return
 785 the enddate
 786
 787 =back
 788
 789 =cut
 790 sub GetSubscriptionExpirationDate {
 791     my ($subscriptionid) = @_;
 792     my $dbh = C4::Context->dbh;
 793     my $subscription = GetSubscription($subscriptionid);
 794     my $enddate=$subscription->{startdate};
 795     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 796     if ($subscription->{numberlength}) {
 797         #calculate the date of the last issue.
 798         for (my $i=1;$i<=$subscription->{numberlength};$i++) {
 799             $enddate = GetNextDate($enddate,$subscription);
 800         }
 801     }
 802     else {
 803         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 804         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 805     }
 806     return $enddate;
 807 }
 808
 809 =head2 CountSubscriptionFromBiblionumber
 810
 811 =over 4
 812
 813 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
 814 this count the number of subscription for a biblionumber given.
 815 return :
 816 the number of subscriptions with biblionumber given on input arg.
 817
 818 =back
 819
 820 =cut
 821 sub CountSubscriptionFromBiblionumber {
 822     my ($biblionumber) = @_;
 823     my $dbh = C4::Context->dbh;
 824     my $query = qq|
 825         SELECT count(*)
 826         FROM   subscription
 827         WHERE  biblionumber=?
 828     |;
 829     my $sth = $dbh->prepare($query);
 830     $sth->execute($biblionumber);
 831     my $subscriptionsnumber = $sth->fetchrow;
 832     return $subscriptionsnumber;
 833 }
 834
 835
 836 =head2 ModSubscriptionHistory
 837
 838 =over 4
 839
 840 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
 841
 842 this function modify the history of a subscription. Put your new values on input arg.
 843
 844 =back
 845
 846 =cut
 847 sub ModSubscriptionHistory {
 848     my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
 849     my $dbh=C4::Context->dbh;
 850     my $query = qq(
 851         UPDATE subscriptionhistory
 852         SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
 853         WHERE subscriptionid=?
 854     );
 855     my $sth = $dbh->prepare($query);
 856     $receivedlist =~ s/^,//g;
 857     $missinglist =~ s/^,//g;
 858     $opacnote =~ s/^,//g;
 859     $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 860 }
 861
 862 =head2 ModSerialStatus
 863
 864 =over 4
 865
 866 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 867
 868 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
 869 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
 870
 871 =back
 872
 873 =cut
 874 sub ModSerialStatus {
 875     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
 876
 877     # 1st, get previous status :
 878     my $dbh = C4::Context->dbh;
 879     my $query = qq|
 880         SELECT subscriptionid,status
 881         FROM   serial
 882         WHERE  serialid=?
 883     |;
 884     my $sth = $dbh->prepare($query);
 885     $sth->execute($serialid);
 886     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 887     # change status & update subscriptionhistory
 888     if ($status eq 6){
 889         DelIssue($serialseq, $subscriptionid)
 890     } else {
 891         my $query = qq(
 892             UPDATE serial
 893             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
 894             WHERE  serialid = ?
 895         );
 896         $sth = $dbh->prepare($query);
 897         $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
 898         my $query = qq(
 899             SELECT missinglist,receivedlist
 900             FROM   subscriptionhistory
 901             WHERE  subscriptionid=?
 902         );
 903         $sth = $dbh->prepare($query);
 904         $sth->execute($subscriptionid);
 905         my ($missinglist,$receivedlist) = $sth->fetchrow;
 906         if ($status == 2 && $oldstatus != 2) {
 907             $receivedlist .= ",$serialseq";
 908         }
 909         $missinglist .= ",$serialseq" if ($status eq 4) ;
 910         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 911         my $query = qq(
 912             UPDATE subscriptionhistory
 913             SET    receivedlist=?, missinglist=?
 914             WHERE  subscriptionid=?
 915         );
 916         $sth=$dbh->prepare($query);
 917         $sth->execute($receivedlist,$missinglist,$subscriptionid);
 918     }
 919     # create new waited entry if needed (ie : was a "waited" and has changed)
 920     if ($oldstatus eq 1 && $status ne 1) {
 921         my $query = qq(
 922             SELECT *
 923             FROM   subscription
 924             WHERE  subscriptionid = ?
 925         );
 926         $sth = $dbh->prepare($query);
 927         $sth->execute($subscriptionid);
 928         my $val = $sth->fetchrow_hashref;
 929         # next issue number
 930         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 931         # next date (calculated from actual date & frequency parameters)
 932           my $nextplanneddate = Get_Next_Date($planneddate,$val);
 933           my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
 934         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
 935         my $query = qq|
 936             UPDATE subscription
 937             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 938                    innerloop1=?, innerloop2=?, innerloop3=?
 939             WHERE  subscriptionid = ?
 940         |;
 941         $sth = $dbh->prepare($query);
 942         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 943     }
 944 }
 945
 946 =head2 ModSubscription
 947
 948 =over 4
 949
 950 this function modify a subscription. Put all new values on input args.
 951
 952 =back
 953
 954 =cut
 955 sub ModSubscription {
 956     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 957         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 958         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 959         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 960         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 961         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
 962     my $dbh = C4::Context->dbh;
 963     my $query = qq|
 964         UPDATE subscription
 965         SET     librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 966                 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 967                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 968                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 969                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 970                 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
 971         WHERE subscriptionid = ?
 972     |;
 973     my $sth=$dbh->prepare($query);
 974     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 975         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 976         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 977         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 978         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 979         $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
 980     $sth->finish;
 981 }
 982
 983
 984 =head2 NewSubscription
 985
 986 =over 4
 987
 988 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 989     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 990     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 991     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 992     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 993     $numberingmethod, $status, $notes)
 994
 995 Create a new subscription with value given on input args.
 996
 997 return :
 998 the id of this new subscription
 999
1000 =back
1001
1002 =cut
1003 sub NewSubscription {
1004     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1005         $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1006         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1007         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1008         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1009         $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
1010
1011     my $dbh = C4::Context->dbh;
1012 #save subscription (insert into database)
1013     my $query = qq|
1014         INSERT INTO subscription
1015             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1016             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1017             add1,every1,whenmorethan1,setto1,lastvalue1,
1018             add2,every2,whenmorethan2,setto2,lastvalue2,
1019             add3,every3,whenmorethan3,setto3,lastvalue3,
1020             numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
1021         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1022         |;
1023     my $sth=$dbh->prepare($query);
1024     $sth->execute(
1025         $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1026         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1027         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1028         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1029         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1030         $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
1031
1032
1033 #then create the 1st waited number
1034     my $subscriptionid = $dbh->{'mysql_insertid'};
1035         my $enddate = GetSubscriptionExpirationDate($subscriptionid);
1036     my $query = qq(
1037         INSERT INTO subscriptionhistory
1038             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
1039         VALUES (?,?,?,?,?,?,?,?)
1040         );
1041     $sth = $dbh->prepare($query);
1042     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1043 ## User may have subscriptionid stored in MARC so check and fill it
1044 my $record=MARCgetbiblio($dbh,$biblionumber);
1045 MARCkoha2marcOnefield( $record, "subscriptionid", $subscriptionid,"biblios" );
1046 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1047 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1048 # reread subscription to get a hash (for calculation of the 1st issue number)
1049     my $query = qq(
1050         SELECT *
1051         FROM   subscription
1052         WHERE  subscriptionid = ?
1053     );
1054     $sth = $dbh->prepare($query);
1055     $sth->execute($subscriptionid);
1056     my $val = $sth->fetchrow_hashref;
1057
1058 # calculate issue number
1059     my $serialseq = GetSeq($val);
1060     my $query = qq|
1061         INSERT INTO serial
1062             (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1063         VALUES (?,?,?,?,?,?)
1064     |;
1065
1066     $sth = $dbh->prepare($query);
1067     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1068     return $subscriptionid;
1069 }
1070
1071
1072 =head2 ReNewSubscription
1073
1074 =over 4
1075
1076 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1077
1078 this function renew a subscription with values given on input args.
1079
1080 =back
1081
1082 =cut
1083 sub ReNewSubscription {
1084     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1085     my $dbh = C4::Context->dbh;
1086     my $subscription = GetSubscription($subscriptionid);
1087     my $record=MARCgetbiblio($dbh,$subscription->{biblionumber});
1088
1089     my $biblio = MARCmarc2koha($dbh,$record,"biblios");
1090     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1091     # renew subscription
1092     my $query = qq|
1093         UPDATE subscription
1094         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1095         WHERE  subscriptionid=?
1096     |;
1097 my    $sth=$dbh->prepare($query);
1098     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1099 }
1100
1101
1102 =head2 NewIssue
1103
1104 =over 4
1105
1106 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1107
1108 Create a new issue stored on the database.
1109 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1110
1111 =back
1112
1113 =cut
1114 sub NewIssue {
1115     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1116     my $dbh = C4::Context->dbh;
1117     my $query = qq|
1118         INSERT INTO serial
1119             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1120         VALUES (?,?,?,?,?,?,?)
1121     |;
1122     my $sth = $dbh->prepare($query);
1123     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1124
1125     my $query = qq|
1126         SELECT missinglist,receivedlist
1127         FROM   subscriptionhistory
1128         WHERE  subscriptionid=?
1129     |;
1130     $sth = $dbh->prepare($query);
1131     $sth->execute($subscriptionid);
1132     my ($missinglist,$receivedlist) = $sth->fetchrow;
1133     if ($status eq 2) {
1134         $receivedlist .= ",$serialseq";
1135     }
1136     if ($status eq 4) {
1137         $missinglist .= ",$serialseq";
1138     }
1139     my $query = qq|
1140         UPDATE subscriptionhistory
1141         SET    receivedlist=?, missinglist=?
1142         WHERE  subscriptionid=?
1143     |;
1144     $sth=$dbh->prepare($query);
1145     $sth->execute($receivedlist,$missinglist,$subscriptionid);
1146 }
1147
1148 =head2 serialchangestatus
1149
1150 =over 4
1151
1152 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1153
1154 Change the status of a serial issue.
1155 Note: this was the older subroutine
1156
1157 =back
1158
1159 =cut
1160 sub serialchangestatus {
1161     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1162     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1163     my $dbh = C4::Context->dbh;
1164     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1165     $sth->execute($serialid);
1166     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1167     # change status & update subscriptionhistory
1168     if ($status eq 6){
1169         delissue($serialseq, $subscriptionid)
1170     }else{
1171         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1172         $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1173
1174         $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1175         $sth->execute($subscriptionid);
1176         my ($missinglist,$receivedlist) = $sth->fetchrow;
1177         if ($status eq 2) {
1178             $receivedlist .= "| $serialseq";
1179             $receivedlist =~ s/^\| //g;
1180         }
1181         $missinglist .= "| $serialseq" if ($status eq 4) ;
1182         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1183         $missinglist =~ s/^\| //g;
1184         $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1185         $sth->execute($receivedlist,$missinglist,$subscriptionid);
1186     }
1187     # create new waited entry if needed (ie : was a "waited" and has changed)
1188     if ($oldstatus eq 1 && $status ne 1) {
1189         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1190         $sth->execute($subscriptionid);
1191         my $val = $sth->fetchrow_hashref;
1192         # next issue number
1193         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1194         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1195         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1196         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1197         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1198     }
1199     # check if an alert must be sent... (= a letter is defined & status became "arrived"
1200         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1201         $sth->execute($subscriptionid);
1202         my $subscription = $sth->fetchrow_hashref;
1203     if ($subscription->{letter} && $status eq 2) {
1204         sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1205     }
1206 }
1207
1208
1209
1210
1211 =head2 HasSubscriptionExpired
1212
1213 =over 4
1214
1215 1 or 0 = HasSubscriptionExpired($subscriptionid)
1216
1217 the subscription has expired when the next issue to arrive is out of subscription limit.
1218
1219 return :
1220 1 if true, 0 if false.
1221
1222 =back
1223
1224 =cut
1225 sub HasSubscriptionExpired {
1226     my ($subscriptionid) = @_;
1227     my $dbh = C4::Context->dbh;
1228     my $subscription = GetSubscription($subscriptionid);
1229     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1230     if ($subscription->{numberlength} ) {
1231         my $query = qq|
1232             SELECT count(*)
1233             FROM   serial
1234             WHERE  subscriptionid=? AND planneddate>=?
1235         |;
1236         my $sth = $dbh->prepare($query);
1237         $sth->execute($subscriptionid,$subscription->{startdate});
1238         my $res = $sth->fetchrow;
1239         if ($subscription->{numberlength}>=$res) {
1240             return 0;
1241         } else {
1242             return 1;
1243         }
1244     } else {
1245         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1246         my $query = qq|
1247             SELECT max(planneddate)
1248             FROM   serial
1249             WHERE  subscriptionid=?
1250         |;
1251         my $sth = $dbh->prepare($query);
1252         $sth->execute($subscriptionid);
1253         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1254         my $endofsubscriptiondate;
1255         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1256         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1257         return 1 if ($res >= $endofsubscriptiondate);
1258         return 0;
1259     }
1260 }
1261
1262 =head2 SetDistributedto
1263
1264 =over 4
1265
1266 SetDistributedto($distributedto,$subscriptionid);
1267 This function update the value of distributedto for a subscription given on input arg.
1268
1269 =back
1270
1271 =cut
1272 sub SetDistributedto {
1273     my ($distributedto,$subscriptionid) = @_;
1274     my $dbh = C4::Context->dbh;
1275     my $query = qq|
1276         UPDATE subscription
1277         SET    distributedto=?
1278         WHERE  subscriptionid=?
1279     |;
1280     my $sth = $dbh->prepare($query);
1281     $sth->execute($distributedto,$subscriptionid);
1282 }
1283
1284 =head2 DelSubscription
1285
1286 =over 4
1287
1288 DelSubscription($subscriptionid)
1289 this function delete the subscription which has $subscriptionid as id.
1290
1291 =back
1292
1293 =cut
1294 sub DelSubscription {
1295     my ($subscriptionid,$biblionumber) = @_;
1296     my $dbh = C4::Context->dbh;
1297 ## User may have subscriptionid stored in MARC so check and remove it
1298 my $record=MARCgetbiblio($dbh,$biblionumber);
1299 MARCkoha2marcOnefield( $record, "subscriptionid", "","biblios" );
1300 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1301 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1302     $subscriptionid=$dbh->quote($subscriptionid);
1303     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1304     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1305     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1306
1307 }
1308
1309 =head2 DelIssue
1310
1311 =over 4
1312
1313 DelIssue($serialseq,$subscriptionid)
1314 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1315
1316 =back
1317
1318 =cut
1319 sub DelIssue {
1320     my ($serialseq,$subscriptionid) = @_;
1321     my $dbh = C4::Context->dbh;
1322     my $query = qq|
1323         DELETE FROM serial
1324         WHERE       serialseq= ?
1325         AND         subscriptionid= ?
1326     |;
1327     my $sth = $dbh->prepare($query);
1328     $sth->execute($serialseq,$subscriptionid);
1329 }
1330
1331 =head2 GetMissingIssues
1332
1333 =over 4
1334
1335 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1336
1337 this function select missing issues on database - where serial.status = 4
1338
1339 return :
1340 a count of the number of missing issues
1341 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1342 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1343
1344 =back
1345
1346 =cut
1347 sub GetMissingIssues {
1348     my ($supplierid,$serialid) = @_;
1349     my $dbh = C4::Context->dbh;
1350     my $sth;
1351     my $byserial='';
1352     if($serialid) {
1353         $byserial = "and serialid = ".$serialid;
1354     }
1355     if ($supplierid) {
1356         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1357                                   FROM subscription, serial, biblio
1358                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1359                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1360                                   serial.STATUS = 4 and
1361                                   subscription.aqbooksellerid=$supplierid and
1362                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1363                                   ");
1364     } else {
1365         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1366                                   FROM subscription, serial, biblio
1367                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1368                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1369                                   serial.STATUS =4 and
1370                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1371                                   ");
1372     }
1373     $sth->execute;
1374     my @issuelist;
1375     my $last_title;
1376     my $odd=0;
1377     my $count=0;
1378     while (my $line = $sth->fetchrow_hashref) {
1379         $odd++ unless $line->{title} eq $last_title;
1380         $last_title = $line->{title} if ($line->{title});
1381         $line->{planneddate} = format_date($line->{planneddate});
1382         $line->{claimdate} = format_date($line->{claimdate});
1383         $line->{'odd'} = 1 if $odd %2 ;
1384         $count++;
1385         push @issuelist,$line;
1386     }
1387     return $count,@issuelist;
1388 }
1389
1390 =head2 removeMissingIssue
1391
1392 =over 4
1393
1394 removeMissingIssue($subscriptionid)
1395
1396 this function removes an issue from being part of the missing string in
1397 subscriptionlist.missinglist column
1398
1399 called when a missing issue is found from the statecollection.pl file
1400
1401 =back
1402
1403 =cut
1404 sub removeMissingIssue {
1405     my ($sequence,$subscriptionid) = @_;
1406     my $dbh = C4::Context->dbh;
1407     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1408     $sth->execute($subscriptionid);
1409     my $data = $sth->fetchrow_hashref;
1410     my $missinglist = $data->{'missinglist'};
1411     my $missinglistbefore = $missinglist;
1412     # warn $missinglist." before";
1413     $missinglist =~ s/($sequence)//;
1414     # warn $missinglist." after";
1415     if($missinglist ne $missinglistbefore){
1416         $missinglist =~ s/\|\s\|/\|/g;
1417         $missinglist =~ s/^\| //g;
1418         $missinglist =~ s/\|$//g;
1419         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1420                                        SET missinglist = ?
1421                                        WHERE subscriptionid = ?");
1422         $sth2->execute($missinglist,$subscriptionid);
1423     }
1424 }
1425
1426 =head2 updateClaim
1427
1428 =over 4
1429
1430 &updateClaim($serialid)
1431
1432 this function updates the time when a claim is issued for late/missing items
1433
1434 called from claims.pl file
1435
1436 =back
1437
1438 =cut
1439 sub updateClaim {
1440     my ($serialid) = @_;
1441     my $dbh = C4::Context->dbh;
1442     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1443                                    WHERE serialid = ?
1444                                    ");
1445     $sth->execute($serialid);
1446 }
1447
1448 =head2 getsupplierbyserialid
1449
1450 =over 4
1451
1452 ($result) = &getsupplierbyserialid($serialid)
1453
1454 this function is used to find the supplier id given a serial id
1455
1456 return :
1457 hashref containing serialid, subscriptionid, and aqbooksellerid
1458
1459 =back
1460
1461 =cut
1462 sub getsupplierbyserialid {
1463     my ($serialid) = @_;
1464     my $dbh = C4::Context->dbh;
1465     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1466                                    FROM serial, subscription
1467                                    WHERE serial.subscriptionid = subscription.subscriptionid
1468                                    AND serialid = ?
1469                                    ");
1470     $sth->execute($serialid);
1471     my $line = $sth->fetchrow_hashref;
1472     my $result = $line->{'aqbooksellerid'};
1473     return $result;
1474 }
1475
1476 =head2 check_routing
1477
1478 =over 4
1479
1480 ($result) = &check_routing($subscriptionid)
1481
1482 this function checks to see if a serial has a routing list and returns the count of routingid
1483 used to show either an 'add' or 'edit' link
1484 =back
1485
1486 =cut
1487 sub check_routing {
1488     my ($subscriptionid) = @_;
1489     my $dbh = C4::Context->dbh;
1490     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1491                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1492                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1493                               ");
1494     $sth->execute($subscriptionid);
1495     my $line = $sth->fetchrow_hashref;
1496     my $result = $line->{'routingids'};
1497     return $result;
1498 }
1499
1500 =head2 addroutingmember
1501
1502 =over 4
1503
1504 &addroutingmember($bornum,$subscriptionid)
1505
1506 this function takes a borrowernumber and subscriptionid and add the member to the
1507 routing list for that serial subscription and gives them a rank on the list
1508 of either 1 or highest current rank + 1
1509
1510 =back
1511
1512 =cut
1513 sub addroutingmember {
1514     my ($bornum,$subscriptionid) = @_;
1515     my $rank;
1516     my $dbh = C4::Context->dbh;
1517     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1518     $sth->execute($subscriptionid);
1519     while(my $line = $sth->fetchrow_hashref){
1520         if($line->{'rank'}>0){
1521             $rank = $line->{'rank'}+1;
1522         } else {
1523             $rank = 1;
1524         }
1525     }
1526     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1527     $sth->execute($subscriptionid,$bornum,$rank);
1528 }
1529
1530 =head2 reorder_members
1531
1532 =over 4
1533
1534 &reorder_members($subscriptionid,$routingid,$rank)
1535
1536 this function is used to reorder the routing list
1537
1538 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1539 - it gets all members on list puts their routingid's into an array
1540 - removes the one in the array that is $routingid
1541 - then reinjects $routingid at point indicated by $rank
1542 - then update the database with the routingids in the new order
1543
1544 =back
1545
1546 =cut
1547 sub reorder_members {
1548     my ($subscriptionid,$routingid,$rank) = @_;
1549     my $dbh = C4::Context->dbh;
1550     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1551     $sth->execute($subscriptionid);
1552     my @result;
1553     while(my $line = $sth->fetchrow_hashref){
1554         push(@result,$line->{'routingid'});
1555     }
1556     # To find the matching index
1557     my $i;
1558     my $key = -1; # to allow for 0 being a valid response
1559     for ($i = 0; $i < @result; $i++) {
1560         if ($routingid == $result[$i]) {
1561             $key = $i; # save the index
1562             last;
1563         }
1564     }
1565     # if index exists in array then move it to new position
1566     if($key > -1 && $rank > 0){
1567         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1568         my $moving_item = splice(@result, $key, 1);
1569         splice(@result, $new_rank, 0, $moving_item);
1570     }
1571     for(my $j = 0; $j < @result; $j++){
1572         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1573         $sth->execute;
1574     }
1575 }
1576
1577 =head2 delroutingmember
1578
1579 =over 4
1580
1581 &delroutingmember($routingid,$subscriptionid)
1582
1583 this function either deletes one member from routing list if $routingid exists otherwise
1584 deletes all members from the routing list
1585
1586 =back
1587
1588 =cut
1589 sub delroutingmember {
1590     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1591     my ($routingid,$subscriptionid) = @_;
1592     my $dbh = C4::Context->dbh;
1593     if($routingid){
1594         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1595         $sth->execute($routingid);
1596         reorder_members($subscriptionid,$routingid);
1597     } else {
1598         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1599         $sth->execute($subscriptionid);
1600     }
1601 }
1602
1603 =head2 getroutinglist
1604
1605 =over 4
1606
1607 ($count,@routinglist) = &getroutinglist($subscriptionid)
1608
1609 this gets the info from the subscriptionroutinglist for $subscriptionid
1610
1611 return :
1612 a count of the number of members on routinglist
1613 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1614 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1615
1616 =back
1617
1618 =cut
1619 sub getroutinglist {
1620     my ($subscriptionid) = @_;
1621     my $dbh = C4::Context->dbh;
1622     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1623                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1624                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1625                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1626                               ");
1627     $sth->execute($subscriptionid);
1628     my @routinglist;
1629     my $count=0;
1630     while (my $line = $sth->fetchrow_hashref) {
1631         $count++;
1632         push(@routinglist,$line);
1633     }
1634     return ($count,@routinglist);
1635 }
1636
1637 =head2 abouttoexpire
1638
1639 =over 4
1640
1641 $result = &abouttoexpire($subscriptionid)
1642
1643 this function alerts you to the penultimate issue for a serial subscription
1644
1645 returns 1 - if this is the penultimate issue
1646 returns 0 - if not
1647
1648 =back
1649
1650 =cut
1651
1652 sub abouttoexpire {
1653     my ($subscriptionid) = @_;
1654     my $dbh = C4::Context->dbh;
1655     my $subscription = GetSubscription($subscriptionid);
1656     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1657     if ($subscription->{numberlength}) {
1658         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1659         $sth->execute($subscriptionid,$subscription->{startdate});
1660         my $res = $sth->fetchrow;
1661         # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1662         if ($subscription->{numberlength}==$res) {
1663             return 1;
1664         } else {
1665             return 0;
1666         }
1667     } else {
1668         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1669         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1670         $sth->execute($subscriptionid);
1671         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1672         my $endofsubscriptiondate;
1673         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1674         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1675         # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1676         my $per = $subscription->{'periodicity'};
1677         my $x = 0;
1678         if ($per == 1) { $x = '1 day'; }
1679         if ($per == 2) { $x = '1 week'; }
1680         if ($per == 3) { $x = '2 weeks'; }
1681         if ($per == 4) { $x = '3 weeks'; }
1682         if ($per == 5) { $x = '1 month'; }
1683         if ($per == 6) { $x = '2 months'; }
1684         if ($per == 7 || $per == 8) { $x = '3 months'; }
1685         if ($per == 9) { $x = '6 months'; }
1686         if ($per == 10) { $x = '1 year'; }
1687         if ($per == 11) { $x = '2 years'; }
1688         my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1689         # warn "DATE BEFORE END: $datebeforeend";
1690         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1691         return 0;
1692     }
1693 }
1694
1695
1696
1697 =head2 Get_Next_Date
1698
1699 =over 4
1700
1701 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1702
1703 this function is an extension of GetNextDate which allows for checking for irregularity
1704
1705 it takes the planneddate and will return the next issue's date and will skip dates if there
1706 exists an irregularity
1707 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1708 skipped then the returned date will be 2007-05-10
1709
1710 return :
1711 $resultdate - then next date in the sequence
1712
1713 =back
1714
1715 =cut
1716 sub Get_Next_Date(@) {
1717     my ($planneddate,$subscription) = @_;
1718     my @irreg = split(/\|/,$subscription->{irregularity});
1719
1720     my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1721     my $dayofweek = Date_DayOfWeek($month,$day,$year);
1722     my $resultdate;
1723     #       warn "DOW $dayofweek";
1724     if ($subscription->{periodicity} == 1) {
1725         for(my $i=0;$i<@irreg;$i++){
1726             if($dayofweek == 7){ $dayofweek = 0; }
1727             if(in_array(($dayofweek+1), @irreg)){
1728                 $planneddate = DateCalc($planneddate,"1 day");
1729                 $dayofweek++;
1730             }
1731         }
1732         $resultdate=DateCalc($planneddate,"1 day");
1733     }
1734     if ($subscription->{periodicity} == 2) {
1735         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1736         for(my $i = 0;$i < @irreg; $i++){
1737             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1738             if($irreg[$i] == ($wkno+1)){
1739                 $planneddate = DateCalc($planneddate,"1 week");
1740                 $wkno++;
1741             }
1742         }
1743         $resultdate=DateCalc($planneddate,"1 week");
1744     }
1745     if ($subscription->{periodicity} == 3) {
1746         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1747         for(my $i = 0;$i < @irreg; $i++){
1748             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1749             if($irreg[$i] == ($wkno+1)){
1750                 $planneddate = DateCalc($planneddate,"2 weeks");
1751                 $wkno++;
1752             }
1753         }
1754         $resultdate=DateCalc($planneddate,"2 weeks");
1755     }
1756     if ($subscription->{periodicity} == 4) {
1757         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1758         for(my $i = 0;$i < @irreg; $i++){
1759             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1760             if($irreg[$i] == ($wkno+1)){
1761                 $planneddate = DateCalc($planneddate,"3 weeks");
1762                 $wkno++;
1763             }
1764         }
1765         $resultdate=DateCalc($planneddate,"3 weeks");
1766     }
1767     if ($subscription->{periodicity} == 5) {
1768         for(my $i = 0;$i < @irreg; $i++){
1769             # warn $irreg[$i];
1770             # warn $month;
1771             if($month == 12) { $month = 0; } # need to rollover to check January
1772             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1773                 $planneddate = DateCalc($planneddate,"1 month");
1774                 $month++; # to check if following ones are to be skipped too
1775             }
1776         }
1777         $resultdate=DateCalc($planneddate,"1 month");
1778         # warn "Planneddate2: $planneddate";
1779     }
1780     if ($subscription->{periodicity} == 6) {
1781         for(my $i = 0;$i < @irreg; $i++){
1782             if($month == 12) { $month = 0; } # need to rollover to check January
1783             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1784                 $planneddate = DateCalc($planneddate,"2 months");
1785                 $month++; # to check if following ones are to be skipped too
1786             }
1787         }
1788         $resultdate=DateCalc($planneddate,"2 months");
1789     }
1790     if ($subscription->{periodicity} == 7) {
1791         for(my $i = 0;$i < @irreg; $i++){
1792             if($month == 12) { $month = 0; } # need to rollover to check January
1793             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1794                 $planneddate = DateCalc($planneddate,"3 months");
1795                 $month++; # to check if following ones are to be skipped too
1796             }
1797         }
1798         $resultdate=DateCalc($planneddate,"3 months");
1799     }
1800     if ($subscription->{periodicity} == 8) {
1801         for(my $i = 0;$i < @irreg; $i++){
1802             if($month == 12) { $month = 0; } # need to rollover to check January
1803             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1804                 $planneddate = DateCalc($planneddate,"3 months");
1805                 $month++; # to check if following ones are to be skipped too
1806             }
1807         }
1808         $resultdate=DateCalc($planneddate,"3 months");
1809     }
1810     if ($subscription->{periodicity} == 9) {
1811         for(my $i = 0;$i < @irreg; $i++){
1812             if($month == 12) { $month = 0; } # need to rollover to check January
1813             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1814                 $planneddate = DateCalc($planneddate,"6 months");
1815                 $month++; # to check if following ones are to be skipped too
1816             }
1817         }
1818         $resultdate=DateCalc($planneddate,"6 months");
1819     }
1820     if ($subscription->{periodicity} == 10) {
1821         $resultdate=DateCalc($planneddate,"1 year");
1822     }
1823     if ($subscription->{periodicity} == 11) {
1824         $resultdate=DateCalc($planneddate,"2 years");
1825     }
1826     #    warn "date: ".$resultdate;
1827     return format_date_in_iso($resultdate);
1828 }
1829
1830
1831 END { }       # module clean-up code here (global destructor)
1832
1833 1;