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