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