C4/Serials.pm

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