C4/Serials.pm

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