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
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use C4::Dates qw(format_date);
  22 use Date::Calc qw(:all);
  23 use POSIX qw(strftime);
  24 use C4::Suggestions;
  25 use C4::Koha;
  26 use C4::Biblio;
  27 use C4::Branch;
  28 use C4::Items;
  29 use C4::Search;
  30 use C4::Letters;
  31 use C4::Log;    # logaction
  32 use C4::Debug;
  33
  34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  35
  36 BEGIN {
  37     $VERSION = 3.01;    # set version for version checking
  38     require Exporter;
  39     @ISA    = qw(Exporter);
  40     @EXPORT = qw(
  41       &NewSubscription    &ModSubscription    &DelSubscription    &GetSubscriptions
  42       &GetSubscription    &CountSubscriptionFromBiblionumber      &GetSubscriptionsFromBiblionumber
  43       &GetFullSubscriptionsFromBiblionumber   &GetFullSubscription &ModSubscriptionHistory
  44       &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
  45
  46       &GetNextSeq         &NewIssue           &ItemizeSerials    &GetSerials
  47       &GetLatestSerials   &ModSerialStatus    &GetNextDate       &GetSerials2
  48       &ReNewSubscription  &GetLateIssues      &GetLateOrMissingIssues
  49       &GetSerialInformation                   &AddItem2Serial
  50       &PrepareSerialsData &GetNextExpected    &ModNextExpected
  51
  52       &UpdateClaimdateIssues
  53       &GetSuppliersWithLateIssues             &getsupplierbyserialid
  54       &GetDistributedTo   &SetDistributedTo
  55       &getroutinglist     &delroutingmember   &addroutingmember
  56       &reorder_members
  57       &check_routing &updateClaim &removeMissingIssue
  58       &CountIssues
  59       HasItems
  60
  61     );
  62 }
  63
  64 =head2 GetSuppliersWithLateIssues
  65
  66 =head1 NAME
  67
  68 C4::Serials - Give functions for serializing.
  69
  70 =head1 SYNOPSIS
  71
  72   use C4::Serials;
  73
  74 =head1 DESCRIPTION
  75
  76 Give all XYZ functions
  77
  78 =head1 FUNCTIONS
  79
  80 =over 4
  81
  82 %supplierlist = &GetSuppliersWithLateIssues
  83
  84 this function get all suppliers with late issues.
  85
  86 return :
  87 an array_ref of suppliers each entry is a hash_ref containing id and name
  88 the array is in name order
  89
  90 =back
  91
  92 =cut
  93
  94 sub GetSuppliersWithLateIssues {
  95     my $dbh   = C4::Context->dbh;
  96     my $query = qq|
  97         SELECT DISTINCT id, name
  98         FROM            subscription
  99         LEFT JOIN       serial ON serial.subscriptionid=subscription.subscriptionid
 100         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 101         WHERE           subscription.subscriptionid = serial.subscriptionid
 102         AND             (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
 103         ORDER BY name
 104     |;
 105     return $dbh->selectall_arrayref($query, { Slice => {} });
 106 }
 107
 108 =head2 GetLateIssues
 109
 110 =over 4
 111
 112 @issuelist = &GetLateIssues($supplierid)
 113
 114 this function select late issues on database
 115
 116 return :
 117 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
 118 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
 119
 120 =back
 121
 122 =cut
 123
 124 sub GetLateIssues {
 125     my ($supplierid) = @_;
 126     my $dbh = C4::Context->dbh;
 127     my $sth;
 128     if ($supplierid) {
 129         my $query = qq|
 130             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 131             FROM       subscription
 132             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 133             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 134             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 135             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 136             AND        subscription.aqbooksellerid=$supplierid
 137             ORDER BY   title
 138         |;
 139         $sth = $dbh->prepare($query);
 140     } else {
 141         my $query = qq|
 142             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 143             FROM       subscription
 144             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 145             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 146             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 147             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 148             ORDER BY   title
 149         |;
 150         $sth = $dbh->prepare($query);
 151     }
 152     $sth->execute;
 153     my @issuelist;
 154     my $last_title;
 155     my $odd   = 0;
 156     while ( my $line = $sth->fetchrow_hashref ) {
 157         $odd++ unless $line->{title} eq $last_title;
 158         $line->{title} = "" if $line->{title} eq $last_title;
 159         $last_title = $line->{title} if ( $line->{title} );
 160         $line->{planneddate} = format_date( $line->{planneddate} );
 161         push @issuelist, $line;
 162     }
 163     return @issuelist;
 164 }
 165
 166 =head2 GetSubscriptionHistoryFromSubscriptionId
 167
 168 =over 4
 169
 170 $sth = GetSubscriptionHistoryFromSubscriptionId()
 171 this function just prepare the SQL request.
 172 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
 173 return :
 174 $sth = $dbh->prepare($query).
 175
 176 =back
 177
 178 =cut
 179
 180 sub GetSubscriptionHistoryFromSubscriptionId() {
 181     my $dbh   = C4::Context->dbh;
 182     my $query = qq|
 183         SELECT *
 184         FROM   subscriptionhistory
 185         WHERE  subscriptionid = ?
 186     |;
 187     return $dbh->prepare($query);
 188 }
 189
 190 =head2 GetSerialStatusFromSerialId
 191
 192 =over 4
 193
 194 $sth = GetSerialStatusFromSerialId();
 195 this function just prepare the SQL request.
 196 After this function, don't forget to execute it by using $sth->execute($serialid)
 197 return :
 198 $sth = $dbh->prepare($query).
 199
 200 =back
 201
 202 =cut
 203
 204 sub GetSerialStatusFromSerialId() {
 205     my $dbh   = C4::Context->dbh;
 206     my $query = qq|
 207         SELECT status
 208         FROM   serial
 209         WHERE  serialid = ?
 210     |;
 211     return $dbh->prepare($query);
 212 }
 213
 214 =head2 GetSerialInformation
 215
 216 =over 4
 217
 218 $data = GetSerialInformation($serialid);
 219 returns a hash containing :
 220   items : items marcrecord (can be an array)
 221   serial table field
 222   subscription table field
 223   + information about subscription expiration
 224
 225 =back
 226
 227 =cut
 228
 229 sub GetSerialInformation {
 230     my ($serialid) = @_;
 231     my $dbh        = C4::Context->dbh;
 232     my $query      = qq|
 233         SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
 234     if (   C4::Context->preference('IndependantBranches')
 235         && C4::Context->userenv
 236         && C4::Context->userenv->{'flags'} != 1
 237         && C4::Context->userenv->{'branch'} ) {
 238         $query .= "
 239       , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 240     }
 241     $query .= qq|
 242         FROM   serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
 243         WHERE  serialid = ?
 244     |;
 245     my $rq = $dbh->prepare($query);
 246     $rq->execute($serialid);
 247     my $data = $rq->fetchrow_hashref;
 248
 249     # create item information if we have serialsadditems for this subscription
 250     if ( $data->{'serialsadditems'} ) {
 251         my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
 252         $queryitem->execute($serialid);
 253         my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
 254         if ( scalar(@$itemnumbers) > 0 ) {
 255             foreach my $itemnum (@$itemnumbers) {
 256
 257                 #It is ASSUMED that GetMarcItem ALWAYS WORK...
 258                 #Maybe GetMarcItem should return values on failure
 259                 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
 260                 my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
 261                 $itemprocessed->{'itemnumber'}   = $itemnum->[0];
 262                 $itemprocessed->{'itemid'}       = $itemnum->[0];
 263                 $itemprocessed->{'serialid'}     = $serialid;
 264                 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 265                 push @{ $data->{'items'} }, $itemprocessed;
 266             }
 267         } else {
 268             my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
 269             $itemprocessed->{'itemid'}       = "N$serialid";
 270             $itemprocessed->{'serialid'}     = $serialid;
 271             $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 272             $itemprocessed->{'countitems'}   = 0;
 273             push @{ $data->{'items'} }, $itemprocessed;
 274         }
 275     }
 276     $data->{ "status" . $data->{'serstatus'} } = 1;
 277     $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
 278     $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
 279     return $data;
 280 }
 281
 282 =head2 AddItem2Serial
 283
 284 =over 4
 285
 286 $data = AddItem2Serial($serialid,$itemnumber);
 287 Adds an itemnumber to Serial record
 288
 289 =back
 290
 291 =cut
 292
 293 sub AddItem2Serial {
 294     my ( $serialid, $itemnumber ) = @_;
 295     my $dbh = C4::Context->dbh;
 296     my $rq  = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
 297     $rq->execute( $serialid, $itemnumber );
 298     return $rq->rows;
 299 }
 300
 301 =head2 UpdateClaimdateIssues
 302
 303 =over 4
 304
 305 UpdateClaimdateIssues($serialids,[$date]);
 306
 307 Update Claimdate for issues in @$serialids list with date $date
 308 (Take Today if none)
 309
 310 =back
 311
 312 =cut
 313
 314 sub UpdateClaimdateIssues {
 315     my ( $serialids, $date ) = @_;
 316     my $dbh = C4::Context->dbh;
 317     $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
 318     my $query = "
 319         UPDATE serial SET claimdate=$date,status=7
 320         WHERE  serialid in (" . join( ",", @$serialids ) . ")";
 321     my $rq = $dbh->prepare($query);
 322     $rq->execute;
 323     return $rq->rows;
 324 }
 325
 326 =head2 GetSubscription
 327
 328 =over 4
 329
 330 $subs = GetSubscription($subscriptionid)
 331 this function get the subscription which has $subscriptionid as id.
 332 return :
 333 a hashref. This hash containts
 334 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 335
 336 =back
 337
 338 =cut
 339
 340 sub GetSubscription {
 341     my ($subscriptionid) = @_;
 342     my $dbh              = C4::Context->dbh;
 343     my $query            = qq(
 344         SELECT  subscription.*,
 345                 subscriptionhistory.*,
 346                 aqbooksellers.name AS aqbooksellername,
 347                 biblio.title AS bibliotitle,
 348                 subscription.biblionumber as bibnum);
 349     if (   C4::Context->preference('IndependantBranches')
 350         && C4::Context->userenv
 351         && C4::Context->userenv->{'flags'} != 1
 352         && C4::Context->userenv->{'branch'} ) {
 353         $query .= "
 354       , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 355     }
 356     $query .= qq(
 357        FROM subscription
 358        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 359        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 360        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 361        WHERE subscription.subscriptionid = ?
 362     );
 363
 364     #     if (C4::Context->preference('IndependantBranches') &&
 365     #         C4::Context->userenv &&
 366     #         C4::Context->userenv->{'flags'} != 1){
 367     # #       $debug and warn "flags: ".C4::Context->userenv->{'flags'};
 368     #       $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
 369     #     }
 370     $debug and warn "query : $query\nsubsid :$subscriptionid";
 371     my $sth = $dbh->prepare($query);
 372     $sth->execute($subscriptionid);
 373     return $sth->fetchrow_hashref;
 374 }
 375
 376 =head2 GetFullSubscription
 377
 378 =over 4
 379
 380    \@res = GetFullSubscription($subscriptionid)
 381    this function read on serial table.
 382
 383 =back
 384
 385 =cut
 386
 387 sub GetFullSubscription {
 388     my ($subscriptionid) = @_;
 389     my $dbh              = C4::Context->dbh;
 390     my $query            = qq|
 391   SELECT    serial.serialid,
 392             serial.serialseq,
 393             serial.planneddate,
 394             serial.publisheddate,
 395             serial.status,
 396             serial.notes as notes,
 397             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 398             aqbooksellers.name as aqbooksellername,
 399             biblio.title as bibliotitle,
 400             subscription.branchcode AS branchcode,
 401             subscription.subscriptionid AS subscriptionid |;
 402     if (   C4::Context->preference('IndependantBranches')
 403         && C4::Context->userenv
 404         && C4::Context->userenv->{'flags'} != 1
 405         && C4::Context->userenv->{'branch'} ) {
 406         $query .= "
 407       , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 408     }
 409     $query .= qq|
 410   FROM      serial
 411   LEFT JOIN subscription ON
 412           (serial.subscriptionid=subscription.subscriptionid )
 413   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 414   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 415   WHERE     serial.subscriptionid = ?
 416   ORDER BY year DESC,
 417           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 418           serial.subscriptionid
 419           |;
 420     $debug and warn "GetFullSubscription query: $query";
 421     my $sth = $dbh->prepare($query);
 422     $sth->execute($subscriptionid);
 423     return $sth->fetchall_arrayref( {} );
 424 }
 425
 426 =head2 PrepareSerialsData
 427
 428 =over 4
 429
 430    \@res = PrepareSerialsData($serialinfomation)
 431    where serialinformation is a hashref array
 432
 433 =back
 434
 435 =cut
 436
 437 sub PrepareSerialsData {
 438     my ($lines) = @_;
 439     my %tmpresults;
 440     my $year;
 441     my @res;
 442     my $startdate;
 443     my $aqbooksellername;
 444     my $bibliotitle;
 445     my @loopissues;
 446     my $first;
 447     my $previousnote = "";
 448
 449     foreach my $subs (@$lines) {
 450         $subs->{'publisheddate'} = (
 451             $subs->{'publisheddate'}
 452             ? format_date( $subs->{'publisheddate'} )
 453             : "XXX"
 454         );
 455         $subs->{'branchname'} = GetBranchName( $subs->{'branchcode'} );
 456         $subs->{'planneddate'}                  = format_date( $subs->{'planneddate'} );
 457         $subs->{ "status" . $subs->{'status'} } = 1;
 458         $subs->{"checked"}                      = $subs->{'status'} =~ /1|3|4|7/;
 459
 460         if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
 461             $year = $subs->{'year'};
 462         } else {
 463             $year = "manage";
 464         }
 465         if ( $tmpresults{$year} ) {
 466             push @{ $tmpresults{$year}->{'serials'} }, $subs;
 467         } else {
 468             $tmpresults{$year} = {
 469                 'year'             => $year,
 470                 'aqbooksellername' => $subs->{'aqbooksellername'},
 471                 'bibliotitle'      => $subs->{'bibliotitle'},
 472                 'serials'          => [$subs],
 473                 'first'            => $first,
 474             };
 475         }
 476     }
 477     foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
 478         push @res, $tmpresults{$key};
 479     }
 480     $res[0]->{'first'} = 1;
 481     return \@res;
 482 }
 483
 484 =head2 GetSubscriptionsFromBiblionumber
 485
 486 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
 487 this function get the subscription list. it reads on subscription table.
 488 return :
 489 table of subscription which has the biblionumber given on input arg.
 490 each line of this table is a hashref. All hashes containt
 491 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
 492
 493 =cut
 494
 495 sub GetSubscriptionsFromBiblionumber {
 496     my ($biblionumber) = @_;
 497     my $dbh            = C4::Context->dbh;
 498     my $query          = qq(
 499         SELECT subscription.*,
 500                branches.branchname,
 501                subscriptionhistory.*,
 502                aqbooksellers.name AS aqbooksellername,
 503                biblio.title AS bibliotitle
 504        FROM subscription
 505        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 506        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 507        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 508        LEFT JOIN branches ON branches.branchcode=subscription.branchcode
 509        WHERE subscription.biblionumber = ?
 510     );
 511     my $sth = $dbh->prepare($query);
 512     $sth->execute($biblionumber);
 513     my @res;
 514     while ( my $subs = $sth->fetchrow_hashref ) {
 515         $subs->{startdate}     = format_date( $subs->{startdate} );
 516         $subs->{histstartdate} = format_date( $subs->{histstartdate} );
 517         $subs->{histenddate}   = format_date( $subs->{histenddate} );
 518         $subs->{opacnote}     =~ s/\n/\<br\/\>/g;
 519         $subs->{missinglist}  =~ s/\n/\<br\/\>/g;
 520         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 521         $subs->{ "periodicity" . $subs->{periodicity} }     = 1;
 522         $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
 523         $subs->{ "status" . $subs->{'status'} }             = 1;
 524         $subs->{'cannotedit'} =
 525           (      C4::Context->preference('IndependantBranches')
 526               && C4::Context->userenv
 527               && C4::Context->userenv->{flags} % 2 != 1
 528               && C4::Context->userenv->{branch}
 529               && $subs->{branchcode}
 530               && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
 531
 532         if ( $subs->{enddate} eq '0000-00-00' ) {
 533             $subs->{enddate} = '';
 534         } else {
 535             $subs->{enddate} = format_date( $subs->{enddate} );
 536         }
 537         $subs->{'abouttoexpire'}       = abouttoexpire( $subs->{'subscriptionid'} );
 538         $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
 539         push @res, $subs;
 540     }
 541     return \@res;
 542 }
 543
 544 =head2 GetFullSubscriptionsFromBiblionumber
 545
 546 =over 4
 547
 548    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
 549    this function read on serial table.
 550
 551 =back
 552
 553 =cut
 554
 555 sub GetFullSubscriptionsFromBiblionumber {
 556     my ($biblionumber) = @_;
 557     my $dbh            = C4::Context->dbh;
 558     my $query          = qq|
 559   SELECT    serial.serialid,
 560             serial.serialseq,
 561             serial.planneddate,
 562             serial.publisheddate,
 563             serial.status,
 564             serial.notes as notes,
 565             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 566             biblio.title as bibliotitle,
 567             subscription.branchcode AS branchcode,
 568             subscription.subscriptionid AS subscriptionid|;
 569     if (   C4::Context->preference('IndependantBranches')
 570         && C4::Context->userenv
 571         && C4::Context->userenv->{'flags'} != 1
 572         && C4::Context->userenv->{'branch'} ) {
 573         $query .= "
 574       , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 575     }
 576
 577     $query .= qq|
 578   FROM      serial
 579   LEFT JOIN subscription ON
 580           (serial.subscriptionid=subscription.subscriptionid)
 581   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 582   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 583   WHERE     subscription.biblionumber = ?
 584   ORDER BY year DESC,
 585           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 586           serial.subscriptionid
 587           |;
 588     my $sth = $dbh->prepare($query);
 589     $sth->execute($biblionumber);
 590     return $sth->fetchall_arrayref( {} );
 591 }
 592
 593 =head2 GetSubscriptions
 594
 595 =over 4
 596
 597 @results = GetSubscriptions($title,$ISSN,$biblionumber);
 598 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
 599 return:
 600 a table of hashref. Each hash containt the subscription.
 601
 602 =back
 603
 604 =cut
 605
 606 sub GetSubscriptions {
 607     my ( $string, $issn, $biblionumber ) = @_;
 608
 609     #return unless $title or $ISSN or $biblionumber;
 610     my $dbh = C4::Context->dbh;
 611     my $sth;
 612     my $sql = qq(
 613             SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
 614             FROM   subscription
 615             LEFT JOIN subscriptionhistory USING(subscriptionid)
 616             LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 617             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 618     );
 619     my @bind_params;
 620     my $sqlwhere;
 621     if ($biblionumber) {
 622         $sqlwhere = "   WHERE biblio.biblionumber=?";
 623         push @bind_params, $biblionumber;
 624     }
 625     if ($string) {
 626         my @sqlstrings;
 627         my @strings_to_search;
 628         @strings_to_search = map { "%$_%" } split( / /, $string );
 629         foreach my $index qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes) {
 630             push @bind_params, @strings_to_search;
 631             my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
 632             $debug && warn "$tmpstring";
 633             $tmpstring =~ s/^AND //;
 634             push @sqlstrings, $tmpstring;
 635         }
 636         $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "(" . join( ") OR (", @sqlstrings ) . ")";
 637     }
 638     if ($issn) {
 639         my @sqlstrings;
 640         my @strings_to_search;
 641         @strings_to_search = map { "%$_%" } split( / /, $issn );
 642         foreach my $index qw(biblioitems.issn subscription.callnumber) {
 643             push @bind_params, @strings_to_search;
 644             my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
 645             $debug && warn "$tmpstring";
 646             $tmpstring =~ s/^OR //;
 647             push @sqlstrings, $tmpstring;
 648         }
 649         $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "(" . join( ") OR (", @sqlstrings ) . ")";
 650     }
 651     $sql .= "$sqlwhere ORDER BY title";
 652     $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
 653     $sth = $dbh->prepare($sql);
 654     $sth->execute(@bind_params);
 655     my @results;
 656     my $previoustitle = "";
 657     my $odd           = 1;
 658
 659     while ( my $line = $sth->fetchrow_hashref ) {
 660         if ( $previoustitle eq $line->{title} ) {
 661             $line->{title} = "";
 662             $line->{issn}  = "";
 663         } else {
 664             $previoustitle = $line->{title};
 665             $odd           = -$odd;
 666         }
 667         $line->{toggle} = 1 if $odd == 1;
 668         $line->{'cannotedit'} =
 669           (      C4::Context->preference('IndependantBranches')
 670               && C4::Context->userenv
 671               && C4::Context->userenv->{flags} % 2 != 1
 672               && C4::Context->userenv->{branch}
 673               && $line->{branchcode}
 674               && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
 675         push @results, $line;
 676     }
 677     return @results;
 678 }
 679
 680 =head2 GetSerials
 681
 682 =over 4
 683
 684 ($totalissues,@serials) = GetSerials($subscriptionid);
 685 this function get every serial not arrived for a given subscription
 686 as well as the number of issues registered in the database (all types)
 687 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 688
 689 FIXME: We should return \@serials.
 690
 691 =back
 692
 693 =cut
 694
 695 sub GetSerials {
 696     my ( $subscriptionid, $count ) = @_;
 697     my $dbh = C4::Context->dbh;
 698
 699     # status = 2 is "arrived"
 700     my $counter = 0;
 701     $count = 5 unless ($count);
 702     my @serials;
 703     my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
 704                         FROM   serial
 705                         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 706                         ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
 707     my $sth = $dbh->prepare($query);
 708     $sth->execute($subscriptionid);
 709
 710     while ( my $line = $sth->fetchrow_hashref ) {
 711         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 712         $line->{"publisheddate"}              = format_date( $line->{"publisheddate"} );
 713         $line->{"planneddate"}                = format_date( $line->{"planneddate"} );
 714         push @serials, $line;
 715     }
 716
 717     # OK, now add the last 5 issues arrives/missing
 718     $query = "SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
 719        FROM     serial
 720        WHERE    subscriptionid = ?
 721        AND      (status in (2,4,5))
 722        ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
 723       ";
 724     $sth = $dbh->prepare($query);
 725     $sth->execute($subscriptionid);
 726     while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
 727         $counter++;
 728         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 729         $line->{"planneddate"}                = format_date( $line->{"planneddate"} );
 730         $line->{"publisheddate"}              = format_date( $line->{"publisheddate"} );
 731         push @serials, $line;
 732     }
 733
 734     $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
 735     $sth   = $dbh->prepare($query);
 736     $sth->execute($subscriptionid);
 737     my ($totalissues) = $sth->fetchrow;
 738     return ( $totalissues, @serials );
 739 }
 740
 741 =head2 GetSerials2
 742
 743 =over 4
 744
 745 @serials = GetSerials2($subscriptionid,$status);
 746 this function gets every serial waited for a given subscription
 747 as well as the number of issues registered in the database (all types)
 748 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 749
 750 =back
 751
 752 =cut
 753
 754 sub GetSerials2 {
 755     my ( $subscription, $status ) = @_;
 756     my $dbh   = C4::Context->dbh;
 757     my $query = qq|
 758                  SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
 759                  FROM     serial
 760                  WHERE    subscriptionid=$subscription AND status IN ($status)
 761                  ORDER BY publisheddate,serialid DESC
 762                     |;
 763     $debug and warn "GetSerials2 query: $query";
 764     my $sth = $dbh->prepare($query);
 765     $sth->execute;
 766     my @serials;
 767
 768     while ( my $line = $sth->fetchrow_hashref ) {
 769         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 770         $line->{"planneddate"}                = format_date( $line->{"planneddate"} );
 771         $line->{"publisheddate"}              = format_date( $line->{"publisheddate"} );
 772         push @serials, $line;
 773     }
 774     return @serials;
 775 }
 776
 777 =head2 GetLatestSerials
 778
 779 =over 4
 780
 781 \@serials = GetLatestSerials($subscriptionid,$limit)
 782 get the $limit's latest serials arrived or missing for a given subscription
 783 return :
 784 a ref to a table which it containts all of the latest serials stored into a hash.
 785
 786 =back
 787
 788 =cut
 789
 790 sub GetLatestSerials {
 791     my ( $subscriptionid, $limit ) = @_;
 792     my $dbh = C4::Context->dbh;
 793
 794     # status = 2 is "arrived"
 795     my $strsth = "SELECT   serialid,serialseq, status, planneddate, notes
 796                         FROM     serial
 797                         WHERE    subscriptionid = ?
 798                         AND      (status =2 or status=4)
 799                         ORDER BY planneddate DESC LIMIT 0,$limit
 800                 ";
 801     my $sth = $dbh->prepare($strsth);
 802     $sth->execute($subscriptionid);
 803     my @serials;
 804     while ( my $line = $sth->fetchrow_hashref ) {
 805         $line->{ "status" . $line->{status} } = 1;                        # fills a "statusX" value, used for template status select list
 806         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
 807         push @serials, $line;
 808     }
 809
 810     return \@serials;
 811 }
 812
 813 =head2 GetDistributedTo
 814
 815 =over 4
 816
 817 $distributedto=GetDistributedTo($subscriptionid)
 818 This function select the old previous value of distributedto in the database.
 819
 820 =back
 821
 822 =cut
 823
 824 sub GetDistributedTo {
 825     my $dbh = C4::Context->dbh;
 826     my $distributedto;
 827     my $subscriptionid = @_;
 828     my $query          = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
 829     my $sth            = $dbh->prepare($query);
 830     $sth->execute($subscriptionid);
 831     return ($distributedto) = $sth->fetchrow;
 832 }
 833
 834 =head2 GetNextSeq
 835
 836 =over 4
 837
 838 GetNextSeq($val)
 839 $val is a hashref containing all the attributes of the table 'subscription'
 840 This function get the next issue for the subscription given on input arg
 841 return:
 842 all the input params updated.
 843
 844 =back
 845
 846 =cut
 847
 848 # sub GetNextSeq {
 849 #     my ($val) =@_;
 850 #     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 851 #     $calculated = $val->{numberingmethod};
 852 # # calculate the (expected) value of the next issue recieved.
 853 #     $newlastvalue1 = $val->{lastvalue1};
 854 # # check if we have to increase the new value.
 855 #     $newinnerloop1 = $val->{innerloop1}+1;
 856 #     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 857 #     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 858 #     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 859 #     $calculated =~ s/\{X\}/$newlastvalue1/g;
 860 #
 861 #     $newlastvalue2 = $val->{lastvalue2};
 862 # # check if we have to increase the new value.
 863 #     $newinnerloop2 = $val->{innerloop2}+1;
 864 #     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 865 #     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 866 #     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 867 #     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 868 #
 869 #     $newlastvalue3 = $val->{lastvalue3};
 870 # # check if we have to increase the new value.
 871 #     $newinnerloop3 = $val->{innerloop3}+1;
 872 #     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 873 #     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 874 #     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 875 #     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 876 #     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 877 # }
 878
 879 sub GetNextSeq {
 880     my ($val) = @_;
 881     my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
 882     my $pattern          = $val->{numberpattern};
 883     my @seasons          = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
 884     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
 885     $calculated    = $val->{numberingmethod};
 886     $newlastvalue1 = $val->{lastvalue1};
 887     $newlastvalue2 = $val->{lastvalue2};
 888     $newlastvalue3 = $val->{lastvalue3};
 889     $newlastvalue1 = $val->{lastvalue1};
 890
 891     # check if we have to increase the new value.
 892     $newinnerloop1 = $val->{innerloop1} + 1;
 893     $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
 894     $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 );    # <1 to be true when 0 or empty.
 895     $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} );    # reset counter if needed.
 896     $calculated =~ s/\{X\}/$newlastvalue1/g;
 897
 898     $newlastvalue2 = $val->{lastvalue2};
 899
 900     # check if we have to increase the new value.
 901     $newinnerloop2 = $val->{innerloop2} + 1;
 902     $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
 903     $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 );                         # <1 to be true when 0 or empty.
 904     $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} );    # reset counter if needed.
 905     if ( $pattern == 6 ) {
 906         if ( $val->{hemisphere} == 2 ) {
 907             my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 908             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 909         } else {
 910             my $newlastvalue2seq = $seasons[$newlastvalue2];
 911             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 912         }
 913     } else {
 914         $calculated =~ s/\{Y\}/$newlastvalue2/g;
 915     }
 916
 917     $newlastvalue3 = $val->{lastvalue3};
 918
 919     # check if we have to increase the new value.
 920     $newinnerloop3 = $val->{innerloop3} + 1;
 921     $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
 922     $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 );    # <1 to be true when 0 or empty.
 923     $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} );    # reset counter if needed.
 924     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 925
 926     return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
 927 }
 928
 929 =head2 GetSeq
 930
 931 =over 4
 932
 933 $calculated = GetSeq($val)
 934 $val is a hashref containing all the attributes of the table 'subscription'
 935 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 936 return:
 937 the sequence in integer format
 938
 939 =back
 940
 941 =cut
 942
 943 sub GetSeq {
 944     my ($val) = @_;
 945     my $pattern = $val->{numberpattern};
 946     my @seasons          = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
 947     my @southern_seasons = ( '',        'Summer', 'Autumn', 'Winter', 'Spring' );
 948     my $calculated       = $val->{numberingmethod};
 949     my $x                = $val->{'lastvalue1'};
 950     $calculated =~ s/\{X\}/$x/g;
 951     my $newlastvalue2 = $val->{'lastvalue2'};
 952
 953     if ( $pattern == 6 ) {
 954         if ( $val->{hemisphere} == 2 ) {
 955             my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 956             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 957         } else {
 958             my $newlastvalue2seq = $seasons[$newlastvalue2];
 959             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 960         }
 961     } else {
 962         $calculated =~ s/\{Y\}/$newlastvalue2/g;
 963     }
 964     my $z = $val->{'lastvalue3'};
 965     $calculated =~ s/\{Z\}/$z/g;
 966     return $calculated;
 967 }
 968
 969 =head2 GetExpirationDate
 970
 971 $sensddate = GetExpirationDate($subscriptionid)
 972
 973 this function return the next expiration date for a subscription given on input args.
 974
 975 return
 976 the enddate
 977
 978 =cut
 979
 980 sub GetExpirationDate {
 981     my ( $subscriptionid, $startdate ) = @_;
 982     my $dbh          = C4::Context->dbh;
 983     my $subscription = GetSubscription($subscriptionid);
 984     my $enddate;
 985
 986     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 987     $enddate = $startdate || $subscription->{startdate};
 988     my @date = split( /-/, $enddate );
 989     return if ( scalar(@date) != 3 || not check_date(@date) );
 990     if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
 991
 992         # If Not Irregular
 993         if ( my $length = $subscription->{numberlength} ) {
 994
 995             #calculate the date of the last issue.
 996             for ( my $i = 1 ; $i <= $length ; $i++ ) {
 997                 $enddate = GetNextDate( $enddate, $subscription );
 998             }
 999         } elsif ( $subscription->{monthlength} ) {
1000             if ( $$subscription{startdate} ) {
1001                 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1002                 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1003             }
1004         } elsif ( $subscription->{weeklength} ) {
1005             if ( $$subscription{startdate} ) {
1006                 my @date = split( /-/, $subscription->{startdate} );
1007                 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1008                 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1009             }
1010         }
1011         return $enddate;
1012     } else {
1013         return;
1014     }
1015 }
1016
1017 =head2 CountSubscriptionFromBiblionumber
1018
1019 =over 4
1020
1021 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1022 this count the number of subscription for a biblionumber given.
1023 return :
1024 the number of subscriptions with biblionumber given on input arg.
1025
1026 =back
1027
1028 =cut
1029
1030 sub CountSubscriptionFromBiblionumber {
1031     my ($biblionumber) = @_;
1032     my $dbh            = C4::Context->dbh;
1033     my $query          = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1034     my $sth            = $dbh->prepare($query);
1035     $sth->execute($biblionumber);
1036     my $subscriptionsnumber = $sth->fetchrow;
1037     return $subscriptionsnumber;
1038 }
1039
1040 =head2 ModSubscriptionHistory
1041
1042 =over 4
1043
1044 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1045
1046 this function modify the history of a subscription. Put your new values on input arg.
1047
1048 =back
1049
1050 =cut
1051
1052 sub ModSubscriptionHistory {
1053     my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
1054     my $dbh   = C4::Context->dbh;
1055     my $query = "UPDATE subscriptionhistory
1056                     SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1057                     WHERE subscriptionid=?
1058                 ";
1059     my $sth = $dbh->prepare($query);
1060     $recievedlist =~ s/^; //;
1061     $missinglist  =~ s/^; //;
1062     $opacnote     =~ s/^; //;
1063     $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1064     return $sth->rows;
1065 }
1066
1067 =head2 ModSerialStatus
1068
1069 =over 4
1070
1071 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1072
1073 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1074 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1075
1076 =back
1077
1078 =cut
1079
1080 sub ModSerialStatus {
1081     my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1082
1083     #It is a usual serial
1084     # 1st, get previous status :
1085     my $dbh   = C4::Context->dbh;
1086     my $query = "SELECT subscriptionid,status FROM serial WHERE  serialid=?";
1087     my $sth   = $dbh->prepare($query);
1088     $sth->execute($serialid);
1089     my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1090
1091     # change status & update subscriptionhistory
1092     my $val;
1093     if ( $status eq 6 ) {
1094         DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1095     } else {
1096         my $query = "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE  serialid = ?";
1097         $sth = $dbh->prepare($query);
1098         $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1099         $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1100         $sth   = $dbh->prepare($query);
1101         $sth->execute($subscriptionid);
1102         my $val = $sth->fetchrow_hashref;
1103         unless ( $val->{manualhistory} ) {
1104             $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE  subscriptionid=?";
1105             $sth   = $dbh->prepare($query);
1106             $sth->execute($subscriptionid);
1107             my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1108             if ( $status eq 2 ) {
1109
1110                 $recievedlist .= "; $serialseq"
1111                   unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1112             }
1113
1114             #         warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1115             $missinglist .= "; $serialseq"
1116               if ( $status eq 4
1117                 and not index( "$missinglist", "$serialseq" ) >= 0 );
1118             $missinglist .= "; $serialseq"
1119               if ( $status eq 5
1120                 and index( "$missinglist", "$serialseq" ) >= 0 );
1121             $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1122             $sth   = $dbh->prepare($query);
1123             $recievedlist =~ s/^; //;
1124             $missinglist  =~ s/^; //;
1125             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1126         }
1127     }
1128
1129     # create new waited entry if needed (ie : was a "waited" and has changed)
1130     if ( $oldstatus eq 1 && $status ne 1 ) {
1131         my $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1132         $sth = $dbh->prepare($query);
1133         $sth->execute($subscriptionid);
1134         my $val = $sth->fetchrow_hashref;
1135
1136         # next issue number
1137         #     warn "Next Seq";
1138         my ( $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 ) = GetNextSeq($val);
1139
1140         #     warn "Next Seq End";
1141
1142         # next date (calculated from actual date & frequency parameters)
1143         #         warn "publisheddate :$publisheddate ";
1144         my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1145         NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1146         $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1147                     WHERE  subscriptionid = ?";
1148         $sth = $dbh->prepare($query);
1149         $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1150
1151         # check if an alert must be sent... (= a letter is defined & status became "arrived"
1152         if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1153             SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1154         }
1155     }
1156 }
1157
1158 =head2 GetNextExpected
1159
1160 =over 4
1161
1162 $nextexpected = GetNextExpected($subscriptionid)
1163
1164 Get the planneddate for the current expected issue of the subscription.
1165
1166 returns a hashref:
1167
1168 $nextexepected = {
1169     serialid => int
1170     planneddate => C4::Dates object
1171     }
1172
1173 =back
1174
1175 =cut
1176
1177 sub GetNextExpected($) {
1178     my ($subscriptionid) = @_;
1179     my $dbh              = C4::Context->dbh;
1180     my $sth              = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1181
1182     # Each subscription has only one 'expected' issue, with serial.status==1.
1183     $sth->execute( $subscriptionid, 1 );
1184     my ($nextissue) = $sth->fetchrow_hashref;
1185     if ( not $nextissue ) {
1186         $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid  = ? ORDER BY planneddate DESC LIMIT 1');
1187         $sth->execute($subscriptionid);
1188         $nextissue = $sth->fetchrow_hashref;
1189     }
1190     $nextissue->{planneddate} = C4::Dates->new( $nextissue->{planneddate}, 'iso' );
1191     return $nextissue;
1192
1193 }
1194
1195 =head2 ModNextExpected
1196
1197 =over 4
1198
1199 ModNextExpected($subscriptionid,$date)
1200
1201 Update the planneddate for the current expected issue of the subscription.
1202 This will modify all future prediction results.
1203
1204 C<$date> is a C4::Dates object.
1205
1206 =back
1207
1208 =cut
1209
1210 sub ModNextExpected($$) {
1211     my ( $subscriptionid, $date ) = @_;
1212     my $dbh = C4::Context->dbh;
1213
1214     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1215     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1216
1217     # Each subscription has only one 'expected' issue, with serial.status==1.
1218     $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1219     return 0;
1220
1221 }
1222
1223 =head2 ModSubscription
1224
1225 =over 4
1226
1227 this function modify a subscription. Put all new values on input args.
1228
1229 =back
1230
1231 =cut
1232
1233 sub ModSubscription {
1234     my ($auser,           $branchcode,      $aqbooksellerid,    $cost,             $aqbudgetid,    $startdate,   $periodicity,   $firstacquidate,
1235         $dow,             $irregularity,    $numberpattern,     $numberlength,     $weeklength,    $monthlength, $add1,          $every1,
1236         $whenmorethan1,   $setto1,          $lastvalue1,        $innerloop1,       $add2,          $every2,      $whenmorethan2, $setto2,
1237         $lastvalue2,      $innerloop2,      $add3,              $every3,           $whenmorethan3, $setto3,      $lastvalue3,    $innerloop3,
1238         $numberingmethod, $status,          $biblionumber,      $callnumber,       $notes,         $letter,      $hemisphere,    $manualhistory,
1239         $internalnotes,   $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,   $location,    $enddate,       $subscriptionid
1240     ) = @_;
1241
1242     #     warn $irregularity;
1243     my $dbh   = C4::Context->dbh;
1244     my $query = "UPDATE subscription
1245                     SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1246                         periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1247                         add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1248                         add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1249                         add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1250                         numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1251                                                 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1252                                                 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1253                                                 ,enddate=?
1254                     WHERE subscriptionid = ?";
1255
1256     #warn "query :".$query;
1257     my $sth = $dbh->prepare($query);
1258     $sth->execute(
1259         $auser,           $branchcode,     $aqbooksellerid, $cost,
1260         $aqbudgetid,      $startdate,      $periodicity,    $firstacquidate,
1261         $dow,             "$irregularity", $numberpattern,  $numberlength,
1262         $weeklength,      $monthlength,    $add1,           $every1,
1263         $whenmorethan1,   $setto1,         $lastvalue1,     $innerloop1,
1264         $add2,            $every2,         $whenmorethan2,  $setto2,
1265         $lastvalue2,      $innerloop2,     $add3,           $every3,
1266         $whenmorethan3,   $setto3,         $lastvalue3,     $innerloop3,
1267         $numberingmethod, $status,         $biblionumber,   $callnumber,
1268         $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1269         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1270         $graceperiod,   $location,        $enddate,           $subscriptionid
1271     );
1272     my $rows = $sth->rows;
1273     $sth->finish;
1274
1275     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1276     return $rows;
1277 }
1278
1279 =head2 NewSubscription
1280
1281 =over 4
1282
1283 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1284     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1285     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1286     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1287     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1288     $numberingmethod, $status, $notes, $serialsadditems,
1289     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1290
1291 Create a new subscription with value given on input args.
1292
1293 return :
1294 the id of this new subscription
1295
1296 =back
1297
1298 =cut
1299
1300 sub NewSubscription {
1301     my ($auser,         $branchcode,      $aqbooksellerid,    $cost,             $aqbudgetid,    $biblionumber, $startdate,       $periodicity,
1302         $dow,           $numberlength,    $weeklength,        $monthlength,      $add1,          $every1,       $whenmorethan1,   $setto1,
1303         $lastvalue1,    $innerloop1,      $add2,              $every2,           $whenmorethan2, $setto2,       $lastvalue2,      $innerloop2,
1304         $add3,          $every3,          $whenmorethan3,     $setto3,           $lastvalue3,    $innerloop3,   $numberingmethod, $status,
1305         $notes,         $letter,          $firstacquidate,    $irregularity,     $numberpattern, $callnumber,   $hemisphere,      $manualhistory,
1306         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,   $location,     $enddate
1307     ) = @_;
1308     my $dbh = C4::Context->dbh;
1309
1310     #save subscription (insert into database)
1311     my $query = qq|
1312         INSERT INTO subscription
1313             (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1314             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1315             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1316             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1317             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1318             numberingmethod, status, notes, letter,firstacquidate,irregularity,
1319             numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1320             staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1321         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1322         |;
1323     my $sth = $dbh->prepare($query);
1324     $sth->execute(
1325         $auser,         $branchcode,      $aqbooksellerid,    $cost,             $aqbudgetid,    $biblionumber, $startdate,       $periodicity,
1326         $dow,           $numberlength,    $weeklength,        $monthlength,      $add1,          $every1,       $whenmorethan1,   $setto1,
1327         $lastvalue1,    $innerloop1,      $add2,              $every2,           $whenmorethan2, $setto2,       $lastvalue2,      $innerloop2,
1328         $add3,          $every3,          $whenmorethan3,     $setto3,           $lastvalue3,    $innerloop3,   $numberingmethod, "$status",
1329         $notes,         $letter,          $firstacquidate,    $irregularity,     $numberpattern, $callnumber,   $hemisphere,      $manualhistory,
1330         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,   $location,     $enddate
1331     );
1332
1333     #then create the 1st waited number
1334     my $subscriptionid = $dbh->{'mysql_insertid'};
1335     $query = qq(
1336         INSERT INTO subscriptionhistory
1337             (biblionumber, subscriptionid, histstartdate,  opacnote, librariannote)
1338         VALUES (?,?,?,?,?)
1339         );
1340     $sth = $dbh->prepare($query);
1341     $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1342
1343     # reread subscription to get a hash (for calculation of the 1st issue number)
1344     $query = qq(
1345         SELECT *
1346         FROM   subscription
1347         WHERE  subscriptionid = ?
1348     );
1349     $sth = $dbh->prepare($query);
1350     $sth->execute($subscriptionid);
1351     my $val = $sth->fetchrow_hashref;
1352
1353     # calculate issue number
1354     my $serialseq = GetSeq($val);
1355     $query = qq|
1356         INSERT INTO serial
1357             (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1358         VALUES (?,?,?,?,?,?)
1359     |;
1360     $sth = $dbh->prepare($query);
1361     $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1362
1363     logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1364
1365     #set serial flag on biblio if not already set.
1366     my ( $null, ($bib) ) = GetBiblio($biblionumber);
1367     if ( !$bib->{'serial'} ) {
1368         my $record = GetMarcBiblio($biblionumber);
1369         my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1370         if ($tag) {
1371             eval { $record->field($tag)->update( $subf => 1 ); };
1372         }
1373         ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1374     }
1375     return $subscriptionid;
1376 }
1377
1378 =head2 ReNewSubscription
1379
1380 =over 4
1381
1382 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1383
1384 this function renew a subscription with values given on input args.
1385
1386 =back
1387
1388 =cut
1389
1390 sub ReNewSubscription {
1391     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1392     my $dbh          = C4::Context->dbh;
1393     my $subscription = GetSubscription($subscriptionid);
1394     my $query        = qq|
1395          SELECT *
1396          FROM   biblio
1397          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1398          WHERE    biblio.biblionumber=?
1399      |;
1400     my $sth = $dbh->prepare($query);
1401     $sth->execute( $subscription->{biblionumber} );
1402     my $biblio = $sth->fetchrow_hashref;
1403
1404     if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1405
1406         NewSuggestion(
1407             {   'suggestedby'   => $user,
1408                 'title'         => $subscription->{bibliotitle},
1409                 'author'        => $biblio->{author},
1410                 'publishercode' => $biblio->{publishercode},
1411                 'note'          => $biblio->{note},
1412                 'biblionumber'  => $subscription->{biblionumber}
1413             }
1414         );
1415     }
1416
1417     # renew subscription
1418     $query = qq|
1419         UPDATE subscription
1420         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1421         WHERE  subscriptionid=?
1422     |;
1423     $sth = $dbh->prepare($query);
1424     $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1425     my $enddate = GetExpirationDate($subscriptionid);
1426         $debug && warn "enddate :$enddate";
1427     $query = qq|
1428         UPDATE subscription
1429         SET    enddate=?
1430         WHERE  subscriptionid=?
1431     |;
1432     $sth = $dbh->prepare($query);
1433     $sth->execute( $enddate, $subscriptionid );
1434     $query = qq|
1435         UPDATE subscriptionhistory
1436         SET    histenddate=?
1437         WHERE  subscriptionid=?
1438     |;
1439     $sth = $dbh->prepare($query);
1440     $sth->execute( $enddate, $subscriptionid );
1441
1442     logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1443 }
1444
1445 =head2 NewIssue
1446
1447 =over 4
1448
1449 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate,  $notes)
1450
1451 Create a new issue stored on the database.
1452 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1453
1454 =back
1455
1456 =cut
1457
1458 sub NewIssue {
1459     my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1460     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1461
1462     my $dbh   = C4::Context->dbh;
1463     my $query = qq|
1464         INSERT INTO serial
1465             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1466         VALUES (?,?,?,?,?,?,?)
1467     |;
1468     my $sth = $dbh->prepare($query);
1469     $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1470     my $serialid = $dbh->{'mysql_insertid'};
1471     $query = qq|
1472         SELECT missinglist,recievedlist
1473         FROM   subscriptionhistory
1474         WHERE  subscriptionid=?
1475     |;
1476     $sth = $dbh->prepare($query);
1477     $sth->execute($subscriptionid);
1478     my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1479
1480     if ( $status eq 2 ) {
1481         ### TODO Add a feature that improves recognition and description.
1482         ### As such count (serialseq) i.e. : N18,2(N19),N20
1483         ### Would use substr and index But be careful to previous presence of ()
1484         $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1485     }
1486     if ( $status eq 4 ) {
1487         $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1488     }
1489     $query = qq|
1490         UPDATE subscriptionhistory
1491         SET    recievedlist=?, missinglist=?
1492         WHERE  subscriptionid=?
1493     |;
1494     $sth = $dbh->prepare($query);
1495     $recievedlist =~ s/^; //;
1496     $missinglist  =~ s/^; //;
1497     $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1498     return $serialid;
1499 }
1500
1501 =head2 ItemizeSerials
1502
1503 =over 4
1504
1505 ItemizeSerials($serialid, $info);
1506 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1507 $serialid the serialid
1508 return :
1509 1 if the itemize is a succes.
1510 0 and @error else. @error containts the list of errors found.
1511
1512 =back
1513
1514 =cut
1515
1516 sub ItemizeSerials {
1517     my ( $serialid, $info ) = @_;
1518     my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1519
1520     my $dbh   = C4::Context->dbh;
1521     my $query = qq|
1522         SELECT *
1523         FROM   serial
1524         WHERE  serialid=?
1525     |;
1526     my $sth = $dbh->prepare($query);
1527     $sth->execute($serialid);
1528     my $data = $sth->fetchrow_hashref;
1529     if ( C4::Context->preference("RoutingSerials") ) {
1530
1531         # check for existing biblioitem relating to serial issue
1532         my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1533         my $bibitemno = 0;
1534         for ( my $i = 0 ; $i < $count ; $i++ ) {
1535             if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1536                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1537                 last;
1538             }
1539         }
1540         if ( $bibitemno == 0 ) {
1541             my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1542             $sth->execute( $data->{'biblionumber'} );
1543             my $biblioitem = $sth->fetchrow_hashref;
1544             $biblioitem->{'volumedate'}  = $data->{planneddate};
1545             $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1546             $biblioitem->{'dewey'}       = $info->{itemcallnumber};
1547         }
1548     }
1549
1550     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1551     if ( $info->{barcode} ) {
1552         my @errors;
1553         my $exists = itemdata( $info->{'barcode'} );
1554         push @errors, "barcode_not_unique" if ($exists);
1555         unless ($exists) {
1556             my $marcrecord = MARC::Record->new();
1557             my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1558             my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1559             $marcrecord->insert_fields_ordered($newField);
1560             if ( $info->{branch} ) {
1561                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1562
1563                 #warn "items.homebranch : $tag , $subfield";
1564                 if ( $marcrecord->field($tag) ) {
1565                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1566                 } else {
1567                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1568                     $marcrecord->insert_fields_ordered($newField);
1569                 }
1570                 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1571
1572                 #warn "items.holdingbranch : $tag , $subfield";
1573                 if ( $marcrecord->field($tag) ) {
1574                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1575                 } else {
1576                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1577                     $marcrecord->insert_fields_ordered($newField);
1578                 }
1579             }
1580             if ( $info->{itemcallnumber} ) {
1581                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1582
1583                 if ( $marcrecord->field($tag) ) {
1584                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1585                 } else {
1586                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1587                     $marcrecord->insert_fields_ordered($newField);
1588                 }
1589             }
1590             if ( $info->{notes} ) {
1591                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1592
1593                 if ( $marcrecord->field($tag) ) {
1594                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1595                 } else {
1596                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1597                     $marcrecord->insert_fields_ordered($newField);
1598                 }
1599             }
1600             if ( $info->{location} ) {
1601                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1602
1603                 if ( $marcrecord->field($tag) ) {
1604                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1605                 } else {
1606                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1607                     $marcrecord->insert_fields_ordered($newField);
1608                 }
1609             }
1610             if ( $info->{status} ) {
1611                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1612
1613                 if ( $marcrecord->field($tag) ) {
1614                     $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1615                 } else {
1616                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1617                     $marcrecord->insert_fields_ordered($newField);
1618                 }
1619             }
1620             if ( C4::Context->preference("RoutingSerials") ) {
1621                 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1622                 if ( $marcrecord->field($tag) ) {
1623                     $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1624                 } else {
1625                     my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1626                     $marcrecord->insert_fields_ordered($newField);
1627                 }
1628             }
1629             AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1630             return 1;
1631         }
1632         return ( 0, @errors );
1633     }
1634 }
1635
1636 =head2 HasSubscriptionStrictlyExpired
1637
1638 =over 4
1639
1640 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1641
1642 the subscription has stricly expired when today > the end subscription date
1643
1644 return :
1645 1 if true, 0 if false, -1 if the expiration date is not set.
1646
1647 =back
1648
1649 =cut
1650
1651 sub HasSubscriptionStrictlyExpired {
1652
1653     # Getting end of subscription date
1654     my ($subscriptionid) = @_;
1655     my $dbh              = C4::Context->dbh;
1656     my $subscription     = GetSubscription($subscriptionid);
1657     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1658
1659     # If the expiration date is set
1660     if ( $expirationdate != 0 ) {
1661         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1662
1663         # Getting today's date
1664         my ( $nowyear, $nowmonth, $nowday ) = Today();
1665
1666         # if today's date > expiration date, then the subscription has stricly expired
1667         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1668             return 1;
1669         } else {
1670             return 0;
1671         }
1672     } else {
1673
1674         # There are some cases where the expiration date is not set
1675         # As we can't determine if the subscription has expired on a date-basis,
1676         # we return -1;
1677         return -1;
1678     }
1679 }
1680
1681 =head2 HasSubscriptionExpired
1682
1683 =over 4
1684
1685 $has_expired = HasSubscriptionExpired($subscriptionid)
1686
1687 the subscription has expired when the next issue to arrive is out of subscription limit.
1688
1689 return :
1690 0 if the subscription has not expired
1691 1 if the subscription has expired
1692 2 if has subscription does not have a valid expiration date set
1693
1694 =back
1695
1696 =cut
1697
1698 sub HasSubscriptionExpired {
1699     my ($subscriptionid) = @_;
1700     my $dbh              = C4::Context->dbh;
1701     my $subscription     = GetSubscription($subscriptionid);
1702     if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1703         my $expirationdate = $subscription->{enddate};
1704         my $query          = qq|
1705             SELECT max(planneddate)
1706             FROM   serial
1707             WHERE  subscriptionid=?
1708       |;
1709         my $sth = $dbh->prepare($query);
1710         $sth->execute($subscriptionid);
1711         my ($res) = $sth->fetchrow;
1712         return 0 unless $res;
1713         my @res                   = split( /-/, $res );
1714         my @endofsubscriptiondate = split( /-/, $expirationdate );
1715         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1716         return 1
1717           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1718             || ( !$res ) );
1719         return 0;
1720     } else {
1721         if ( $subscription->{'numberlength'} ) {
1722             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1723             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1724             return 0;
1725         } else {
1726             return 0;
1727         }
1728     }
1729     return 0;    # Notice that you'll never get here.
1730 }
1731
1732 =head2 SetDistributedto
1733
1734 =over 4
1735
1736 SetDistributedto($distributedto,$subscriptionid);
1737 This function update the value of distributedto for a subscription given on input arg.
1738
1739 =back
1740
1741 =cut
1742
1743 sub SetDistributedto {
1744     my ( $distributedto, $subscriptionid ) = @_;
1745     my $dbh   = C4::Context->dbh;
1746     my $query = qq|
1747         UPDATE subscription
1748         SET    distributedto=?
1749         WHERE  subscriptionid=?
1750     |;
1751     my $sth = $dbh->prepare($query);
1752     $sth->execute( $distributedto, $subscriptionid );
1753 }
1754
1755 =head2 DelSubscription
1756
1757 =over 4
1758
1759 DelSubscription($subscriptionid)
1760 this function delete the subscription which has $subscriptionid as id.
1761
1762 =back
1763
1764 =cut
1765
1766 sub DelSubscription {
1767     my ($subscriptionid) = @_;
1768     my $dbh = C4::Context->dbh;
1769     $subscriptionid = $dbh->quote($subscriptionid);
1770     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1771     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1772     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1773
1774     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1775 }
1776
1777 =head2 DelIssue
1778
1779 =over 4
1780
1781 DelIssue($serialseq,$subscriptionid)
1782 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1783
1784 =back
1785
1786 =cut
1787
1788 sub DelIssue {
1789     my ($dataissue) = @_;
1790     my $dbh = C4::Context->dbh;
1791     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1792
1793     my $query = qq|
1794         DELETE FROM serial
1795         WHERE       serialid= ?
1796         AND         subscriptionid= ?
1797     |;
1798     my $mainsth = $dbh->prepare($query);
1799     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1800
1801     #Delete element from subscription history
1802     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1803     my $sth = $dbh->prepare($query);
1804     $sth->execute( $dataissue->{'subscriptionid'} );
1805     my $val = $sth->fetchrow_hashref;
1806     unless ( $val->{manualhistory} ) {
1807         my $query = qq|
1808           SELECT * FROM subscriptionhistory
1809           WHERE       subscriptionid= ?
1810       |;
1811         my $sth = $dbh->prepare($query);
1812         $sth->execute( $dataissue->{'subscriptionid'} );
1813         my $data      = $sth->fetchrow_hashref;
1814         my $serialseq = $dataissue->{'serialseq'};
1815         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1816         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1817         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1818         $sth = $dbh->prepare($strsth);
1819         $sth->execute( $dataissue->{'subscriptionid'} );
1820     }
1821
1822     return $mainsth->rows;
1823 }
1824
1825 =head2 GetLateOrMissingIssues
1826
1827 =over 4
1828
1829 @issuelist = &GetLateMissingIssues($supplierid,$serialid)
1830
1831 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1832
1833 return :
1834 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1835 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1836
1837 =back
1838
1839 =cut
1840
1841 sub GetLateOrMissingIssues {
1842     my ( $supplierid, $serialid, $order ) = @_;
1843     my $dbh = C4::Context->dbh;
1844     my $sth;
1845     my $byserial = '';
1846     if ($serialid) {
1847         $byserial = "and serialid = " . $serialid;
1848     }
1849     if ($order) {
1850         $order .= ", title";
1851     } else {
1852         $order = "title";
1853     }
1854     if ($supplierid) {
1855         $sth = $dbh->prepare(
1856             "SELECT
1857                 serialid,      aqbooksellerid,        name,
1858                 biblio.title,  planneddate,           serialseq,
1859                 serial.status, serial.subscriptionid, claimdate
1860             FROM      serial
1861                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1862                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1863                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1864                 WHERE subscription.subscriptionid = serial.subscriptionid
1865                 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1866                 AND subscription.aqbooksellerid=$supplierid
1867                 $byserial
1868                 ORDER BY $order"
1869         );
1870     } else {
1871         $sth = $dbh->prepare(
1872             "SELECT
1873             serialid,      aqbooksellerid,         name,
1874             biblio.title,  planneddate,           serialseq,
1875             serial.status, serial.subscriptionid, claimdate
1876             FROM serial
1877                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1878                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1879                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1880                 WHERE subscription.subscriptionid = serial.subscriptionid
1881                         AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1882                 $byserial
1883                 ORDER BY $order"
1884         );
1885     }
1886     $sth->execute;
1887     my @issuelist;
1888     while ( my $line = $sth->fetchrow_hashref ) {
1889         if ($line->{planneddate}) {
1890             $line->{planneddate} = format_date( $line->{planneddate} );
1891         }
1892         if ($line->{claimdate}) {
1893             $line->{claimdate}   = format_date( $line->{claimdate} );
1894         }
1895         $line->{"status".$line->{status}}   = 1;
1896         push @issuelist, $line;
1897     }
1898     return @issuelist;
1899 }
1900
1901 =head2 removeMissingIssue
1902
1903 =over 4
1904
1905 removeMissingIssue($subscriptionid)
1906
1907 this function removes an issue from being part of the missing string in
1908 subscriptionlist.missinglist column
1909
1910 called when a missing issue is found from the serials-recieve.pl file
1911
1912 =back
1913
1914 =cut
1915
1916 sub removeMissingIssue {
1917     my ( $sequence, $subscriptionid ) = @_;
1918     my $dbh = C4::Context->dbh;
1919     my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1920     $sth->execute($subscriptionid);
1921     my $data              = $sth->fetchrow_hashref;
1922     my $missinglist       = $data->{'missinglist'};
1923     my $missinglistbefore = $missinglist;
1924
1925     # warn $missinglist." before";
1926     $missinglist =~ s/($sequence)//;
1927
1928     # warn $missinglist." after";
1929     if ( $missinglist ne $missinglistbefore ) {
1930         $missinglist =~ s/\|\s\|/\|/g;
1931         $missinglist =~ s/^\| //g;
1932         $missinglist =~ s/\|$//g;
1933         my $sth2 = $dbh->prepare(
1934             "UPDATE subscriptionhistory
1935                     SET missinglist = ?
1936                     WHERE subscriptionid = ?"
1937         );
1938         $sth2->execute( $missinglist, $subscriptionid );
1939     }
1940 }
1941
1942 =head2 updateClaim
1943
1944 =over 4
1945
1946 &updateClaim($serialid)
1947
1948 this function updates the time when a claim is issued for late/missing items
1949
1950 called from claims.pl file
1951
1952 =back
1953
1954 =cut
1955
1956 sub updateClaim {
1957     my ($serialid) = @_;
1958     my $dbh        = C4::Context->dbh;
1959     my $sth        = $dbh->prepare(
1960         "UPDATE serial SET claimdate = now()
1961                 WHERE serialid = ?
1962         "
1963     );
1964     $sth->execute($serialid);
1965 }
1966
1967 =head2 getsupplierbyserialid
1968
1969 =over 4
1970
1971 ($result) = &getsupplierbyserialid($serialid)
1972
1973 this function is used to find the supplier id given a serial id
1974
1975 return :
1976 hashref containing serialid, subscriptionid, and aqbooksellerid
1977
1978 =back
1979
1980 =cut
1981
1982 sub getsupplierbyserialid {
1983     my ($serialid) = @_;
1984     my $dbh        = C4::Context->dbh;
1985     my $sth        = $dbh->prepare(
1986         "SELECT serialid, serial.subscriptionid, aqbooksellerid
1987          FROM serial
1988             LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1989             WHERE serialid = ?
1990         "
1991     );
1992     $sth->execute($serialid);
1993     my $line   = $sth->fetchrow_hashref;
1994     my $result = $line->{'aqbooksellerid'};
1995     return $result;
1996 }
1997
1998 =head2 check_routing
1999
2000 =over 4
2001
2002 ($result) = &check_routing($subscriptionid)
2003
2004 this function checks to see if a serial has a routing list and returns the count of routingid
2005 used to show either an 'add' or 'edit' link
2006
2007 =back
2008
2009 =cut
2010
2011 sub check_routing {
2012     my ($subscriptionid) = @_;
2013     my $dbh              = C4::Context->dbh;
2014     my $sth              = $dbh->prepare(
2015         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2016                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2017                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2018                               "
2019     );
2020     $sth->execute($subscriptionid);
2021     my $line   = $sth->fetchrow_hashref;
2022     my $result = $line->{'routingids'};
2023     return $result;
2024 }
2025
2026 =head2 addroutingmember
2027
2028 =over 4
2029
2030 &addroutingmember($borrowernumber,$subscriptionid)
2031
2032 this function takes a borrowernumber and subscriptionid and add the member to the
2033 routing list for that serial subscription and gives them a rank on the list
2034 of either 1 or highest current rank + 1
2035
2036 =back
2037
2038 =cut
2039
2040 sub addroutingmember {
2041     my ( $borrowernumber, $subscriptionid ) = @_;
2042     my $rank;
2043     my $dbh = C4::Context->dbh;
2044     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2045     $sth->execute($subscriptionid);
2046     while ( my $line = $sth->fetchrow_hashref ) {
2047         if ( $line->{'rank'} > 0 ) {
2048             $rank = $line->{'rank'} + 1;
2049         } else {
2050             $rank = 1;
2051         }
2052     }
2053     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2054     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2055 }
2056
2057 =head2 reorder_members
2058
2059 =over 4
2060
2061 &reorder_members($subscriptionid,$routingid,$rank)
2062
2063 this function is used to reorder the routing list
2064
2065 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2066 - it gets all members on list puts their routingid's into an array
2067 - removes the one in the array that is $routingid
2068 - then reinjects $routingid at point indicated by $rank
2069 - then update the database with the routingids in the new order
2070
2071 =back
2072
2073 =cut
2074
2075 sub reorder_members {
2076     my ( $subscriptionid, $routingid, $rank ) = @_;
2077     my $dbh = C4::Context->dbh;
2078     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2079     $sth->execute($subscriptionid);
2080     my @result;
2081     while ( my $line = $sth->fetchrow_hashref ) {
2082         push( @result, $line->{'routingid'} );
2083     }
2084
2085     # To find the matching index
2086     my $i;
2087     my $key = -1;    # to allow for 0 being a valid response
2088     for ( $i = 0 ; $i < @result ; $i++ ) {
2089         if ( $routingid == $result[$i] ) {
2090             $key = $i;    # save the index
2091             last;
2092         }
2093     }
2094
2095     # if index exists in array then move it to new position
2096     if ( $key > -1 && $rank > 0 ) {
2097         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
2098         my $moving_item = splice( @result, $key, 1 );
2099         splice( @result, $new_rank, 0, $moving_item );
2100     }
2101     for ( my $j = 0 ; $j < @result ; $j++ ) {
2102         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2103         $sth->execute;
2104     }
2105 }
2106
2107 =head2 delroutingmember
2108
2109 =over 4
2110
2111 &delroutingmember($routingid,$subscriptionid)
2112
2113 this function either deletes one member from routing list if $routingid exists otherwise
2114 deletes all members from the routing list
2115
2116 =back
2117
2118 =cut
2119
2120 sub delroutingmember {
2121
2122     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2123     my ( $routingid, $subscriptionid ) = @_;
2124     my $dbh = C4::Context->dbh;
2125     if ($routingid) {
2126         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2127         $sth->execute($routingid);
2128         reorder_members( $subscriptionid, $routingid );
2129     } else {
2130         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2131         $sth->execute($subscriptionid);
2132     }
2133 }
2134
2135 =head2 getroutinglist
2136
2137 =over 4
2138
2139 ($count,@routinglist) = &getroutinglist($subscriptionid)
2140
2141 this gets the info from the subscriptionroutinglist for $subscriptionid
2142
2143 return :
2144 a count of the number of members on routinglist
2145 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2146 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2147
2148 =back
2149
2150 =cut
2151
2152 sub getroutinglist {
2153     my ($subscriptionid) = @_;
2154     my $dbh              = C4::Context->dbh;
2155     my $sth              = $dbh->prepare(
2156         "SELECT routingid, borrowernumber, ranking, biblionumber
2157             FROM subscription
2158             LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2159             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2160                               "
2161     );
2162     $sth->execute($subscriptionid);
2163     my @routinglist;
2164     my $count = 0;
2165     while ( my $line = $sth->fetchrow_hashref ) {
2166         $count++;
2167         push( @routinglist, $line );
2168     }
2169     return ( $count, @routinglist );
2170 }
2171
2172 =head2 countissuesfrom
2173
2174 =over 4
2175
2176 $result = &countissuesfrom($subscriptionid,$startdate)
2177
2178
2179 =back
2180
2181 =cut
2182
2183 sub countissuesfrom {
2184     my ( $subscriptionid, $startdate ) = @_;
2185     my $dbh   = C4::Context->dbh;
2186     my $query = qq|
2187             SELECT count(*)
2188             FROM   serial
2189             WHERE  subscriptionid=?
2190             AND serial.publisheddate>?
2191         |;
2192     my $sth = $dbh->prepare($query);
2193     $sth->execute( $subscriptionid, $startdate );
2194     my ($countreceived) = $sth->fetchrow;
2195     return $countreceived;
2196 }
2197
2198 =head2 CountIssues
2199
2200 =over 4
2201
2202 $result = &CountIssues($subscriptionid)
2203
2204
2205 =back
2206
2207 =cut
2208
2209 sub CountIssues {
2210     my ($subscriptionid) = @_;
2211     my $dbh              = C4::Context->dbh;
2212     my $query            = qq|
2213             SELECT count(*)
2214             FROM   serial
2215             WHERE  subscriptionid=?
2216         |;
2217     my $sth = $dbh->prepare($query);
2218     $sth->execute($subscriptionid);
2219     my ($countreceived) = $sth->fetchrow;
2220     return $countreceived;
2221 }
2222
2223 =head2 HasItems
2224
2225 =over 4
2226
2227 $result = &HasItems($subscriptionid)
2228
2229
2230 =back
2231
2232 =cut
2233
2234 sub HasItems {
2235     my ($subscriptionid) = @_;
2236     my $dbh              = C4::Context->dbh;
2237     my $query = qq|
2238             SELECT COUNT(serialitems.itemnumber)
2239             FROM   serial
2240                         LEFT JOIN serialitems USING(serialid)
2241             WHERE  subscriptionid=? AND serialitems.serialid NOT NULL
2242         |;
2243     my $sth=$dbh->prepare($query);
2244     $sth->execute($subscriptionid);
2245     my ($countitems)=$sth->fetchrow;
2246     return $countitems;
2247 }
2248
2249 =head2 abouttoexpire
2250
2251 =over 4
2252
2253 $result = &abouttoexpire($subscriptionid)
2254
2255 this function alerts you to the penultimate issue for a serial subscription
2256
2257 returns 1 - if this is the penultimate issue
2258 returns 0 - if not
2259
2260 =back
2261
2262 =cut
2263
2264 sub abouttoexpire {
2265     my ($subscriptionid) = @_;
2266     my $dbh              = C4::Context->dbh;
2267     my $subscription     = GetSubscription($subscriptionid);
2268     my $per              = $subscription->{'periodicity'};
2269     if ( $per % 16 > 0 ) {
2270         my $expirationdate = $subscription->{enddate};
2271         my $sth            = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?");
2272         $sth->execute($subscriptionid);
2273         my ($res) = $sth->fetchrow;
2274         my @res = split( /-/, $res );
2275         @res = Date::Calc::Today if ( $res[0] * $res[1] == 0 );
2276         my @endofsubscriptiondate = split( /-/, $expirationdate );
2277         my $x;
2278         if ( $per == 1 ) { $x = 7; }
2279         if ( $per == 2 ) { $x = 7; }
2280         if ( $per == 3 ) { $x = 14; }
2281         if ( $per == 4 ) { $x = 21; }
2282         if ( $per == 5 ) { $x = 31; }
2283         if ( $per == 6 ) { $x = 62; }
2284         if ( $per == 7 || $per == 8 ) { $x = 93; }
2285         if ( $per == 9 )  { $x = 190; }
2286         if ( $per == 10 ) { $x = 365; }
2287         if ( $per == 11 ) { $x = 730; }
2288         my @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2], -( 3 * $x ) )
2289           if ( @endofsubscriptiondate && $endofsubscriptiondate[0] * $endofsubscriptiondate[1] * $endofsubscriptiondate[2] );
2290
2291         # warn "DATE BEFORE END: $datebeforeend";
2292         return 1
2293           if (
2294             @res
2295             && ( @datebeforeend
2296                 && Delta_Days( $res[0], $res[1], $res[2], $datebeforeend[0], $datebeforeend[1], $datebeforeend[2] ) <= 0 )
2297             && ( @endofsubscriptiondate
2298                 && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) >= 0 )
2299           );
2300         return 0;
2301     } elsif ( $subscription->{numberlength} > 0 ) {
2302         return ( countissuesfrom( $subscriptionid, $subscription->{'startdate'} ) >= $subscription->{numberlength} - 1 );
2303     } else {
2304         return 0;
2305     }
2306 }
2307
2308 =head2 GetNextDate
2309
2310 ($resultdate) = &GetNextDate($planneddate,$subscription)
2311
2312 this function is an extension of GetNextDate which allows for checking for irregularity
2313
2314 it takes the planneddate and will return the next issue's date and will skip dates if there
2315 exists an irregularity
2316 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2317 skipped then the returned date will be 2007-05-10
2318
2319 return :
2320 $resultdate - then next date in the sequence
2321
2322 Return 0 if periodicity==0
2323
2324 =cut
2325
2326 sub in_array {    # used in next sub down
2327     my ( $val, @elements ) = @_;
2328     foreach my $elem (@elements) {
2329         if ( $val == $elem ) {
2330             return 1;
2331         }
2332     }
2333     return 0;
2334 }
2335
2336 sub GetNextDate(@) {
2337     my ( $planneddate, $subscription ) = @_;
2338     my @irreg = split( /\,/, $subscription->{irregularity} );
2339
2340     #date supposed to be in ISO.
2341
2342     my ( $year, $month, $day ) = split( /-/, $planneddate );
2343     $month = 1 unless ($month);
2344     $day   = 1 unless ($day);
2345     my @resultdate;
2346
2347     #       warn "DOW $dayofweek";
2348     if ( $subscription->{periodicity} % 16 == 0 ) {    # 'without regularity' || 'irregular'
2349         return 0;
2350     }
2351
2352     #   daily : n / week
2353     #   Since we're interpreting irregularity here as which days of the week to skip an issue,
2354     #   renaming this pattern from 1/day to " n / week ".
2355     if ( $subscription->{periodicity} == 1 ) {
2356         my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2357         if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2358         else {
2359             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2360                 $dayofweek = 0 if ( $dayofweek == 7 );
2361                 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2362                     ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2363                     $dayofweek++;
2364                 }
2365             }
2366             @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2367         }
2368     }
2369
2370     #   1  week
2371     if ( $subscription->{periodicity} == 2 ) {
2372         my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2373         if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2374         else {
2375             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2376
2377                 #FIXME: if two consecutive irreg, do we only skip one?
2378                 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2379                     ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2380                     $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2381                 }
2382             }
2383             @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2384         }
2385     }
2386
2387     #   1 / 2 weeks
2388     if ( $subscription->{periodicity} == 3 ) {
2389         my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2390         if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2391         else {
2392             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2393                 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2394                     ### BUGFIX was previously +1 ^
2395                     ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2396                     $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2397                 }
2398             }
2399             @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2400         }
2401     }
2402
2403     #   1 / 3 weeks
2404     if ( $subscription->{periodicity} == 4 ) {
2405         my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2406         if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2407         else {
2408             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2409                 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2410                     ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2411                     $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2412                 }
2413             }
2414             @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2415         }
2416     }
2417     my $tmpmonth = $month;
2418     if ( $year && $month && $day ) {
2419         if ( $subscription->{periodicity} == 5 ) {
2420             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2421                 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2422                     ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2423                     $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2424                 }
2425             }
2426             @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2427         }
2428         if ( $subscription->{periodicity} == 6 ) {
2429             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2430                 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2431                     ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2432                     $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2433                 }
2434             }
2435             @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2436         }
2437         if ( $subscription->{periodicity} == 7 ) {
2438             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2439                 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2440                     ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2441                     $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2442                 }
2443             }
2444             @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2445         }
2446         if ( $subscription->{periodicity} == 8 ) {
2447             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2448                 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2449                     ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2450                     $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2451                 }
2452             }
2453             @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2454         }
2455         if ( $subscription->{periodicity} == 9 ) {
2456             for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2457                 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2458                     ### BUFIX Seems to need more Than One ?
2459                     ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2460                     $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2461                 }
2462             }
2463             @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2464         }
2465         if ( $subscription->{periodicity} == 10 ) {
2466             @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2467         }
2468         if ( $subscription->{periodicity} == 11 ) {
2469             @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2470         }
2471     }
2472     my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2473
2474     return "$resultdate";
2475 }
2476
2477 =head2 itemdata
2478
2479   $item = &itemdata($barcode);
2480
2481 Looks up the item with the given barcode, and returns a
2482 reference-to-hash containing information about that item. The keys of
2483 the hash are the fields from the C<items> and C<biblioitems> tables in
2484 the Koha database.
2485
2486 =cut
2487
2488 #'
2489 sub itemdata {
2490     my ($barcode) = @_;
2491     my $dbh       = C4::Context->dbh;
2492     my $sth       = $dbh->prepare(
2493         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2494         WHERE barcode=?"
2495     );
2496     $sth->execute($barcode);
2497     my $data = $sth->fetchrow_hashref;
2498     $sth->finish;
2499     return ($data);
2500 }
2501
2502 1;
2503 __END__
2504
2505 =head1 AUTHOR
2506
2507 Koha Developement team <info@koha.org>
2508
2509 =cut