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