C4/Serials.pm

   1 package C4::Serials;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Parts Copyright 2010 Biblibre
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use C4::Auth qw(haspermission);
  24 use C4::Context;
  25 use DateTime;
  26 use Date::Calc qw(:all);
  27 use POSIX qw(strftime);
  28 use C4::Biblio;
  29 use C4::Log;    # logaction
  30 use C4::Debug;
  31 use C4::Serials::Frequency;
  32 use C4::Serials::Numberpattern;
  33 use Koha::AdditionalField;
  34 use Koha::DateUtils;
  35 use Koha::Serial;
  36 use Koha::Subscriptions;
  37 use Koha::Subscription::Histories;
  38
  39 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  40
  41 # Define statuses
  42 use constant {
  43     EXPECTED               => 1,
  44     ARRIVED                => 2,
  45     LATE                   => 3,
  46     MISSING                => 4,
  47     MISSING_NEVER_RECIEVED => 41,
  48     MISSING_SOLD_OUT       => 42,
  49     MISSING_DAMAGED        => 43,
  50     MISSING_LOST           => 44,
  51     NOT_ISSUED             => 5,
  52     DELETED                => 6,
  53     CLAIMED                => 7,
  54     STOPPED                => 8,
  55 };
  56
  57 use constant MISSING_STATUSES => (
  58     MISSING,          MISSING_NEVER_RECIEVED,
  59     MISSING_SOLD_OUT, MISSING_DAMAGED,
  60     MISSING_LOST
  61 );
  62
  63 BEGIN {
  64     require Exporter;
  65     @ISA    = qw(Exporter);
  66     @EXPORT = qw(
  67       &NewSubscription    &ModSubscription    &DelSubscription
  68       &GetSubscription    &CountSubscriptionFromBiblionumber      &GetSubscriptionsFromBiblionumber
  69       &SearchSubscriptions
  70       &GetFullSubscriptionsFromBiblionumber   &GetFullSubscription &ModSubscriptionHistory
  71       &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
  72       &GetSubscriptionHistoryFromSubscriptionId
  73
  74       &GetNextSeq &GetSeq &NewIssue           &GetSerials
  75       &GetLatestSerials   &ModSerialStatus    &GetNextDate       &GetSerials2
  76       &ReNewSubscription  &GetLateOrMissingIssues
  77       &GetSerialInformation                   &AddItem2Serial
  78       &PrepareSerialsData &GetNextExpected    &ModNextExpected
  79       &GetPreviousSerialid
  80
  81       &GetSuppliersWithLateIssues
  82       &getroutinglist     &delroutingmember   &addroutingmember
  83       &reorder_members
  84       &check_routing &updateClaim
  85       &CountIssues
  86       HasItems
  87       &subscriptionCurrentlyOnOrder
  88
  89     );
  90 }
  91
  92 =head1 NAME
  93
  94 C4::Serials - Serials Module Functions
  95
  96 =head1 SYNOPSIS
  97
  98   use C4::Serials;
  99
 100 =head1 DESCRIPTION
 101
 102 Functions for handling subscriptions, claims routing etc.
 103
 104
 105 =head1 SUBROUTINES
 106
 107 =head2 GetSuppliersWithLateIssues
 108
 109 $supplierlist = GetSuppliersWithLateIssues()
 110
 111 this function get all suppliers with late issues.
 112
 113 return :
 114 an array_ref of suppliers each entry is a hash_ref containing id and name
 115 the array is in name order
 116
 117 =cut
 118
 119 sub GetSuppliersWithLateIssues {
 120     my $dbh   = C4::Context->dbh;
 121     my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
 122     my $query = qq|
 123     SELECT DISTINCT id, name
 124     FROM            subscription
 125     LEFT JOIN       serial ON serial.subscriptionid=subscription.subscriptionid
 126     LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 127     WHERE id > 0
 128         AND (
 129             (planneddate < now() AND serial.status=1)
 130             OR serial.STATUS IN ( $statuses )
 131         )
 132         AND subscription.closed = 0
 133     ORDER BY name|;
 134     return $dbh->selectall_arrayref($query, { Slice => {} });
 135 }
 136
 137 =head2 GetSubscriptionHistoryFromSubscriptionId
 138
 139 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
 140
 141 This function returns the subscription history as a hashref
 142
 143 =cut
 144
 145 sub GetSubscriptionHistoryFromSubscriptionId {
 146     my ($subscriptionid) = @_;
 147
 148     return unless $subscriptionid;
 149
 150     my $dbh   = C4::Context->dbh;
 151     my $query = qq|
 152         SELECT *
 153         FROM   subscriptionhistory
 154         WHERE  subscriptionid = ?
 155     |;
 156     my $sth = $dbh->prepare($query);
 157     $sth->execute($subscriptionid);
 158     my $results = $sth->fetchrow_hashref;
 159     $sth->finish;
 160
 161     return $results;
 162 }
 163
 164 =head2 GetSerialInformation
 165
 166 $data = GetSerialInformation($serialid);
 167 returns a hash_ref containing :
 168   items : items marcrecord (can be an array)
 169   serial table field
 170   subscription table field
 171   + information about subscription expiration
 172
 173 =cut
 174
 175 sub GetSerialInformation {
 176     my ($serialid) = @_;
 177     my $dbh        = C4::Context->dbh;
 178     my $query      = qq|
 179         SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
 180         FROM   serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
 181         WHERE  serialid = ?
 182     |;
 183     my $rq = $dbh->prepare($query);
 184     $rq->execute($serialid);
 185     my $data = $rq->fetchrow_hashref;
 186
 187     # create item information if we have serialsadditems for this subscription
 188     if ( $data->{'serialsadditems'} ) {
 189         my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
 190         $queryitem->execute($serialid);
 191         my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
 192         require C4::Items;
 193         if ( scalar(@$itemnumbers) > 0 ) {
 194             foreach my $itemnum (@$itemnumbers) {
 195
 196                 #It is ASSUMED that GetMarcItem ALWAYS WORK...
 197                 #Maybe GetMarcItem should return values on failure
 198                 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
 199                 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
 200                 $itemprocessed->{'itemnumber'}   = $itemnum->[0];
 201                 $itemprocessed->{'itemid'}       = $itemnum->[0];
 202                 $itemprocessed->{'serialid'}     = $serialid;
 203                 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 204                 push @{ $data->{'items'} }, $itemprocessed;
 205             }
 206         } else {
 207             my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
 208             $itemprocessed->{'itemid'}       = "N$serialid";
 209             $itemprocessed->{'serialid'}     = $serialid;
 210             $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 211             $itemprocessed->{'countitems'}   = 0;
 212             push @{ $data->{'items'} }, $itemprocessed;
 213         }
 214     }
 215     $data->{ "status" . $data->{'serstatus'} } = 1;
 216     $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
 217     $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
 218     $data->{cannotedit} = not can_edit_subscription( $data );
 219     return $data;
 220 }
 221
 222 =head2 AddItem2Serial
 223
 224 $rows = AddItem2Serial($serialid,$itemnumber);
 225 Adds an itemnumber to Serial record
 226 returns the number of rows affected
 227
 228 =cut
 229
 230 sub AddItem2Serial {
 231     my ( $serialid, $itemnumber ) = @_;
 232
 233     return unless ($serialid and $itemnumber);
 234
 235     my $dbh = C4::Context->dbh;
 236     my $rq  = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
 237     $rq->execute( $serialid, $itemnumber );
 238     return $rq->rows;
 239 }
 240
 241 =head2 GetSubscription
 242
 243 $subs = GetSubscription($subscriptionid)
 244 this function returns the subscription which has $subscriptionid as id.
 245 return :
 246 a hashref. This hash contains
 247 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
 248
 249 =cut
 250
 251 sub GetSubscription {
 252     my ($subscriptionid) = @_;
 253     my $dbh              = C4::Context->dbh;
 254     my $query            = qq(
 255         SELECT  subscription.*,
 256                 subscriptionhistory.*,
 257                 aqbooksellers.name AS aqbooksellername,
 258                 biblio.title AS bibliotitle,
 259                 subscription.biblionumber as bibnum
 260        FROM subscription
 261        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 262        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 263        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 264        WHERE subscription.subscriptionid = ?
 265     );
 266
 267     $debug and warn "query : $query\nsubsid :$subscriptionid";
 268     my $sth = $dbh->prepare($query);
 269     $sth->execute($subscriptionid);
 270     my $subscription = $sth->fetchrow_hashref;
 271
 272     return unless $subscription;
 273
 274     $subscription->{cannotedit} = not can_edit_subscription( $subscription );
 275
 276     # Add additional fields to the subscription into a new key "additional_fields"
 277     my $additional_field_values = Koha::AdditionalField->fetch_all_values({
 278             tablename => 'subscription',
 279             record_id => $subscriptionid,
 280     });
 281     $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
 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->{opacnote}     =~ s/\n/\<br\/\>/g;
 433         $subs->{missinglist}  =~ s/\n/\<br\/\>/g;
 434         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 435         $subs->{ "periodicity" . $subs->{periodicity} }     = 1;
 436         $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
 437         $subs->{ "status" . $subs->{'status'} }             = 1;
 438
 439         if (not defined $subs->{enddate} ) {
 440             $subs->{enddate} = '';
 441         } else {
 442             $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
 443         }
 444         $subs->{'abouttoexpire'}       = abouttoexpire( $subs->{'subscriptionid'} );
 445         $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
 446         $subs->{cannotedit} = not can_edit_subscription( $subs );
 447         push @res, $subs;
 448     }
 449     return \@res;
 450 }
 451
 452 =head2 GetFullSubscriptionsFromBiblionumber
 453
 454    $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
 455    this function reads the serial table.
 456
 457 =cut
 458
 459 sub GetFullSubscriptionsFromBiblionumber {
 460     my ($biblionumber) = @_;
 461     my $dbh            = C4::Context->dbh;
 462     my $query          = qq|
 463   SELECT    serial.serialid,
 464             serial.serialseq,
 465             serial.planneddate,
 466             serial.publisheddate,
 467             serial.publisheddatetext,
 468             serial.status,
 469             serial.notes as notes,
 470             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 471             biblio.title as bibliotitle,
 472             subscription.branchcode AS branchcode,
 473             subscription.subscriptionid AS subscriptionid
 474   FROM      serial
 475   LEFT JOIN subscription ON
 476           (serial.subscriptionid=subscription.subscriptionid)
 477   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 478   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 479   WHERE     subscription.biblionumber = ?
 480   ORDER BY year DESC,
 481           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 482           serial.subscriptionid
 483           |;
 484     my $sth = $dbh->prepare($query);
 485     $sth->execute($biblionumber);
 486     my $subscriptions = $sth->fetchall_arrayref( {} );
 487     my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
 488     for my $subscription ( @$subscriptions ) {
 489         $subscription->{cannotedit} = $cannotedit;
 490     }
 491     return $subscriptions;
 492 }
 493
 494 =head2 SearchSubscriptions
 495
 496   @results = SearchSubscriptions($args);
 497
 498 This function returns a list of hashrefs, one for each subscription
 499 that meets the conditions specified by the $args hashref.
 500
 501 The valid search fields are:
 502
 503   biblionumber
 504   title
 505   issn
 506   ean
 507   callnumber
 508   location
 509   publisher
 510   bookseller
 511   branch
 512   expiration_date
 513   closed
 514
 515 The expiration_date search field is special; it specifies the maximum
 516 subscription expiration date.
 517
 518 =cut
 519
 520 sub SearchSubscriptions {
 521     my ( $args ) = @_;
 522
 523     my $additional_fields = $args->{additional_fields} // [];
 524     my $matching_record_ids_for_additional_fields = [];
 525     if ( @$additional_fields ) {
 526         $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
 527                 fields => $additional_fields,
 528                 tablename => 'subscription',
 529                 exact_match => 0,
 530         });
 531         return () unless @$matching_record_ids_for_additional_fields;
 532     }
 533
 534     my $query = q|
 535         SELECT
 536             subscription.notes AS publicnotes,
 537             subscriptionhistory.*,
 538             subscription.*,
 539             biblio.notes AS biblionotes,
 540             biblio.title,
 541             biblio.author,
 542             biblio.biblionumber,
 543             aqbooksellers.name AS vendorname,
 544             biblioitems.issn
 545         FROM subscription
 546             LEFT JOIN subscriptionhistory USING(subscriptionid)
 547             LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 548             LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
 549             LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 550     |;
 551     $query .= q| WHERE 1|;
 552     my @where_strs;
 553     my @where_args;
 554     if( $args->{biblionumber} ) {
 555         push @where_strs, "biblio.biblionumber = ?";
 556         push @where_args, $args->{biblionumber};
 557     }
 558
 559     if( $args->{title} ){
 560         my @words = split / /, $args->{title};
 561         my (@strs, @args);
 562         foreach my $word (@words) {
 563             push @strs, "biblio.title LIKE ?";
 564             push @args, "%$word%";
 565         }
 566         if (@strs) {
 567             push @where_strs, '(' . join (' AND ', @strs) . ')';
 568             push @where_args, @args;
 569         }
 570     }
 571     if( $args->{issn} ){
 572         push @where_strs, "biblioitems.issn LIKE ?";
 573         push @where_args, "%$args->{issn}%";
 574     }
 575     if( $args->{ean} ){
 576         push @where_strs, "biblioitems.ean LIKE ?";
 577         push @where_args, "%$args->{ean}%";
 578     }
 579     if ( $args->{callnumber} ) {
 580         push @where_strs, "subscription.callnumber LIKE ?";
 581         push @where_args, "%$args->{callnumber}%";
 582     }
 583     if( $args->{publisher} ){
 584         push @where_strs, "biblioitems.publishercode LIKE ?";
 585         push @where_args, "%$args->{publisher}%";
 586     }
 587     if( $args->{bookseller} ){
 588         push @where_strs, "aqbooksellers.name LIKE ?";
 589         push @where_args, "%$args->{bookseller}%";
 590     }
 591     if( $args->{branch} ){
 592         push @where_strs, "subscription.branchcode = ?";
 593         push @where_args, "$args->{branch}";
 594     }
 595     if ( $args->{location} ) {
 596         push @where_strs, "subscription.location = ?";
 597         push @where_args, "$args->{location}";
 598     }
 599     if ( $args->{expiration_date} ) {
 600         push @where_strs, "subscription.enddate <= ?";
 601         push @where_args, "$args->{expiration_date}";
 602     }
 603     if( defined $args->{closed} ){
 604         push @where_strs, "subscription.closed = ?";
 605         push @where_args, "$args->{closed}";
 606     }
 607
 608     if(@where_strs){
 609         $query .= ' AND ' . join(' AND ', @where_strs);
 610     }
 611     if ( @$additional_fields ) {
 612         $query .= ' AND subscriptionid IN ('
 613             . join( ', ', @$matching_record_ids_for_additional_fields )
 614         . ')';
 615     }
 616
 617     $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
 618
 619     my $dbh = C4::Context->dbh;
 620     my $sth = $dbh->prepare($query);
 621     $sth->execute(@where_args);
 622     my $results =  $sth->fetchall_arrayref( {} );
 623
 624     for my $subscription ( @$results ) {
 625         $subscription->{cannotedit} = not can_edit_subscription( $subscription );
 626         $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
 627
 628         my $additional_field_values = Koha::AdditionalField->fetch_all_values({
 629             record_id => $subscription->{subscriptionid},
 630             tablename => 'subscription'
 631         });
 632         $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
 633     }
 634
 635     return @$results;
 636 }
 637
 638
 639 =head2 GetSerials
 640
 641 ($totalissues,@serials) = GetSerials($subscriptionid);
 642 this function gets every serial not arrived for a given subscription
 643 as well as the number of issues registered in the database (all types)
 644 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 645
 646 FIXME: We should return \@serials.
 647
 648 =cut
 649
 650 sub GetSerials {
 651     my ( $subscriptionid, $count ) = @_;
 652
 653     return unless $subscriptionid;
 654
 655     my $dbh = C4::Context->dbh;
 656
 657     # status = 2 is "arrived"
 658     my $counter = 0;
 659     $count = 5 unless ($count);
 660     my @serials;
 661     my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
 662     my $query = "SELECT serialid,serialseq, status, publisheddate,
 663         publisheddatetext, planneddate,notes, routingnotes
 664                         FROM   serial
 665                         WHERE  subscriptionid = ? AND status NOT IN ( $statuses )
 666                         ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
 667     my $sth = $dbh->prepare($query);
 668     $sth->execute($subscriptionid);
 669
 670     while ( my $line = $sth->fetchrow_hashref ) {
 671         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 672         for my $datefield ( qw( planneddate publisheddate) ) {
 673             if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
 674                 $line->{$datefield} =  output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 675             } else {
 676                 $line->{$datefield} = q{};
 677             }
 678         }
 679         push @serials, $line;
 680     }
 681
 682     # OK, now add the last 5 issues arrives/missing
 683     $query = "SELECT   serialid,serialseq, status, planneddate, publisheddate,
 684         publisheddatetext, notes, routingnotes
 685        FROM     serial
 686        WHERE    subscriptionid = ?
 687        AND      status IN ( $statuses )
 688        ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
 689       ";
 690     $sth = $dbh->prepare($query);
 691     $sth->execute($subscriptionid);
 692     while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
 693         $counter++;
 694         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 695         for my $datefield ( qw( planneddate publisheddate) ) {
 696             if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
 697                 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 698             } else {
 699                 $line->{$datefield} = q{};
 700             }
 701         }
 702
 703         push @serials, $line;
 704     }
 705
 706     $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
 707     $sth   = $dbh->prepare($query);
 708     $sth->execute($subscriptionid);
 709     my ($totalissues) = $sth->fetchrow;
 710     return ( $totalissues, @serials );
 711 }
 712
 713 =head2 GetSerials2
 714
 715 @serials = GetSerials2($subscriptionid,$statuses);
 716 this function returns every serial waited for a given subscription
 717 as well as the number of issues registered in the database (all types)
 718 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 719
 720 $statuses is an arrayref of statuses and is mandatory.
 721
 722 =cut
 723
 724 sub GetSerials2 {
 725     my ( $subscription, $statuses ) = @_;
 726
 727     return unless ($subscription and @$statuses);
 728
 729     my $dbh   = C4::Context->dbh;
 730     my $query = q|
 731                  SELECT serialid,serialseq, status, planneddate, publisheddate,
 732                     publisheddatetext, notes, routingnotes
 733                  FROM     serial
 734                  WHERE    subscriptionid=?
 735             |
 736             . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
 737             . q|
 738                  ORDER BY publisheddate,serialid DESC
 739     |;
 740     $debug and warn "GetSerials2 query: $query";
 741     my $sth = $dbh->prepare($query);
 742     $sth->execute( $subscription, @$statuses );
 743     my @serials;
 744
 745     while ( my $line = $sth->fetchrow_hashref ) {
 746         $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
 747         # Format dates for display
 748         for my $datefield ( qw( planneddate publisheddate ) ) {
 749             if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
 750                 $line->{$datefield} = q{};
 751             }
 752             else {
 753                 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 754             }
 755         }
 756         push @serials, $line;
 757     }
 758     return @serials;
 759 }
 760
 761 =head2 GetLatestSerials
 762
 763 \@serials = GetLatestSerials($subscriptionid,$limit)
 764 get the $limit's latest serials arrived or missing for a given subscription
 765 return :
 766 a ref to an array which contains all of the latest serials stored into a hash.
 767
 768 =cut
 769
 770 sub GetLatestSerials {
 771     my ( $subscriptionid, $limit ) = @_;
 772
 773     return unless ($subscriptionid and $limit);
 774
 775     my $dbh = C4::Context->dbh;
 776
 777     my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
 778     my $strsth = "SELECT   serialid,serialseq, status, planneddate, publisheddate, notes
 779                         FROM     serial
 780                         WHERE    subscriptionid = ?
 781                         AND      status IN ($statuses)
 782                         ORDER BY publisheddate DESC LIMIT 0,$limit
 783                 ";
 784     my $sth = $dbh->prepare($strsth);
 785     $sth->execute($subscriptionid);
 786     my @serials;
 787     while ( my $line = $sth->fetchrow_hashref ) {
 788         $line->{ "status" . $line->{status} } = 1;                        # fills a "statusX" value, used for template status select list
 789         push @serials, $line;
 790     }
 791
 792     return \@serials;
 793 }
 794
 795 =head2 GetPreviousSerialid
 796
 797 $serialid = GetPreviousSerialid($subscriptionid, $nth)
 798 get the $nth's previous serial for the given subscriptionid
 799 return :
 800 the serialid
 801
 802 =cut
 803
 804 sub GetPreviousSerialid {
 805     my ( $subscriptionid, $nth ) = @_;
 806     $nth ||= 1;
 807     my $dbh = C4::Context->dbh;
 808     my $return = undef;
 809
 810     # Status 2: Arrived
 811     my $strsth = "SELECT   serialid
 812                         FROM     serial
 813                         WHERE    subscriptionid = ?
 814                         AND      status = 2
 815                         ORDER BY serialid DESC LIMIT $nth,1
 816                 ";
 817     my $sth = $dbh->prepare($strsth);
 818     $sth->execute($subscriptionid);
 819     my @serials;
 820     my $line = $sth->fetchrow_hashref;
 821     $return = $line->{'serialid'} if ($line);
 822
 823     return $return;
 824 }
 825
 826 =head2 GetNextSeq
 827
 828     my (
 829         $nextseq,       $newlastvalue1, $newlastvalue2, $newlastvalue3,
 830         $newinnerloop1, $newinnerloop2, $newinnerloop3
 831     ) = GetNextSeq( $subscription, $pattern, $planneddate );
 832
 833 $subscription is a hashref containing all the attributes of the table
 834 'subscription'.
 835 $pattern is a hashref containing all the attributes of the table
 836 'subscription_numberpatterns'.
 837 $planneddate is a date string in iso format.
 838 This function get the next issue for the subscription given on input arg
 839
 840 =cut
 841
 842 sub GetNextSeq {
 843     my ($subscription, $pattern, $planneddate) = @_;
 844
 845     return unless ($subscription and $pattern);
 846
 847     my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
 848     $newinnerloop1, $newinnerloop2, $newinnerloop3 );
 849     my $count = 1;
 850
 851     if ($subscription->{'skip_serialseq'}) {
 852         my @irreg = split /;/, $subscription->{'irregularity'};
 853         if(@irreg > 0) {
 854             my $irregularities = {};
 855             $irregularities->{$_} = 1 foreach(@irreg);
 856             my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
 857             while($irregularities->{$issueno}) {
 858                 $count++;
 859                 $issueno++;
 860             }
 861         }
 862     }
 863
 864     my $numberingmethod = $pattern->{numberingmethod};
 865     my $calculated = "";
 866     if ($numberingmethod) {
 867         $calculated    = $numberingmethod;
 868         my $locale = $subscription->{locale};
 869         $newlastvalue1 = $subscription->{lastvalue1} || 0;
 870         $newlastvalue2 = $subscription->{lastvalue2} || 0;
 871         $newlastvalue3 = $subscription->{lastvalue3} || 0;
 872         $newinnerloop1 = $subscription->{innerloop1} || 0;
 873         $newinnerloop2 = $subscription->{innerloop2} || 0;
 874         $newinnerloop3 = $subscription->{innerloop3} || 0;
 875         my %calc;
 876         foreach(qw/X Y Z/) {
 877             $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
 878         }
 879
 880         for(my $i = 0; $i < $count; $i++) {
 881             if($calc{'X'}) {
 882                 # check if we have to increase the new value.
 883                 $newinnerloop1 += 1;
 884                 if ($newinnerloop1 >= $pattern->{every1}) {
 885                     $newinnerloop1  = 0;
 886                     $newlastvalue1 += $pattern->{add1};
 887                 }
 888                 # reset counter if needed.
 889                 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
 890             }
 891             if($calc{'Y'}) {
 892                 # check if we have to increase the new value.
 893                 $newinnerloop2 += 1;
 894                 if ($newinnerloop2 >= $pattern->{every2}) {
 895                     $newinnerloop2  = 0;
 896                     $newlastvalue2 += $pattern->{add2};
 897                 }
 898                 # reset counter if needed.
 899                 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
 900             }
 901             if($calc{'Z'}) {
 902                 # check if we have to increase the new value.
 903                 $newinnerloop3 += 1;
 904                 if ($newinnerloop3 >= $pattern->{every3}) {
 905                     $newinnerloop3  = 0;
 906                     $newlastvalue3 += $pattern->{add3};
 907                 }
 908                 # reset counter if needed.
 909                 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
 910             }
 911         }
 912         if($calc{'X'}) {
 913             my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
 914             $calculated =~ s/\{X\}/$newlastvalue1string/g;
 915         }
 916         if($calc{'Y'}) {
 917             my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
 918             $calculated =~ s/\{Y\}/$newlastvalue2string/g;
 919         }
 920         if($calc{'Z'}) {
 921             my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
 922             $calculated =~ s/\{Z\}/$newlastvalue3string/g;
 923         }
 924     }
 925
 926     return ($calculated,
 927             $newlastvalue1, $newlastvalue2, $newlastvalue3,
 928             $newinnerloop1, $newinnerloop2, $newinnerloop3);
 929 }
 930
 931 =head2 GetSeq
 932
 933 $calculated = GetSeq($subscription, $pattern)
 934 $subscription is a hashref containing all the attributes of the table 'subscription'
 935 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
 936 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 937 return:
 938 the sequence in string format
 939
 940 =cut
 941
 942 sub GetSeq {
 943     my ($subscription, $pattern) = @_;
 944
 945     return unless ($subscription and $pattern);
 946
 947     my $locale = $subscription->{locale};
 948
 949     my $calculated = $pattern->{numberingmethod};
 950
 951     my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
 952     $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
 953     $calculated =~ s/\{X\}/$newlastvalue1/g;
 954
 955     my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
 956     $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
 957     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 958
 959     my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
 960     $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
 961     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 962     return $calculated;
 963 }
 964
 965 =head2 GetExpirationDate
 966
 967 $enddate = GetExpirationDate($subscriptionid, [$startdate])
 968
 969 this function return the next expiration date for a subscription given on input args.
 970
 971 return
 972 the enddate or undef
 973
 974 =cut
 975
 976 sub GetExpirationDate {
 977     my ( $subscriptionid, $startdate ) = @_;
 978
 979     return unless ($subscriptionid);
 980
 981     my $dbh          = C4::Context->dbh;
 982     my $subscription = GetSubscription($subscriptionid);
 983     my $enddate;
 984
 985     # we don't do the same test if the subscription is based on X numbers or on X weeks/months
 986     $enddate = $startdate || $subscription->{startdate};
 987     my @date = split( /-/, $enddate );
 988
 989     return if ( scalar(@date) != 3 || not check_date(@date) );
 990
 991     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
 992     if ( $frequency and $frequency->{unit} ) {
 993
 994         # If Not Irregular
 995         if ( my $length = $subscription->{numberlength} ) {
 996
 997             #calculate the date of the last issue.
 998             for ( my $i = 1 ; $i <= $length ; $i++ ) {
 999                 $enddate = GetNextDate( $subscription, $enddate );
1000             }
1001         } elsif ( $subscription->{monthlength} ) {
1002             if ( $$subscription{startdate} ) {
1003                 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1004                 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1005             }
1006         } elsif ( $subscription->{weeklength} ) {
1007             if ( $$subscription{startdate} ) {
1008                 my @date = split( /-/, $subscription->{startdate} );
1009                 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1010                 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1011             }
1012         } else {
1013             $enddate = $subscription->{enddate};
1014         }
1015         return $enddate;
1016     } else {
1017         return $subscription->{enddate};
1018     }
1019 }
1020
1021 =head2 CountSubscriptionFromBiblionumber
1022
1023 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1024 this returns a count of the subscriptions for a given biblionumber
1025 return :
1026 the number of subscriptions
1027
1028 =cut
1029
1030 sub CountSubscriptionFromBiblionumber {
1031     my ($biblionumber) = @_;
1032
1033     return unless ($biblionumber);
1034
1035     my $dbh            = C4::Context->dbh;
1036     my $query          = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1037     my $sth            = $dbh->prepare($query);
1038     $sth->execute($biblionumber);
1039     my $subscriptionsnumber = $sth->fetchrow;
1040     return $subscriptionsnumber;
1041 }
1042
1043 =head2 ModSubscriptionHistory
1044
1045 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1046
1047 this function modifies the history of a subscription. Put your new values on input arg.
1048 returns the number of rows affected
1049
1050 =cut
1051
1052 sub ModSubscriptionHistory {
1053     my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1054
1055     return unless ($subscriptionid);
1056
1057     my $dbh   = C4::Context->dbh;
1058     my $query = "UPDATE subscriptionhistory
1059                     SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1060                     WHERE subscriptionid=?
1061                 ";
1062     my $sth = $dbh->prepare($query);
1063     $receivedlist =~ s/^; // if $receivedlist;
1064     $missinglist  =~ s/^; // if $missinglist;
1065     $opacnote     =~ s/^; // if $opacnote;
1066     $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1067     return $sth->rows;
1068 }
1069
1070 =head2 ModSerialStatus
1071
1072     ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1073         $publisheddatetext, $status, $notes);
1074
1075 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1076 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1077
1078 =cut
1079
1080 sub ModSerialStatus {
1081     my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1082         $status, $notes) = @_;
1083
1084     return unless ($serialid);
1085
1086     #It is a usual serial
1087     # 1st, get previous status :
1088     my $dbh   = C4::Context->dbh;
1089     my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1090         FROM serial, subscription
1091         WHERE serial.subscriptionid=subscription.subscriptionid
1092             AND serialid=?";
1093     my $sth   = $dbh->prepare($query);
1094     $sth->execute($serialid);
1095     my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1096     my $frequency = GetSubscriptionFrequency($periodicity);
1097
1098     # change status & update subscriptionhistory
1099     my $val;
1100     if ( $status == DELETED ) {
1101         DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1102     } else {
1103         my $query = '
1104             UPDATE serial
1105             SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1106                 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1107             WHERE  serialid = ?
1108         ';
1109         $sth = $dbh->prepare($query);
1110         $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1111             $planneddate, $status, $notes, $routingnotes, $serialid );
1112         $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1113         $sth   = $dbh->prepare($query);
1114         $sth->execute($subscriptionid);
1115         my $val = $sth->fetchrow_hashref;
1116         unless ( $val->{manualhistory} ) {
1117             $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE  subscriptionid=?";
1118             $sth   = $dbh->prepare($query);
1119             $sth->execute($subscriptionid);
1120             my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1121
1122             if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1123                 $recievedlist .= "; $serialseq"
1124                     if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1125             }
1126
1127             # in case serial has been previously marked as missing
1128             if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1129                 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1130             }
1131
1132             $missinglist .= "; $serialseq"
1133                 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1134             $missinglist .= "; not issued $serialseq"
1135                 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1136
1137             $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1138             $sth   = $dbh->prepare($query);
1139             $recievedlist =~ s/^; //;
1140             $missinglist  =~ s/^; //;
1141             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1142         }
1143     }
1144
1145     # create new expected entry if needed (ie : was "expected" and has changed)
1146     my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1147     if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1148         my $subscription = GetSubscription($subscriptionid);
1149         my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1150
1151         # next issue number
1152         my (
1153             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1154             $newinnerloop1, $newinnerloop2, $newinnerloop3
1155           )
1156           = GetNextSeq( $subscription, $pattern, $publisheddate );
1157
1158         # next date (calculated from actual date & frequency parameters)
1159         my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1160         my $nextpubdate = $nextpublisheddate;
1161         $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1162                     WHERE  subscriptionid = ?";
1163         $sth = $dbh->prepare($query);
1164         $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1165         NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $notes, $routingnotes );
1166         # check if an alert must be sent... (= a letter is defined & status became "arrived"
1167         if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1168             require C4::Letters;
1169             C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1170         }
1171     }
1172
1173     return;
1174 }
1175
1176 =head2 GetNextExpected
1177
1178 $nextexpected = GetNextExpected($subscriptionid)
1179
1180 Get the planneddate for the current expected issue of the subscription.
1181
1182 returns a hashref:
1183
1184 $nextexepected = {
1185     serialid => int
1186     planneddate => ISO date
1187     }
1188
1189 =cut
1190
1191 sub GetNextExpected {
1192     my ($subscriptionid) = @_;
1193
1194     my $dbh = C4::Context->dbh;
1195     my $query = qq{
1196         SELECT *
1197         FROM serial
1198         WHERE subscriptionid = ?
1199           AND status = ?
1200         LIMIT 1
1201     };
1202     my $sth = $dbh->prepare($query);
1203
1204     # Each subscription has only one 'expected' issue.
1205     $sth->execute( $subscriptionid, EXPECTED );
1206     my $nextissue = $sth->fetchrow_hashref;
1207     if ( !$nextissue ) {
1208         $query = qq{
1209             SELECT *
1210             FROM serial
1211             WHERE subscriptionid = ?
1212             ORDER BY publisheddate DESC
1213             LIMIT 1
1214         };
1215         $sth = $dbh->prepare($query);
1216         $sth->execute($subscriptionid);
1217         $nextissue = $sth->fetchrow_hashref;
1218     }
1219     foreach(qw/planneddate publisheddate/) {
1220         if ( !defined $nextissue->{$_} ) {
1221             # or should this default to 1st Jan ???
1222             $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1223         }
1224         $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1225                          ? $nextissue->{$_}
1226                          : undef;
1227     }
1228
1229     return $nextissue;
1230 }
1231
1232 =head2 ModNextExpected
1233
1234 ModNextExpected($subscriptionid,$date)
1235
1236 Update the planneddate for the current expected issue of the subscription.
1237 This will modify all future prediction results.
1238
1239 C<$date> is an ISO date.
1240
1241 returns 0
1242
1243 =cut
1244
1245 sub ModNextExpected {
1246     my ( $subscriptionid, $date ) = @_;
1247     my $dbh = C4::Context->dbh;
1248
1249     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1250     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1251
1252     # Each subscription has only one 'expected' issue.
1253     $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1254     return 0;
1255
1256 }
1257
1258 =head2 GetSubscriptionIrregularities
1259
1260 =over 4
1261
1262 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1263 get the list of irregularities for a subscription
1264
1265 =back
1266
1267 =cut
1268
1269 sub GetSubscriptionIrregularities {
1270     my $subscriptionid = shift;
1271
1272     return unless $subscriptionid;
1273
1274     my $dbh = C4::Context->dbh;
1275     my $query = qq{
1276         SELECT irregularity
1277         FROM subscription
1278         WHERE subscriptionid = ?
1279     };
1280     my $sth = $dbh->prepare($query);
1281     $sth->execute($subscriptionid);
1282
1283     my ($result) = $sth->fetchrow_array;
1284     my @irreg = split /;/, $result;
1285
1286     return @irreg;
1287 }
1288
1289 =head2 ModSubscription
1290
1291 this function modifies a subscription. Put all new values on input args.
1292 returns the number of rows affected
1293
1294 =cut
1295
1296 sub ModSubscription {
1297     my (
1298     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1299     $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1300     $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1301     $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1302     $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1303     $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1304     $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1305     $itemtype, $previousitemtype
1306     ) = @_;
1307
1308     my $dbh   = C4::Context->dbh;
1309     my $query = "UPDATE subscription
1310         SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1311             startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1312             numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1313             lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1314             lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1315             callnumber=?, notes=?, letter=?, manualhistory=?,
1316             internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1317             opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1318             skip_serialseq=?, itemtype=?, previousitemtype=?
1319         WHERE subscriptionid = ?";
1320
1321     my $sth = $dbh->prepare($query);
1322     $sth->execute(
1323         $auser,           $branchcode,     $aqbooksellerid, $cost,
1324         $aqbudgetid,      $startdate,      $periodicity,    $firstacquidate,
1325         $irregularity,    $numberpattern,  $locale,         $numberlength,
1326         $weeklength,      $monthlength,    $lastvalue1,     $innerloop1,
1327         $lastvalue2,      $innerloop2,     $lastvalue3,     $innerloop3,
1328         $status,          $biblionumber,   $callnumber,     $notes,
1329         $letter,          ($manualhistory ? $manualhistory : 0),
1330         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1331         $graceperiod,     $location,       $enddate,        $skip_serialseq,
1332         $itemtype,        $previousitemtype,
1333         $subscriptionid
1334     );
1335     my $rows = $sth->rows;
1336
1337     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1338     return $rows;
1339 }
1340
1341 =head2 NewSubscription
1342
1343 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1344     $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1345     $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1346     $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1347     $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1348     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1349     $skip_serialseq, $itemtype, $previousitemtype);
1350
1351 Create a new subscription with value given on input args.
1352
1353 return :
1354 the id of this new subscription
1355
1356 =cut
1357
1358 sub NewSubscription {
1359     my (
1360     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1361     $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1362     $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1363     $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1364     $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1365     $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1366     $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1367     ) = @_;
1368     my $dbh = C4::Context->dbh;
1369
1370     my $subscription = Koha::Subscription->new(
1371         {
1372             librarian         => $auser,
1373             branchcode        => $branchcode,
1374             aqbooksellerid    => $aqbooksellerid,
1375             cost              => $cost,
1376             aqbudgetid        => $aqbudgetid,
1377             biblionumber      => $biblionumber,
1378             startdate         => $startdate,
1379             periodicity       => $periodicity,
1380             numberlength      => $numberlength,
1381             weeklength        => $weeklength,
1382             monthlength       => $monthlength,
1383             lastvalue1        => $lastvalue1,
1384             innerloop1        => $innerloop1,
1385             lastvalue2        => $lastvalue2,
1386             innerloop2        => $innerloop2,
1387             lastvalue3        => $lastvalue3,
1388             innerloop3        => $innerloop3,
1389             status            => $status,
1390             notes             => $notes,
1391             letter            => $letter,
1392             firstacquidate    => $firstacquidate,
1393             irregularity      => $irregularity,
1394             numberpattern     => $numberpattern,
1395             locale            => $locale,
1396             callnumber        => $callnumber,
1397             manualhistory     => $manualhistory,
1398             internalnotes     => $internalnotes,
1399             serialsadditems   => $serialsadditems,
1400             staffdisplaycount => $staffdisplaycount,
1401             opacdisplaycount  => $opacdisplaycount,
1402             graceperiod       => $graceperiod,
1403             location          => $location,
1404             enddate           => $enddate,
1405             skip_serialseq    => $skip_serialseq,
1406             itemtype          => $itemtype,
1407             previousitemtype  => $previousitemtype,
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     my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1709     foreach my $af (@$afs) {
1710         $af->delete_values({record_id => $subscriptionid});
1711     }
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 $additional_field_values = Koha::AdditionalField->fetch_all_values({
1842             record_id => $line->{subscriptionid},
1843             tablename => 'subscription'
1844         });
1845         %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1846
1847         push @issuelist, $line;
1848     }
1849     return @issuelist;
1850 }
1851
1852 =head2 updateClaim
1853
1854 &updateClaim($serialid)
1855
1856 this function updates the time when a claim is issued for late/missing items
1857
1858 called from claims.pl file
1859
1860 =cut
1861
1862 sub updateClaim {
1863     my ($serialids) = @_;
1864     return unless $serialids;
1865     unless ( ref $serialids ) {
1866         $serialids = [ $serialids ];
1867     }
1868     my $dbh = C4::Context->dbh;
1869     return $dbh->do(q|
1870         UPDATE serial
1871         SET claimdate = NOW(),
1872             claims_count = claims_count + 1,
1873             status = ?
1874         WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1875         {}, CLAIMED, @$serialids );
1876 }
1877
1878 =head2 check_routing
1879
1880 $result = &check_routing($subscriptionid)
1881
1882 this function checks to see if a serial has a routing list and returns the count of routingid
1883 used to show either an 'add' or 'edit' link
1884
1885 =cut
1886
1887 sub check_routing {
1888     my ($subscriptionid) = @_;
1889
1890     return unless ($subscriptionid);
1891
1892     my $dbh              = C4::Context->dbh;
1893     my $sth              = $dbh->prepare(
1894         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1895                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1896                               WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1897                               "
1898     );
1899     $sth->execute($subscriptionid);
1900     my $line   = $sth->fetchrow_hashref;
1901     my $result = $line->{'routingids'};
1902     return $result;
1903 }
1904
1905 =head2 addroutingmember
1906
1907 addroutingmember($borrowernumber,$subscriptionid)
1908
1909 this function takes a borrowernumber and subscriptionid and adds the member to the
1910 routing list for that serial subscription and gives them a rank on the list
1911 of either 1 or highest current rank + 1
1912
1913 =cut
1914
1915 sub addroutingmember {
1916     my ( $borrowernumber, $subscriptionid ) = @_;
1917
1918     return unless ($borrowernumber and $subscriptionid);
1919
1920     my $rank;
1921     my $dbh = C4::Context->dbh;
1922     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1923     $sth->execute($subscriptionid);
1924     while ( my $line = $sth->fetchrow_hashref ) {
1925         if ( $line->{'rank'} > 0 ) {
1926             $rank = $line->{'rank'} + 1;
1927         } else {
1928             $rank = 1;
1929         }
1930     }
1931     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1932     $sth->execute( $subscriptionid, $borrowernumber, $rank );
1933 }
1934
1935 =head2 reorder_members
1936
1937 reorder_members($subscriptionid,$routingid,$rank)
1938
1939 this function is used to reorder the routing list
1940
1941 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1942 - it gets all members on list puts their routingid's into an array
1943 - removes the one in the array that is $routingid
1944 - then reinjects $routingid at point indicated by $rank
1945 - then update the database with the routingids in the new order
1946
1947 =cut
1948
1949 sub reorder_members {
1950     my ( $subscriptionid, $routingid, $rank ) = @_;
1951     my $dbh = C4::Context->dbh;
1952     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1953     $sth->execute($subscriptionid);
1954     my @result;
1955     while ( my $line = $sth->fetchrow_hashref ) {
1956         push( @result, $line->{'routingid'} );
1957     }
1958
1959     # To find the matching index
1960     my $i;
1961     my $key = -1;    # to allow for 0 being a valid response
1962     for ( $i = 0 ; $i < @result ; $i++ ) {
1963         if ( $routingid == $result[$i] ) {
1964             $key = $i;    # save the index
1965             last;
1966         }
1967     }
1968
1969     # if index exists in array then move it to new position
1970     if ( $key > -1 && $rank > 0 ) {
1971         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
1972         my $moving_item = splice( @result, $key, 1 );
1973         splice( @result, $new_rank, 0, $moving_item );
1974     }
1975     for ( my $j = 0 ; $j < @result ; $j++ ) {
1976         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1977         $sth->execute;
1978     }
1979     return;
1980 }
1981
1982 =head2 delroutingmember
1983
1984 delroutingmember($routingid,$subscriptionid)
1985
1986 this function either deletes one member from routing list if $routingid exists otherwise
1987 deletes all members from the routing list
1988
1989 =cut
1990
1991 sub delroutingmember {
1992
1993     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1994     my ( $routingid, $subscriptionid ) = @_;
1995     my $dbh = C4::Context->dbh;
1996     if ($routingid) {
1997         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1998         $sth->execute($routingid);
1999         reorder_members( $subscriptionid, $routingid );
2000     } else {
2001         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2002         $sth->execute($subscriptionid);
2003     }
2004     return;
2005 }
2006
2007 =head2 getroutinglist
2008
2009 @routinglist = getroutinglist($subscriptionid)
2010
2011 this gets the info from the subscriptionroutinglist for $subscriptionid
2012
2013 return :
2014 the routinglist as an array. Each element of the array contains a hash_ref containing
2015 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2016
2017 =cut
2018
2019 sub getroutinglist {
2020     my ($subscriptionid) = @_;
2021     my $dbh              = C4::Context->dbh;
2022     my $sth              = $dbh->prepare(
2023         'SELECT routingid, borrowernumber, ranking, biblionumber
2024             FROM subscription
2025             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2026             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2027     );
2028     $sth->execute($subscriptionid);
2029     my $routinglist = $sth->fetchall_arrayref({});
2030     return @{$routinglist};
2031 }
2032
2033 =head2 countissuesfrom
2034
2035 $result = countissuesfrom($subscriptionid,$startdate)
2036
2037 Returns a count of serial rows matching the given subsctiptionid
2038 with published date greater than startdate
2039
2040 =cut
2041
2042 sub countissuesfrom {
2043     my ( $subscriptionid, $startdate ) = @_;
2044     my $dbh   = C4::Context->dbh;
2045     my $query = qq|
2046             SELECT count(*)
2047             FROM   serial
2048             WHERE  subscriptionid=?
2049             AND serial.publisheddate>?
2050         |;
2051     my $sth = $dbh->prepare($query);
2052     $sth->execute( $subscriptionid, $startdate );
2053     my ($countreceived) = $sth->fetchrow;
2054     return $countreceived;
2055 }
2056
2057 =head2 CountIssues
2058
2059 $result = CountIssues($subscriptionid)
2060
2061 Returns a count of serial rows matching the given subsctiptionid
2062
2063 =cut
2064
2065 sub CountIssues {
2066     my ($subscriptionid) = @_;
2067     my $dbh              = C4::Context->dbh;
2068     my $query            = qq|
2069             SELECT count(*)
2070             FROM   serial
2071             WHERE  subscriptionid=?
2072         |;
2073     my $sth = $dbh->prepare($query);
2074     $sth->execute($subscriptionid);
2075     my ($countreceived) = $sth->fetchrow;
2076     return $countreceived;
2077 }
2078
2079 =head2 HasItems
2080
2081 $result = HasItems($subscriptionid)
2082
2083 returns a count of items from serial matching the subscriptionid
2084
2085 =cut
2086
2087 sub HasItems {
2088     my ($subscriptionid) = @_;
2089     my $dbh              = C4::Context->dbh;
2090     my $query = q|
2091             SELECT COUNT(serialitems.itemnumber)
2092             FROM   serial
2093                         LEFT JOIN serialitems USING(serialid)
2094             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2095         |;
2096     my $sth=$dbh->prepare($query);
2097     $sth->execute($subscriptionid);
2098     my ($countitems)=$sth->fetchrow_array();
2099     return $countitems;
2100 }
2101
2102 =head2 abouttoexpire
2103
2104 $result = abouttoexpire($subscriptionid)
2105
2106 this function alerts you to the penultimate issue for a serial subscription
2107
2108 returns 1 - if this is the penultimate issue
2109 returns 0 - if not
2110
2111 =cut
2112
2113 sub abouttoexpire {
2114     my ($subscriptionid) = @_;
2115     my $dbh              = C4::Context->dbh;
2116     my $subscription     = GetSubscription($subscriptionid);
2117     my $per = $subscription->{'periodicity'};
2118     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2119     if ($frequency and $frequency->{unit}){
2120
2121         my $expirationdate = GetExpirationDate($subscriptionid);
2122
2123         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2124         my $nextdate = GetNextDate($subscription, $res);
2125
2126         # only compare dates if both dates exist.
2127         if ($nextdate and $expirationdate) {
2128             if(Date::Calc::Delta_Days(
2129                 split( /-/, $nextdate ),
2130                 split( /-/, $expirationdate )
2131             ) <= 0) {
2132                 return 1;
2133             }
2134         }
2135
2136     } elsif ($subscription->{numberlength}>0) {
2137         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2138     }
2139
2140     return 0;
2141 }
2142
2143 =head2 GetFictiveIssueNumber
2144
2145 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2146
2147 Get the position of the issue published at $publisheddate, considering the
2148 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2149 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2150 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2151 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2152 depending on how many rows are in serial table.
2153 The issue number calculation is based on subscription frequency, first acquisition
2154 date, and $publisheddate.
2155
2156 Returns undef when called for irregular frequencies.
2157
2158 The routine is used to skip irregularities when calculating the next issue
2159 date (in GetNextDate) or the next issue number (in GetNextSeq).
2160
2161 =cut
2162
2163 sub GetFictiveIssueNumber {
2164     my ($subscription, $publisheddate) = @_;
2165
2166     my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2167     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2168     return if !$unit;
2169     my $issueno;
2170
2171     my ( $year, $month, $day ) = split /-/, $publisheddate;
2172     my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2173     my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2174
2175     if( $frequency->{'unitsperissue'} == 1 ) {
2176         $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2177     } else { # issuesperunit == 1
2178         $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2179     }
2180     return $issueno;
2181 }
2182
2183 sub _delta_units {
2184     my ( $date1, $date2, $unit ) = @_;
2185     # date1 and date2 are array refs in the form [ yy, mm, dd ]
2186
2187     if( $unit eq 'day' ) {
2188         return Delta_Days( @$date1, @$date2 );
2189     } elsif( $unit eq 'week' ) {
2190         return int( Delta_Days( @$date1, @$date2 ) / 7 );
2191     }
2192
2193     # In case of months or years, this is a wrapper around N_Delta_YMD.
2194     # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2195     # while we expect 1 month.
2196     my @delta = N_Delta_YMD( @$date1, @$date2 );
2197     if( $delta[2] > 27 ) {
2198         # Check if we could add a month
2199         my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2200         if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2201             $delta[1]++;
2202         }
2203     }
2204     if( $delta[1] >= 12 ) {
2205         $delta[0]++;
2206         $delta[1] -= 12;
2207     }
2208     # if unit is year, we only return full years
2209     return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2210 }
2211
2212 sub _get_next_date_day {
2213     my ($subscription, $freqdata, $year, $month, $day) = @_;
2214
2215     my @newissue; # ( yy, mm, dd )
2216     # We do not need $delta_days here, since it would be zero where used
2217
2218     if( $freqdata->{issuesperunit} == 1 ) {
2219         # Add full days
2220         @newissue = Add_Delta_Days(
2221             $year, $month, $day, $freqdata->{"unitsperissue"} );
2222     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2223         # Add zero days
2224         @newissue = ( $year, $month, $day );
2225         $subscription->{countissuesperunit}++;
2226     } else {
2227         # We finished a cycle of issues within a unit.
2228         # No subtraction of zero needed, just add one day
2229         @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2230         $subscription->{countissuesperunit} = 1;
2231     }
2232     return @newissue;
2233 }
2234
2235 sub _get_next_date_week {
2236     my ($subscription, $freqdata, $year, $month, $day) = @_;
2237
2238     my @newissue; # ( yy, mm, dd )
2239     my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2240
2241     if( $freqdata->{issuesperunit} == 1 ) {
2242         # Add full weeks (of 7 days)
2243         @newissue = Add_Delta_Days(
2244             $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2245     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2246         # Add rounded number of days based on frequency.
2247         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2248         $subscription->{countissuesperunit}++;
2249     } else {
2250         # We finished a cycle of issues within a unit.
2251         # Subtract delta * (issues - 1), add 1 week
2252         @newissue = Add_Delta_Days( $year, $month, $day,
2253             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2254         @newissue = Add_Delta_Days( @newissue, 7 );
2255         $subscription->{countissuesperunit} = 1;
2256     }
2257     return @newissue;
2258 }
2259
2260 sub _get_next_date_month {
2261     my ($subscription, $freqdata, $year, $month, $day) = @_;
2262
2263     my @newissue; # ( yy, mm, dd )
2264     my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2265
2266     if( $freqdata->{issuesperunit} == 1 ) {
2267         # Add full months
2268         @newissue = Add_Delta_YM(
2269             $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2270     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2271         # Add rounded number of days based on frequency.
2272         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2273         $subscription->{countissuesperunit}++;
2274     } else {
2275         # We finished a cycle of issues within a unit.
2276         # Subtract delta * (issues - 1), add 1 month
2277         @newissue = Add_Delta_Days( $year, $month, $day,
2278             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2279         @newissue = Add_Delta_YM( @newissue, 0, 1 );
2280         $subscription->{countissuesperunit} = 1;
2281     }
2282     return @newissue;
2283 }
2284
2285 sub _get_next_date_year {
2286     my ($subscription, $freqdata, $year, $month, $day) = @_;
2287
2288     my @newissue; # ( yy, mm, dd )
2289     my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2290
2291     if( $freqdata->{issuesperunit} == 1 ) {
2292         # Add full years
2293         @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2294     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2295         # Add rounded number of days based on frequency.
2296         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2297         $subscription->{countissuesperunit}++;
2298     } else {
2299         # We finished a cycle of issues within a unit.
2300         # Subtract delta * (issues - 1), add 1 year
2301         @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2302         @newissue = Add_Delta_YM( @newissue, 1, 0 );
2303         $subscription->{countissuesperunit} = 1;
2304     }
2305     return @newissue;
2306 }
2307
2308 =head2 GetNextDate
2309
2310 $resultdate = GetNextDate($publisheddate,$subscription)
2311
2312 this function it takes the publisheddate and will return the next issue's date
2313 and will skip dates if there exists an irregularity.
2314 $publisheddate has to be an ISO date
2315 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2316 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2317 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2318 skipped then the returned date will be 2007-05-10
2319
2320 return :
2321 $resultdate - then next date in the sequence (ISO date)
2322
2323 Return undef if subscription is irregular
2324
2325 =cut
2326
2327 sub GetNextDate {
2328     my ( $subscription, $publisheddate, $updatecount ) = @_;
2329
2330     return unless $subscription and $publisheddate;
2331
2332     my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2333
2334     if ($freqdata->{'unit'}) {
2335         my ( $year, $month, $day ) = split /-/, $publisheddate;
2336
2337         # Process an irregularity Hash
2338         # Suppose that irregularities are stored in a string with this structure
2339         # irreg1;irreg2;irreg3
2340         # where irregX is the number of issue which will not be received
2341         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2342         my %irregularities;
2343         if ( $subscription->{irregularity} ) {
2344             my @irreg = split /;/, $subscription->{'irregularity'} ;
2345             foreach my $irregularity (@irreg) {
2346                 $irregularities{$irregularity} = 1;
2347             }
2348         }
2349
2350         # Get the 'fictive' next issue number
2351         # It is used to check if next issue is an irregular issue.
2352         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2353
2354         # Then get the next date
2355         my $unit = lc $freqdata->{'unit'};
2356         if ($unit eq 'day') {
2357             while ($irregularities{$issueno}) {
2358                 ($year, $month, $day) = _get_next_date_day($subscription,
2359                     $freqdata, $year, $month, $day);
2360                 $issueno++;
2361             }
2362             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2363                 $year, $month, $day);
2364         }
2365         elsif ($unit eq 'week') {
2366             while ($irregularities{$issueno}) {
2367                 ($year, $month, $day) = _get_next_date_week($subscription,
2368                     $freqdata, $year, $month, $day);
2369                 $issueno++;
2370             }
2371             ($year, $month, $day) = _get_next_date_week($subscription,
2372                 $freqdata, $year, $month, $day);
2373         }
2374         elsif ($unit eq 'month') {
2375             while ($irregularities{$issueno}) {
2376                 ($year, $month, $day) = _get_next_date_month($subscription,
2377                     $freqdata, $year, $month, $day);
2378                 $issueno++;
2379             }
2380             ($year, $month, $day) = _get_next_date_month($subscription,
2381                 $freqdata, $year, $month, $day);
2382         }
2383         elsif ($unit eq 'year') {
2384             while ($irregularities{$issueno}) {
2385                 ($year, $month, $day) = _get_next_date_year($subscription,
2386                     $freqdata, $year, $month, $day);
2387                 $issueno++;
2388             }
2389             ($year, $month, $day) = _get_next_date_year($subscription,
2390                 $freqdata, $year, $month, $day);
2391         }
2392
2393         if ($updatecount){
2394             my $dbh = C4::Context->dbh;
2395             my $query = qq{
2396                 UPDATE subscription
2397                 SET countissuesperunit = ?
2398                 WHERE subscriptionid = ?
2399             };
2400             my $sth = $dbh->prepare($query);
2401             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2402         }
2403
2404         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2405     }
2406 }
2407
2408 =head2 _numeration
2409
2410   $string = &_numeration($value,$num_type,$locale);
2411
2412 _numeration returns the string corresponding to $value in the num_type
2413 num_type can take :
2414     -dayname
2415     -dayabrv
2416     -monthname
2417     -monthabrv
2418     -season
2419     -seasonabrv
2420
2421 =cut
2422
2423 sub _numeration {
2424     my ($value, $num_type, $locale) = @_;
2425     $value ||= 0;
2426     $num_type //= '';
2427     $locale ||= 'en';
2428     my $string;
2429     if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2430         # 1970-11-01 was a Sunday
2431         $value = $value % 7;
2432         my $dt = DateTime->new(
2433             year    => 1970,
2434             month   => 11,
2435             day     => $value + 1,
2436             locale  => $locale,
2437         );
2438         $string = $num_type =~ /^dayname$/
2439             ? $dt->strftime("%A")
2440             : $dt->strftime("%a");
2441     } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2442         $value = $value % 12;
2443         my $dt = DateTime->new(
2444             year    => 1970,
2445             month   => $value + 1,
2446             locale  => $locale,
2447         );
2448         $string = $num_type =~ /^monthname$/
2449             ? $dt->strftime("%B")
2450             : $dt->strftime("%b");
2451     } elsif ( $num_type =~ /^season$/ ) {
2452         my @seasons= qw( Spring Summer Fall Winter );
2453         $value = $value % 4;
2454         $string = $seasons[$value];
2455     } elsif ( $num_type =~ /^seasonabrv$/ ) {
2456         my @seasonsabrv= qw( Spr Sum Fal Win );
2457         $value = $value % 4;
2458         $string = $seasonsabrv[$value];
2459     } else {
2460         $string = $value;
2461     }
2462
2463     return $string;
2464 }
2465
2466 =head2 CloseSubscription
2467
2468 Close a subscription given a subscriptionid
2469
2470 =cut
2471
2472 sub CloseSubscription {
2473     my ( $subscriptionid ) = @_;
2474     return unless $subscriptionid;
2475     my $dbh = C4::Context->dbh;
2476     my $sth = $dbh->prepare( q{
2477         UPDATE subscription
2478         SET closed = 1
2479         WHERE subscriptionid = ?
2480     } );
2481     $sth->execute( $subscriptionid );
2482
2483     # Set status = missing when status = stopped
2484     $sth = $dbh->prepare( q{
2485         UPDATE serial
2486         SET status = ?
2487         WHERE subscriptionid = ?
2488         AND status = ?
2489     } );
2490     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2491 }
2492
2493 =head2 ReopenSubscription
2494
2495 Reopen a subscription given a subscriptionid
2496
2497 =cut
2498
2499 sub ReopenSubscription {
2500     my ( $subscriptionid ) = @_;
2501     return unless $subscriptionid;
2502     my $dbh = C4::Context->dbh;
2503     my $sth = $dbh->prepare( q{
2504         UPDATE subscription
2505         SET closed = 0
2506         WHERE subscriptionid = ?
2507     } );
2508     $sth->execute( $subscriptionid );
2509
2510     # Set status = expected when status = stopped
2511     $sth = $dbh->prepare( q{
2512         UPDATE serial
2513         SET status = ?
2514         WHERE subscriptionid = ?
2515         AND status = ?
2516     } );
2517     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2518 }
2519
2520 =head2 subscriptionCurrentlyOnOrder
2521
2522     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2523
2524 Return 1 if subscription is currently on order else 0.
2525
2526 =cut
2527
2528 sub subscriptionCurrentlyOnOrder {
2529     my ( $subscriptionid ) = @_;
2530     my $dbh = C4::Context->dbh;
2531     my $query = qq|
2532         SELECT COUNT(*) FROM aqorders
2533         WHERE subscriptionid = ?
2534             AND datereceived IS NULL
2535             AND datecancellationprinted IS NULL
2536     |;
2537     my $sth = $dbh->prepare( $query );
2538     $sth->execute($subscriptionid);
2539     return $sth->fetchrow_array;
2540 }
2541
2542 =head2 can_claim_subscription
2543
2544     $can = can_claim_subscription( $subscriptionid[, $userid] );
2545
2546 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2547
2548 =cut
2549
2550 sub can_claim_subscription {
2551     my ( $subscription, $userid ) = @_;
2552     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2553 }
2554
2555 =head2 can_edit_subscription
2556
2557     $can = can_edit_subscription( $subscriptionid[, $userid] );
2558
2559 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2560
2561 =cut
2562
2563 sub can_edit_subscription {
2564     my ( $subscription, $userid ) = @_;
2565     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2566 }
2567
2568 =head2 can_show_subscription
2569
2570     $can = can_show_subscription( $subscriptionid[, $userid] );
2571
2572 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2573
2574 =cut
2575
2576 sub can_show_subscription {
2577     my ( $subscription, $userid ) = @_;
2578     return _can_do_on_subscription( $subscription, $userid, '*' );
2579 }
2580
2581 sub _can_do_on_subscription {
2582     my ( $subscription, $userid, $permission ) = @_;
2583     return 0 unless C4::Context->userenv;
2584     my $flags = C4::Context->userenv->{flags};
2585     $userid ||= C4::Context->userenv->{'id'};
2586
2587     if ( C4::Context->preference('IndependentBranches') ) {
2588         return 1
2589           if C4::Context->IsSuperLibrarian()
2590               or
2591               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2592               or (
2593                   C4::Auth::haspermission( $userid,
2594                       { serials => $permission } )
2595                   and (  not defined $subscription->{branchcode}
2596                       or $subscription->{branchcode} eq ''
2597                       or $subscription->{branchcode} eq
2598                       C4::Context->userenv->{'branch'} )
2599               );
2600     }
2601     else {
2602         return 1
2603           if C4::Context->IsSuperLibrarian()
2604               or
2605               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2606               or C4::Auth::haspermission(
2607                   $userid, { serials => $permission }
2608               ),
2609         ;
2610     }
2611     return 0;
2612 }
2613
2614 =head2 findSerialsByStatus
2615
2616     @serials = findSerialsByStatus($status, $subscriptionid);
2617
2618     Returns an array of serials matching a given status and subscription id.
2619
2620 =cut
2621
2622 sub findSerialsByStatus {
2623     my ( $status, $subscriptionid ) = @_;
2624     my $dbh   = C4::Context->dbh;
2625     my $query = q| SELECT * from serial
2626                     WHERE status = ?
2627                     AND subscriptionid = ?
2628                 |;
2629     my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2630     return @$serials;
2631 }
2632
2633 1;
2634 __END__
2635
2636 =head1 AUTHOR
2637
2638 Koha Development Team <http://koha-community.org/>
2639
2640 =cut