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