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