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