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 C4::Date;
  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    my $duration;
 716     if ($subscription->{periodicity} == 1) {
 717         $duration=get_duration("1 days");
 718     }
 719     if ($subscription->{periodicity} == 2) {
 720        $duration=get_duration("1 weeks");
 721     }
 722     if ($subscription->{periodicity} == 3) {
 723       $duration=get_duration("2 weeks");
 724     }
 725     if ($subscription->{periodicity} == 4) {
 726        $duration=get_duration("3 weeks");
 727     }
 728     if ($subscription->{periodicity} == 5) {
 729      $duration=get_duration("1 months");
 730     }
 731     if ($subscription->{periodicity} == 6) {
 732        $duration=get_duration("2 months");
 733     }
 734     if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8) {
 735         $duration=get_duration("3 months");
 736     }
 737
 738     if ($subscription->{periodicity} == 9) {
 739          $duration=get_duration("6 months");
 740     }
 741     if ($subscription->{periodicity} == 10) {
 742           $duration=get_duration("1 years");
 743     }
 744     if ($subscription->{periodicity} == 11) {
 745         $duration=get_duration("2 years");
 746     }
 747  $resultdate=DATE_Add_Duration($planneddate,$duration);
 748     return $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         my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
 804         my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 805
 806         $enddate = DATE_Add_Duration($subscription->{startdate},$duration) ;
 807     }
 808     return $enddate;
 809 }
 810
 811 =head2 CountSubscriptionFromBiblionumber
 812
 813 =over 4
 814
 815 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
 816 this count the number of subscription for a biblionumber given.
 817 return :
 818 the number of subscriptions with biblionumber given on input arg.
 819
 820 =back
 821
 822 =cut
 823 sub CountSubscriptionFromBiblionumber {
 824     my ($biblionumber) = @_;
 825     my $dbh = C4::Context->dbh;
 826     my $query = qq|
 827         SELECT count(*)
 828         FROM   subscription
 829         WHERE  biblionumber=?
 830     |;
 831     my $sth = $dbh->prepare($query);
 832     $sth->execute($biblionumber);
 833     my $subscriptionsnumber = $sth->fetchrow;
 834     return $subscriptionsnumber;
 835 }
 836
 837
 838 =head2 ModSubscriptionHistory
 839
 840 =over 4
 841
 842 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote);
 843
 844 this function modify the history of a subscription. Put your new values on input arg.
 845
 846 =back
 847
 848 =cut
 849 sub ModSubscriptionHistory {
 850     my ($subscriptionid,$histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote)=@_;
 851     my $dbh=C4::Context->dbh;
 852     my $query = qq(
 853         UPDATE subscriptionhistory
 854         SET histstartdate=?,enddate=?,receivedlist=?,missinglist=?,opacnote=?,librariannote=?
 855         WHERE subscriptionid=?
 856     );
 857     my $sth = $dbh->prepare($query);
 858     $receivedlist =~ s/^,//g;
 859     $missinglist =~ s/^,//g;
 860     $opacnote =~ s/^,//g;
 861     $sth->execute($histstartdate,$enddate,$receivedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 862 }
 863
 864 =head2 ModSerialStatus
 865
 866 =over 4
 867
 868 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 869
 870 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
 871 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
 872
 873 =back
 874
 875 =cut
 876 sub ModSerialStatus {
 877     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes,$itemnumber)=@_;
 878
 879     # 1st, get previous status :
 880     my $dbh = C4::Context->dbh;
 881     my $query = qq|
 882         SELECT subscriptionid,status
 883         FROM   serial
 884         WHERE  serialid=?
 885     |;
 886     my $sth = $dbh->prepare($query);
 887     $sth->execute($serialid);
 888     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 889     # change status & update subscriptionhistory
 890     if ($status eq 6){
 891         DelIssue($serialseq, $subscriptionid)
 892     } else {
 893         my $query = qq(
 894             UPDATE serial
 895             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?,itemnumber=?
 896             WHERE  serialid = ?
 897         );
 898         $sth = $dbh->prepare($query);
 899         $sth->execute($serialseq,format_date_in_iso($publisheddate),format_date_in_iso($planneddate),$status,$notes,$itemnumber,$serialid);
 900         my $query = qq(
 901             SELECT missinglist,receivedlist
 902             FROM   subscriptionhistory
 903             WHERE  subscriptionid=?
 904         );
 905         $sth = $dbh->prepare($query);
 906         $sth->execute($subscriptionid);
 907         my ($missinglist,$receivedlist) = $sth->fetchrow;
 908         if ($status == 2 && $oldstatus != 2) {
 909             $receivedlist .= ",$serialseq";
 910         }
 911         $missinglist .= ",$serialseq" if ($status eq 4) ;
 912         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 913         my $query = qq(
 914             UPDATE subscriptionhistory
 915             SET    receivedlist=?, missinglist=?
 916             WHERE  subscriptionid=?
 917         );
 918         $sth=$dbh->prepare($query);
 919         $sth->execute($receivedlist,$missinglist,$subscriptionid);
 920     }
 921     # create new waited entry if needed (ie : was a "waited" and has changed)
 922     if ($oldstatus eq 1 && $status ne 1) {
 923         my $query = qq(
 924             SELECT *
 925             FROM   subscription
 926             WHERE  subscriptionid = ?
 927         );
 928         $sth = $dbh->prepare($query);
 929         $sth->execute($subscriptionid);
 930         my $val = $sth->fetchrow_hashref;
 931         # next issue number
 932         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 933         # next date (calculated from actual date & frequency parameters)
 934           my $nextplanneddate = Get_Next_Date($planneddate,$val);
 935           my $nextpublisheddate = Get_Next_Date($publisheddate,$val);
 936         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,$nextplanneddate,0);
 937         my $query = qq|
 938             UPDATE subscription
 939             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 940                    innerloop1=?, innerloop2=?, innerloop3=?
 941             WHERE  subscriptionid = ?
 942         |;
 943         $sth = $dbh->prepare($query);
 944         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 945     }
 946 }
 947
 948 =head2 ModSubscription
 949
 950 =over 4
 951
 952 this function modify a subscription. Put all new values on input args.
 953
 954 =back
 955
 956 =cut
 957 sub ModSubscription {
 958     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 959         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 960         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 961         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 962         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 963         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate)= @_;
 964     my $dbh = C4::Context->dbh;
 965     my $query = qq|
 966         UPDATE subscription
 967         SET     librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 968                 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 969                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 970                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 971                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 972                 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?,irregularity=?,hemisphere=?,callnumber=?,numberpattern=? ,publisheddate=?
 973         WHERE subscriptionid = ?
 974     |;
 975     my $sth=$dbh->prepare($query);
 976     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 977         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 978         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 979         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 980         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 981         $numberingmethod, $status, $biblionumber, $notes, $letter, $irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate,$subscriptionid);
 982     $sth->finish;
 983 }
 984
 985
 986 =head2 NewSubscription
 987
 988 =over 4
 989
 990 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 991     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 992     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 993     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 994     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 995     $numberingmethod, $status, $notes)
 996
 997 Create a new subscription with value given on input args.
 998
 999 return :
1000 the id of this new subscription
1001
1002 =back
1003
1004 =cut
1005 sub NewSubscription {
1006     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1007         $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1008         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1009         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1010         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1011         $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,$publisheddate) = @_;
1012
1013     my $dbh = C4::Context->dbh;
1014 #save subscription (insert into database)
1015     my $query = qq|
1016         INSERT INTO subscription
1017             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1018             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1019             add1,every1,whenmorethan1,setto1,lastvalue1,
1020             add2,every2,whenmorethan2,setto2,lastvalue2,
1021             add3,every3,whenmorethan3,setto3,lastvalue3,
1022             numberingmethod, status, notes, letter,irregularity,hemisphere,callnumber,numberpattern,publisheddate)
1023         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1024         |;
1025     my $sth=$dbh->prepare($query);
1026     $sth->execute(
1027         $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1028         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1029         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1030         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1031         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1032         $numberingmethod, $status, $notes, $letter,$irregularity,$hemisphere,$callnumber,$numberpattern,format_date_in_iso($publisheddate));
1033
1034
1035 #then create the 1st waited number
1036     my $subscriptionid = $dbh->{'mysql_insertid'};
1037         my $enddate = GetSubscriptionExpirationDate($subscriptionid);
1038     my $query = qq(
1039         INSERT INTO subscriptionhistory
1040             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, receivedlist, opacnote, librariannote)
1041         VALUES (?,?,?,?,?,?,?,?)
1042         );
1043     $sth = $dbh->prepare($query);
1044     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1045 ## User may have subscriptionid stored in MARC so check and fill it
1046 my $record=XMLgetbiblio($dbh,$biblionumber);
1047 $record=XML_xml2hash_onerecord($record);
1048 XML_writeline( $record, "subscriptionid", $subscriptionid,"biblios" );
1049 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1050 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1051 # reread subscription to get a hash (for calculation of the 1st issue number)
1052     my $query = qq(
1053         SELECT *
1054         FROM   subscription
1055         WHERE  subscriptionid = ?
1056     );
1057     $sth = $dbh->prepare($query);
1058     $sth->execute($subscriptionid);
1059     my $val = $sth->fetchrow_hashref;
1060
1061 # calculate issue number
1062     my $serialseq = GetSeq($val);
1063     my $query = qq|
1064         INSERT INTO serial
1065             (serialseq,subscriptionid,biblionumber,status, planneddate,publisheddate)
1066         VALUES (?,?,?,?,?,?)
1067     |;
1068
1069     $sth = $dbh->prepare($query);
1070     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate),format_date_in_iso($publisheddate));
1071     return $subscriptionid;
1072 }
1073
1074
1075 =head2 ReNewSubscription
1076
1077 =over 4
1078
1079 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1080
1081 this function renew a subscription with values given on input args.
1082
1083 =back
1084
1085 =cut
1086 sub ReNewSubscription {
1087     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1088     my $dbh = C4::Context->dbh;
1089     my $subscription = GetSubscription($subscriptionid);
1090     my $record=XMLgetbiblio($dbh,$subscription->{biblionumber});
1091     $record=XML_xml2hash_onerecord($record);
1092     my $biblio = XMLmarc2koha_onerecord($dbh,$record,"biblios");
1093     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1094     # renew subscription
1095     my $query = qq|
1096         UPDATE subscription
1097         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1098         WHERE  subscriptionid=?
1099     |;
1100 my    $sth=$dbh->prepare($query);
1101     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1102 }
1103
1104
1105 =head2 NewIssue
1106
1107 =over 4
1108
1109 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1110
1111 Create a new issue stored on the database.
1112 Note : we have to update the receivedlist and missinglist on subscriptionhistory for this subscription.
1113
1114 =back
1115
1116 =cut
1117 sub NewIssue {
1118     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate,$itemnumber) = @_;
1119     my $dbh = C4::Context->dbh;
1120     my $query = qq|
1121         INSERT INTO serial
1122             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,itemnumber)
1123         VALUES (?,?,?,?,?,?,?)
1124     |;
1125     my $sth = $dbh->prepare($query);
1126     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,format_date_in_iso($publisheddate), format_date_in_iso($planneddate),$itemnumber);
1127
1128     my $query = qq|
1129         SELECT missinglist,receivedlist
1130         FROM   subscriptionhistory
1131         WHERE  subscriptionid=?
1132     |;
1133     $sth = $dbh->prepare($query);
1134     $sth->execute($subscriptionid);
1135     my ($missinglist,$receivedlist) = $sth->fetchrow;
1136     if ($status eq 2) {
1137         $receivedlist .= ",$serialseq";
1138     }
1139     if ($status eq 4) {
1140         $missinglist .= ",$serialseq";
1141     }
1142     my $query = qq|
1143         UPDATE subscriptionhistory
1144         SET    receivedlist=?, missinglist=?
1145         WHERE  subscriptionid=?
1146     |;
1147     $sth=$dbh->prepare($query);
1148     $sth->execute($receivedlist,$missinglist,$subscriptionid);
1149 }
1150
1151 =head2 serialchangestatus
1152
1153 =over 4
1154
1155 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1156
1157 Change the status of a serial issue.
1158 Note: this was the older subroutine
1159
1160 =back
1161
1162 =cut
1163 sub serialchangestatus {
1164     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1165     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1166     my $dbh = C4::Context->dbh;
1167     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1168     $sth->execute($serialid);
1169     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1170     # change status & update subscriptionhistory
1171     if ($status eq 6){
1172         delissue($serialseq, $subscriptionid)
1173     }else{
1174         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1175         $sth->execute($serialseq,format_date_in_iso($planneddate),$status,$notes,$serialid);
1176
1177         $sth = $dbh->prepare("select missinglist,receivedlist from subscriptionhistory where subscriptionid=?");
1178         $sth->execute($subscriptionid);
1179         my ($missinglist,$receivedlist) = $sth->fetchrow;
1180         if ($status eq 2) {
1181             $receivedlist .= "| $serialseq";
1182             $receivedlist =~ s/^\| //g;
1183         }
1184         $missinglist .= "| $serialseq" if ($status eq 4) ;
1185         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1186         $missinglist =~ s/^\| //g;
1187         $sth=$dbh->prepare("update subscriptionhistory set receivedlist=?, missinglist=? where subscriptionid=?");
1188         $sth->execute($receivedlist,$missinglist,$subscriptionid);
1189     }
1190     # create new waited entry if needed (ie : was a "waited" and has changed)
1191     if ($oldstatus eq 1 && $status ne 1) {
1192         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1193         $sth->execute($subscriptionid);
1194         my $val = $sth->fetchrow_hashref;
1195         # next issue number
1196         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1197         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1198         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1199         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1200         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1201     }
1202     # check if an alert must be sent... (= a letter is defined & status became "arrived"
1203         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1204         $sth->execute($subscriptionid);
1205         my $subscription = $sth->fetchrow_hashref;
1206     if ($subscription->{letter} && $status eq 2) {
1207         sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1208     }
1209 }
1210
1211
1212
1213
1214 =head2 HasSubscriptionExpired
1215
1216 =over 4
1217
1218 1 or 0 = HasSubscriptionExpired($subscriptionid)
1219
1220 the subscription has expired when the next issue to arrive is out of subscription limit.
1221
1222 return :
1223 1 if true, 0 if false.
1224
1225 =back
1226
1227 =cut
1228 sub HasSubscriptionExpired {
1229     my ($subscriptionid) = @_;
1230     my $dbh = C4::Context->dbh;
1231     my $subscription = GetSubscription($subscriptionid);
1232     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1233     if ($subscription->{numberlength} ) {
1234         my $query = qq|
1235             SELECT count(*)
1236             FROM   serial
1237             WHERE  subscriptionid=? AND planneddate>=?
1238         |;
1239         my $sth = $dbh->prepare($query);
1240         $sth->execute($subscriptionid,$subscription->{startdate});
1241         my $res = $sth->fetchrow;
1242         if ($subscription->{numberlength}>=$res) {
1243             return 0;
1244         } else {
1245             return 1;
1246         }
1247     } else {
1248         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1249         my $query = qq|
1250             SELECT max(planneddate)
1251             FROM   serial
1252             WHERE  subscriptionid=?
1253         |;
1254         my $sth = $dbh->prepare($query);
1255         $sth->execute($subscriptionid);
1256         my $res = $sth->fetchrow;
1257         my $endofsubscriptiondate;
1258         my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1259         my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1260
1261         $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1262         return 1 if ($res >= $endofsubscriptiondate);
1263         return 0;
1264     }
1265 }
1266
1267 =head2 SetDistributedto
1268
1269 =over 4
1270
1271 SetDistributedto($distributedto,$subscriptionid);
1272 This function update the value of distributedto for a subscription given on input arg.
1273
1274 =back
1275
1276 =cut
1277 sub SetDistributedto {
1278     my ($distributedto,$subscriptionid) = @_;
1279     my $dbh = C4::Context->dbh;
1280     my $query = qq|
1281         UPDATE subscription
1282         SET    distributedto=?
1283         WHERE  subscriptionid=?
1284     |;
1285     my $sth = $dbh->prepare($query);
1286     $sth->execute($distributedto,$subscriptionid);
1287 }
1288
1289 =head2 DelSubscription
1290
1291 =over 4
1292
1293 DelSubscription($subscriptionid)
1294 this function delete the subscription which has $subscriptionid as id.
1295
1296 =back
1297
1298 =cut
1299 sub DelSubscription {
1300     my ($subscriptionid,$biblionumber) = @_;
1301     my $dbh = C4::Context->dbh;
1302 ## User may have subscriptionid stored in MARC so check and remove it
1303 my $record=XMLgetbibliohash($dbh,$biblionumber);
1304 XML_writeline( $record, "subscriptionid", "","biblios" );
1305 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1306 NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode);
1307     $subscriptionid=$dbh->quote($subscriptionid);
1308     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1309     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1310     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1311
1312 }
1313
1314 =head2 DelIssue
1315
1316 =over 4
1317
1318 DelIssue($serialseq,$subscriptionid)
1319 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1320
1321 =back
1322
1323 =cut
1324 sub DelIssue {
1325     my ($serialseq,$subscriptionid) = @_;
1326     my $dbh = C4::Context->dbh;
1327     my $query = qq|
1328         DELETE FROM serial
1329         WHERE       serialseq= ?
1330         AND         subscriptionid= ?
1331     |;
1332     my $sth = $dbh->prepare($query);
1333     $sth->execute($serialseq,$subscriptionid);
1334 }
1335
1336 =head2 GetMissingIssues
1337
1338 =over 4
1339
1340 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1341
1342 this function select missing issues on database - where serial.status = 4
1343
1344 return :
1345 a count of the number of missing issues
1346 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1347 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1348
1349 =back
1350
1351 =cut
1352 sub GetMissingIssues {
1353     my ($supplierid,$serialid) = @_;
1354     my $dbh = C4::Context->dbh;
1355     my $sth;
1356     my $byserial='';
1357     if($serialid) {
1358         $byserial = "and serialid = ".$serialid;
1359     }
1360     if ($supplierid) {
1361         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1362                                   FROM subscription, serial, biblio
1363                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1364                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1365                                   serial.STATUS = 4 and
1366                                   subscription.aqbooksellerid=$supplierid and
1367                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1368                                   ");
1369     } else {
1370         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1371                                   FROM subscription, serial, biblio
1372                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1373                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1374                                   serial.STATUS =4 and
1375                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1376                                   ");
1377     }
1378     $sth->execute;
1379     my @issuelist;
1380     my $last_title;
1381     my $odd=0;
1382     my $count=0;
1383     while (my $line = $sth->fetchrow_hashref) {
1384         $odd++ unless $line->{title} eq $last_title;
1385         $last_title = $line->{title} if ($line->{title});
1386         $line->{planneddate} = format_date($line->{planneddate});
1387         $line->{claimdate} = format_date($line->{claimdate});
1388         $line->{'odd'} = 1 if $odd %2 ;
1389         $count++;
1390         push @issuelist,$line;
1391     }
1392     return $count,@issuelist;
1393 }
1394
1395 =head2 removeMissingIssue
1396
1397 =over 4
1398
1399 removeMissingIssue($subscriptionid)
1400
1401 this function removes an issue from being part of the missing string in
1402 subscriptionlist.missinglist column
1403
1404 called when a missing issue is found from the statecollection.pl file
1405
1406 =back
1407
1408 =cut
1409 sub removeMissingIssue {
1410     my ($sequence,$subscriptionid) = @_;
1411     my $dbh = C4::Context->dbh;
1412     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1413     $sth->execute($subscriptionid);
1414     my $data = $sth->fetchrow_hashref;
1415     my $missinglist = $data->{'missinglist'};
1416     my $missinglistbefore = $missinglist;
1417     # warn $missinglist." before";
1418     $missinglist =~ s/($sequence)//;
1419     # warn $missinglist." after";
1420     if($missinglist ne $missinglistbefore){
1421         $missinglist =~ s/\|\s\|/\|/g;
1422         $missinglist =~ s/^\| //g;
1423         $missinglist =~ s/\|$//g;
1424         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1425                                        SET missinglist = ?
1426                                        WHERE subscriptionid = ?");
1427         $sth2->execute($missinglist,$subscriptionid);
1428     }
1429 }
1430
1431 =head2 updateClaim
1432
1433 =over 4
1434
1435 &updateClaim($serialid)
1436
1437 this function updates the time when a claim is issued for late/missing items
1438
1439 called from claims.pl file
1440
1441 =back
1442
1443 =cut
1444 sub updateClaim {
1445     my ($serialid) = @_;
1446     my $dbh = C4::Context->dbh;
1447     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1448                                    WHERE serialid = ?
1449                                    ");
1450     $sth->execute($serialid);
1451 }
1452
1453 =head2 getsupplierbyserialid
1454
1455 =over 4
1456
1457 ($result) = &getsupplierbyserialid($serialid)
1458
1459 this function is used to find the supplier id given a serial id
1460
1461 return :
1462 hashref containing serialid, subscriptionid, and aqbooksellerid
1463
1464 =back
1465
1466 =cut
1467 sub getsupplierbyserialid {
1468     my ($serialid) = @_;
1469     my $dbh = C4::Context->dbh;
1470     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1471                                    FROM serial, subscription
1472                                    WHERE serial.subscriptionid = subscription.subscriptionid
1473                                    AND serialid = ?
1474                                    ");
1475     $sth->execute($serialid);
1476     my $line = $sth->fetchrow_hashref;
1477     my $result = $line->{'aqbooksellerid'};
1478     return $result;
1479 }
1480
1481 =head2 check_routing
1482
1483 =over 4
1484
1485 ($result) = &check_routing($subscriptionid)
1486
1487 this function checks to see if a serial has a routing list and returns the count of routingid
1488 used to show either an 'add' or 'edit' link
1489 =back
1490
1491 =cut
1492 sub check_routing {
1493     my ($subscriptionid) = @_;
1494     my $dbh = C4::Context->dbh;
1495     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1496                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1497                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1498                               ");
1499     $sth->execute($subscriptionid);
1500     my $line = $sth->fetchrow_hashref;
1501     my $result = $line->{'routingids'};
1502     return $result;
1503 }
1504
1505 =head2 addroutingmember
1506
1507 =over 4
1508
1509 &addroutingmember($bornum,$subscriptionid)
1510
1511 this function takes a borrowernumber and subscriptionid and add the member to the
1512 routing list for that serial subscription and gives them a rank on the list
1513 of either 1 or highest current rank + 1
1514
1515 =back
1516
1517 =cut
1518 sub addroutingmember {
1519     my ($bornum,$subscriptionid) = @_;
1520     my $rank;
1521     my $dbh = C4::Context->dbh;
1522     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1523     $sth->execute($subscriptionid);
1524     while(my $line = $sth->fetchrow_hashref){
1525         if($line->{'rank'}>0){
1526             $rank = $line->{'rank'}+1;
1527         } else {
1528             $rank = 1;
1529         }
1530     }
1531     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1532     $sth->execute($subscriptionid,$bornum,$rank);
1533 }
1534
1535 =head2 reorder_members
1536
1537 =over 4
1538
1539 &reorder_members($subscriptionid,$routingid,$rank)
1540
1541 this function is used to reorder the routing list
1542
1543 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1544 - it gets all members on list puts their routingid's into an array
1545 - removes the one in the array that is $routingid
1546 - then reinjects $routingid at point indicated by $rank
1547 - then update the database with the routingids in the new order
1548
1549 =back
1550
1551 =cut
1552 sub reorder_members {
1553     my ($subscriptionid,$routingid,$rank) = @_;
1554     my $dbh = C4::Context->dbh;
1555     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1556     $sth->execute($subscriptionid);
1557     my @result;
1558     while(my $line = $sth->fetchrow_hashref){
1559         push(@result,$line->{'routingid'});
1560     }
1561     # To find the matching index
1562     my $i;
1563     my $key = -1; # to allow for 0 being a valid response
1564     for ($i = 0; $i < @result; $i++) {
1565         if ($routingid == $result[$i]) {
1566             $key = $i; # save the index
1567             last;
1568         }
1569     }
1570     # if index exists in array then move it to new position
1571     if($key > -1 && $rank > 0){
1572         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1573         my $moving_item = splice(@result, $key, 1);
1574         splice(@result, $new_rank, 0, $moving_item);
1575     }
1576     for(my $j = 0; $j < @result; $j++){
1577         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1578         $sth->execute;
1579     }
1580 }
1581
1582 =head2 delroutingmember
1583
1584 =over 4
1585
1586 &delroutingmember($routingid,$subscriptionid)
1587
1588 this function either deletes one member from routing list if $routingid exists otherwise
1589 deletes all members from the routing list
1590
1591 =back
1592
1593 =cut
1594 sub delroutingmember {
1595     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1596     my ($routingid,$subscriptionid) = @_;
1597     my $dbh = C4::Context->dbh;
1598     if($routingid){
1599         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1600         $sth->execute($routingid);
1601         reorder_members($subscriptionid,$routingid);
1602     } else {
1603         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1604         $sth->execute($subscriptionid);
1605     }
1606 }
1607
1608 =head2 getroutinglist
1609
1610 =over 4
1611
1612 ($count,@routinglist) = &getroutinglist($subscriptionid)
1613
1614 this gets the info from the subscriptionroutinglist for $subscriptionid
1615
1616 return :
1617 a count of the number of members on routinglist
1618 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1619 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1620
1621 =back
1622
1623 =cut
1624 sub getroutinglist {
1625     my ($subscriptionid) = @_;
1626     my $dbh = C4::Context->dbh;
1627     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1628                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1629                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1630                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1631                               ");
1632     $sth->execute($subscriptionid);
1633     my @routinglist;
1634     my $count=0;
1635     while (my $line = $sth->fetchrow_hashref) {
1636         $count++;
1637         push(@routinglist,$line);
1638     }
1639     return ($count,@routinglist);
1640 }
1641
1642 =head2 abouttoexpire
1643
1644 =over 4
1645
1646 $result = &abouttoexpire($subscriptionid)
1647
1648 this function alerts you to the penultimate issue for a serial subscription
1649
1650 returns 1 - if this is the penultimate issue
1651 returns 0 - if not
1652
1653 =back
1654
1655 =cut
1656
1657 sub abouttoexpire {
1658     my ($subscriptionid) = @_;
1659     my $dbh = C4::Context->dbh;
1660     my $subscription = GetSubscription($subscriptionid);
1661     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1662     if ($subscription->{numberlength}) {
1663         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1664         $sth->execute($subscriptionid,$subscription->{startdate});
1665         my $res = $sth->fetchrow;
1666         # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1667         if ($subscription->{numberlength}==$res) {
1668             return 1;
1669         } else {
1670             return 0;
1671         }
1672     } else {
1673         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1674         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1675         $sth->execute($subscriptionid);
1676         my $res = $sth->fetchrow;
1677         my $endofsubscriptiondate;
1678         my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength});
1679         my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1680
1681         $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ;
1682         my $per = $subscription->{'periodicity'};
1683         my $x = 0;
1684         if ($per == 1) { $x = '1 days'; }
1685         if ($per == 2) { $x = '1 weeks'; }
1686         if ($per == 3) { $x = '2 weeks'; }
1687         if ($per == 4) { $x = '3 weeks'; }
1688         if ($per == 5) { $x = '1 months'; }
1689         if ($per == 6) { $x = '2 months'; }
1690         if ($per == 7 || $per == 8) { $x = '3 months'; }
1691         if ($per == 9) { $x = '6 months'; }
1692         if ($per == 10) { $x = '1 years'; }
1693         if ($per == 11) { $x = '2 years'; }
1694         my $duration=get_duration("-".$x) ;
1695         my $datebeforeend = DATE_Add_Duration($endofsubscriptiondate,$duration); # if ($subscription->{weeklength});
1696         # warn "DATE BEFORE END: $datebeforeend";
1697         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1698         return 0;
1699     }
1700 }
1701
1702
1703
1704 =head2 Get_Next_Date
1705
1706 =over 4
1707
1708 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
1709
1710 this function is an extension of GetNextDate which allows for checking for irregularity
1711
1712 it takes the planneddate and will return the next issue's date and will skip dates if there
1713 exists an irregularity
1714 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
1715 skipped then the returned date will be 2007-05-10
1716
1717 return :
1718 $resultdate - then next date in the sequence
1719
1720 =back
1721
1722 =cut
1723 sub Get_Next_Date(@) {
1724     my ($planneddate,$subscription) = @_;
1725     my @irreg = split(/\|/,$subscription->{irregularity});
1726  my $dateobj=DATE_obj($planneddate);
1727     my $dayofweek = $dateobj->day_of_week;
1728   my $month=$dateobj->month;
1729     my $resultdate;
1730     #       warn "DOW $dayofweek";
1731
1732     if ($subscription->{periodicity} == 1) {
1733 my $duration=get_duration("1 days");
1734         for(my $i=0;$i<@irreg;$i++){
1735             if($dayofweek == 7){ $dayofweek = 0; }
1736
1737             if(in_array(($dayofweek+1), @irreg)){
1738                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1739                 $dayofweek++;
1740             }
1741         }
1742         $resultdate=DATE_Add_Duration($planneddate,$duration);
1743     }
1744     if ($subscription->{periodicity} == 2) {
1745         my $wkno = $dateobj->week_number;
1746 my $duration=get_duration("1 weeks");
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 = DATE_Add_Duration($planneddate,$duration);
1751                 $wkno++;
1752             }
1753         }
1754         $resultdate=DATE_Add_Duration($planneddate,$duration);
1755     }
1756     if ($subscription->{periodicity} == 3) {
1757         my $wkno = $dateobj->week_number;
1758 my $duration=get_duration("2 weeks");
1759         for(my $i = 0;$i < @irreg; $i++){
1760             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1761             if($irreg[$i] == ($wkno+1)){
1762                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1763                 $wkno++;
1764             }
1765         }
1766         $resultdate=DATE_Add_Duration($planneddate,$duration);
1767     }
1768     if ($subscription->{periodicity} == 4) {
1769         my $wkno = $dateobj->week_number;
1770 my $duration=get_duration("3 weeks");
1771         for(my $i = 0;$i < @irreg; $i++){
1772             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1773             if($irreg[$i] == ($wkno+1)){
1774                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1775                 $wkno++;
1776             }
1777         }
1778         $resultdate=DATE_Add_Duration($planneddate,$duration);
1779     }
1780     if ($subscription->{periodicity} == 5) {
1781 my $duration=get_duration("1 months");
1782         for(my $i = 0;$i < @irreg; $i++){
1783             # warn $irreg[$i];
1784             # warn $month;
1785             if($month == 12) { $month = 0; } # need to rollover to check January
1786             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1787                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1788                 $month++; # to check if following ones are to be skipped too
1789             }
1790         }
1791         $resultdate=DATE_Add_Duration($planneddate,$duration);
1792         # warn "Planneddate2: $planneddate";
1793     }
1794     if ($subscription->{periodicity} == 6) {
1795 my $duration=get_duration("2 months");
1796         for(my $i = 0;$i < @irreg; $i++){
1797             # warn $irreg[$i];
1798             # warn $month;
1799             if($month == 12) { $month = 0; } # need to rollover to check January
1800             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1801                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1802                 $month++; # to check if following ones are to be skipped too
1803             }
1804         }
1805         $resultdate=DATE_Add_Duration($planneddate,$duration);
1806     }
1807     if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8 ) {
1808 my $duration=get_duration("3 months");
1809         for(my $i = 0;$i < @irreg; $i++){
1810             # warn $irreg[$i];
1811             # warn $month;
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 = DATE_Add_Duration($planneddate,$duration);
1815                 $month++; # to check if following ones are to be skipped too
1816             }
1817         }
1818         $resultdate=DATE_Add_Duration($planneddate,$duration);
1819     }
1820
1821     if ($subscription->{periodicity} == 9) {
1822 my $duration=get_duration("6 months");
1823         for(my $i = 0;$i < @irreg; $i++){
1824             # warn $irreg[$i];
1825             # warn $month;
1826             if($month == 12) { $month = 0; } # need to rollover to check January
1827             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1828                 $planneddate = DATE_Add_Duration($planneddate,$duration);
1829                 $month++; # to check if following ones are to be skipped too
1830             }
1831         }
1832         $resultdate=DATE_Add_Duration($planneddate,$duration);
1833     }
1834     if ($subscription->{periodicity} == 10) {
1835 my $duration=get_duration("1 years");
1836         $resultdate=DATE_Add_Duration($planneddate,$duration);
1837     }
1838     if ($subscription->{periodicity} == 11) {
1839         my $duration=get_duration("2 years");
1840         $resultdate=DATE_Add_Duration($planneddate,$duration);
1841     }
1842     #    warn "date: ".$resultdate;
1843     return $resultdate;
1844 }
1845
1846
1847
1848 END { }       # module clean-up code here (global destructor)
1849
1850 1;