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