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