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