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