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