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