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