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