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