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