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