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