C4/Serials.pm

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