C4/Serials.pm

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