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