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