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