C4/Serials.pm

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