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