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