C4/Serials.pm

   1 package C4::Serials;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Parts Copyright 2010 Biblibre
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22
  23 use C4::Auth qw(haspermission);
  24 use C4::Context;
  25 use DateTime;
  26 use Date::Calc qw(:all);
  27 use POSIX qw(strftime);
  28 use C4::Biblio;
  29 use C4::Log;    # logaction
  30 use C4::Debug;
  31 use C4::Serials::Frequency;
  32 use C4::Serials::Numberpattern;
  33 use Koha::AdditionalFieldValues;
  34 use Koha::DateUtils;
  35 use Koha::Serial;
  36 use Koha::Subscriptions;
  37 use Koha::Subscription::Histories;
  38 use Koha::SharedContent;
  39
  40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  41
  42 # Define statuses
  43 use constant {
  44     EXPECTED               => 1,
  45     ARRIVED                => 2,
  46     LATE                   => 3,
  47     MISSING                => 4,
  48     MISSING_NEVER_RECIEVED => 41,
  49     MISSING_SOLD_OUT       => 42,
  50     MISSING_DAMAGED        => 43,
  51     MISSING_LOST           => 44,
  52     NOT_ISSUED             => 5,
  53     DELETED                => 6,
  54     CLAIMED                => 7,
  55     STOPPED                => 8,
  56 };
  57
  58 use constant MISSING_STATUSES => (
  59     MISSING,          MISSING_NEVER_RECIEVED,
  60     MISSING_SOLD_OUT, MISSING_DAMAGED,
  61     MISSING_LOST
  62 );
  63
  64 BEGIN {
  65     require Exporter;
  66     @ISA    = qw(Exporter);
  67     @EXPORT = qw(
  68       &NewSubscription    &ModSubscription    &DelSubscription
  69       &GetSubscription    &CountSubscriptionFromBiblionumber      &GetSubscriptionsFromBiblionumber
  70       &SearchSubscriptions
  71       &GetFullSubscriptionsFromBiblionumber   &GetFullSubscription &ModSubscriptionHistory
  72       &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
  73       &GetSubscriptionHistoryFromSubscriptionId
  74
  75       &GetNextSeq &GetSeq &NewIssue           &GetSerials
  76       &GetLatestSerials   &ModSerialStatus    &GetNextDate       &GetSerials2
  77       &ReNewSubscription  &GetLateOrMissingIssues
  78       &GetSerialInformation                   &AddItem2Serial
  79       &PrepareSerialsData &GetNextExpected    &ModNextExpected
  80       &GetPreviousSerialid
  81
  82       &GetSuppliersWithLateIssues
  83       &getroutinglist     &delroutingmember   &addroutingmember
  84       &reorder_members
  85       &check_routing &updateClaim
  86       &CountIssues
  87       HasItems
  88       &subscriptionCurrentlyOnOrder
  89
  90     );
  91 }
  92
  93 =head1 NAME
  94
  95 C4::Serials - Serials Module Functions
  96
  97 =head1 SYNOPSIS
  98
  99   use C4::Serials;
 100
 101 =head1 DESCRIPTION
 102
 103 Functions for handling subscriptions, claims routing etc.
 104
 105
 106 =head1 SUBROUTINES
 107
 108 =head2 GetSuppliersWithLateIssues
 109
 110 $supplierlist = GetSuppliersWithLateIssues()
 111
 112 this function get all suppliers with late issues.
 113
 114 return :
 115 an array_ref of suppliers each entry is a hash_ref containing id and name
 116 the array is in name order
 117
 118 =cut
 119
 120 sub GetSuppliersWithLateIssues {
 121     my $dbh   = C4::Context->dbh;
 122     my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
 123     my $query = qq|
 124     SELECT DISTINCT id, name
 125     FROM            subscription
 126     LEFT JOIN       serial ON serial.subscriptionid=subscription.subscriptionid
 127     LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 128     WHERE id > 0
 129         AND (
 130             (planneddate < now() AND serial.status=1)
 131             OR serial.STATUS IN ( $statuses )
 132         )
 133         AND subscription.closed = 0
 134     ORDER BY name|;
 135     return $dbh->selectall_arrayref($query, { Slice => {} });
 136 }
 137
 138 =head2 GetSubscriptionHistoryFromSubscriptionId
 139
 140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
 141
 142 This function returns the subscription history as a hashref
 143
 144 =cut
 145
 146 sub GetSubscriptionHistoryFromSubscriptionId {
 147     my ($subscriptionid) = @_;
 148
 149     return unless $subscriptionid;
 150
 151     my $dbh   = C4::Context->dbh;
 152     my $query = qq|
 153         SELECT *
 154         FROM   subscriptionhistory
 155         WHERE  subscriptionid = ?
 156     |;
 157     my $sth = $dbh->prepare($query);
 158     $sth->execute($subscriptionid);
 159     my $results = $sth->fetchrow_hashref;
 160     $sth->finish;
 161
 162     return $results;
 163 }
 164
 165 =head2 GetSerialInformation
 166
 167 $data = GetSerialInformation($serialid);
 168 returns a hash_ref containing :
 169   items : items marcrecord (can be an array)
 170   serial table field
 171   subscription table field
 172   + information about subscription expiration
 173
 174 =cut
 175
 176 sub GetSerialInformation {
 177     my ($serialid) = @_;
 178     my $dbh        = C4::Context->dbh;
 179     my $query      = qq|
 180         SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
 181         FROM   serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
 182         WHERE  serialid = ?
 183     |;
 184     my $rq = $dbh->prepare($query);
 185     $rq->execute($serialid);
 186     my $data = $rq->fetchrow_hashref;
 187
 188     # create item information if we have serialsadditems for this subscription
 189     if ( $data->{'serialsadditems'} ) {
 190         my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
 191         $queryitem->execute($serialid);
 192         my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
 193         require C4::Items;
 194         if ( scalar(@$itemnumbers) > 0 ) {
 195             foreach my $itemnum (@$itemnumbers) {
 196
 197                 #It is ASSUMED that GetMarcItem ALWAYS WORK...
 198                 #Maybe GetMarcItem should return values on failure
 199                 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
 200                 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
 201                 $itemprocessed->{'itemnumber'}   = $itemnum->[0];
 202                 $itemprocessed->{'itemid'}       = $itemnum->[0];
 203                 $itemprocessed->{'serialid'}     = $serialid;
 204                 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 205                 push @{ $data->{'items'} }, $itemprocessed;
 206             }
 207         } else {
 208             my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
 209             $itemprocessed->{'itemid'}       = "N$serialid";
 210             $itemprocessed->{'serialid'}     = $serialid;
 211             $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 212             $itemprocessed->{'countitems'}   = 0;
 213             push @{ $data->{'items'} }, $itemprocessed;
 214         }
 215     }
 216     $data->{ "status" . $data->{'serstatus'} } = 1;
 217     $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
 218     $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
 219     $data->{cannotedit} = not can_edit_subscription( $data );
 220     return $data;
 221 }
 222
 223 =head2 AddItem2Serial
 224
 225 $rows = AddItem2Serial($serialid,$itemnumber);
 226 Adds an itemnumber to Serial record
 227 returns the number of rows affected
 228
 229 =cut
 230
 231 sub AddItem2Serial {
 232     my ( $serialid, $itemnumber ) = @_;
 233
 234     return unless ($serialid and $itemnumber);
 235
 236     my $dbh = C4::Context->dbh;
 237     my $rq  = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
 238     $rq->execute( $serialid, $itemnumber );
 239     return $rq->rows;
 240 }
 241
 242 =head2 GetSubscription
 243
 244 $subs = GetSubscription($subscriptionid)
 245 this function returns the subscription which has $subscriptionid as id.
 246 return :
 247 a hashref. This hash contains
 248 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
 249
 250 =cut
 251
 252 sub GetSubscription {
 253     my ($subscriptionid) = @_;
 254     my $dbh              = C4::Context->dbh;
 255     my $query            = qq(
 256         SELECT  subscription.*,
 257                 subscriptionhistory.*,
 258                 aqbooksellers.name AS aqbooksellername,
 259                 biblio.title AS bibliotitle,
 260                 subscription.biblionumber as bibnum
 261        FROM subscription
 262        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 263        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 264        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 265        WHERE subscription.subscriptionid = ?
 266     );
 267
 268     $debug and warn "query : $query\nsubsid :$subscriptionid";
 269     my $sth = $dbh->prepare($query);
 270     $sth->execute($subscriptionid);
 271     my $subscription = $sth->fetchrow_hashref;
 272
 273     return unless $subscription;
 274
 275     $subscription->{cannotedit} = not can_edit_subscription( $subscription );
 276
 277     if ( my $mana_id = $subscription->{mana_id} ) {
 278         my $mana_subscription = Koha::SharedContent::get_entity_by_id(
 279             'subscription', $mana_id, {usecomments => 1});
 280         $subscription->{comments} = $mana_subscription->{data}->{comments};
 281     }
 282
 283     return $subscription;
 284 }
 285
 286 =head2 GetFullSubscription
 287
 288    $array_ref = GetFullSubscription($subscriptionid)
 289    this function reads the serial table.
 290
 291 =cut
 292
 293 sub GetFullSubscription {
 294     my ($subscriptionid) = @_;
 295
 296     return unless ($subscriptionid);
 297
 298     my $dbh              = C4::Context->dbh;
 299     my $query            = qq|
 300   SELECT    serial.serialid,
 301             serial.serialseq,
 302             serial.planneddate,
 303             serial.publisheddate,
 304             serial.publisheddatetext,
 305             serial.status,
 306             serial.notes as notes,
 307             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 308             aqbooksellers.name as aqbooksellername,
 309             biblio.title as bibliotitle,
 310             subscription.branchcode AS branchcode,
 311             subscription.subscriptionid AS subscriptionid
 312   FROM      serial
 313   LEFT JOIN subscription ON
 314           (serial.subscriptionid=subscription.subscriptionid )
 315   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 316   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 317   WHERE     serial.subscriptionid = ?
 318   ORDER BY year DESC,
 319           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 320           serial.subscriptionid
 321           |;
 322     $debug and warn "GetFullSubscription query: $query";
 323     my $sth = $dbh->prepare($query);
 324     $sth->execute($subscriptionid);
 325     my $subscriptions = $sth->fetchall_arrayref( {} );
 326     my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
 327     for my $subscription ( @$subscriptions ) {
 328         $subscription->{cannotedit} = $cannotedit;
 329     }
 330     return $subscriptions;
 331 }
 332
 333 =head2 PrepareSerialsData
 334
 335    $array_ref = PrepareSerialsData($serialinfomation)
 336    where serialinformation is a hashref array
 337
 338 =cut
 339
 340 sub PrepareSerialsData {
 341     my ($lines) = @_;
 342
 343     return unless ($lines);
 344
 345     my %tmpresults;
 346     my $year;
 347     my @res;
 348     my $startdate;
 349     my $aqbooksellername;
 350     my $bibliotitle;
 351     my @loopissues;
 352     my $first;
 353     my $previousnote = "";
 354
 355     foreach my $subs (@{$lines}) {
 356         for my $datefield ( qw(publisheddate planneddate) ) {
 357             # handle 0000-00-00 dates
 358             if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
 359                 $subs->{$datefield} = undef;
 360             }
 361         }
 362         $subs->{ "status" . $subs->{'status'} } = 1;
 363         if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
 364             $subs->{"checked"} = 1;
 365         }
 366
 367         if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
 368             $year = $subs->{'year'};
 369         } else {
 370             $year = "manage";
 371         }
 372         if ( $tmpresults{$year} ) {
 373             push @{ $tmpresults{$year}->{'serials'} }, $subs;
 374         } else {
 375             $tmpresults{$year} = {
 376                 'year'             => $year,
 377                 'aqbooksellername' => $subs->{'aqbooksellername'},
 378                 'bibliotitle'      => $subs->{'bibliotitle'},
 379                 'serials'          => [$subs],
 380                 'first'            => $first,
 381             };
 382         }
 383     }
 384     foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
 385         push @res, $tmpresults{$key};
 386     }
 387     return \@res;
 388 }
 389
 390 =head2 GetSubscriptionsFromBiblionumber
 391
 392 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
 393 this function get the subscription list. it reads the subscription table.
 394 return :
 395 reference to an array of subscriptions which have the biblionumber given on input arg.
 396 each element of this array is a hashref containing
 397 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
 398
 399 =cut
 400
 401 sub GetSubscriptionsFromBiblionumber {
 402     my ($biblionumber) = @_;
 403
 404     return unless ($biblionumber);
 405
 406     my $dbh            = C4::Context->dbh;
 407     my $query          = qq(
 408         SELECT subscription.*,
 409                branches.branchname,
 410                subscriptionhistory.*,
 411                aqbooksellers.name AS aqbooksellername,
 412                biblio.title AS bibliotitle
 413        FROM subscription
 414        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 415        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 416        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 417        LEFT JOIN branches ON branches.branchcode=subscription.branchcode
 418        WHERE subscription.biblionumber = ?
 419     );
 420     my $sth = $dbh->prepare($query);
 421     $sth->execute($biblionumber);
 422     my @res;
 423     while ( my $subs = $sth->fetchrow_hashref ) {
 424         $subs->{startdate}     = output_pref( { dt => dt_from_string( $subs->{startdate} ),     dateonly => 1 } );
 425         $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
 426         if ( defined $subs->{histenddate} ) {
 427            $subs->{histenddate}   = output_pref( { dt => dt_from_string( $subs->{histenddate} ),   dateonly => 1 } );
 428         } else {
 429             $subs->{histenddate} = "";
 430         }
 431         $subs->{opacnote}     =~ s/\n/\<br\/\>/g;
 432         $subs->{missinglist}  =~ s/\n/\<br\/\>/g;
 433         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 434         $subs->{ "periodicity" . $subs->{periodicity} }     = 1;
 435         $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
 436         $subs->{ "status" . $subs->{'status'} }             = 1;
 437
 438         if (not defined $subs->{enddate} ) {
 439             $subs->{enddate} = '';
 440         } else {
 441             $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
 442         }
 443         $subs->{'abouttoexpire'}       = abouttoexpire( $subs->{'subscriptionid'} );
 444         $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
 445         $subs->{cannotedit} = not can_edit_subscription( $subs );
 446         push @res, $subs;
 447     }
 448     return \@res;
 449 }
 450
 451 =head2 GetFullSubscriptionsFromBiblionumber
 452
 453    $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
 454    this function reads the serial table.
 455
 456 =cut
 457
 458 sub GetFullSubscriptionsFromBiblionumber {
 459     my ($biblionumber) = @_;
 460     my $dbh            = C4::Context->dbh;
 461     my $query          = qq|
 462   SELECT    serial.serialid,
 463             serial.serialseq,
 464             serial.planneddate,
 465             serial.publisheddate,
 466             serial.publisheddatetext,
 467             serial.status,
 468             serial.notes as notes,
 469             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 470             biblio.title as bibliotitle,
 471             subscription.branchcode AS branchcode,
 472             subscription.subscriptionid AS subscriptionid
 473   FROM      serial
 474   LEFT JOIN subscription ON
 475           (serial.subscriptionid=subscription.subscriptionid)
 476   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 477   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 478   WHERE     subscription.biblionumber = ?
 479   ORDER BY year DESC,
 480           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 481           serial.subscriptionid
 482           |;
 483     my $sth = $dbh->prepare($query);
 484     $sth->execute($biblionumber);
 485     my $subscriptions = $sth->fetchall_arrayref( {} );
 486     my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
 487     for my $subscription ( @$subscriptions ) {
 488         $subscription->{cannotedit} = $cannotedit;
 489     }
 490     return $subscriptions;
 491 }
 492
 493 =head2 SearchSubscriptions
 494
 495   @results = SearchSubscriptions($args);
 496
 497 This function returns a list of hashrefs, one for each subscription
 498 that meets the conditions specified by the $args hashref.
 499
 500 The valid search fields are:
 501
 502   biblionumber
 503   title
 504   issn
 505   ean
 506   callnumber
 507   location
 508   publisher
 509   bookseller
 510   branch
 511   expiration_date
 512   closed
 513
 514 The expiration_date search field is special; it specifies the maximum
 515 subscription expiration date.
 516
 517 =cut
 518
 519 sub SearchSubscriptions {
 520     my ( $args ) = @_;
 521
 522     my $additional_fields = $args->{additional_fields} // [];
 523     my $matching_record_ids_for_additional_fields = [];
 524     if ( @$additional_fields ) {
 525         my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
 526
 527         return () unless @subscriptions;
 528
 529         $matching_record_ids_for_additional_fields = [ map {
 530             $_->subscriptionid
 531         } @subscriptions ];
 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 $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
 629         $subscription->{additional_fields} = { map { $_->field->name => $_->value }
 630             $subscription_object->additional_field_values->as_list };
 631
 632     }
 633
 634     return @$results;
 635 }
 636
 637
 638 =head2 GetSerials
 639
 640 ($totalissues,@serials) = GetSerials($subscriptionid);
 641 this function gets every serial not arrived for a given subscription
 642 as well as the number of issues registered in the database (all types)
 643 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 644
 645 FIXME: We should return \@serials.
 646
 647 =cut
 648
 649 sub GetSerials {
 650     my ( $subscriptionid, $count ) = @_;
 651
 652     return unless $subscriptionid;
 653
 654     my $dbh = C4::Context->dbh;
 655
 656     # status = 2 is "arrived"
 657     my $counter = 0;
 658     $count = 5 unless ($count);
 659     my @serials;
 660     my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
 661     my $query = "SELECT serialid,serialseq, status, publisheddate,
 662         publisheddatetext, planneddate,notes, routingnotes
 663                         FROM   serial
 664                         WHERE  subscriptionid = ? AND status NOT IN ( $statuses )
 665                         ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
 666     my $sth = $dbh->prepare($query);
 667     $sth->execute($subscriptionid);
 668
 669     while ( my $line = $sth->fetchrow_hashref ) {
 670         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 671         for my $datefield ( qw( planneddate publisheddate) ) {
 672             if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
 673                 $line->{$datefield} =  output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 674             } else {
 675                 $line->{$datefield} = q{};
 676             }
 677         }
 678         push @serials, $line;
 679     }
 680
 681     # OK, now add the last 5 issues arrives/missing
 682     $query = "SELECT   serialid,serialseq, status, planneddate, publisheddate,
 683         publisheddatetext, notes, routingnotes
 684        FROM     serial
 685        WHERE    subscriptionid = ?
 686        AND      status IN ( $statuses )
 687        ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
 688       ";
 689     $sth = $dbh->prepare($query);
 690     $sth->execute($subscriptionid);
 691     while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
 692         $counter++;
 693         $line->{ "status" . $line->{status} } = 1;                                         # fills a "statusX" value, used for template status select list
 694         for my $datefield ( qw( planneddate publisheddate) ) {
 695             if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
 696                 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 697             } else {
 698                 $line->{$datefield} = q{};
 699             }
 700         }
 701
 702         push @serials, $line;
 703     }
 704
 705     $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
 706     $sth   = $dbh->prepare($query);
 707     $sth->execute($subscriptionid);
 708     my ($totalissues) = $sth->fetchrow;
 709     return ( $totalissues, @serials );
 710 }
 711
 712 =head2 GetSerials2
 713
 714 @serials = GetSerials2($subscriptionid,$statuses);
 715 this function returns every serial waited for a given subscription
 716 as well as the number of issues registered in the database (all types)
 717 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 718
 719 $statuses is an arrayref of statuses and is mandatory.
 720
 721 =cut
 722
 723 sub GetSerials2 {
 724     my ( $subscription, $statuses ) = @_;
 725
 726     return unless ($subscription and @$statuses);
 727
 728     my $dbh   = C4::Context->dbh;
 729     my $query = q|
 730                  SELECT serialid,serialseq, status, planneddate, publisheddate,
 731                     publisheddatetext, notes, routingnotes
 732                  FROM     serial
 733                  WHERE    subscriptionid=?
 734             |
 735             . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
 736             . q|
 737                  ORDER BY publisheddate,serialid DESC
 738     |;
 739     $debug and warn "GetSerials2 query: $query";
 740     my $sth = $dbh->prepare($query);
 741     $sth->execute( $subscription, @$statuses );
 742     my @serials;
 743
 744     while ( my $line = $sth->fetchrow_hashref ) {
 745         $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
 746         # Format dates for display
 747         for my $datefield ( qw( planneddate publisheddate ) ) {
 748             if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
 749                 $line->{$datefield} = q{};
 750             }
 751             else {
 752                 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
 753             }
 754         }
 755         push @serials, $line;
 756     }
 757     return @serials;
 758 }
 759
 760 =head2 GetLatestSerials
 761
 762 \@serials = GetLatestSerials($subscriptionid,$limit)
 763 get the $limit's latest serials arrived or missing for a given subscription
 764 return :
 765 a ref to an array which contains all of the latest serials stored into a hash.
 766
 767 =cut
 768
 769 sub GetLatestSerials {
 770     my ( $subscriptionid, $limit ) = @_;
 771
 772     return unless ($subscriptionid and $limit);
 773
 774     my $dbh = C4::Context->dbh;
 775
 776     my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
 777     my $strsth = "SELECT   serialid,serialseq, status, planneddate, publisheddate, notes
 778                         FROM     serial
 779                         WHERE    subscriptionid = ?
 780                         AND      status IN ($statuses)
 781                         ORDER BY publisheddate DESC LIMIT 0,$limit
 782                 ";
 783     my $sth = $dbh->prepare($strsth);
 784     $sth->execute($subscriptionid);
 785     my @serials;
 786     while ( my $line = $sth->fetchrow_hashref ) {
 787         $line->{ "status" . $line->{status} } = 1;                        # fills a "statusX" value, used for template status select list
 788         push @serials, $line;
 789     }
 790
 791     return \@serials;
 792 }
 793
 794 =head2 GetPreviousSerialid
 795
 796 $serialid = GetPreviousSerialid($subscriptionid, $nth)
 797 get the $nth's previous serial for the given subscriptionid
 798 return :
 799 the serialid
 800
 801 =cut
 802
 803 sub GetPreviousSerialid {
 804     my ( $subscriptionid, $nth ) = @_;
 805     $nth ||= 1;
 806     my $dbh = C4::Context->dbh;
 807     my $return = undef;
 808
 809     # Status 2: Arrived
 810     my $strsth = "SELECT   serialid
 811                         FROM     serial
 812                         WHERE    subscriptionid = ?
 813                         AND      status = 2
 814                         ORDER BY serialid DESC LIMIT $nth,1
 815                 ";
 816     my $sth = $dbh->prepare($strsth);
 817     $sth->execute($subscriptionid);
 818     my @serials;
 819     my $line = $sth->fetchrow_hashref;
 820     $return = $line->{'serialid'} if ($line);
 821
 822     return $return;
 823 }
 824
 825 =head2 GetNextSeq
 826
 827     my (
 828         $nextseq,       $newlastvalue1, $newlastvalue2, $newlastvalue3,
 829         $newinnerloop1, $newinnerloop2, $newinnerloop3
 830     ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
 831
 832 $subscription is a hashref containing all the attributes of the table
 833 'subscription'.
 834 $pattern is a hashref containing all the attributes of the table
 835 'subscription_numberpatterns'.
 836 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
 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, $frequency, $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, $frequency) + 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, $frequency );
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         my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1151
1152         # next issue number
1153         my (
1154             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1155             $newinnerloop1, $newinnerloop2, $newinnerloop3
1156           )
1157           = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1158
1159         # next date (calculated from actual date & frequency parameters)
1160         my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1161         my $nextpubdate = $nextpublisheddate;
1162         $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1163                     WHERE  subscriptionid = ?";
1164         $sth = $dbh->prepare($query);
1165         $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1166         NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, $publisheddatetext, $notes, $routingnotes );
1167         # check if an alert must be sent... (= a letter is defined & status became "arrived"
1168         if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1169             require C4::Letters;
1170             C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1171         }
1172     }
1173
1174     return;
1175 }
1176
1177 =head2 GetNextExpected
1178
1179 $nextexpected = GetNextExpected($subscriptionid)
1180
1181 Get the planneddate for the current expected issue of the subscription.
1182
1183 returns a hashref:
1184
1185 $nextexepected = {
1186     serialid => int
1187     planneddate => ISO date
1188     }
1189
1190 =cut
1191
1192 sub GetNextExpected {
1193     my ($subscriptionid) = @_;
1194
1195     my $dbh = C4::Context->dbh;
1196     my $query = qq{
1197         SELECT *
1198         FROM serial
1199         WHERE subscriptionid = ?
1200           AND status = ?
1201         LIMIT 1
1202     };
1203     my $sth = $dbh->prepare($query);
1204
1205     # Each subscription has only one 'expected' issue.
1206     $sth->execute( $subscriptionid, EXPECTED );
1207     my $nextissue = $sth->fetchrow_hashref;
1208     if ( !$nextissue ) {
1209         $query = qq{
1210             SELECT *
1211             FROM serial
1212             WHERE subscriptionid = ?
1213             ORDER BY publisheddate DESC
1214             LIMIT 1
1215         };
1216         $sth = $dbh->prepare($query);
1217         $sth->execute($subscriptionid);
1218         $nextissue = $sth->fetchrow_hashref;
1219     }
1220     foreach(qw/planneddate publisheddate/) {
1221         if ( !defined $nextissue->{$_} ) {
1222             # or should this default to 1st Jan ???
1223             $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1224         }
1225         $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1226                          ? $nextissue->{$_}
1227                          : undef;
1228     }
1229
1230     return $nextissue;
1231 }
1232
1233 =head2 ModNextExpected
1234
1235 ModNextExpected($subscriptionid,$date)
1236
1237 Update the planneddate for the current expected issue of the subscription.
1238 This will modify all future prediction results.
1239
1240 C<$date> is an ISO date.
1241
1242 returns 0
1243
1244 =cut
1245
1246 sub ModNextExpected {
1247     my ( $subscriptionid, $date ) = @_;
1248     my $dbh = C4::Context->dbh;
1249
1250     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1251     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1252
1253     # Each subscription has only one 'expected' issue.
1254     $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1255     return 0;
1256
1257 }
1258
1259 =head2 GetSubscriptionIrregularities
1260
1261 =over 4
1262
1263 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1264 get the list of irregularities for a subscription
1265
1266 =back
1267
1268 =cut
1269
1270 sub GetSubscriptionIrregularities {
1271     my $subscriptionid = shift;
1272
1273     return unless $subscriptionid;
1274
1275     my $dbh = C4::Context->dbh;
1276     my $query = qq{
1277         SELECT irregularity
1278         FROM subscription
1279         WHERE subscriptionid = ?
1280     };
1281     my $sth = $dbh->prepare($query);
1282     $sth->execute($subscriptionid);
1283
1284     my ($result) = $sth->fetchrow_array;
1285     my @irreg = split /;/, $result;
1286
1287     return @irreg;
1288 }
1289
1290 =head2 ModSubscription
1291
1292 this function modifies a subscription. Put all new values on input args.
1293 returns the number of rows affected
1294
1295 =cut
1296
1297 sub ModSubscription {
1298     my (
1299     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1300     $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1301     $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1302     $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1303     $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1304     $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1305     $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1306     $itemtype, $previousitemtype, $mana_id
1307     ) = @_;
1308
1309     my $dbh   = C4::Context->dbh;
1310     my $query = "UPDATE subscription
1311         SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1312             startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1313             numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1314             lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1315             lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1316             callnumber=?, notes=?, letter=?, manualhistory=?,
1317             internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1318             opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1319             skip_serialseq=?, itemtype=?, previousitemtype=?, mana_id=?
1320         WHERE subscriptionid = ?";
1321
1322     my $sth = $dbh->prepare($query);
1323     $sth->execute(
1324         $auser,           $branchcode,     $aqbooksellerid, $cost,
1325         $aqbudgetid,      $startdate,      $periodicity,    $firstacquidate,
1326         $irregularity,    $numberpattern,  $locale,         $numberlength,
1327         $weeklength,      $monthlength,    $lastvalue1,     $innerloop1,
1328         $lastvalue2,      $innerloop2,     $lastvalue3,     $innerloop3,
1329         $status,          $biblionumber,   $callnumber,     $notes,
1330         $letter,          ($manualhistory ? $manualhistory : 0),
1331         $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1332         $graceperiod,     $location,       $enddate,        $skip_serialseq,
1333         $itemtype,        $previousitemtype, $mana_id,
1334         $subscriptionid
1335     );
1336     my $rows = $sth->rows;
1337
1338     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1339     return $rows;
1340 }
1341
1342 =head2 NewSubscription
1343
1344 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1345     $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1346     $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1347     $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1348     $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1349     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1350     $skip_serialseq, $itemtype, $previousitemtype);
1351
1352 Create a new subscription with value given on input args.
1353
1354 return :
1355 the id of this new subscription
1356
1357 =cut
1358
1359 sub NewSubscription {
1360     my (
1361     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1362     $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1363     $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1364     $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1365     $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1366     $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1367     $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1368     ) = @_;
1369     my $dbh = C4::Context->dbh;
1370
1371     my $subscription = Koha::Subscription->new(
1372         {
1373             librarian         => $auser,
1374             branchcode        => $branchcode,
1375             aqbooksellerid    => $aqbooksellerid,
1376             cost              => $cost,
1377             aqbudgetid        => $aqbudgetid,
1378             biblionumber      => $biblionumber,
1379             startdate         => $startdate,
1380             periodicity       => $periodicity,
1381             numberlength      => $numberlength,
1382             weeklength        => $weeklength,
1383             monthlength       => $monthlength,
1384             lastvalue1        => $lastvalue1,
1385             innerloop1        => $innerloop1,
1386             lastvalue2        => $lastvalue2,
1387             innerloop2        => $innerloop2,
1388             lastvalue3        => $lastvalue3,
1389             innerloop3        => $innerloop3,
1390             status            => $status,
1391             notes             => $notes,
1392             letter            => $letter,
1393             firstacquidate    => $firstacquidate,
1394             irregularity      => $irregularity,
1395             numberpattern     => $numberpattern,
1396             locale            => $locale,
1397             callnumber        => $callnumber,
1398             manualhistory     => $manualhistory,
1399             internalnotes     => $internalnotes,
1400             serialsadditems   => $serialsadditems,
1401             staffdisplaycount => $staffdisplaycount,
1402             opacdisplaycount  => $opacdisplaycount,
1403             graceperiod       => $graceperiod,
1404             location          => $location,
1405             enddate           => $enddate,
1406             skip_serialseq    => $skip_serialseq,
1407             itemtype          => $itemtype,
1408             previousitemtype  => $previousitemtype,
1409             mana_id           => $mana_id,
1410         }
1411     )->store;
1412     $subscription->discard_changes;
1413     my $subscriptionid = $subscription->subscriptionid;
1414     my ( $query, $sth );
1415     unless ($enddate) {
1416         $enddate = GetExpirationDate( $subscriptionid, $startdate );
1417         $query = qq|
1418             UPDATE subscription
1419             SET    enddate=?
1420             WHERE  subscriptionid=?
1421         |;
1422         $sth = $dbh->prepare($query);
1423         $sth->execute( $enddate, $subscriptionid );
1424     }
1425
1426     # then create the 1st expected number
1427     $query = qq(
1428         INSERT INTO subscriptionhistory
1429             (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1430         VALUES (?,?,?, '', '')
1431         );
1432     $sth = $dbh->prepare($query);
1433     $sth->execute( $biblionumber, $subscriptionid, $startdate);
1434
1435     # reread subscription to get a hash (for calculation of the 1st issue number)
1436     $subscription = GetSubscription($subscriptionid); # We should not do that
1437     my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1438
1439     # calculate issue number
1440     my $serialseq = GetSeq($subscription, $pattern) || q{};
1441
1442     Koha::Serial->new(
1443         {
1444             serialseq      => $serialseq,
1445             serialseq_x    => $subscription->{'lastvalue1'},
1446             serialseq_y    => $subscription->{'lastvalue2'},
1447             serialseq_z    => $subscription->{'lastvalue3'},
1448             subscriptionid => $subscriptionid,
1449             biblionumber   => $biblionumber,
1450             status         => EXPECTED,
1451             planneddate    => $firstacquidate,
1452             publisheddate  => $firstacquidate,
1453         }
1454     )->store();
1455
1456     logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1457
1458     #set serial flag on biblio if not already set.
1459     my $biblio = Koha::Biblios->find( $biblionumber );
1460     if ( $biblio and !$biblio->serial ) {
1461         my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1462         my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1463         if ($tag) {
1464             eval { $record->field($tag)->update( $subf => 1 ); };
1465         }
1466         ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1467     }
1468     return $subscriptionid;
1469 }
1470
1471 =head2 ReNewSubscription
1472
1473 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1474
1475 this function renew a subscription with values given on input args.
1476
1477 =cut
1478
1479 sub ReNewSubscription {
1480     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1481     my $dbh          = C4::Context->dbh;
1482     my $subscription = GetSubscription($subscriptionid);
1483     my $query        = qq|
1484          SELECT *
1485          FROM   biblio
1486          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1487          WHERE    biblio.biblionumber=?
1488      |;
1489     my $sth = $dbh->prepare($query);
1490     $sth->execute( $subscription->{biblionumber} );
1491     my $biblio = $sth->fetchrow_hashref;
1492
1493     if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1494         require C4::Suggestions;
1495         C4::Suggestions::NewSuggestion(
1496             {   'suggestedby'   => $user,
1497                 'title'         => $subscription->{bibliotitle},
1498                 'author'        => $biblio->{author},
1499                 'publishercode' => $biblio->{publishercode},
1500                 'note'          => $biblio->{note},
1501                 'biblionumber'  => $subscription->{biblionumber}
1502             }
1503         );
1504     }
1505
1506     $numberlength ||= 0; # Should not we raise an exception instead?
1507     $weeklength   ||= 0;
1508
1509     # renew subscription
1510     $query = qq|
1511         UPDATE subscription
1512         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1513         WHERE  subscriptionid=?
1514     |;
1515     $sth = $dbh->prepare($query);
1516     $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1517     my $enddate = GetExpirationDate($subscriptionid);
1518         $debug && warn "enddate :$enddate";
1519     $query = qq|
1520         UPDATE subscription
1521         SET    enddate=?
1522         WHERE  subscriptionid=?
1523     |;
1524     $sth = $dbh->prepare($query);
1525     $sth->execute( $enddate, $subscriptionid );
1526
1527     logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1528     return;
1529 }
1530
1531 =head2 NewIssue
1532
1533 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1534
1535 Create a new issue stored on the database.
1536 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1537 returns the serial id
1538
1539 =cut
1540
1541 sub NewIssue {
1542     my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1543         $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1544     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1545
1546     return unless ($subscriptionid);
1547
1548     my $schema = Koha::Database->new()->schema();
1549
1550     my $subscription = Koha::Subscriptions->find( $subscriptionid );
1551
1552     my $serial = Koha::Serial->new(
1553         {
1554             serialseq         => $serialseq,
1555             serialseq_x       => $subscription->lastvalue1(),
1556             serialseq_y       => $subscription->lastvalue2(),
1557             serialseq_z       => $subscription->lastvalue3(),
1558             subscriptionid    => $subscriptionid,
1559             biblionumber      => $biblionumber,
1560             status            => $status,
1561             planneddate       => $planneddate,
1562             publisheddate     => $publisheddate,
1563             publisheddatetext => $publisheddatetext,
1564             notes             => $notes,
1565             routingnotes      => $routingnotes
1566         }
1567     )->store();
1568
1569     my $serialid = $serial->id();
1570
1571     my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1572     my $missinglist = $subscription_history->missinglist();
1573     my $recievedlist = $subscription_history->recievedlist();
1574
1575     if ( $status == ARRIVED ) {
1576         ### TODO Add a feature that improves recognition and description.
1577         ### As such count (serialseq) i.e. : N18,2(N19),N20
1578         ### Would use substr and index But be careful to previous presence of ()
1579         $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1580     }
1581     if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1582         $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1583     }
1584
1585     $recievedlist =~ s/^; //;
1586     $missinglist  =~ s/^; //;
1587
1588     $subscription_history->recievedlist($recievedlist);
1589     $subscription_history->missinglist($missinglist);
1590     $subscription_history->store();
1591
1592     return $serialid;
1593 }
1594
1595 =head2 HasSubscriptionStrictlyExpired
1596
1597 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1598
1599 the subscription has stricly expired when today > the end subscription date
1600
1601 return :
1602 1 if true, 0 if false, -1 if the expiration date is not set.
1603
1604 =cut
1605
1606 sub HasSubscriptionStrictlyExpired {
1607
1608     # Getting end of subscription date
1609     my ($subscriptionid) = @_;
1610
1611     return unless ($subscriptionid);
1612
1613     my $dbh              = C4::Context->dbh;
1614     my $subscription     = GetSubscription($subscriptionid);
1615     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1616
1617     # If the expiration date is set
1618     if ( $expirationdate != 0 ) {
1619         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1620
1621         # Getting today's date
1622         my ( $nowyear, $nowmonth, $nowday ) = Today();
1623
1624         # if today's date > expiration date, then the subscription has stricly expired
1625         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1626             return 1;
1627         } else {
1628             return 0;
1629         }
1630     } else {
1631
1632         # There are some cases where the expiration date is not set
1633         # As we can't determine if the subscription has expired on a date-basis,
1634         # we return -1;
1635         return -1;
1636     }
1637 }
1638
1639 =head2 HasSubscriptionExpired
1640
1641 $has_expired = HasSubscriptionExpired($subscriptionid)
1642
1643 the subscription has expired when the next issue to arrive is out of subscription limit.
1644
1645 return :
1646 0 if the subscription has not expired
1647 1 if the subscription has expired
1648 2 if has subscription does not have a valid expiration date set
1649
1650 =cut
1651
1652 sub HasSubscriptionExpired {
1653     my ($subscriptionid) = @_;
1654
1655     return unless ($subscriptionid);
1656
1657     my $dbh              = C4::Context->dbh;
1658     my $subscription     = GetSubscription($subscriptionid);
1659     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1660     if ( $frequency and $frequency->{unit} ) {
1661         my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1662         if (!defined $expirationdate) {
1663             $expirationdate = q{};
1664         }
1665         my $query          = qq|
1666             SELECT max(planneddate)
1667             FROM   serial
1668             WHERE  subscriptionid=?
1669       |;
1670         my $sth = $dbh->prepare($query);
1671         $sth->execute($subscriptionid);
1672         my ($res) = $sth->fetchrow;
1673         if (!$res || $res=~m/^0000/) {
1674             return 0;
1675         }
1676         my @res                   = split( /-/, $res );
1677         my @endofsubscriptiondate = split( /-/, $expirationdate );
1678         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1679         return 1
1680           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1681             || ( !$res ) );
1682         return 0;
1683     } else {
1684         # Irregular
1685         if ( $subscription->{'numberlength'} ) {
1686             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1687             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1688             return 0;
1689         } else {
1690             return 0;
1691         }
1692     }
1693     return 0;    # Notice that you'll never get here.
1694 }
1695
1696 =head2 DelSubscription
1697
1698 DelSubscription($subscriptionid)
1699 this function deletes subscription which has $subscriptionid as id.
1700
1701 =cut
1702
1703 sub DelSubscription {
1704     my ($subscriptionid) = @_;
1705     my $dbh = C4::Context->dbh;
1706     $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1707     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1708     $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1709
1710     Koha::AdditionalFieldValues->search({
1711         'field.tablename' => 'subscription',
1712         'me.record_id' => $subscriptionid,
1713     }, { join => 'field' })->delete;
1714
1715     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1716 }
1717
1718 =head2 DelIssue
1719
1720 DelIssue($serialseq,$subscriptionid)
1721 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1722
1723 returns the number of rows affected
1724
1725 =cut
1726
1727 sub DelIssue {
1728     my ($dataissue) = @_;
1729     my $dbh = C4::Context->dbh;
1730     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1731
1732     my $query = qq|
1733         DELETE FROM serial
1734         WHERE       serialid= ?
1735         AND         subscriptionid= ?
1736     |;
1737     my $mainsth = $dbh->prepare($query);
1738     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1739
1740     #Delete element from subscription history
1741     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1742     my $sth = $dbh->prepare($query);
1743     $sth->execute( $dataissue->{'subscriptionid'} );
1744     my $val = $sth->fetchrow_hashref;
1745     unless ( $val->{manualhistory} ) {
1746         my $query = qq|
1747           SELECT * FROM subscriptionhistory
1748           WHERE       subscriptionid= ?
1749       |;
1750         my $sth = $dbh->prepare($query);
1751         $sth->execute( $dataissue->{'subscriptionid'} );
1752         my $data      = $sth->fetchrow_hashref;
1753         my $serialseq = $dataissue->{'serialseq'};
1754         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1755         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1756         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1757         $sth = $dbh->prepare($strsth);
1758         $sth->execute( $dataissue->{'subscriptionid'} );
1759     }
1760
1761     return $mainsth->rows;
1762 }
1763
1764 =head2 GetLateOrMissingIssues
1765
1766 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1767
1768 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1769
1770 return :
1771 the issuelist as an array of hash refs. Each element of this array contains
1772 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1773
1774 =cut
1775
1776 sub GetLateOrMissingIssues {
1777     my ( $supplierid, $serialid, $order ) = @_;
1778
1779     return unless ( $supplierid or $serialid );
1780
1781     my $dbh = C4::Context->dbh;
1782
1783     my $sth;
1784     my $byserial = '';
1785     if ($serialid) {
1786         $byserial = "and serialid = " . $serialid;
1787     }
1788     if ($order) {
1789         $order .= ", title";
1790     } else {
1791         $order = "title";
1792     }
1793     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1794     if ($supplierid) {
1795         $sth = $dbh->prepare(
1796             "SELECT
1797                 serialid,      aqbooksellerid,        name,
1798                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1799                 serial.status, serial.subscriptionid, claimdate, claims_count,
1800                 subscription.branchcode
1801             FROM      serial
1802                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1803                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1804                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1805                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1806                 WHERE subscription.subscriptionid = serial.subscriptionid
1807                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1808                 AND subscription.aqbooksellerid=$supplierid
1809                 $byserial
1810                 ORDER BY $order"
1811         );
1812     } else {
1813         $sth = $dbh->prepare(
1814             "SELECT
1815             serialid,      aqbooksellerid,         name,
1816             biblio.title,  planneddate,           serialseq,
1817                 serial.status, serial.subscriptionid, claimdate, claims_count,
1818                 subscription.branchcode
1819             FROM serial
1820                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1821                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1822                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1823                 WHERE subscription.subscriptionid = serial.subscriptionid
1824                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1825                 $byserial
1826                 ORDER BY $order"
1827         );
1828     }
1829     $sth->execute( EXPECTED, LATE, CLAIMED );
1830     my @issuelist;
1831     while ( my $line = $sth->fetchrow_hashref ) {
1832
1833         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1834             $line->{planneddateISO} = $line->{planneddate};
1835             $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1836         }
1837         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1838             $line->{claimdateISO} = $line->{claimdate};
1839             $line->{claimdate}   = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1840         }
1841         $line->{"status".$line->{status}}   = 1;
1842
1843         my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1844         $line->{additional_fields} = { map { $_->field->name => $_->value }
1845             $subscription_object->additional_field_values->as_list };
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, $frequency);
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, $frequency);
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, $frequency) = @_;
2165
2166     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2167     return if !$unit;
2168     my $issueno;
2169
2170     my ( $year, $month, $day ) = split /-/, $publisheddate;
2171     my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2172     my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2173
2174     if( $frequency->{'unitsperissue'} == 1 ) {
2175         $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2176     } else { # issuesperunit == 1
2177         $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2178     }
2179     return $issueno;
2180 }
2181
2182 sub _delta_units {
2183     my ( $date1, $date2, $unit ) = @_;
2184     # date1 and date2 are array refs in the form [ yy, mm, dd ]
2185
2186     if( $unit eq 'day' ) {
2187         return Delta_Days( @$date1, @$date2 );
2188     } elsif( $unit eq 'week' ) {
2189         return int( Delta_Days( @$date1, @$date2 ) / 7 );
2190     }
2191
2192     # In case of months or years, this is a wrapper around N_Delta_YMD.
2193     # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2194     # while we expect 1 month.
2195     my @delta = N_Delta_YMD( @$date1, @$date2 );
2196     if( $delta[2] > 27 ) {
2197         # Check if we could add a month
2198         my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2199         if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2200             $delta[1]++;
2201         }
2202     }
2203     if( $delta[1] >= 12 ) {
2204         $delta[0]++;
2205         $delta[1] -= 12;
2206     }
2207     # if unit is year, we only return full years
2208     return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2209 }
2210
2211 sub _get_next_date_day {
2212     my ($subscription, $freqdata, $year, $month, $day) = @_;
2213
2214     my @newissue; # ( yy, mm, dd )
2215     # We do not need $delta_days here, since it would be zero where used
2216
2217     if( $freqdata->{issuesperunit} == 1 ) {
2218         # Add full days
2219         @newissue = Add_Delta_Days(
2220             $year, $month, $day, $freqdata->{"unitsperissue"} );
2221     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2222         # Add zero days
2223         @newissue = ( $year, $month, $day );
2224         $subscription->{countissuesperunit}++;
2225     } else {
2226         # We finished a cycle of issues within a unit.
2227         # No subtraction of zero needed, just add one day
2228         @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2229         $subscription->{countissuesperunit} = 1;
2230     }
2231     return @newissue;
2232 }
2233
2234 sub _get_next_date_week {
2235     my ($subscription, $freqdata, $year, $month, $day) = @_;
2236
2237     my @newissue; # ( yy, mm, dd )
2238     my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2239
2240     if( $freqdata->{issuesperunit} == 1 ) {
2241         # Add full weeks (of 7 days)
2242         @newissue = Add_Delta_Days(
2243             $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2244     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2245         # Add rounded number of days based on frequency.
2246         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2247         $subscription->{countissuesperunit}++;
2248     } else {
2249         # We finished a cycle of issues within a unit.
2250         # Subtract delta * (issues - 1), add 1 week
2251         @newissue = Add_Delta_Days( $year, $month, $day,
2252             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2253         @newissue = Add_Delta_Days( @newissue, 7 );
2254         $subscription->{countissuesperunit} = 1;
2255     }
2256     return @newissue;
2257 }
2258
2259 sub _get_next_date_month {
2260     my ($subscription, $freqdata, $year, $month, $day) = @_;
2261
2262     my @newissue; # ( yy, mm, dd )
2263     my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2264
2265     if( $freqdata->{issuesperunit} == 1 ) {
2266         # Add full months
2267         @newissue = Add_Delta_YM(
2268             $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2269     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2270         # Add rounded number of days based on frequency.
2271         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2272         $subscription->{countissuesperunit}++;
2273     } else {
2274         # We finished a cycle of issues within a unit.
2275         # Subtract delta * (issues - 1), add 1 month
2276         @newissue = Add_Delta_Days( $year, $month, $day,
2277             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2278         @newissue = Add_Delta_YM( @newissue, 0, 1 );
2279         $subscription->{countissuesperunit} = 1;
2280     }
2281     return @newissue;
2282 }
2283
2284 sub _get_next_date_year {
2285     my ($subscription, $freqdata, $year, $month, $day) = @_;
2286
2287     my @newissue; # ( yy, mm, dd )
2288     my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2289
2290     if( $freqdata->{issuesperunit} == 1 ) {
2291         # Add full years
2292         @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2293     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2294         # Add rounded number of days based on frequency.
2295         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2296         $subscription->{countissuesperunit}++;
2297     } else {
2298         # We finished a cycle of issues within a unit.
2299         # Subtract delta * (issues - 1), add 1 year
2300         @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2301         @newissue = Add_Delta_YM( @newissue, 1, 0 );
2302         $subscription->{countissuesperunit} = 1;
2303     }
2304     return @newissue;
2305 }
2306
2307 =head2 GetNextDate
2308
2309 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2310
2311 this function it takes the publisheddate and will return the next issue's date
2312 and will skip dates if there exists an irregularity.
2313 $publisheddate has to be an ISO date
2314 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2315 $frequency is a hashref containing frequency informations
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, $freqdata, $updatecount ) = @_;
2329
2330     return unless $subscription and $publisheddate;
2331
2332
2333     if ($freqdata->{'unit'}) {
2334         my ( $year, $month, $day ) = split /-/, $publisheddate;
2335
2336         # Process an irregularity Hash
2337         # Suppose that irregularities are stored in a string with this structure
2338         # irreg1;irreg2;irreg3
2339         # where irregX is the number of issue which will not be received
2340         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2341         my %irregularities;
2342         if ( $subscription->{irregularity} ) {
2343             my @irreg = split /;/, $subscription->{'irregularity'} ;
2344             foreach my $irregularity (@irreg) {
2345                 $irregularities{$irregularity} = 1;
2346             }
2347         }
2348
2349         # Get the 'fictive' next issue number
2350         # It is used to check if next issue is an irregular issue.
2351         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2352
2353         # Then get the next date
2354         my $unit = lc $freqdata->{'unit'};
2355         if ($unit eq 'day') {
2356             while ($irregularities{$issueno}) {
2357                 ($year, $month, $day) = _get_next_date_day($subscription,
2358                     $freqdata, $year, $month, $day);
2359                 $issueno++;
2360             }
2361             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2362                 $year, $month, $day);
2363         }
2364         elsif ($unit eq 'week') {
2365             while ($irregularities{$issueno}) {
2366                 ($year, $month, $day) = _get_next_date_week($subscription,
2367                     $freqdata, $year, $month, $day);
2368                 $issueno++;
2369             }
2370             ($year, $month, $day) = _get_next_date_week($subscription,
2371                 $freqdata, $year, $month, $day);
2372         }
2373         elsif ($unit eq 'month') {
2374             while ($irregularities{$issueno}) {
2375                 ($year, $month, $day) = _get_next_date_month($subscription,
2376                     $freqdata, $year, $month, $day);
2377                 $issueno++;
2378             }
2379             ($year, $month, $day) = _get_next_date_month($subscription,
2380                 $freqdata, $year, $month, $day);
2381         }
2382         elsif ($unit eq 'year') {
2383             while ($irregularities{$issueno}) {
2384                 ($year, $month, $day) = _get_next_date_year($subscription,
2385                     $freqdata, $year, $month, $day);
2386                 $issueno++;
2387             }
2388             ($year, $month, $day) = _get_next_date_year($subscription,
2389                 $freqdata, $year, $month, $day);
2390         }
2391
2392         if ($updatecount){
2393             my $dbh = C4::Context->dbh;
2394             my $query = qq{
2395                 UPDATE subscription
2396                 SET countissuesperunit = ?
2397                 WHERE subscriptionid = ?
2398             };
2399             my $sth = $dbh->prepare($query);
2400             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2401         }
2402
2403         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2404     }
2405 }
2406
2407 =head2 _numeration
2408
2409   $string = &_numeration($value,$num_type,$locale);
2410
2411 _numeration returns the string corresponding to $value in the num_type
2412 num_type can take :
2413     -dayname
2414     -dayabrv
2415     -monthname
2416     -monthabrv
2417     -season
2418     -seasonabrv
2419
2420 =cut
2421
2422 sub _numeration {
2423     my ($value, $num_type, $locale) = @_;
2424     $value ||= 0;
2425     $num_type //= '';
2426     $locale ||= 'en';
2427     my $string;
2428     if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2429         # 1970-11-01 was a Sunday
2430         $value = $value % 7;
2431         my $dt = DateTime->new(
2432             year    => 1970,
2433             month   => 11,
2434             day     => $value + 1,
2435             locale  => $locale,
2436         );
2437         $string = $num_type =~ /^dayname$/
2438             ? $dt->strftime("%A")
2439             : $dt->strftime("%a");
2440     } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2441         $value = $value % 12;
2442         my $dt = DateTime->new(
2443             year    => 1970,
2444             month   => $value + 1,
2445             locale  => $locale,
2446         );
2447         $string = $num_type =~ /^monthname$/
2448             ? $dt->strftime("%B")
2449             : $dt->strftime("%b");
2450     } elsif ( $num_type =~ /^season$/ ) {
2451         my @seasons= qw( Spring Summer Fall Winter );
2452         $value = $value % 4;
2453         $string = $seasons[$value];
2454     } elsif ( $num_type =~ /^seasonabrv$/ ) {
2455         my @seasonsabrv= qw( Spr Sum Fal Win );
2456         $value = $value % 4;
2457         $string = $seasonsabrv[$value];
2458     } else {
2459         $string = $value;
2460     }
2461
2462     return $string;
2463 }
2464
2465 =head2 CloseSubscription
2466
2467 Close a subscription given a subscriptionid
2468
2469 =cut
2470
2471 sub CloseSubscription {
2472     my ( $subscriptionid ) = @_;
2473     return unless $subscriptionid;
2474     my $dbh = C4::Context->dbh;
2475     my $sth = $dbh->prepare( q{
2476         UPDATE subscription
2477         SET closed = 1
2478         WHERE subscriptionid = ?
2479     } );
2480     $sth->execute( $subscriptionid );
2481
2482     # Set status = missing when status = stopped
2483     $sth = $dbh->prepare( q{
2484         UPDATE serial
2485         SET status = ?
2486         WHERE subscriptionid = ?
2487         AND status = ?
2488     } );
2489     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2490 }
2491
2492 =head2 ReopenSubscription
2493
2494 Reopen a subscription given a subscriptionid
2495
2496 =cut
2497
2498 sub ReopenSubscription {
2499     my ( $subscriptionid ) = @_;
2500     return unless $subscriptionid;
2501     my $dbh = C4::Context->dbh;
2502     my $sth = $dbh->prepare( q{
2503         UPDATE subscription
2504         SET closed = 0
2505         WHERE subscriptionid = ?
2506     } );
2507     $sth->execute( $subscriptionid );
2508
2509     # Set status = expected when status = stopped
2510     $sth = $dbh->prepare( q{
2511         UPDATE serial
2512         SET status = ?
2513         WHERE subscriptionid = ?
2514         AND status = ?
2515     } );
2516     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2517 }
2518
2519 =head2 subscriptionCurrentlyOnOrder
2520
2521     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2522
2523 Return 1 if subscription is currently on order else 0.
2524
2525 =cut
2526
2527 sub subscriptionCurrentlyOnOrder {
2528     my ( $subscriptionid ) = @_;
2529     my $dbh = C4::Context->dbh;
2530     my $query = qq|
2531         SELECT COUNT(*) FROM aqorders
2532         WHERE subscriptionid = ?
2533             AND datereceived IS NULL
2534             AND datecancellationprinted IS NULL
2535     |;
2536     my $sth = $dbh->prepare( $query );
2537     $sth->execute($subscriptionid);
2538     return $sth->fetchrow_array;
2539 }
2540
2541 =head2 can_claim_subscription
2542
2543     $can = can_claim_subscription( $subscriptionid[, $userid] );
2544
2545 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2546
2547 =cut
2548
2549 sub can_claim_subscription {
2550     my ( $subscription, $userid ) = @_;
2551     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2552 }
2553
2554 =head2 can_edit_subscription
2555
2556     $can = can_edit_subscription( $subscriptionid[, $userid] );
2557
2558 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2559
2560 =cut
2561
2562 sub can_edit_subscription {
2563     my ( $subscription, $userid ) = @_;
2564     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2565 }
2566
2567 =head2 can_show_subscription
2568
2569     $can = can_show_subscription( $subscriptionid[, $userid] );
2570
2571 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2572
2573 =cut
2574
2575 sub can_show_subscription {
2576     my ( $subscription, $userid ) = @_;
2577     return _can_do_on_subscription( $subscription, $userid, '*' );
2578 }
2579
2580 sub _can_do_on_subscription {
2581     my ( $subscription, $userid, $permission ) = @_;
2582     return 0 unless C4::Context->userenv;
2583     my $flags = C4::Context->userenv->{flags};
2584     $userid ||= C4::Context->userenv->{'id'};
2585
2586     if ( C4::Context->preference('IndependentBranches') ) {
2587         return 1
2588           if C4::Context->IsSuperLibrarian()
2589               or
2590               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2591               or (
2592                   C4::Auth::haspermission( $userid,
2593                       { serials => $permission } )
2594                   and (  not defined $subscription->{branchcode}
2595                       or $subscription->{branchcode} eq ''
2596                       or $subscription->{branchcode} eq
2597                       C4::Context->userenv->{'branch'} )
2598               );
2599     }
2600     else {
2601         return 1
2602           if C4::Context->IsSuperLibrarian()
2603               or
2604               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2605               or C4::Auth::haspermission(
2606                   $userid, { serials => $permission }
2607               ),
2608         ;
2609     }
2610     return 0;
2611 }
2612
2613 =head2 findSerialsByStatus
2614
2615     @serials = findSerialsByStatus($status, $subscriptionid);
2616
2617     Returns an array of serials matching a given status and subscription id.
2618
2619 =cut
2620
2621 sub findSerialsByStatus {
2622     my ( $status, $subscriptionid ) = @_;
2623     my $dbh   = C4::Context->dbh;
2624     my $query = q| SELECT * from serial
2625                     WHERE status = ?
2626                     AND subscriptionid = ?
2627                 |;
2628     my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2629     return @$serials;
2630 }
2631
2632 1;
2633 __END__
2634
2635 =head1 AUTHOR
2636
2637 Koha Development Team <http://koha-community.org/>
2638
2639 =cut