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