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      if (C4::Context->preference("RenewSerialAddsSuggestion")){
1432         NewSuggestion(
1433             $user,             $subscription->{bibliotitle},
1434             $biblio->{author}, $biblio->{publishercode},
1435             $biblio->{note},   '',
1436             '',                '',
1437             '',                '',
1438             $subscription->{biblionumber}
1439         );
1440     }
1441
1442     # renew subscription
1443     $query = qq|
1444         UPDATE subscription
1445         SET    startdate=?,numberlength=?,weeklength=?,monthlength=?
1446         WHERE  subscriptionid=?
1447     |;
1448     $sth = $dbh->prepare($query);
1449     $sth->execute( format_date_in_iso($startdate),
1450         $numberlength, $weeklength, $monthlength, $subscriptionid );
1451
1452     logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1453 }
1454
1455 =head2 NewIssue
1456
1457 =over 4
1458
1459 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate,  $notes)
1460
1461 Create a new issue stored on the database.
1462 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1463
1464 =back
1465
1466 =cut
1467
1468 sub NewIssue {
1469     my ( $serialseq, $subscriptionid, $biblionumber, $status,
1470         $planneddate, $publisheddate, $notes )
1471       = @_;
1472     ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1473
1474     my $dbh   = C4::Context->dbh;
1475     my $query = qq|
1476         INSERT INTO serial
1477             (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1478         VALUES (?,?,?,?,?,?,?)
1479     |;
1480     my $sth = $dbh->prepare($query);
1481     $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1482         $publisheddate, $planneddate,$notes );
1483     my $serialid=$dbh->{'mysql_insertid'};
1484     $query = qq|
1485         SELECT missinglist,recievedlist
1486         FROM   subscriptionhistory
1487         WHERE  subscriptionid=?
1488     |;
1489     $sth = $dbh->prepare($query);
1490     $sth->execute($subscriptionid);
1491     my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1492
1493     if ( $status eq 2 ) {
1494       ### TODO Add a feature that improves recognition and description.
1495       ### As such count (serialseq) i.e. : N18,2(N19),N20
1496       ### Would use substr and index But be careful to previous presence of ()
1497         $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1498     }
1499     if ( $status eq 4 ) {
1500         $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1501     }
1502     $query = qq|
1503         UPDATE subscriptionhistory
1504         SET    recievedlist=?, missinglist=?
1505         WHERE  subscriptionid=?
1506     |;
1507     $sth = $dbh->prepare($query);
1508     $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1509     return $serialid;
1510 }
1511
1512 =head2 ItemizeSerials
1513
1514 =over 4
1515
1516 ItemizeSerials($serialid, $info);
1517 $info is a hashref containing  barcode branch, itemcallnumber, status, location
1518 $serialid the serialid
1519 return :
1520 1 if the itemize is a succes.
1521 0 and @error else. @error containts the list of errors found.
1522
1523 =back
1524
1525 =cut
1526
1527 sub ItemizeSerials {
1528     my ( $serialid, $info ) = @_;
1529     my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1530
1531     my $dbh   = C4::Context->dbh;
1532     my $query = qq|
1533         SELECT *
1534         FROM   serial
1535         WHERE  serialid=?
1536     |;
1537     my $sth = $dbh->prepare($query);
1538     $sth->execute($serialid);
1539     my $data = $sth->fetchrow_hashref;
1540     if ( C4::Context->preference("RoutingSerials") ) {
1541
1542         # check for existing biblioitem relating to serial issue
1543         my ( $count, @results ) =
1544           GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1545         my $bibitemno = 0;
1546         for ( my $i = 0 ; $i < $count ; $i++ ) {
1547             if (  $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1548                 . $data->{'planneddate'}
1549                 . ')' )
1550             {
1551                 $bibitemno = $results[$i]->{'biblioitemnumber'};
1552                 last;
1553             }
1554         }
1555         if ( $bibitemno == 0 ) {
1556
1557     # warn "need to add new biblioitem so copy last one and make minor changes";
1558             my $sth =
1559               $dbh->prepare(
1560 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1561               );
1562             $sth->execute( $data->{'biblionumber'} );
1563             my $biblioitem = $sth->fetchrow_hashref;
1564             $biblioitem->{'volumedate'} =
1565               format_date_in_iso( $data->{planneddate} );
1566             $biblioitem->{'volumeddesc'} =
1567               $data->{serialseq} . ' ('
1568               . format_date( $data->{'planneddate'} ) . ')';
1569             $biblioitem->{'dewey'} = $info->{itemcallnumber};
1570
1571             #FIXME  HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1572             # so I comment it, we can speak of it when you want
1573             # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1574 #             if ( $info->{barcode} )
1575 #             {    # only make biblioitem if we are going to make item also
1576 #                 $bibitemno = newbiblioitem($biblioitem);
1577 #             }
1578         }
1579     }
1580
1581     my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1582     if ( $info->{barcode} ) {
1583         my @errors;
1584         my $exists = itemdata( $info->{'barcode'} );
1585         push @errors, "barcode_not_unique" if ($exists);
1586         unless ($exists) {
1587             my $marcrecord = MARC::Record->new();
1588             my ( $tag, $subfield ) =
1589               GetMarcFromKohaField( "items.barcode", $fwk );
1590             my $newField =
1591               MARC::Field->new( "$tag", '', '',
1592                 "$subfield" => $info->{barcode} );
1593             $marcrecord->insert_fields_ordered($newField);
1594             if ( $info->{branch} ) {
1595                 my ( $tag, $subfield ) =
1596                   GetMarcFromKohaField( "items.homebranch",
1597                     $fwk );
1598
1599                 #warn "items.homebranch : $tag , $subfield";
1600                 if ( $marcrecord->field($tag) ) {
1601                     $marcrecord->field($tag)
1602                       ->add_subfields( "$subfield" => $info->{branch} );
1603                 }
1604                 else {
1605                     my $newField =
1606                       MARC::Field->new( "$tag", '', '',
1607                         "$subfield" => $info->{branch} );
1608                     $marcrecord->insert_fields_ordered($newField);
1609                 }
1610                 ( $tag, $subfield ) =
1611                   GetMarcFromKohaField( "items.holdingbranch",
1612                     $fwk );
1613
1614                 #warn "items.holdingbranch : $tag , $subfield";
1615                 if ( $marcrecord->field($tag) ) {
1616                     $marcrecord->field($tag)
1617                       ->add_subfields( "$subfield" => $info->{branch} );
1618                 }
1619                 else {
1620                     my $newField =
1621                       MARC::Field->new( "$tag", '', '',
1622                         "$subfield" => $info->{branch} );
1623                     $marcrecord->insert_fields_ordered($newField);
1624                 }
1625             }
1626             if ( $info->{itemcallnumber} ) {
1627                 my ( $tag, $subfield ) =
1628                   GetMarcFromKohaField( "items.itemcallnumber",
1629                     $fwk );
1630
1631                 #warn "items.itemcallnumber : $tag , $subfield";
1632                 if ( $marcrecord->field($tag) ) {
1633                     $marcrecord->field($tag)
1634                       ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1635                 }
1636                 else {
1637                     my $newField =
1638                       MARC::Field->new( "$tag", '', '',
1639                         "$subfield" => $info->{itemcallnumber} );
1640                     $marcrecord->insert_fields_ordered($newField);
1641                 }
1642             }
1643             if ( $info->{notes} ) {
1644                 my ( $tag, $subfield ) =
1645                   GetMarcFromKohaField( "items.itemnotes", $fwk );
1646
1647                 # warn "items.itemnotes : $tag , $subfield";
1648                 if ( $marcrecord->field($tag) ) {
1649                     $marcrecord->field($tag)
1650                       ->add_subfields( "$subfield" => $info->{notes} );
1651                 }
1652                 else {
1653                     my $newField =
1654                       MARC::Field->new( "$tag", '', '',
1655                         "$subfield" => $info->{notes} );
1656                     $marcrecord->insert_fields_ordered($newField);
1657                 }
1658             }
1659             if ( $info->{location} ) {
1660                 my ( $tag, $subfield ) =
1661                   GetMarcFromKohaField( "items.location", $fwk );
1662
1663                 # warn "items.location : $tag , $subfield";
1664                 if ( $marcrecord->field($tag) ) {
1665                     $marcrecord->field($tag)
1666                       ->add_subfields( "$subfield" => $info->{location} );
1667                 }
1668                 else {
1669                     my $newField =
1670                       MARC::Field->new( "$tag", '', '',
1671                         "$subfield" => $info->{location} );
1672                     $marcrecord->insert_fields_ordered($newField);
1673                 }
1674             }
1675             if ( $info->{status} ) {
1676                 my ( $tag, $subfield ) =
1677                   GetMarcFromKohaField( "items.notforloan",
1678                     $fwk );
1679
1680                 # warn "items.notforloan : $tag , $subfield";
1681                 if ( $marcrecord->field($tag) ) {
1682                     $marcrecord->field($tag)
1683                       ->add_subfields( "$subfield" => $info->{status} );
1684                 }
1685                 else {
1686                     my $newField =
1687                       MARC::Field->new( "$tag", '', '',
1688                         "$subfield" => $info->{status} );
1689                     $marcrecord->insert_fields_ordered($newField);
1690                 }
1691             }
1692             if ( C4::Context->preference("RoutingSerials") ) {
1693                 my ( $tag, $subfield ) =
1694                   GetMarcFromKohaField( "items.dateaccessioned",
1695                     $fwk );
1696                 if ( $marcrecord->field($tag) ) {
1697                     $marcrecord->field($tag)
1698                       ->add_subfields( "$subfield" => $now );
1699                 }
1700                 else {
1701                     my $newField =
1702                       MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1703                     $marcrecord->insert_fields_ordered($newField);
1704                 }
1705             }
1706             AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1707             return 1;
1708         }
1709         return ( 0, @errors );
1710     }
1711 }
1712
1713 =head2 HasSubscriptionExpired
1714
1715 =over 4
1716
1717 1 or 0 = HasSubscriptionExpired($subscriptionid)
1718
1719 the subscription has expired when the next issue to arrive is out of subscription limit.
1720
1721 return :
1722 1 if true, 0 if false.
1723
1724 =back
1725
1726 =cut
1727
1728 sub HasSubscriptionExpired {
1729     my ($subscriptionid) = @_;
1730     my $dbh              = C4::Context->dbh;
1731     my $subscription     = GetSubscription($subscriptionid);
1732     if (($subscription->{periodicity} % 16)>0){
1733       my $expirationdate   = GetExpirationDate($subscriptionid);
1734       my $query = qq|
1735             SELECT max(planneddate)
1736             FROM   serial
1737             WHERE  subscriptionid=?
1738       |;
1739       my $sth = $dbh->prepare($query);
1740       $sth->execute($subscriptionid);
1741       my ($res) = $sth->fetchrow  ;
1742       my @res=split (/-/,$res);
1743 # warn "date expiration :$expirationdate";
1744       my @endofsubscriptiondate=split(/-/,$expirationdate);
1745       return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1746                   $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1747                   || (!$res));
1748       return 0;
1749     } else {
1750       if ($subscription->{'numberlength'}){
1751         my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1752         return 1 if ($countreceived >$subscription->{'numberlentgh'});
1753               return 0;
1754       } else {
1755               return 0;
1756       }
1757     }
1758     return 0;
1759 }
1760
1761 =head2 SetDistributedto
1762
1763 =over 4
1764
1765 SetDistributedto($distributedto,$subscriptionid);
1766 This function update the value of distributedto for a subscription given on input arg.
1767
1768 =back
1769
1770 =cut
1771
1772 sub SetDistributedto {
1773     my ( $distributedto, $subscriptionid ) = @_;
1774     my $dbh   = C4::Context->dbh;
1775     my $query = qq|
1776         UPDATE subscription
1777         SET    distributedto=?
1778         WHERE  subscriptionid=?
1779     |;
1780     my $sth = $dbh->prepare($query);
1781     $sth->execute( $distributedto, $subscriptionid );
1782 }
1783
1784 =head2 DelSubscription
1785
1786 =over 4
1787
1788 DelSubscription($subscriptionid)
1789 this function delete the subscription which has $subscriptionid as id.
1790
1791 =back
1792
1793 =cut
1794
1795 sub DelSubscription {
1796     my ($subscriptionid) = @_;
1797     my $dbh = C4::Context->dbh;
1798     $subscriptionid = $dbh->quote($subscriptionid);
1799     $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1800     $dbh->do(
1801         "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1802     $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1803
1804     logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1805 }
1806
1807 =head2 DelIssue
1808
1809 =over 4
1810
1811 DelIssue($serialseq,$subscriptionid)
1812 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1813
1814 =back
1815
1816 =cut
1817
1818 sub DelIssue {
1819     my ( $dataissue) = @_;
1820     my $dbh   = C4::Context->dbh;
1821     ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1822
1823     my $query = qq|
1824         DELETE FROM serial
1825         WHERE       serialid= ?
1826         AND         subscriptionid= ?
1827     |;
1828     my $mainsth = $dbh->prepare($query);
1829     $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1830
1831     #Delete element from subscription history
1832     $query = "SELECT * FROM   subscription WHERE  subscriptionid = ?";
1833     my $sth   = $dbh->prepare($query);
1834     $sth->execute($dataissue->{'subscriptionid'});
1835     my $val = $sth->fetchrow_hashref;
1836     unless ( $val->{manualhistory} ) {
1837         my $query = qq|
1838           SELECT * FROM subscriptionhistory
1839           WHERE       subscriptionid= ?
1840       |;
1841         my $sth = $dbh->prepare($query);
1842         $sth->execute($dataissue->{'subscriptionid'});
1843         my $data = $sth->fetchrow_hashref;
1844         my $serialseq= $dataissue->{'serialseq'};
1845         $data->{'missinglist'}  =~ s/\b$serialseq\b//;
1846         $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1847         my $strsth = "UPDATE subscriptionhistory SET "
1848           . join( ",",
1849             map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1850           . " WHERE subscriptionid=?";
1851         $sth = $dbh->prepare($strsth);
1852         $sth->execute($dataissue->{'subscriptionid'});
1853     }
1854
1855     return $mainsth->rows;
1856 }
1857
1858 =head2 GetLateOrMissingIssues
1859
1860 =over 4
1861
1862 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1863
1864 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1865
1866 return :
1867 a count of the number of missing issues
1868 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1869 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1870
1871 =back
1872
1873 =cut
1874
1875 sub GetLateOrMissingIssues {
1876     my ( $supplierid, $serialid,$order ) = @_;
1877     my $dbh = C4::Context->dbh;
1878     my $sth;
1879     my $byserial = '';
1880     if ($serialid) {
1881         $byserial = "and serialid = " . $serialid;
1882     }
1883     if ($order){
1884       $order.=", title";
1885     } else {
1886       $order="title";
1887     }
1888     if ($supplierid) {
1889         $sth = $dbh->prepare(
1890 "SELECT
1891    serialid,
1892    aqbooksellerid,
1893    name,
1894    biblio.title,
1895    planneddate,
1896    serialseq,
1897    serial.status,
1898    serial.subscriptionid,
1899    claimdate
1900 FROM      serial
1901 LEFT JOIN subscription  ON serial.subscriptionid=subscription.subscriptionid
1902 LEFT JOIN biblio        ON subscription.biblionumber=biblio.biblionumber
1903 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1904 WHERE subscription.subscriptionid = serial.subscriptionid
1905 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1906 AND subscription.aqbooksellerid=$supplierid
1907 $byserial
1908 ORDER BY $order"
1909         );
1910     }
1911     else {
1912         $sth = $dbh->prepare(
1913 "SELECT
1914    serialid,
1915    aqbooksellerid,
1916    name,
1917    biblio.title,
1918    planneddate,
1919    serialseq,
1920    serial.status,
1921    serial.subscriptionid,
1922    claimdate
1923 FROM serial
1924 LEFT JOIN subscription
1925 ON serial.subscriptionid=subscription.subscriptionid
1926 LEFT JOIN biblio
1927 ON subscription.biblionumber=biblio.biblionumber
1928 LEFT JOIN aqbooksellers
1929 ON subscription.aqbooksellerid = aqbooksellers.id
1930 WHERE
1931    subscription.subscriptionid = serial.subscriptionid
1932 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1933 $byserial
1934 ORDER BY $order"
1935         );
1936     }
1937     $sth->execute;
1938     my @issuelist;
1939     my $last_title;
1940     my $odd   = 0;
1941     my $count = 0;
1942     while ( my $line = $sth->fetchrow_hashref ) {
1943         $odd++ unless $line->{title} eq $last_title;
1944         $last_title = $line->{title} if ( $line->{title} );
1945         $line->{planneddate} = format_date( $line->{planneddate} );
1946         $line->{claimdate}   = format_date( $line->{claimdate} );
1947         $line->{"status".$line->{status}}   = 1;
1948         $line->{'odd'} = 1 if $odd % 2;
1949         $count++;
1950         push @issuelist, $line;
1951     }
1952     return $count, @issuelist;
1953 }
1954
1955 =head2 removeMissingIssue
1956
1957 =over 4
1958
1959 removeMissingIssue($subscriptionid)
1960
1961 this function removes an issue from being part of the missing string in
1962 subscriptionlist.missinglist column
1963
1964 called when a missing issue is found from the serials-recieve.pl file
1965
1966 =back
1967
1968 =cut
1969
1970 sub removeMissingIssue {
1971     my ( $sequence, $subscriptionid ) = @_;
1972     my $dbh = C4::Context->dbh;
1973     my $sth =
1974       $dbh->prepare(
1975         "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1976     $sth->execute($subscriptionid);
1977     my $data              = $sth->fetchrow_hashref;
1978     my $missinglist       = $data->{'missinglist'};
1979     my $missinglistbefore = $missinglist;
1980
1981     # warn $missinglist." before";
1982     $missinglist =~ s/($sequence)//;
1983
1984     # warn $missinglist." after";
1985     if ( $missinglist ne $missinglistbefore ) {
1986         $missinglist =~ s/\|\s\|/\|/g;
1987         $missinglist =~ s/^\| //g;
1988         $missinglist =~ s/\|$//g;
1989         my $sth2 = $dbh->prepare(
1990             "UPDATE subscriptionhistory
1991                                        SET missinglist = ?
1992                                        WHERE subscriptionid = ?"
1993         );
1994         $sth2->execute( $missinglist, $subscriptionid );
1995     }
1996 }
1997
1998 =head2 updateClaim
1999
2000 =over 4
2001
2002 &updateClaim($serialid)
2003
2004 this function updates the time when a claim is issued for late/missing items
2005
2006 called from claims.pl file
2007
2008 =back
2009
2010 =cut
2011
2012 sub updateClaim {
2013     my ($serialid) = @_;
2014     my $dbh        = C4::Context->dbh;
2015     my $sth        = $dbh->prepare(
2016         "UPDATE serial SET claimdate = now()
2017                                    WHERE serialid = ?
2018                                    "
2019     );
2020     $sth->execute($serialid);
2021 }
2022
2023 =head2 getsupplierbyserialid
2024
2025 =over 4
2026
2027 ($result) = &getsupplierbyserialid($serialid)
2028
2029 this function is used to find the supplier id given a serial id
2030
2031 return :
2032 hashref containing serialid, subscriptionid, and aqbooksellerid
2033
2034 =back
2035
2036 =cut
2037
2038 sub getsupplierbyserialid {
2039     my ($serialid) = @_;
2040     my $dbh        = C4::Context->dbh;
2041     my $sth        = $dbh->prepare(
2042         "SELECT serialid, serial.subscriptionid, aqbooksellerid
2043          FROM serial
2044          LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2045          WHERE serialid = ?
2046                                    "
2047     );
2048     $sth->execute($serialid);
2049     my $line   = $sth->fetchrow_hashref;
2050     my $result = $line->{'aqbooksellerid'};
2051     return $result;
2052 }
2053
2054 =head2 check_routing
2055
2056 =over 4
2057
2058 ($result) = &check_routing($subscriptionid)
2059
2060 this function checks to see if a serial has a routing list and returns the count of routingid
2061 used to show either an 'add' or 'edit' link
2062 =back
2063
2064 =cut
2065
2066 sub check_routing {
2067     my ($subscriptionid) = @_;
2068     my $dbh              = C4::Context->dbh;
2069     my $sth              = $dbh->prepare(
2070 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2071                               ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2072                               WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2073                               "
2074     );
2075     $sth->execute($subscriptionid);
2076     my $line   = $sth->fetchrow_hashref;
2077     my $result = $line->{'routingids'};
2078     return $result;
2079 }
2080
2081 =head2 addroutingmember
2082
2083 =over 4
2084
2085 &addroutingmember($borrowernumber,$subscriptionid)
2086
2087 this function takes a borrowernumber and subscriptionid and add the member to the
2088 routing list for that serial subscription and gives them a rank on the list
2089 of either 1 or highest current rank + 1
2090
2091 =back
2092
2093 =cut
2094
2095 sub addroutingmember {
2096     my ( $borrowernumber, $subscriptionid ) = @_;
2097     my $rank;
2098     my $dbh = C4::Context->dbh;
2099     my $sth =
2100       $dbh->prepare(
2101 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2102       );
2103     $sth->execute($subscriptionid);
2104     while ( my $line = $sth->fetchrow_hashref ) {
2105         if ( $line->{'rank'} > 0 ) {
2106             $rank = $line->{'rank'} + 1;
2107         }
2108         else {
2109             $rank = 1;
2110         }
2111     }
2112     $sth =
2113       $dbh->prepare(
2114 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2115       );
2116     $sth->execute( $subscriptionid, $borrowernumber, $rank );
2117 }
2118
2119 =head2 reorder_members
2120
2121 =over 4
2122
2123 &reorder_members($subscriptionid,$routingid,$rank)
2124
2125 this function is used to reorder the routing list
2126
2127 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2128 - it gets all members on list puts their routingid's into an array
2129 - removes the one in the array that is $routingid
2130 - then reinjects $routingid at point indicated by $rank
2131 - then update the database with the routingids in the new order
2132
2133 =back
2134
2135 =cut
2136
2137 sub reorder_members {
2138     my ( $subscriptionid, $routingid, $rank ) = @_;
2139     my $dbh = C4::Context->dbh;
2140     my $sth =
2141       $dbh->prepare(
2142 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2143       );
2144     $sth->execute($subscriptionid);
2145     my @result;
2146     while ( my $line = $sth->fetchrow_hashref ) {
2147         push( @result, $line->{'routingid'} );
2148     }
2149
2150     # To find the matching index
2151     my $i;
2152     my $key = -1;    # to allow for 0 being a valid response
2153     for ( $i = 0 ; $i < @result ; $i++ ) {
2154         if ( $routingid == $result[$i] ) {
2155             $key = $i;    # save the index
2156             last;
2157         }
2158     }
2159
2160     # if index exists in array then move it to new position
2161     if ( $key > -1 && $rank > 0 ) {
2162         my $new_rank = $rank -
2163           1;    # $new_rank is what you want the new index to be in the array
2164         my $moving_item = splice( @result, $key, 1 );
2165         splice( @result, $new_rank, 0, $moving_item );
2166     }
2167     for ( my $j = 0 ; $j < @result ; $j++ ) {
2168         my $sth =
2169           $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2170               . ( $j + 1 )
2171               . "' WHERE routingid = '"
2172               . $result[$j]
2173               . "'" );
2174         $sth->execute;
2175     }
2176 }
2177
2178 =head2 delroutingmember
2179
2180 =over 4
2181
2182 &delroutingmember($routingid,$subscriptionid)
2183
2184 this function either deletes one member from routing list if $routingid exists otherwise
2185 deletes all members from the routing list
2186
2187 =back
2188
2189 =cut
2190
2191 sub delroutingmember {
2192
2193 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2194     my ( $routingid, $subscriptionid ) = @_;
2195     my $dbh = C4::Context->dbh;
2196     if ($routingid) {
2197         my $sth =
2198           $dbh->prepare(
2199             "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2200         $sth->execute($routingid);
2201         reorder_members( $subscriptionid, $routingid );
2202     }
2203     else {
2204         my $sth =
2205           $dbh->prepare(
2206             "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2207         $sth->execute($subscriptionid);
2208     }
2209 }
2210
2211 =head2 getroutinglist
2212
2213 =over 4
2214
2215 ($count,@routinglist) = &getroutinglist($subscriptionid)
2216
2217 this gets the info from the subscriptionroutinglist for $subscriptionid
2218
2219 return :
2220 a count of the number of members on routinglist
2221 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2222 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2223
2224 =back
2225
2226 =cut
2227
2228 sub getroutinglist {
2229     my ($subscriptionid) = @_;
2230     my $dbh              = C4::Context->dbh;
2231     my $sth              = $dbh->prepare(
2232         "SELECT routingid, borrowernumber,
2233                               ranking, biblionumber
2234          FROM subscription
2235          LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2236          WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2237                               "
2238     );
2239     $sth->execute($subscriptionid);
2240     my @routinglist;
2241     my $count = 0;
2242     while ( my $line = $sth->fetchrow_hashref ) {
2243         $count++;
2244         push( @routinglist, $line );
2245     }
2246     return ( $count, @routinglist );
2247 }
2248
2249 =head2 countissuesfrom
2250
2251 =over 4
2252
2253 $result = &countissuesfrom($subscriptionid,$startdate)
2254
2255
2256 =back
2257
2258 =cut
2259
2260 sub countissuesfrom {
2261     my ($subscriptionid,$startdate) = @_;
2262     my $dbh              = C4::Context->dbh;
2263     my $query = qq|
2264             SELECT count(*)
2265             FROM   serial
2266             WHERE  subscriptionid=?
2267             AND serial.publisheddate>?
2268         |;
2269     my $sth=$dbh->prepare($query);
2270     $sth->execute($subscriptionid, $startdate);
2271     my ($countreceived)=$sth->fetchrow;
2272     return $countreceived;
2273 }
2274
2275 =head2 abouttoexpire
2276
2277 =over 4
2278
2279 $result = &abouttoexpire($subscriptionid)
2280
2281 this function alerts you to the penultimate issue for a serial subscription
2282
2283 returns 1 - if this is the penultimate issue
2284 returns 0 - if not
2285
2286 =back
2287
2288 =cut
2289
2290 sub abouttoexpire {
2291     my ($subscriptionid) = @_;
2292     my $dbh              = C4::Context->dbh;
2293     my $subscription     = GetSubscription($subscriptionid);
2294     my $per = $subscription->{'periodicity'};
2295     if ($per % 16>0){
2296       my $expirationdate   = GetExpirationDate($subscriptionid);
2297       my $sth =
2298         $dbh->prepare(
2299           "select max(planneddate) from serial where subscriptionid=?");
2300       $sth->execute($subscriptionid);
2301       my ($res) = $sth->fetchrow ;
2302 #        warn "date expiration : ".$expirationdate." date courante ".$res;
2303       my @res=split /-/,$res;
2304       @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2305       my @endofsubscriptiondate=split/-/,$expirationdate;
2306       my $x;
2307       if ( $per == 1 ) {$x=7;}
2308       if ( $per == 2 ) {$x=7; }
2309       if ( $per == 3 ) {$x=14;}
2310       if ( $per == 4 ) { $x = 21; }
2311       if ( $per == 5 ) { $x = 31; }
2312       if ( $per == 6 ) { $x = 62; }
2313       if ( $per == 7 || $per == 8 ) { $x = 93; }
2314       if ( $per == 9 )  { $x = 190; }
2315       if ( $per == 10 ) { $x = 365; }
2316       if ( $per == 11 ) { $x = 730; }
2317       my @datebeforeend=Add_Delta_Days(  $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2318                     - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2319               # warn "DATE BEFORE END: $datebeforeend";
2320       return 1 if ( @res &&
2321                     (@datebeforeend &&
2322                         Delta_Days($res[0],$res[1],$res[2],
2323                         $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2324                     (@endofsubscriptiondate &&
2325                         Delta_Days($res[0],$res[1],$res[2],
2326                         $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2327     return 0;
2328    } elsif ($subscription->{numberlength}>0) {
2329     return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2330    } else {return 0}
2331 }
2332
2333 =head2 old_newsubscription
2334
2335 =over 4
2336
2337 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2338                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2339                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2340                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2341                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2342                         $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2343
2344 this function is similar to the NewSubscription subroutine but has a few different
2345 values passed in
2346 $firstacquidate - date of first serial issue to arrive
2347 $irregularity - the issues not expected separated by a '|'
2348 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2349 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2350    subscription-add.tmpl file
2351 $callnumber - display the callnumber of the serial
2352 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2353
2354 return :
2355 the $subscriptionid number of the new subscription
2356
2357 =back
2358
2359 =cut
2360
2361 sub old_newsubscription {
2362     my (
2363         $auser,         $aqbooksellerid,  $cost,          $aqbudgetid,
2364         $biblionumber,  $startdate,       $periodicity,   $firstacquidate,
2365         $dow,           $irregularity,    $numberpattern, $numberlength,
2366         $weeklength,    $monthlength,     $add1,          $every1,
2367         $whenmorethan1, $setto1,          $lastvalue1,    $add2,
2368         $every2,        $whenmorethan2,   $setto2,        $lastvalue2,
2369         $add3,          $every3,          $whenmorethan3, $setto3,
2370         $lastvalue3,    $numberingmethod, $status,        $callnumber,
2371         $notes,         $hemisphere
2372     ) = @_;
2373     my $dbh = C4::Context->dbh;
2374
2375     #save subscription
2376     my $sth = $dbh->prepare(
2377 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2378                                                         startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2379                                                                 add1,every1,whenmorethan1,setto1,lastvalue1,
2380                                                                 add2,every2,whenmorethan2,setto2,lastvalue2,
2381                                                                 add3,every3,whenmorethan3,setto3,lastvalue3,
2382                                                                 numberingmethod, status, callnumber, notes, hemisphere) values
2383                                                           (?,?,?,?,?,?,?,?,?,?,?,
2384                                                                                            ?,?,?,?,?,?,?,?,?,?,?,
2385                                                                                            ?,?,?,?,?,?,?,?,?,?,?,?)"
2386     );
2387     $sth->execute(
2388         $auser,         $aqbooksellerid,
2389         $cost,          $aqbudgetid,
2390         $biblionumber,  format_date_in_iso($startdate),
2391         $periodicity,   format_date_in_iso($firstacquidate),
2392         $dow,           $irregularity,
2393         $numberpattern, $numberlength,
2394         $weeklength,    $monthlength,
2395         $add1,          $every1,
2396         $whenmorethan1, $setto1,
2397         $lastvalue1,    $add2,
2398         $every2,        $whenmorethan2,
2399         $setto2,        $lastvalue2,
2400         $add3,          $every3,
2401         $whenmorethan3, $setto3,
2402         $lastvalue3,    $numberingmethod,
2403         $status,        $callnumber,
2404         $notes,         $hemisphere
2405     );
2406
2407     #then create the 1st waited number
2408     my $subscriptionid = $dbh->{'mysql_insertid'};
2409     my $enddate        = GetExpirationDate($subscriptionid);
2410
2411     $sth =
2412       $dbh->prepare(
2413 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2414       );
2415     $sth->execute(
2416         $biblionumber, $subscriptionid,
2417         format_date_in_iso($startdate),
2418         format_date_in_iso($enddate),
2419         "", "", "", $notes
2420     );
2421
2422    # reread subscription to get a hash (for calculation of the 1st issue number)
2423     $sth =
2424       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2425     $sth->execute($subscriptionid);
2426     my $val = $sth->fetchrow_hashref;
2427
2428     # calculate issue number
2429     my $serialseq = GetSeq($val);
2430     $sth =
2431       $dbh->prepare(
2432 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2433       );
2434     $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2435         1, format_date_in_iso($startdate) );
2436     return $subscriptionid;
2437 }
2438
2439 =head2 old_modsubscription
2440
2441 =over 4
2442
2443 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2444                         $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2445                         $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2446                         $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2447                         $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2448                         $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2449
2450 this function is similar to the ModSubscription subroutine but has a few different
2451 values passed in
2452 $firstacquidate - date of first serial issue to arrive
2453 $irregularity - the issues not expected separated by a '|'
2454 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2455 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2456    subscription-add.tmpl file
2457 $callnumber - display the callnumber of the serial
2458 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2459
2460 =back
2461
2462 =cut
2463
2464 sub old_modsubscription {
2465     my (
2466         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2467         $startdate,    $periodicity,    $firstacquidate, $dow,
2468         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2469         $monthlength,  $add1,           $every1,         $whenmorethan1,
2470         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2471         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2472         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2473         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2474         $status,       $biblionumber,   $callnumber,     $notes,
2475         $hemisphere,   $subscriptionid
2476     ) = @_;
2477     my $dbh = C4::Context->dbh;
2478     my $sth = $dbh->prepare(
2479 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2480                                                    periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2481                                                   add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2482                                                   add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2483                                                   add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2484                                                   numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2485     );
2486     $sth->execute(
2487         $auser,        $aqbooksellerid, $cost,           $aqbudgetid,
2488         $startdate,    $periodicity,    $firstacquidate, $dow,
2489         $irregularity, $numberpattern,  $numberlength,   $weeklength,
2490         $monthlength,  $add1,           $every1,         $whenmorethan1,
2491         $setto1,       $lastvalue1,     $innerloop1,     $add2,
2492         $every2,       $whenmorethan2,  $setto2,         $lastvalue2,
2493         $innerloop2,   $add3,           $every3,         $whenmorethan3,
2494         $setto3,       $lastvalue3,     $innerloop3,     $numberingmethod,
2495         $status,       $biblionumber,   $callnumber,     $notes,
2496         $hemisphere,   $subscriptionid
2497     );
2498     $sth->finish;
2499
2500     $sth =
2501       $dbh->prepare("select * from subscription where subscriptionid = ? ");
2502     $sth->execute($subscriptionid);
2503     my $val = $sth->fetchrow_hashref;
2504
2505     # calculate issue number
2506     my $serialseq = Get_Seq($val);
2507     $sth =
2508       $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2509     $sth->execute( $serialseq, $subscriptionid );
2510
2511     my $enddate = subscriptionexpirationdate($subscriptionid);
2512     $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2513     $sth->execute( format_date_in_iso($enddate) );
2514 }
2515
2516 =head2 old_getserials
2517
2518 =over 4
2519
2520 ($totalissues,@serials) = &old_getserials($subscriptionid)
2521
2522 this function get a hashref of serials and the total count of them
2523
2524 return :
2525 $totalissues - number of serial lines
2526 the serials into a table. Each line of this table containts a ref to a hash which it containts
2527 serialid, serialseq, status,planneddate,notes,routingnotes  from tables : serial where status is not 2, 4, or 5
2528
2529 =back
2530
2531 =cut
2532
2533 sub old_getserials {
2534     my ($subscriptionid) = @_;
2535     my $dbh = C4::Context->dbh;
2536
2537     # status = 2 is "arrived"
2538     my $sth =
2539       $dbh->prepare(
2540 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2541       );
2542     $sth->execute($subscriptionid);
2543     my @serials;
2544     my $num = 1;
2545     while ( my $line = $sth->fetchrow_hashref ) {
2546         $line->{ "status" . $line->{status} } =
2547           1;    # fills a "statusX" value, used for template status select list
2548         $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2549         $line->{"num"}         = $num;
2550         $num++;
2551         push @serials, $line;
2552     }
2553     $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2554     $sth->execute($subscriptionid);
2555     my ($totalissues) = $sth->fetchrow;
2556     return ( $totalissues, @serials );
2557 }
2558
2559 =head2 GetNextDate
2560
2561 ($resultdate) = &GetNextDate($planneddate,$subscription)
2562
2563 this function is an extension of GetNextDate which allows for checking for irregularity
2564
2565 it takes the planneddate and will return the next issue's date and will skip dates if there
2566 exists an irregularity
2567 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2568 skipped then the returned date will be 2007-05-10
2569
2570 return :
2571 $resultdate - then next date in the sequence
2572
2573 Return 0 if periodicity==0
2574
2575 =cut
2576 sub in_array { # used in next sub down
2577   my ($val,@elements) = @_;
2578   foreach my $elem(@elements) {
2579     if($val == $elem) {
2580             return 1;
2581     }
2582   }
2583   return 0;
2584 }
2585
2586 sub GetNextDate(@) {
2587     my ( $planneddate, $subscription ) = @_;
2588     my @irreg = split( /\,/, $subscription->{irregularity} );
2589
2590     #date supposed to be in ISO.
2591
2592     my ( $year, $month, $day ) = split(/-/, $planneddate);
2593     $month=1 unless ($month);
2594     $day=1 unless ($day);
2595     my @resultdate;
2596
2597     #       warn "DOW $dayofweek";
2598     if ( $subscription->{periodicity} % 16 == 0 ) {
2599       return 0;
2600     }
2601     if ( $subscription->{periodicity} == 1 ) {
2602         my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2603         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2604         else {
2605           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2606               $dayofweek = 0 if ( $dayofweek == 7 );
2607               if ( in_array( ($dayofweek + 1), @irreg ) ) {
2608                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2609                   $dayofweek++;
2610               }
2611           }
2612           @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2613         }
2614     }
2615     if ( $subscription->{periodicity} == 2 ) {
2616         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2617         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2618         else {
2619           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2620               if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2621                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2622                   $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2623               }
2624           }
2625           @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2626         }
2627     }
2628     if ( $subscription->{periodicity} == 3 ) {
2629         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2630         if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2631         else {
2632           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2633               if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2634               ### BUGFIX was previously +1 ^
2635                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2636                   $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2637               }
2638           }
2639           @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2640         }
2641     }
2642     if ( $subscription->{periodicity} == 4 ) {
2643         my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2644         if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2645         else {
2646           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2647               if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2648                   ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2649                   $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2650               }
2651           }
2652           @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2653         }
2654     }
2655     my $tmpmonth=$month;
2656     if ($year && $month && $day){
2657     if ( $subscription->{periodicity} == 5 ) {
2658           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2659               if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2660                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2661                   $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2662               }
2663           }
2664           @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2665     }
2666     if ( $subscription->{periodicity} == 6 ) {
2667           for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2668               if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2669                   ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2670                   $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2671               }
2672           }
2673           @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2674     }
2675     if ( $subscription->{periodicity} == 7 ) {
2676         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2677             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2678                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2679                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2680             }
2681         }
2682         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2683     }
2684     if ( $subscription->{periodicity} == 8 ) {
2685         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2686             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2687                 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2688                 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2689             }
2690         }
2691         @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2692     }
2693     if ( $subscription->{periodicity} == 9 ) {
2694         for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2695             if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2696             ### BUFIX Seems to need more Than One ?
2697                 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2698                 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2699             }
2700         }
2701         @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2702     }
2703     if ( $subscription->{periodicity} == 10 ) {
2704         @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2705     }
2706     if ( $subscription->{periodicity} == 11 ) {
2707         @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2708     }
2709     }
2710     my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2711
2712 #     warn "dateNEXTSEQ : ".$resultdate;
2713     return "$resultdate";
2714 }
2715
2716 =head2 itemdata
2717
2718   $item = &itemdata($barcode);
2719
2720 Looks up the item with the given barcode, and returns a
2721 reference-to-hash containing information about that item. The keys of
2722 the hash are the fields from the C<items> and C<biblioitems> tables in
2723 the Koha database.
2724
2725 =cut
2726
2727 #'
2728 sub itemdata {
2729     my ($barcode) = @_;
2730     my $dbh       = C4::Context->dbh;
2731     my $sth       = $dbh->prepare(
2732         "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2733         WHERE barcode=?"
2734     );
2735     $sth->execute($barcode);
2736     my $data = $sth->fetchrow_hashref;
2737     $sth->finish;
2738     return ($data);
2739 }
2740
2741 1;
2742 __END__
2743
2744 =back
2745
2746 =head1 AUTHOR
2747
2748 Koha Developement team <info@koha.org>
2749
2750 =cut