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     $subscriptionid = $dbh->quote($subscriptionid);
1843     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1844     $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1845     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1846
1847     my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1848     foreach my $af (@$afs) {
1849         $af->delete_values({record_id => $subscriptionid});
1850     }
1851
1852     logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1853 }
1854
1855 =head2 DelIssue
1856
1857 DelIssue($serialseq,$subscriptionid)
1858 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1859
1860 returns the number of rows affected
1861
1862 =cut
1863
1864 sub DelIssue {
1865     my ($dataissue) = @_;
1866     my $dbh = C4::Context->dbh;
1867     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1868
1869     my $query = qq|
1870         DELETE FROM serial
1871         WHERE       serialid= ?
1872         AND         subscriptionid= ?
1873     |;
1874     my $mainsth = $dbh->prepare($query);
1875     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1876
1877     #Delete element from subscription history
1878     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1879     my $sth = $dbh->prepare($query);
1880     $sth->execute( $dataissue->{'subscriptionid'} );
1881     my $val = $sth->fetchrow_hashref;
1882     unless ( $val->{manualhistory} ) {
1883         my $query = qq|
1884           SELECT * FROM subscriptionhistory
1885           WHERE       subscriptionid= ?
1886       |;
1887         my $sth = $dbh->prepare($query);
1888         $sth->execute( $dataissue->{'subscriptionid'} );
1889         my $data      = $sth->fetchrow_hashref;
1890         my $serialseq = $dataissue->{'serialseq'};
1891         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1892         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1893         my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1894         $sth = $dbh->prepare($strsth);
1895         $sth->execute( $dataissue->{'subscriptionid'} );
1896     }
1897
1898     return $mainsth->rows;
1899 }
1900
1901 =head2 GetLateOrMissingIssues
1902
1903 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1904
1905 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1906
1907 return :
1908 the issuelist as an array of hash refs. Each element of this array contains
1909 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1910
1911 =cut
1912
1913 sub GetLateOrMissingIssues {
1914     my ( $supplierid, $serialid, $order ) = @_;
1915
1916     return unless ( $supplierid or $serialid );
1917
1918     my $dbh = C4::Context->dbh;
1919
1920     my $sth;
1921     my $byserial = '';
1922     if ($serialid) {
1923         $byserial = "and serialid = " . $serialid;
1924     }
1925     if ($order) {
1926         $order .= ", title";
1927     } else {
1928         $order = "title";
1929     }
1930     my $missing_statuses_string = join ',', (MISSING_STATUSES);
1931     if ($supplierid) {
1932         $sth = $dbh->prepare(
1933             "SELECT
1934                 serialid,      aqbooksellerid,        name,
1935                 biblio.title,  biblioitems.issn,      planneddate,    serialseq,
1936                 serial.status, serial.subscriptionid, claimdate, claims_count,
1937                 subscription.branchcode
1938             FROM      serial
1939                 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1940                 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1941                 LEFT JOIN biblioitems   ON subscription.biblionumber=biblioitems.biblionumber
1942                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1943                 WHERE subscription.subscriptionid = serial.subscriptionid
1944                 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1945                 AND subscription.aqbooksellerid=$supplierid
1946                 $byserial
1947                 ORDER BY $order"
1948         );
1949     } else {
1950         $sth = $dbh->prepare(
1951             "SELECT
1952             serialid,      aqbooksellerid,         name,
1953             biblio.title,  planneddate,           serialseq,
1954                 serial.status, serial.subscriptionid, claimdate, claims_count,
1955                 subscription.branchcode
1956             FROM serial
1957                 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1958                 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1959                 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1960                 WHERE subscription.subscriptionid = serial.subscriptionid
1961                         AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1962                 $byserial
1963                 ORDER BY $order"
1964         );
1965     }
1966     $sth->execute( EXPECTED, LATE, CLAIMED );
1967     my @issuelist;
1968     while ( my $line = $sth->fetchrow_hashref ) {
1969
1970         if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1971             $line->{planneddateISO} = $line->{planneddate};
1972             $line->{planneddate} = format_date( $line->{planneddate} );
1973         }
1974         if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1975             $line->{claimdateISO} = $line->{claimdate};
1976             $line->{claimdate}   = format_date( $line->{claimdate} );
1977         }
1978         $line->{"status".$line->{status}}   = 1;
1979
1980         my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1981             record_id => $line->{subscriptionid},
1982             tablename => 'subscription'
1983         });
1984         %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1985
1986         push @issuelist, $line;
1987     }
1988     return @issuelist;
1989 }
1990
1991 =head2 updateClaim
1992
1993 &updateClaim($serialid)
1994
1995 this function updates the time when a claim is issued for late/missing items
1996
1997 called from claims.pl file
1998
1999 =cut
2000
2001 sub updateClaim {
2002     my ($serialid) = @_;
2003     my $dbh        = C4::Context->dbh;
2004     $dbh->do(q|
2005         UPDATE serial
2006         SET claimdate = NOW(),
2007             claims_count = claims_count + 1
2008         WHERE serialid = ?
2009     |, {}, $serialid );
2010     return;
2011 }
2012
2013 =head2 getsupplierbyserialid
2014
2015 $result = getsupplierbyserialid($serialid)
2016
2017 this function is used to find the supplier id given a serial id
2018
2019 return :
2020 hashref containing serialid, subscriptionid, and aqbooksellerid
2021
2022 =cut
2023
2024 sub getsupplierbyserialid {
2025     my ($serialid) = @_;
2026     my $dbh        = C4::Context->dbh;
2027     my $sth        = $dbh->prepare(
2028         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2029          FROM serial
2030             LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2031             WHERE serialid = ?
2032         "
2033     );
2034     $sth->execute($serialid);
2035     my $line   = $sth->fetchrow_hashref;
2036     my $result = $line->{'aqbooksellerid'};
2037     return $result;
2038 }
2039
2040 =head2 check_routing
2041
2042 $result = &check_routing($subscriptionid)
2043
2044 this function checks to see if a serial has a routing list and returns the count of routingid
2045 used to show either an 'add' or 'edit' link
2046
2047 =cut
2048
2049 sub check_routing {
2050     my ($subscriptionid) = @_;
2051
2052     return unless ($subscriptionid);
2053
2054     my $dbh              = C4::Context->dbh;
2055     my $sth              = $dbh->prepare(
2056         "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2057                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2058                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2059                               "
2060     );
2061     $sth->execute($subscriptionid);
2062     my $line   = $sth->fetchrow_hashref;
2063     my $result = $line->{'routingids'};
2064     return $result;
2065 }
2066
2067 =head2 addroutingmember
2068
2069 addroutingmember($borrowernumber,$subscriptionid)
2070
2071 this function takes a borrowernumber and subscriptionid and adds the member to the
2072 routing list for that serial subscription and gives them a rank on the list
2073 of either 1 or highest current rank + 1
2074
2075 =cut
2076
2077 sub addroutingmember {
2078     my ( $borrowernumber, $subscriptionid ) = @_;
2079
2080     return unless ($borrowernumber and $subscriptionid);
2081
2082     my $rank;
2083     my $dbh = C4::Context->dbh;
2084     my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2085     $sth->execute($subscriptionid);
2086     while ( my $line = $sth->fetchrow_hashref ) {
2087         if ( $line->{'rank'} > 0 ) {
2088             $rank = $line->{'rank'} + 1;
2089         } else {
2090             $rank = 1;
2091         }
2092     }
2093     $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2094     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2095 }
2096
2097 =head2 reorder_members
2098
2099 reorder_members($subscriptionid,$routingid,$rank)
2100
2101 this function is used to reorder the routing list
2102
2103 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2104 - it gets all members on list puts their routingid's into an array
2105 - removes the one in the array that is $routingid
2106 - then reinjects $routingid at point indicated by $rank
2107 - then update the database with the routingids in the new order
2108
2109 =cut
2110
2111 sub reorder_members {
2112     my ( $subscriptionid, $routingid, $rank ) = @_;
2113     my $dbh = C4::Context->dbh;
2114     my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2115     $sth->execute($subscriptionid);
2116     my @result;
2117     while ( my $line = $sth->fetchrow_hashref ) {
2118         push( @result, $line->{'routingid'} );
2119     }
2120
2121     # To find the matching index
2122     my $i;
2123     my $key = -1;    # to allow for 0 being a valid response
2124     for ( $i = 0 ; $i < @result ; $i++ ) {
2125         if ( $routingid == $result[$i] ) {
2126             $key = $i;    # save the index
2127             last;
2128         }
2129     }
2130
2131     # if index exists in array then move it to new position
2132     if ( $key > -1 && $rank > 0 ) {
2133         my $new_rank = $rank - 1;                       # $new_rank is what you want the new index to be in the array
2134         my $moving_item = splice( @result, $key, 1 );
2135         splice( @result, $new_rank, 0, $moving_item );
2136     }
2137     for ( my $j = 0 ; $j < @result ; $j++ ) {
2138         my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2139         $sth->execute;
2140     }
2141     return;
2142 }
2143
2144 =head2 delroutingmember
2145
2146 delroutingmember($routingid,$subscriptionid)
2147
2148 this function either deletes one member from routing list if $routingid exists otherwise
2149 deletes all members from the routing list
2150
2151 =cut
2152
2153 sub delroutingmember {
2154
2155     # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2156     my ( $routingid, $subscriptionid ) = @_;
2157     my $dbh = C4::Context->dbh;
2158     if ($routingid) {
2159         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2160         $sth->execute($routingid);
2161         reorder_members( $subscriptionid, $routingid );
2162     } else {
2163         my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2164         $sth->execute($subscriptionid);
2165     }
2166     return;
2167 }
2168
2169 =head2 getroutinglist
2170
2171 @routinglist = getroutinglist($subscriptionid)
2172
2173 this gets the info from the subscriptionroutinglist for $subscriptionid
2174
2175 return :
2176 the routinglist as an array. Each element of the array contains a hash_ref containing
2177 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2178
2179 =cut
2180
2181 sub getroutinglist {
2182     my ($subscriptionid) = @_;
2183     my $dbh              = C4::Context->dbh;
2184     my $sth              = $dbh->prepare(
2185         'SELECT routingid, borrowernumber, ranking, biblionumber
2186             FROM subscription
2187             JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2188             WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2189     );
2190     $sth->execute($subscriptionid);
2191     my $routinglist = $sth->fetchall_arrayref({});
2192     return @{$routinglist};
2193 }
2194
2195 =head2 countissuesfrom
2196
2197 $result = countissuesfrom($subscriptionid,$startdate)
2198
2199 Returns a count of serial rows matching the given subsctiptionid
2200 with published date greater than startdate
2201
2202 =cut
2203
2204 sub countissuesfrom {
2205     my ( $subscriptionid, $startdate ) = @_;
2206     my $dbh   = C4::Context->dbh;
2207     my $query = qq|
2208             SELECT count(*)
2209             FROM   serial
2210             WHERE  subscriptionid=?
2211             AND serial.publisheddate>?
2212         |;
2213     my $sth = $dbh->prepare($query);
2214     $sth->execute( $subscriptionid, $startdate );
2215     my ($countreceived) = $sth->fetchrow;
2216     return $countreceived;
2217 }
2218
2219 =head2 CountIssues
2220
2221 $result = CountIssues($subscriptionid)
2222
2223 Returns a count of serial rows matching the given subsctiptionid
2224
2225 =cut
2226
2227 sub CountIssues {
2228     my ($subscriptionid) = @_;
2229     my $dbh              = C4::Context->dbh;
2230     my $query            = qq|
2231             SELECT count(*)
2232             FROM   serial
2233             WHERE  subscriptionid=?
2234         |;
2235     my $sth = $dbh->prepare($query);
2236     $sth->execute($subscriptionid);
2237     my ($countreceived) = $sth->fetchrow;
2238     return $countreceived;
2239 }
2240
2241 =head2 HasItems
2242
2243 $result = HasItems($subscriptionid)
2244
2245 returns a count of items from serial matching the subscriptionid
2246
2247 =cut
2248
2249 sub HasItems {
2250     my ($subscriptionid) = @_;
2251     my $dbh              = C4::Context->dbh;
2252     my $query = q|
2253             SELECT COUNT(serialitems.itemnumber)
2254             FROM   serial
2255                         LEFT JOIN serialitems USING(serialid)
2256             WHERE  subscriptionid=? AND serialitems.serialid IS NOT NULL
2257         |;
2258     my $sth=$dbh->prepare($query);
2259     $sth->execute($subscriptionid);
2260     my ($countitems)=$sth->fetchrow_array();
2261     return $countitems;
2262 }
2263
2264 =head2 abouttoexpire
2265
2266 $result = abouttoexpire($subscriptionid)
2267
2268 this function alerts you to the penultimate issue for a serial subscription
2269
2270 returns 1 - if this is the penultimate issue
2271 returns 0 - if not
2272
2273 =cut
2274
2275 sub abouttoexpire {
2276     my ($subscriptionid) = @_;
2277     my $dbh              = C4::Context->dbh;
2278     my $subscription     = GetSubscription($subscriptionid);
2279     my $per = $subscription->{'periodicity'};
2280     my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2281     if ($frequency and $frequency->{unit}){
2282
2283         my $expirationdate = GetExpirationDate($subscriptionid);
2284
2285         my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2286         my $nextdate = GetNextDate($subscription, $res);
2287
2288         # only compare dates if both dates exist.
2289         if ($nextdate and $expirationdate) {
2290             if(Date::Calc::Delta_Days(
2291                 split( /-/, $nextdate ),
2292                 split( /-/, $expirationdate )
2293             ) <= 0) {
2294                 return 1;
2295             }
2296         }
2297
2298     } elsif ($subscription->{numberlength}>0) {
2299         return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2300     }
2301
2302     return 0;
2303 }
2304
2305 sub in_array {    # used in next sub down
2306     my ( $val, @elements ) = @_;
2307     foreach my $elem (@elements) {
2308         if ( $val == $elem ) {
2309             return 1;
2310         }
2311     }
2312     return 0;
2313 }
2314
2315 =head2 GetSubscriptionsFromBorrower
2316
2317 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2318
2319 this gets the info from subscriptionroutinglist for each $subscriptionid
2320
2321 return :
2322 a count of the serial subscription routing lists to which a patron belongs,
2323 with the titles of those serial subscriptions as an array. Each element of the array
2324 contains a hash_ref with subscriptionID and title of subscription.
2325
2326 =cut
2327
2328 sub GetSubscriptionsFromBorrower {
2329     my ($borrowernumber) = @_;
2330     my $dbh              = C4::Context->dbh;
2331     my $sth              = $dbh->prepare(
2332         "SELECT subscription.subscriptionid, biblio.title
2333             FROM subscription
2334             JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2335             JOIN subscriptionroutinglist USING (subscriptionid)
2336             WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2337                                "
2338     );
2339     $sth->execute($borrowernumber);
2340     my @routinglist;
2341     my $count = 0;
2342     while ( my $line = $sth->fetchrow_hashref ) {
2343         $count++;
2344         push( @routinglist, $line );
2345     }
2346     return ( $count, @routinglist );
2347 }
2348
2349
2350 =head2 GetFictiveIssueNumber
2351
2352 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2353
2354 Get the position of the issue published at $publisheddate, considering the
2355 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2356 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2357 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2358 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2359 depending on how many rows are in serial table.
2360 The issue number calculation is based on subscription frequency, first acquisition
2361 date, and $publisheddate.
2362
2363 =cut
2364
2365 sub GetFictiveIssueNumber {
2366     my ($subscription, $publisheddate) = @_;
2367
2368     my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2369     my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2370     my $issueno = 0;
2371
2372     if($unit) {
2373         my ($year, $month, $day) = split /-/, $publisheddate;
2374         my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2375         my $wkno;
2376         my $delta;
2377
2378         if($unit eq 'day') {
2379             $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2380         } elsif($unit eq 'week') {
2381             ($wkno, $year) = Week_of_Year($year, $month, $day);
2382             my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2383             $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2384         } elsif($unit eq 'month') {
2385             $delta = ($fa_year == $year)
2386                    ? ($month - $fa_month)
2387                    : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2388         } elsif($unit eq 'year') {
2389             $delta = $year - $fa_year;
2390         }
2391         if($frequency->{'unitsperissue'} == 1) {
2392             $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2393         } else {
2394             # Assuming issuesperunit == 1
2395             $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2396         }
2397     }
2398     return $issueno;
2399 }
2400
2401 sub _get_next_date_day {
2402     my ($subscription, $freqdata, $year, $month, $day) = @_;
2403
2404     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2405         ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2406         $subscription->{countissuesperunit} = 1;
2407     } else {
2408         $subscription->{countissuesperunit}++;
2409     }
2410
2411     return ($year, $month, $day);
2412 }
2413
2414 sub _get_next_date_week {
2415     my ($subscription, $freqdata, $year, $month, $day) = @_;
2416
2417     my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2418     my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2419
2420     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2421         $subscription->{countissuesperunit} = 1;
2422         $wkno += $freqdata->{unitsperissue};
2423         if($wkno > 52){
2424             $wkno = $wkno % 52;
2425             $yr++;
2426         }
2427         ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2428         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2429     } else {
2430         # Try to guess the next day of week
2431         my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2432         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2433         $subscription->{countissuesperunit}++;
2434     }
2435
2436     return ($year, $month, $day);
2437 }
2438
2439 sub _get_next_date_month {
2440     my ($subscription, $freqdata, $year, $month, $day) = @_;
2441
2442     my $fa_day;
2443     (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2444
2445     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2446         $subscription->{countissuesperunit} = 1;
2447         ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2448             $freqdata->{unitsperissue});
2449         my $days_in_month = Days_in_Month($year, $month);
2450         $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2451     } else {
2452         # Try to guess the next day in month
2453         my $days_in_month = Days_in_Month($year, $month);
2454         my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2455         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2456         $subscription->{countissuesperunit}++;
2457     }
2458
2459     return ($year, $month, $day);
2460 }
2461
2462 sub _get_next_date_year {
2463     my ($subscription, $freqdata, $year, $month, $day) = @_;
2464
2465     my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2466
2467     if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2468         $subscription->{countissuesperunit} = 1;
2469         ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2470         $month = $fa_month;
2471         my $days_in_month = Days_in_Month($year, $month);
2472         $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2473     } else {
2474         # Try to guess the next day in year
2475         my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2476         my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2477         ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2478         $subscription->{countissuesperunit}++;
2479     }
2480
2481     return ($year, $month, $day);
2482 }
2483
2484 =head2 GetNextDate
2485
2486 $resultdate = GetNextDate($publisheddate,$subscription)
2487
2488 this function it takes the publisheddate and will return the next issue's date
2489 and will skip dates if there exists an irregularity.
2490 $publisheddate has to be an ISO date
2491 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2492 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2493 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2494 skipped then the returned date will be 2007-05-10
2495
2496 return :
2497 $resultdate - then next date in the sequence (ISO date)
2498
2499 Return undef if subscription is irregular
2500
2501 =cut
2502
2503 sub GetNextDate {
2504     my ( $subscription, $publisheddate, $updatecount ) = @_;
2505
2506     return unless $subscription and $publisheddate;
2507
2508     my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2509
2510     if ($freqdata->{'unit'}) {
2511         my ( $year, $month, $day ) = split /-/, $publisheddate;
2512
2513         # Process an irregularity Hash
2514         # Suppose that irregularities are stored in a string with this structure
2515         # irreg1;irreg2;irreg3
2516         # where irregX is the number of issue which will not be received
2517         # (the first issue takes the number 1, the 2nd the number 2 and so on)
2518         my %irregularities;
2519         if ( $subscription->{irregularity} ) {
2520             my @irreg = split /;/, $subscription->{'irregularity'} ;
2521             foreach my $irregularity (@irreg) {
2522                 $irregularities{$irregularity} = 1;
2523             }
2524         }
2525
2526         # Get the 'fictive' next issue number
2527         # It is used to check if next issue is an irregular issue.
2528         my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2529
2530         # Then get the next date
2531         my $unit = lc $freqdata->{'unit'};
2532         if ($unit eq 'day') {
2533             while ($irregularities{$issueno}) {
2534                 ($year, $month, $day) = _get_next_date_day($subscription,
2535                     $freqdata, $year, $month, $day);
2536                 $issueno++;
2537             }
2538             ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2539                 $year, $month, $day);
2540         }
2541         elsif ($unit eq 'week') {
2542             while ($irregularities{$issueno}) {
2543                 ($year, $month, $day) = _get_next_date_week($subscription,
2544                     $freqdata, $year, $month, $day);
2545                 $issueno++;
2546             }
2547             ($year, $month, $day) = _get_next_date_week($subscription,
2548                 $freqdata, $year, $month, $day);
2549         }
2550         elsif ($unit eq 'month') {
2551             while ($irregularities{$issueno}) {
2552                 ($year, $month, $day) = _get_next_date_month($subscription,
2553                     $freqdata, $year, $month, $day);
2554                 $issueno++;
2555             }
2556             ($year, $month, $day) = _get_next_date_month($subscription,
2557                 $freqdata, $year, $month, $day);
2558         }
2559         elsif ($unit eq 'year') {
2560             while ($irregularities{$issueno}) {
2561                 ($year, $month, $day) = _get_next_date_year($subscription,
2562                     $freqdata, $year, $month, $day);
2563                 $issueno++;
2564             }
2565             ($year, $month, $day) = _get_next_date_year($subscription,
2566                 $freqdata, $year, $month, $day);
2567         }
2568
2569         if ($updatecount){
2570             my $dbh = C4::Context->dbh;
2571             my $query = qq{
2572                 UPDATE subscription
2573                 SET countissuesperunit = ?
2574                 WHERE subscriptionid = ?
2575             };
2576             my $sth = $dbh->prepare($query);
2577             $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2578         }
2579
2580         return sprintf("%04d-%02d-%02d", $year, $month, $day);
2581     }
2582 }
2583
2584 =head2 _numeration
2585
2586   $string = &_numeration($value,$num_type,$locale);
2587
2588 _numeration returns the string corresponding to $value in the num_type
2589 num_type can take :
2590     -dayname
2591     -monthname
2592     -season
2593 =cut
2594
2595 #'
2596
2597 sub _numeration {
2598     my ($value, $num_type, $locale) = @_;
2599     $value ||= 0;
2600     $num_type //= '';
2601     $locale ||= 'en';
2602     my $string;
2603     if ( $num_type =~ /^dayname$/ ) {
2604         # 1970-11-01 was a Sunday
2605         $value = $value % 7;
2606         my $dt = DateTime->new(
2607             year    => 1970,
2608             month   => 11,
2609             day     => $value + 1,
2610             locale  => $locale,
2611         );
2612         $string = $dt->strftime("%A");
2613     } elsif ( $num_type =~ /^monthname$/ ) {
2614         $value = $value % 12;
2615         my $dt = DateTime->new(
2616             year    => 1970,
2617             month   => $value + 1,
2618             locale  => $locale,
2619         );
2620         $string = $dt->strftime("%B");
2621     } elsif ( $num_type =~ /^season$/ ) {
2622         my @seasons= qw( Spring Summer Fall Winter );
2623         $value = $value % 4;
2624         $string = $seasons[$value];
2625     } else {
2626         $string = $value;
2627     }
2628
2629     return $string;
2630 }
2631
2632 =head2 is_barcode_in_use
2633
2634 Returns number of occurrences of the barcode in the items table
2635 Can be used as a boolean test of whether the barcode has
2636 been deployed as yet
2637
2638 =cut
2639
2640 sub is_barcode_in_use {
2641     my $barcode = shift;
2642     my $dbh       = C4::Context->dbh;
2643     my $occurrences = $dbh->selectall_arrayref(
2644         'SELECT itemnumber from items where barcode = ?',
2645         {}, $barcode
2646
2647     );
2648
2649     return @{$occurrences};
2650 }
2651
2652 =head2 CloseSubscription
2653 Close a subscription given a subscriptionid
2654 =cut
2655 sub CloseSubscription {
2656     my ( $subscriptionid ) = @_;
2657     return unless $subscriptionid;
2658     my $dbh = C4::Context->dbh;
2659     my $sth = $dbh->prepare( q{
2660         UPDATE subscription
2661         SET closed = 1
2662         WHERE subscriptionid = ?
2663     } );
2664     $sth->execute( $subscriptionid );
2665
2666     # Set status = missing when status = stopped
2667     $sth = $dbh->prepare( q{
2668         UPDATE serial
2669         SET status = ?
2670         WHERE subscriptionid = ?
2671         AND status = ?
2672     } );
2673     $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2674 }
2675
2676 =head2 ReopenSubscription
2677 Reopen a subscription given a subscriptionid
2678 =cut
2679 sub ReopenSubscription {
2680     my ( $subscriptionid ) = @_;
2681     return unless $subscriptionid;
2682     my $dbh = C4::Context->dbh;
2683     my $sth = $dbh->prepare( q{
2684         UPDATE subscription
2685         SET closed = 0
2686         WHERE subscriptionid = ?
2687     } );
2688     $sth->execute( $subscriptionid );
2689
2690     # Set status = expected when status = stopped
2691     $sth = $dbh->prepare( q{
2692         UPDATE serial
2693         SET status = ?
2694         WHERE subscriptionid = ?
2695         AND status = ?
2696     } );
2697     $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2698 }
2699
2700 =head2 subscriptionCurrentlyOnOrder
2701
2702     $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2703
2704 Return 1 if subscription is currently on order else 0.
2705
2706 =cut
2707
2708 sub subscriptionCurrentlyOnOrder {
2709     my ( $subscriptionid ) = @_;
2710     my $dbh = C4::Context->dbh;
2711     my $query = qq|
2712         SELECT COUNT(*) FROM aqorders
2713         WHERE subscriptionid = ?
2714             AND datereceived IS NULL
2715             AND datecancellationprinted IS NULL
2716     |;
2717     my $sth = $dbh->prepare( $query );
2718     $sth->execute($subscriptionid);
2719     return $sth->fetchrow_array;
2720 }
2721
2722 =head2 can_edit_subscription
2723
2724     $can = can_edit_subscription( $subscriptionid[, $userid] );
2725
2726 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2727
2728 =cut
2729
2730 sub can_edit_subscription {
2731     my ( $subscription, $userid ) = @_;
2732     return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2733 }
2734
2735 =head2 can_show_subscription
2736
2737     $can = can_show_subscription( $subscriptionid[, $userid] );
2738
2739 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2740
2741 =cut
2742
2743 sub can_show_subscription {
2744     my ( $subscription, $userid ) = @_;
2745     return _can_do_on_subscription( $subscription, $userid, '*' );
2746 }
2747
2748 sub _can_do_on_subscription {
2749     my ( $subscription, $userid, $permission ) = @_;
2750     return 0 unless C4::Context->userenv;
2751     my $flags = C4::Context->userenv->{flags};
2752     $userid ||= C4::Context->userenv->{'id'};
2753
2754     if ( C4::Context->preference('IndependentBranches') ) {
2755         return 1
2756           if C4::Context->IsSuperLibrarian()
2757               or
2758               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2759               or (
2760                   C4::Auth::haspermission( $userid,
2761                       { serials => $permission } )
2762                   and (  not defined $subscription->{branchcode}
2763                       or $subscription->{branchcode} eq ''
2764                       or $subscription->{branchcode} eq
2765                       C4::Context->userenv->{'branch'} )
2766               );
2767     }
2768     else {
2769         return 1
2770           if C4::Context->IsSuperLibrarian()
2771               or
2772               C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2773               or C4::Auth::haspermission(
2774                   $userid, { serials => $permission }
2775               ),
2776         ;
2777     }
2778     return 0;
2779 }
2780
2781 1;
2782 __END__
2783
2784 =head1 AUTHOR
2785
2786 Koha Development Team <http://koha-community.org/>
2787
2788 =cut