C4/Serials.pm

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