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