C4/Serials.pm

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