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 .= "; $serialseq"
1123                     if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1124             }
1125
1126             # in case serial has been previously marked as missing
1127             if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1128                 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1129             }
1130
1131             $missinglist .= "; $serialseq"
1132                 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1133             $missinglist .= "; not issued $serialseq"
1134                 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1135
1136             $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1137             $sth   = $dbh->prepare($query);
1138             $recievedlist =~ s/^; //;
1139             $missinglist  =~ s/^; //;
1140             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1141         }
1142     }
1143
1144     # create new expected entry if needed (ie : was "expected" and has changed)
1145     my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1146     if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1147         my $subscription = GetSubscription($subscriptionid);
1148         my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1149         my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1150
1151         # next issue number
1152         my (
1153             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1154             $newinnerloop1, $newinnerloop2, $newinnerloop3
1155           )
1156           = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1157
1158         # next date (calculated from actual date & frequency parameters)
1159         my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1160         my $nextpubdate = $nextpublisheddate;
1161         $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1162                     WHERE  subscriptionid = ?";
1163         $sth = $dbh->prepare($query);
1164         $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1165         my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1166         NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1167         # check if an alert must be sent... (= a letter is defined & status became "arrived"
1168         if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1169             require C4::Letters;
1170             C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1171         }
1172     }
1173
1174     return;
1175 }
1176
1177 =head2 GetNextExpected
1178
1179 $nextexpected = GetNextExpected($subscriptionid)
1180
1181 Get the planneddate for the current expected issue of the subscription.
1182
1183 returns a hashref:
1184
1185 $nextexepected = {
1186     serialid => int
1187     planneddate => ISO date
1188     }
1189
1190 =cut
1191
1192 sub GetNextExpected {
1193     my ($subscriptionid) = @_;
1194
1195     my $dbh = C4::Context->dbh;
1196     my $query = qq{
1197         SELECT *
1198         FROM serial
1199         WHERE subscriptionid = ?
1200           AND status = ?
1201         LIMIT 1
1202     };
1203     my $sth = $dbh->prepare($query);
1204
1205     # Each subscription has only one 'expected' issue.
1206     $sth->execute( $subscriptionid, EXPECTED );
1207     my $nextissue = $sth->fetchrow_hashref;
1208     if ( !$nextissue ) {
1209         $query = qq{
1210             SELECT *
1211             FROM serial
1212             WHERE subscriptionid = ?
1213             ORDER BY publisheddate DESC
1214             LIMIT 1
1215         };
1216         $sth = $dbh->prepare($query);
1217         $sth->execute($subscriptionid);
1218         $nextissue = $sth->fetchrow_hashref;
1219     }
1220     foreach(qw/planneddate publisheddate/) {
1221         if ( !defined $nextissue->{$_} ) {
1222             # or should this default to 1st Jan ???
1223             $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1224         }
1225         $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1226                          ? $nextissue->{$_}
1227                          : undef;
1228     }
1229
1230     return $nextissue;
1231 }
1232
1233 =head2 ModNextExpected
1234
1235 ModNextExpected($subscriptionid,$date)
1236
1237 Update the planneddate for the current expected issue of the subscription.
1238 This will modify all future prediction results.
1239
1240 C<$date> is an ISO date.
1241
1242 returns 0
1243
1244 =cut
1245
1246 sub ModNextExpected {
1247     my ( $subscriptionid, $date ) = @_;
1248     my $dbh = C4::Context->dbh;
1249
1250     #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1251     my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1252
1253     # Each subscription has only one 'expected' issue.
1254     $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1255     return 0;
1256
1257 }
1258
1259 =head2 GetSubscriptionIrregularities
1260
1261 =over 4
1262
1263 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1264 get the list of irregularities for a subscription
1265
1266 =back
1267
1268 =cut
1269
1270 sub GetSubscriptionIrregularities {
1271     my $subscriptionid = shift;
1272
1273     return unless $subscriptionid;
1274
1275     my $dbh = C4::Context->dbh;
1276     my $query = qq{
1277         SELECT irregularity
1278         FROM subscription
1279         WHERE subscriptionid = ?
1280     };
1281     my $sth = $dbh->prepare($query);
1282     $sth->execute($subscriptionid);
1283
1284     my ($result) = $sth->fetchrow_array;
1285     my @irreg = split /;/, $result;
1286
1287     return @irreg;
1288 }
1289
1290 =head2 ModSubscription
1291
1292 this function modifies a subscription. Put all new values on input args.
1293 returns the number of rows affected
1294
1295 =cut
1296
1297 sub ModSubscription {
1298     my (
1299     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1300     $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1301     $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1302     $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1303     $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1304     $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1305     $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1306     $itemtype, $previousitemtype, $mana_id
1307     ) = @_;
1308
1309     my $subscription = Koha::Subscriptions->find($subscriptionid);
1310     $subscription->set(
1311         {
1312             librarian         => $auser,
1313             branchcode        => $branchcode,
1314             aqbooksellerid    => $aqbooksellerid,
1315             cost              => $cost,
1316             aqbudgetid        => $aqbudgetid,
1317             biblionumber      => $biblionumber,
1318             startdate         => $startdate,
1319             periodicity       => $periodicity,
1320             numberlength      => $numberlength,
1321             weeklength        => $weeklength,
1322             monthlength       => $monthlength,
1323             lastvalue1        => $lastvalue1,
1324             innerloop1        => $innerloop1,
1325             lastvalue2        => $lastvalue2,
1326             innerloop2        => $innerloop2,
1327             lastvalue3        => $lastvalue3,
1328             innerloop3        => $innerloop3,
1329             status            => $status,
1330             notes             => $notes,
1331             letter            => $letter,
1332             firstacquidate    => $firstacquidate,
1333             irregularity      => $irregularity,
1334             numberpattern     => $numberpattern,
1335             locale            => $locale,
1336             callnumber        => $callnumber,
1337             manualhistory     => $manualhistory,
1338             internalnotes     => $internalnotes,
1339             serialsadditems   => $serialsadditems,
1340             staffdisplaycount => $staffdisplaycount,
1341             opacdisplaycount  => $opacdisplaycount,
1342             graceperiod       => $graceperiod,
1343             location          => $location,
1344             enddate           => $enddate,
1345             skip_serialseq    => $skip_serialseq,
1346             itemtype          => $itemtype,
1347             previousitemtype  => $previousitemtype,
1348             mana_id           => $mana_id,
1349         }
1350     )->store;
1351
1352     logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1353
1354     $subscription->discard_changes;
1355     return $subscription;
1356 }
1357
1358 =head2 NewSubscription
1359
1360 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1361     $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1362     $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1363     $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1364     $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1365     $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1366     $skip_serialseq, $itemtype, $previousitemtype);
1367
1368 Create a new subscription with value given on input args.
1369
1370 return :
1371 the id of this new subscription
1372
1373 =cut
1374
1375 sub NewSubscription {
1376     my (
1377     $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1378     $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1379     $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1380     $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1381     $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1382     $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1383     $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1384     ) = @_;
1385     my $dbh = C4::Context->dbh;
1386
1387     my $subscription = Koha::Subscription->new(
1388         {
1389             librarian         => $auser,
1390             branchcode        => $branchcode,
1391             aqbooksellerid    => $aqbooksellerid,
1392             cost              => $cost,
1393             aqbudgetid        => $aqbudgetid,
1394             biblionumber      => $biblionumber,
1395             startdate         => $startdate,
1396             periodicity       => $periodicity,
1397             numberlength      => $numberlength,
1398             weeklength        => $weeklength,
1399             monthlength       => $monthlength,
1400             lastvalue1        => $lastvalue1,
1401             innerloop1        => $innerloop1,
1402             lastvalue2        => $lastvalue2,
1403             innerloop2        => $innerloop2,
1404             lastvalue3        => $lastvalue3,
1405             innerloop3        => $innerloop3,
1406             status            => $status,
1407             notes             => $notes,
1408             letter            => $letter,
1409             firstacquidate    => $firstacquidate,
1410             irregularity      => $irregularity,
1411             numberpattern     => $numberpattern,
1412             locale            => $locale,
1413             callnumber        => $callnumber,
1414             manualhistory     => $manualhistory,
1415             internalnotes     => $internalnotes,
1416             serialsadditems   => $serialsadditems,
1417             staffdisplaycount => $staffdisplaycount,
1418             opacdisplaycount  => $opacdisplaycount,
1419             graceperiod       => $graceperiod,
1420             location          => $location,
1421             enddate           => $enddate,
1422             skip_serialseq    => $skip_serialseq,
1423             itemtype          => $itemtype,
1424             previousitemtype  => $previousitemtype,
1425             mana_id           => $mana_id,
1426         }
1427     )->store;
1428     $subscription->discard_changes;
1429     my $subscriptionid = $subscription->subscriptionid;
1430     my ( $query, $sth );
1431     unless ($enddate) {
1432         $enddate = GetExpirationDate( $subscriptionid, $startdate );
1433         $query = qq|
1434             UPDATE subscription
1435             SET    enddate=?
1436             WHERE  subscriptionid=?
1437         |;
1438         $sth = $dbh->prepare($query);
1439         $sth->execute( $enddate, $subscriptionid );
1440     }
1441
1442     # then create the 1st expected number
1443     $query = qq(
1444         INSERT INTO subscriptionhistory
1445             (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1446         VALUES (?,?,?, '', '')
1447         );
1448     $sth = $dbh->prepare($query);
1449     $sth->execute( $biblionumber, $subscriptionid, $startdate);
1450
1451     # reread subscription to get a hash (for calculation of the 1st issue number)
1452     $subscription = GetSubscription($subscriptionid); # We should not do that
1453     my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1454
1455     # calculate issue number
1456     my $serialseq = GetSeq($subscription, $pattern) || q{};
1457
1458     Koha::Serial->new(
1459         {
1460             serialseq      => $serialseq,
1461             serialseq_x    => $subscription->{'lastvalue1'},
1462             serialseq_y    => $subscription->{'lastvalue2'},
1463             serialseq_z    => $subscription->{'lastvalue3'},
1464             subscriptionid => $subscriptionid,
1465             biblionumber   => $biblionumber,
1466             status         => EXPECTED,
1467             planneddate    => $firstacquidate,
1468             publisheddate  => $firstacquidate,
1469         }
1470     )->store();
1471
1472     logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1473
1474     #set serial flag on biblio if not already set.
1475     my $biblio = Koha::Biblios->find( $biblionumber );
1476     if ( $biblio and !$biblio->serial ) {
1477         my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1478         my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1479         if ($tag) {
1480             eval { $record->field($tag)->update( $subf => 1 ); };
1481         }
1482         ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1483     }
1484     return $subscriptionid;
1485 }
1486
1487 =head2 GetSubscriptionLength
1488
1489 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1490
1491 This function calculates the subscription length.
1492
1493 =cut
1494
1495 sub GetSubscriptionLength {
1496     my ($subtype, $length) = @_;
1497
1498     return unless looks_like_number($length);
1499
1500     return
1501     (
1502           $subtype eq 'issues' ? $length : 0,
1503           $subtype eq 'weeks'  ? $length : 0,
1504           $subtype eq 'months' ? $length : 0,
1505     );
1506 }
1507
1508
1509 =head2 ReNewSubscription
1510
1511 ReNewSubscription($params);
1512
1513 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1514
1515 this function renew a subscription with values given on input args.
1516
1517 =cut
1518
1519 sub ReNewSubscription {
1520     my ( $params ) = @_;
1521     my $subscriptionid = $params->{subscriptionid};
1522     my $user           = $params->{user};
1523     my $startdate      = $params->{startdate};
1524     my $numberlength   = $params->{numberlength};
1525     my $weeklength     = $params->{weeklength};
1526     my $monthlength    = $params->{monthlength};
1527     my $note           = $params->{note};
1528     my $branchcode     = $params->{branchcode};
1529
1530     my $dbh          = C4::Context->dbh;
1531     my $subscription = GetSubscription($subscriptionid);
1532     my $query        = qq|
1533          SELECT *
1534          FROM   biblio
1535          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1536          WHERE    biblio.biblionumber=?
1537      |;
1538     my $sth = $dbh->prepare($query);
1539     $sth->execute( $subscription->{biblionumber} );
1540     my $biblio = $sth->fetchrow_hashref;
1541
1542     if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1543         require C4::Suggestions;
1544         C4::Suggestions::NewSuggestion(
1545             {   'suggestedby'   => $user,
1546                 'title'         => $subscription->{bibliotitle},
1547                 'author'        => $biblio->{author},
1548                 'publishercode' => $biblio->{publishercode},
1549                 'note'          => $note,
1550                 'biblionumber'  => $subscription->{biblionumber},
1551                 'branchcode'    => $branchcode,
1552             }
1553         );
1554     }
1555
1556     $numberlength ||= 0; # Should not we raise an exception instead?
1557     $weeklength   ||= 0;
1558
1559     # renew subscription
1560     $query = qq|
1561         UPDATE subscription
1562         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1563         WHERE  subscriptionid=?
1564     |;
1565     $sth = $dbh->prepare($query);
1566     $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1567     my $enddate = GetExpirationDate($subscriptionid);
1568         $debug && warn "enddate :$enddate";
1569     $query = qq|
1570         UPDATE subscription
1571         SET    enddate=?
1572         WHERE  subscriptionid=?
1573     |;
1574     $sth = $dbh->prepare($query);
1575     $sth->execute( $enddate, $subscriptionid );
1576
1577     logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1578     return;
1579 }
1580
1581 =head2 NewIssue
1582
1583 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1584
1585 Create a new issue stored on the database.
1586 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1587 returns the serial id
1588
1589 =cut
1590
1591 sub NewIssue {
1592     my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1593         $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1594     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1595
1596     return unless ($subscriptionid);
1597
1598     my $schema = Koha::Database->new()->schema();
1599
1600     my $subscription = Koha::Subscriptions->find( $subscriptionid );
1601
1602     my $serial = Koha::Serial->new(
1603         {
1604             serialseq         => $serialseq,
1605             serialseq_x       => $subscription->lastvalue1(),
1606             serialseq_y       => $subscription->lastvalue2(),
1607             serialseq_z       => $subscription->lastvalue3(),
1608             subscriptionid    => $subscriptionid,
1609             biblionumber      => $biblionumber,
1610             status            => $status,
1611             planneddate       => $planneddate,
1612             publisheddate     => $publisheddate,
1613             publisheddatetext => $publisheddatetext,
1614             notes             => $notes,
1615             routingnotes      => $routingnotes
1616         }
1617     )->store();
1618
1619     my $serialid = $serial->id();
1620
1621     my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1622     my $missinglist = $subscription_history->missinglist();
1623     my $recievedlist = $subscription_history->recievedlist();
1624
1625     if ( $status == ARRIVED ) {
1626         ### TODO Add a feature that improves recognition and description.
1627         ### As such count (serialseq) i.e. : N18,2(N19),N20
1628         ### Would use substr and index But be careful to previous presence of ()
1629         $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1630     }
1631     if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1632         $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1633     }
1634
1635     $recievedlist =~ s/^; //;
1636     $missinglist  =~ s/^; //;
1637
1638     $subscription_history->recievedlist($recievedlist);
1639     $subscription_history->missinglist($missinglist);
1640     $subscription_history->store();
1641
1642     return $serialid;
1643 }
1644
1645 =head2 HasSubscriptionStrictlyExpired
1646
1647 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1648
1649 the subscription has stricly expired when today > the end subscription date
1650
1651 return :
1652 1 if true, 0 if false, -1 if the expiration date is not set.
1653
1654 =cut
1655
1656 sub HasSubscriptionStrictlyExpired {
1657
1658     # Getting end of subscription date
1659     my ($subscriptionid) = @_;
1660
1661     return unless ($subscriptionid);
1662
1663     my $dbh              = C4::Context->dbh;
1664     my $subscription     = GetSubscription($subscriptionid);
1665     my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1666
1667     # If the expiration date is set
1668     if ( $expirationdate != 0 ) {
1669         my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1670
1671         # Getting today's date
1672         my ( $nowyear, $nowmonth, $nowday ) = Today();
1673
1674         # if today's date > expiration date, then the subscription has stricly expired
1675         if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1676             return 1;
1677         } else {
1678             return 0;
1679         }
1680     } else {
1681
1682         # There are some cases where the expiration date is not set
1683         # As we can't determine if the subscription has expired on a date-basis,
1684         # we return -1;
1685         return -1;
1686     }
1687 }
1688
1689 =head2 HasSubscriptionExpired
1690
1691 $has_expired = HasSubscriptionExpired($subscriptionid)
1692
1693 the subscription has expired when the next issue to arrive is out of subscription limit.
1694
1695 return :
1696 0 if the subscription has not expired
1697 1 if the subscription has expired
1698 2 if has subscription does not have a valid expiration date set
1699
1700 =cut
1701
1702 sub HasSubscriptionExpired {
1703     my ($subscriptionid) = @_;
1704
1705     return unless ($subscriptionid);
1706
1707     my $dbh              = C4::Context->dbh;
1708     my $subscription     = GetSubscription($subscriptionid);
1709     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1710     if ( $frequency and $frequency->{unit} ) {
1711         my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1712         if (!defined $expirationdate) {
1713             $expirationdate = q{};
1714         }
1715         my $query          = qq|
1716             SELECT max(planneddate)
1717             FROM   serial
1718             WHERE  subscriptionid=?
1719       |;
1720         my $sth = $dbh->prepare($query);
1721         $sth->execute($subscriptionid);
1722         my ($res) = $sth->fetchrow;
1723         if (!$res || $res=~m/^0000/) {
1724             return 0;
1725         }
1726         my @res                   = split( /-/, $res );
1727         my @endofsubscriptiondate = split( /-/, $expirationdate );
1728         return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1729         return 1
1730           if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1731             || ( !$res ) );
1732         return 0;
1733     } else {
1734         # Irregular
1735         if ( $subscription->{'numberlength'} ) {
1736             my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1737             return 1 if ( $countreceived > $subscription->{'numberlength'} );
1738             return 0;
1739         } else {
1740             return 0;
1741         }
1742     }
1743     return 0;    # Notice that you'll never get here.
1744 }
1745
1746 =head2 DelSubscription
1747
1748 DelSubscription($subscriptionid)
1749 this function deletes subscription which has $subscriptionid as id.
1750
1751 =cut
1752
1753 sub DelSubscription {
1754     my ($subscriptionid) = @_;
1755     my $dbh = C4::Context->dbh;
1756     $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1757     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1758     $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1759
1760     Koha::AdditionalFieldValues->search({
1761         'field.tablename' => 'subscription',
1762         'me.record_id' => $subscriptionid,
1763     }, { join => 'field' })->delete;
1764
1765     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1766 }
1767
1768 =head2 DelIssue
1769
1770 DelIssue($serialseq,$subscriptionid)
1771 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1772
1773 returns the number of rows affected
1774
1775 =cut
1776
1777 sub DelIssue {
1778     my ($dataissue) = @_;
1779     my $dbh = C4::Context->dbh;
1780     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1781
1782     my $query = qq|
1783         DELETE FROM serial
1784         WHERE       serialid= ?
1785         AND         subscriptionid= ?
1786     |;
1787     my $mainsth = $dbh->prepare($query);
1788     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1789
1790     #Delete element from subscription history
1791     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1792     my $sth = $dbh->prepare($query);
1793     $sth->execute( $dataissue->{'subscriptionid'} );
1794     my $val = $sth->fetchrow_hashref;
1795     unless ( $val->{manualhistory} ) {
1796         my $query = qq|
1797           SELECT * FROM subscriptionhistory
1798           WHERE       subscriptionid= ?
1799       |;
1800         my $sth = $dbh->prepare($query);
1801         $sth->execute( $dataissue->{'subscriptionid'} );
1802         my $data      = $sth->fetchrow_hashref;
1803         my $serialseq = $dataissue->{'serialseq'};
1804         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1805         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1806         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1807         $sth = $dbh->prepare($strsth);
1808         $sth->execute( $dataissue->{'subscriptionid'} );
1809     }
1810
1811     return $mainsth->rows;
1812 }
1813
1814 =head2 GetLateOrMissingIssues
1815
1816 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1817
1818 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1819
1820 return :
1821 the issuelist as an array of hash refs. Each element of this array contains
1822 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1823
1824 =cut
1825
1826 sub GetLateOrMissingIssues {
1827     my ( $supplierid, $serialid, $order ) = @_;
1828
1829     return unless ( $supplierid or $serialid );
1830
1831     my $dbh = C4::Context->dbh;
1832
1833     my $sth;
1834     my $byserial = '';
1835     if ($serialid) {
1836         $byserial = "and serialid = " . $serialid;
1837     }
1838     if ($order) {
1839         $order .= ", title";
1840     } else {
1841         $order = "title";
1842     }
1843     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1844     if ($supplierid) {
1845         $sth = $dbh->prepare(
1846             "SELECT
1847                 serialid,      aqbooksellerid,        name,
1848                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1849                 serial.status, serial.subscriptionid, claimdate, claims_count,
1850                 subscription.branchcode
1851             FROM      serial
1852                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1853                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1854                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1855                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1856                 WHERE subscription.subscriptionid = serial.subscriptionid
1857                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1858                 AND subscription.aqbooksellerid=$supplierid
1859                 $byserial
1860                 ORDER BY $order"
1861         );
1862     } else {
1863         $sth = $dbh->prepare(
1864             "SELECT
1865             serialid,      aqbooksellerid,         name,
1866             biblio.title,  planneddate,           serialseq,
1867                 serial.status, serial.subscriptionid, claimdate, claims_count,
1868                 subscription.branchcode
1869             FROM serial
1870                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1871                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1872                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1873                 WHERE subscription.subscriptionid = serial.subscriptionid
1874                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1875                 $byserial
1876                 ORDER BY $order"
1877         );
1878     }
1879     $sth->execute( EXPECTED, LATE, CLAIMED );
1880     my @issuelist;
1881     while ( my $line = $sth->fetchrow_hashref ) {
1882
1883         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1884             $line->{planneddateISO} = $line->{planneddate};
1885             $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1886         }
1887         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1888             $line->{claimdateISO} = $line->{claimdate};
1889             $line->{claimdate}   = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1890         }
1891         $line->{"status".$line->{status}}   = 1;
1892
1893         my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1894         $line->{additional_fields} = { map { $_->field->name => $_->value }
1895             $subscription_object->additional_field_values->as_list };
1896
1897         push @issuelist, $line;
1898     }
1899     return @issuelist;
1900 }
1901
1902 =head2 updateClaim
1903
1904 &updateClaim($serialid)
1905
1906 this function updates the time when a claim is issued for late/missing items
1907
1908 called from claims.pl file
1909
1910 =cut
1911
1912 sub updateClaim {
1913     my ($serialids) = @_;
1914     return unless $serialids;
1915     unless ( ref $serialids ) {
1916         $serialids = [ $serialids ];
1917     }
1918     my $dbh = C4::Context->dbh;
1919     return $dbh->do(q|
1920         UPDATE serial
1921         SET claimdate = NOW(),
1922             claims_count = claims_count + 1,
1923             status = ?
1924         WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1925         {}, CLAIMED, @$serialids );
1926 }
1927
1928 =head2 check_routing
1929
1930 $result = &check_routing($subscriptionid)
1931
1932 this function checks to see if a serial has a routing list and returns the count of routingid
1933 used to show either an 'add' or 'edit' link
1934
1935 =cut
1936
1937 sub check_routing {
1938     my ($subscriptionid) = @_;
1939
1940     return unless ($subscriptionid);
1941
1942     my $dbh              = C4::Context->dbh;
1943     my $sth              = $dbh->prepare(
1944         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1945                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1946                               WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1947                               "
1948     );
1949     $sth->execute($subscriptionid);
1950     my $line   = $sth->fetchrow_hashref;
1951     my $result = $line->{'routingids'};
1952     return $result;
1953 }
1954
1955 =head2 addroutingmember
1956
1957 addroutingmember($borrowernumber,$subscriptionid)
1958
1959 this function takes a borrowernumber and subscriptionid and adds the member to the
1960 routing list for that serial subscription and gives them a rank on the list
1961 of either 1 or highest current rank + 1
1962
1963 =cut
1964
1965 sub addroutingmember {
1966     my ( $borrowernumber, $subscriptionid ) = @_;
1967
1968     return unless ($borrowernumber and $subscriptionid);
1969
1970     my $rank;
1971     my $dbh = C4::Context->dbh;
1972     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1973     $sth->execute($subscriptionid);
1974     while ( my $line = $sth->fetchrow_hashref ) {
1975         if ( $line->{'rank'} > 0 ) {
1976             $rank = $line->{'rank'} + 1;
1977         } else {
1978             $rank = 1;
1979         }
1980     }
1981     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1982     $sth->execute( $subscriptionid, $borrowernumber, $rank );
1983 }
1984
1985 =head2 reorder_members
1986
1987 reorder_members($subscriptionid,$routingid,$rank)
1988
1989 this function is used to reorder the routing list
1990
1991 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1992 - it gets all members on list puts their routingid's into an array
1993 - removes the one in the array that is $routingid
1994 - then reinjects $routingid at point indicated by $rank
1995 - then update the database with the routingids in the new order
1996
1997 =cut
1998
1999 sub reorder_members {
2000     my ( $subscriptionid, $routingid, $rank ) = @_;
2001     my $dbh = C4::Context->dbh;
2002     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2003     $sth->execute($subscriptionid);
2004     my @result;
2005     while ( my $line = $sth->fetchrow_hashref ) {
2006         push( @result, $line->{'routingid'} );
2007     }
2008
2009     # To find the matching index
2010     my $i;
2011     my $key = -1;    # to allow for 0 being a valid response
2012     for ( $i = 0 ; $i < @result ; $i++ ) {
2013         if ( $routingid == $result[$i] ) {
2014             $key = $i;    # save the index
2015             last;
2016         }
2017     }
2018
2019     # if index exists in array then move it to new position
2020     if ( $key > -1 && $rank > 0 ) {
2021         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
2022         my $moving_item = splice( @result, $key, 1 );
2023         splice( @result, $new_rank, 0, $moving_item );
2024     }
2025     for ( my $j = 0 ; $j < @result ; $j++ ) {
2026         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2027         $sth->execute;
2028     }
2029     return;
2030 }
2031
2032 =head2 delroutingmember
2033
2034 delroutingmember($routingid,$subscriptionid)
2035
2036 this function either deletes one member from routing list if $routingid exists otherwise
2037 deletes all members from the routing list
2038
2039 =cut
2040
2041 sub delroutingmember {
2042
2043     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2044     my ( $routingid, $subscriptionid ) = @_;
2045     my $dbh = C4::Context->dbh;
2046     if ($routingid) {
2047         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2048         $sth->execute($routingid);
2049         reorder_members( $subscriptionid, $routingid );
2050     } else {
2051         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2052         $sth->execute($subscriptionid);
2053     }
2054     return;
2055 }
2056
2057 =head2 getroutinglist
2058
2059 @routinglist = getroutinglist($subscriptionid)
2060
2061 this gets the info from the subscriptionroutinglist for $subscriptionid
2062
2063 return :
2064 the routinglist as an array. Each element of the array contains a hash_ref containing
2065 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2066
2067 =cut
2068
2069 sub getroutinglist {
2070     my ($subscriptionid) = @_;
2071     my $dbh              = C4::Context->dbh;
2072     my $sth              = $dbh->prepare(
2073         'SELECT routingid, borrowernumber, ranking, biblionumber
2074             FROM subscription
2075             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2076             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2077     );
2078     $sth->execute($subscriptionid);
2079     my $routinglist = $sth->fetchall_arrayref({});
2080     return @{$routinglist};
2081 }
2082
2083 =head2 countissuesfrom
2084
2085 $result = countissuesfrom($subscriptionid,$startdate)
2086
2087 Returns a count of serial rows matching the given subsctiptionid
2088 with published date greater than startdate
2089
2090 =cut
2091
2092 sub countissuesfrom {
2093     my ( $subscriptionid, $startdate ) = @_;
2094     my $dbh   = C4::Context->dbh;
2095     my $query = qq|
2096             SELECT count(*)
2097             FROM   serial
2098             WHERE  subscriptionid=?
2099             AND serial.publisheddate>?
2100         |;
2101     my $sth = $dbh->prepare($query);
2102     $sth->execute( $subscriptionid, $startdate );
2103     my ($countreceived) = $sth->fetchrow;
2104     return $countreceived;
2105 }
2106
2107 =head2 CountIssues
2108
2109 $result = CountIssues($subscriptionid)
2110
2111 Returns a count of serial rows matching the given subsctiptionid
2112
2113 =cut
2114
2115 sub CountIssues {
2116     my ($subscriptionid) = @_;
2117     my $dbh              = C4::Context->dbh;
2118     my $query            = qq|
2119             SELECT count(*)
2120             FROM   serial
2121             WHERE  subscriptionid=?
2122         |;
2123     my $sth = $dbh->prepare($query);
2124     $sth->execute($subscriptionid);
2125     my ($countreceived) = $sth->fetchrow;
2126     return $countreceived;
2127 }
2128
2129 =head2 HasItems
2130
2131 $result = HasItems($subscriptionid)
2132
2133 returns a count of items from serial matching the subscriptionid
2134
2135 =cut
2136
2137 sub HasItems {
2138     my ($subscriptionid) = @_;
2139     my $dbh              = C4::Context->dbh;
2140     my $query = q|
2141             SELECT COUNT(serialitems.itemnumber)
2142             FROM   serial
2143                         LEFT JOIN serialitems USING(serialid)
2144             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2145         |;
2146     my $sth=$dbh->prepare($query);
2147     $sth->execute($subscriptionid);
2148     my ($countitems)=$sth->fetchrow_array();
2149     return $countitems;
2150 }
2151
2152 =head2 abouttoexpire
2153
2154 $result = abouttoexpire($subscriptionid)
2155
2156 this function alerts you to the penultimate issue for a serial subscription
2157
2158 returns 1 - if this is the penultimate issue
2159 returns 0 - if not
2160
2161 =cut
2162
2163 sub abouttoexpire {
2164     my ($subscriptionid) = @_;
2165     my $dbh              = C4::Context->dbh;
2166     my $subscription     = GetSubscription($subscriptionid);
2167     my $per = $subscription->{'periodicity'};
2168     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2169     if ($frequency and $frequency->{unit}){
2170
2171         my $expirationdate = GetExpirationDate($subscriptionid);
2172
2173         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2174         my $nextdate = GetNextDate($subscription, $res, $frequency);
2175
2176         # only compare dates if both dates exist.
2177         if ($nextdate and $expirationdate) {
2178             if(Date::Calc::Delta_Days(
2179                 split( /-/, $nextdate ),
2180                 split( /-/, $expirationdate )
2181             ) <= 0) {
2182                 return 1;
2183             }
2184         }
2185
2186     } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2187         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2188     }
2189
2190     return 0;
2191 }
2192
2193 =head2 GetFictiveIssueNumber
2194
2195 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2196
2197 Get the position of the issue published at $publisheddate, considering the
2198 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2199 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2200 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2201 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2202 depending on how many rows are in serial table.
2203 The issue number calculation is based on subscription frequency, first acquisition
2204 date, and $publisheddate.
2205
2206 Returns undef when called for irregular frequencies.
2207
2208 The routine is used to skip irregularities when calculating the next issue
2209 date (in GetNextDate) or the next issue number (in GetNextSeq).
2210
2211 =cut
2212
2213 sub GetFictiveIssueNumber {
2214     my ($subscription, $publisheddate, $frequency) = @_;
2215
2216     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2217     return if !$unit;
2218     my $issueno;
2219
2220     my ( $year, $month, $day ) = split /-/, $publisheddate;
2221     my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2222     my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2223
2224     if( $frequency->{'unitsperissue'} == 1 ) {
2225         $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2226     } else { # issuesperunit == 1
2227         $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2228     }
2229     return $issueno;
2230 }
2231
2232 sub _delta_units {
2233     my ( $date1, $date2, $unit ) = @_;
2234     # date1 and date2 are array refs in the form [ yy, mm, dd ]
2235
2236     if( $unit eq 'day' ) {
2237         return Delta_Days( @$date1, @$date2 );
2238     } elsif( $unit eq 'week' ) {
2239         return int( Delta_Days( @$date1, @$date2 ) / 7 );
2240     }
2241
2242     # In case of months or years, this is a wrapper around N_Delta_YMD.
2243     # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2244     # while we expect 1 month.
2245     my @delta = N_Delta_YMD( @$date1, @$date2 );
2246     if( $delta[2] > 27 ) {
2247         # Check if we could add a month
2248         my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2249         if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2250             $delta[1]++;
2251         }
2252     }
2253     if( $delta[1] >= 12 ) {
2254         $delta[0]++;
2255         $delta[1] -= 12;
2256     }
2257     # if unit is year, we only return full years
2258     return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2259 }
2260
2261 sub _get_next_date_day {
2262     my ($subscription, $freqdata, $year, $month, $day) = @_;
2263
2264     my @newissue; # ( yy, mm, dd )
2265     # We do not need $delta_days here, since it would be zero where used
2266
2267     if( $freqdata->{issuesperunit} == 1 ) {
2268         # Add full days
2269         @newissue = Add_Delta_Days(
2270             $year, $month, $day, $freqdata->{"unitsperissue"} );
2271     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2272         # Add zero days
2273         @newissue = ( $year, $month, $day );
2274         $subscription->{countissuesperunit}++;
2275     } else {
2276         # We finished a cycle of issues within a unit.
2277         # No subtraction of zero needed, just add one day
2278         @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2279         $subscription->{countissuesperunit} = 1;
2280     }
2281     return @newissue;
2282 }
2283
2284 sub _get_next_date_week {
2285     my ($subscription, $freqdata, $year, $month, $day) = @_;
2286
2287     my @newissue; # ( yy, mm, dd )
2288     my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2289
2290     if( $freqdata->{issuesperunit} == 1 ) {
2291         # Add full weeks (of 7 days)
2292         @newissue = Add_Delta_Days(
2293             $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2294     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2295         # Add rounded number of days based on frequency.
2296         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2297         $subscription->{countissuesperunit}++;
2298     } else {
2299         # We finished a cycle of issues within a unit.
2300         # Subtract delta * (issues - 1), add 1 week
2301         @newissue = Add_Delta_Days( $year, $month, $day,
2302             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2303         @newissue = Add_Delta_Days( @newissue, 7 );
2304         $subscription->{countissuesperunit} = 1;
2305     }
2306     return @newissue;
2307 }
2308
2309 sub _get_next_date_month {
2310     my ($subscription, $freqdata, $year, $month, $day) = @_;
2311
2312     my @newissue; # ( yy, mm, dd )
2313     my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2314
2315     if( $freqdata->{issuesperunit} == 1 ) {
2316         # Add full months
2317         @newissue = Add_Delta_YM(
2318             $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2319     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2320         # Add rounded number of days based on frequency.
2321         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2322         $subscription->{countissuesperunit}++;
2323     } else {
2324         # We finished a cycle of issues within a unit.
2325         # Subtract delta * (issues - 1), add 1 month
2326         @newissue = Add_Delta_Days( $year, $month, $day,
2327             -$delta_days * ($freqdata->{issuesperunit} - 1) );
2328         @newissue = Add_Delta_YM( @newissue, 0, 1 );
2329         $subscription->{countissuesperunit} = 1;
2330     }
2331     return @newissue;
2332 }
2333
2334 sub _get_next_date_year {
2335     my ($subscription, $freqdata, $year, $month, $day) = @_;
2336
2337     my @newissue; # ( yy, mm, dd )
2338     my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2339
2340     if( $freqdata->{issuesperunit} == 1 ) {
2341         # Add full years
2342         @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2343     } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2344         # Add rounded number of days based on frequency.
2345         @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2346         $subscription->{countissuesperunit}++;
2347     } else {
2348         # We finished a cycle of issues within a unit.
2349         # Subtract delta * (issues - 1), add 1 year
2350         @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2351         @newissue = Add_Delta_YM( @newissue, 1, 0 );
2352         $subscription->{countissuesperunit} = 1;
2353     }
2354     return @newissue;
2355 }
2356
2357 =head2 GetNextDate
2358
2359 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2360
2361 this function it takes the publisheddate and will return the next issue's date
2362 and will skip dates if there exists an irregularity.
2363 $publisheddate has to be an ISO date
2364 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2365 $frequency is a hashref containing frequency informations
2366 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2367 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2368 skipped then the returned date will be 2007-05-10
2369
2370 return :
2371 $resultdate - then next date in the sequence (ISO date)
2372
2373 Return undef if subscription is irregular
2374
2375 =cut
2376
2377 sub GetNextDate {
2378     my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2379
2380     return unless $subscription and $publisheddate;
2381
2382
2383     if ($freqdata->{'unit'}) {
2384         my ( $year, $month, $day ) = split /-/, $publisheddate;
2385
2386         # Process an irregularity Hash
2387         # Suppose that irregularities are stored in a string with this structure
2388         # irreg1;irreg2;irreg3
2389         # where irregX is the number of issue which will not be received
2390         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2391         my %irregularities;
2392         if ( $subscription->{irregularity} ) {
2393             my @irreg = split /;/, $subscription->{'irregularity'} ;
2394             foreach my $irregularity (@irreg) {
2395                 $irregularities{$irregularity} = 1;
2396             }
2397         }
2398
2399         # Get the 'fictive' next issue number
2400         # It is used to check if next issue is an irregular issue.
2401         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2402
2403         # Then get the next date
2404         my $unit = lc $freqdata->{'unit'};
2405         if ($unit eq 'day') {
2406             while ($irregularities{$issueno}) {
2407                 ($year, $month, $day) = _get_next_date_day($subscription,
2408                     $freqdata, $year, $month, $day);
2409                 $issueno++;
2410             }
2411             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2412                 $year, $month, $day);
2413         }
2414         elsif ($unit eq 'week') {
2415             while ($irregularities{$issueno}) {
2416                 ($year, $month, $day) = _get_next_date_week($subscription,
2417                     $freqdata, $year, $month, $day);
2418                 $issueno++;
2419             }
2420             ($year, $month, $day) = _get_next_date_week($subscription,
2421                 $freqdata, $year, $month, $day);
2422         }
2423         elsif ($unit eq 'month') {
2424             while ($irregularities{$issueno}) {
2425                 ($year, $month, $day) = _get_next_date_month($subscription,
2426                     $freqdata, $year, $month, $day);
2427                 $issueno++;
2428             }
2429             ($year, $month, $day) = _get_next_date_month($subscription,
2430                 $freqdata, $year, $month, $day);
2431         }
2432         elsif ($unit eq 'year') {
2433             while ($irregularities{$issueno}) {
2434                 ($year, $month, $day) = _get_next_date_year($subscription,
2435                     $freqdata, $year, $month, $day);
2436                 $issueno++;
2437             }
2438             ($year, $month, $day) = _get_next_date_year($subscription,
2439                 $freqdata, $year, $month, $day);
2440         }
2441
2442         if ($updatecount){
2443             my $dbh = C4::Context->dbh;
2444             my $query = qq{
2445                 UPDATE subscription
2446                 SET countissuesperunit = ?
2447                 WHERE subscriptionid = ?
2448             };
2449             my $sth = $dbh->prepare($query);
2450             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2451         }
2452
2453         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2454     }
2455 }
2456
2457 =head2 _numeration
2458
2459   $string = &_numeration($value,$num_type,$locale);
2460
2461 _numeration returns the string corresponding to $value in the num_type
2462 num_type can take :
2463     -dayname
2464     -dayabrv
2465     -monthname
2466     -monthabrv
2467     -season
2468     -seasonabrv
2469
2470 =cut
2471
2472 sub _numeration {
2473     my ($value, $num_type, $locale) = @_;
2474     $value ||= 0;
2475     $num_type //= '';
2476     $locale ||= 'en';
2477     my $string;
2478     if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2479         # 1970-11-01 was a Sunday
2480         $value = $value % 7;
2481         my $dt = DateTime->new(
2482             year    => 1970,
2483             month   => 11,
2484             day     => $value + 1,
2485             locale  => $locale,
2486         );
2487         $string = $num_type =~ /^dayname$/
2488             ? $dt->strftime("%A")
2489             : $dt->strftime("%a");
2490     } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2491         $value = $value % 12;
2492         my $dt = DateTime->new(
2493             year    => 1970,
2494             month   => $value + 1,
2495             locale  => $locale,
2496         );
2497         $string = $num_type =~ /^monthname$/
2498             ? $dt->strftime("%B")
2499             : $dt->strftime("%b");
2500     } elsif ( $num_type =~ /^season$/ ) {
2501         my @seasons= qw( Spring Summer Fall Winter );
2502         $value = $value % 4;
2503         $string = $seasons[$value];
2504     } elsif ( $num_type =~ /^seasonabrv$/ ) {
2505         my @seasonsabrv= qw( Spr Sum Fal Win );
2506         $value = $value % 4;
2507         $string = $seasonsabrv[$value];
2508     } else {
2509         $string = $value;
2510     }
2511
2512     return $string;
2513 }
2514
2515 =head2 CloseSubscription
2516
2517 Close a subscription given a subscriptionid
2518
2519 =cut
2520
2521 sub CloseSubscription {
2522     my ( $subscriptionid ) = @_;
2523     return unless $subscriptionid;
2524     my $dbh = C4::Context->dbh;
2525     my $sth = $dbh->prepare( q{
2526         UPDATE subscription
2527         SET closed = 1
2528         WHERE subscriptionid = ?
2529     } );
2530     $sth->execute( $subscriptionid );
2531
2532     # Set status = missing when status = stopped
2533     $sth = $dbh->prepare( q{
2534         UPDATE serial
2535         SET status = ?
2536         WHERE subscriptionid = ?
2537         AND status = ?
2538     } );
2539     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2540 }
2541
2542 =head2 ReopenSubscription
2543
2544 Reopen a subscription given a subscriptionid
2545
2546 =cut
2547
2548 sub ReopenSubscription {
2549     my ( $subscriptionid ) = @_;
2550     return unless $subscriptionid;
2551     my $dbh = C4::Context->dbh;
2552     my $sth = $dbh->prepare( q{
2553         UPDATE subscription
2554         SET closed = 0
2555         WHERE subscriptionid = ?
2556     } );
2557     $sth->execute( $subscriptionid );
2558
2559     # Set status = expected when status = stopped
2560     $sth = $dbh->prepare( q{
2561         UPDATE serial
2562         SET status = ?
2563         WHERE subscriptionid = ?
2564         AND status = ?
2565     } );
2566     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2567 }
2568
2569 =head2 subscriptionCurrentlyOnOrder
2570
2571     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2572
2573 Return 1 if subscription is currently on order else 0.
2574
2575 =cut
2576
2577 sub subscriptionCurrentlyOnOrder {
2578     my ( $subscriptionid ) = @_;
2579     my $dbh = C4::Context->dbh;
2580     my $query = qq|
2581         SELECT COUNT(*) FROM aqorders
2582         WHERE subscriptionid = ?
2583             AND datereceived IS NULL
2584             AND datecancellationprinted IS NULL
2585     |;
2586     my $sth = $dbh->prepare( $query );
2587     $sth->execute($subscriptionid);
2588     return $sth->fetchrow_array;
2589 }
2590
2591 =head2 can_claim_subscription
2592
2593     $can = can_claim_subscription( $subscriptionid[, $userid] );
2594
2595 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2596
2597 =cut
2598
2599 sub can_claim_subscription {
2600     my ( $subscription, $userid ) = @_;
2601     return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2602 }
2603
2604 =head2 can_edit_subscription
2605
2606     $can = can_edit_subscription( $subscriptionid[, $userid] );
2607
2608 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2609
2610 =cut
2611
2612 sub can_edit_subscription {
2613     my ( $subscription, $userid ) = @_;
2614     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2615 }
2616
2617 =head2 can_show_subscription
2618
2619     $can = can_show_subscription( $subscriptionid[, $userid] );
2620
2621 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2622
2623 =cut
2624
2625 sub can_show_subscription {
2626     my ( $subscription, $userid ) = @_;
2627     return _can_do_on_subscription( $subscription, $userid, '*' );
2628 }
2629
2630 sub _can_do_on_subscription {
2631     my ( $subscription, $userid, $permission ) = @_;
2632     return 0 unless C4::Context->userenv;
2633     my $flags = C4::Context->userenv->{flags};
2634     $userid ||= C4::Context->userenv->{'id'};
2635
2636     if ( C4::Context->preference('IndependentBranches') ) {
2637         return 1
2638           if C4::Context->IsSuperLibrarian()
2639               or
2640               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2641               or (
2642                   C4::Auth::haspermission( $userid,
2643                       { serials => $permission } )
2644                   and (  not defined $subscription->{branchcode}
2645                       or $subscription->{branchcode} eq ''
2646                       or $subscription->{branchcode} eq
2647                       C4::Context->userenv->{'branch'} )
2648               );
2649     }
2650     else {
2651         return 1
2652           if C4::Context->IsSuperLibrarian()
2653               or
2654               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2655               or C4::Auth::haspermission(
2656                   $userid, { serials => $permission }
2657               ),
2658         ;
2659     }
2660     return 0;
2661 }
2662
2663 =head2 findSerialsByStatus
2664
2665     @serials = findSerialsByStatus($status, $subscriptionid);
2666
2667     Returns an array of serials matching a given status and subscription id.
2668
2669 =cut
2670
2671 sub findSerialsByStatus {
2672     my ( $status, $subscriptionid ) = @_;
2673     my $dbh   = C4::Context->dbh;
2674     my $query = q| SELECT * from serial
2675                     WHERE status = ?
2676                     AND subscriptionid = ?
2677                 |;
2678     my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2679     return @$serials;
2680 }
2681
2682 1;
2683 __END__
2684
2685 =head1 AUTHOR
2686
2687 Koha Development Team <http://koha-community.org/>
2688
2689 =cut