C4/Serials.pm

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