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