C4/Serials.pm

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