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