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