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