C4/Serials.pm

   1 package C4::Serials; #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # $Id$
  21
  22 use strict;
  23 use C4::Date;
  24 use Date::Manip;
  25 use C4::Suggestions;
  26 use C4::Biblio;
  27 use C4::Search;
  28 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 &ItemizeSerials
  58     &GetSerials &GetLatestSerials &ModSerialStatus
  59     &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
  60     &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
  61     &GetDistributedTo &SetDistributedto &serialchangestatus
  62     &getroutinglist &delroutingmember &addroutingmember &reorder_members
  63     &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
  64     &old_newsubscription &old_modsubscription &old_getserials &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   subcriptionhistory
 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 startdate, histstartdate,opacnote,missinglist,recievedlist,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->{startdate} = format_date($subs->{startdate});
 279         $subs->{histstartdate} = format_date($subs->{histstartdate});
 280         $subs->{opacnote} =~ s/\n/\<br\/\>/g;
 281         $subs->{missinglist} =~ s/\n/\<br\/\>/g;
 282         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 283         $subs->{"periodicity".$subs->{periodicity}} = 1;
 284         $subs->{"status".$subs->{'status'}} = 1;
 285         if ($subs->{enddate} eq '0000-00-00') {
 286             $subs->{enddate}='';
 287         } else {
 288             $subs->{enddate} = format_date($subs->{enddate});
 289         }
 290         push @res,$subs;
 291     }
 292     return \@res;
 293 }
 294 =head2 GetFullSubscriptionsFromBiblionumber
 295
 296 =over 4
 297
 298    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
 299    this function read on serial table.
 300
 301 =back
 302
 303 =cut
 304 sub GetFullSubscriptionsFromBiblionumber {
 305     my ($biblionumber) = @_;
 306     my $dbh = C4::Context->dbh;
 307     my $query=qq|
 308                 SELECT  serial.serialseq,
 309                         serial.planneddate,
 310                         serial.publisheddate,
 311                         serial.status,
 312                         serial.notes,
 313                         year(serial.publisheddate) AS year,
 314                         aqbudget.bookfundid,aqbooksellers.name AS aqbooksellername,
 315                         biblio.title AS bibliotitle
 316                 FROM serial
 317                 LEFT JOIN subscription ON
 318                     (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
 319                 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 320                 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 321                 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 322                 WHERE subscription.biblionumber = ?
 323                 ORDER BY year,serial.publisheddate,serial.subscriptionid,serial.planneddate
 324     |;
 325
 326     my $sth = $dbh->prepare($query);
 327     $sth->execute($biblionumber);
 328     my @res;
 329     my $year;
 330     my $startdate;
 331     my $aqbooksellername;
 332     my $bibliotitle;
 333     my @loopissues;
 334     my $first;
 335     my $previousnote="";
 336     while (my $subs = $sth->fetchrow_hashref) {
 337         ### BUG To FIX: When there is no published date, will create many null ids!!!
 338
 339         if ($year and ($year==$subs->{year})){
 340             if ($first eq 1){$first=0;}
 341             my $temp=$res[scalar(@res)-1]->{'serials'};
 342             push @$temp,
 343                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 344                 'planneddate' => format_date($subs->{'planneddate'}),
 345                 'serialseq' => $subs->{'serialseq'},
 346                 "status".$subs->{'status'} => 1,
 347                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 348                 };
 349         } else {
 350             $first=1 if (not $year);
 351             $year= $subs->{'year'};
 352             $startdate= format_date($subs->{'startdate'});
 353             $aqbooksellername= $subs->{'aqbooksellername'};
 354             $bibliotitle= $subs->{'bibliotitle'};
 355             my @temp;
 356             push @temp,
 357                 {'publisheddate' =>format_date($subs->{'publisheddate'}),
 358                             'planneddate' => format_date($subs->{'planneddate'}),
 359                 'serialseq' => $subs->{'serialseq'},
 360                 "status".$subs->{'status'} => 1,
 361                 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
 362                 };
 363
 364             push @res,{
 365                 'year'=>$year,
 366                 'startdate'=>$startdate,
 367                 'aqbooksellername'=>$aqbooksellername,
 368                 'bibliotitle'=>$bibliotitle,
 369                 'serials'=>\@temp,
 370                 'first'=>$first
 371             };
 372         }
 373         $previousnote=$subs->{notes};
 374     }
 375     return \@res;
 376 }
 377
 378
 379 =head2 GetSubscriptions
 380
 381 =over 4
 382
 383 @results = GetSubscriptions($title,$ISSN,$biblionumber);
 384 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
 385 return:
 386 a table of hashref. Each hash containt the subscription.
 387
 388 =back
 389
 390 =cut
 391 sub GetSubscriptions {
 392     my ($title,$ISSN,$biblionumber) = @_;
 393     return unless $title or $ISSN or $biblionumber;
 394     my $dbh = C4::Context->dbh;
 395     my $sth;
 396     if ($biblionumber) {
 397         my $query = qq(
 398             SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 399             FROM   subscription,biblio,biblioitems
 400             WHERE   biblio.biblionumber = biblioitems.biblionumber
 401                 AND 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,biblioitems.issn,subscription.notes,biblio.biblionumber
 411                 FROM   subscription,biblio,biblioitems
 412                 WHERE  biblio.biblionumber = biblioitems.biblionumber
 413                     AND biblio.biblionumber= subscription.biblionumber
 414                     AND (biblio.title LIKE ? or biblioitems.issn = ?)
 415                 ORDER BY title
 416             |;
 417             $sth = $dbh->prepare($query);
 418             $sth->execute("%$title%",$ISSN);
 419         }
 420         else{
 421             if ($ISSN){
 422                 my $query = qq(
 423                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 424                     FROM   subscription,biblio,biblioitems
 425                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 426                         AND biblio.biblionumber=subscription.biblionumber
 427                         AND biblioitems.issn = ?
 428                     ORDER BY title
 429                 );
 430                 $sth = $dbh->prepare($query);
 431                 $sth->execute($ISSN);
 432             } else {
 433                 my $query = qq(
 434                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 435                     FROM   subscription,biblio,biblioitems
 436                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 437                         AND biblio.biblionumber=subscription.biblionumber
 438                         AND biblio.title LIKE ?
 439                     ORDER BY title
 440                 );
 441                 $sth = $dbh->prepare($query);
 442                 $sth->execute("%$title%");
 443             }
 444         }
 445     }
 446     my @results;
 447     my $previoustitle="";
 448     my $odd=1;
 449     while (my $line = $sth->fetchrow_hashref) {
 450         if ($previoustitle eq $line->{title}) {
 451             $line->{title}="";
 452             $line->{issn}="";
 453             $line->{toggle} = 1 if $odd==1;
 454         } else {
 455             $previoustitle=$line->{title};
 456             $odd=-$odd;
 457             $line->{toggle} = 1 if $odd==1;
 458         }
 459         push @results, $line;
 460     }
 461     return @results;
 462 }
 463
 464 =head2 GetSerials
 465
 466 =over 4
 467
 468 ($totalissues,@serials) = GetSerials($subscriptionid);
 469 this function get every serial not arrived for a given subscription
 470 as well as the number of issues registered in the database (all types)
 471 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 472
 473 =back
 474
 475 =cut
 476 sub GetSerials {
 477     my ($subscriptionid) = @_;
 478     my $dbh = C4::Context->dbh;
 479     # OK, now add the last 5 issues arrives/missing
 480     my $query = qq|
 481         SELECT   serialid,serialseq, status, planneddate,notes
 482         FROM     serial
 483         WHERE    subscriptionid = ?
 484         AND      (status in (2,4,5))
 485         ORDER BY serialid DESC
 486     |;
 487     my $sth=$dbh->prepare($query);
 488     $sth->execute($subscriptionid);
 489     my $counter=0;
 490     my @serials;
 491     while((my $line = $sth->fetchrow_hashref) && $counter <5) {
 492         $counter++;
 493         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 494         $line->{"planneddate"} = format_date($line->{"planneddate"});
 495         push @serials,$line;
 496     }
 497     # status = 2 is "arrived"
 498     my $query = qq|
 499         SELECT serialid,serialseq, status, publisheddate, planneddate,notes
 500         FROM   serial
 501         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 502     |;
 503     my $sth=$dbh->prepare($query);
 504     $sth->execute($subscriptionid);
 505     while(my $line = $sth->fetchrow_hashref) {
 506         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 507         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 508         $line->{"planneddate"} = format_date($line->{"planneddate"});
 509         push @serials,$line;
 510     }
 511     my $query = qq|
 512         SELECT count(*)
 513         FROM   serial
 514         WHERE  subscriptionid=?
 515     |;
 516     $sth=$dbh->prepare($query);
 517     $sth->execute($subscriptionid);
 518     my ($totalissues) = $sth->fetchrow;
 519     return ($totalissues,@serials);
 520 }
 521
 522 =head2 GetLatestSerials
 523
 524 =over 4
 525
 526 \@serials = GetLatestSerials($subscriptionid,$limit)
 527 get the $limit's latest serials arrived or missing for a given subscription
 528 return :
 529 a ref to a table which it containts all of the latest serials stored into a hash.
 530
 531 =back
 532
 533 =cut
 534 sub GetLatestSerials {
 535     my ($subscriptionid,$limit) = @_;
 536     my $dbh = C4::Context->dbh;
 537     # status = 2 is "arrived"
 538     my $strsth=qq(
 539         SELECT   serialid,serialseq, status, planneddate
 540         FROM     serial
 541         WHERE    subscriptionid = ?
 542         AND      (status =2 or status=4)
 543         ORDER BY planneddate DESC LIMIT 0,$limit
 544     );
 545     my $sth=$dbh->prepare($strsth);
 546     $sth->execute($subscriptionid);
 547     my @serials;
 548     while(my $line = $sth->fetchrow_hashref) {
 549         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 550         $line->{"planneddate"} = format_date($line->{"planneddate"});
 551         push @serials,$line;
 552     }
 553 #     my $query = qq|
 554 #         SELECT count(*)
 555 #         FROM   serial
 556 #         WHERE  subscriptionid=?
 557 #     |;
 558 #     $sth=$dbh->prepare($query);
 559 #     $sth->execute($subscriptionid);
 560 #     my ($totalissues) = $sth->fetchrow;
 561     return \@serials;
 562 }
 563
 564 =head2 GetDistributedTo
 565
 566 =over 4
 567
 568 $distributedto=GetDistributedTo($subscriptionid)
 569 This function select the old previous value of distributedto in the database.
 570
 571 =back
 572
 573 =cut
 574 sub GetDistributedTo {
 575     my $dbh = C4::Context->dbh;
 576     my $distributedto;
 577     my $subscriptionid = @_;
 578     my $query = qq|
 579         SELECT distributedto
 580         FROM   subscription
 581         WHERE  subscriptionid=?
 582     |;
 583     my $sth = $dbh->prepare($query);
 584     $sth->execute($subscriptionid);
 585     return ($distributedto) = $sth->fetchrow;
 586 }
 587
 588 =head2 GetNextSeq
 589
 590 =over 4
 591
 592 GetNextSeq($val)
 593 $val is a hashref containing all the attributes of the table 'subscription'
 594 This function get the next issue for the subscription given on input arg
 595 return:
 596 all the input params updated.
 597
 598 =back
 599
 600 =cut
 601 sub GetNextSeq {
 602     my ($val) =@_;
 603     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 604     $calculated = $val->{numberingmethod};
 605 # calculate the (expected) value of the next issue recieved.
 606     $newlastvalue1 = $val->{lastvalue1};
 607 # check if we have to increase the new value.
 608     $newinnerloop1 = $val->{innerloop1}+1;
 609     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 610     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 611     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 612     $calculated =~ s/\{X\}/$newlastvalue1/g;
 613
 614     $newlastvalue2 = $val->{lastvalue2};
 615 # check if we have to increase the new value.
 616     $newinnerloop2 = $val->{innerloop2}+1;
 617     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 618     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 619     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 620     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 621
 622     $newlastvalue3 = $val->{lastvalue3};
 623 # check if we have to increase the new value.
 624     $newinnerloop3 = $val->{innerloop3}+1;
 625     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 626     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 627     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 628     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 629     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 630 }
 631
 632
 633 sub New_Get_Next_Seq {
 634     my ($val) =@_;
 635     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 636     my $pattern = $val->{numberpattern};
 637     my @seasons = ('nothing','Winter','Spring','Summer','Autumn');
 638     my @southern_seasons = ('','Summer','Autumn','Winter','Spring');
 639     $calculated = $val->{numberingmethod};
 640     $newlastvalue1 = $val->{lastvalue1};
 641     $newlastvalue2 = $val->{lastvalue2};
 642     $newlastvalue3 = $val->{lastvalue3};
 643     if($newlastvalue3 > 0){ # if x y and z columns are used
 644         $newlastvalue3 = $newlastvalue3+1;
 645         if($newlastvalue3 > $val->{whenmorethan3}){
 646             $newlastvalue3 = $val->{setto3};
 647             $newlastvalue2++;
 648             if($newlastvalue2 > $val->{whenmorethan2}){
 649                 $newlastvalue1++;
 650                 $newlastvalue2 = $val->{setto2};
 651             }
 652         }
 653         $calculated =~ s/\{X\}/$newlastvalue1/g;
 654         if($pattern == 6){
 655             if($val->{hemisphere} == 2){
 656                 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 657                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 658             } else {
 659                 my $newlastvalue2seq = $seasons[$newlastvalue2];
 660                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 661             }
 662         } else {
 663             $calculated =~ s/\{Y\}/$newlastvalue2/g;
 664         }
 665         $calculated =~ s/\{Z\}/$newlastvalue3/g;
 666     }
 667     if($newlastvalue2 > 0 && $newlastvalue3 < 1){ # if x and y columns are used
 668         $newlastvalue2 = $newlastvalue2+1;
 669         if($newlastvalue2 > $val->{whenmorethan2}){
 670             $newlastvalue2 = $val->{setto2};
 671             $newlastvalue1++;
 672         }
 673         $calculated =~ s/\{X\}/$newlastvalue1/g;
 674         if($pattern == 6){
 675             if($val->{hemisphere} == 2){
 676                 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 677                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 678             } else {
 679                 my $newlastvalue2seq = $seasons[$newlastvalue2];
 680                 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 681             }
 682         } else {
 683             $calculated =~ s/\{Y\}/$newlastvalue2/g;
 684         }
 685     }
 686     if($newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1){ # if column x only
 687         $newlastvalue1 = $newlastvalue1+1;
 688         if($newlastvalue1 > $val->{whenmorethan1}){
 689             $newlastvalue1 = $val->{setto2};
 690         }
 691         $calculated =~ s/\{X\}/$newlastvalue1/g;
 692     }
 693     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3);
 694 }
 695
 696
 697 =head2 GetNextDate
 698
 699 =over 4
 700
 701 $resultdate = GetNextDate($planneddate,$subscription)
 702
 703 this function get the date after $planneddate.
 704 return:
 705 the date on ISO format.
 706
 707 =back
 708
 709 =cut
 710 sub GetNextDate(@) {
 711     my ($planneddate,$subscription) = @_;
 712     my $resultdate;
 713     if ($subscription->{periodicity} == 1) {
 714         $resultdate=DateCalc($planneddate,"1 day");
 715     }
 716     if ($subscription->{periodicity} == 2) {
 717         $resultdate=DateCalc($planneddate,"1 week");
 718     }
 719     if ($subscription->{periodicity} == 3) {
 720         $resultdate=DateCalc($planneddate,"2 weeks");
 721     }
 722     if ($subscription->{periodicity} == 4) {
 723         $resultdate=DateCalc($planneddate,"3 weeks");
 724     }
 725     if ($subscription->{periodicity} == 5) {
 726         $resultdate=DateCalc($planneddate,"1 month");
 727     }
 728     if ($subscription->{periodicity} == 6) {
 729         $resultdate=DateCalc($planneddate,"2 months");
 730     }
 731     if ($subscription->{periodicity} == 7) {
 732         $resultdate=DateCalc($planneddate,"3 months");
 733     }
 734     if ($subscription->{periodicity} == 8) {
 735         $resultdate=DateCalc($planneddate,"3 months");
 736     }
 737     if ($subscription->{periodicity} == 9) {
 738         $resultdate=DateCalc($planneddate,"6 months");
 739     }
 740     if ($subscription->{periodicity} == 10) {
 741         $resultdate=DateCalc($planneddate,"1 year");
 742     }
 743     if ($subscription->{periodicity} == 11) {
 744         $resultdate=DateCalc($planneddate,"2 years");
 745     }
 746     return format_date_in_iso($resultdate);
 747 }
 748
 749 =head2 GetSeq
 750
 751 =over 4
 752
 753 $calculated = GetSeq($val)
 754 $val is a hashref containing all the attributes of the table 'subscription'
 755 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 756 return:
 757 the sequence in integer format
 758
 759 =back
 760
 761 =cut
 762 sub GetSeq {
 763     my ($val) =@_;
 764     my $calculated = $val->{numberingmethod};
 765     my $x=$val->{'lastvalue1'};
 766     $calculated =~ s/\{X\}/$x/g;
 767     my $y=$val->{'lastvalue2'};
 768     $calculated =~ s/\{Y\}/$y/g;
 769     my $z=$val->{'lastvalue3'};
 770     $calculated =~ s/\{Z\}/$z/g;
 771     return $calculated;
 772 }
 773
 774 =head2 GetSubscriptionExpirationDate
 775
 776 =over 4
 777
 778 $sensddate = GetSubscriptionExpirationDate($subscriptionid)
 779
 780 this function return the expiration date for a subscription given on input args.
 781
 782 return
 783 the enddate
 784
 785 =back
 786
 787 =cut
 788 sub GetSubscriptionExpirationDate {
 789     my ($subscriptionid) = @_;
 790     my $dbh = C4::Context->dbh;
 791     my $subscription = GetSubscription($subscriptionid);
 792     my $enddate=$subscription->{startdate};
 793     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 794     if ($subscription->{numberlength}) {
 795         #calculate the date of the last issue.
 796         for (my $i=1;$i<=$subscription->{numberlength};$i++) {
 797             $enddate = GetNextDate($enddate,$subscription);
 798         }
 799     }
 800     else {
 801         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 802         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 803     }
 804     return $enddate;
 805 }
 806
 807 =head2 CountSubscriptionFromBiblionumber
 808
 809 =over 4
 810
 811 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
 812 this count the number of subscription for a biblionumber given.
 813 return :
 814 the number of subscriptions with biblionumber given on input arg.
 815
 816 =back
 817
 818 =cut
 819 sub CountSubscriptionFromBiblionumber {
 820     my ($biblionumber) = @_;
 821     my $dbh = C4::Context->dbh;
 822     my $query = qq|
 823         SELECT count(*)
 824         FROM   subscription
 825         WHERE  biblionumber=?
 826     |;
 827     my $sth = $dbh->prepare($query);
 828     $sth->execute($biblionumber);
 829     my $subscriptionsnumber = $sth->fetchrow;
 830     return $subscriptionsnumber;
 831 }
 832
 833
 834 =head2 ModSubscriptionHistory
 835
 836 =over 4
 837
 838 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
 839
 840 this function modify the history of a subscription. Put your new values on input arg.
 841
 842 =back
 843
 844 =cut
 845 sub ModSubscriptionHistory {
 846     my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 847     my $dbh=C4::Context->dbh;
 848     my $query = qq(
 849         UPDATE subscriptionhistory
 850         SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
 851         WHERE subscriptionid=?
 852     );
 853     my $sth = $dbh->prepare($query);
 854     $recievedlist =~ s/^,//g;
 855     $missinglist =~ s/^,//g;
 856     $opacnote =~ s/^,//g;
 857     $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 858 }
 859
 860 =head2 ModSerialStatus
 861
 862 =over 4
 863
 864 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 865
 866 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
 867 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
 868
 869 =back
 870
 871 =cut
 872 sub ModSerialStatus {
 873     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
 874     # 1st, get previous status :
 875     my $dbh = C4::Context->dbh;
 876     my $query = qq|
 877         SELECT subscriptionid,status
 878         FROM   serial
 879         WHERE  serialid=?
 880     |;
 881     my $sth = $dbh->prepare($query);
 882     $sth->execute($serialid);
 883     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 884     # change status & update subscriptionhistory
 885     if ($status eq 6){
 886         DelIssue($serialseq, $subscriptionid)
 887     } else {
 888         my $query = qq(
 889             UPDATE serial
 890             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
 891             WHERE  serialid = ?
 892         );
 893         $sth = $dbh->prepare($query);
 894         $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
 895         my $query = qq(
 896             SELECT missinglist,recievedlist
 897             FROM   subscriptionhistory
 898             WHERE  subscriptionid=?
 899         );
 900         $sth = $dbh->prepare($query);
 901         $sth->execute($subscriptionid);
 902         my ($missinglist,$recievedlist) = $sth->fetchrow;
 903         if ($status eq 2) {
 904             $recievedlist .= ",$serialseq";
 905         }
 906         $missinglist .= ",$serialseq" if ($status eq 4) ;
 907         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 908         my $query = qq(
 909             UPDATE subscriptionhistory
 910             SET    recievedlist=?, missinglist=?
 911             WHERE  subscriptionid=?
 912         );
 913         $sth=$dbh->prepare($query);
 914         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 915     }
 916     # create new waited entry if needed (ie : was a "waited" and has changed)
 917     if ($oldstatus eq 1 && $status ne 1) {
 918         my $query = qq(
 919             SELECT *
 920             FROM   subscription
 921             WHERE  subscriptionid = ?
 922         );
 923         $sth = $dbh->prepare($query);
 924         $sth->execute($subscriptionid);
 925         my $val = $sth->fetchrow_hashref;
 926         # next issue number
 927         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 928         # next date (calculated from actual date & frequency parameters)
 929         my $nextpublisheddate = GetNextDate($publisheddate,$val);
 930         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
 931         my $query = qq|
 932             UPDATE subscription
 933             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 934                    innerloop1=?, innerloop2=?, innerloop3=?
 935             WHERE  subscriptionid = ?
 936         |;
 937         $sth = $dbh->prepare($query);
 938         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 939     }
 940 }
 941
 942 =head2 ModSubscription
 943
 944 =over 4
 945
 946 this function modify a subscription. Put all new values on input args.
 947
 948 =back
 949
 950 =cut
 951 sub ModSubscription {
 952     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 953         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 954         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 955         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 956         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 957         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
 958     my $dbh = C4::Context->dbh;
 959     my $query = qq|
 960         UPDATE subscription
 961         SET     librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 962                 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 963                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 964                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 965                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 966                 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
 967         WHERE subscriptionid = ?
 968     |;
 969     my $sth=$dbh->prepare($query);
 970     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 971         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 972         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 973         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 974         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 975         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
 976     $sth->finish;
 977 }
 978
 979
 980 =head2 NewSubscription
 981
 982 =over 4
 983
 984 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 985     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 986     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 987     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 988     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 989     $numberingmethod, $status, $notes)
 990
 991 Create a new subscription with value given on input args.
 992
 993 return :
 994 the id of this new subscription
 995
 996 =back
 997
 998 =cut
 999 sub NewSubscription {
1000     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1001         $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1002         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1003         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1004         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1005         $numberingmethod, $status, $notes) = @_;
1006     my $dbh = C4::Context->dbh;
1007 #save subscription (insert into database)
1008     my $query = qq|
1009         INSERT INTO subscription
1010             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1011             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1012             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1013             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1014             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1015             numberingmethod, status, notes)
1016         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1017         |;
1018     my $sth=$dbh->prepare($query);
1019     $sth->execute(
1020         $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1021         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1022         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1023         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1024         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1025         $numberingmethod, $status, $notes);
1026
1027 #then create the 1st waited number
1028     my $subscriptionid = $dbh->{'mysql_insertid'};
1029     my $query = qq(
1030         INSERT INTO subscriptionhistory
1031             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1032         VALUES (?,?,?,?,?,?,?,?)
1033         );
1034     $sth = $dbh->prepare($query);
1035     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
1036
1037 # reread subscription to get a hash (for calculation of the 1st issue number)
1038     my $query = qq(
1039         SELECT *
1040         FROM   subscription
1041         WHERE  subscriptionid = ?
1042     );
1043     $sth = $dbh->prepare($query);
1044     $sth->execute($subscriptionid);
1045     my $val = $sth->fetchrow_hashref;
1046
1047 # calculate issue number
1048     my $serialseq = GetSeq($val);
1049     my $query = qq|
1050         INSERT INTO serial
1051             (serialseq,subscriptionid,biblionumber,status, planneddate)
1052         VALUES (?,?,?,?,?)
1053     |;
1054     $sth = $dbh->prepare($query);
1055     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1056     return $subscriptionid;
1057 }
1058
1059
1060 =head2 ReNewSubscription
1061
1062 =over 4
1063
1064 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1065
1066 this function renew a subscription with values given on input args.
1067
1068 =back
1069
1070 =cut
1071 sub ReNewSubscription {
1072     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1073     my $dbh = C4::Context->dbh;
1074     my $subscription = GetSubscription($subscriptionid);
1075     my $query = qq|
1076         SELECT *
1077         FROM   biblio,biblioitems
1078         WHERE  biblio.biblionumber=biblioitems.biblionumber
1079         AND    biblio.biblionumber=?
1080     |;
1081     my $sth = $dbh->prepare($query);
1082     $sth->execute($subscription->{biblionumber});
1083     my $biblio = $sth->fetchrow_hashref;
1084     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1085     # renew subscription
1086     my $query = qq|
1087         UPDATE subscription
1088         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1089         WHERE  subscriptionid=?
1090     |;
1091     $sth=$dbh->prepare($query);
1092     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1093 }
1094
1095
1096 =head2 NewIssue
1097
1098 =over 4
1099
1100 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1101
1102 Create a new issue stored on the database.
1103 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1104
1105 =back
1106
1107 =cut
1108 sub NewIssue {
1109     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1110     my $dbh = C4::Context->dbh;
1111     my $query = qq|
1112         INSERT INTO serial
1113             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1114         VALUES (?,?,?,?,?,?)
1115     |;
1116     my $sth = $dbh->prepare($query);
1117     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1118     my $query = qq|
1119         SELECT missinglist,recievedlist
1120         FROM   subscriptionhistory
1121         WHERE  subscriptionid=?
1122     |;
1123     $sth = $dbh->prepare($query);
1124     $sth->execute($subscriptionid);
1125     my ($missinglist,$recievedlist) = $sth->fetchrow;
1126     if ($status eq 2) {
1127         $recievedlist .= ",$serialseq";
1128     }
1129     if ($status eq 4) {
1130         $missinglist .= ",$serialseq";
1131     }
1132     my $query = qq|
1133         UPDATE subscriptionhistory
1134         SET    recievedlist=?, missinglist=?
1135         WHERE  subscriptionid=?
1136     |;
1137     $sth=$dbh->prepare($query);
1138     $sth->execute($recievedlist,$missinglist,$subscriptionid);
1139 }
1140
1141 =head2 serialchangestatus
1142
1143 =over 4
1144
1145 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1146
1147 Change the status of a serial issue.
1148 Note: this was the older subroutine
1149
1150 =back
1151
1152 =cut
1153 sub serialchangestatus {
1154     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1155     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1156     my $dbh = C4::Context->dbh;
1157     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1158     $sth->execute($serialid);
1159     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1160     # change status & update subscriptionhistory
1161     if ($status eq 6){
1162         delissue($serialseq, $subscriptionid)
1163     }else{
1164         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1165         $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1166         $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1167         $sth->execute($subscriptionid);
1168         my ($missinglist,$recievedlist) = $sth->fetchrow;
1169         if ($status eq 2) {
1170             $recievedlist .= "| $serialseq";
1171             $recievedlist =~ s/^\| //g;
1172         }
1173         $missinglist .= "| $serialseq" if ($status eq 4) ;
1174         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1175         $missinglist =~ s/^\| //g;
1176         $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1177         $sth->execute($recievedlist,$missinglist,$subscriptionid);
1178     }
1179     # create new waited entry if needed (ie : was a "waited" and has changed)
1180     if ($oldstatus eq 1 && $status ne 1) {
1181         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1182         $sth->execute($subscriptionid);
1183         my $val = $sth->fetchrow_hashref;
1184         # next issue number
1185         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1186         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1187         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1188         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1189         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1190     }
1191 }
1192
1193
1194 =head2 ItemizeSerials
1195
1196 =over 4
1197
1198 ItemizeSerials($serialid, $info);
1199 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1200 $serialid the serialid
1201 return :
1202 1 if the itemize is a succes.
1203 0 and @error else. @error containts the list of errors found.
1204
1205 =back
1206
1207 =cut
1208 sub ItemizeSerials {
1209     my ($serialid, $info) =@_;
1210     my $now = ParseDate("today");
1211     $now = UnixDate($now,"%Y-%m-%d");
1212
1213     my $dbh= C4::Context->dbh;
1214     my $query = qq|
1215         SELECT *
1216         FROM   serial
1217         WHERE  serialid=?
1218     |;
1219     my $sth=$dbh->prepare($query);
1220     $sth->execute($serialid);
1221     my $data=$sth->fetchrow_hashref;
1222     if(C4::Context->preference("RoutingSerials")){
1223         # check for existing biblioitem relating to serial issue
1224         my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1225         my $bibitemno = 0;
1226         for(my $i=0;$i<$count;$i++){
1227             if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1228                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1229                 last;
1230             }
1231         }
1232         if($bibitemno == 0){
1233             # warn "need to add new biblioitem so copy last one and make minor changes";
1234             my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1235             $sth->execute($data->{'biblionumber'});
1236             my $biblioitem;
1237             my $biblioitem = $sth->fetchrow_hashref;
1238             $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1239             $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1240             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1241             if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1242                 $bibitemno = newbiblioitem($biblioitem);
1243             }
1244         }
1245     }
1246
1247     my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1248     my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1249     if ($info->{barcode}){
1250         my @errors;
1251         my $exists = itemdata($info->{'barcode'});
1252         push @errors,"barcode_not_unique" if($exists);
1253         unless ($exists){
1254             my $marcrecord = MARC::Record->new();
1255             my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1256             my $newField = MARC::Field->new(
1257                 "$tag",'','',
1258                 "$subfield" => $info->{barcode}
1259             );
1260             $marcrecord->insert_fields_ordered($newField);
1261             if ($info->{branch}){
1262                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1263                 #warn "items.homebranch : $tag , $subfield";
1264                 if ($marcrecord->field($tag)) {
1265                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1266                 } else {
1267                     my $newField = MARC::Field->new(
1268                         "$tag",'','',
1269                         "$subfield" => $info->{branch}
1270                     );
1271                     $marcrecord->insert_fields_ordered($newField);
1272                 }
1273                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1274                 #warn "items.holdingbranch : $tag , $subfield";
1275                 if ($marcrecord->field($tag)) {
1276                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1277                 } else {
1278                     my $newField = MARC::Field->new(
1279                         "$tag",'','',
1280                         "$subfield" => $info->{branch}
1281                     );
1282                     $marcrecord->insert_fields_ordered($newField);
1283                 }
1284             }
1285             if ($info->{itemcallnumber}){
1286                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1287                 #warn "items.itemcallnumber : $tag , $subfield";
1288                 if ($marcrecord->field($tag)) {
1289                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1290                 } else {
1291                     my $newField = MARC::Field->new(
1292                         "$tag",'','',
1293                         "$subfield" => $info->{itemcallnumber}
1294                     );
1295                     $marcrecord->insert_fields_ordered($newField);
1296                 }
1297             }
1298             if ($info->{notes}){
1299                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1300                 # warn "items.itemnotes : $tag , $subfield";
1301                 if ($marcrecord->field($tag)) {
1302                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1303                 } else {
1304                     my $newField = MARC::Field->new(
1305                     "$tag",'','',
1306                     "$subfield" => $info->{notes}
1307                 );
1308                     $marcrecord->insert_fields_ordered($newField);
1309                 }
1310             }
1311             if ($info->{location}){
1312                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1313                 # warn "items.location : $tag , $subfield";
1314                 if ($marcrecord->field($tag)) {
1315                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1316                 } else {
1317                     my $newField = MARC::Field->new(
1318                         "$tag",'','',
1319                         "$subfield" => $info->{location}
1320                     );
1321                     $marcrecord->insert_fields_ordered($newField);
1322                 }
1323             }
1324             if ($info->{status}){
1325                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1326                 # warn "items.notforloan : $tag , $subfield";
1327                 if ($marcrecord->field($tag)) {
1328                 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1329                 } else {
1330                     my $newField = MARC::Field->new(
1331                         "$tag",'','',
1332                         "$subfield" => $info->{status}
1333                     );
1334                     $marcrecord->insert_fields_ordered($newField);
1335                 }
1336             }
1337             if(C4::Context->preference("RoutingSerials")){
1338                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1339                 if ($marcrecord->field($tag)) {
1340                     $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1341                 } else {
1342                     my $newField = MARC::Field->new(
1343                         "$tag",'','',
1344                         "$subfield" => $now
1345                     );
1346                     $marcrecord->insert_fields_ordered($newField);
1347                 }
1348             }
1349             NEWnewitem($dbh,$marcrecord,$bibid);
1350             return 1;
1351         }
1352         return (0,@errors);
1353     }
1354 }
1355
1356 =head2 HasSubscriptionExpired
1357
1358 =over 4
1359
1360 1 or 0 = HasSubscriptionExpired($subscriptionid)
1361
1362 the subscription has expired when the next issue to arrive is out of subscription limit.
1363
1364 return :
1365 1 if true, 0 if false.
1366
1367 =back
1368
1369 =cut
1370 sub HasSubscriptionExpired {
1371     my ($subscriptionid) = @_;
1372     my $dbh = C4::Context->dbh;
1373     my $subscription = GetSubscription($subscriptionid);
1374     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1375     if ($subscription->{numberlength}) {
1376         my $query = qq|
1377             SELECT count(*)
1378             FROM   serial
1379             WHERE  subscriptionid=? AND planneddate>=?
1380         |;
1381         my $sth = $dbh->prepare($query);
1382         $sth->execute($subscriptionid,$subscription->{startdate});
1383         my $res = $sth->fetchrow;
1384         if ($subscription->{numberlength}>=$res) {
1385             return 0;
1386         } else {
1387             return 1;
1388         }
1389     } else {
1390         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1391         my $query = qq|
1392             SELECT max(planneddate)
1393             FROM   serial
1394             WHERE  subscriptionid=?
1395         |;
1396         my $sth = $dbh->prepare($query);
1397         $sth->execute($subscriptionid);
1398         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1399         my $endofsubscriptiondate;
1400         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1401         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1402         return 1 if ($res >= $endofsubscriptiondate);
1403         return 0;
1404     }
1405 }
1406
1407 =head2 SetDistributedto
1408
1409 =over 4
1410
1411 SetDistributedto($distributedto,$subscriptionid);
1412 This function update the value of distributedto for a subscription given on input arg.
1413
1414 =back
1415
1416 =cut
1417 sub SetDistributedto {
1418     my ($distributedto,$subscriptionid) = @_;
1419     my $dbh = C4::Context->dbh;
1420     my $query = qq|
1421         UPDATE subscription
1422         SET    distributedto=?
1423         WHERE  subscriptionid=?
1424     |;
1425     my $sth = $dbh->prepare($query);
1426     $sth->execute($distributedto,$subscriptionid);
1427 }
1428
1429 =head2 DelSubscription
1430
1431 =over 4
1432
1433 DelSubscription($subscriptionid)
1434 this function delete the subscription which has $subscriptionid as id.
1435
1436 =back
1437
1438 =cut
1439 sub DelSubscription {
1440     my ($subscriptionid) = @_;
1441     my $dbh = C4::Context->dbh;
1442     $subscriptionid=$dbh->quote($subscriptionid);
1443     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1444     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1445     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1446 }
1447
1448 =head2 DelIssue
1449
1450 =over 4
1451
1452 DelIssue($serialseq,$subscriptionid)
1453 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1454
1455 =back
1456
1457 =cut
1458 sub DelIssue {
1459     my ($serialseq,$subscriptionid) = @_;
1460     my $dbh = C4::Context->dbh;
1461     my $query = qq|
1462         DELETE FROM serial
1463         WHERE       serialseq= ?
1464         AND         subscriptionid= ?
1465     |;
1466     my $sth = $dbh->prepare($query);
1467     $sth->execute($serialseq,$subscriptionid);
1468 }
1469
1470 =head2 GetMissingIssues
1471
1472 =over 4
1473
1474 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1475
1476 this function select missing issues on database - where serial.status = 4
1477
1478 return :
1479 a count of the number of missing issues
1480 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1481 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1482
1483 =back
1484
1485 =cut
1486 sub GetMissingIssues {
1487     my ($supplierid,$serialid) = @_;
1488     my $dbh = C4::Context->dbh;
1489     my $sth;
1490     my $byserial='';
1491     if($serialid) {
1492         $byserial = "and serialid = ".$serialid;
1493     }
1494     if ($supplierid) {
1495         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1496                                   FROM subscription, serial, biblio
1497                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1498                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1499                                   serial.STATUS = 4 and
1500                                   subscription.aqbooksellerid=$supplierid and
1501                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1502                                   ");
1503     } else {
1504         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1505                                   FROM subscription, serial, biblio
1506                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1507                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1508                                   serial.STATUS =4 and
1509                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1510                                   ");
1511     }
1512     $sth->execute;
1513     my @issuelist;
1514     my $last_title;
1515     my $odd=0;
1516     my $count=0;
1517     while (my $line = $sth->fetchrow_hashref) {
1518         $odd++ unless $line->{title} eq $last_title;
1519         $last_title = $line->{title} if ($line->{title});
1520         $line->{planneddate} = format_date($line->{planneddate});
1521         $line->{claimdate} = format_date($line->{claimdate});
1522         $line->{'odd'} = 1 if $odd %2 ;
1523         $count++;
1524         push @issuelist,$line;
1525     }
1526     return $count,@issuelist;
1527 }
1528
1529 =head2 removeMissingIssue
1530
1531 =over 4
1532
1533 removeMissingIssue($subscriptionid)
1534
1535 this function removes an issue from being part of the missing string in
1536 subscriptionlist.missinglist column
1537
1538 called when a missing issue is found from the statecollection.pl file
1539
1540 =back
1541
1542 =cut
1543 sub removeMissingIssue {
1544     my ($sequence,$subscriptionid) = @_;
1545     my $dbh = C4::Context->dbh;
1546     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1547     $sth->execute($subscriptionid);
1548     my $data = $sth->fetchrow_hashref;
1549     my $missinglist = $data->{'missinglist'};
1550     my $missinglistbefore = $missinglist;
1551     # warn $missinglist." before";
1552     $missinglist =~ s/($sequence)//;
1553     # warn $missinglist." after";
1554     if($missinglist ne $missinglistbefore){
1555         $missinglist =~ s/\|\s\|/\|/g;
1556         $missinglist =~ s/^\| //g;
1557         $missinglist =~ s/\|$//g;
1558         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1559                                        SET missinglist = ?
1560                                        WHERE subscriptionid = ?");
1561         $sth2->execute($missinglist,$subscriptionid);
1562     }
1563 }
1564
1565 =head2 updateClaim
1566
1567 =over 4
1568
1569 &updateClaim($serialid)
1570
1571 this function updates the time when a claim is issued for late/missing items
1572
1573 called from claims.pl file
1574
1575 =back
1576
1577 =cut
1578 sub updateClaim {
1579     my ($serialid) = @_;
1580     my $dbh = C4::Context->dbh;
1581     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1582                                    WHERE serialid = ?
1583                                    ");
1584     $sth->execute($serialid);
1585 }
1586
1587 =head2 getsupplierbyserialid
1588
1589 =over 4
1590
1591 ($result) = &getsupplierbyserialid($serialid)
1592
1593 this function is used to find the supplier id given a serial id
1594
1595 return :
1596 hashref containing serialid, subscriptionid, and aqbooksellerid
1597
1598 =back
1599
1600 =cut
1601 sub getsupplierbyserialid {
1602     my ($serialid) = @_;
1603     my $dbh = C4::Context->dbh;
1604     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1605                                    FROM serial, subscription
1606                                    WHERE serial.subscriptionid = subscription.subscriptionid
1607                                    AND serialid = ?
1608                                    ");
1609     $sth->execute($serialid);
1610     my $line = $sth->fetchrow_hashref;
1611     my $result = $line->{'aqbooksellerid'};
1612     return $result;
1613 }
1614
1615 =head2 check_routing
1616
1617 =over 4
1618
1619 ($result) = &check_routing($subscriptionid)
1620
1621 this function checks to see if a serial has a routing list and returns the count of routingid
1622 used to show either an 'add' or 'edit' link
1623 =back
1624
1625 =cut
1626 sub check_routing {
1627     my ($subscriptionid) = @_;
1628     my $dbh = C4::Context->dbh;
1629     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1630                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1631                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1632                               ");
1633     $sth->execute($subscriptionid);
1634     my $line = $sth->fetchrow_hashref;
1635     my $result = $line->{'routingids'};
1636     return $result;
1637 }
1638
1639 =head2 addroutingmember
1640
1641 =over 4
1642
1643 &addroutingmember($bornum,$subscriptionid)
1644
1645 this function takes a borrowernumber and subscriptionid and add the member to the
1646 routing list for that serial subscription and gives them a rank on the list
1647 of either 1 or highest current rank + 1
1648
1649 =back
1650
1651 =cut
1652 sub addroutingmember {
1653     my ($bornum,$subscriptionid) = @_;
1654     my $rank;
1655     my $dbh = C4::Context->dbh;
1656     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1657     $sth->execute($subscriptionid);
1658     while(my $line = $sth->fetchrow_hashref){
1659         if($line->{'rank'}>0){
1660             $rank = $line->{'rank'}+1;
1661         } else {
1662             $rank = 1;
1663         }
1664     }
1665     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1666     $sth->execute($subscriptionid,$bornum,$rank);
1667 }
1668
1669 =head2 reorder_members
1670
1671 =over 4
1672
1673 &reorder_members($subscriptionid,$routingid,$rank)
1674
1675 this function is used to reorder the routing list
1676
1677 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1678 - it gets all members on list puts their routingid's into an array
1679 - removes the one in the array that is $routingid
1680 - then reinjects $routingid at point indicated by $rank
1681 - then update the database with the routingids in the new order
1682
1683 =back
1684
1685 =cut
1686 sub reorder_members {
1687     my ($subscriptionid,$routingid,$rank) = @_;
1688     my $dbh = C4::Context->dbh;
1689     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1690     $sth->execute($subscriptionid);
1691     my @result;
1692     while(my $line = $sth->fetchrow_hashref){
1693         push(@result,$line->{'routingid'});
1694     }
1695     # To find the matching index
1696     my $i;
1697     my $key = -1; # to allow for 0 being a valid response
1698     for ($i = 0; $i < @result; $i++) {
1699         if ($routingid == $result[$i]) {
1700             $key = $i; # save the index
1701             last;
1702         }
1703     }
1704     # if index exists in array then move it to new position
1705     if($key > -1 && $rank > 0){
1706         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1707         my $moving_item = splice(@result, $key, 1);
1708         splice(@result, $new_rank, 0, $moving_item);
1709     }
1710     for(my $j = 0; $j < @result; $j++){
1711         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1712         $sth->execute;
1713     }
1714 }
1715
1716 =head2 delroutingmember
1717
1718 =over 4
1719
1720 &delroutingmember($routingid,$subscriptionid)
1721
1722 this function either deletes one member from routing list if $routingid exists otherwise
1723 deletes all members from the routing list
1724
1725 =back
1726
1727 =cut
1728 sub delroutingmember {
1729     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1730     my ($routingid,$subscriptionid) = @_;
1731     my $dbh = C4::Context->dbh;
1732     if($routingid){
1733         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1734         $sth->execute($routingid);
1735         reorder_members($subscriptionid,$routingid);
1736     } else {
1737         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1738         $sth->execute($subscriptionid);
1739     }
1740 }
1741
1742 =head2 getroutinglist
1743
1744 =over 4
1745
1746 ($count,@routinglist) = &getroutinglist($subscriptionid)
1747
1748 this gets the info from the subscriptionroutinglist for $subscriptionid
1749
1750 return :
1751 a count of the number of members on routinglist
1752 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1753 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1754
1755 =back
1756
1757 =cut
1758 sub getroutinglist {
1759     my ($subscriptionid) = @_;
1760     my $dbh = C4::Context->dbh;
1761     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1762                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1763                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1764                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1765                               ");
1766     $sth->execute($subscriptionid);
1767     my @routinglist;
1768     my $count=0;
1769     while (my $line = $sth->fetchrow_hashref) {
1770         $count++;
1771         push(@routinglist,$line);
1772     }
1773     return ($count,@routinglist);
1774 }
1775
1776 =head2 abouttoexpire
1777
1778 =over 4
1779
1780 $result = &abouttoexpire($subscriptionid)
1781
1782 this function alerts you to the penultimate issue for a serial subscription
1783
1784 returns 1 - if this is the penultimate issue
1785 returns 0 - if not
1786
1787 =back
1788
1789 =cut
1790
1791 sub abouttoexpire {
1792     my ($subscriptionid) = @_;
1793     my $dbh = C4::Context->dbh;
1794     my $subscription = getsubscription($subscriptionid);
1795     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1796     if ($subscription->{numberlength}) {
1797         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1798         $sth->execute($subscriptionid,$subscription->{startdate});
1799         my $res = $sth->fetchrow;
1800         # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1801         if ($subscription->{numberlength}==$res) {
1802             return 1;
1803         } else {
1804             return 0;
1805         }
1806     } else {
1807         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1808         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1809         $sth->execute($subscriptionid);
1810         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1811         my $endofsubscriptiondate;
1812         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1813         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1814         # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1815         my $per = $subscription->{'periodicity'};
1816         my $x = 0;
1817         if ($per == 1) { $x = '1 day'; }
1818         if ($per == 2) { $x = '1 week'; }
1819         if ($per == 3) { $x = '2 weeks'; }
1820         if ($per == 4) { $x = '3 weeks'; }
1821         if ($per == 5) { $x = '1 month'; }
1822         if ($per == 6) { $x = '2 months'; }
1823         if ($per == 7 || $per == 8) { $x = '3 months'; }
1824         if ($per == 9) { $x = '6 months'; }
1825         if ($per == 10) { $x = '1 year'; }
1826         if ($per == 11) { $x = '2 years'; }
1827         my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1828         # warn "DATE BEFORE END: $datebeforeend";
1829         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1830         return 0;
1831     }
1832 }
1833
1834 =head2 old_newsubscription
1835
1836 =over 4
1837
1838 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1839                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1840                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1841                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1842                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1843                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
1844
1845 this function is similar to the NewSubscription subroutine but has a few different
1846 values passed in
1847 $firstacquidate - date of first serial issue to arrive
1848 $irregularity - the issues not expected separated by a '|'
1849 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1850 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1851    alt_subscription-add.tmpl file
1852 $callnumber - display the callnumber of the serial
1853 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1854
1855 return :
1856 the $subscriptionid number of the new subscription
1857
1858 =back
1859
1860 =cut
1861 sub old_newsubscription {
1862             my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1863                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1864                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1865                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1866                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1867                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_;
1868             my $dbh = C4::Context->dbh;
1869             #save subscription
1870             my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1871                                                                 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
1872                                                                         add1,every1,whenmorethan1,setto1,lastvalue1,
1873                                                                         add2,every2,whenmorethan2,setto2,lastvalue2,
1874                                                                         add3,every3,whenmorethan3,setto3,lastvalue3,
1875                                                                         numberingmethod, status, callnumber, notes, hemisphere) values
1876                                                           (?,?,?,?,?,?,?,?,?,?,?,
1877                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,
1878                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,?)");
1879         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1880             format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1881                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1882                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1883                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1884                                                     $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1885         #then create the 1st waited number
1886         my $subscriptionid = $dbh->{'mysql_insertid'};
1887         my $enddate = subscriptionexpirationdate($subscriptionid);
1888
1889         $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1890         $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1891         # reread subscription to get a hash (for calculation of the 1st issue number)
1892         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1893         $sth->execute($subscriptionid);
1894         my $val = $sth->fetchrow_hashref;
1895
1896         # calculate issue number
1897         my $serialseq = Get_Seq($val);
1898         $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1899         $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1900         return $subscriptionid;
1901 }
1902
1903 =head2 old_modsubscription
1904
1905 =over 4
1906
1907 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1908                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1909                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1910                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1911                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1912                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
1913
1914 this function is similar to the ModSubscription subroutine but has a few different
1915 values passed in
1916 $firstacquidate - date of first serial issue to arrive
1917 $irregularity - the issues not expected separated by a '|'
1918 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1919 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1920    alt_subscription-add.tmpl file
1921 $callnumber - display the callnumber of the serial
1922 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1923
1924 =back
1925
1926 =cut
1927 sub old_modsubscription {
1928             my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1929                                                         $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1930                                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1931                                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1932                                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1933                                                         $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1934             my $dbh = C4::Context->dbh;
1935             my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1936                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1937                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1938                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1939                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1940                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1941         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1942                                                     $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1943                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1944                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1945                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1946                                                     $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1947         $sth->finish;
1948
1949
1950         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1951         $sth->execute($subscriptionid);
1952         my $val = $sth->fetchrow_hashref;
1953
1954         # calculate issue number
1955         my $serialseq = Get_Seq($val);
1956         $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1957         $sth->execute($serialseq,$subscriptionid);
1958
1959         my $enddate = subscriptionexpirationdate($subscriptionid);
1960         $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1961         $sth->execute(format_date_in_iso($enddate));
1962 }
1963
1964 =head2 old_getserials
1965
1966 =over 4
1967
1968 ($totalissues,@serials) = &old_getserials($subscriptionid)
1969
1970 this function get a hashref of serials and the total count of them
1971
1972 return :
1973 $totalissues - number of serial lines
1974 the serials into a table. Each line of this table containts a ref to a hash which it containts
1975 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
1976
1977 =back
1978
1979 =cut
1980 sub old_getserials {
1981             my ($subscriptionid) = @_;
1982             my $dbh = C4::Context->dbh;
1983             # status = 2 is "arrived"
1984             my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1985           $sth->execute($subscriptionid);
1986         my @serials;
1987         my $num = 1;
1988         while(my $line = $sth->fetchrow_hashref) {
1989                             $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1990                             $line->{"planneddate"} = format_date($line->{"planneddate"});
1991                             $line->{"num"} = $num;
1992                             $num++;
1993                             push @serials,$line;
1994                     }
1995         $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
1996         $sth->execute($subscriptionid);
1997         my ($totalissues) = $sth->fetchrow;
1998         return ($totalissues,@serials);
1999 }
2000
2001 =head2 Get_Next_Date
2002
2003 =over 4
2004
2005 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
2006
2007 this function is an extension of GetNextDate which allows for checking for irregularity
2008
2009 it takes the planneddate and will return the next issue's date and will skip dates if there
2010 exists an irregularity
2011 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2012 skipped then the returned date will be 2007-05-10
2013
2014 return :
2015 $resultdate - then next date in the sequence
2016
2017 =back
2018
2019 =cut
2020 sub Get_Next_Date(@) {
2021     my ($planneddate,$subscription) = @_;
2022     my @irreg = split(/\|/,$subscription->{irregularity});
2023
2024     my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
2025     my $dayofweek = Date_DayOfWeek($month,$day,$year);
2026     my $resultdate;
2027     #       warn "DOW $dayofweek";
2028     if ($subscription->{periodicity} == 1) {
2029         for(my $i=0;$i<@irreg;$i++){
2030             if($dayofweek == 7){ $dayofweek = 0; }
2031             if(in_array(($dayofweek+1), @irreg)){
2032                 $planneddate = DateCalc($planneddate,"1 day");
2033                 $dayofweek++;
2034             }
2035         }
2036         $resultdate=DateCalc($planneddate,"1 day");
2037     }
2038     if ($subscription->{periodicity} == 2) {
2039         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2040         for(my $i = 0;$i < @irreg; $i++){
2041             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2042             if($irreg[$i] == ($wkno+1)){
2043                 $planneddate = DateCalc($planneddate,"1 week");
2044                 $wkno++;
2045             }
2046         }
2047         $resultdate=DateCalc($planneddate,"1 week");
2048     }
2049     if ($subscription->{periodicity} == 3) {
2050         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2051         for(my $i = 0;$i < @irreg; $i++){
2052             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2053             if($irreg[$i] == ($wkno+1)){
2054                 $planneddate = DateCalc($planneddate,"2 weeks");
2055                 $wkno++;
2056             }
2057         }
2058         $resultdate=DateCalc($planneddate,"2 weeks");
2059     }
2060     if ($subscription->{periodicity} == 4) {
2061         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2062         for(my $i = 0;$i < @irreg; $i++){
2063             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2064             if($irreg[$i] == ($wkno+1)){
2065                 $planneddate = DateCalc($planneddate,"3 weeks");
2066                 $wkno++;
2067             }
2068         }
2069         $resultdate=DateCalc($planneddate,"3 weeks");
2070     }
2071     if ($subscription->{periodicity} == 5) {
2072         for(my $i = 0;$i < @irreg; $i++){
2073             # warn $irreg[$i];
2074             # warn $month;
2075             if($month == 12) { $month = 0; } # need to rollover to check January
2076             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2077                 $planneddate = DateCalc($planneddate,"1 month");
2078                 $month++; # to check if following ones are to be skipped too
2079             }
2080         }
2081         $resultdate=DateCalc($planneddate,"1 month");
2082         # warn "Planneddate2: $planneddate";
2083     }
2084     if ($subscription->{periodicity} == 6) {
2085         for(my $i = 0;$i < @irreg; $i++){
2086             if($month == 12) { $month = 0; } # need to rollover to check January
2087             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2088                 $planneddate = DateCalc($planneddate,"2 months");
2089                 $month++; # to check if following ones are to be skipped too
2090             }
2091         }
2092         $resultdate=DateCalc($planneddate,"2 months");
2093     }
2094     if ($subscription->{periodicity} == 7) {
2095         for(my $i = 0;$i < @irreg; $i++){
2096             if($month == 12) { $month = 0; } # need to rollover to check January
2097             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2098                 $planneddate = DateCalc($planneddate,"3 months");
2099                 $month++; # to check if following ones are to be skipped too
2100             }
2101         }
2102         $resultdate=DateCalc($planneddate,"3 months");
2103     }
2104     if ($subscription->{periodicity} == 8) {
2105         for(my $i = 0;$i < @irreg; $i++){
2106             if($month == 12) { $month = 0; } # need to rollover to check January
2107             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2108                 $planneddate = DateCalc($planneddate,"3 months");
2109                 $month++; # to check if following ones are to be skipped too
2110             }
2111         }
2112         $resultdate=DateCalc($planneddate,"3 months");
2113     }
2114     if ($subscription->{periodicity} == 9) {
2115         for(my $i = 0;$i < @irreg; $i++){
2116             if($month == 12) { $month = 0; } # need to rollover to check January
2117             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2118                 $planneddate = DateCalc($planneddate,"6 months");
2119                 $month++; # to check if following ones are to be skipped too
2120             }
2121         }
2122         $resultdate=DateCalc($planneddate,"6 months");
2123     }
2124     if ($subscription->{periodicity} == 10) {
2125         $resultdate=DateCalc($planneddate,"1 year");
2126     }
2127     if ($subscription->{periodicity} == 11) {
2128         $resultdate=DateCalc($planneddate,"2 years");
2129     }
2130     #    warn "date: ".$resultdate;
2131     return format_date_in_iso($resultdate);
2132 }
2133
2134
2135 END { }       # module clean-up code here (global destructor)
2136
2137 1;