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