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