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