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