C4/Serials.pm

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