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