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