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 sub serialchangestatus {
1142     my ($serialid,$serialseq,$planneddate,$status,$notes)=@_;
1143     # 1st, get previous status : if we change from "waited" to something else, then we will have to create a new "waited" entry
1144     my $dbh = C4::Context->dbh;
1145     my $sth = $dbh->prepare("select subscriptionid,status from serial where serialid=?");
1146     $sth->execute($serialid);
1147     my ($subscriptionid,$oldstatus) = $sth->fetchrow;
1148     # change status & update subscriptionhistory
1149     if ($status eq 6){
1150         delissue($serialseq, $subscriptionid)
1151     }else{
1152         $sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=?,notes=? where serialid = ?");
1153         $sth->execute($serialseq,$planneddate,$status,$notes,$serialid);
1154         $sth = $dbh->prepare("select missinglist,recievedlist from subscriptionhistory where subscriptionid=?");
1155         $sth->execute($subscriptionid);
1156         my ($missinglist,$recievedlist) = $sth->fetchrow;
1157         if ($status eq 2) {
1158             $recievedlist .= "| $serialseq";
1159             $recievedlist =~ s/^\| //g;
1160         }
1161         $missinglist .= "| $serialseq" if ($status eq 4) ;
1162         $missinglist .= "| not issued $serialseq" if ($status eq 5);
1163         $missinglist =~ s/^\| //g;
1164         $sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
1165         $sth->execute($recievedlist,$missinglist,$subscriptionid);
1166     }
1167     # create new waited entry if needed (ie : was a "waited" and has changed)
1168     if ($oldstatus eq 1 && $status ne 1) {
1169         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1170         $sth->execute($subscriptionid);
1171         my $val = $sth->fetchrow_hashref;
1172         # next issue number
1173         my ($newserialseq,$newlastvalue1,$newlastvalue2,$newlastvalue3) = New_Get_Next_Seq($val);
1174         my $nextplanneddate = Get_Next_Date($planneddate,$val);
1175         newissue($newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextplanneddate);
1176         $sth = $dbh->prepare("update subscription set lastvalue1=?, lastvalue2=?,lastvalue3=? where subscriptionid = ?");
1177         $sth->execute($newlastvalue1,$newlastvalue2,$newlastvalue3,$subscriptionid);
1178     }
1179 }
1180
1181
1182 =head2 ItemizeSerials
1183
1184 =over 4
1185
1186 ItemizeSerials($serialid, $info);
1187 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1188 $serialid the serialid
1189 return :
1190 1 if the itemize is a succes.
1191 0 and @error else. @error containts the list of errors found.
1192
1193 =back
1194
1195 =cut
1196 sub ItemizeSerials {
1197     my ($serialid, $info) =@_;
1198     my $now = ParseDate("today");
1199     $now = UnixDate($now,"%Y-%m-%d");
1200
1201     my $dbh= C4::Context->dbh;
1202     my $query = qq|
1203         SELECT *
1204         FROM   serial
1205         WHERE  serialid=?
1206     |;
1207     my $sth=$dbh->prepare($query);
1208     $sth->execute($serialid);
1209     my $data=$sth->fetchrow_hashref;
1210     if(C4::Context->preference("RoutingSerials")){
1211         # check for existing biblioitem relating to serial issue
1212         my($count, @results) = getbiblioitembybiblionumber($data->{'biblionumber'});
1213         my $bibitemno = 0;
1214         for(my $i=0;$i<$count;$i++){
1215             if($results[$i]->{'volumeddesc'} eq $data->{'serialseq'}.' ('.$data->{'planneddate'}.')'){
1216                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1217                 last;
1218             }
1219         }
1220         if($bibitemno == 0){
1221             # warn "need to add new biblioitem so copy last one and make minor changes";
1222             my $sth=$dbh->prepare("SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC");
1223             $sth->execute($data->{'biblionumber'});
1224             my $biblioitem;
1225             my $biblioitem = $sth->fetchrow_hashref;
1226             $biblioitem->{'volumedate'} = format_date_in_iso($data->{planneddate});
1227             $biblioitem->{'volumeddesc'} = $data->{serialseq}.' ('.format_date($data->{'planneddate'}).')';
1228             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1229             if ($info->{barcode}){ # only make biblioitem if we are going to make item also
1230                 $bibitemno = newbiblioitem($biblioitem);
1231             }
1232         }
1233     }
1234
1235     my $bibid=MARCfind_MARCbibid_from_oldbiblionumber($dbh,$data->{biblionumber});
1236     my $fwk=MARCfind_frameworkcode($dbh,$bibid);
1237     if ($info->{barcode}){
1238         my @errors;
1239         my $exists = itemdata($info->{'barcode'});
1240         push @errors,"barcode_not_unique" if($exists);
1241         unless ($exists){
1242             my $marcrecord = MARC::Record->new();
1243             my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.barcode",$fwk);
1244             my $newField = MARC::Field->new(
1245                 "$tag",'','',
1246                 "$subfield" => $info->{barcode}
1247             );
1248             $marcrecord->insert_fields_ordered($newField);
1249             if ($info->{branch}){
1250                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.homebranch",$fwk);
1251                 #warn "items.homebranch : $tag , $subfield";
1252                 if ($marcrecord->field($tag)) {
1253                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1254                 } else {
1255                     my $newField = MARC::Field->new(
1256                         "$tag",'','',
1257                         "$subfield" => $info->{branch}
1258                     );
1259                     $marcrecord->insert_fields_ordered($newField);
1260                 }
1261                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.holdingbranch",$fwk);
1262                 #warn "items.holdingbranch : $tag , $subfield";
1263                 if ($marcrecord->field($tag)) {
1264                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{branch})
1265                 } else {
1266                     my $newField = MARC::Field->new(
1267                         "$tag",'','',
1268                         "$subfield" => $info->{branch}
1269                     );
1270                     $marcrecord->insert_fields_ordered($newField);
1271                 }
1272             }
1273             if ($info->{itemcallnumber}){
1274                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemcallnumber",$fwk);
1275                 #warn "items.itemcallnumber : $tag , $subfield";
1276                 if ($marcrecord->field($tag)) {
1277                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{itemcallnumber})
1278                 } else {
1279                     my $newField = MARC::Field->new(
1280                         "$tag",'','',
1281                         "$subfield" => $info->{itemcallnumber}
1282                     );
1283                     $marcrecord->insert_fields_ordered($newField);
1284                 }
1285             }
1286             if ($info->{notes}){
1287                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$fwk);
1288                 # warn "items.itemnotes : $tag , $subfield";
1289                 if ($marcrecord->field($tag)) {
1290                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{notes})
1291                 } else {
1292                     my $newField = MARC::Field->new(
1293                     "$tag",'','',
1294                     "$subfield" => $info->{notes}
1295                 );
1296                     $marcrecord->insert_fields_ordered($newField);
1297                 }
1298             }
1299             if ($info->{location}){
1300                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
1301                 # warn "items.location : $tag , $subfield";
1302                 if ($marcrecord->field($tag)) {
1303                     $marcrecord->field($tag)->add_subfields("$subfield" => $info->{location})
1304                 } else {
1305                     my $newField = MARC::Field->new(
1306                         "$tag",'','',
1307                         "$subfield" => $info->{location}
1308                     );
1309                     $marcrecord->insert_fields_ordered($newField);
1310                 }
1311             }
1312             if ($info->{status}){
1313                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
1314                 # warn "items.notforloan : $tag , $subfield";
1315                 if ($marcrecord->field($tag)) {
1316                 $marcrecord->field($tag)->add_subfields("$subfield" => $info->{status})
1317                 } else {
1318                     my $newField = MARC::Field->new(
1319                         "$tag",'','',
1320                         "$subfield" => $info->{status}
1321                     );
1322                     $marcrecord->insert_fields_ordered($newField);
1323                 }
1324             }
1325             if(C4::Context->preference("RoutingSerials")){
1326                 my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.dateaccessioned",$fwk);
1327                 if ($marcrecord->field($tag)) {
1328                     $marcrecord->field($tag)->add_subfields("$subfield" => $now)
1329                 } else {
1330                     my $newField = MARC::Field->new(
1331                         "$tag",'','',
1332                         "$subfield" => $now
1333                     );
1334                     $marcrecord->insert_fields_ordered($newField);
1335                 }
1336             }
1337             NEWnewitem($dbh,$marcrecord,$bibid);
1338             return 1;
1339         }
1340         return (0,@errors);
1341     }
1342 }
1343
1344 =head2 HasSubscriptionExpired
1345
1346 =over 4
1347
1348 1 or 0 = HasSubscriptionExpired($subscriptionid)
1349
1350 the subscription has expired when the next issue to arrive is out of subscription limit.
1351
1352 return :
1353 1 if true, 0 if false.
1354
1355 =back
1356
1357 =cut
1358 sub HasSubscriptionExpired {
1359     my ($subscriptionid) = @_;
1360     my $dbh = C4::Context->dbh;
1361     my $subscription = GetSubscription($subscriptionid);
1362     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1363     if ($subscription->{numberlength}) {
1364         my $query = qq|
1365             SELECT count(*)
1366             FROM   serial
1367             WHERE  subscriptionid=? AND planneddate>=?
1368         |;
1369         my $sth = $dbh->prepare($query);
1370         $sth->execute($subscriptionid,$subscription->{startdate});
1371         my $res = $sth->fetchrow;
1372         if ($subscription->{numberlength}>=$res) {
1373             return 0;
1374         } else {
1375             return 1;
1376         }
1377     } else {
1378         #a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1379         my $query = qq|
1380             SELECT max(planneddate)
1381             FROM   serial
1382             WHERE  subscriptionid=?
1383         |;
1384         my $sth = $dbh->prepare($query);
1385         $sth->execute($subscriptionid);
1386         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1387         my $endofsubscriptiondate;
1388         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1389         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1390         return 1 if ($res >= $endofsubscriptiondate);
1391         return 0;
1392     }
1393 }
1394
1395 =head2 SetDistributedto
1396
1397 =over 4
1398
1399 SetDistributedto($distributedto,$subscriptionid);
1400 This function update the value of distributedto for a subscription given on input arg.
1401
1402 =back
1403
1404 =cut
1405 sub SetDistributedto {
1406     my ($distributedto,$subscriptionid) = @_;
1407     my $dbh = C4::Context->dbh;
1408     my $query = qq|
1409         UPDATE subscription
1410         SET    distributedto=?
1411         WHERE  subscriptionid=?
1412     |;
1413     my $sth = $dbh->prepare($query);
1414     $sth->execute($distributedto,$subscriptionid);
1415 }
1416
1417 =head2 DelSubscription
1418
1419 =over 4
1420
1421 DelSubscription($subscriptionid)
1422 this function delete the subscription which has $subscriptionid as id.
1423
1424 =back
1425
1426 =cut
1427 sub DelSubscription {
1428     my ($subscriptionid) = @_;
1429     my $dbh = C4::Context->dbh;
1430     $subscriptionid=$dbh->quote($subscriptionid);
1431     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1432     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1433     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1434 }
1435
1436 =head2 DelIssue
1437
1438 =over 4
1439
1440 DelIssue($serialseq,$subscriptionid)
1441 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1442
1443 =back
1444
1445 =cut
1446 sub DelIssue {
1447     my ($serialseq,$subscriptionid) = @_;
1448     my $dbh = C4::Context->dbh;
1449     my $query = qq|
1450         DELETE FROM serial
1451         WHERE       serialseq= ?
1452         AND         subscriptionid= ?
1453     |;
1454     my $sth = $dbh->prepare($query);
1455     $sth->execute($serialseq,$subscriptionid);
1456 }
1457
1458 sub GetMissingIssues {
1459     my ($supplierid,$serialid) = @_;
1460     my $dbh = C4::Context->dbh;
1461     my $sth;
1462     my $byserial='';
1463     if($serialid) {
1464         $byserial = "and serialid = ".$serialid;
1465     }
1466     if ($supplierid) {
1467         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1468                                   FROM subscription, serial, biblio
1469                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1470                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1471                                   serial.STATUS = 4 and
1472                                   subscription.aqbooksellerid=$supplierid and
1473                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1474                                   ");
1475     } else {
1476         $sth = $dbh->prepare("SELECT serialid,aqbooksellerid,name,title,planneddate,serialseq,serial.subscriptionid,claimdate
1477                                   FROM subscription, serial, biblio
1478                                   LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1479                                   WHERE subscription.subscriptionid = serial.subscriptionid AND
1480                                   serial.STATUS =4 and
1481                                   biblio.biblionumber = subscription.biblionumber ".$byserial." order by title
1482                                   ");
1483     }
1484     $sth->execute;
1485     my @issuelist;
1486     my $last_title;
1487     my $odd=0;
1488     my $count=0;
1489     while (my $line = $sth->fetchrow_hashref) {
1490         $odd++ unless $line->{title} eq $last_title;
1491         $last_title = $line->{title} if ($line->{title});
1492         $line->{planneddate} = format_date($line->{planneddate});
1493         $line->{claimdate} = format_date($line->{claimdate});
1494         $line->{'odd'} = 1 if $odd %2 ;
1495         $count++;
1496         push @issuelist,$line;
1497     }
1498     return $count,@issuelist;
1499 }
1500
1501 sub removeMissingIssue {
1502     my ($sequence,$subscriptionid) = @_;
1503     my $dbh = C4::Context->dbh;
1504     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1505     $sth->execute($subscriptionid);
1506     my $data = $sth->fetchrow_hashref;
1507     my $missinglist = $data->{'missinglist'};
1508     my $missinglistbefore = $missinglist;
1509     # warn $missinglist." before";
1510     $missinglist =~ s/($sequence)//;
1511     # warn $missinglist." after";
1512     if($missinglist ne $missinglistbefore){
1513         $missinglist =~ s/\|\s\|/\|/g;
1514         $missinglist =~ s/^\| //g;
1515         $missinglist =~ s/\|$//g;
1516         my $sth2= $dbh->prepare("UPDATE subscriptionhistory
1517                                        SET missinglist = ?
1518                                        WHERE subscriptionid = ?");
1519         $sth2->execute($missinglist,$subscriptionid);
1520     }
1521 }
1522
1523 sub updateClaim {
1524     my ($serialid) = @_;
1525     my $dbh = C4::Context->dbh;
1526     my $sth = $dbh->prepare("UPDATE serial SET claimdate = now()
1527                                    WHERE serialid = ?
1528                                    ");
1529     $sth->execute($serialid);
1530 }
1531
1532 sub getsupplierbyserialid {
1533     my ($serialid) = @_;
1534     my $dbh = C4::Context->dbh;
1535     my $sth = $dbh->prepare("SELECT serialid, serial.subscriptionid, aqbooksellerid
1536                                    FROM serial, subscription
1537                                    WHERE serial.subscriptionid = subscription.subscriptionid
1538                                    AND serialid = ?
1539                                    ");
1540     $sth->execute($serialid);
1541     my $line = $sth->fetchrow_hashref;
1542     my $result = $line->{'aqbooksellerid'};
1543     return $result;
1544 }
1545
1546 sub check_routing {
1547     my ($subscriptionid) = @_;
1548     my $dbh = C4::Context->dbh;
1549     my $sth = $dbh->prepare("SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
1550                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1551                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1552                               ");
1553     $sth->execute($subscriptionid);
1554     my $line = $sth->fetchrow_hashref;
1555     my $result = $line->{'routingids'};
1556     return $result;
1557 }
1558
1559 sub addroutingmember {
1560     my ($bornum,$subscriptionid) = @_;
1561     my $rank;
1562     my $dbh = C4::Context->dbh;
1563     my $sth = $dbh->prepare("SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?");
1564     $sth->execute($subscriptionid);
1565     while(my $line = $sth->fetchrow_hashref){
1566         if($line->{'rank'}>0){
1567             $rank = $line->{'rank'}+1;
1568         } else {
1569             $rank = 1;
1570         }
1571     }
1572     $sth = $dbh->prepare("INSERT INTO subscriptionroutinglist VALUES (null,?,?,?,null)");
1573     $sth->execute($subscriptionid,$bornum,$rank);
1574 }
1575
1576 sub reorder_members {
1577     my ($subscriptionid,$routingid,$rank) = @_;
1578     my $dbh = C4::Context->dbh;
1579     my $sth = $dbh->prepare("SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC");
1580     $sth->execute($subscriptionid);
1581     my @result;
1582     while(my $line = $sth->fetchrow_hashref){
1583         push(@result,$line->{'routingid'});
1584     }
1585     # To find the matching index
1586     my $i;
1587     my $key = -1; # to allow for 0 being a valid response
1588     for ($i = 0; $i < @result; $i++) {
1589         if ($routingid == $result[$i]) {
1590             $key = $i; # save the index
1591             last;
1592         }
1593     }
1594     # if index exists in array then move it to new position
1595     if($key > -1 && $rank > 0){
1596         my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
1597         my $moving_item = splice(@result, $key, 1);
1598         splice(@result, $new_rank, 0, $moving_item);
1599     }
1600     for(my $j = 0; $j < @result; $j++){
1601         my $sth = $dbh->prepare("UPDATE subscriptionroutinglist SET ranking = '" . ($j+1) . "' WHERE routingid = '". $result[$j]."'");
1602         $sth->execute;
1603     }
1604 }
1605
1606 sub delroutingmember {
1607     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1608     my ($routingid,$subscriptionid) = @_;
1609     my $dbh = C4::Context->dbh;
1610     if($routingid){
1611         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1612         $sth->execute($routingid);
1613         reorder_members($subscriptionid,$routingid);
1614     } else {
1615         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1616         $sth->execute($subscriptionid);
1617     }
1618 }
1619
1620 sub getroutinglist {
1621     my ($subscriptionid) = @_;
1622     my $dbh = C4::Context->dbh;
1623     my $sth = $dbh->prepare("SELECT routingid, borrowernumber,
1624                               ranking, biblionumber FROM subscriptionroutinglist, subscription
1625                               WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1626                               AND subscription.subscriptionid = ? ORDER BY ranking ASC
1627                               ");
1628     $sth->execute($subscriptionid);
1629     my @routinglist;
1630     my $count=0;
1631     while (my $line = $sth->fetchrow_hashref) {
1632         $count++;
1633         push(@routinglist,$line);
1634     }
1635     return ($count,@routinglist);
1636 }
1637
1638 # is the subscription about to expire? - check if penultimate issue.
1639 sub abouttoexpire {
1640     my ($subscriptionid) = @_;
1641     my $dbh = C4::Context->dbh;
1642     my $subscription = getsubscription($subscriptionid);
1643     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1644     if ($subscription->{numberlength}) {
1645         my $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?  and planneddate>=?");
1646         $sth->execute($subscriptionid,$subscription->{startdate});
1647         my $res = $sth->fetchrow;
1648         warn "length: ".$subscription->{numberlength}." vs count: ".$res;
1649         if ($subscription->{numberlength}==$res) {
1650             return 1;
1651         } else {
1652             return 0;
1653         }
1654     } else {
1655         # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration
1656         my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
1657         $sth->execute($subscriptionid);
1658         my $res = ParseDate(format_date_in_iso($sth->fetchrow));
1659         my $endofsubscriptiondate;
1660         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength});
1661         $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength});
1662         warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res;
1663         my $per = $subscription->{'periodicity'};
1664         my $x = 0;
1665         if ($per == 1) { $x = '1 day'; }
1666         if ($per == 2) { $x = '1 week'; }
1667         if ($per == 3) { $x = '2 weeks'; }
1668         if ($per == 4) { $x = '3 weeks'; }
1669         if ($per == 5) { $x = '1 month'; }
1670         if ($per == 6) { $x = '2 months'; }
1671         if ($per == 7 || $per == 8) { $x = '3 months'; }
1672         if ($per == 9) { $x = '6 months'; }
1673         if ($per == 10) { $x = '1 year'; }
1674         if ($per == 11) { $x = '2 years'; }
1675         my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength});
1676         warn "DATE BEFORE END: $datebeforeend";
1677         return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate);
1678         return 0;
1679     }
1680 }
1681
1682 sub old_newsubscription {
1683             my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1684                                 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1685                                 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1686                                 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1687                                 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1688                                 $numberingmethod, $status, $callnumber, $notes, $hemisphere) = @_;
1689             my $dbh = C4::Context->dbh;
1690             #save subscription
1691             my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
1692                                                                 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
1693                                                                         add1,every1,whenmorethan1,setto1,lastvalue1,
1694                                                                         add2,every2,whenmorethan2,setto2,lastvalue2,
1695                                                                         add3,every3,whenmorethan3,setto3,lastvalue3,
1696                                                                         numberingmethod, status, callnumber, notes, hemisphere) values
1697                                                           (?,?,?,?,?,?,?,?,?,?,?,
1698                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,
1699                                                                                                                        ?,?,?,?,?,?,?,?,?,?,?,?)");
1700         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1701             format_date_in_iso($startdate),$periodicity,format_date_in_iso($firstacquidate),$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1702                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
1703                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
1704                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
1705                                                     $numberingmethod, $status,$callnumber, $notes, $hemisphere);
1706         #then create the 1st waited number
1707         my $subscriptionid = $dbh->{'mysql_insertid'};
1708         my $enddate = subscriptionexpirationdate($subscriptionid);
1709
1710         $sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
1711         $sth->execute($biblionumber, $subscriptionid, format_date_in_iso($startdate), format_date_in_iso($enddate), "", "", "", $notes);
1712         # reread subscription to get a hash (for calculation of the 1st issue number)
1713         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1714         $sth->execute($subscriptionid);
1715         my $val = $sth->fetchrow_hashref;
1716
1717         # calculate issue number
1718         my $serialseq = Get_Seq($val);
1719         $sth = $dbh->prepare("insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)");
1720         $sth->execute($serialseq, $subscriptionid, $val->{'biblionumber'}, 1, format_date_in_iso($startdate));
1721         return $subscriptionid;
1722 }
1723
1724 sub old_modsubscription {
1725             my ($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1726                                                         $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1727                                                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1728                                                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1729                                                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1730                                                         $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid)= @_;
1731             my $dbh = C4::Context->dbh;
1732             my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1733                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
1734                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1735                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1736                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1737                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?");
1738         $sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
1739                                                     $periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
1740                                                     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1741                                                     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1742                                                     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1743                                                     $numberingmethod, $status, $biblionumber, $callnumber, $notes, $hemisphere, $subscriptionid);
1744         $sth->finish;
1745
1746
1747         $sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
1748         $sth->execute($subscriptionid);
1749         my $val = $sth->fetchrow_hashref;
1750
1751         # calculate issue number
1752         my $serialseq = Get_Seq($val);
1753         $sth = $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
1754         $sth->execute($serialseq,$subscriptionid);
1755
1756         my $enddate = subscriptionexpirationdate($subscriptionid);
1757         $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
1758         $sth->execute(format_date_in_iso($enddate));
1759 }
1760
1761 sub old_getserials {
1762             my ($subscriptionid) = @_;
1763             my $dbh = C4::Context->dbh;
1764             # status = 2 is "arrived"
1765             my $sth=$dbh->prepare("select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5");
1766           $sth->execute($subscriptionid);
1767         my @serials;
1768         my $num = 1;
1769         while(my $line = $sth->fetchrow_hashref) {
1770                             $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
1771                             $line->{"planneddate"} = format_date($line->{"planneddate"});
1772                             $line->{"num"} = $num;
1773                             $num++;
1774                             push @serials,$line;
1775                     }
1776         $sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
1777         $sth->execute($subscriptionid);
1778         my ($totalissues) = $sth->fetchrow;
1779         return ($totalissues,@serials);
1780 }
1781
1782 sub Get_Next_Date(@) {
1783     my ($planneddate,$subscription) = @_;
1784     my @irreg = split(/\|/,$subscription->{irregularity});
1785
1786     my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d");
1787     my $dayofweek = Date_DayOfWeek($month,$day,$year);
1788     my $resultdate;
1789     #       warn "DOW $dayofweek";
1790     if ($subscription->{periodicity} == 1) {
1791         for(my $i=0;$i<@irreg;$i++){
1792             if($dayofweek == 7){ $dayofweek = 0; }
1793             if(in_array(($dayofweek+1), @irreg)){
1794                 $planneddate = DateCalc($planneddate,"1 day");
1795                 $dayofweek++;
1796             }
1797         }
1798         $resultdate=DateCalc($planneddate,"1 day");
1799     }
1800     if ($subscription->{periodicity} == 2) {
1801         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1802         for(my $i = 0;$i < @irreg; $i++){
1803             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1804             if($irreg[$i] == ($wkno+1)){
1805                 $planneddate = DateCalc($planneddate,"1 week");
1806                 $wkno++;
1807             }
1808         }
1809         $resultdate=DateCalc($planneddate,"1 week");
1810     }
1811     if ($subscription->{periodicity} == 3) {
1812         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1813         for(my $i = 0;$i < @irreg; $i++){
1814             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1815             if($irreg[$i] == ($wkno+1)){
1816                 $planneddate = DateCalc($planneddate,"2 weeks");
1817                 $wkno++;
1818             }
1819         }
1820         $resultdate=DateCalc($planneddate,"2 weeks");
1821     }
1822     if ($subscription->{periodicity} == 4) {
1823         my $wkno = Date_WeekOfYear($month,$day,$year,1);
1824         for(my $i = 0;$i < @irreg; $i++){
1825             if($wkno > 52) { $wkno = 0; } # need to rollover at January
1826             if($irreg[$i] == ($wkno+1)){
1827                 $planneddate = DateCalc($planneddate,"3 weeks");
1828                 $wkno++;
1829             }
1830         }
1831         $resultdate=DateCalc($planneddate,"3 weeks");
1832     }
1833     if ($subscription->{periodicity} == 5) {
1834         for(my $i = 0;$i < @irreg; $i++){
1835             # warn $irreg[$i];
1836             # warn $month;
1837             if($month == 12) { $month = 0; } # need to rollover to check January
1838             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1839                 $planneddate = DateCalc($planneddate,"1 month");
1840                 $month++; # to check if following ones are to be skipped too
1841             }
1842         }
1843         $resultdate=DateCalc($planneddate,"1 month");
1844         # warn "Planneddate2: $planneddate";
1845     }
1846     if ($subscription->{periodicity} == 6) {
1847         for(my $i = 0;$i < @irreg; $i++){
1848             if($month == 12) { $month = 0; } # need to rollover to check January
1849             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1850                 $planneddate = DateCalc($planneddate,"2 months");
1851                 $month++; # to check if following ones are to be skipped too
1852             }
1853         }
1854         $resultdate=DateCalc($planneddate,"2 months");
1855     }
1856     if ($subscription->{periodicity} == 7) {
1857         for(my $i = 0;$i < @irreg; $i++){
1858             if($month == 12) { $month = 0; } # need to rollover to check January
1859             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1860                 $planneddate = DateCalc($planneddate,"3 months");
1861                 $month++; # to check if following ones are to be skipped too
1862             }
1863         }
1864         $resultdate=DateCalc($planneddate,"3 months");
1865     }
1866     if ($subscription->{periodicity} == 8) {
1867         for(my $i = 0;$i < @irreg; $i++){
1868             if($month == 12) { $month = 0; } # need to rollover to check January
1869             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1870                 $planneddate = DateCalc($planneddate,"3 months");
1871                 $month++; # to check if following ones are to be skipped too
1872             }
1873         }
1874         $resultdate=DateCalc($planneddate,"3 months");
1875     }
1876     if ($subscription->{periodicity} == 9) {
1877         for(my $i = 0;$i < @irreg; $i++){
1878             if($month == 12) { $month = 0; } # need to rollover to check January
1879             if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped
1880                 $planneddate = DateCalc($planneddate,"6 months");
1881                 $month++; # to check if following ones are to be skipped too
1882             }
1883         }
1884         $resultdate=DateCalc($planneddate,"6 months");
1885     }
1886     if ($subscription->{periodicity} == 10) {
1887         $resultdate=DateCalc($planneddate,"1 year");
1888     }
1889     if ($subscription->{periodicity} == 11) {
1890         $resultdate=DateCalc($planneddate,"2 years");
1891     }
1892     #    warn "date: ".$resultdate;
1893     return format_date_in_iso($resultdate);
1894 }
1895
1896
1897 END { }       # module clean-up code here (global destructor)
1898
1899 1;