C4/Serials.pm

   1 package C4::Serials; #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # $Id$
  21
  22 use strict;
  23 use C4::Date;
  24 use Date::Manip;
  25 use C4::Suggestions;
  26 use C4::Biblio;
  27 use C4::Search;
  28 use C4::Letters;
  29 require Exporter;
  30
  31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  32
  33 # set the version for version checking
  34 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  35         shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  36
  37
  38 =head1 NAME
  39
  40 C4::Serials - Give functions for serializing.
  41
  42 =head1 SYNOPSIS
  43
  44   use C4::Serials;
  45
  46 =head1 DESCRIPTION
  47
  48 Give all XYZ functions
  49
  50 =head1 FUNCTIONS
  51
  52 =cut
  53 @ISA = qw(Exporter);
  54 @EXPORT = qw(
  55     &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions &GetSubscription
  56     &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
  57     &GetFullSubscriptionsFromBiblionumber &GetNextSeq
  58     &ModSubscriptionHistory &NewIssue &ItemizeSerials
  59     &GetSerials &GetLatestSerials &ModSerialStatus
  60     &HasSubscriptionExpired &GetSubscriptionExpirationDate &ReNewSubscription
  61     &GetSuppliersWithLateIssues &GetLateIssues &GetMissingIssues
  62     &GetDistributedTo &SetDistributedto &serialchangestatus
  63     &getroutinglist &delroutingmember &addroutingmember &reorder_members
  64     &check_routing &getsupplierbyserialid &updateClaim &removeMissingIssue &abouttoexpire
  65     &old_newsubscription &old_modsubscription &old_getserials &Get_Next_Date
  66 );
  67
  68 =head2 GetSuppliersWithLateIssues
  69
  70 =over 4
  71
  72 %supplierlist = &GetSuppliersWithLateIssues
  73
  74 this function get all suppliers with late issues.
  75
  76 return :
  77 the supplierlist into a hash. this hash containts id & name of the supplier
  78
  79 =back
  80
  81 =cut
  82 sub GetSuppliersWithLateIssues {
  83     my $dbh = C4::Context->dbh;
  84     my $query = qq|
  85         SELECT DISTINCT id, name
  86         FROM            subscription, serial
  87         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
  88         WHERE           subscription.subscriptionid = serial.subscriptionid
  89         AND             (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
  90     |;
  91     my $sth = $dbh->prepare($query);
  92     $sth->execute;
  93     my %supplierlist;
  94     while (my ($id,$name) = $sth->fetchrow) {
  95         $supplierlist{$id} = $name;
  96     }
  97     if(C4::Context->preference("RoutingSerials")){
  98         $supplierlist{''} = "All Suppliers";
  99     }
 100     return %supplierlist;
 101 }
 102
 103 =head2 GetLateIssues
 104
 105 =over 4
 106
 107 @issuelist = &GetLateIssues($supplierid)
 108
 109 this function select late issues on database
 110
 111 return :
 112 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
 113 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
 114
 115 =back
 116
 117 =cut
 118 sub GetLateIssues {
 119     my ($supplierid) = @_;
 120     my $dbh = C4::Context->dbh;
 121     my $sth;
 122     if ($supplierid) {
 123         my $query = qq |
 124             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 125             FROM       subscription, serial, biblio
 126             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 127             WHERE      subscription.subscriptionid = serial.subscriptionid
 128             AND        ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 129             AND        subscription.aqbooksellerid=$supplierid
 130             AND        biblio.biblionumber = subscription.biblionumber
 131             ORDER BY   title
 132         |;
 133         $sth = $dbh->prepare($query);
 134     } else {
 135         my $query = qq|
 136             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 137             FROM       subscription, serial, biblio
 138             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 139             WHERE      subscription.subscriptionid = serial.subscriptionid
 140             AND        ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 141             AND        biblio.biblionumber = subscription.biblionumber
 142             ORDER BY   title
 143         |;
 144         $sth = $dbh->prepare($query);
 145     }
 146     $sth->execute;
 147     my @issuelist;
 148     my $last_title;
 149     my $odd=0;
 150     my $count=0;
 151     while (my $line = $sth->fetchrow_hashref) {
 152         $odd++ unless $line->{title} eq $last_title;
 153         $line->{title} = "" if $line->{title} eq $last_title;
 154         $last_title = $line->{title} if ($line->{title});
 155         $line->{planneddate} = format_date($line->{planneddate});
 156         $line->{'odd'} = 1 if $odd %2 ;
 157         $count++;
 158         push @issuelist,$line;
 159     }
 160     return $count,@issuelist;
 161 }
 162
 163 =head2 GetSubscriptionHistoryFromSubscriptionId
 164
 165 =over 4
 166
 167 $sth = GetSubscriptionHistoryFromSubscriptionId()
 168 this function just prepare the SQL request.
 169 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
 170 return :
 171 $sth = $dbh->prepare($query).
 172
 173 =back
 174
 175 =cut
 176 sub GetSubscriptionHistoryFromSubscriptionId() {
 177     my $dbh = C4::Context->dbh;
 178     my $query = qq|
 179         SELECT *
 180         FROM   subcriptionhistory
 181         WHERE  subscriptionid = ?
 182     |;
 183     return $dbh->prepare($query);
 184 }
 185
 186 =head2 GetSerialStatusFromSerialId
 187
 188 =over 4
 189
 190 $sth = GetSerialStatusFromSerialId();
 191 this function just prepare the SQL request.
 192 After this function, don't forget to execute it by using $sth->execute($serialid)
 193 return :
 194 $sth = $dbh->prepare($query).
 195
 196 =back
 197
 198 =cut
 199 sub GetSerialStatusFromSerialId(){
 200     my $dbh = C4::Context->dbh;
 201     my $query = qq|
 202         SELECT status
 203         FROM   serial
 204         WHERE  serialid = ?
 205     |;
 206     return $dbh->prepare($query);
 207 }
 208
 209
 210 =head2 GetSubscription
 211
 212 =over 4
 213
 214 $subs = GetSubscription($subscriptionid)
 215 this function get the subscription which has $subscriptionid as id.
 216 return :
 217 a hashref. This hash containts
 218 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 219
 220 =back
 221
 222 =cut
 223 sub GetSubscription {
 224     my ($subscriptionid) = @_;
 225     my $dbh = C4::Context->dbh;
 226     my $query =qq(
 227         SELECT  subscription.*,
 228                 subscriptionhistory.*,
 229                 aqbudget.bookfundid,
 230                 aqbooksellers.name AS aqbooksellername,
 231                 biblio.title AS bibliotitle
 232        FROM subscription
 233        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 234        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 235        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 236        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 237        WHERE subscription.subscriptionid = ?
 238     );
 239     my $sth = $dbh->prepare($query);
 240     $sth->execute($subscriptionid);
 241     my $subs = $sth->fetchrow_hashref;
 242     return $subs;
 243 }
 244
 245 =head2 GetSubscriptionsFromBiblionumber
 246
 247 =over 4
 248
 249 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
 250 this function get the subscription list. it reads on subscription table.
 251 return :
 252 table of subscription which has the biblionumber given on input arg.
 253 each line of this table is a hashref. All hashes containt
 254 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
 255
 256 =back
 257
 258 =cut
 259 sub GetSubscriptionsFromBiblionumber {
 260     my ($biblionumber) = @_;
 261     my $dbh = C4::Context->dbh;
 262     my $query = qq(
 263         SELECT subscription.*,
 264                subscriptionhistory.*,
 265                aqbudget.bookfundid,
 266                aqbooksellers.name AS aqbooksellername,
 267                biblio.title AS bibliotitle
 268        FROM subscription
 269        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 270        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 271        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 272        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 273        WHERE subscription.biblionumber = ?
 274     );
 275     my $sth = $dbh->prepare($query);
 276     $sth->execute($biblionumber);
 277     my @res;
 278     while (my $subs = $sth->fetchrow_hashref) {
 279         $subs->{startdate} = format_date($subs->{startdate});
 280         $subs->{histstartdate} = format_date($subs->{histstartdate});
 281         $subs->{opacnote} =~ s/\n/\<br\/\>/g;
 282         $subs->{missinglist} =~ s/\n/\<br\/\>/g;
 283         $subs->{recievedlist} =~ 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,biblioitems.issn,subscription.notes,biblio.biblionumber
 400             FROM   subscription,biblio,biblioitems
 401             WHERE   biblio.biblionumber = biblioitems.biblionumber
 402                 AND biblio.biblionumber = subscription.biblionumber
 403                 AND biblio.biblionumber=?
 404             ORDER BY title
 405         );
 406     $sth = $dbh->prepare($query);
 407     $sth->execute($biblionumber);
 408     } else {
 409         if ($ISSN and $title){
 410             my $query = qq|
 411                 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 412                 FROM   subscription,biblio,biblioitems
 413                 WHERE  biblio.biblionumber = biblioitems.biblionumber
 414                     AND biblio.biblionumber= subscription.biblionumber
 415                     AND (biblio.title LIKE ? or biblioitems.issn = ?)
 416                 ORDER BY title
 417             |;
 418             $sth = $dbh->prepare($query);
 419             $sth->execute("%$title%",$ISSN);
 420         }
 421         else{
 422             if ($ISSN){
 423                 my $query = qq(
 424                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 425                     FROM   subscription,biblio,biblioitems
 426                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 427                         AND biblio.biblionumber=subscription.biblionumber
 428                         AND biblioitems.issn = ?
 429                     ORDER BY title
 430                 );
 431                 $sth = $dbh->prepare($query);
 432                 $sth->execute($ISSN);
 433             } else {
 434                 my $query = qq(
 435                     SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber
 436                     FROM   subscription,biblio,biblioitems
 437                     WHERE  biblio.biblionumber = biblioitems.biblionumber
 438                         AND biblio.biblionumber=subscription.biblionumber
 439                         AND biblio.title LIKE ?
 440                     ORDER BY title
 441                 );
 442                 $sth = $dbh->prepare($query);
 443                 $sth->execute("%$title%");
 444             }
 445         }
 446     }
 447     my @results;
 448     my $previoustitle="";
 449     my $odd=1;
 450     while (my $line = $sth->fetchrow_hashref) {
 451         if ($previoustitle eq $line->{title}) {
 452             $line->{title}="";
 453             $line->{issn}="";
 454             $line->{toggle} = 1 if $odd==1;
 455         } else {
 456             $previoustitle=$line->{title};
 457             $odd=-$odd;
 458             $line->{toggle} = 1 if $odd==1;
 459         }
 460         push @results, $line;
 461     }
 462     return @results;
 463 }
 464
 465 =head2 GetSerials
 466
 467 =over 4
 468
 469 ($totalissues,@serials) = GetSerials($subscriptionid);
 470 this function get every serial not arrived for a given subscription
 471 as well as the number of issues registered in the database (all types)
 472 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 473
 474 =back
 475
 476 =cut
 477 sub GetSerials {
 478     my ($subscriptionid) = @_;
 479     my $dbh = C4::Context->dbh;
 480     # OK, now add the last 5 issues arrives/missing
 481     my $query = qq|
 482         SELECT   serialid,serialseq, status, planneddate,notes
 483         FROM     serial
 484         WHERE    subscriptionid = ?
 485         AND      (status in (2,4,5))
 486         ORDER BY serialid DESC
 487     |;
 488     my $sth=$dbh->prepare($query);
 489     $sth->execute($subscriptionid);
 490     my $counter=0;
 491     my @serials;
 492     while((my $line = $sth->fetchrow_hashref) && $counter <5) {
 493         $counter++;
 494         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 495         $line->{"planneddate"} = format_date($line->{"planneddate"});
 496         push @serials,$line;
 497     }
 498     # status = 2 is "arrived"
 499     my $query = qq|
 500         SELECT serialid,serialseq, status, publisheddate, planneddate,notes
 501         FROM   serial
 502         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 503     |;
 504     my $sth=$dbh->prepare($query);
 505     $sth->execute($subscriptionid);
 506     while(my $line = $sth->fetchrow_hashref) {
 507         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 508         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 509         $line->{"planneddate"} = format_date($line->{"planneddate"});
 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 recieved.
 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     if ($subscription->{periodicity} == 1) {
 715         $resultdate=DateCalc($planneddate,"1 day");
 716     }
 717     if ($subscription->{periodicity} == 2) {
 718         $resultdate=DateCalc($planneddate,"1 week");
 719     }
 720     if ($subscription->{periodicity} == 3) {
 721         $resultdate=DateCalc($planneddate,"2 weeks");
 722     }
 723     if ($subscription->{periodicity} == 4) {
 724         $resultdate=DateCalc($planneddate,"3 weeks");
 725     }
 726     if ($subscription->{periodicity} == 5) {
 727         $resultdate=DateCalc($planneddate,"1 month");
 728     }
 729     if ($subscription->{periodicity} == 6) {
 730         $resultdate=DateCalc($planneddate,"2 months");
 731     }
 732     if ($subscription->{periodicity} == 7) {
 733         $resultdate=DateCalc($planneddate,"3 months");
 734     }
 735     if ($subscription->{periodicity} == 8) {
 736         $resultdate=DateCalc($planneddate,"3 months");
 737     }
 738     if ($subscription->{periodicity} == 9) {
 739         $resultdate=DateCalc($planneddate,"6 months");
 740     }
 741     if ($subscription->{periodicity} == 10) {
 742         $resultdate=DateCalc($planneddate,"1 year");
 743     }
 744     if ($subscription->{periodicity} == 11) {
 745         $resultdate=DateCalc($planneddate,"2 years");
 746     }
 747     return format_date_in_iso($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         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
 803         $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
 804     }
 805     return $enddate;
 806 }
 807
 808 =head2 CountSubscriptionFromBiblionumber
 809
 810 =over 4
 811
 812 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
 813 this count the number of subscription for a biblionumber given.
 814 return :
 815 the number of subscriptions with biblionumber given on input arg.
 816
 817 =back
 818
 819 =cut
 820 sub CountSubscriptionFromBiblionumber {
 821     my ($biblionumber) = @_;
 822     my $dbh = C4::Context->dbh;
 823     my $query = qq|
 824         SELECT count(*)
 825         FROM   subscription
 826         WHERE  biblionumber=?
 827     |;
 828     my $sth = $dbh->prepare($query);
 829     $sth->execute($biblionumber);
 830     my $subscriptionsnumber = $sth->fetchrow;
 831     return $subscriptionsnumber;
 832 }
 833
 834
 835 =head2 ModSubscriptionHistory
 836
 837 =over 4
 838
 839 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
 840
 841 this function modify the history of a subscription. Put your new values on input arg.
 842
 843 =back
 844
 845 =cut
 846 sub ModSubscriptionHistory {
 847     my ($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote)=@_;
 848     my $dbh=C4::Context->dbh;
 849     my $query = qq(
 850         UPDATE subscriptionhistory
 851         SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
 852         WHERE subscriptionid=?
 853     );
 854     my $sth = $dbh->prepare($query);
 855     $recievedlist =~ s/^,//g;
 856     $missinglist =~ s/^,//g;
 857     $opacnote =~ s/^,//g;
 858     $sth->execute($histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote,$subscriptionid);
 859 }
 860
 861 =head2 ModSerialStatus
 862
 863 =over 4
 864
 865 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
 866
 867 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
 868 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
 869
 870 =back
 871
 872 =cut
 873 sub ModSerialStatus {
 874     my ($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)=@_;
 875     # 1st, get previous status :
 876     my $dbh = C4::Context->dbh;
 877     my $query = qq|
 878         SELECT subscriptionid,status
 879         FROM   serial
 880         WHERE  serialid=?
 881     |;
 882     my $sth = $dbh->prepare($query);
 883     $sth->execute($serialid);
 884     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
 885     # change status & update subscriptionhistory
 886     if ($status eq 6){
 887         DelIssue($serialseq, $subscriptionid)
 888     } else {
 889         my $query = qq(
 890             UPDATE serial
 891             SET    serialseq=?,publisheddate=?,planneddate=?,status=?,notes=?
 892             WHERE  serialid = ?
 893         );
 894         $sth = $dbh->prepare($query);
 895         $sth->execute($serialseq,$publisheddate,$planneddate,$status,$notes,$serialid);
 896         my $query = qq(
 897             SELECT missinglist,recievedlist
 898             FROM   subscriptionhistory
 899             WHERE  subscriptionid=?
 900         );
 901         $sth = $dbh->prepare($query);
 902         $sth->execute($subscriptionid);
 903         my ($missinglist,$recievedlist) = $sth->fetchrow;
 904         if ($status eq 2) {
 905             $recievedlist .= ",$serialseq";
 906         }
 907         $missinglist .= ",$serialseq" if ($status eq 4) ;
 908         $missinglist .= ",not issued $serialseq" if ($status eq 5);
 909         my $query = qq(
 910             UPDATE subscriptionhistory
 911             SET    recievedlist=?, missinglist=?
 912             WHERE  subscriptionid=?
 913         );
 914         $sth=$dbh->prepare($query);
 915         $sth->execute($recievedlist,$missinglist,$subscriptionid);
 916     }
 917     # create new waited entry if needed (ie : was a "waited" and has changed)
 918     if ($oldstatus eq 1 && $status ne 1) {
 919         my $query = qq(
 920             SELECT *
 921             FROM   subscription
 922             WHERE  subscriptionid = ?
 923         );
 924         $sth = $dbh->prepare($query);
 925         $sth->execute($subscriptionid);
 926         my $val = $sth->fetchrow_hashref;
 927         # next issue number
 928         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3) = GetNextSeq($val);
 929         # next date (calculated from actual date & frequency parameters)
 930         my $nextpublisheddate = GetNextDate($publisheddate,$val);
 931         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate,0);
 932         my $query = qq|
 933             UPDATE subscription
 934             SET    lastvalue1=?, lastvalue2=?, lastvalue3=?,
 935                    innerloop1=?, innerloop2=?, innerloop3=?
 936             WHERE  subscriptionid = ?
 937         |;
 938         $sth = $dbh->prepare($query);
 939         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3,$subscriptionid);
 940     }
 941 }
 942
 943 =head2 ModSubscription
 944
 945 =over 4
 946
 947 this function modify a subscription. Put all new values on input args.
 948
 949 =back
 950
 951 =cut
 952 sub ModSubscription {
 953     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 954         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 955         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 956         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 957         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 958         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
 959     my $dbh = C4::Context->dbh;
 960     my $query = qq|
 961         UPDATE subscription
 962         SET     librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
 963                 periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
 964                 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
 965                 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
 966                 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
 967                 numberingmethod=?, status=?, biblionumber=?, notes=?, letter=?
 968         WHERE subscriptionid = ?
 969     |;
 970     my $sth=$dbh->prepare($query);
 971     $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
 972         $periodicity,$dow,$numberlength,$weeklength,$monthlength,
 973         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 974         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 975         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 976         $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
 977     $sth->finish;
 978 }
 979
 980
 981 =head2 NewSubscription
 982
 983 =over 4
 984
 985 $subscriptionid = &NewSubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
 986     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
 987     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
 988     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
 989     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
 990     $numberingmethod, $status, $notes)
 991
 992 Create a new subscription with value given on input args.
 993
 994 return :
 995 the id of this new subscription
 996
 997 =back
 998
 999 =cut
1000 sub NewSubscription {
1001     my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1002         $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1003         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1004         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1005         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1006         $numberingmethod, $status, $notes, $letter) = @_;
1007     my $dbh = C4::Context->dbh;
1008 #save subscription (insert into database)
1009     my $query = qq|
1010         INSERT INTO subscription
1011             (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1012             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1013             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1014             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1015             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1016             numberingmethod, status, notes, letter)
1017         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1018         |;
1019     my $sth=$dbh->prepare($query);
1020     $sth->execute(
1021         $auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1022         format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1023         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1024         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1025         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1026         $numberingmethod, $status, $notes, $letter);
1027
1028 #then create the 1st waited number
1029     my $subscriptionid = $dbh->{'mysql_insertid'};
1030     my $query = qq(
1031         INSERT INTO subscriptionhistory
1032             (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1033         VALUES (?,?,?,?,?,?,?,?)
1034         );
1035     $sth = $dbh->prepare($query);
1036     $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), 0, "", "", "", $notes);
1037
1038 # reread subscription to get a hash (for calculation of the 1st issue number)
1039     my $query = qq(
1040         SELECT *
1041         FROM   subscription
1042         WHERE  subscriptionid = ?
1043     );
1044     $sth = $dbh->prepare($query);
1045     $sth->execute($subscriptionid);
1046     my $val = $sth->fetchrow_hashref;
1047
1048 # calculate issue number
1049     my $serialseq = GetSeq($val);
1050     my $query = qq|
1051         INSERT INTO serial
1052             (serialseq,subscriptionid,biblionumber,status, planneddate)
1053         VALUES (?,?,?,?,?)
1054     |;
1055     $sth = $dbh->prepare($query);
1056     $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1057     return $subscriptionid;
1058 }
1059
1060
1061 =head2 ReNewSubscription
1062
1063 =over 4
1064
1065 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1066
1067 this function renew a subscription with values given on input args.
1068
1069 =back
1070
1071 =cut
1072 sub ReNewSubscription {
1073     my ($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note) = @_;
1074     my $dbh = C4::Context->dbh;
1075     my $subscription = GetSubscription($subscriptionid);
1076     my $query = qq|
1077         SELECT *
1078         FROM   biblio,biblioitems
1079         WHERE  biblio.biblionumber=biblioitems.biblionumber
1080         AND    biblio.biblionumber=?
1081     |;
1082     my $sth = $dbh->prepare($query);
1083     $sth->execute($subscription->{biblionumber});
1084     my $biblio = $sth->fetchrow_hashref;
1085     NewSuggestion($user,$subscription->{bibliotitle},$biblio->{author},$biblio->{publishercode},$biblio->{note},'','','','','',$subscription->{biblionumber});
1086     # renew subscription
1087     my $query = qq|
1088         UPDATE subscription
1089         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1090         WHERE  subscriptionid=?
1091     |;
1092     $sth=$dbh->prepare($query);
1093     $sth->execute(format_date_in_iso($startdate),$numberlength,$weeklength,$monthlength, $subscriptionid);
1094 }
1095
1096
1097 =head2 NewIssue
1098
1099 =over 4
1100
1101 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1102
1103 Create a new issue stored on the database.
1104 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1105
1106 =back
1107
1108 =cut
1109 sub NewIssue {
1110     my ($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate) = @_;
1111     my $dbh = C4::Context->dbh;
1112     my $query = qq|
1113         INSERT INTO serial
1114             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate)
1115         VALUES (?,?,?,?,?,?)
1116     |;
1117     my $sth = $dbh->prepare($query);
1118     $sth->execute($serialseq,$subscriptionid,$biblionumber,$status,$publisheddate, $planneddate);
1119     my $query = qq|
1120         SELECT missinglist,recievedlist
1121         FROM   subscriptionhistory
1122         WHERE  subscriptionid=?
1123     |;
1124     $sth = $dbh->prepare($query);
1125     $sth->execute($subscriptionid);
1126     my ($missinglist,$recievedlist) = $sth->fetchrow;
1127     if ($status eq 2) {
1128         $recievedlist .= ",$serialseq";
1129     }
1130     if ($status eq 4) {
1131         $missinglist .= ",$serialseq";
1132     }
1133     my $query = qq|
1134         UPDATE subscriptionhistory
1135         SET    recievedlist=?, missinglist=?
1136         WHERE  subscriptionid=?
1137     |;
1138     $sth=$dbh->prepare($query);
1139     $sth->execute($recievedlist,$missinglist,$subscriptionid);
1140 }
1141
1142 =head2 serialchangestatus
1143
1144 =over 4
1145
1146 serialchangestatus($serialid,$serialseq,$planneddate,$status,$notes)
1147
1148 Change the status of a serial issue.
1149 Note: this was the older subroutine
1150
1151 =back
1152
1153 =cut
1154 sub serialchangestatus {
1155     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1156     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1157     my $dbh = C4::Context->dbh;
1158     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1159     $sth->execute($serialid);
1160     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1161     # change status & update subscriptionhistory
1162     if ($status eq 6){
1163         delissue($serialseq, $subscriptionid)
1164     }else{
1165         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1166         $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1167         $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1168         $sth->execute($subscriptionid);
1169         my ($missinglist,$recievedlist) = $sth->fetchrow;
1170         if ($status eq 2) {
1171             $recievedlist .= "| $serialseq";
1172             $recievedlist =~ s/^\| //g;
1173         }
1174         $missinglist .= "| $serialseq" if ($status eq 4) ;
1175         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1176         $missinglist =~ s/^\| //g;
1177         $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1178         $sth->execute($recievedlist,$missinglist,$subscriptionid);
1179     }
1180     # create new waited entry if needed (ie : was a "waited" and has changed)
1181     if ($oldstatus eq 1 && $status ne 1) {
1182         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1183         $sth->execute($subscriptionid);
1184         my $val = $sth->fetchrow_hashref;
1185         # next issue number
1186         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1187         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1188         NewIssue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1189         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1190         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1191     }
1192     # check if an alert must be sent... (= a letter is defined & status became "arrived"
1193         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1194         $sth->execute($subscriptionid);
1195         my $subscription = $sth->fetchrow_hashref;
1196     if ($subscription->{letter} && $status eq 2) {
1197         sendalerts('issue',$subscription->{subscriptionid},$subscription->{letter});
1198     }
1199 }
1200
1201
1202 =head2 ItemizeSerials
1203
1204 =over 4
1205
1206 ItemizeSerials($serialid, $info);
1207 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1208 $serialid the serialid
1209 return :
1210 1 if the itemize is a succes.
1211 0 and @error else. @error containts the list of errors found.
1212
1213 =back
1214
1215 =cut
1216 sub ItemizeSerials {
1217     my ($serialid, $info) =@_;
1218     my $now = ParseDate("today");
1219     $now = UnixDate($now,"%Y-%m-%d");
1220
1221     my $dbh= C4::Context->dbh;
1222     my $query = qq|
1223         SELECT *
1224         FROM   serial
1225         WHERE  serialid=?
1226     |;
1227     my $sth=$dbh->prepare($query);
1228     $sth->execute($serialid);
1229     my $data=$sth->fetchrow_hashref;
1230     if(C4::Context->preference("RoutingSerials")){
1231         # check for existing biblioitem relating to serial issue
1232         my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1233         my $bibitemno = 0;
1234         for(my $i=0;$i<$count;$i++){
1235             if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1236                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1237                 last;
1238             }
1239         }
1240         if($bibitemno == 0){
1241             # warn "need to add new biblioitem so copy last one and make minor changes";
1242             my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1243             $sth->execute($data->{'biblionumber'});
1244             my $biblioitem;
1245             my $biblioitem = $sth->fetchrow_hashref;
1246             $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1247             $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1248             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1249             if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1250                 $bibitemno = newbiblioitem($biblioitem);
1251             }
1252         }
1253     }
1254
1255     my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1256     my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1257     if ($info->{barcode}){
1258         my @errors;
1259         my $exists = itemdata($info->{'barcode'});
1260         push @errors,"barcode_not_unique" if($exists);
1261         unless ($exists){
1262             my $marcrecord = MARC::Record->new();
1263             my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1264             my $newField = MARC::Field->new(
1265                 "$tag",'','',
1266                 "$subfield" => $info->{barcode}
1267             );
1268             $marcrecord->insert_fields_ordered($newField);
1269             if ($info->{branch}){
1270                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1271                 #warn "items.homebranch : $tag , $subfield";
1272                 if ($marcrecord->field($tag)) {
1273                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1274                 } else {
1275                     my $newField = MARC::Field->new(
1276                         "$tag",'','',
1277                         "$subfield" => $info->{branch}
1278                     );
1279                     $marcrecord->insert_fields_ordered($newField);
1280                 }
1281                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1282                 #warn "items.holdingbranch : $tag , $subfield";
1283                 if ($marcrecord->field($tag)) {
1284                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1285                 } else {
1286                     my $newField = MARC::Field->new(
1287                         "$tag",'','',
1288                         "$subfield" => $info->{branch}
1289                     );
1290                     $marcrecord->insert_fields_ordered($newField);
1291                 }
1292             }
1293             if ($info->{itemcallnumber}){
1294                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1295                 #warn "items.itemcallnumber : $tag , $subfield";
1296                 if ($marcrecord->field($tag)) {
1297                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1298                 } else {
1299                     my $newField = MARC::Field->new(
1300                         "$tag",'','',
1301                         "$subfield" => $info->{itemcallnumber}
1302                     );
1303                     $marcrecord->insert_fields_ordered($newField);
1304                 }
1305             }
1306             if ($info->{notes}){
1307                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1308                 # warn "items.itemnotes : $tag , $subfield";
1309                 if ($marcrecord->field($tag)) {
1310                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1311                 } else {
1312                     my $newField = MARC::Field->new(
1313                     "$tag",'','',
1314                     "$subfield" => $info->{notes}
1315                 );
1316                     $marcrecord->insert_fields_ordered($newField);
1317                 }
1318             }
1319             if ($info->{location}){
1320                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1321                 # warn "items.location : $tag , $subfield";
1322                 if ($marcrecord->field($tag)) {
1323                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1324                 } else {
1325                     my $newField = MARC::Field->new(
1326                         "$tag",'','',
1327                         "$subfield" => $info->{location}
1328                     );
1329                     $marcrecord->insert_fields_ordered($newField);
1330                 }
1331             }
1332             if ($info->{status}){
1333                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1334                 # warn "items.notforloan : $tag , $subfield";
1335                 if ($marcrecord->field($tag)) {
1336                 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1337                 } else {
1338                     my $newField = MARC::Field->new(
1339                         "$tag",'','',
1340                         "$subfield" => $info->{status}
1341                     );
1342                     $marcrecord->insert_fields_ordered($newField);
1343                 }
1344             }
1345             if(C4::Context->preference("RoutingSerials")){
1346                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1347                 if ($marcrecord->field($tag)) {
1348                     $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1349                 } else {
1350                     my $newField = MARC::Field->new(
1351                         "$tag",'','',
1352                         "$subfield" => $now
1353                     );
1354                     $marcrecord->insert_fields_ordered($newField);
1355                 }
1356             }
1357             NEWnewitem($dbh,$marcrecord,$bibid);
1358             return 1;
1359         }
1360         return (0,@errors);
1361     }
1362 }
1363
1364 =head2 HasSubscriptionExpired
1365
1366 =over 4
1367
1368 1 or 0 = HasSubscriptionExpired($subscriptionid)
1369
1370 the subscription has expired when the next issue to arrive is out of subscription limit.
1371
1372 return :
1373 1 if true, 0 if false.
1374
1375 =back
1376
1377 =cut
1378 sub HasSubscriptionExpired {
1379     my ($subscriptionid) = @_;
1380     my $dbh = C4::Context->dbh;
1381     my $subscription = GetSubscription($subscriptionid);
1382     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1383     if ($subscription->{numberlength}) {
1384         my $query = qq|
1385             SELECT count(*)
1386             FROM   serial
1387             WHERE  subscriptionid=? AND planneddate>=?
1388         |;
1389         my $sth = $dbh->prepare($query);
1390         $sth->execute($subscriptionid,$subscription->{startdate});
1391         my $res = $sth->fetchrow;
1392         if ($subscription->{numberlength}>=$res) {
1393             return 0;
1394         } else {
1395             return 1;
1396         }
1397     } else {
1398         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1399         my $query = qq|
1400             SELECT max(planneddate)
1401             FROM   serial
1402             WHERE  subscriptionid=?
1403         |;
1404         my $sth = $dbh->prepare($query);
1405         $sth->execute($subscriptionid);
1406         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1407         my $endofsubscriptiondate;
1408         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1409         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1410         return 1 if ($res >= $endofsubscriptiondate);
1411         return 0;
1412     }
1413 }
1414
1415 =head2 SetDistributedto
1416
1417 =over 4
1418
1419 SetDistributedto($distributedto,$subscriptionid);
1420 This function update the value of distributedto for a subscription given on input arg.
1421
1422 =back
1423
1424 =cut
1425 sub SetDistributedto {
1426     my ($distributedto,$subscriptionid) = @_;
1427     my $dbh = C4::Context->dbh;
1428     my $query = qq|
1429         UPDATE subscription
1430         SET    distributedto=?
1431         WHERE  subscriptionid=?
1432     |;
1433     my $sth = $dbh->prepare($query);
1434     $sth->execute($distributedto,$subscriptionid);
1435 }
1436
1437 =head2 DelSubscription
1438
1439 =over 4
1440
1441 DelSubscription($subscriptionid)
1442 this function delete the subscription which has $subscriptionid as id.
1443
1444 =back
1445
1446 =cut
1447 sub DelSubscription {
1448     my ($subscriptionid) = @_;
1449     my $dbh = C4::Context->dbh;
1450     $subscriptionid=$dbh->quote($subscriptionid);
1451     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1452     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1453     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1454 }
1455
1456 =head2 DelIssue
1457
1458 =over 4
1459
1460 DelIssue($serialseq,$subscriptionid)
1461 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1462
1463 =back
1464
1465 =cut
1466 sub DelIssue {
1467     my ($serialseq,$subscriptionid) = @_;
1468     my $dbh = C4::Context->dbh;
1469     my $query = qq|
1470         DELETE FROM serial
1471         WHERE       serialseq= ?
1472         AND         subscriptionid= ?
1473     |;
1474     my $sth = $dbh->prepare($query);
1475     $sth->execute($serialseq,$subscriptionid);
1476 }
1477
1478 =head2 GetMissingIssues
1479
1480 =over 4
1481
1482 ($count,@issuelist) = &GetMissingIssues($supplierid,$serialid)
1483
1484 this function select missing issues on database - where serial.status = 4
1485
1486 return :
1487 a count of the number of missing issues
1488 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1489 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1490
1491 =back
1492
1493 =cut
1494 sub GetMissingIssues {
1495     my ($supplierid,$serialid) = @_;
1496     my $dbh = C4::Context->dbh;
1497     my $sth;
1498     my $byserial='';
1499     if($serialid) {
1500         $byserial = "and serialid = ".$serialid;
1501     }
1502     if ($supplierid) {
1503         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1504                                   FROM subscription, serial, biblio
1505                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1506                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1507                                   serial.STATUS = 4 and
1508                                   subscription.aqbooksellerid=$supplierid and
1509                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1510                                   ");
1511     } else {
1512         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1513                                   FROM subscription, serial, biblio
1514                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1515                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1516                                   serial.STATUS =4 and
1517                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1518                                   ");
1519     }
1520     $sth->execute;
1521     my @issuelist;
1522     my $last_title;
1523     my $odd=0;
1524     my $count=0;
1525     while (my $line = $sth->fetchrow_hashref) {
1526         $odd++ unless $line->{title} eq $last_title;
1527         $last_title = $line->{title} if ($line->{title});
1528         $line->{planneddate} = format_date($line->{planneddate});
1529         $line->{claimdate} = format_date($line->{claimdate});
1530         $line->{'odd'} = 1 if $odd %2 ;
1531         $count++;
1532         push @issuelist,$line;
1533     }
1534     return $count,@issuelist;
1535 }
1536
1537 =head2 removeMissingIssue
1538
1539 =over 4
1540
1541 removeMissingIssue($subscriptionid)
1542
1543 this function removes an issue from being part of the missing string in
1544 subscriptionlist.missinglist column
1545
1546 called when a missing issue is found from the statecollection.pl file
1547
1548 =back
1549
1550 =cut
1551 sub removeMissingIssue {
1552     my ($sequence,$subscriptionid) = @_;
1553     my $dbh = C4::Context->dbh;
1554     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1555     $sth->execute($subscriptionid);
1556     my $data = $sth->fetchrow_hashref;
1557     my $missinglist = $data->{'missinglist'};
1558     my $missinglistbefore = $missinglist;
1559     # warn $missinglist." before";
1560     $missinglist =~ s/($sequence)//;
1561     # warn $missinglist." after";
1562     if($missinglist ne $missinglistbefore){
1563         $missinglist =~ s/\|\s\|/\|/g;
1564         $missinglist =~ s/^\| //g;
1565         $missinglist =~ s/\|$//g;
1566         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1567                                        SET missinglist = ?
1568                                        WHERE subscriptionid = ?");
1569         $sth2->execute($missinglist,$subscriptionid);
1570     }
1571 }
1572
1573 =head2 updateClaim
1574
1575 =over 4
1576
1577 &updateClaim($serialid)
1578
1579 this function updates the time when a claim is issued for late/missing items
1580
1581 called from claims.pl file
1582
1583 =back
1584
1585 =cut
1586 sub updateClaim {
1587     my ($serialid) = @_;
1588     my $dbh = C4::Context->dbh;
1589     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1590                                    WHERE serialid = ?
1591                                    ");
1592     $sth->execute($serialid);
1593 }
1594
1595 =head2 getsupplierbyserialid
1596
1597 =over 4
1598
1599 ($result) = &getsupplierbyserialid($serialid)
1600
1601 this function is used to find the supplier id given a serial id
1602
1603 return :
1604 hashref containing serialid, subscriptionid, and aqbooksellerid
1605
1606 =back
1607
1608 =cut
1609 sub getsupplierbyserialid {
1610     my ($serialid) = @_;
1611     my $dbh = C4::Context->dbh;
1612     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1613                                    FROM serial, subscription
1614                                    WHERE serial.subscriptionid = subscription.subscriptionid
1615                                    AND serialid = ?
1616                                    ");
1617     $sth->execute($serialid);
1618     my $line = $sth->fetchrow_hashref;
1619     my $result = $line->{'aqbooksellerid'};
1620     return $result;
1621 }
1622
1623 =head2 check_routing
1624
1625 =over 4
1626
1627 ($result) = &check_routing($subscriptionid)
1628
1629 this function checks to see if a serial has a routing list and returns the count of routingid
1630 used to show either an 'add' or 'edit' link
1631 =back
1632
1633 =cut
1634 sub check_routing {
1635     my ($subscriptionid) = @_;
1636     my $dbh = C4::Context->dbh;
1637     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1638                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1639                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1640                               ");
1641     $sth->execute($subscriptionid);
1642     my $line = $sth->fetchrow_hashref;
1643     my $result = $line->{'routingids'};
1644     return $result;
1645 }
1646
1647 =head2 addroutingmember
1648
1649 =over 4
1650
1651 &addroutingmember($bornum,$subscriptionid)
1652
1653 this function takes a borrowernumber and subscriptionid and add the member to the
1654 routing list for that serial subscription and gives them a rank on the list
1655 of either 1 or highest current rank + 1
1656
1657 =back
1658
1659 =cut
1660 sub addroutingmember {
1661     my ($bornum,$subscriptionid) = @_;
1662     my $rank;
1663     my $dbh = C4::Context->dbh;
1664     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1665     $sth->execute($subscriptionid);
1666     while(my $line = $sth->fetchrow_hashref){
1667         if($line->{'rank'}>0){
1668             $rank = $line->{'rank'}+1;
1669         } else {
1670             $rank = 1;
1671         }
1672     }
1673     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1674     $sth->execute($subscriptionid,$bornum,$rank);
1675 }
1676
1677 =head2 reorder_members
1678
1679 =over 4
1680
1681 &reorder_members($subscriptionid,$routingid,$rank)
1682
1683 this function is used to reorder the routing list
1684
1685 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1686 - it gets all members on list puts their routingid's into an array
1687 - removes the one in the array that is $routingid
1688 - then reinjects $routingid at point indicated by $rank
1689 - then update the database with the routingids in the new order
1690
1691 =back
1692
1693 =cut
1694 sub reorder_members {
1695     my ($subscriptionid,$routingid,$rank) = @_;
1696     my $dbh = C4::Context->dbh;
1697     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1698     $sth->execute($subscriptionid);
1699     my @result;
1700     while(my $line = $sth->fetchrow_hashref){
1701         push(@result,$line->{'routingid'});
1702     }
1703     # To find the matching index
1704     my $i;
1705     my $key = -1; # to allow for 0 being a valid response
1706     for ($i = 0; $i < @result; $i++) {
1707         if ($routingid == $result[$i]) {
1708             $key = $i; # save the index
1709             last;
1710         }
1711     }
1712     # if index exists in array then move it to new position
1713     if($key > -1 && $rank > 0){
1714         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1715         my $moving_item = splice(@result, $key, 1);
1716         splice(@result, $new_rank, 0, $moving_item);
1717     }
1718     for(my $j = 0; $j < @result; $j++){
1719         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1720         $sth->execute;
1721     }
1722 }
1723
1724 =head2 delroutingmember
1725
1726 =over 4
1727
1728 &delroutingmember($routingid,$subscriptionid)
1729
1730 this function either deletes one member from routing list if $routingid exists otherwise
1731 deletes all members from the routing list
1732
1733 =back
1734
1735 =cut
1736 sub delroutingmember {
1737     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1738     my ($routingid,$subscriptionid) = @_;
1739     my $dbh = C4::Context->dbh;
1740     if($routingid){
1741         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1742         $sth->execute($routingid);
1743         reorder_members($subscriptionid,$routingid);
1744     } else {
1745         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1746         $sth->execute($subscriptionid);
1747     }
1748 }
1749
1750 =head2 getroutinglist
1751
1752 =over 4
1753
1754 ($count,@routinglist) = &getroutinglist($subscriptionid)
1755
1756 this gets the info from the subscriptionroutinglist for $subscriptionid
1757
1758 return :
1759 a count of the number of members on routinglist
1760 the routinglist into a table. Each line of this table containts a ref to a hash which containts
1761 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
1762
1763 =back
1764
1765 =cut
1766 sub getroutinglist {
1767     my ($subscriptionid) = @_;
1768     my $dbh = C4::Context->dbh;
1769     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1770                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1771                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1772                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1773                               ");
1774     $sth->execute($subscriptionid);
1775     my @routinglist;
1776     my $count=0;
1777     while (my $line = $sth->fetchrow_hashref) {
1778         $count++;
1779         push(@routinglist,$line);
1780     }
1781     return ($count,@routinglist);
1782 }
1783
1784 =head2 abouttoexpire
1785
1786 =over 4
1787
1788 $result = &abouttoexpire($subscriptionid)
1789
1790 this function alerts you to the penultimate issue for a serial subscription
1791
1792 returns 1 - if this is the penultimate issue
1793 returns 0 - if not
1794
1795 =back
1796
1797 =cut
1798
1799 sub abouttoexpire {
1800     my ($subscriptionid) = @_;
1801     my $dbh = C4::Context->dbh;
1802     my $subscription = getsubscription($subscriptionid);
1803     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1804     if ($subscription->{numberlength}) {
1805         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1806         $sth->execute($subscriptionid,$subscription->{startdate});
1807         my $res = $sth->fetchrow;
1808         # warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1809         if ($subscription->{numberlength}==$res) {
1810             return 1;
1811         } else {
1812             return 0;
1813         }
1814     } else {
1815         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1816         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1817         $sth->execute($subscriptionid);
1818         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1819         my $endofsubscriptiondate;
1820         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1821         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1822         # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1823         my $per = $subscription->{'periodicity'};
1824         my $x = 0;
1825         if ($per == 1) { $x = '1 day'; }
1826         if ($per == 2) { $x = '1 week'; }
1827         if ($per == 3) { $x = '2 weeks'; }
1828         if ($per == 4) { $x = '3 weeks'; }
1829         if ($per == 5) { $x = '1 month'; }
1830         if ($per == 6) { $x = '2 months'; }
1831         if ($per == 7 || $per == 8) { $x = '3 months'; }
1832         if ($per == 9) { $x = '6 months'; }
1833         if ($per == 10) { $x = '1 year'; }
1834         if ($per == 11) { $x = '2 years'; }
1835         my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1836         # warn "DATE BEFORE END: $datebeforeend";
1837         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1838         return 0;
1839     }
1840 }
1841
1842 =head2 old_newsubscription
1843
1844 =over 4
1845
1846 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1847                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1848                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1849                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1850                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1851                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
1852
1853 this function is similar to the NewSubscription subroutine but has a few different
1854 values passed in
1855 $firstacquidate - date of first serial issue to arrive
1856 $irregularity - the issues not expected separated by a '|'
1857 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1858 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1859    alt_subscription-add.tmpl file
1860 $callnumber - display the callnumber of the serial
1861 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1862
1863 return :
1864 the $subscriptionid number of the new subscription
1865
1866 =back
1867
1868 =cut
1869 sub old_newsubscription {
1870             my ($auser,$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) = @_;
1876             my $dbh = C4::Context->dbh;
1877             #save subscription
1878             my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1879                                                                 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
1880                                                                         add1,every1,whenmorethan1,setto1,lastvalue1,
1881                                                                         add2,every2,whenmorethan2,setto2,lastvalue2,
1882                                                                         add3,every3,whenmorethan3,setto3,lastvalue3,
1883                                                                         numberingmethod, status, callnumber, notes, hemisphere) values
1884                                                           (?,?,?,?,?,?,?,?,?,?,?,
1885                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,
1886                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,?)");
1887         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1888             format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1889                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1890                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1891                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1892                                                     $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1893         #then create the 1st waited number
1894         my $subscriptionid = $dbh->{'mysql_insertid'};
1895         my $enddate = subscriptionexpirationdate($subscriptionid);
1896
1897         $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1898         $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1899         # reread subscription to get a hash (for calculation of the 1st issue number)
1900         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1901         $sth->execute($subscriptionid);
1902         my $val = $sth->fetchrow_hashref;
1903
1904         # calculate issue number
1905         my $serialseq = Get_Seq($val);
1906         $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1907         $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1908         return $subscriptionid;
1909 }
1910
1911 =head2 old_modsubscription
1912
1913 =over 4
1914
1915 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1916                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1917                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1918                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1919                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1920                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
1921
1922 this function is similar to the ModSubscription subroutine but has a few different
1923 values passed in
1924 $firstacquidate - date of first serial issue to arrive
1925 $irregularity - the issues not expected separated by a '|'
1926 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
1927 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
1928    alt_subscription-add.tmpl file
1929 $callnumber - display the callnumber of the serial
1930 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
1931
1932 =back
1933
1934 =cut
1935 sub old_modsubscription {
1936             my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1937                                                         $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1938                                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1939                                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1940                                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1941                                                         $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1942             my $dbh = C4::Context->dbh;
1943             my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1944                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1945                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1946                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1947                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1948                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1949         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1950                                                     $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1951                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1952                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1953                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1954                                                     $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1955         $sth->finish;
1956
1957
1958         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1959         $sth->execute($subscriptionid);
1960         my $val = $sth->fetchrow_hashref;
1961
1962         # calculate issue number
1963         my $serialseq = Get_Seq($val);
1964         $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1965         $sth->execute($serialseq,$subscriptionid);
1966
1967         my $enddate = subscriptionexpirationdate($subscriptionid);
1968         $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1969         $sth->execute(format_date_in_iso($enddate));
1970 }
1971
1972 =head2 old_getserials
1973
1974 =over 4
1975
1976 ($totalissues,@serials) = &old_getserials($subscriptionid)
1977
1978 this function get a hashref of serials and the total count of them
1979
1980 return :
1981 $totalissues - number of serial lines
1982 the serials into a table. Each line of this table containts a ref to a hash which it containts
1983 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
1984
1985 =back
1986
1987 =cut
1988 sub old_getserials {
1989             my ($subscriptionid) = @_;
1990             my $dbh = C4::Context->dbh;
1991             # status = 2 is "arrived"
1992             my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1993           $sth->execute($subscriptionid);
1994         my @serials;
1995         my $num = 1;
1996         while(my $line = $sth->fetchrow_hashref) {
1997                             $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1998                             $line->{"planneddate"} = format_date($line->{"planneddate"});
1999                             $line->{"num"} = $num;
2000                             $num++;
2001                             push @serials,$line;
2002                     }
2003         $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
2004         $sth->execute($subscriptionid);
2005         my ($totalissues) = $sth->fetchrow;
2006         return ($totalissues,@serials);
2007 }
2008
2009 =head2 Get_Next_Date
2010
2011 =over 4
2012
2013 ($resultdate) = &Get_Next_Date($planneddate,$subscription)
2014
2015 this function is an extension of GetNextDate which allows for checking for irregularity
2016
2017 it takes the planneddate and will return the next issue's date and will skip dates if there
2018 exists an irregularity
2019 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2020 skipped then the returned date will be 2007-05-10
2021
2022 return :
2023 $resultdate - then next date in the sequence
2024
2025 =back
2026
2027 =cut
2028 sub Get_Next_Date(@) {
2029     my ($planneddate,$subscription) = @_;
2030     my @irreg = split(/\|/,$subscription->{irregularity});
2031
2032     my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
2033     my $dayofweek = Date_DayOfWeek($month,$day,$year);
2034     my $resultdate;
2035     #       warn "DOW $dayofweek";
2036     if ($subscription->{periodicity} == 1) {
2037         for(my $i=0;$i<@irreg;$i++){
2038             if($dayofweek == 7){ $dayofweek = 0; }
2039             if(in_array(($dayofweek+1), @irreg)){
2040                 $planneddate = DateCalc($planneddate,"1 day");
2041                 $dayofweek++;
2042             }
2043         }
2044         $resultdate=DateCalc($planneddate,"1 day");
2045     }
2046     if ($subscription->{periodicity} == 2) {
2047         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2048         for(my $i = 0;$i < @irreg; $i++){
2049             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2050             if($irreg[$i] == ($wkno+1)){
2051                 $planneddate = DateCalc($planneddate,"1 week");
2052                 $wkno++;
2053             }
2054         }
2055         $resultdate=DateCalc($planneddate,"1 week");
2056     }
2057     if ($subscription->{periodicity} == 3) {
2058         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2059         for(my $i = 0;$i < @irreg; $i++){
2060             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2061             if($irreg[$i] == ($wkno+1)){
2062                 $planneddate = DateCalc($planneddate,"2 weeks");
2063                 $wkno++;
2064             }
2065         }
2066         $resultdate=DateCalc($planneddate,"2 weeks");
2067     }
2068     if ($subscription->{periodicity} == 4) {
2069         my $wkno = Date_WeekOfYear($month,$day,$year,1);
2070         for(my $i = 0;$i < @irreg; $i++){
2071             if($wkno > 52) { $wkno = 0; } # need to rollover at January
2072             if($irreg[$i] == ($wkno+1)){
2073                 $planneddate = DateCalc($planneddate,"3 weeks");
2074                 $wkno++;
2075             }
2076         }
2077         $resultdate=DateCalc($planneddate,"3 weeks");
2078     }
2079     if ($subscription->{periodicity} == 5) {
2080         for(my $i = 0;$i < @irreg; $i++){
2081             # warn $irreg[$i];
2082             # warn $month;
2083             if($month == 12) { $month = 0; } # need to rollover to check January
2084             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2085                 $planneddate = DateCalc($planneddate,"1 month");
2086                 $month++; # to check if following ones are to be skipped too
2087             }
2088         }
2089         $resultdate=DateCalc($planneddate,"1 month");
2090         # warn "Planneddate2: $planneddate";
2091     }
2092     if ($subscription->{periodicity} == 6) {
2093         for(my $i = 0;$i < @irreg; $i++){
2094             if($month == 12) { $month = 0; } # need to rollover to check January
2095             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2096                 $planneddate = DateCalc($planneddate,"2 months");
2097                 $month++; # to check if following ones are to be skipped too
2098             }
2099         }
2100         $resultdate=DateCalc($planneddate,"2 months");
2101     }
2102     if ($subscription->{periodicity} == 7) {
2103         for(my $i = 0;$i < @irreg; $i++){
2104             if($month == 12) { $month = 0; } # need to rollover to check January
2105             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2106                 $planneddate = DateCalc($planneddate,"3 months");
2107                 $month++; # to check if following ones are to be skipped too
2108             }
2109         }
2110         $resultdate=DateCalc($planneddate,"3 months");
2111     }
2112     if ($subscription->{periodicity} == 8) {
2113         for(my $i = 0;$i < @irreg; $i++){
2114             if($month == 12) { $month = 0; } # need to rollover to check January
2115             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2116                 $planneddate = DateCalc($planneddate,"3 months");
2117                 $month++; # to check if following ones are to be skipped too
2118             }
2119         }
2120         $resultdate=DateCalc($planneddate,"3 months");
2121     }
2122     if ($subscription->{periodicity} == 9) {
2123         for(my $i = 0;$i < @irreg; $i++){
2124             if($month == 12) { $month = 0; } # need to rollover to check January
2125             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
2126                 $planneddate = DateCalc($planneddate,"6 months");
2127                 $month++; # to check if following ones are to be skipped too
2128             }
2129         }
2130         $resultdate=DateCalc($planneddate,"6 months");
2131     }
2132     if ($subscription->{periodicity} == 10) {
2133         $resultdate=DateCalc($planneddate,"1 year");
2134     }
2135     if ($subscription->{periodicity} == 11) {
2136         $resultdate=DateCalc($planneddate,"2 years");
2137     }
2138     #    warn "date: ".$resultdate;
2139     return format_date_in_iso($resultdate);
2140 }
2141
2142
2143 END { }       # module clean-up code here (global destructor)
2144
2145 1;