C4/Serials.pm

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