3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
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.
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.
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>.
23 use C4
::Auth
qw(haspermission);
26 use Date
::Calc
qw(:all);
27 use POSIX
qw(strftime);
29 use C4
::Log
; # logaction
31 use C4
::Serials
::Frequency
;
32 use C4
::Serials
::Numberpattern
;
33 use Koha
::AdditionalFieldValues
;
36 use Koha
::Subscriptions
;
37 use Koha
::Subscription
::Histories
;
38 use Koha
::SharedContent
;
40 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 MISSING_NEVER_RECIEVED => 41,
49 MISSING_SOLD_OUT => 42,
50 MISSING_DAMAGED => 43,
58 use constant MISSING_STATUSES => (
59 MISSING, MISSING_NEVER_RECIEVED,
60 MISSING_SOLD_OUT, MISSING_DAMAGED,
68 &NewSubscription &ModSubscription &DelSubscription
69 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
71 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
72 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
73 &GetSubscriptionHistoryFromSubscriptionId
75 &GetNextSeq &GetSeq &NewIssue &GetSerials
76 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
77 &ReNewSubscription &GetLateOrMissingIssues
78 &GetSerialInformation &AddItem2Serial
79 &PrepareSerialsData &GetNextExpected &ModNextExpected
82 &GetSuppliersWithLateIssues
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &subscriptionCurrentlyOnOrder
95 C4::Serials - Serials Module Functions
103 Functions for handling subscriptions, claims routing etc.
108 =head2 GetSuppliersWithLateIssues
110 $supplierlist = GetSuppliersWithLateIssues()
112 this function get all suppliers with late issues.
115 an array_ref of suppliers each entry is a hash_ref containing id and name
116 the array is in name order
120 sub GetSuppliersWithLateIssues
{
121 my $dbh = C4
::Context
->dbh;
122 my $statuses = join(',', ( LATE
, MISSING_STATUSES
, CLAIMED
) );
124 SELECT DISTINCT id
, name
126 LEFT JOIN serial ON serial
.subscriptionid
=subscription
.subscriptionid
127 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
130 (planneddate
< now
() AND serial
.status
=1)
131 OR serial
.STATUS IN
( $statuses )
133 AND subscription
.closed
= 0
135 return $dbh->selectall_arrayref($query, { Slice
=> {} });
138 =head2 GetSubscriptionHistoryFromSubscriptionId
140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
142 This function returns the subscription history as a hashref
146 sub GetSubscriptionHistoryFromSubscriptionId
{
147 my ($subscriptionid) = @_;
149 return unless $subscriptionid;
151 my $dbh = C4
::Context
->dbh;
154 FROM subscriptionhistory
155 WHERE subscriptionid
= ?
157 my $sth = $dbh->prepare($query);
158 $sth->execute($subscriptionid);
159 my $results = $sth->fetchrow_hashref;
165 =head2 GetSerialInformation
167 $data = GetSerialInformation($serialid);
168 returns a hash_ref containing :
169 items : items marcrecord (can be an array)
171 subscription table field
172 + information about subscription expiration
176 sub GetSerialInformation
{
178 my $dbh = C4
::Context
->dbh;
180 SELECT serial
.*, serial
.notes as sernotes
, serial
.status as serstatus
,subscription
.*,subscription
.subscriptionid as subsid
181 FROM serial LEFT JOIN subscription ON subscription
.subscriptionid
=serial
.subscriptionid
184 my $rq = $dbh->prepare($query);
185 $rq->execute($serialid);
186 my $data = $rq->fetchrow_hashref;
188 # create item information if we have serialsadditems for this subscription
189 if ( $data->{'serialsadditems'} ) {
190 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
191 $queryitem->execute($serialid);
192 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
194 if ( scalar(@
$itemnumbers) > 0 ) {
195 foreach my $itemnum (@
$itemnumbers) {
197 #It is ASSUMED that GetMarcItem ALWAYS WORK...
198 #Maybe GetMarcItem should return values on failure
199 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
200 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, $itemnum->[0], $data );
201 $itemprocessed->{'itemnumber'} = $itemnum->[0];
202 $itemprocessed->{'itemid'} = $itemnum->[0];
203 $itemprocessed->{'serialid'} = $serialid;
204 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
205 push @
{ $data->{'items'} }, $itemprocessed;
208 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, '', $data );
209 $itemprocessed->{'itemid'} = "N$serialid";
210 $itemprocessed->{'serialid'} = $serialid;
211 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
212 $itemprocessed->{'countitems'} = 0;
213 push @
{ $data->{'items'} }, $itemprocessed;
216 $data->{ "status" . $data->{'serstatus'} } = 1;
217 $data->{'subscriptionexpired'} = HasSubscriptionExpired
( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
218 $data->{'abouttoexpire'} = abouttoexpire
( $data->{'subscriptionid'} );
219 $data->{cannotedit
} = not can_edit_subscription
( $data );
223 =head2 AddItem2Serial
225 $rows = AddItem2Serial($serialid,$itemnumber);
226 Adds an itemnumber to Serial record
227 returns the number of rows affected
232 my ( $serialid, $itemnumber ) = @_;
234 return unless ($serialid and $itemnumber);
236 my $dbh = C4
::Context
->dbh;
237 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
238 $rq->execute( $serialid, $itemnumber );
242 =head2 GetSubscription
244 $subs = GetSubscription($subscriptionid)
245 this function returns the subscription which has $subscriptionid as id.
247 a hashref. This hash contains
248 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
252 sub GetSubscription
{
253 my ($subscriptionid) = @_;
254 my $dbh = C4
::Context
->dbh;
256 SELECT subscription
.*,
257 subscriptionhistory
.*,
258 aqbooksellers
.name AS aqbooksellername
,
259 biblio
.title AS bibliotitle
,
260 subscription
.biblionumber as bibnum
262 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
263 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
264 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
265 WHERE subscription
.subscriptionid
= ?
268 $debug and warn "query : $query\nsubsid :$subscriptionid";
269 my $sth = $dbh->prepare($query);
270 $sth->execute($subscriptionid);
271 my $subscription = $sth->fetchrow_hashref;
273 return unless $subscription;
275 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
277 if ( my $mana_id = $subscription->{mana_id
} ) {
278 my $mana_subscription = Koha
::SharedContent
::get_entity_by_id
(
279 'subscription', $mana_id, {usecomments
=> 1});
280 $subscription->{comments
} = $mana_subscription->{data
}->{comments
};
283 return $subscription;
286 =head2 GetFullSubscription
288 $array_ref = GetFullSubscription($subscriptionid)
289 this function reads the serial table.
293 sub GetFullSubscription
{
294 my ($subscriptionid) = @_;
296 return unless ($subscriptionid);
298 my $dbh = C4
::Context
->dbh;
300 SELECT serial
.serialid
,
303 serial
.publisheddate
,
304 serial
.publisheddatetext
,
306 serial
.notes as notes
,
307 year
(IF
(serial
.publisheddate IS NULL
,serial
.publisheddate
,serial
.planneddate
)) as year
,
308 aqbooksellers
.name as aqbooksellername
,
309 biblio
.title as bibliotitle
,
310 subscription
.branchcode AS branchcode
,
311 subscription
.subscriptionid AS subscriptionid
313 LEFT JOIN subscription ON
314 (serial
.subscriptionid
=subscription
.subscriptionid
)
315 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
316 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
317 WHERE serial
.subscriptionid
= ?
319 IF
(serial
.publisheddate IS NULL
,serial
.publisheddate
,serial
.planneddate
) DESC
,
320 serial
.subscriptionid
322 $debug and warn "GetFullSubscription query: $query";
323 my $sth = $dbh->prepare($query);
324 $sth->execute($subscriptionid);
325 my $subscriptions = $sth->fetchall_arrayref( {} );
326 my $cannotedit = not can_edit_subscription
( $subscriptions->[0] ) if scalar @
$subscriptions;
327 for my $subscription ( @
$subscriptions ) {
328 $subscription->{cannotedit
} = $cannotedit;
330 return $subscriptions;
333 =head2 PrepareSerialsData
335 $array_ref = PrepareSerialsData($serialinfomation)
336 where serialinformation is a hashref array
340 sub PrepareSerialsData
{
343 return unless ($lines);
349 my $aqbooksellername;
353 my $previousnote = "";
355 foreach my $subs (@
{$lines}) {
356 for my $datefield ( qw(publisheddate planneddate) ) {
357 # handle 0000-00-00 dates
358 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
359 $subs->{$datefield} = undef;
362 $subs->{ "status" . $subs->{'status'} } = 1;
363 if ( grep { $_ == $subs->{status
} } ( EXPECTED
, LATE
, MISSING_STATUSES
, CLAIMED
) ) {
364 $subs->{"checked"} = 1;
367 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
368 $year = $subs->{'year'};
372 if ( $tmpresults{$year} ) {
373 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
375 $tmpresults{$year} = {
377 'aqbooksellername' => $subs->{'aqbooksellername'},
378 'bibliotitle' => $subs->{'bibliotitle'},
379 'serials' => [$subs],
384 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
385 push @res, $tmpresults{$key};
390 =head2 GetSubscriptionsFromBiblionumber
392 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
393 this function get the subscription list. it reads the subscription table.
395 reference to an array of subscriptions which have the biblionumber given on input arg.
396 each element of this array is a hashref containing
397 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
401 sub GetSubscriptionsFromBiblionumber
{
402 my ($biblionumber) = @_;
404 return unless ($biblionumber);
406 my $dbh = C4
::Context
->dbh;
408 SELECT subscription
.*,
410 subscriptionhistory
.*,
411 aqbooksellers
.name AS aqbooksellername
,
412 biblio
.title AS bibliotitle
414 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
415 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
416 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
417 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
418 WHERE subscription
.biblionumber
= ?
420 my $sth = $dbh->prepare($query);
421 $sth->execute($biblionumber);
423 while ( my $subs = $sth->fetchrow_hashref ) {
424 $subs->{startdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{startdate
} ), dateonly
=> 1 } );
425 $subs->{histstartdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histstartdate
} ), dateonly
=> 1 } );
426 if ( defined $subs->{histenddate
} ) {
427 $subs->{histenddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histenddate
} ), dateonly
=> 1 } );
429 $subs->{histenddate
} = "";
431 $subs->{opacnote
} //= "";
432 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
433 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
434 $subs->{ "status" . $subs->{'status'} } = 1;
436 if (not defined $subs->{enddate
} ) {
437 $subs->{enddate
} = '';
439 $subs->{enddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{enddate
}), dateonly
=> 1 } );
441 $subs->{'abouttoexpire'} = abouttoexpire
( $subs->{'subscriptionid'} );
442 $subs->{'subscriptionexpired'} = HasSubscriptionExpired
( $subs->{'subscriptionid'} );
443 $subs->{cannotedit
} = not can_edit_subscription
( $subs );
449 =head2 GetFullSubscriptionsFromBiblionumber
451 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
452 this function reads the serial table.
456 sub GetFullSubscriptionsFromBiblionumber
{
457 my ($biblionumber) = @_;
458 my $dbh = C4
::Context
->dbh;
460 SELECT serial
.serialid
,
463 serial
.publisheddate
,
464 serial
.publisheddatetext
,
466 serial
.notes as notes
,
467 year
(IF
(serial
.publisheddate IS NULL
,serial
.publisheddate
,serial
.planneddate
)) as year
,
468 biblio
.title as bibliotitle
,
469 subscription
.branchcode AS branchcode
,
470 subscription
.subscriptionid AS subscriptionid
472 LEFT JOIN subscription ON
473 (serial
.subscriptionid
=subscription
.subscriptionid
)
474 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
475 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
476 WHERE subscription
.biblionumber
= ?
478 IF
(serial
.publisheddate IS NULL
,serial
.publisheddate
,serial
.planneddate
) DESC
,
479 serial
.subscriptionid
481 my $sth = $dbh->prepare($query);
482 $sth->execute($biblionumber);
483 my $subscriptions = $sth->fetchall_arrayref( {} );
484 my $cannotedit = not can_edit_subscription
( $subscriptions->[0] ) if scalar @
$subscriptions;
485 for my $subscription ( @
$subscriptions ) {
486 $subscription->{cannotedit
} = $cannotedit;
488 return $subscriptions;
491 =head2 SearchSubscriptions
493 @results = SearchSubscriptions($args);
495 This function returns a list of hashrefs, one for each subscription
496 that meets the conditions specified by the $args hashref.
498 The valid search fields are:
512 The expiration_date search field is special; it specifies the maximum
513 subscription expiration date.
517 sub SearchSubscriptions
{
520 my $additional_fields = $args->{additional_fields
} // [];
521 my $matching_record_ids_for_additional_fields = [];
522 if ( @
$additional_fields ) {
523 my @subscriptions = Koha
::Subscriptions
->filter_by_additional_fields($additional_fields);
525 return () unless @subscriptions;
527 $matching_record_ids_for_additional_fields = [ map {
534 subscription
.notes AS publicnotes
,
535 subscriptionhistory
.*,
537 biblio
.notes AS biblionotes
,
541 aqbooksellers
.name AS vendorname
,
544 LEFT JOIN subscriptionhistory USING
(subscriptionid
)
545 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
546 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= subscription
.biblionumber
547 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
549 $query .= q
| WHERE
1|;
552 if( $args->{biblionumber
} ) {
553 push @where_strs, "biblio.biblionumber = ?";
554 push @where_args, $args->{biblionumber
};
557 if( $args->{title
} ){
558 my @words = split / /, $args->{title
};
560 foreach my $word (@words) {
561 push @strs, "biblio.title LIKE ?";
562 push @args, "%$word%";
565 push @where_strs, '(' . join (' AND ', @strs) . ')';
566 push @where_args, @args;
570 push @where_strs, "biblioitems.issn LIKE ?";
571 push @where_args, "%$args->{issn}%";
574 push @where_strs, "biblioitems.ean LIKE ?";
575 push @where_args, "%$args->{ean}%";
577 if ( $args->{callnumber
} ) {
578 push @where_strs, "subscription.callnumber LIKE ?";
579 push @where_args, "%$args->{callnumber}%";
581 if( $args->{publisher
} ){
582 push @where_strs, "biblioitems.publishercode LIKE ?";
583 push @where_args, "%$args->{publisher}%";
585 if( $args->{bookseller
} ){
586 push @where_strs, "aqbooksellers.name LIKE ?";
587 push @where_args, "%$args->{bookseller}%";
589 if( $args->{branch
} ){
590 push @where_strs, "subscription.branchcode = ?";
591 push @where_args, "$args->{branch}";
593 if ( $args->{location
} ) {
594 push @where_strs, "subscription.location = ?";
595 push @where_args, "$args->{location}";
597 if ( $args->{expiration_date
} ) {
598 push @where_strs, "subscription.enddate <= ?";
599 push @where_args, "$args->{expiration_date}";
601 if( defined $args->{closed
} ){
602 push @where_strs, "subscription.closed = ?";
603 push @where_args, "$args->{closed}";
607 $query .= ' AND ' . join(' AND ', @where_strs);
609 if ( @
$additional_fields ) {
610 $query .= ' AND subscriptionid IN ('
611 . join( ', ', @
$matching_record_ids_for_additional_fields )
615 $query .= " ORDER BY " . $args->{orderby
} if $args->{orderby
};
617 my $dbh = C4
::Context
->dbh;
618 my $sth = $dbh->prepare($query);
619 $sth->execute(@where_args);
620 my $results = $sth->fetchall_arrayref( {} );
622 for my $subscription ( @
$results ) {
623 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
624 $subscription->{cannotdisplay
} = not can_show_subscription
( $subscription );
626 my $subscription_object = Koha
::Subscriptions
->find($subscription->{subscriptionid
});
627 $subscription->{additional_fields
} = { map { $_->field->name => $_->value }
628 $subscription_object->additional_field_values->as_list };
638 ($totalissues,@serials) = GetSerials($subscriptionid);
639 this function gets every serial not arrived for a given subscription
640 as well as the number of issues registered in the database (all types)
641 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
643 FIXME: We should return \@serials.
648 my ( $subscriptionid, $count ) = @_;
650 return unless $subscriptionid;
652 my $dbh = C4
::Context
->dbh;
654 # status = 2 is "arrived"
656 $count = 5 unless ($count);
658 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
, NOT_ISSUED
) );
659 my $query = "SELECT serialid,serialseq, status, publisheddate,
660 publisheddatetext, planneddate,notes, routingnotes
662 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
663 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
664 my $sth = $dbh->prepare($query);
665 $sth->execute($subscriptionid);
667 while ( my $line = $sth->fetchrow_hashref ) {
668 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
669 for my $datefield ( qw( planneddate publisheddate) ) {
670 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
671 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
673 $line->{$datefield} = q{};
676 push @serials, $line;
679 # OK, now add the last 5 issues arrives/missing
680 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
681 publisheddatetext, notes, routingnotes
683 WHERE subscriptionid = ?
684 AND status IN ( $statuses )
685 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
687 $sth = $dbh->prepare($query);
688 $sth->execute($subscriptionid);
689 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
691 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
692 for my $datefield ( qw( planneddate publisheddate) ) {
693 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
694 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
696 $line->{$datefield} = q{};
700 push @serials, $line;
703 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
704 $sth = $dbh->prepare($query);
705 $sth->execute($subscriptionid);
706 my ($totalissues) = $sth->fetchrow;
707 return ( $totalissues, @serials );
712 @serials = GetSerials2($subscriptionid,$statuses);
713 this function returns every serial waited for a given subscription
714 as well as the number of issues registered in the database (all types)
715 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
717 $statuses is an arrayref of statuses and is mandatory.
722 my ( $subscription, $statuses ) = @_;
724 return unless ($subscription and @
$statuses);
726 my $dbh = C4
::Context
->dbh;
728 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,
729 publisheddatetext
, notes
, routingnotes
731 WHERE subscriptionid
=?
733 . q
| AND status IN
(| . join( ",", ('?') x @
$statuses ) . q
|)|
735 ORDER BY publisheddate
,serialid DESC
737 $debug and warn "GetSerials2 query: $query";
738 my $sth = $dbh->prepare($query);
739 $sth->execute( $subscription, @
$statuses );
742 while ( my $line = $sth->fetchrow_hashref ) {
743 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
744 # Format dates for display
745 for my $datefield ( qw( planneddate publisheddate ) ) {
746 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
747 $line->{$datefield} = q{};
750 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
753 push @serials, $line;
758 =head2 GetLatestSerials
760 \@serials = GetLatestSerials($subscriptionid,$limit)
761 get the $limit's latest serials arrived or missing for a given subscription
763 a ref to an array which contains all of the latest serials stored into a hash.
767 sub GetLatestSerials
{
768 my ( $subscriptionid, $limit ) = @_;
770 return unless ($subscriptionid and $limit);
772 my $dbh = C4
::Context
->dbh;
774 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
) );
775 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
777 WHERE subscriptionid = ?
778 AND status IN ($statuses)
779 ORDER BY publisheddate DESC LIMIT 0,$limit
781 my $sth = $dbh->prepare($strsth);
782 $sth->execute($subscriptionid);
784 while ( my $line = $sth->fetchrow_hashref ) {
785 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
786 push @serials, $line;
792 =head2 GetPreviousSerialid
794 $serialid = GetPreviousSerialid($subscriptionid, $nth)
795 get the $nth's previous serial for the given subscriptionid
801 sub GetPreviousSerialid
{
802 my ( $subscriptionid, $nth ) = @_;
804 my $dbh = C4
::Context
->dbh;
808 my $strsth = "SELECT serialid
810 WHERE subscriptionid = ?
812 ORDER BY serialid DESC LIMIT $nth,1
814 my $sth = $dbh->prepare($strsth);
815 $sth->execute($subscriptionid);
817 my $line = $sth->fetchrow_hashref;
818 $return = $line->{'serialid'} if ($line);
826 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
827 $newinnerloop1, $newinnerloop2, $newinnerloop3
828 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
830 $subscription is a hashref containing all the attributes of the table
832 $pattern is a hashref containing all the attributes of the table
833 'subscription_numberpatterns'.
834 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
835 $planneddate is a date string in iso format.
836 This function get the next issue for the subscription given on input arg
841 my ($subscription, $pattern, $frequency, $planneddate) = @_;
843 return unless ($subscription and $pattern);
845 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
846 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
849 if ($subscription->{'skip_serialseq'}) {
850 my @irreg = split /;/, $subscription->{'irregularity'};
852 my $irregularities = {};
853 $irregularities->{$_} = 1 foreach(@irreg);
854 my $issueno = GetFictiveIssueNumber
($subscription, $planneddate, $frequency) + 1;
855 while($irregularities->{$issueno}) {
862 my $numberingmethod = $pattern->{numberingmethod
};
864 if ($numberingmethod) {
865 $calculated = $numberingmethod;
866 my $locale = $subscription->{locale
};
867 $newlastvalue1 = $subscription->{lastvalue1
} || 0;
868 $newlastvalue2 = $subscription->{lastvalue2
} || 0;
869 $newlastvalue3 = $subscription->{lastvalue3
} || 0;
870 $newinnerloop1 = $subscription->{innerloop1
} || 0;
871 $newinnerloop2 = $subscription->{innerloop2
} || 0;
872 $newinnerloop3 = $subscription->{innerloop3
} || 0;
875 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
878 for(my $i = 0; $i < $count; $i++) {
880 # check if we have to increase the new value.
882 if ($newinnerloop1 >= $pattern->{every1
}) {
884 $newlastvalue1 += $pattern->{add1
};
886 # reset counter if needed.
887 $newlastvalue1 = $pattern->{setto1
} if ($newlastvalue1 > $pattern->{whenmorethan1
});
890 # check if we have to increase the new value.
892 if ($newinnerloop2 >= $pattern->{every2
}) {
894 $newlastvalue2 += $pattern->{add2
};
896 # reset counter if needed.
897 $newlastvalue2 = $pattern->{setto2
} if ($newlastvalue2 > $pattern->{whenmorethan2
});
900 # check if we have to increase the new value.
902 if ($newinnerloop3 >= $pattern->{every3
}) {
904 $newlastvalue3 += $pattern->{add3
};
906 # reset counter if needed.
907 $newlastvalue3 = $pattern->{setto3
} if ($newlastvalue3 > $pattern->{whenmorethan3
});
911 my $newlastvalue1string = _numeration
( $newlastvalue1, $pattern->{numbering1
}, $locale );
912 $calculated =~ s/\{X\}/$newlastvalue1string/g;
915 my $newlastvalue2string = _numeration
( $newlastvalue2, $pattern->{numbering2
}, $locale );
916 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
919 my $newlastvalue3string = _numeration
( $newlastvalue3, $pattern->{numbering3
}, $locale );
920 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
925 $newlastvalue1, $newlastvalue2, $newlastvalue3,
926 $newinnerloop1, $newinnerloop2, $newinnerloop3);
931 $calculated = GetSeq($subscription, $pattern)
932 $subscription is a hashref containing all the attributes of the table 'subscription'
933 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
934 this function transforms {X},{Y},{Z} to 150,0,0 for example.
936 the sequence in string format
941 my ($subscription, $pattern) = @_;
943 return unless ($subscription and $pattern);
945 my $locale = $subscription->{locale
};
947 my $calculated = $pattern->{numberingmethod
};
949 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
950 $newlastvalue1 = _numeration
($newlastvalue1, $pattern->{numbering1
}, $locale) if ($pattern->{numbering1
}); # reset counter if needed.
951 $calculated =~ s/\{X\}/$newlastvalue1/g;
953 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
954 $newlastvalue2 = _numeration
($newlastvalue2, $pattern->{numbering2
}, $locale) if ($pattern->{numbering2
}); # reset counter if needed.
955 $calculated =~ s/\{Y\}/$newlastvalue2/g;
957 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
958 $newlastvalue3 = _numeration
($newlastvalue3, $pattern->{numbering3
}, $locale) if ($pattern->{numbering3
}); # reset counter if needed.
959 $calculated =~ s/\{Z\}/$newlastvalue3/g;
963 =head2 GetExpirationDate
965 $enddate = GetExpirationDate($subscriptionid, [$startdate])
967 this function return the next expiration date for a subscription given on input args.
974 sub GetExpirationDate
{
975 my ( $subscriptionid, $startdate ) = @_;
977 return unless ($subscriptionid);
979 my $dbh = C4
::Context
->dbh;
980 my $subscription = GetSubscription
($subscriptionid);
983 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
984 $enddate = $startdate || $subscription->{startdate
};
985 my @date = split( /-/, $enddate );
987 return if ( scalar(@date) != 3 || not check_date
(@date) );
989 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
990 if ( $frequency and $frequency->{unit
} ) {
993 if ( my $length = $subscription->{numberlength
} ) {
995 #calculate the date of the last issue.
996 for ( my $i = 1 ; $i <= $length ; $i++ ) {
997 $enddate = GetNextDate
( $subscription, $enddate, $frequency );
999 } elsif ( $subscription->{monthlength
} ) {
1000 if ( $$subscription{startdate
} ) {
1001 my @enddate = Add_Delta_YM
( $date[0], $date[1], $date[2], 0, $subscription->{monthlength
} );
1002 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1004 } elsif ( $subscription->{weeklength
} ) {
1005 if ( $$subscription{startdate
} ) {
1006 my @date = split( /-/, $subscription->{startdate
} );
1007 my @enddate = Add_Delta_Days
( $date[0], $date[1], $date[2], $subscription->{weeklength
} * 7 );
1008 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1011 $enddate = $subscription->{enddate
};
1015 return $subscription->{enddate
};
1019 =head2 CountSubscriptionFromBiblionumber
1021 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1022 this returns a count of the subscriptions for a given biblionumber
1024 the number of subscriptions
1028 sub CountSubscriptionFromBiblionumber
{
1029 my ($biblionumber) = @_;
1031 return unless ($biblionumber);
1033 my $dbh = C4
::Context
->dbh;
1034 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1035 my $sth = $dbh->prepare($query);
1036 $sth->execute($biblionumber);
1037 my $subscriptionsnumber = $sth->fetchrow;
1038 return $subscriptionsnumber;
1041 =head2 ModSubscriptionHistory
1043 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1045 this function modifies the history of a subscription. Put your new values on input arg.
1046 returns the number of rows affected
1050 sub ModSubscriptionHistory
{
1051 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1053 return unless ($subscriptionid);
1055 my $dbh = C4
::Context
->dbh;
1056 my $query = "UPDATE subscriptionhistory
1057 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1058 WHERE subscriptionid=?
1060 my $sth = $dbh->prepare($query);
1061 $receivedlist =~ s/^; // if $receivedlist;
1062 $missinglist =~ s/^; // if $missinglist;
1063 $opacnote =~ s/^; // if $opacnote;
1064 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1068 =head2 ModSerialStatus
1070 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1071 $publisheddatetext, $status, $notes);
1073 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1074 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1078 sub ModSerialStatus
{
1079 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1080 $status, $notes) = @_;
1082 return unless ($serialid);
1084 #It is a usual serial
1085 # 1st, get previous status :
1086 my $dbh = C4
::Context
->dbh;
1087 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1088 FROM serial, subscription
1089 WHERE serial.subscriptionid=subscription.subscriptionid
1091 my $sth = $dbh->prepare($query);
1092 $sth->execute($serialid);
1093 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1094 my $frequency = GetSubscriptionFrequency
($periodicity);
1096 # change status & update subscriptionhistory
1098 if ( $status == DELETED
) {
1099 DelIssue
( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1103 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1104 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1107 $sth = $dbh->prepare($query);
1108 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1109 $planneddate, $status, $notes, $routingnotes, $serialid );
1110 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1111 $sth = $dbh->prepare($query);
1112 $sth->execute($subscriptionid);
1113 my $val = $sth->fetchrow_hashref;
1114 unless ( $val->{manualhistory
} ) {
1115 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1116 $sth = $dbh->prepare($query);
1117 $sth->execute($subscriptionid);
1118 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1120 if ( $status == ARRIVED
|| ($oldstatus == ARRIVED
&& $status != ARRIVED
) ) {
1121 $recievedlist .= "; $serialseq"
1122 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1125 # in case serial has been previously marked as missing
1126 if (grep /$status/, (EXPECTED
, ARRIVED
, LATE
, CLAIMED
)) {
1127 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1130 $missinglist .= "; $serialseq"
1131 if ( ( grep { $_ == $status } ( MISSING_STATUSES
) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1132 $missinglist .= "; not issued $serialseq"
1133 if ( $status == NOT_ISSUED
&& $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1135 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1136 $sth = $dbh->prepare($query);
1137 $recievedlist =~ s/^; //;
1138 $missinglist =~ s/^; //;
1139 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1143 # create new expected entry if needed (ie : was "expected" and has changed)
1144 my $otherIssueExpected = scalar findSerialsByStatus
(EXPECTED
, $subscriptionid);
1145 if ( !$otherIssueExpected && $oldstatus == EXPECTED
&& $status != EXPECTED
) {
1146 my $subscription = GetSubscription
($subscriptionid);
1147 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1148 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1152 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1153 $newinnerloop1, $newinnerloop2, $newinnerloop3
1155 = GetNextSeq
( $subscription, $pattern, $frequency, $publisheddate );
1157 # next date (calculated from actual date & frequency parameters)
1158 my $nextpublisheddate = GetNextDate
($subscription, $publisheddate, $frequency, 1);
1159 my $nextpubdate = $nextpublisheddate;
1160 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1161 WHERE subscriptionid = ?";
1162 $sth = $dbh->prepare($query);
1163 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1164 my $newnote = C4
::Context
->preference('PreserveSerialNotes') ?
$notes : "";
1165 NewIssue
( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1166 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1167 if ( $subscription->{letter
} && $status == ARRIVED
&& $oldstatus != ARRIVED
) {
1168 require C4
::Letters
;
1169 C4
::Letters
::SendAlerts
( 'issue', $serialid, $subscription->{letter
} );
1176 =head2 GetNextExpected
1178 $nextexpected = GetNextExpected($subscriptionid)
1180 Get the planneddate for the current expected issue of the subscription.
1186 planneddate => ISO date
1191 sub GetNextExpected
{
1192 my ($subscriptionid) = @_;
1194 my $dbh = C4
::Context
->dbh;
1198 WHERE subscriptionid
= ?
1202 my $sth = $dbh->prepare($query);
1204 # Each subscription has only one 'expected' issue.
1205 $sth->execute( $subscriptionid, EXPECTED
);
1206 my $nextissue = $sth->fetchrow_hashref;
1207 if ( !$nextissue ) {
1211 WHERE subscriptionid
= ?
1212 ORDER BY publisheddate DESC
1215 $sth = $dbh->prepare($query);
1216 $sth->execute($subscriptionid);
1217 $nextissue = $sth->fetchrow_hashref;
1219 foreach(qw
/planneddate publisheddate/) {
1220 if ( !defined $nextissue->{$_} ) {
1221 # or should this default to 1st Jan ???
1222 $nextissue->{$_} = strftime
( '%Y-%m-%d', localtime );
1224 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1232 =head2 ModNextExpected
1234 ModNextExpected($subscriptionid,$date)
1236 Update the planneddate for the current expected issue of the subscription.
1237 This will modify all future prediction results.
1239 C<$date> is an ISO date.
1245 sub ModNextExpected
{
1246 my ( $subscriptionid, $date ) = @_;
1247 my $dbh = C4
::Context
->dbh;
1249 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1250 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1252 # Each subscription has only one 'expected' issue.
1253 $sth->execute( $date, $date, $subscriptionid, EXPECTED
);
1258 =head2 GetSubscriptionIrregularities
1262 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1263 get the list of irregularities for a subscription
1269 sub GetSubscriptionIrregularities
{
1270 my $subscriptionid = shift;
1272 return unless $subscriptionid;
1274 my $dbh = C4
::Context
->dbh;
1278 WHERE subscriptionid
= ?
1280 my $sth = $dbh->prepare($query);
1281 $sth->execute($subscriptionid);
1283 my ($result) = $sth->fetchrow_array;
1284 my @irreg = split /;/, $result;
1289 =head2 ModSubscription
1291 this function modifies a subscription. Put all new values on input args.
1292 returns the number of rows affected
1296 sub ModSubscription
{
1298 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1299 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1300 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1301 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1302 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1303 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1304 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1305 $itemtype, $previousitemtype, $mana_id
1308 my $subscription = Koha
::Subscriptions
->find($subscriptionid);
1311 librarian
=> $auser,
1312 branchcode
=> $branchcode,
1313 aqbooksellerid
=> $aqbooksellerid,
1315 aqbudgetid
=> $aqbudgetid,
1316 biblionumber
=> $biblionumber,
1317 startdate
=> $startdate,
1318 periodicity
=> $periodicity,
1319 numberlength
=> $numberlength,
1320 weeklength
=> $weeklength,
1321 monthlength
=> $monthlength,
1322 lastvalue1
=> $lastvalue1,
1323 innerloop1
=> $innerloop1,
1324 lastvalue2
=> $lastvalue2,
1325 innerloop2
=> $innerloop2,
1326 lastvalue3
=> $lastvalue3,
1327 innerloop3
=> $innerloop3,
1331 firstacquidate
=> $firstacquidate,
1332 irregularity
=> $irregularity,
1333 numberpattern
=> $numberpattern,
1335 callnumber
=> $callnumber,
1336 manualhistory
=> $manualhistory,
1337 internalnotes
=> $internalnotes,
1338 serialsadditems
=> $serialsadditems,
1339 staffdisplaycount
=> $staffdisplaycount,
1340 opacdisplaycount
=> $opacdisplaycount,
1341 graceperiod
=> $graceperiod,
1342 location
=> $location,
1343 enddate
=> $enddate,
1344 skip_serialseq
=> $skip_serialseq,
1345 itemtype
=> $itemtype,
1346 previousitemtype
=> $previousitemtype,
1347 mana_id
=> $mana_id,
1351 logaction
( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1353 $subscription->discard_changes;
1354 return $subscription;
1357 =head2 NewSubscription
1359 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1360 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1361 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1362 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1363 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1364 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1365 $skip_serialseq, $itemtype, $previousitemtype);
1367 Create a new subscription with value given on input args.
1370 the id of this new subscription
1374 sub NewSubscription
{
1376 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1377 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1378 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1379 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1380 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1381 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1382 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1384 my $dbh = C4
::Context
->dbh;
1386 my $subscription = Koha
::Subscription
->new(
1388 librarian
=> $auser,
1389 branchcode
=> $branchcode,
1390 aqbooksellerid
=> $aqbooksellerid,
1392 aqbudgetid
=> $aqbudgetid,
1393 biblionumber
=> $biblionumber,
1394 startdate
=> $startdate,
1395 periodicity
=> $periodicity,
1396 numberlength
=> $numberlength,
1397 weeklength
=> $weeklength,
1398 monthlength
=> $monthlength,
1399 lastvalue1
=> $lastvalue1,
1400 innerloop1
=> $innerloop1,
1401 lastvalue2
=> $lastvalue2,
1402 innerloop2
=> $innerloop2,
1403 lastvalue3
=> $lastvalue3,
1404 innerloop3
=> $innerloop3,
1408 firstacquidate
=> $firstacquidate,
1409 irregularity
=> $irregularity,
1410 numberpattern
=> $numberpattern,
1412 callnumber
=> $callnumber,
1413 manualhistory
=> $manualhistory,
1414 internalnotes
=> $internalnotes,
1415 serialsadditems
=> $serialsadditems,
1416 staffdisplaycount
=> $staffdisplaycount,
1417 opacdisplaycount
=> $opacdisplaycount,
1418 graceperiod
=> $graceperiod,
1419 location
=> $location,
1420 enddate
=> $enddate,
1421 skip_serialseq
=> $skip_serialseq,
1422 itemtype
=> $itemtype,
1423 previousitemtype
=> $previousitemtype,
1424 mana_id
=> $mana_id,
1427 $subscription->discard_changes;
1428 my $subscriptionid = $subscription->subscriptionid;
1429 my ( $query, $sth );
1431 $enddate = GetExpirationDate
( $subscriptionid, $startdate );
1435 WHERE subscriptionid
=?
1437 $sth = $dbh->prepare($query);
1438 $sth->execute( $enddate, $subscriptionid );
1441 # then create the 1st expected number
1443 INSERT INTO subscriptionhistory
1444 (biblionumber
, subscriptionid
, histstartdate
, missinglist
, recievedlist
)
1445 VALUES
(?
,?
,?
, '', '')
1447 $sth = $dbh->prepare($query);
1448 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1450 # reread subscription to get a hash (for calculation of the 1st issue number)
1451 $subscription = GetSubscription
($subscriptionid); # We should not do that
1452 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1454 # calculate issue number
1455 my $serialseq = GetSeq
($subscription, $pattern) || q{};
1459 serialseq
=> $serialseq,
1460 serialseq_x
=> $subscription->{'lastvalue1'},
1461 serialseq_y
=> $subscription->{'lastvalue2'},
1462 serialseq_z
=> $subscription->{'lastvalue3'},
1463 subscriptionid
=> $subscriptionid,
1464 biblionumber
=> $biblionumber,
1466 planneddate
=> $firstacquidate,
1467 publisheddate
=> $firstacquidate,
1471 logaction
( "SERIAL", "ADD", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1473 #set serial flag on biblio if not already set.
1474 my $biblio = Koha
::Biblios
->find( $biblionumber );
1475 if ( $biblio and !$biblio->serial ) {
1476 my $record = GetMarcBiblio
({ biblionumber
=> $biblionumber });
1477 my ( $tag, $subf ) = GetMarcFromKohaField
( 'biblio.serial' );
1479 eval { $record->field($tag)->update( $subf => 1 ); };
1481 ModBiblio
( $record, $biblionumber, $biblio->frameworkcode );
1483 return $subscriptionid;
1486 =head2 ReNewSubscription
1488 ReNewSubscription($params);
1490 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1492 this function renew a subscription with values given on input args.
1496 sub ReNewSubscription
{
1497 my ( $params ) = @_;
1498 my $subscriptionid = $params->{subscriptionid
};
1499 my $user = $params->{user
};
1500 my $startdate = $params->{startdate
};
1501 my $numberlength = $params->{numberlength
};
1502 my $weeklength = $params->{weeklength
};
1503 my $monthlength = $params->{monthlength
};
1504 my $note = $params->{note
};
1505 my $branchcode = $params->{branchcode
};
1507 my $dbh = C4
::Context
->dbh;
1508 my $subscription = GetSubscription
($subscriptionid);
1512 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1513 WHERE biblio
.biblionumber
=?
1515 my $sth = $dbh->prepare($query);
1516 $sth->execute( $subscription->{biblionumber
} );
1517 my $biblio = $sth->fetchrow_hashref;
1519 if ( C4
::Context
->preference("RenewSerialAddsSuggestion") ) {
1520 require C4
::Suggestions
;
1521 C4
::Suggestions
::NewSuggestion
(
1522 { 'suggestedby' => $user,
1523 'title' => $subscription->{bibliotitle
},
1524 'author' => $biblio->{author
},
1525 'publishercode' => $biblio->{publishercode
},
1527 'biblionumber' => $subscription->{biblionumber
},
1528 'branchcode' => $branchcode,
1533 $numberlength ||= 0; # Should not we raise an exception instead?
1536 # renew subscription
1539 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
,reneweddate
=NOW
()
1540 WHERE subscriptionid
=?
1542 $sth = $dbh->prepare($query);
1543 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1544 my $enddate = GetExpirationDate
($subscriptionid);
1545 $debug && warn "enddate :$enddate";
1549 WHERE subscriptionid
=?
1551 $sth = $dbh->prepare($query);
1552 $sth->execute( $enddate, $subscriptionid );
1554 logaction
( "SERIAL", "RENEW", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1560 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1562 Create a new issue stored on the database.
1563 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1564 returns the serial id
1569 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1570 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1571 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1573 return unless ($subscriptionid);
1575 my $schema = Koha
::Database
->new()->schema();
1577 my $subscription = Koha
::Subscriptions
->find( $subscriptionid );
1579 my $serial = Koha
::Serial
->new(
1581 serialseq
=> $serialseq,
1582 serialseq_x
=> $subscription->lastvalue1(),
1583 serialseq_y
=> $subscription->lastvalue2(),
1584 serialseq_z
=> $subscription->lastvalue3(),
1585 subscriptionid
=> $subscriptionid,
1586 biblionumber
=> $biblionumber,
1588 planneddate
=> $planneddate,
1589 publisheddate
=> $publisheddate,
1590 publisheddatetext
=> $publisheddatetext,
1592 routingnotes
=> $routingnotes
1596 my $serialid = $serial->id();
1598 my $subscription_history = Koha
::Subscription
::Histories
->find($subscriptionid);
1599 my $missinglist = $subscription_history->missinglist();
1600 my $recievedlist = $subscription_history->recievedlist();
1602 if ( $status == ARRIVED
) {
1603 ### TODO Add a feature that improves recognition and description.
1604 ### As such count (serialseq) i.e. : N18,2(N19),N20
1605 ### Would use substr and index But be careful to previous presence of ()
1606 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1608 if ( grep { /^$status$/ } (MISSING_STATUSES
) ) {
1609 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1612 $recievedlist =~ s/^; //;
1613 $missinglist =~ s/^; //;
1615 $subscription_history->recievedlist($recievedlist);
1616 $subscription_history->missinglist($missinglist);
1617 $subscription_history->store();
1622 =head2 HasSubscriptionStrictlyExpired
1624 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1626 the subscription has stricly expired when today > the end subscription date
1629 1 if true, 0 if false, -1 if the expiration date is not set.
1633 sub HasSubscriptionStrictlyExpired
{
1635 # Getting end of subscription date
1636 my ($subscriptionid) = @_;
1638 return unless ($subscriptionid);
1640 my $dbh = C4
::Context
->dbh;
1641 my $subscription = GetSubscription
($subscriptionid);
1642 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1644 # If the expiration date is set
1645 if ( $expirationdate != 0 ) {
1646 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1648 # Getting today's date
1649 my ( $nowyear, $nowmonth, $nowday ) = Today
();
1651 # if today's date > expiration date, then the subscription has stricly expired
1652 if ( Delta_Days
( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1659 # There are some cases where the expiration date is not set
1660 # As we can't determine if the subscription has expired on a date-basis,
1666 =head2 HasSubscriptionExpired
1668 $has_expired = HasSubscriptionExpired($subscriptionid)
1670 the subscription has expired when the next issue to arrive is out of subscription limit.
1673 0 if the subscription has not expired
1674 1 if the subscription has expired
1675 2 if has subscription does not have a valid expiration date set
1679 sub HasSubscriptionExpired
{
1680 my ($subscriptionid) = @_;
1682 return unless ($subscriptionid);
1684 my $dbh = C4
::Context
->dbh;
1685 my $subscription = GetSubscription
($subscriptionid);
1686 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1687 if ( $frequency and $frequency->{unit
} ) {
1688 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1689 if (!defined $expirationdate) {
1690 $expirationdate = q{};
1693 SELECT max
(planneddate
)
1695 WHERE subscriptionid
=?
1697 my $sth = $dbh->prepare($query);
1698 $sth->execute($subscriptionid);
1699 my ($res) = $sth->fetchrow;
1700 if (!$res || $res=~m/^0000/) {
1703 my @res = split( /-/, $res );
1704 my @endofsubscriptiondate = split( /-/, $expirationdate );
1705 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date
(@res) || not check_date
(@endofsubscriptiondate) );
1707 if ( ( @endofsubscriptiondate && Delta_Days
( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1712 if ( $subscription->{'numberlength'} ) {
1713 my $countreceived = countissuesfrom
( $subscriptionid, $subscription->{'startdate'} );
1714 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1720 return 0; # Notice that you'll never get here.
1723 =head2 DelSubscription
1725 DelSubscription($subscriptionid)
1726 this function deletes subscription which has $subscriptionid as id.
1730 sub DelSubscription
{
1731 my ($subscriptionid) = @_;
1732 my $dbh = C4
::Context
->dbh;
1733 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1734 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1735 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1737 Koha
::AdditionalFieldValues
->search({
1738 'field.tablename' => 'subscription',
1739 'me.record_id' => $subscriptionid,
1740 }, { join => 'field' })->delete;
1742 logaction
( "SERIAL", "DELETE", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1747 DelIssue($serialseq,$subscriptionid)
1748 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1750 returns the number of rows affected
1755 my ($dataissue) = @_;
1756 my $dbh = C4
::Context
->dbh;
1757 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1762 AND subscriptionid
= ?
1764 my $mainsth = $dbh->prepare($query);
1765 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1767 #Delete element from subscription history
1768 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1769 my $sth = $dbh->prepare($query);
1770 $sth->execute( $dataissue->{'subscriptionid'} );
1771 my $val = $sth->fetchrow_hashref;
1772 unless ( $val->{manualhistory
} ) {
1774 SELECT
* FROM subscriptionhistory
1775 WHERE subscriptionid
= ?
1777 my $sth = $dbh->prepare($query);
1778 $sth->execute( $dataissue->{'subscriptionid'} );
1779 my $data = $sth->fetchrow_hashref;
1780 my $serialseq = $dataissue->{'serialseq'};
1781 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1782 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1783 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1784 $sth = $dbh->prepare($strsth);
1785 $sth->execute( $dataissue->{'subscriptionid'} );
1788 return $mainsth->rows;
1791 =head2 GetLateOrMissingIssues
1793 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1795 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1798 the issuelist as an array of hash refs. Each element of this array contains
1799 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1803 sub GetLateOrMissingIssues
{
1804 my ( $supplierid, $serialid, $order ) = @_;
1806 return unless ( $supplierid or $serialid );
1808 my $dbh = C4
::Context
->dbh;
1813 $byserial = "and serialid = " . $serialid;
1816 $order .= ", title";
1820 my $missing_statuses_string = join ',', (MISSING_STATUSES
);
1822 $sth = $dbh->prepare(
1824 serialid, aqbooksellerid, name,
1825 biblio.title, biblioitems.issn, planneddate, serialseq,
1826 serial.status, serial.subscriptionid, claimdate, claims_count,
1827 subscription.branchcode
1829 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1830 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1831 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1832 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1833 WHERE subscription.subscriptionid = serial.subscriptionid
1834 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1835 AND subscription.aqbooksellerid=$supplierid
1840 $sth = $dbh->prepare(
1842 serialid, aqbooksellerid, name,
1843 biblio.title, planneddate, serialseq,
1844 serial.status, serial.subscriptionid, claimdate, claims_count,
1845 subscription.branchcode
1847 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1848 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1849 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1850 WHERE subscription.subscriptionid = serial.subscriptionid
1851 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1856 $sth->execute( EXPECTED
, LATE
, CLAIMED
);
1858 while ( my $line = $sth->fetchrow_hashref ) {
1860 if ($line->{planneddate
} && $line->{planneddate
} !~/^0+\-/) {
1861 $line->{planneddateISO
} = $line->{planneddate
};
1862 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{"planneddate"} ), dateonly
=> 1 } );
1864 if ($line->{claimdate
} && $line->{claimdate
} !~/^0+\-/) {
1865 $line->{claimdateISO
} = $line->{claimdate
};
1866 $line->{claimdate
} = output_pref
( { dt
=> dt_from_string
( $line->{"claimdate"} ), dateonly
=> 1 } );
1868 $line->{"status".$line->{status
}} = 1;
1870 my $subscription_object = Koha
::Subscriptions
->find($line->{subscriptionid
});
1871 $line->{additional_fields
} = { map { $_->field->name => $_->value }
1872 $subscription_object->additional_field_values->as_list };
1874 push @issuelist, $line;
1881 &updateClaim($serialid)
1883 this function updates the time when a claim is issued for late/missing items
1885 called from claims.pl file
1890 my ($serialids) = @_;
1891 return unless $serialids;
1892 unless ( ref $serialids ) {
1893 $serialids = [ $serialids ];
1895 my $dbh = C4
::Context
->dbh;
1898 SET claimdate
= NOW
(),
1899 claims_count
= claims_count
+ 1,
1901 WHERE serialid
in (| . join( q
|,|, (q
|?
|) x @
$serialids ) . q
|)|,
1902 {}, CLAIMED
, @
$serialids );
1905 =head2 check_routing
1907 $result = &check_routing($subscriptionid)
1909 this function checks to see if a serial has a routing list and returns the count of routingid
1910 used to show either an 'add' or 'edit' link
1915 my ($subscriptionid) = @_;
1917 return unless ($subscriptionid);
1919 my $dbh = C4
::Context
->dbh;
1920 my $sth = $dbh->prepare(
1921 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1922 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1923 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1926 $sth->execute($subscriptionid);
1927 my $line = $sth->fetchrow_hashref;
1928 my $result = $line->{'routingids'};
1932 =head2 addroutingmember
1934 addroutingmember($borrowernumber,$subscriptionid)
1936 this function takes a borrowernumber and subscriptionid and adds the member to the
1937 routing list for that serial subscription and gives them a rank on the list
1938 of either 1 or highest current rank + 1
1942 sub addroutingmember
{
1943 my ( $borrowernumber, $subscriptionid ) = @_;
1945 return unless ($borrowernumber and $subscriptionid);
1948 my $dbh = C4
::Context
->dbh;
1949 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1950 $sth->execute($subscriptionid);
1951 while ( my $line = $sth->fetchrow_hashref ) {
1952 if ( $line->{'rank'} > 0 ) {
1953 $rank = $line->{'rank'} + 1;
1958 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1959 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1962 =head2 reorder_members
1964 reorder_members($subscriptionid,$routingid,$rank)
1966 this function is used to reorder the routing list
1968 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1969 - it gets all members on list puts their routingid's into an array
1970 - removes the one in the array that is $routingid
1971 - then reinjects $routingid at point indicated by $rank
1972 - then update the database with the routingids in the new order
1976 sub reorder_members
{
1977 my ( $subscriptionid, $routingid, $rank ) = @_;
1978 my $dbh = C4
::Context
->dbh;
1979 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1980 $sth->execute($subscriptionid);
1982 while ( my $line = $sth->fetchrow_hashref ) {
1983 push( @result, $line->{'routingid'} );
1986 # To find the matching index
1988 my $key = -1; # to allow for 0 being a valid response
1989 for ( $i = 0 ; $i < @result ; $i++ ) {
1990 if ( $routingid == $result[$i] ) {
1991 $key = $i; # save the index
1996 # if index exists in array then move it to new position
1997 if ( $key > -1 && $rank > 0 ) {
1998 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1999 my $moving_item = splice( @result, $key, 1 );
2000 splice( @result, $new_rank, 0, $moving_item );
2002 for ( my $j = 0 ; $j < @result ; $j++ ) {
2003 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2009 =head2 delroutingmember
2011 delroutingmember($routingid,$subscriptionid)
2013 this function either deletes one member from routing list if $routingid exists otherwise
2014 deletes all members from the routing list
2018 sub delroutingmember
{
2020 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2021 my ( $routingid, $subscriptionid ) = @_;
2022 my $dbh = C4
::Context
->dbh;
2024 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2025 $sth->execute($routingid);
2026 reorder_members
( $subscriptionid, $routingid );
2028 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2029 $sth->execute($subscriptionid);
2034 =head2 getroutinglist
2036 @routinglist = getroutinglist($subscriptionid)
2038 this gets the info from the subscriptionroutinglist for $subscriptionid
2041 the routinglist as an array. Each element of the array contains a hash_ref containing
2042 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2046 sub getroutinglist
{
2047 my ($subscriptionid) = @_;
2048 my $dbh = C4
::Context
->dbh;
2049 my $sth = $dbh->prepare(
2050 'SELECT routingid, borrowernumber, ranking, biblionumber
2052 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2053 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2055 $sth->execute($subscriptionid);
2056 my $routinglist = $sth->fetchall_arrayref({});
2057 return @
{$routinglist};
2060 =head2 countissuesfrom
2062 $result = countissuesfrom($subscriptionid,$startdate)
2064 Returns a count of serial rows matching the given subsctiptionid
2065 with published date greater than startdate
2069 sub countissuesfrom
{
2070 my ( $subscriptionid, $startdate ) = @_;
2071 my $dbh = C4
::Context
->dbh;
2075 WHERE subscriptionid
=?
2076 AND serial
.publisheddate
>?
2078 my $sth = $dbh->prepare($query);
2079 $sth->execute( $subscriptionid, $startdate );
2080 my ($countreceived) = $sth->fetchrow;
2081 return $countreceived;
2086 $result = CountIssues($subscriptionid)
2088 Returns a count of serial rows matching the given subsctiptionid
2093 my ($subscriptionid) = @_;
2094 my $dbh = C4
::Context
->dbh;
2098 WHERE subscriptionid
=?
2100 my $sth = $dbh->prepare($query);
2101 $sth->execute($subscriptionid);
2102 my ($countreceived) = $sth->fetchrow;
2103 return $countreceived;
2108 $result = HasItems($subscriptionid)
2110 returns a count of items from serial matching the subscriptionid
2115 my ($subscriptionid) = @_;
2116 my $dbh = C4
::Context
->dbh;
2118 SELECT COUNT
(serialitems
.itemnumber
)
2120 LEFT JOIN serialitems USING
(serialid
)
2121 WHERE subscriptionid
=? AND serialitems
.serialid IS NOT NULL
2123 my $sth=$dbh->prepare($query);
2124 $sth->execute($subscriptionid);
2125 my ($countitems)=$sth->fetchrow_array();
2129 =head2 abouttoexpire
2131 $result = abouttoexpire($subscriptionid)
2133 this function alerts you to the penultimate issue for a serial subscription
2135 returns 1 - if this is the penultimate issue
2141 my ($subscriptionid) = @_;
2142 my $dbh = C4
::Context
->dbh;
2143 my $subscription = GetSubscription
($subscriptionid);
2144 my $per = $subscription->{'periodicity'};
2145 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($per);
2146 if ($frequency and $frequency->{unit
}){
2148 my $expirationdate = GetExpirationDate
($subscriptionid);
2150 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2151 my $nextdate = GetNextDate
($subscription, $res, $frequency);
2153 # only compare dates if both dates exist.
2154 if ($nextdate and $expirationdate) {
2155 if(Date
::Calc
::Delta_Days
(
2156 split( /-/, $nextdate ),
2157 split( /-/, $expirationdate )
2163 } elsif ( $subscription->{numberlength
} && $subscription->{numberlength
}>0) {
2164 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2170 =head2 GetFictiveIssueNumber
2172 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2174 Get the position of the issue published at $publisheddate, considering the
2175 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2176 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2177 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2178 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2179 depending on how many rows are in serial table.
2180 The issue number calculation is based on subscription frequency, first acquisition
2181 date, and $publisheddate.
2183 Returns undef when called for irregular frequencies.
2185 The routine is used to skip irregularities when calculating the next issue
2186 date (in GetNextDate) or the next issue number (in GetNextSeq).
2190 sub GetFictiveIssueNumber
{
2191 my ($subscription, $publisheddate, $frequency) = @_;
2193 my $unit = $frequency->{unit
} ?
lc $frequency->{'unit'} : undef;
2197 my ( $year, $month, $day ) = split /-/, $publisheddate;
2198 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2199 my $delta = _delta_units
( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2201 if( $frequency->{'unitsperissue'} == 1 ) {
2202 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2203 } else { # issuesperunit == 1
2204 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2210 my ( $date1, $date2, $unit ) = @_;
2211 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2213 if( $unit eq 'day' ) {
2214 return Delta_Days
( @
$date1, @
$date2 );
2215 } elsif( $unit eq 'week' ) {
2216 return int( Delta_Days
( @
$date1, @
$date2 ) / 7 );
2219 # In case of months or years, this is a wrapper around N_Delta_YMD.
2220 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2221 # while we expect 1 month.
2222 my @delta = N_Delta_YMD
( @
$date1, @
$date2 );
2223 if( $delta[2] > 27 ) {
2224 # Check if we could add a month
2225 my @jump = Add_Delta_YM
( @
$date1, $delta[0], 1 + $delta[1] );
2226 if( Delta_Days
( @jump, @
$date2 ) >= 0 ) {
2230 if( $delta[1] >= 12 ) {
2234 # if unit is year, we only return full years
2235 return $unit eq 'month' ?
$delta[0] * 12 + $delta[1] : $delta[0];
2238 sub _get_next_date_day
{
2239 my ($subscription, $freqdata, $year, $month, $day) = @_;
2241 my @newissue; # ( yy, mm, dd )
2242 # We do not need $delta_days here, since it would be zero where used
2244 if( $freqdata->{issuesperunit
} == 1 ) {
2246 @newissue = Add_Delta_Days
(
2247 $year, $month, $day, $freqdata->{"unitsperissue"} );
2248 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2250 @newissue = ( $year, $month, $day );
2251 $subscription->{countissuesperunit
}++;
2253 # We finished a cycle of issues within a unit.
2254 # No subtraction of zero needed, just add one day
2255 @newissue = Add_Delta_Days
( $year, $month, $day, 1 );
2256 $subscription->{countissuesperunit
} = 1;
2261 sub _get_next_date_week
{
2262 my ($subscription, $freqdata, $year, $month, $day) = @_;
2264 my @newissue; # ( yy, mm, dd )
2265 my $delta_days = int( 7 / $freqdata->{issuesperunit
} );
2267 if( $freqdata->{issuesperunit
} == 1 ) {
2268 # Add full weeks (of 7 days)
2269 @newissue = Add_Delta_Days
(
2270 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2271 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2272 # Add rounded number of days based on frequency.
2273 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2274 $subscription->{countissuesperunit
}++;
2276 # We finished a cycle of issues within a unit.
2277 # Subtract delta * (issues - 1), add 1 week
2278 @newissue = Add_Delta_Days
( $year, $month, $day,
2279 -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2280 @newissue = Add_Delta_Days
( @newissue, 7 );
2281 $subscription->{countissuesperunit
} = 1;
2286 sub _get_next_date_month
{
2287 my ($subscription, $freqdata, $year, $month, $day) = @_;
2289 my @newissue; # ( yy, mm, dd )
2290 my $delta_days = int( 30 / $freqdata->{issuesperunit
} );
2292 if( $freqdata->{issuesperunit
} == 1 ) {
2294 @newissue = Add_Delta_YM
(
2295 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2296 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2297 # Add rounded number of days based on frequency.
2298 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2299 $subscription->{countissuesperunit
}++;
2301 # We finished a cycle of issues within a unit.
2302 # Subtract delta * (issues - 1), add 1 month
2303 @newissue = Add_Delta_Days
( $year, $month, $day,
2304 -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2305 @newissue = Add_Delta_YM
( @newissue, 0, 1 );
2306 $subscription->{countissuesperunit
} = 1;
2311 sub _get_next_date_year
{
2312 my ($subscription, $freqdata, $year, $month, $day) = @_;
2314 my @newissue; # ( yy, mm, dd )
2315 my $delta_days = int( 365 / $freqdata->{issuesperunit
} );
2317 if( $freqdata->{issuesperunit
} == 1 ) {
2319 @newissue = Add_Delta_YM
( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2320 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2321 # Add rounded number of days based on frequency.
2322 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2323 $subscription->{countissuesperunit
}++;
2325 # We finished a cycle of issues within a unit.
2326 # Subtract delta * (issues - 1), add 1 year
2327 @newissue = Add_Delta_Days
( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2328 @newissue = Add_Delta_YM
( @newissue, 1, 0 );
2329 $subscription->{countissuesperunit
} = 1;
2336 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2338 this function it takes the publisheddate and will return the next issue's date
2339 and will skip dates if there exists an irregularity.
2340 $publisheddate has to be an ISO date
2341 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2342 $frequency is a hashref containing frequency informations
2343 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2344 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2345 skipped then the returned date will be 2007-05-10
2348 $resultdate - then next date in the sequence (ISO date)
2350 Return undef if subscription is irregular
2355 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2357 return unless $subscription and $publisheddate;
2360 if ($freqdata->{'unit'}) {
2361 my ( $year, $month, $day ) = split /-/, $publisheddate;
2363 # Process an irregularity Hash
2364 # Suppose that irregularities are stored in a string with this structure
2365 # irreg1;irreg2;irreg3
2366 # where irregX is the number of issue which will not be received
2367 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2369 if ( $subscription->{irregularity
} ) {
2370 my @irreg = split /;/, $subscription->{'irregularity'} ;
2371 foreach my $irregularity (@irreg) {
2372 $irregularities{$irregularity} = 1;
2376 # Get the 'fictive' next issue number
2377 # It is used to check if next issue is an irregular issue.
2378 my $issueno = GetFictiveIssueNumber
($subscription, $publisheddate, $freqdata) + 1;
2380 # Then get the next date
2381 my $unit = lc $freqdata->{'unit'};
2382 if ($unit eq 'day') {
2383 while ($irregularities{$issueno}) {
2384 ($year, $month, $day) = _get_next_date_day
($subscription,
2385 $freqdata, $year, $month, $day);
2388 ($year, $month, $day) = _get_next_date_day
($subscription, $freqdata,
2389 $year, $month, $day);
2391 elsif ($unit eq 'week') {
2392 while ($irregularities{$issueno}) {
2393 ($year, $month, $day) = _get_next_date_week
($subscription,
2394 $freqdata, $year, $month, $day);
2397 ($year, $month, $day) = _get_next_date_week
($subscription,
2398 $freqdata, $year, $month, $day);
2400 elsif ($unit eq 'month') {
2401 while ($irregularities{$issueno}) {
2402 ($year, $month, $day) = _get_next_date_month
($subscription,
2403 $freqdata, $year, $month, $day);
2406 ($year, $month, $day) = _get_next_date_month
($subscription,
2407 $freqdata, $year, $month, $day);
2409 elsif ($unit eq 'year') {
2410 while ($irregularities{$issueno}) {
2411 ($year, $month, $day) = _get_next_date_year
($subscription,
2412 $freqdata, $year, $month, $day);
2415 ($year, $month, $day) = _get_next_date_year
($subscription,
2416 $freqdata, $year, $month, $day);
2420 my $dbh = C4
::Context
->dbh;
2423 SET countissuesperunit
= ?
2424 WHERE subscriptionid
= ?
2426 my $sth = $dbh->prepare($query);
2427 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2430 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2436 $string = &_numeration($value,$num_type,$locale);
2438 _numeration returns the string corresponding to $value in the num_type
2450 my ($value, $num_type, $locale) = @_;
2455 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2456 # 1970-11-01 was a Sunday
2457 $value = $value % 7;
2458 my $dt = DateTime
->new(
2464 $string = $num_type =~ /^dayname$/
2465 ?
$dt->strftime("%A")
2466 : $dt->strftime("%a");
2467 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2468 $value = $value % 12;
2469 my $dt = DateTime
->new(
2471 month
=> $value + 1,
2474 $string = $num_type =~ /^monthname$/
2475 ?
$dt->strftime("%B")
2476 : $dt->strftime("%b");
2477 } elsif ( $num_type =~ /^season$/ ) {
2478 my @seasons= qw( Spring Summer Fall Winter );
2479 $value = $value % 4;
2480 $string = $seasons[$value];
2481 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2482 my @seasonsabrv= qw( Spr Sum Fal Win );
2483 $value = $value % 4;
2484 $string = $seasonsabrv[$value];
2492 =head2 CloseSubscription
2494 Close a subscription given a subscriptionid
2498 sub CloseSubscription
{
2499 my ( $subscriptionid ) = @_;
2500 return unless $subscriptionid;
2501 my $dbh = C4
::Context
->dbh;
2502 my $sth = $dbh->prepare( q{
2505 WHERE subscriptionid = ?
2507 $sth->execute( $subscriptionid );
2509 # Set status = missing when status = stopped
2510 $sth = $dbh->prepare( q{
2513 WHERE subscriptionid = ?
2516 $sth->execute( STOPPED
, $subscriptionid, EXPECTED
);
2519 =head2 ReopenSubscription
2521 Reopen a subscription given a subscriptionid
2525 sub ReopenSubscription
{
2526 my ( $subscriptionid ) = @_;
2527 return unless $subscriptionid;
2528 my $dbh = C4
::Context
->dbh;
2529 my $sth = $dbh->prepare( q{
2532 WHERE subscriptionid = ?
2534 $sth->execute( $subscriptionid );
2536 # Set status = expected when status = stopped
2537 $sth = $dbh->prepare( q{
2540 WHERE subscriptionid = ?
2543 $sth->execute( EXPECTED
, $subscriptionid, STOPPED
);
2546 =head2 subscriptionCurrentlyOnOrder
2548 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2550 Return 1 if subscription is currently on order else 0.
2554 sub subscriptionCurrentlyOnOrder
{
2555 my ( $subscriptionid ) = @_;
2556 my $dbh = C4
::Context
->dbh;
2558 SELECT COUNT
(*) FROM aqorders
2559 WHERE subscriptionid
= ?
2560 AND datereceived IS NULL
2561 AND datecancellationprinted IS NULL
2563 my $sth = $dbh->prepare( $query );
2564 $sth->execute($subscriptionid);
2565 return $sth->fetchrow_array;
2568 =head2 can_claim_subscription
2570 $can = can_claim_subscription( $subscriptionid[, $userid] );
2572 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2576 sub can_claim_subscription
{
2577 my ( $subscription, $userid ) = @_;
2578 return _can_do_on_subscription
( $subscription, $userid, 'claim_serials' );
2581 =head2 can_edit_subscription
2583 $can = can_edit_subscription( $subscriptionid[, $userid] );
2585 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2589 sub can_edit_subscription
{
2590 my ( $subscription, $userid ) = @_;
2591 return _can_do_on_subscription
( $subscription, $userid, 'edit_subscription' );
2594 =head2 can_show_subscription
2596 $can = can_show_subscription( $subscriptionid[, $userid] );
2598 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2602 sub can_show_subscription
{
2603 my ( $subscription, $userid ) = @_;
2604 return _can_do_on_subscription
( $subscription, $userid, '*' );
2607 sub _can_do_on_subscription
{
2608 my ( $subscription, $userid, $permission ) = @_;
2609 return 0 unless C4
::Context
->userenv;
2610 my $flags = C4
::Context
->userenv->{flags
};
2611 $userid ||= C4
::Context
->userenv->{'id'};
2613 if ( C4
::Context
->preference('IndependentBranches') ) {
2615 if C4
::Context
->IsSuperLibrarian()
2617 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2619 C4
::Auth
::haspermission
( $userid,
2620 { serials
=> $permission } )
2621 and ( not defined $subscription->{branchcode
}
2622 or $subscription->{branchcode
} eq ''
2623 or $subscription->{branchcode
} eq
2624 C4
::Context
->userenv->{'branch'} )
2629 if C4
::Context
->IsSuperLibrarian()
2631 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2632 or C4
::Auth
::haspermission
(
2633 $userid, { serials
=> $permission }
2640 =head2 findSerialsByStatus
2642 @serials = findSerialsByStatus($status, $subscriptionid);
2644 Returns an array of serials matching a given status and subscription id.
2648 sub findSerialsByStatus
{
2649 my ( $status, $subscriptionid ) = @_;
2650 my $dbh = C4
::Context
->dbh;
2651 my $query = q
| SELECT
* from serial
2653 AND subscriptionid
= ?
2655 my $serials = $dbh->selectall_arrayref( $query, { Slice
=> {} }, $status, $subscriptionid );
2664 Koha Development Team <http://koha-community.org/>