C4/Serials.pm

   1 package C4::Serials;    #assumes C4/Serials.pm
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Dates qw(format_date format_date_in_iso);
  23 use Date::Calc qw(:all);
  24 use POSIX qw(strftime);
  25 use C4::Suggestions;
  26 use C4::Koha;
  27 use C4::Biblio;
  28 use C4::Items;
  29 use C4::Search;
  30 use C4::Letters;
  31 use C4::Log; # logaction
  32
  33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  34
  35 BEGIN {
  36         $VERSION = 3.01;        # set version for version checking
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         @EXPORT = qw(
  40     &NewSubscription    &ModSubscription    &DelSubscription    &GetSubscriptions
  41     &GetSubscription    &CountSubscriptionFromBiblionumber      &GetSubscriptionsFromBiblionumber
  42     &GetFullSubscriptionsFromBiblionumber   &GetFullSubscription &ModSubscriptionHistory
  43     &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
  44
  45     &GetNextSeq         &NewIssue           &ItemizeSerials    &GetSerials
  46     &GetLatestSerials   &ModSerialStatus    &GetNextDate       &GetSerials2
  47     &ReNewSubscription  &GetLateIssues      &GetLateOrMissingIssues
  48     &GetSerialInformation                   &AddItem2Serial
  49     &PrepareSerialsData
  50
  51     &UpdateClaimdateIssues
  52     &GetSuppliersWithLateIssues             &getsupplierbyserialid
  53     &GetDistributedTo   &SetDistributedTo
  54     &getroutinglist     &delroutingmember   &addroutingmember
  55     &reorder_members
  56     &check_routing &updateClaim &removeMissingIssue
  57
  58     &old_newsubscription &old_modsubscription &old_getserials
  59         );
  60 }
  61
  62 =head2 GetSuppliersWithLateIssues
  63
  64 =head1 NAME
  65
  66 C4::Serials - Give functions for serializing.
  67
  68 =head1 SYNOPSIS
  69
  70   use C4::Serials;
  71
  72 =head1 DESCRIPTION
  73
  74 Give all XYZ functions
  75
  76 =head1 FUNCTIONS
  77
  78 =over 4
  79
  80 %supplierlist = &GetSuppliersWithLateIssues
  81
  82 this function get all suppliers with late issues.
  83
  84 return :
  85 the supplierlist into a hash. this hash containts id & name of the supplier
  86
  87 =back
  88
  89 =cut
  90
  91 sub GetSuppliersWithLateIssues {
  92     my $dbh   = C4::Context->dbh;
  93     my $query = qq|
  94         SELECT DISTINCT id, name
  95         FROM            subscription
  96         LEFT JOIN       serial ON serial.subscriptionid=subscription.subscriptionid
  97         LEFT JOIN       aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
  98         WHERE           subscription.subscriptionid = serial.subscriptionid
  99         AND             (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
 100         ORDER BY name
 101     |;
 102     my $sth = $dbh->prepare($query);
 103     $sth->execute;
 104     my %supplierlist;
 105     while ( my ( $id, $name ) = $sth->fetchrow ) {
 106         $supplierlist{$id} = $name;
 107     }
 108     if ( C4::Context->preference("RoutingSerials") ) {
 109         $supplierlist{''} = "All Suppliers";
 110     }
 111     return %supplierlist;
 112 }
 113
 114 =head2 GetLateIssues
 115
 116 =over 4
 117
 118 @issuelist = &GetLateIssues($supplierid)
 119
 120 this function select late issues on database
 121
 122 return :
 123 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
 124 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
 125
 126 =back
 127
 128 =cut
 129
 130 sub GetLateIssues {
 131     my ($supplierid) = @_;
 132     my $dbh = C4::Context->dbh;
 133     my $sth;
 134     if ($supplierid) {
 135         my $query = qq|
 136             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 137             FROM       subscription
 138             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 139             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 140             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 141             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 142             AND        subscription.aqbooksellerid=$supplierid
 143             ORDER BY   title
 144         |;
 145         $sth = $dbh->prepare($query);
 146     }
 147     else {
 148         my $query = qq|
 149             SELECT     name,title,planneddate,serialseq,serial.subscriptionid
 150             FROM       subscription
 151             LEFT JOIN  serial ON subscription.subscriptionid = serial.subscriptionid
 152             LEFT JOIN  biblio ON biblio.biblionumber = subscription.biblionumber
 153             LEFT JOIN  aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
 154             WHERE      ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
 155             ORDER BY   title
 156         |;
 157         $sth = $dbh->prepare($query);
 158     }
 159     $sth->execute;
 160     my @issuelist;
 161     my $last_title;
 162     my $odd   = 0;
 163     my $count = 0;
 164     while ( my $line = $sth->fetchrow_hashref ) {
 165         $odd++ unless $line->{title} eq $last_title;
 166         $line->{title} = "" if $line->{title} eq $last_title;
 167         $last_title = $line->{title} if ( $line->{title} );
 168         $line->{planneddate} = format_date( $line->{planneddate} );
 169         $count++;
 170         push @issuelist, $line;
 171     }
 172     return $count, @issuelist;
 173 }
 174
 175 =head2 GetSubscriptionHistoryFromSubscriptionId
 176
 177 =over 4
 178
 179 $sth = GetSubscriptionHistoryFromSubscriptionId()
 180 this function just prepare the SQL request.
 181 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
 182 return :
 183 $sth = $dbh->prepare($query).
 184
 185 =back
 186
 187 =cut
 188
 189 sub GetSubscriptionHistoryFromSubscriptionId() {
 190     my $dbh   = C4::Context->dbh;
 191     my $query = qq|
 192         SELECT *
 193         FROM   subscriptionhistory
 194         WHERE  subscriptionid = ?
 195     |;
 196     return $dbh->prepare($query);
 197 }
 198
 199 =head2 GetSerialStatusFromSerialId
 200
 201 =over 4
 202
 203 $sth = GetSerialStatusFromSerialId();
 204 this function just prepare the SQL request.
 205 After this function, don't forget to execute it by using $sth->execute($serialid)
 206 return :
 207 $sth = $dbh->prepare($query).
 208
 209 =back
 210
 211 =cut
 212
 213 sub GetSerialStatusFromSerialId() {
 214     my $dbh   = C4::Context->dbh;
 215     my $query = qq|
 216         SELECT status
 217         FROM   serial
 218         WHERE  serialid = ?
 219     |;
 220     return $dbh->prepare($query);
 221 }
 222
 223 =head2 GetSerialInformation
 224
 225 =over 4
 226
 227 $data = GetSerialInformation($serialid);
 228 returns a hash containing :
 229   items : items marcrecord (can be an array)
 230   serial table field
 231   subscription table field
 232   + information about subscription expiration
 233
 234 =back
 235
 236 =cut
 237
 238 sub GetSerialInformation {
 239     my ($serialid) = @_;
 240     my $dbh        = C4::Context->dbh;
 241     my $query      = qq|
 242         SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
 243        if (C4::Context->preference('IndependantBranches') &&
 244               C4::Context->userenv &&
 245               C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
 246                 $query.="
 247       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 248         }
 249             $query .= qq|
 250         FROM   serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
 251         WHERE  serialid = ?
 252     |;
 253     my $rq = $dbh->prepare($query);
 254     $rq->execute($serialid);
 255     my $data = $rq->fetchrow_hashref;
 256     # create item information if we have serialsadditems for this subscription
 257     if ( $data->{'serialsadditems'} ) {
 258         if ( $data->{'itemnumber'} ) {
 259             my @itemnumbers = split /,/, $data->{'itemnumber'};
 260             foreach my $itemnum (@itemnumbers) {
 261
 262                 #It is ASSUMED that GetMarcItem ALWAYS WORK...
 263                 #Maybe GetMarcItem should return values on failure
 264 #                 warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
 265                 my $itemprocessed =
 266                   PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
 267                 $itemprocessed->{'itemnumber'}   = $itemnum;
 268                 $itemprocessed->{'itemid'}       = $itemnum;
 269                 $itemprocessed->{'serialid'}     = $serialid;
 270                 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 271                 push @{ $data->{'items'} }, $itemprocessed;
 272             }
 273         }
 274         else {
 275             my $itemprocessed =
 276               PrepareItemrecordDisplay( $data->{'biblionumber'} );
 277             $itemprocessed->{'itemid'}       = "N$serialid";
 278             $itemprocessed->{'serialid'}     = $serialid;
 279             $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
 280             $itemprocessed->{'countitems'}   = 0;
 281             push @{ $data->{'items'} }, $itemprocessed;
 282         }
 283     }
 284     $data->{ "status" . $data->{'serstatus'} } = 1;
 285     $data->{'subscriptionexpired'} =
 286       HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
 287     $data->{'abouttoexpire'} =
 288       abouttoexpire( $data->{'subscriptionid'} );
 289     return $data;
 290 }
 291
 292 =head2 AddItem2Serial
 293
 294 =over 4
 295
 296 $data = AddItem2Serial($serialid,$itemnumber);
 297 Adds an itemnumber to Serial record
 298 =back
 299
 300 =cut
 301
 302 sub AddItem2Serial {
 303     my ( $serialid, $itemnumber ) = @_;
 304     my $dbh   = C4::Context->dbh;
 305     my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
 306     $rq->execute($serialid, $itemnumber);
 307     return $rq->rows;
 308 }
 309
 310 =head2 UpdateClaimdateIssues
 311
 312 =over 4
 313
 314 UpdateClaimdateIssues($serialids,[$date]);
 315
 316 Update Claimdate for issues in @$serialids list with date $date
 317 (Take Today if none)
 318 =back
 319
 320 =cut
 321
 322 sub UpdateClaimdateIssues {
 323     my ( $serialids, $date ) = @_;
 324     my $dbh   = C4::Context->dbh;
 325     $date = strftime("%Y-%m-%d",localtime) unless ($date);
 326     my $query = "
 327         UPDATE serial SET claimdate=$date,status=7
 328         WHERE  serialid in ".join (",",@$serialids);
 329     ;
 330     my $rq = $dbh->prepare($query);
 331     $rq->execute;
 332     return $rq->rows;
 333 }
 334
 335 =head2 GetSubscription
 336
 337 =over 4
 338
 339 $subs = GetSubscription($subscriptionid)
 340 this function get the subscription which has $subscriptionid as id.
 341 return :
 342 a hashref. This hash containts
 343 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
 344
 345 =back
 346
 347 =cut
 348
 349 sub GetSubscription {
 350     my ($subscriptionid) = @_;
 351     my $dbh              = C4::Context->dbh;
 352     my $query            = qq(
 353         SELECT  subscription.*,
 354                 subscriptionhistory.*,
 355                 subscriptionhistory.enddate as histenddate,
 356                 aqbudget.bookfundid,
 357                 aqbooksellers.name AS aqbooksellername,
 358                 biblio.title AS bibliotitle,
 359                 subscription.biblionumber as bibnum);
 360        if (C4::Context->preference('IndependantBranches') &&
 361               C4::Context->userenv &&
 362               C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
 363                 $query.="
 364       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 365         }
 366             $query .= qq(
 367        FROM subscription
 368        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 369        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 370        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 371        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 372        WHERE subscription.subscriptionid = ?
 373     );
 374 #     if (C4::Context->preference('IndependantBranches') &&
 375 #         C4::Context->userenv &&
 376 #         C4::Context->userenv->{'flags'} != 1){
 377 # #       warn "flags: ".C4::Context->userenv->{'flags'};
 378 #       $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
 379 #     }
 380 #        warn "query : $query";
 381     my $sth = $dbh->prepare($query);
 382 #       warn "subsid :$subscriptionid";
 383     $sth->execute($subscriptionid);
 384     my $subs = $sth->fetchrow_hashref;
 385     return $subs;
 386 }
 387
 388 =head2 GetFullSubscription
 389
 390 =over 4
 391
 392    \@res = GetFullSubscription($subscriptionid)
 393    this function read on serial table.
 394
 395 =back
 396
 397 =cut
 398
 399 sub GetFullSubscription {
 400     my ($subscriptionid) = @_;
 401     my $dbh            = C4::Context->dbh;
 402     my $query          = qq|
 403   SELECT    serial.serialid,
 404             serial.serialseq,
 405             serial.planneddate,
 406             serial.publisheddate,
 407             serial.status,
 408             serial.notes as notes,
 409             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 410             aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
 411             biblio.title as bibliotitle,
 412             subscription.branchcode AS branchcode,
 413             subscription.subscriptionid AS subscriptionid |;
 414     if (C4::Context->preference('IndependantBranches') &&
 415         C4::Context->userenv &&
 416         C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
 417       $query.="
 418       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 419     }
 420     $query.=qq|
 421   FROM      serial
 422   LEFT JOIN subscription ON
 423           (serial.subscriptionid=subscription.subscriptionid )
 424   LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 425   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 426   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 427   WHERE     serial.subscriptionid = ?
 428   ORDER BY year DESC,
 429           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 430           serial.subscriptionid
 431           |;
 432 #     warn $query;
 433     my $sth = $dbh->prepare($query);
 434     $sth->execute($subscriptionid);
 435     my $subs = $sth->fetchall_arrayref({});
 436     return $subs;
 437 }
 438
 439
 440 =head2 PrepareSerialsData
 441
 442 =over 4
 443
 444    \@res = PrepareSerialsData($serialinfomation)
 445    where serialinformation is a hashref array
 446
 447 =back
 448
 449 =cut
 450
 451 sub PrepareSerialsData{
 452     my ($lines)=@_;
 453     my %tmpresults;
 454     my $year;
 455     my @res;
 456     my $startdate;
 457     my $aqbooksellername;
 458     my $bibliotitle;
 459     my @loopissues;
 460     my $first;
 461     my $previousnote = "";
 462
 463     foreach  my $subs ( @$lines ) {
 464         $subs->{'publisheddate'} =
 465           ( $subs->{'publisheddate'}
 466             ? format_date( $subs->{'publisheddate'} )
 467             : "XXX" );
 468         $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
 469         $subs->{ "status" . $subs->{'status'} } = 1;
 470
 471 #         $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
 472         if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
 473             $year = $subs->{'year'};
 474         }
 475         else {
 476             $year = "manage";
 477         }
 478         if ( $tmpresults{$year} ) {
 479             push @{ $tmpresults{$year}->{'serials'} }, $subs;
 480         }
 481         else {
 482             $tmpresults{$year} = {
 483                 'year' => $year,
 484
 485                 #               'startdate'=>format_date($subs->{'startdate'}),
 486                 'aqbooksellername' => $subs->{'aqbooksellername'},
 487                 'bibliotitle'      => $subs->{'bibliotitle'},
 488                 'serials'          => [$subs],
 489                 'first'            => $first,
 490 #                 'branchcode'       => $subs->{'branchcode'},
 491 #                 'subscriptionid'   => $subs->{'subscriptionid'},
 492             };
 493         }
 494
 495         #         $previousnote=$subs->{notes};
 496     }
 497     foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
 498         push @res, $tmpresults{$key};
 499     }
 500     $res[0]->{'first'}=1;
 501     return \@res;
 502 }
 503
 504 =head2 GetSubscriptionsFromBiblionumber
 505
 506 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
 507 this function get the subscription list. it reads on subscription table.
 508 return :
 509 table of subscription which has the biblionumber given on input arg.
 510 each line of this table is a hashref. All hashes containt
 511 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
 512
 513 =cut
 514
 515 sub GetSubscriptionsFromBiblionumber {
 516     my ($biblionumber) = @_;
 517     my $dbh            = C4::Context->dbh;
 518     my $query          = qq(
 519         SELECT subscription.*,
 520                branches.branchname,
 521                subscriptionhistory.*,
 522                subscriptionhistory.enddate as histenddate,
 523                aqbudget.bookfundid,
 524                aqbooksellers.name AS aqbooksellername,
 525                biblio.title AS bibliotitle
 526        FROM subscription
 527        LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
 528        LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 529        LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
 530        LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
 531        LEFT JOIN branches ON branches.branchcode=subscription.branchcode
 532        WHERE subscription.biblionumber = ?
 533     );
 534 #     if (C4::Context->preference('IndependantBranches') &&
 535 #         C4::Context->userenv &&
 536 #         C4::Context->userenv->{'flags'} != 1){
 537 #        $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
 538 #     }
 539     my $sth = $dbh->prepare($query);
 540     $sth->execute($biblionumber);
 541     my @res;
 542     while ( my $subs = $sth->fetchrow_hashref ) {
 543         $subs->{startdate}     = format_date( $subs->{startdate} );
 544         $subs->{histstartdate} = format_date( $subs->{histstartdate} );
 545         $subs->{histenddate} = format_date( $subs->{histenddate} );
 546         $subs->{opacnote}     =~ s/\n/\<br\/\>/g;
 547         $subs->{missinglist}  =~ s/\n/\<br\/\>/g;
 548         $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
 549         $subs->{ "periodicity" . $subs->{periodicity} } = 1;
 550         $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
 551         $subs->{ "status" . $subs->{'status'} } = 1;
 552         $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
 553                 C4::Context->userenv &&
 554                 C4::Context->userenv->{flags} !=1  &&
 555                 C4::Context->userenv->{branch} && $subs->{branchcode} &&
 556                 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
 557         if ( $subs->{enddate} eq '0000-00-00' ) {
 558             $subs->{enddate} = '';
 559         }
 560         else {
 561             $subs->{enddate} = format_date( $subs->{enddate} );
 562         }
 563         $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
 564         $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
 565         push @res, $subs;
 566     }
 567     return \@res;
 568 }
 569
 570 =head2 GetFullSubscriptionsFromBiblionumber
 571
 572 =over 4
 573
 574    \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
 575    this function read on serial table.
 576
 577 =back
 578
 579 =cut
 580
 581 sub GetFullSubscriptionsFromBiblionumber {
 582     my ($biblionumber) = @_;
 583     my $dbh            = C4::Context->dbh;
 584     my $query          = qq|
 585   SELECT    serial.serialid,
 586             serial.serialseq,
 587             serial.planneddate,
 588             serial.publisheddate,
 589             serial.status,
 590             serial.notes as notes,
 591             year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
 592             aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
 593             biblio.title as bibliotitle,
 594             subscription.branchcode AS branchcode,
 595             subscription.subscriptionid AS subscriptionid|;
 596      if (C4::Context->preference('IndependantBranches') &&
 597         C4::Context->userenv &&
 598         C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
 599       $query.="
 600       , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
 601      }
 602
 603      $query.=qq|
 604   FROM      serial
 605   LEFT JOIN subscription ON
 606           (serial.subscriptionid=subscription.subscriptionid)
 607   LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
 608   LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
 609   LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
 610   WHERE     subscription.biblionumber = ?
 611   ORDER BY year DESC,
 612           IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
 613           serial.subscriptionid
 614           |;
 615     my $sth = $dbh->prepare($query);
 616     $sth->execute($biblionumber);
 617     my $subs= $sth->fetchall_arrayref({});
 618     return $subs;
 619 }
 620
 621 =head2 GetSubscriptions
 622
 623 =over 4
 624
 625 @results = GetSubscriptions($title,$ISSN,$biblionumber);
 626 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
 627 return:
 628 a table of hashref. Each hash containt the subscription.
 629
 630 =back
 631
 632 =cut
 633
 634 sub GetSubscriptions {
 635     my ( $title, $ISSN, $biblionumber ) = @_;
 636     #return unless $title or $ISSN or $biblionumber;
 637     my $dbh = C4::Context->dbh;
 638     my $sth;
 639     if ($biblionumber) {
 640         my $query = qq(
 641             SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
 642             FROM   subscription
 643             LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 644             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 645             WHERE biblio.biblionumber=?
 646         );
 647         $query.=" ORDER BY title";
 648 #         warn "query :$query";
 649         $sth = $dbh->prepare($query);
 650         $sth->execute($biblionumber);
 651     }
 652     else {
 653         if ( $ISSN and $title ) {
 654             my $query = qq|
 655                 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
 656                 FROM   subscription
 657                 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 658                 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 659                 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
 660             $query.=" ORDER BY title";
 661             $sth = $dbh->prepare($query);
 662             $sth->execute( $ISSN );
 663         }
 664         else {
 665             if ($ISSN) {
 666                 my $query = qq(
 667                     SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
 668                     FROM   subscription
 669                     LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 670                     LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 671                     WHERE biblioitems.issn LIKE ?
 672                 );
 673                 $query.=" ORDER BY title";
 674 #         warn "query :$query";
 675                 $sth = $dbh->prepare($query);
 676                 $sth->execute( "%" . $ISSN . "%" );
 677             }
 678             else {
 679                 my $query = qq(
 680                     SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
 681                     FROM   subscription
 682                     LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
 683                     LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 684                     WHERE 1
 685                     ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
 686
 687                 $query.=" ORDER BY title";
 688 #                 warn $query;
 689                 $sth = $dbh->prepare($query);
 690                 $sth->execute;
 691             }
 692         }
 693     }
 694     my @results;
 695     my $previoustitle = "";
 696     my $odd           = 1;
 697     while ( my $line = $sth->fetchrow_hashref ) {
 698         if ( $previoustitle eq $line->{title} ) {
 699             $line->{title}  = "";
 700             $line->{issn}   = "";
 701             $line->{toggle} = 1 if $odd == 1;
 702         }
 703         else {
 704             $previoustitle = $line->{title};
 705             $odd           = -$odd;
 706             $line->{toggle} = 1 if $odd == 1;
 707         }
 708         $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
 709                 C4::Context->userenv &&
 710                 C4::Context->userenv->{flags} !=1  &&
 711                 C4::Context->userenv->{branch} && $line->{branchcode} &&
 712                 (C4::Context->userenv->{branch} ne $line->{branchcode}));
 713         push @results, $line;
 714     }
 715     return @results;
 716 }
 717
 718 =head2 GetSerials
 719
 720 =over 4
 721
 722 ($totalissues,@serials) = GetSerials($subscriptionid);
 723 this function get every serial not arrived for a given subscription
 724 as well as the number of issues registered in the database (all types)
 725 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 726
 727 =back
 728
 729 =cut
 730
 731 sub GetSerials {
 732     my ($subscriptionid,$count) = @_;
 733     my $dbh = C4::Context->dbh;
 734
 735     # status = 2 is "arrived"
 736     my $counter = 0;
 737     $count=5 unless ($count);
 738     my @serials;
 739     my $query =
 740       "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
 741                         FROM   serial
 742                         WHERE  subscriptionid = ? AND status NOT IN (2,4,5)
 743                         ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
 744     my $sth = $dbh->prepare($query);
 745     $sth->execute($subscriptionid);
 746     while ( my $line = $sth->fetchrow_hashref ) {
 747         $line->{ "status" . $line->{status} } =
 748           1;    # fills a "statusX" value, used for template status select list
 749         $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
 750         $line->{"planneddate"}   = format_date( $line->{"planneddate"} );
 751         push @serials, $line;
 752     }
 753     # OK, now add the last 5 issues arrives/missing
 754     $query =
 755       "SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
 756        FROM     serial
 757        WHERE    subscriptionid = ?
 758        AND      (status in (2,4,5))
 759        ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
 760       ";
 761     $sth = $dbh->prepare($query);
 762     $sth->execute($subscriptionid);
 763     while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
 764         $counter++;
 765         $line->{ "status" . $line->{status} } =
 766           1;    # fills a "statusX" value, used for template status select list
 767         $line->{"planneddate"}   = format_date( $line->{"planneddate"} );
 768         $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
 769         push @serials, $line;
 770     }
 771
 772     $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
 773     $sth = $dbh->prepare($query);
 774     $sth->execute($subscriptionid);
 775     my ($totalissues) = $sth->fetchrow;
 776     return ( $totalissues, @serials );
 777 }
 778
 779 =head2 GetSerials2
 780
 781 =over 4
 782
 783 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
 784 this function get every serial waited for a given subscription
 785 as well as the number of issues registered in the database (all types)
 786 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
 787
 788 =back
 789
 790 =cut
 791 sub GetSerials2 {
 792     my ($subscription,$status) = @_;
 793     my $dbh = C4::Context->dbh;
 794     my $query = qq|
 795                  SELECT   serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
 796                  FROM     serial
 797                  WHERE    subscriptionid=$subscription AND status IN ($status)
 798                  ORDER BY publisheddate,serialid DESC
 799                     |;
 800 #     warn $query;
 801     my $sth=$dbh->prepare($query);
 802     $sth->execute;
 803     my @serials;
 804     while(my $line = $sth->fetchrow_hashref) {
 805         $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
 806         $line->{"planneddate"} = format_date($line->{"planneddate"});
 807         $line->{"publisheddate"} = format_date($line->{"publisheddate"});
 808         push @serials,$line;
 809     }
 810     my ($totalissues) = scalar(@serials);
 811     return ($totalissues,@serials);
 812 }
 813
 814 =head2 GetLatestSerials
 815
 816 =over 4
 817
 818 \@serials = GetLatestSerials($subscriptionid,$limit)
 819 get the $limit's latest serials arrived or missing for a given subscription
 820 return :
 821 a ref to a table which it containts all of the latest serials stored into a hash.
 822
 823 =back
 824
 825 =cut
 826
 827 sub GetLatestSerials {
 828     my ( $subscriptionid, $limit ) = @_;
 829     my $dbh = C4::Context->dbh;
 830
 831     # status = 2 is "arrived"
 832     my $strsth = "SELECT   serialid,serialseq, status, planneddate, notes
 833                         FROM     serial
 834                         WHERE    subscriptionid = ?
 835                         AND      (status =2 or status=4)
 836                         ORDER BY planneddate DESC LIMIT 0,$limit
 837                 ";
 838     my $sth = $dbh->prepare($strsth);
 839     $sth->execute($subscriptionid);
 840     my @serials;
 841     while ( my $line = $sth->fetchrow_hashref ) {
 842         $line->{ "status" . $line->{status} } =
 843           1;    # fills a "statusX" value, used for template status select list
 844         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
 845         push @serials, $line;
 846     }
 847
 848     #     my $query = qq|
 849     #         SELECT count(*)
 850     #         FROM   serial
 851     #         WHERE  subscriptionid=?
 852     #     |;
 853     #     $sth=$dbh->prepare($query);
 854     #     $sth->execute($subscriptionid);
 855     #     my ($totalissues) = $sth->fetchrow;
 856     return \@serials;
 857 }
 858
 859 =head2 GetDistributedTo
 860
 861 =over 4
 862
 863 $distributedto=GetDistributedTo($subscriptionid)
 864 This function select the old previous value of distributedto in the database.
 865
 866 =back
 867
 868 =cut
 869
 870 sub GetDistributedTo {
 871     my $dbh = C4::Context->dbh;
 872     my $distributedto;
 873     my $subscriptionid = @_;
 874     my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
 875     my $sth   = $dbh->prepare($query);
 876     $sth->execute($subscriptionid);
 877     return ($distributedto) = $sth->fetchrow;
 878 }
 879
 880 =head2 GetNextSeq
 881
 882 =over 4
 883
 884 GetNextSeq($val)
 885 $val is a hashref containing all the attributes of the table 'subscription'
 886 This function get the next issue for the subscription given on input arg
 887 return:
 888 all the input params updated.
 889
 890 =back
 891
 892 =cut
 893
 894 # sub GetNextSeq {
 895 #     my ($val) =@_;
 896 #     my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 897 #     $calculated = $val->{numberingmethod};
 898 # # calculate the (expected) value of the next issue recieved.
 899 #     $newlastvalue1 = $val->{lastvalue1};
 900 # # check if we have to increase the new value.
 901 #     $newinnerloop1 = $val->{innerloop1}+1;
 902 #     $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 903 #     $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 904 #     $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 905 #     $calculated =~ s/\{X\}/$newlastvalue1/g;
 906 #
 907 #     $newlastvalue2 = $val->{lastvalue2};
 908 # # check if we have to increase the new value.
 909 #     $newinnerloop2 = $val->{innerloop2}+1;
 910 #     $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 911 #     $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 912 #     $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 913 #     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 914 #
 915 #     $newlastvalue3 = $val->{lastvalue3};
 916 # # check if we have to increase the new value.
 917 #     $newinnerloop3 = $val->{innerloop3}+1;
 918 #     $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 919 #     $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 920 #     $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 921 #     $calculated =~ s/\{Z\}/$newlastvalue3/g;
 922 #     return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
 923 # }
 924
 925 sub GetNextSeq {
 926     my ($val) = @_;
 927     my (
 928         $calculated,    $newlastvalue1, $newlastvalue2, $newlastvalue3,
 929         $newinnerloop1, $newinnerloop2, $newinnerloop3
 930     );
 931     my $pattern = $val->{numberpattern};
 932     my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
 933     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
 934     $calculated    = $val->{numberingmethod};
 935     $newlastvalue1 = $val->{lastvalue1};
 936     $newlastvalue2 = $val->{lastvalue2};
 937     $newlastvalue3 = $val->{lastvalue3};
 938   $newlastvalue1 = $val->{lastvalue1};
 939   # check if we have to increase the new value.
 940   $newinnerloop1 = $val->{innerloop1} + 1;
 941   $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
 942   $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
 943   $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
 944   $calculated =~ s/\{X\}/$newlastvalue1/g;
 945
 946   $newlastvalue2 = $val->{lastvalue2};
 947   # check if we have to increase the new value.
 948   $newinnerloop2 = $val->{innerloop2} + 1;
 949   $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
 950   $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
 951   $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
 952   if ( $pattern == 6 ) {
 953     if ( $val->{hemisphere} == 2 ) {
 954        my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
 955        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 956     }
 957     else {
 958        my $newlastvalue2seq = $seasons[$newlastvalue2];
 959        $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
 960     }
 961   }
 962   else {
 963     $calculated =~ s/\{Y\}/$newlastvalue2/g;
 964   }
 965
 966
 967   $newlastvalue3 = $val->{lastvalue3};
 968   # check if we have to increase the new value.
 969   $newinnerloop3 = $val->{innerloop3} + 1;
 970   $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
 971   $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
 972   $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
 973   $calculated =~ s/\{Z\}/$newlastvalue3/g;
 974
 975   return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
 976            $newinnerloop1, $newinnerloop2, $newinnerloop3);
 977 }
 978
 979 =head2 GetSeq
 980
 981 =over 4
 982
 983 $calculated = GetSeq($val)
 984 $val is a hashref containing all the attributes of the table 'subscription'
 985 this function transforms {X},{Y},{Z} to 150,0,0 for example.
 986 return:
 987 the sequence in integer format
 988
 989 =back
 990
 991 =cut
 992
 993 sub GetSeq {
 994     my ($val)      = @_;
 995     my $pattern = $val->{numberpattern};
 996     my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
 997     my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
 998     my $calculated = $val->{numberingmethod};
 999     my $x          = $val->{'lastvalue1'};
1000     $calculated =~ s/\{X\}/$x/g;
1001     my $newlastvalue2 = $val->{'lastvalue2'};
1002     if ( $pattern == 6 ) {
1003         if ( $val->{hemisphere} == 2 ) {
1004             my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1005             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1006         }
1007         else {
1008             my $newlastvalue2seq = $seasons[$newlastvalue2];
1009             $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1010         }
1011     }
1012     else {
1013         $calculated =~ s/\{Y\}/$newlastvalue2/g;
1014     }
1015     my $z = $val->{'lastvalue3'};
1016     $calculated =~ s/\{Z\}/$z/g;
1017     return $calculated;
1018 }
1019
1020 =head2 GetExpirationDate
1021
1022 $sensddate = GetExpirationDate($subscriptionid)
1023
1024 this function return the expiration date for a subscription given on input args.
1025
1026 return
1027 the enddate
1028
1029 =cut
1030
1031 sub GetExpirationDate {
1032     my ($subscriptionid) = @_;
1033     my $dbh              = C4::Context->dbh;
1034     my $subscription     = GetSubscription($subscriptionid);
1035     my $enddate          = $subscription->{startdate};
1036
1037 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1038     if (($subscription->{periodicity} % 16) >0){
1039       if ( $subscription->{numberlength} ) {
1040           #calculate the date of the last issue.
1041           my $length = $subscription->{numberlength};
1042           for ( my $i = 1 ; $i <= $length ; $i++ ) {
1043               $enddate = GetNextDate( $enddate, $subscription );
1044           }
1045       }
1046       elsif ( $subscription->{monthlength} ){
1047           my @date=split (/-/,$subscription->{startdate});
1048           my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1049           $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1050       } elsif ( $subscription->{weeklength} ){
1051           my @date=split (/-/,$subscription->{startdate});
1052           my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1053           $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1054       }
1055       return $enddate;
1056     } else {
1057       return 0;
1058     }
1059 }
1060
1061 =head2 CountSubscriptionFromBiblionumber
1062
1063 =over 4
1064
1065 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1066 this count the number of subscription for a biblionumber given.
1067 return :
1068 the number of subscriptions with biblionumber given on input arg.
1069
1070 =back
1071
1072 =cut
1073
1074 sub CountSubscriptionFromBiblionumber {
1075     my ($biblionumber) = @_;
1076     my $dbh = C4::Context->dbh;
1077     my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1078     my $sth   = $dbh->prepare($query);
1079     $sth->execute($biblionumber);
1080     my $subscriptionsnumber = $sth->fetchrow;
1081     return $subscriptionsnumber;
1082 }
1083
1084 =head2 ModSubscriptionHistory
1085
1086 =over 4
1087
1088 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1089
1090 this function modify the history of a subscription. Put your new values on input arg.
1091
1092 =back
1093
1094 =cut
1095
1096 sub ModSubscriptionHistory {
1097     my (
1098         $subscriptionid, $histstartdate, $enddate, $recievedlist,
1099         $missinglist,    $opacnote,      $librariannote
1100     ) = @_;
1101     my $dbh   = C4::Context->dbh;
1102     my $query = "UPDATE subscriptionhistory
1103                     SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1104                     WHERE subscriptionid=?
1105                 ";
1106     my $sth = $dbh->prepare($query);
1107     $recievedlist =~ s/^,//g;
1108     $missinglist  =~ s/^,//g;
1109     $opacnote     =~ s/^,//g;
1110     $sth->execute(
1111         $histstartdate, $enddate,       $recievedlist, $missinglist,
1112         $opacnote,      $librariannote, $subscriptionid
1113     );
1114     return $sth->rows;
1115 }
1116
1117 =head2 ModSerialStatus
1118
1119 =over 4
1120
1121 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1122
1123 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1124 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1125
1126 =back
1127
1128 =cut
1129
1130 sub ModSerialStatus {
1131     my ( $serialid, $serialseq,  $planneddate,$publisheddate, $status, $notes )
1132       = @_;
1133
1134     #It is a usual serial
1135     # 1st, get previous status :
1136     my $dbh   = C4::Context->dbh;
1137     my $query = "SELECT subscriptionid,status FROM serial WHERE  serialid=?";
1138     my $sth   = $dbh->prepare($query);
1139     $sth->execute($serialid);
1140     my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1141
1142     # change status & update subscriptionhistory
1143     my $val;
1144     if ( $status eq 6 ) {
1145         DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1146     }
1147     else {
1148         my $query =
1149 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE  serialid = ?";
1150         $sth = $dbh->prepare($query);
1151         $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1152             $notes, $serialid );
1153         $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1154         $sth = $dbh->prepare($query);
1155         $sth->execute($subscriptionid);
1156         my $val = $sth->fetchrow_hashref;
1157         unless ( $val->{manualhistory} ) {
1158             $query =
1159 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE  subscriptionid=?";
1160             $sth = $dbh->prepare($query);
1161             $sth->execute($subscriptionid);
1162             my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1163             if ( $status eq 2 ) {
1164
1165 #             warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1166                 $recievedlist .= ",$serialseq"
1167                   unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1168             }
1169
1170 #         warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1171             $missinglist .= ",$serialseq"
1172               if ( $status eq 4
1173                 and not index( "$missinglist", "$serialseq" ) >= 0 );
1174             $missinglist .= ",not issued $serialseq"
1175               if ( $status eq 5
1176                 and index( "$missinglist", "$serialseq" ) >= 0 );
1177             $query =
1178 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE  subscriptionid=?";
1179             $sth = $dbh->prepare($query);
1180             $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1181         }
1182     }
1183
1184     # create new waited entry if needed (ie : was a "waited" and has changed)
1185     if ( $oldstatus eq 1 && $status ne 1 ) {
1186         my $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1187         $sth = $dbh->prepare($query);
1188         $sth->execute($subscriptionid);
1189         my $val = $sth->fetchrow_hashref;
1190
1191         # next issue number
1192 #     warn "Next Seq";
1193         my (
1194             $newserialseq,  $newlastvalue1, $newlastvalue2, $newlastvalue3,
1195             $newinnerloop1, $newinnerloop2, $newinnerloop3
1196         ) = GetNextSeq($val);
1197 #     warn "Next Seq End";
1198
1199         # next date (calculated from actual date & frequency parameters)
1200 #         warn "publisheddate :$publisheddate ";
1201         my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1202         NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1203             1, $nextpublisheddate, $nextpublisheddate );
1204         $query =
1205 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1206                     WHERE  subscriptionid = ?";
1207         $sth = $dbh->prepare($query);
1208         $sth->execute(
1209             $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1210             $newinnerloop2, $newinnerloop3, $subscriptionid
1211         );
1212
1213 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1214         if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1215             SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1216         }
1217     }
1218 }
1219
1220 =head2 ModSubscription
1221
1222 =over 4
1223
1224 this function modify a subscription. Put all new values on input args.
1225
1226 =back
1227
1228 =cut
1229
1230 sub ModSubscription {
1231     my (
1232         $auser,           $branchcode,   $aqbooksellerid, $cost,
1233         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1234         $dow,             $irregularity, $numberpattern,  $numberlength,
1235         $weeklength,      $monthlength,  $add1,           $every1,
1236         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1237         $add2,            $every2,       $whenmorethan2,  $setto2,
1238         $lastvalue2,      $innerloop2,   $add3,           $every3,
1239         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1240         $numberingmethod, $status,       $biblionumber,   $callnumber,
1241         $notes,           $letter,       $hemisphere,     $manualhistory,
1242         $internalnotes,   $serialsadditems,
1243         $subscriptionid
1244     ) = @_;
1245 #     warn $irregularity;
1246     my $dbh   = C4::Context->dbh;
1247     my $query = "UPDATE subscription
1248                     SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1249                         periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1250                         add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1251                         add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1252                         add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1253                         numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?
1254                     WHERE subscriptionid = ?";
1255 #     warn "query :".$query;
1256     my $sth = $dbh->prepare($query);
1257     $sth->execute(
1258         $auser,           $branchcode,   $aqbooksellerid, $cost,
1259         $aqbudgetid,      $startdate,    $periodicity,    $firstacquidate,
1260         $dow,             "$irregularity", $numberpattern,  $numberlength,
1261         $weeklength,      $monthlength,  $add1,           $every1,
1262         $whenmorethan1,   $setto1,       $lastvalue1,     $innerloop1,
1263         $add2,            $every2,       $whenmorethan2,  $setto2,
1264         $lastvalue2,      $innerloop2,   $add3,           $every3,
1265         $whenmorethan3,   $setto3,       $lastvalue3,     $innerloop3,
1266         $numberingmethod, $status,       $biblionumber,   $callnumber,
1267         $notes,           $letter,       $hemisphere,     ($manualhistory?$manualhistory:0),
1268         $internalnotes,   $serialsadditems,
1269         $subscriptionid
1270     );
1271     my $rows=$sth->rows;
1272     $sth->finish;
1273
1274     logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1275     return $rows;
1276 }
1277
1278 =head2 NewSubscription
1279
1280 =over 4
1281
1282 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1283     $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1284     $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1285     $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1286     $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1287     $numberingmethod, $status, $notes, $serialsadditems)
1288
1289 Create a new subscription with value given on input args.
1290
1291 return :
1292 the id of this new subscription
1293
1294 =back
1295
1296 =cut
1297
1298 sub NewSubscription {
1299     my (
1300         $auser,         $branchcode,   $aqbooksellerid,  $cost,
1301         $aqbudgetid,    $biblionumber, $startdate,       $periodicity,
1302         $dow,           $numberlength, $weeklength,      $monthlength,
1303         $add1,          $every1,       $whenmorethan1,   $setto1,
1304         $lastvalue1,    $innerloop1,   $add2,            $every2,
1305         $whenmorethan2, $setto2,       $lastvalue2,      $innerloop2,
1306         $add3,          $every3,       $whenmorethan3,   $setto3,
1307         $lastvalue3,    $innerloop3,   $numberingmethod, $status,
1308         $notes,         $letter,       $firstacquidate,  $irregularity,
1309         $numberpattern, $callnumber,   $hemisphere,      $manualhistory,
1310         $internalnotes, $serialsadditems,
1311     ) = @_;
1312     my $dbh = C4::Context->dbh;
1313
1314     #save subscription (insert into database)
1315     my $query = qq|
1316         INSERT INTO subscription
1317             (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1318             startdate,periodicity,dow,numberlength,weeklength,monthlength,
1319             add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1320             add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1321             add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1322             numberingmethod, status, notes, letter,firstacquidate,irregularity,
1323             numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems)
1324         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1325         |;
1326     my $sth = $dbh->prepare($query);
1327     $sth->execute(
1328         $auser,                         $branchcode,
1329         $aqbooksellerid,                $cost,
1330         $aqbudgetid,                    $biblionumber,
1331         format_date_in_iso($startdate), $periodicity,
1332         $dow,                           $numberlength,
1333         $weeklength,                    $monthlength,
1334         $add1,                          $every1,
1335         $whenmorethan1,                 $setto1,
1336         $lastvalue1,                    $innerloop1,
1337         $add2,                          $every2,
1338         $whenmorethan2,                 $setto2,
1339         $lastvalue2,                    $innerloop2,
1340         $add3,                          $every3,
1341         $whenmorethan3,                 $setto3,
1342         $lastvalue3,                    $innerloop3,
1343         $numberingmethod,               "$status",
1344         $notes,                         $letter,
1345         format_date_in_iso($firstacquidate),                $irregularity,
1346         $numberpattern,                 $callnumber,
1347         $hemisphere,                    $manualhistory,
1348         $internalnotes,                 $serialsadditems,
1349     );
1350
1351     #then create the 1st waited number
1352     my $subscriptionid = $dbh->{'mysql_insertid'};
1353     $query             = qq(
1354         INSERT INTO subscriptionhistory
1355             (biblionumber, subscriptionid, histstartdate,  opacnote, librariannote)
1356         VALUES (?,?,?,?,?)
1357         );
1358     $sth = $dbh->prepare($query);
1359     $sth->execute( $biblionumber, $subscriptionid,
1360         format_date_in_iso($startdate),
1361         $notes,$internalnotes );
1362
1363    # reread subscription to get a hash (for calculation of the 1st issue number)
1364     $query = qq(
1365         SELECT *
1366         FROM   subscription
1367         WHERE  subscriptionid = ?
1368     );
1369     $sth = $dbh->prepare($query);
1370     $sth->execute($subscriptionid);
1371     my $val = $sth->fetchrow_hashref;
1372
1373     # calculate issue number
1374     my $serialseq = GetSeq($val);
1375     $query     = qq|
1376         INSERT INTO serial
1377             (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1378         VALUES (?,?,?,?,?,?)
1379     |;
1380     $sth = $dbh->prepare($query);
1381     $sth->execute(
1382         "$serialseq", $subscriptionid, $biblionumber, 1,
1383         format_date_in_iso($startdate),
1384         format_date_in_iso($startdate)
1385     );
1386
1387     logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1388
1389 #set serial flag on biblio if not already set.
1390     my ($null, ($bib)) = GetBiblio($biblionumber);
1391     if( ! $bib->{'serial'} ) {
1392         my $record = GetMarcBiblio($biblionumber);
1393         my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1394         if($tag) {
1395             eval {
1396             $record->field($tag)->update( $subf => 1 );
1397             };
1398         }
1399         ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1400     }
1401     return $subscriptionid;
1402 }
1403
1404 =head2 ReNewSubscription
1405
1406 =over 4
1407
1408 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1409
1410 this function renew a subscription with values given on input args.
1411
1412 =back
1413
1414 =cut
1415
1416 sub ReNewSubscription {
1417     my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1418         $monthlength, $note )
1419       = @_;
1420     my $dbh          = C4::Context->dbh;
1421     my $subscription = GetSubscription($subscriptionid);
1422      my $query        = qq|
1423          SELECT *
1424          FROM   biblio
1425          LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1426          WHERE    biblio.biblionumber=?
1427      |;
1428      my $sth = $dbh->prepare($query);
1429      $sth->execute( $subscription->{biblionumber} );
1430      my $biblio = $sth->fetchrow_hashref;
1431      NewSuggestion(
1432          $user,             $subscription->{bibliotitle},
1433          $biblio->{author}, $biblio->{publishercode},
1434          $biblio->{note},   '',
1435          '',                '',
1436          '',                '',
1437          $subscription->{biblionumber}
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->{'numberlentgh'});
1751               return 0;
1752       } else {
1753               return 0;
1754       }
1755     }
1756     return 0;
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