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