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