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