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