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