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