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