C4/Serials.pm

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