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