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