C4/Serials.pm

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