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