C4/Serials.pm

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