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