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