C4/Serials.pm

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