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="00-00-0000",serial.planneddate,serial.publisheddate)) 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="00-00-0000",serial.planneddate,serial.publisheddate) 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="00-00-0000",serial.planneddate,serial.publisheddate)) 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="00-00-0000",serial.planneddate,serial.publisheddate) 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<>'0000-00-00',publisheddate,planneddate) 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<>'0000-00-00',publisheddate,planneddate) 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         NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $notes, $routingnotes );
1165         # check if an alert must be sent... (= a letter is defined & status became "arrived"
1166         if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1167             require C4::Letters;
1168             C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1169         }
1170     }
1171
1172     return;
1173 }
1174
1175 =head2 GetNextExpected
1176
1177 $nextexpected = GetNextExpected($subscriptionid)
1178
1179 Get the planneddate for the current expected issue of the subscription.
1180
1181 returns a hashref:
1182
1183 $nextexepected = {
1184     serialid => int
1185     planneddate => ISO date
1186     }
1187
1188 =cut
1189
1190 sub GetNextExpected {
1191     my ($subscriptionid) = @_;
1192
1193     my $dbh = C4::Context->dbh;
1194     my $query = qq{
1195         SELECT *
1196         FROM serial
1197         WHERE subscriptionid = ?
1198           AND status = ?
1199         LIMIT 1
1200     };
1201     my $sth = $dbh->prepare($query);
1202
1203     # Each subscription has only one 'expected' issue.
1204     $sth->execute( $subscriptionid, EXPECTED );
1205     my $nextissue = $sth->fetchrow_hashref;
1206     if ( !$nextissue ) {
1207         $query = qq{
1208             SELECT *
1209             FROM serial
1210             WHERE subscriptionid = ?
1211             ORDER BY publisheddate DESC
1212             LIMIT 1
1213         };
1214         $sth = $dbh->prepare($query);
1215         $sth->execute($subscriptionid);
1216         $nextissue = $sth->fetchrow_hashref;
1217     }
1218     foreach(qw/planneddate publisheddate/) {
1219         if ( !defined $nextissue->{$_} ) {
1220             # or should this default to 1st Jan ???
1221             $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1222         }
1223         $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1224                          ? $nextissue->{$_}
1225                          : undef;
1226     }
1227
1228     return $nextissue;
1229 }
1230
1231 =head2 ModNextExpected
1232
1233 ModNextExpected($subscriptionid,$date)
1234
1235 Update the planneddate for the current expected issue of the subscription.
1236 This will modify all future prediction results.
1237
1238 C<$date> is an ISO date.
1239
1240 returns 0
1241
1242 =cut
1243
1244 sub ModNextExpected {
1245     my ( $subscriptionid, $date ) = @_;
1246     my $dbh = C4::Context->dbh;
1247
1248     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1249     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1250
1251     # Each subscription has only one 'expected' issue.
1252     $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1253     return 0;
1254
1255 }
1256
1257 =head2 GetSubscriptionIrregularities
1258
1259 =over 4
1260
1261 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1262 get the list of irregularities for a subscription
1263
1264 =back
1265
1266 =cut
1267
1268 sub GetSubscriptionIrregularities {
1269     my $subscriptionid = shift;
1270
1271     return unless $subscriptionid;
1272
1273     my $dbh = C4::Context->dbh;
1274     my $query = qq{
1275         SELECT irregularity
1276         FROM subscription
1277         WHERE subscriptionid = ?
1278     };
1279     my $sth = $dbh->prepare($query);
1280     $sth->execute($subscriptionid);
1281
1282     my ($result) = $sth->fetchrow_array;
1283     my @irreg = split /;/, $result;
1284
1285     return @irreg;
1286 }
1287
1288 =head2 ModSubscription
1289
1290 this function modifies a subscription. Put all new values on input args.
1291 returns the number of rows affected
1292
1293 =cut
1294
1295 sub ModSubscription {
1296     my (
1297     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1298     $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1299     $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1300     $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1301     $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1302     $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1303     $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1304     $itemtype, $previousitemtype, $mana_id
1305     ) = @_;
1306
1307     my $dbh   = C4::Context->dbh;
1308     my $query = "UPDATE subscription
1309         SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1310             startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1311             numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1312             lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1313             lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1314             callnumber=?, notes=?, letter=?, manualhistory=?,
1315             internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1316             opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1317             skip_serialseq=?, itemtype=?, previousitemtype=?, mana_id=?
1318         WHERE subscriptionid = ?";
1319
1320     my $sth = $dbh->prepare($query);
1321     $sth->execute(
1322         $auser,           $branchcode,     $aqbooksellerid, $cost,
1323         $aqbudgetid,      $startdate,      $periodicity,    $firstacquidate,
1324         $irregularity,    $numberpattern,  $locale,         $numberlength,
1325         $weeklength,      $monthlength,    $lastvalue1,     $innerloop1,
1326         $lastvalue2,      $innerloop2,     $lastvalue3,     $innerloop3,
1327         $status,          $biblionumber,   $callnumber,     $notes,
1328         $letter,          ($manualhistory ? $manualhistory : 0),
1329         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1330         $graceperiod,     $location,       $enddate,        $skip_serialseq,
1331         $itemtype,        $previousitemtype, $mana_id,
1332         $subscriptionid
1333     );
1334     my $rows = $sth->rows;
1335
1336     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1337     return $rows;
1338 }
1339
1340 =head2 NewSubscription
1341
1342 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1343     $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1344     $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1345     $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1346     $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1347     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1348     $skip_serialseq, $itemtype, $previousitemtype);
1349
1350 Create a new subscription with value given on input args.
1351
1352 return :
1353 the id of this new subscription
1354
1355 =cut
1356
1357 sub NewSubscription {
1358     my (
1359     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1360     $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1361     $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1362     $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1363     $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1364     $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1365     $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1366     ) = @_;
1367     my $dbh = C4::Context->dbh;
1368
1369     my $subscription = Koha::Subscription->new(
1370         {
1371             librarian         => $auser,
1372             branchcode        => $branchcode,
1373             aqbooksellerid    => $aqbooksellerid,
1374             cost              => $cost,
1375             aqbudgetid        => $aqbudgetid,
1376             biblionumber      => $biblionumber,
1377             startdate         => $startdate,
1378             periodicity       => $periodicity,
1379             numberlength      => $numberlength,
1380             weeklength        => $weeklength,
1381             monthlength       => $monthlength,
1382             lastvalue1        => $lastvalue1,
1383             innerloop1        => $innerloop1,
1384             lastvalue2        => $lastvalue2,
1385             innerloop2        => $innerloop2,
1386             lastvalue3        => $lastvalue3,
1387             innerloop3        => $innerloop3,
1388             status            => $status,
1389             notes             => $notes,
1390             letter            => $letter,
1391             firstacquidate    => $firstacquidate,
1392             irregularity      => $irregularity,
1393             numberpattern     => $numberpattern,
1394             locale            => $locale,
1395             callnumber        => $callnumber,
1396             manualhistory     => $manualhistory,
1397             internalnotes     => $internalnotes,
1398             serialsadditems   => $serialsadditems,
1399             staffdisplaycount => $staffdisplaycount,
1400             opacdisplaycount  => $opacdisplaycount,
1401             graceperiod       => $graceperiod,
1402             location          => $location,
1403             enddate           => $enddate,
1404             skip_serialseq    => $skip_serialseq,
1405             itemtype          => $itemtype,
1406             previousitemtype  => $previousitemtype,
1407             mana_id           => $mana_id,
1408         }
1409     )->store;
1410     $subscription->discard_changes;
1411     my $subscriptionid = $subscription->subscriptionid;
1412     my ( $query, $sth );
1413     unless ($enddate) {
1414         $enddate = GetExpirationDate( $subscriptionid, $startdate );
1415         $query = qq|
1416             UPDATE subscription
1417             SET    enddate=?
1418             WHERE  subscriptionid=?
1419         |;
1420         $sth = $dbh->prepare($query);
1421         $sth->execute( $enddate, $subscriptionid );
1422     }
1423
1424     # then create the 1st expected number
1425     $query = qq(
1426         INSERT INTO subscriptionhistory
1427             (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1428         VALUES (?,?,?, '', '')
1429         );
1430     $sth = $dbh->prepare($query);
1431     $sth->execute( $biblionumber, $subscriptionid, $startdate);
1432
1433     # reread subscription to get a hash (for calculation of the 1st issue number)
1434     $subscription = GetSubscription($subscriptionid); # We should not do that
1435     my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1436
1437     # calculate issue number
1438     my $serialseq = GetSeq($subscription, $pattern) || q{};
1439
1440     Koha::Serial->new(
1441         {
1442             serialseq      => $serialseq,
1443             serialseq_x    => $subscription->{'lastvalue1'},
1444             serialseq_y    => $subscription->{'lastvalue2'},
1445             serialseq_z    => $subscription->{'lastvalue3'},
1446             subscriptionid => $subscriptionid,
1447             biblionumber   => $biblionumber,
1448             status         => EXPECTED,
1449             planneddate    => $firstacquidate,
1450             publisheddate  => $firstacquidate,
1451         }
1452     )->store();
1453
1454     logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1455
1456     #set serial flag on biblio if not already set.
1457     my $biblio = Koha::Biblios->find( $biblionumber );
1458     if ( $biblio and !$biblio->serial ) {
1459         my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1460         my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1461         if ($tag) {
1462             eval { $record->field($tag)->update( $subf => 1 ); };
1463         }
1464         ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1465     }
1466     return $subscriptionid;
1467 }
1468
1469 =head2 ReNewSubscription
1470
1471 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1472
1473 this function renew a subscription with values given on input args.
1474
1475 =cut
1476
1477 sub ReNewSubscription {
1478     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1479     my $dbh          = C4::Context->dbh;
1480     my $subscription = GetSubscription($subscriptionid);
1481     my $query        = qq|
1482          SELECT *
1483          FROM   biblio
1484          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1485          WHERE    biblio.biblionumber=?
1486      |;
1487     my $sth = $dbh->prepare($query);
1488     $sth->execute( $subscription->{biblionumber} );
1489     my $biblio = $sth->fetchrow_hashref;
1490
1491     if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1492         require C4::Suggestions;
1493         C4::Suggestions::NewSuggestion(
1494             {   'suggestedby'   => $user,
1495                 'title'         => $subscription->{bibliotitle},
1496                 'author'        => $biblio->{author},
1497                 'publishercode' => $biblio->{publishercode},
1498                 'note'          => $biblio->{note},
1499                 'biblionumber'  => $subscription->{biblionumber}
1500             }
1501         );
1502     }
1503
1504     $numberlength ||= 0; # Should not we raise an exception instead?
1505     $weeklength   ||= 0;
1506
1507     # renew subscription
1508     $query = qq|
1509         UPDATE subscription
1510         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1511         WHERE  subscriptionid=?
1512     |;
1513     $sth = $dbh->prepare($query);
1514     $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1515     my $enddate = GetExpirationDate($subscriptionid);
1516         $debug && warn "enddate :$enddate";
1517     $query = qq|
1518         UPDATE subscription
1519         SET    enddate=?
1520         WHERE  subscriptionid=?
1521     |;
1522     $sth = $dbh->prepare($query);
1523     $sth->execute( $enddate, $subscriptionid );
1524
1525     logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1526     return;
1527 }
1528
1529 =head2 NewIssue
1530
1531 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1532
1533 Create a new issue stored on the database.
1534 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1535 returns the serial id
1536
1537 =cut
1538
1539 sub NewIssue {
1540     my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1541         $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1542     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1543
1544     return unless ($subscriptionid);
1545
1546     my $schema = Koha::Database->new()->schema();
1547
1548     my $subscription = Koha::Subscriptions->find( $subscriptionid );
1549
1550     my $serial = Koha::Serial->new(
1551         {
1552             serialseq         => $serialseq,
1553             serialseq_x       => $subscription->lastvalue1(),
1554             serialseq_y       => $subscription->lastvalue2(),
1555             serialseq_z       => $subscription->lastvalue3(),
1556             subscriptionid    => $subscriptionid,
1557             biblionumber      => $biblionumber,
1558             status            => $status,
1559             planneddate       => $planneddate,
1560             publisheddate     => $publisheddate,
1561             publisheddatetext => $publisheddatetext,
1562             notes             => $notes,
1563             routingnotes      => $routingnotes
1564         }
1565     )->store();
1566
1567     my $serialid = $serial->id();
1568
1569     my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1570     my $missinglist = $subscription_history->missinglist();
1571     my $recievedlist = $subscription_history->recievedlist();
1572
1573     if ( $status == ARRIVED ) {
1574         ### TODO Add a feature that improves recognition and description.
1575         ### As such count (serialseq) i.e. : N18,2(N19),N20
1576         ### Would use substr and index But be careful to previous presence of ()
1577         $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1578     }
1579     if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1580         $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1581     }
1582
1583     $recievedlist =~ s/^; //;
1584     $missinglist  =~ s/^; //;
1585
1586     $subscription_history->recievedlist($recievedlist);
1587     $subscription_history->missinglist($missinglist);
1588     $subscription_history->store();
1589
1590     return $serialid;
1591 }
1592
1593 =head2 HasSubscriptionStrictlyExpired
1594
1595 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1596
1597 the subscription has stricly expired when today > the end subscription date
1598
1599 return :
1600 1 if true, 0 if false, -1 if the expiration date is not set.
1601
1602 =cut
1603
1604 sub HasSubscriptionStrictlyExpired {
1605
1606     # Getting end of subscription date
1607     my ($subscriptionid) = @_;
1608
1609     return unless ($subscriptionid);
1610
1611     my $dbh              = C4::Context->dbh;
1612     my $subscription     = GetSubscription($subscriptionid);
1613     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1614
1615     # If the expiration date is set
1616     if ( $expirationdate != 0 ) {
1617         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1618
1619         # Getting today's date
1620         my ( $nowyear, $nowmonth, $nowday ) = Today();
1621
1622         # if today's date > expiration date, then the subscription has stricly expired
1623         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1624             return 1;
1625         } else {
1626             return 0;
1627         }
1628     } else {
1629
1630         # There are some cases where the expiration date is not set
1631         # As we can't determine if the subscription has expired on a date-basis,
1632         # we return -1;
1633         return -1;
1634     }
1635 }
1636
1637 =head2 HasSubscriptionExpired
1638
1639 $has_expired = HasSubscriptionExpired($subscriptionid)
1640
1641 the subscription has expired when the next issue to arrive is out of subscription limit.
1642
1643 return :
1644 0 if the subscription has not expired
1645 1 if the subscription has expired
1646 2 if has subscription does not have a valid expiration date set
1647
1648 =cut
1649
1650 sub HasSubscriptionExpired {
1651     my ($subscriptionid) = @_;
1652
1653     return unless ($subscriptionid);
1654
1655     my $dbh              = C4::Context->dbh;
1656     my $subscription     = GetSubscription($subscriptionid);
1657     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1658     if ( $frequency and $frequency->{unit} ) {
1659         my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1660         if (!defined $expirationdate) {
1661             $expirationdate = q{};
1662         }
1663         my $query          = qq|
1664             SELECT max(planneddate)
1665             FROM   serial
1666             WHERE  subscriptionid=?
1667       |;
1668         my $sth = $dbh->prepare($query);
1669         $sth->execute($subscriptionid);
1670         my ($res) = $sth->fetchrow;
1671         if (!$res || $res=~m/^0000/) {
1672             return 0;
1673         }
1674         my @res                   = split( /-/, $res );
1675         my @endofsubscriptiondate = split( /-/, $expirationdate );
1676         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1677         return 1
1678           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1679             || ( !$res ) );
1680         return 0;
1681     } else {
1682         # Irregular
1683         if ( $subscription->{'numberlength'} ) {
1684             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1685             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1686             return 0;
1687         } else {
1688             return 0;
1689         }
1690     }
1691     return 0;    # Notice that you'll never get here.
1692 }
1693
1694 =head2 DelSubscription
1695
1696 DelSubscription($subscriptionid)
1697 this function deletes subscription which has $subscriptionid as id.
1698
1699 =cut
1700
1701 sub DelSubscription {
1702     my ($subscriptionid) = @_;
1703     my $dbh = C4::Context->dbh;
1704     $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1705     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1706     $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1707
1708     Koha::AdditionalFieldValues->search({
1709         'field.tablename' => 'subscription',
1710         'me.record_id' => $subscriptionid,
1711     }, { join => 'field' })->delete;
1712
1713     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1714 }
1715
1716 =head2 DelIssue
1717
1718 DelIssue($serialseq,$subscriptionid)
1719 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1720
1721 returns the number of rows affected
1722
1723 =cut
1724
1725 sub DelIssue {
1726     my ($dataissue) = @_;
1727     my $dbh = C4::Context->dbh;
1728     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1729
1730     my $query = qq|
1731         DELETE FROM serial
1732         WHERE       serialid= ?
1733         AND         subscriptionid= ?
1734     |;
1735     my $mainsth = $dbh->prepare($query);
1736     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1737
1738     #Delete element from subscription history
1739     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1740     my $sth = $dbh->prepare($query);
1741     $sth->execute( $dataissue->{'subscriptionid'} );
1742     my $val = $sth->fetchrow_hashref;
1743     unless ( $val->{manualhistory} ) {
1744         my $query = qq|
1745           SELECT * FROM subscriptionhistory
1746           WHERE       subscriptionid= ?
1747       |;
1748         my $sth = $dbh->prepare($query);
1749         $sth->execute( $dataissue->{'subscriptionid'} );
1750         my $data      = $sth->fetchrow_hashref;
1751         my $serialseq = $dataissue->{'serialseq'};
1752         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1753         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1754         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1755         $sth = $dbh->prepare($strsth);
1756         $sth->execute( $dataissue->{'subscriptionid'} );
1757     }
1758
1759     return $mainsth->rows;
1760 }
1761
1762 =head2 GetLateOrMissingIssues
1763
1764 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1765
1766 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1767
1768 return :
1769 the issuelist as an array of hash refs. Each element of this array contains
1770 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1771
1772 =cut
1773
1774 sub GetLateOrMissingIssues {
1775     my ( $supplierid, $serialid, $order ) = @_;
1776
1777     return unless ( $supplierid or $serialid );
1778
1779     my $dbh = C4::Context->dbh;
1780
1781     my $sth;
1782     my $byserial = '';
1783     if ($serialid) {
1784         $byserial = "and serialid = " . $serialid;
1785     }
1786     if ($order) {
1787         $order .= ", title";
1788     } else {
1789         $order = "title";
1790     }
1791     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1792     if ($supplierid) {
1793         $sth = $dbh->prepare(
1794             "SELECT
1795                 serialid,      aqbooksellerid,        name,
1796                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1797                 serial.status, serial.subscriptionid, claimdate, claims_count,
1798                 subscription.branchcode
1799             FROM      serial
1800                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1801                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1802                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1803                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1804                 WHERE subscription.subscriptionid = serial.subscriptionid
1805                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1806                 AND subscription.aqbooksellerid=$supplierid
1807                 $byserial
1808                 ORDER BY $order"
1809         );
1810     } else {
1811         $sth = $dbh->prepare(
1812             "SELECT
1813             serialid,      aqbooksellerid,         name,
1814             biblio.title,  planneddate,           serialseq,
1815                 serial.status, serial.subscriptionid, claimdate, claims_count,
1816                 subscription.branchcode
1817             FROM serial
1818                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1819                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1820                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1821                 WHERE subscription.subscriptionid = serial.subscriptionid
1822                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1823                 $byserial
1824                 ORDER BY $order"
1825         );
1826     }
1827     $sth->execute( EXPECTED, LATE, CLAIMED );
1828     my @issuelist;
1829     while ( my $line = $sth->fetchrow_hashref ) {
1830
1831         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1832             $line->{planneddateISO} = $line->{planneddate};
1833             $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1834         }
1835         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1836             $line->{claimdateISO} = $line->{claimdate};
1837             $line->{claimdate}   = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1838         }
1839         $line->{"status".$line->{status}}   = 1;
1840
1841         my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1842         $line->{additional_fields} = { map { $_->field->name => $_->value }
1843             $subscription_object->additional_field_values->as_list };
1844
1845         push @issuelist, $line;
1846     }
1847     return @issuelist;
1848 }
1849
1850 =head2 updateClaim
1851
1852 &updateClaim($serialid)
1853
1854 this function updates the time when a claim is issued for late/missing items
1855
1856 called from claims.pl file
1857
1858 =cut
1859
1860 sub updateClaim {
1861     my ($serialids) = @_;
1862     return unless $serialids;
1863     unless ( ref $serialids ) {
1864         $serialids = [ $serialids ];
1865     }
1866     my $dbh = C4::Context->dbh;
1867     return $dbh->do(q|
1868         UPDATE serial
1869         SET claimdate = NOW(),
1870             claims_count = claims_count + 1,
1871             status = ?
1872         WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1873         {}, CLAIMED, @$serialids );
1874 }
1875
1876 =head2 check_routing
1877
1878 $result = &check_routing($subscriptionid)
1879
1880 this function checks to see if a serial has a routing list and returns the count of routingid
1881 used to show either an 'add' or 'edit' link
1882
1883 =cut
1884
1885 sub check_routing {
1886     my ($subscriptionid) = @_;
1887
1888     return unless ($subscriptionid);
1889
1890     my $dbh              = C4::Context->dbh;
1891     my $sth              = $dbh->prepare(
1892         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1893                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1894                               WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1895                               "
1896     );
1897     $sth->execute($subscriptionid);
1898     my $line   = $sth->fetchrow_hashref;
1899     my $result = $line->{'routingids'};
1900     return $result;
1901 }
1902
1903 =head2 addroutingmember
1904
1905 addroutingmember($borrowernumber,$subscriptionid)
1906
1907 this function takes a borrowernumber and subscriptionid and adds the member to the
1908 routing list for that serial subscription and gives them a rank on the list
1909 of either 1 or highest current rank + 1
1910
1911 =cut
1912
1913 sub addroutingmember {
1914     my ( $borrowernumber, $subscriptionid ) = @_;
1915
1916     return unless ($borrowernumber and $subscriptionid);
1917
1918     my $rank;
1919     my $dbh = C4::Context->dbh;
1920     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1921     $sth->execute($subscriptionid);
1922     while ( my $line = $sth->fetchrow_hashref ) {
1923         if ( $line->{'rank'} > 0 ) {
1924             $rank = $line->{'rank'} + 1;
1925         } else {
1926             $rank = 1;
1927         }
1928     }
1929     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1930     $sth->execute( $subscriptionid, $borrowernumber, $rank );
1931 }
1932
1933 =head2 reorder_members
1934
1935 reorder_members($subscriptionid,$routingid,$rank)
1936
1937 this function is used to reorder the routing list
1938
1939 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1940 - it gets all members on list puts their routingid's into an array
1941 - removes the one in the array that is $routingid
1942 - then reinjects $routingid at point indicated by $rank
1943 - then update the database with the routingids in the new order
1944
1945 =cut
1946
1947 sub reorder_members {
1948     my ( $subscriptionid, $routingid, $rank ) = @_;
1949     my $dbh = C4::Context->dbh;
1950     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1951     $sth->execute($subscriptionid);
1952     my @result;
1953     while ( my $line = $sth->fetchrow_hashref ) {
1954         push( @result, $line->{'routingid'} );
1955     }
1956
1957     # To find the matching index
1958     my $i;
1959     my $key = -1;    # to allow for 0 being a valid response
1960     for ( $i = 0 ; $i < @result ; $i++ ) {
1961         if ( $routingid == $result[$i] ) {
1962             $key = $i;    # save the index
1963             last;
1964         }
1965     }
1966
1967     # if index exists in array then move it to new position
1968     if ( $key > -1 && $rank > 0 ) {
1969         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
1970         my $moving_item = splice( @result, $key, 1 );
1971         splice( @result, $new_rank, 0, $moving_item );
1972     }
1973     for ( my $j = 0 ; $j < @result ; $j++ ) {
1974         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1975         $sth->execute;
1976     }
1977     return;
1978 }
1979
1980 =head2 delroutingmember
1981
1982 delroutingmember($routingid,$subscriptionid)
1983
1984 this function either deletes one member from routing list if $routingid exists otherwise
1985 deletes all members from the routing list
1986
1987 =cut
1988
1989 sub delroutingmember {
1990
1991     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1992     my ( $routingid, $subscriptionid ) = @_;
1993     my $dbh = C4::Context->dbh;
1994     if ($routingid) {
1995         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1996         $sth->execute($routingid);
1997         reorder_members( $subscriptionid, $routingid );
1998     } else {
1999         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2000         $sth->execute($subscriptionid);
2001     }
2002     return;
2003 }
2004
2005 =head2 getroutinglist
2006
2007 @routinglist = getroutinglist($subscriptionid)
2008
2009 this gets the info from the subscriptionroutinglist for $subscriptionid
2010
2011 return :
2012 the routinglist as an array. Each element of the array contains a hash_ref containing
2013 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2014
2015 =cut
2016
2017 sub getroutinglist {
2018     my ($subscriptionid) = @_;
2019     my $dbh              = C4::Context->dbh;
2020     my $sth              = $dbh->prepare(
2021         'SELECT routingid, borrowernumber, ranking, biblionumber
2022             FROM subscription
2023             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2024             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2025     );
2026     $sth->execute($subscriptionid);
2027     my $routinglist = $sth->fetchall_arrayref({});
2028     return @{$routinglist};
2029 }
2030
2031 =head2 countissuesfrom
2032
2033 $result = countissuesfrom($subscriptionid,$startdate)
2034
2035 Returns a count of serial rows matching the given subsctiptionid
2036 with published date greater than startdate
2037
2038 =cut
2039
2040 sub countissuesfrom {
2041     my ( $subscriptionid, $startdate ) = @_;
2042     my $dbh   = C4::Context->dbh;
2043     my $query = qq|
2044             SELECT count(*)
2045             FROM   serial
2046             WHERE  subscriptionid=?
2047             AND serial.publisheddate>?
2048         |;
2049     my $sth = $dbh->prepare($query);
2050     $sth->execute( $subscriptionid, $startdate );
2051     my ($countreceived) = $sth->fetchrow;
2052     return $countreceived;
2053 }
2054
2055 =head2 CountIssues
2056
2057 $result = CountIssues($subscriptionid)
2058
2059 Returns a count of serial rows matching the given subsctiptionid
2060
2061 =cut
2062
2063 sub CountIssues {
2064     my ($subscriptionid) = @_;
2065     my $dbh              = C4::Context->dbh;
2066     my $query            = qq|
2067             SELECT count(*)
2068             FROM   serial
2069             WHERE  subscriptionid=?
2070         |;
2071     my $sth = $dbh->prepare($query);
2072     $sth->execute($subscriptionid);
2073     my ($countreceived) = $sth->fetchrow;
2074     return $countreceived;
2075 }
2076
2077 =head2 HasItems
2078
2079 $result = HasItems($subscriptionid)
2080
2081 returns a count of items from serial matching the subscriptionid
2082
2083 =cut
2084
2085 sub HasItems {
2086     my ($subscriptionid) = @_;
2087     my $dbh              = C4::Context->dbh;
2088     my $query = q|
2089             SELECT COUNT(serialitems.itemnumber)
2090             FROM   serial
2091                         LEFT JOIN serialitems USING(serialid)
2092             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2093         |;
2094     my $sth=$dbh->prepare($query);
2095     $sth->execute($subscriptionid);
2096     my ($countitems)=$sth->fetchrow_array();
2097     return $countitems;
2098 }
2099
2100 =head2 abouttoexpire
2101
2102 $result = abouttoexpire($subscriptionid)
2103
2104 this function alerts you to the penultimate issue for a serial subscription
2105
2106 returns 1 - if this is the penultimate issue
2107 returns 0 - if not
2108
2109 =cut
2110
2111 sub abouttoexpire {
2112     my ($subscriptionid) = @_;
2113     my $dbh              = C4::Context->dbh;
2114     my $subscription     = GetSubscription($subscriptionid);
2115     my $per = $subscription->{'periodicity'};
2116     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2117     if ($frequency and $frequency->{unit}){
2118
2119         my $expirationdate = GetExpirationDate($subscriptionid);
2120
2121         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2122         my $nextdate = GetNextDate($subscription, $res, $frequency);
2123
2124         # only compare dates if both dates exist.
2125         if ($nextdate and $expirationdate) {
2126             if(Date::Calc::Delta_Days(
2127                 split( /-/, $nextdate ),
2128                 split( /-/, $expirationdate )
2129             ) <= 0) {
2130                 return 1;
2131             }
2132         }
2133
2134     } elsif ($subscription->{numberlength}>0) {
2135         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2136     }
2137
2138     return 0;
2139 }
2140
2141 =head2 GetFictiveIssueNumber
2142
2143 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2144
2145 Get the position of the issue published at $publisheddate, considering the
2146 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2147 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2148 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2149 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2150 depending on how many rows are in serial table.
2151 The issue number calculation is based on subscription frequency, first acquisition
2152 date, and $publisheddate.
2153
2154 Returns undef when called for irregular frequencies.
2155
2156 The routine is used to skip irregularities when calculating the next issue
2157 date (in GetNextDate) or the next issue number (in GetNextSeq).
2158
2159 =cut
2160
2161 sub GetFictiveIssueNumber {
2162     my ($subscription, $publisheddate, $frequency) = @_;
2163
2164     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2165     return if !$unit;
2166     my $issueno;
2167
2168     my ( $year, $month, $day ) = split /-/, $publisheddate;
2169     my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2170     my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2171
2172     if( $frequency->{'unitsperissue'} == 1 ) {
2173         $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2174     } else { # issuesperunit == 1
2175         $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2176     }
2177     return $issueno;
2178 }
2179
2180 sub _delta_units {
2181     my ( $date1, $date2, $unit ) = @_;
2182     # date1 and date2 are array refs in the form [ yy, mm, dd ]
2183
2184     if( $unit eq 'day' ) {
2185         return Delta_Days( @$date1, @$date2 );
2186     } elsif( $unit eq 'week' ) {
2187         return int( Delta_Days( @$date1, @$date2 ) / 7 );
2188     }
2189
2190     # In case of months or years, this is a wrapper around N_Delta_YMD.
2191     # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2192     # while we expect 1 month.
2193     my @delta = N_Delta_YMD( @$date1, @$date2 );
2194     if( $delta[2] > 27 ) {
2195         # Check if we could add a month
2196         my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2197         if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2198             $delta[1]++;
2199         }
2200     }
2201     if( $delta[1] >= 12 ) {
2202         $delta[0]++;
2203         $delta[1] -= 12;
2204     }
2205     # if unit is year, we only return full years
2206     return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2207 }
2208
2209 sub _get_next_date_day {
2210     my ($subscription, $freqdata, $year, $month, $day) = @_;
2211
2212     my @newissue; # ( yy, mm, dd )
2213     # We do not need $delta_days here, since it would be zero where used
2214
2215     if( $freqdata->{issuesperunit} == 1 ) {
2216         # Add full days
2217         @newissue = Add_Delta_Days(
2218             $year, $month, $day, $freqdata->{"unitsperissue"} );
2219     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2220         # Add zero days
2221         @newissue = ( $year, $month, $day );
2222         $subscription->{countissuesperunit}++;
2223     } else {
2224         # We finished a cycle of issues within a unit.
2225         # No subtraction of zero needed, just add one day
2226         @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2227         $subscription->{countissuesperunit} = 1;
2228     }
2229     return @newissue;
2230 }
2231
2232 sub _get_next_date_week {
2233     my ($subscription, $freqdata, $year, $month, $day) = @_;
2234
2235     my @newissue; # ( yy, mm, dd )
2236     my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2237
2238     if( $freqdata->{issuesperunit} == 1 ) {
2239         # Add full weeks (of 7 days)
2240         @newissue = Add_Delta_Days(
2241             $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2242     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2243         # Add rounded number of days based on frequency.
2244         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2245         $subscription->{countissuesperunit}++;
2246     } else {
2247         # We finished a cycle of issues within a unit.
2248         # Subtract delta * (issues - 1), add 1 week
2249         @newissue = Add_Delta_Days( $year, $month, $day,
2250             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2251         @newissue = Add_Delta_Days( @newissue, 7 );
2252         $subscription->{countissuesperunit} = 1;
2253     }
2254     return @newissue;
2255 }
2256
2257 sub _get_next_date_month {
2258     my ($subscription, $freqdata, $year, $month, $day) = @_;
2259
2260     my @newissue; # ( yy, mm, dd )
2261     my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2262
2263     if( $freqdata->{issuesperunit} == 1 ) {
2264         # Add full months
2265         @newissue = Add_Delta_YM(
2266             $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2267     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2268         # Add rounded number of days based on frequency.
2269         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2270         $subscription->{countissuesperunit}++;
2271     } else {
2272         # We finished a cycle of issues within a unit.
2273         # Subtract delta * (issues - 1), add 1 month
2274         @newissue = Add_Delta_Days( $year, $month, $day,
2275             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2276         @newissue = Add_Delta_YM( @newissue, 0, 1 );
2277         $subscription->{countissuesperunit} = 1;
2278     }
2279     return @newissue;
2280 }
2281
2282 sub _get_next_date_year {
2283     my ($subscription, $freqdata, $year, $month, $day) = @_;
2284
2285     my @newissue; # ( yy, mm, dd )
2286     my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2287
2288     if( $freqdata->{issuesperunit} == 1 ) {
2289         # Add full years
2290         @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2291     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2292         # Add rounded number of days based on frequency.
2293         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2294         $subscription->{countissuesperunit}++;
2295     } else {
2296         # We finished a cycle of issues within a unit.
2297         # Subtract delta * (issues - 1), add 1 year
2298         @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2299         @newissue = Add_Delta_YM( @newissue, 1, 0 );
2300         $subscription->{countissuesperunit} = 1;
2301     }
2302     return @newissue;
2303 }
2304
2305 =head2 GetNextDate
2306
2307 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2308
2309 this function it takes the publisheddate and will return the next issue's date
2310 and will skip dates if there exists an irregularity.
2311 $publisheddate has to be an ISO date
2312 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2313 $frequency is a hashref containing frequency informations
2314 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2315 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2316 skipped then the returned date will be 2007-05-10
2317
2318 return :
2319 $resultdate - then next date in the sequence (ISO date)
2320
2321 Return undef if subscription is irregular
2322
2323 =cut
2324
2325 sub GetNextDate {
2326     my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2327
2328     return unless $subscription and $publisheddate;
2329
2330
2331     if ($freqdata->{'unit'}) {
2332         my ( $year, $month, $day ) = split /-/, $publisheddate;
2333
2334         # Process an irregularity Hash
2335         # Suppose that irregularities are stored in a string with this structure
2336         # irreg1;irreg2;irreg3
2337         # where irregX is the number of issue which will not be received
2338         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2339         my %irregularities;
2340         if ( $subscription->{irregularity} ) {
2341             my @irreg = split /;/, $subscription->{'irregularity'} ;
2342             foreach my $irregularity (@irreg) {
2343                 $irregularities{$irregularity} = 1;
2344             }
2345         }
2346
2347         # Get the 'fictive' next issue number
2348         # It is used to check if next issue is an irregular issue.
2349         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2350
2351         # Then get the next date
2352         my $unit = lc $freqdata->{'unit'};
2353         if ($unit eq 'day') {
2354             while ($irregularities{$issueno}) {
2355                 ($year, $month, $day) = _get_next_date_day($subscription,
2356                     $freqdata, $year, $month, $day);
2357                 $issueno++;
2358             }
2359             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2360                 $year, $month, $day);
2361         }
2362         elsif ($unit eq 'week') {
2363             while ($irregularities{$issueno}) {
2364                 ($year, $month, $day) = _get_next_date_week($subscription,
2365                     $freqdata, $year, $month, $day);
2366                 $issueno++;
2367             }
2368             ($year, $month, $day) = _get_next_date_week($subscription,
2369                 $freqdata, $year, $month, $day);
2370         }
2371         elsif ($unit eq 'month') {
2372             while ($irregularities{$issueno}) {
2373                 ($year, $month, $day) = _get_next_date_month($subscription,
2374                     $freqdata, $year, $month, $day);
2375                 $issueno++;
2376             }
2377             ($year, $month, $day) = _get_next_date_month($subscription,
2378                 $freqdata, $year, $month, $day);
2379         }
2380         elsif ($unit eq 'year') {
2381             while ($irregularities{$issueno}) {
2382                 ($year, $month, $day) = _get_next_date_year($subscription,
2383                     $freqdata, $year, $month, $day);
2384                 $issueno++;
2385             }
2386             ($year, $month, $day) = _get_next_date_year($subscription,
2387                 $freqdata, $year, $month, $day);
2388         }
2389
2390         if ($updatecount){
2391             my $dbh = C4::Context->dbh;
2392             my $query = qq{
2393                 UPDATE subscription
2394                 SET countissuesperunit = ?
2395                 WHERE subscriptionid = ?
2396             };
2397             my $sth = $dbh->prepare($query);
2398             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2399         }
2400
2401         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2402     }
2403 }
2404
2405 =head2 _numeration
2406
2407   $string = &_numeration($value,$num_type,$locale);
2408
2409 _numeration returns the string corresponding to $value in the num_type
2410 num_type can take :
2411     -dayname
2412     -dayabrv
2413     -monthname
2414     -monthabrv
2415     -season
2416     -seasonabrv
2417
2418 =cut
2419
2420 sub _numeration {
2421     my ($value, $num_type, $locale) = @_;
2422     $value ||= 0;
2423     $num_type //= '';
2424     $locale ||= 'en';
2425     my $string;
2426     if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2427         # 1970-11-01 was a Sunday
2428         $value = $value % 7;
2429         my $dt = DateTime->new(
2430             year    => 1970,
2431             month   => 11,
2432             day     => $value + 1,
2433             locale  => $locale,
2434         );
2435         $string = $num_type =~ /^dayname$/
2436             ? $dt->strftime("%A")
2437             : $dt->strftime("%a");
2438     } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2439         $value = $value % 12;
2440         my $dt = DateTime->new(
2441             year    => 1970,
2442             month   => $value + 1,
2443             locale  => $locale,
2444         );
2445         $string = $num_type =~ /^monthname$/
2446             ? $dt->strftime("%B")
2447             : $dt->strftime("%b");
2448     } elsif ( $num_type =~ /^season$/ ) {
2449         my @seasons= qw( Spring Summer Fall Winter );
2450         $value = $value % 4;
2451         $string = $seasons[$value];
2452     } elsif ( $num_type =~ /^seasonabrv$/ ) {
2453         my @seasonsabrv= qw( Spr Sum Fal Win );
2454         $value = $value % 4;
2455         $string = $seasonsabrv[$value];
2456     } else {
2457         $string = $value;
2458     }
2459
2460     return $string;
2461 }
2462
2463 =head2 CloseSubscription
2464
2465 Close a subscription given a subscriptionid
2466
2467 =cut
2468
2469 sub CloseSubscription {
2470     my ( $subscriptionid ) = @_;
2471     return unless $subscriptionid;
2472     my $dbh = C4::Context->dbh;
2473     my $sth = $dbh->prepare( q{
2474         UPDATE subscription
2475         SET closed = 1
2476         WHERE subscriptionid = ?
2477     } );
2478     $sth->execute( $subscriptionid );
2479
2480     # Set status = missing when status = stopped
2481     $sth = $dbh->prepare( q{
2482         UPDATE serial
2483         SET status = ?
2484         WHERE subscriptionid = ?
2485         AND status = ?
2486     } );
2487     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2488 }
2489
2490 =head2 ReopenSubscription
2491
2492 Reopen a subscription given a subscriptionid
2493
2494 =cut
2495
2496 sub ReopenSubscription {
2497     my ( $subscriptionid ) = @_;
2498     return unless $subscriptionid;
2499     my $dbh = C4::Context->dbh;
2500     my $sth = $dbh->prepare( q{
2501         UPDATE subscription
2502         SET closed = 0
2503         WHERE subscriptionid = ?
2504     } );
2505     $sth->execute( $subscriptionid );
2506
2507     # Set status = expected when status = stopped
2508     $sth = $dbh->prepare( q{
2509         UPDATE serial
2510         SET status = ?
2511         WHERE subscriptionid = ?
2512         AND status = ?
2513     } );
2514     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2515 }
2516
2517 =head2 subscriptionCurrentlyOnOrder
2518
2519     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2520
2521 Return 1 if subscription is currently on order else 0.
2522
2523 =cut
2524
2525 sub subscriptionCurrentlyOnOrder {
2526     my ( $subscriptionid ) = @_;
2527     my $dbh = C4::Context->dbh;
2528     my $query = qq|
2529         SELECT COUNT(*) FROM aqorders
2530         WHERE subscriptionid = ?
2531             AND datereceived IS NULL
2532             AND datecancellationprinted IS NULL
2533     |;
2534     my $sth = $dbh->prepare( $query );
2535     $sth->execute($subscriptionid);
2536     return $sth->fetchrow_array;
2537 }
2538
2539 =head2 can_claim_subscription
2540
2541     $can = can_claim_subscription( $subscriptionid[, $userid] );
2542
2543 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2544
2545 =cut
2546
2547 sub can_claim_subscription {
2548     my ( $subscription, $userid ) = @_;
2549     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2550 }
2551
2552 =head2 can_edit_subscription
2553
2554     $can = can_edit_subscription( $subscriptionid[, $userid] );
2555
2556 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2557
2558 =cut
2559
2560 sub can_edit_subscription {
2561     my ( $subscription, $userid ) = @_;
2562     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2563 }
2564
2565 =head2 can_show_subscription
2566
2567     $can = can_show_subscription( $subscriptionid[, $userid] );
2568
2569 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2570
2571 =cut
2572
2573 sub can_show_subscription {
2574     my ( $subscription, $userid ) = @_;
2575     return _can_do_on_subscription( $subscription, $userid, '*' );
2576 }
2577
2578 sub _can_do_on_subscription {
2579     my ( $subscription, $userid, $permission ) = @_;
2580     return 0 unless C4::Context->userenv;
2581     my $flags = C4::Context->userenv->{flags};
2582     $userid ||= C4::Context->userenv->{'id'};
2583
2584     if ( C4::Context->preference('IndependentBranches') ) {
2585         return 1
2586           if C4::Context->IsSuperLibrarian()
2587               or
2588               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2589               or (
2590                   C4::Auth::haspermission( $userid,
2591                       { serials => $permission } )
2592                   and (  not defined $subscription->{branchcode}
2593                       or $subscription->{branchcode} eq ''
2594                       or $subscription->{branchcode} eq
2595                       C4::Context->userenv->{'branch'} )
2596               );
2597     }
2598     else {
2599         return 1
2600           if C4::Context->IsSuperLibrarian()
2601               or
2602               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2603               or C4::Auth::haspermission(
2604                   $userid, { serials => $permission }
2605               ),
2606         ;
2607     }
2608     return 0;
2609 }
2610
2611 =head2 findSerialsByStatus
2612
2613     @serials = findSerialsByStatus($status, $subscriptionid);
2614
2615     Returns an array of serials matching a given status and subscription id.
2616
2617 =cut
2618
2619 sub findSerialsByStatus {
2620     my ( $status, $subscriptionid ) = @_;
2621     my $dbh   = C4::Context->dbh;
2622     my $query = q| SELECT * from serial
2623                     WHERE status = ?
2624                     AND subscriptionid = ?
2625                 |;
2626     my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2627     return @$serials;
2628 }
2629
2630 1;
2631 __END__
2632
2633 =head1 AUTHOR
2634
2635 Koha Development Team <http://koha-community.org/>
2636
2637 =cut