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