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