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