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=XMLgetbiblio($dbh,$biblionumber);
1045 $record=XML_xml2hash_onerecord($record);
1046 XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
1047 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1048 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1049 # reread subscription to get a hash (for calculation of the 1st issue number)
1050     my $query = qq(
1051         SELECT *
1052         FROM   subscription
1053         WHERE  subscriptionid = ?
1054     );
1055     $sth = $dbh->prepare($query);
1056     $sth->execute($subscriptionid);
1057     my $val = $sth->fetchrow_hashref;
1058
1059 # calculate issue number
1060     my $serialseq = GetSeq($val);
1061     my $query = qq|
1062         INSERT INTO serial
1063             (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1064         VALUES (?,?,?,?,?,?)
1065     |;
1066
1067     $sth = $dbh->prepare($query);
1068     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1069     return $subscriptionid;
1070 }
1071
1072
1073 =head2 ReNewSubscription
1074
1075 =over 4
1076
1077 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1078
1079 this function renew a subscription with values given on input args.
1080
1081 =back
1082
1083 =cut
1084 sub ReNewSubscription {
1085     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1086     my $dbh = C4::Context->dbh;
1087     my $subscription = GetSubscription($subscriptionid);
1088     my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
1089     $record=XML_xml2hash_onerecord($record);
1090     my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
1091     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1092     # renew subscription
1093     my $query = qq|
1094         UPDATE subscription
1095         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1096         WHERE  subscriptionid=?
1097     |;
1098 my    $sth=$dbh->prepare($query);
1099     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1100 }
1101
1102
1103 =head2 NewIssue
1104
1105 =over 4
1106
1107 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1108
1109 Create a new issue stored on the database.
1110 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1111
1112 =back
1113
1114 =cut
1115 sub NewIssue {
1116     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1117     my $dbh = C4::Context->dbh;
1118     my $query = qq|
1119         INSERT INTO serial
1120             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1121         VALUES (?,?,?,?,?,?,?)
1122     |;
1123     my $sth = $dbh->prepare($query);
1124     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1125
1126     my $query = qq|
1127         SELECT missinglist,receivedlist
1128         FROM   subscriptionhistory
1129         WHERE  subscriptionid=?
1130     |;
1131     $sth = $dbh->prepare($query);
1132     $sth->execute($subscriptionid);
1133     my ($missinglist,$receivedlist) = $sth->fetchrow;
1134     if ($status eq 2) {
1135         $receivedlist .= ",$serialseq";
1136     }
1137     if ($status eq 4) {
1138         $missinglist .= ",$serialseq";
1139     }
1140     my $query = qq|
1141         UPDATE subscriptionhistory
1142         SET    receivedlist=?, missinglist=?
1143         WHERE  subscriptionid=?
1144     |;
1145     $sth=$dbh->prepare($query);
1146     $sth->execute($receivedlist,$missinglist,$subscriptionid);
1147 }
1148
1149 =head2 serialchangestatus
1150
1151 =over 4
1152
1153 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1154
1155 Change the status of a serial issue.
1156 Note: this was the older subroutine
1157
1158 =back
1159
1160 =cut
1161 sub serialchangestatus {
1162     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1163     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1164     my $dbh = C4::Context->dbh;
1165     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1166     $sth->execute($serialid);
1167     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1168     # change status & update subscriptionhistory
1169     if ($status eq 6){
1170         delissue($serialseq, $subscriptionid)
1171     }else{
1172         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1173         $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1174
1175         $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1176         $sth->execute($subscriptionid);
1177         my ($missinglist,$receivedlist) = $sth->fetchrow;
1178         if ($status eq 2) {
1179             $receivedlist .= "| $serialseq";
1180             $receivedlist =~ s/^\| //g;
1181         }
1182         $missinglist .= "| $serialseq" if ($status eq 4) ;
1183         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1184         $missinglist =~ s/^\| //g;
1185         $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1186         $sth->execute($receivedlist,$missinglist,$subscriptionid);
1187     }
1188     # create new waited entry if needed (ie : was a "waited" and has changed)
1189     if ($oldstatus eq 1 && $status ne 1) {
1190         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1191         $sth->execute($subscriptionid);
1192         my $val = $sth->fetchrow_hashref;
1193         # next issue number
1194         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1195         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1196         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1197         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1198         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1199     }
1200     # check if an alert must be sent... (= a letter is defined & status became "arrived"
1201         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1202         $sth->execute($subscriptionid);
1203         my $subscription = $sth->fetchrow_hashref;
1204     if ($subscription->{letter} && $status eq 2) {
1205         sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1206     }
1207 }
1208
1209
1210
1211
1212 =head2 HasSubscriptionExpired
1213
1214 =over 4
1215
1216 1 or 0 = HasSubscriptionExpired($subscriptionid)
1217
1218 the subscription has expired when the next issue to arrive is out of subscription limit.
1219
1220 return :
1221 1 if true, 0 if false.
1222
1223 =back
1224
1225 =cut
1226 sub HasSubscriptionExpired {
1227     my ($subscriptionid) = @_;
1228     my $dbh = C4::Context->dbh;
1229     my $subscription = GetSubscription($subscriptionid);
1230     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1231     if ($subscription->{numberlength} ) {
1232         my $query = qq|
1233             SELECT count(*)
1234             FROM   serial
1235             WHERE  subscriptionid=? AND planneddate>=?
1236         |;
1237         my $sth = $dbh->prepare($query);
1238         $sth->execute($subscriptionid,$subscription->{startdate});
1239         my $res = $sth->fetchrow;
1240         if ($subscription->{numberlength}>=$res) {
1241             return 0;
1242         } else {
1243             return 1;
1244         }
1245     } else {
1246         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1247         my $query = qq|
1248             SELECT max(planneddate)
1249             FROM   serial
1250             WHERE  subscriptionid=?
1251         |;
1252         my $sth = $dbh->prepare($query);
1253         $sth->execute($subscriptionid);
1254         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1255         my $endofsubscriptiondate;
1256         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1257         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1258         return 1 if ($res >= $endofsubscriptiondate);
1259         return 0;
1260     }
1261 }
1262
1263 =head2 SetDistributedto
1264
1265 =over 4
1266
1267 SetDistributedto($distributedto,$subscriptionid);
1268 This function update the value of distributedto for a subscription given on input arg.
1269
1270 =back
1271
1272 =cut
1273 sub SetDistributedto {
1274     my ($distributedto,$subscriptionid) = @_;
1275     my $dbh = C4::Context->dbh;
1276     my $query = qq|
1277         UPDATE subscription
1278         SET    distributedto=?
1279         WHERE  subscriptionid=?
1280     |;
1281     my $sth = $dbh->prepare($query);
1282     $sth->execute($distributedto,$subscriptionid);
1283 }
1284
1285 =head2 DelSubscription
1286
1287 =over 4
1288
1289 DelSubscription($subscriptionid)
1290 this function delete the subscription which has $subscriptionid as id.
1291
1292 =back
1293
1294 =cut
1295 sub DelSubscription {
1296     my ($subscriptionid,$biblionumber) = @_;
1297     my $dbh = C4::Context->dbh;
1298 ## User may have subscriptionid stored in MARC so check and remove it
1299 my $record=XMLgetbiblio($dbh,$biblionumber);
1300 $record=XML_xml2hash_onerecord($record);
1301 XML_writeline( $record, "subscriptionid", "","biblios" );
1302 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1303 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1304     $subscriptionid=$dbh->quote($subscriptionid);
1305     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1306     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1307     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1308
1309 }
1310
1311 =head2 DelIssue
1312
1313 =over 4
1314
1315 DelIssue($serialseq,$subscriptionid)
1316 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1317
1318 =back
1319
1320 =cut
1321 sub DelIssue {
1322     my ($serialseq,$subscriptionid) = @_;
1323     my $dbh = C4::Context->dbh;
1324     my $query = qq|
1325         DELETE FROM serial
1326         WHERE       serialseq= ?
1327         AND         subscriptionid= ?
1328     |;
1329     my $sth = $dbh->prepare($query);
1330     $sth->execute($serialseq,$subscriptionid);
1331 }
1332
1333 =head2 GetMissingIssues
1334
1335 =over 4
1336
1337 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1338
1339 this function select missing issues on database - where serial.status = 4
1340
1341 return :
1342 a count of the number of missing issues
1343 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1344 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1345
1346 =back
1347
1348 =cut
1349 sub GetMissingIssues {
1350     my ($supplierid,$serialid) = @_;
1351     my $dbh = C4::Context->dbh;
1352     my $sth;
1353     my $byserial='';
1354     if($serialid) {
1355         $byserial = "and serialid = ".$serialid;
1356     }
1357     if ($supplierid) {
1358         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1359                                   FROM subscription, serial, biblio
1360                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1361                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1362                                   serial.STATUS = 4 and
1363                                   subscription.aqbooksellerid=$supplierid and
1364                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1365                                   ");
1366     } else {
1367         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1368                                   FROM subscription, serial, biblio
1369                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1370                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1371                                   serial.STATUS =4 and
1372                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1373                                   ");
1374     }
1375     $sth->execute;
1376     my @issuelist;
1377     my $last_title;
1378     my $odd=0;
1379     my $count=0;
1380     while (my $line = $sth->fetchrow_hashref) {
1381         $odd++ unless $line->{title} eq $last_title;
1382         $last_title = $line->{title} if ($line->{title});
1383         $line->{planneddate} = format_date($line->{planneddate});
1384         $line->{claimdate} = format_date($line->{claimdate});
1385         $line->{'odd'} = 1 if $odd %2 ;
1386         $count++;
1387         push @issuelist,$line;
1388     }
1389     return $count,@issuelist;
1390 }
1391
1392 =head2 removeMissingIssue
1393
1394 =over 4
1395
1396 removeMissingIssue($subscriptionid)
1397
1398 this function removes an issue from being part of the missing string in
1399 subscriptionlist.missinglist column
1400
1401 called when a missing issue is found from the statecollection.pl file
1402
1403 =back
1404
1405 =cut
1406 sub removeMissingIssue {
1407     my ($sequence,$subscriptionid) = @_;
1408     my $dbh = C4::Context->dbh;
1409     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1410     $sth->execute($subscriptionid);
1411     my $data = $sth->fetchrow_hashref;
1412     my $missinglist = $data->{'missinglist'};
1413     my $missinglistbefore = $missinglist;
1414     # warn $missinglist." before";
1415     $missinglist =~ s/($sequence)//;
1416     # warn $missinglist." after";
1417     if($missinglist ne $missinglistbefore){
1418         $missinglist =~ s/\|\s\|/\|/g;
1419         $missinglist =~ s/^\| //g;
1420         $missinglist =~ s/\|$//g;
1421         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1422                                        SET missinglist = ?
1423                                        WHERE subscriptionid = ?");
1424         $sth2->execute($missinglist,$subscriptionid);
1425     }
1426 }
1427
1428 =head2 updateClaim
1429
1430 =over 4
1431
1432 &updateClaim($serialid)
1433
1434 this function updates the time when a claim is issued for late/missing items
1435
1436 called from claims.pl file
1437
1438 =back
1439
1440 =cut
1441 sub updateClaim {
1442     my ($serialid) = @_;
1443     my $dbh = C4::Context->dbh;
1444     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1445                                    WHERE serialid = ?
1446                                    ");
1447     $sth->execute($serialid);
1448 }
1449
1450 =head2 getsupplierbyserialid
1451
1452 =over 4
1453
1454 ($result) = &getsupplierbyserialid($serialid)
1455
1456 this function is used to find the supplier id given a serial id
1457
1458 return :
1459 hashref containing serialid, subscriptionid, and aqbooksellerid
1460
1461 =back
1462
1463 =cut
1464 sub getsupplierbyserialid {
1465     my ($serialid) = @_;
1466     my $dbh = C4::Context->dbh;
1467     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1468                                    FROM serial, subscription
1469                                    WHERE serial.subscriptionid = subscription.subscriptionid
1470                                    AND serialid = ?
1471                                    ");
1472     $sth->execute($serialid);
1473     my $line = $sth->fetchrow_hashref;
1474     my $result = $line->{'aqbooksellerid'};
1475     return $result;
1476 }
1477
1478 =head2 check_routing
1479
1480 =over 4
1481
1482 ($result) = &check_routing($subscriptionid)
1483
1484 this function checks to see if a serial has a routing list and returns the count of routingid
1485 used to show either an 'add' or 'edit' link
1486 =back
1487
1488 =cut
1489 sub check_routing {
1490     my ($subscriptionid) = @_;
1491     my $dbh = C4::Context->dbh;
1492     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1493                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1494                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1495                               ");
1496     $sth->execute($subscriptionid);
1497     my $line = $sth->fetchrow_hashref;
1498     my $result = $line->{'routingids'};
1499     return $result;
1500 }
1501
1502 =head2 addroutingmember
1503
1504 =over 4
1505
1506 &addroutingmember($bornum,$subscriptionid)
1507
1508 this function takes a borrowernumber and subscriptionid and add the member to the
1509 routing list for that serial subscription and gives them a rank on the list
1510 of either 1 or highest current rank + 1
1511
1512 =back
1513
1514 =cut
1515 sub addroutingmember {
1516     my ($bornum,$subscriptionid) = @_;
1517     my $rank;
1518     my $dbh = C4::Context->dbh;
1519     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1520     $sth->execute($subscriptionid);
1521     while(my $line = $sth->fetchrow_hashref){
1522         if($line->{'rank'}>0){
1523             $rank = $line->{'rank'}+1;
1524         } else {
1525             $rank = 1;
1526         }
1527     }
1528     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1529     $sth->execute($subscriptionid,$bornum,$rank);
1530 }
1531
1532 =head2 reorder_members
1533
1534 =over 4
1535
1536 &reorder_members($subscriptionid,$routingid,$rank)
1537
1538 this function is used to reorder the routing list
1539
1540 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1541 - it gets all members on list puts their routingid's into an array
1542 - removes the one in the array that is $routingid
1543 - then reinjects $routingid at point indicated by $rank
1544 - then update the database with the routingids in the new order
1545
1546 =back
1547
1548 =cut
1549 sub reorder_members {
1550     my ($subscriptionid,$routingid,$rank) = @_;
1551     my $dbh = C4::Context->dbh;
1552     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1553     $sth->execute($subscriptionid);
1554     my @result;
1555     while(my $line = $sth->fetchrow_hashref){
1556         push(@result,$line->{'routingid'});
1557     }
1558     # To find the matching index
1559     my $i;
1560     my $key = -1; # to allow for 0 being a valid response
1561     for ($i = 0; $i < @result; $i++) {
1562         if ($routingid == $result[$i]) {
1563             $key = $i; # save the index
1564             last;
1565         }
1566     }
1567     # if index exists in array then move it to new position
1568     if($key > -1 && $rank > 0){
1569         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1570         my $moving_item = splice(@result, $key, 1);
1571         splice(@result, $new_rank, 0, $moving_item);
1572     }
1573     for(my $j = 0; $j < @result; $j++){
1574         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1575         $sth->execute;
1576     }
1577 }
1578
1579 =head2 delroutingmember
1580
1581 =over 4
1582
1583 &delroutingmember($routingid,$subscriptionid)
1584
1585 this function either deletes one member from routing list if $routingid exists otherwise
1586 deletes all members from the routing list
1587
1588 =back
1589
1590 =cut
1591 sub delroutingmember {
1592     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1593     my ($routingid,$subscriptionid) = @_;
1594     my $dbh = C4::Context->dbh;
1595     if($routingid){
1596         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1597         $sth->execute($routingid);
1598         reorder_members($subscriptionid,$routingid);
1599     } else {
1600         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1601         $sth->execute($subscriptionid);
1602     }
1603 }
1604
1605 =head2 getroutinglist
1606
1607 =over 4
1608
1609 ($count,@routinglist) = &getroutinglist($subscriptionid)
1610
1611 this gets the info from the subscriptionroutinglist for $subscriptionid
1612
1613 return :
1614 a count of the number of members on routinglist
1615 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1616 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1617
1618 =back
1619
1620 =cut
1621 sub getroutinglist {
1622     my ($subscriptionid) = @_;
1623     my $dbh = C4::Context->dbh;
1624     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1625                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1626                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1627                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1628                               ");
1629     $sth->execute($subscriptionid);
1630     my @routinglist;
1631     my $count=0;
1632     while (my $line = $sth->fetchrow_hashref) {
1633         $count++;
1634         push(@routinglist,$line);
1635     }
1636     return ($count,@routinglist);
1637 }
1638
1639 =head2 abouttoexpire
1640
1641 =over 4
1642
1643 $result = &abouttoexpire($subscriptionid)
1644
1645 this function alerts you to the penultimate issue for a serial subscription
1646
1647 returns 1 - if this is the penultimate issue
1648 returns 0 - if not
1649
1650 =back
1651
1652 =cut
1653
1654 sub abouttoexpire {
1655     my ($subscriptionid) = @_;
1656     my $dbh = C4::Context->dbh;
1657     my $subscription = GetSubscription($subscriptionid);
1658     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1659     if ($subscription->{numberlength}) {
1660         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1661         $sth->execute($subscriptionid,$subscription->{startdate});
1662         my $res = $sth->fetchrow;
1663         # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1664         if ($subscription->{numberlength}==$res) {
1665             return 1;
1666         } else {
1667             return 0;
1668         }
1669     } else {
1670         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1671         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1672         $sth->execute($subscriptionid);
1673         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1674         my $endofsubscriptiondate;
1675         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1676         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1677         # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1678         my $per = $subscription->{'periodicity'};
1679         my $x = 0;
1680         if ($per == 1) { $x = '1 day'; }
1681         if ($per == 2) { $x = '1 week'; }
1682         if ($per == 3) { $x = '2 weeks'; }
1683         if ($per == 4) { $x = '3 weeks'; }
1684         if ($per == 5) { $x = '1 month'; }
1685         if ($per == 6) { $x = '2 months'; }
1686         if ($per == 7 || $per == 8) { $x = '3 months'; }
1687         if ($per == 9) { $x = '6 months'; }
1688         if ($per == 10) { $x = '1 year'; }
1689         if ($per == 11) { $x = '2 years'; }
1690         my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1691         # warn "DATE BEFORE END: $datebeforeend";
1692         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1693         return 0;
1694     }
1695 }
1696
1697
1698
1699 =head2 Get_Next_Date
1700
1701 =over 4
1702
1703 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1704
1705 this function is an extension of GetNextDate which allows for checking for irregularity
1706
1707 it takes the planneddate and will return the next issue's date and will skip dates if there
1708 exists an irregularity
1709 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1710 skipped then the returned date will be 2007-05-10
1711
1712 return :
1713 $resultdate - then next date in the sequence
1714
1715 =back
1716
1717 =cut
1718 sub Get_Next_Date(@) {
1719     my ($planneddate,$subscription) = @_;
1720     my @irreg = split(/\|/,$subscription->{irregularity});
1721
1722     my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1723     my $dayofweek = Date_DayOfWeek($month,$day,$year);
1724     my $resultdate;
1725     #       warn "DOW $dayofweek";
1726     if ($subscription->{periodicity} == 1) {
1727         for(my $i=0;$i<@irreg;$i++){
1728             if($dayofweek == 7){ $dayofweek = 0; }
1729             if(in_array(($dayofweek+1), @irreg)){
1730                 $planneddate = DateCalc($planneddate,"1 day");
1731                 $dayofweek++;
1732             }
1733         }
1734         $resultdate=DateCalc($planneddate,"1 day");
1735     }
1736     if ($subscription->{periodicity} == 2) {
1737         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1738         for(my $i = 0;$i < @irreg; $i++){
1739             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1740             if($irreg[$i] == ($wkno+1)){
1741                 $planneddate = DateCalc($planneddate,"1 week");
1742                 $wkno++;
1743             }
1744         }
1745         $resultdate=DateCalc($planneddate,"1 week");
1746     }
1747     if ($subscription->{periodicity} == 3) {
1748         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1749         for(my $i = 0;$i < @irreg; $i++){
1750             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1751             if($irreg[$i] == ($wkno+1)){
1752                 $planneddate = DateCalc($planneddate,"2 weeks");
1753                 $wkno++;
1754             }
1755         }
1756         $resultdate=DateCalc($planneddate,"2 weeks");
1757     }
1758     if ($subscription->{periodicity} == 4) {
1759         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1760         for(my $i = 0;$i < @irreg; $i++){
1761             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1762             if($irreg[$i] == ($wkno+1)){
1763                 $planneddate = DateCalc($planneddate,"3 weeks");
1764                 $wkno++;
1765             }
1766         }
1767         $resultdate=DateCalc($planneddate,"3 weeks");
1768     }
1769     if ($subscription->{periodicity} == 5) {
1770         for(my $i = 0;$i < @irreg; $i++){
1771             # warn $irreg[$i];
1772             # warn $month;
1773             if($month == 12) { $month = 0; } # need to rollover to check January
1774             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1775                 $planneddate = DateCalc($planneddate,"1 month");
1776                 $month++; # to check if following ones are to be skipped too
1777             }
1778         }
1779         $resultdate=DateCalc($planneddate,"1 month");
1780         # warn "Planneddate2: $planneddate";
1781     }
1782     if ($subscription->{periodicity} == 6) {
1783         for(my $i = 0;$i < @irreg; $i++){
1784             if($month == 12) { $month = 0; } # need to rollover to check January
1785             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1786                 $planneddate = DateCalc($planneddate,"2 months");
1787                 $month++; # to check if following ones are to be skipped too
1788             }
1789         }
1790         $resultdate=DateCalc($planneddate,"2 months");
1791     }
1792     if ($subscription->{periodicity} == 7) {
1793         for(my $i = 0;$i < @irreg; $i++){
1794             if($month == 12) { $month = 0; } # need to rollover to check January
1795             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1796                 $planneddate = DateCalc($planneddate,"3 months");
1797                 $month++; # to check if following ones are to be skipped too
1798             }
1799         }
1800         $resultdate=DateCalc($planneddate,"3 months");
1801     }
1802     if ($subscription->{periodicity} == 8) {
1803         for(my $i = 0;$i < @irreg; $i++){
1804             if($month == 12) { $month = 0; } # need to rollover to check January
1805             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1806                 $planneddate = DateCalc($planneddate,"3 months");
1807                 $month++; # to check if following ones are to be skipped too
1808             }
1809         }
1810         $resultdate=DateCalc($planneddate,"3 months");
1811     }
1812     if ($subscription->{periodicity} == 9) {
1813         for(my $i = 0;$i < @irreg; $i++){
1814             if($month == 12) { $month = 0; } # need to rollover to check January
1815             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1816                 $planneddate = DateCalc($planneddate,"6 months");
1817                 $month++; # to check if following ones are to be skipped too
1818             }
1819         }
1820         $resultdate=DateCalc($planneddate,"6 months");
1821     }
1822     if ($subscription->{periodicity} == 10) {
1823         $resultdate=DateCalc($planneddate,"1 year");
1824     }
1825     if ($subscription->{periodicity} == 11) {
1826         $resultdate=DateCalc($planneddate,"2 years");
1827     }
1828     #    warn "date: ".$resultdate;
1829     return format_date_in_iso($resultdate);
1830 }
1831
1832
1833 END { }       # module clean-up code here (global destructor)
1834
1835 1;