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