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