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