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
;
39 use Scalar
::Util
qw( looks_like_number );
41 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
49 MISSING_NEVER_RECIEVED => 41,
50 MISSING_SOLD_OUT => 42,
51 MISSING_DAMAGED => 43,
59 use constant MISSING_STATUSES => (
60 MISSING, MISSING_NEVER_RECIEVED,
61 MISSING_SOLD_OUT, MISSING_DAMAGED,
69 &NewSubscription &ModSubscription &DelSubscription
70 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
72 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
73 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
74 &GetSubscriptionHistoryFromSubscriptionId
76 &GetNextSeq &GetSeq &NewIssue &GetSerials
77 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
78 &GetSubscriptionLength &ReNewSubscription &GetLateOrMissingIssues
79 &GetSerialInformation &AddItem2Serial
80 &PrepareSerialsData &GetNextExpected &ModNextExpected
83 &GetSuppliersWithLateIssues
84 &getroutinglist &delroutingmember &addroutingmember
86 &check_routing &updateClaim
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues
{
122 my $dbh = C4
::Context
->dbh;
123 my $statuses = join(',', ( LATE
, MISSING_STATUSES
, CLAIMED
) );
125 SELECT DISTINCT id
, name
127 LEFT JOIN serial ON serial
.subscriptionid
=subscription
.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
131 (planneddate
< now
() AND serial
.status
=1)
132 OR serial
.STATUS IN
( $statuses )
134 AND subscription
.closed
= 0
136 return $dbh->selectall_arrayref($query, { Slice
=> {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId
{
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4
::Context
->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid
= ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialInformation
168 $data = GetSerialInformation($serialid);
169 returns a hash_ref containing :
170 items : items marcrecord (can be an array)
172 subscription table field
173 + information about subscription expiration
177 sub GetSerialInformation
{
179 my $dbh = C4
::Context
->dbh;
181 SELECT serial
.*, serial
.notes as sernotes
, serial
.status as serstatus
,subscription
.*,subscription
.subscriptionid as subsid
182 FROM serial LEFT JOIN subscription ON subscription
.subscriptionid
=serial
.subscriptionid
185 my $rq = $dbh->prepare($query);
186 $rq->execute($serialid);
187 my $data = $rq->fetchrow_hashref;
189 # create item information if we have serialsadditems for this subscription
190 if ( $data->{'serialsadditems'} ) {
191 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
192 $queryitem->execute($serialid);
193 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
195 if ( scalar(@
$itemnumbers) > 0 ) {
196 foreach my $itemnum (@
$itemnumbers) {
198 #It is ASSUMED that GetMarcItem ALWAYS WORK...
199 #Maybe GetMarcItem should return values on failure
200 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
201 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, $itemnum->[0], $data );
202 $itemprocessed->{'itemnumber'} = $itemnum->[0];
203 $itemprocessed->{'itemid'} = $itemnum->[0];
204 $itemprocessed->{'serialid'} = $serialid;
205 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
206 push @
{ $data->{'items'} }, $itemprocessed;
209 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, '', $data );
210 $itemprocessed->{'itemid'} = "N$serialid";
211 $itemprocessed->{'serialid'} = $serialid;
212 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
213 $itemprocessed->{'countitems'} = 0;
214 push @
{ $data->{'items'} }, $itemprocessed;
217 $data->{ "status" . $data->{'serstatus'} } = 1;
218 $data->{'subscriptionexpired'} = HasSubscriptionExpired
( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
219 $data->{'abouttoexpire'} = abouttoexpire
( $data->{'subscriptionid'} );
220 $data->{cannotedit
} = not can_edit_subscription
( $data );
224 =head2 AddItem2Serial
226 $rows = AddItem2Serial($serialid,$itemnumber);
227 Adds an itemnumber to Serial record
228 returns the number of rows affected
233 my ( $serialid, $itemnumber ) = @_;
235 return unless ($serialid and $itemnumber);
237 my $dbh = C4
::Context
->dbh;
238 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
239 $rq->execute( $serialid, $itemnumber );
243 =head2 GetSubscription
245 $subs = GetSubscription($subscriptionid)
246 this function returns the subscription which has $subscriptionid as id.
248 a hashref. This hash contains
249 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
253 sub GetSubscription
{
254 my ($subscriptionid) = @_;
255 my $dbh = C4
::Context
->dbh;
257 SELECT subscription
.*,
258 subscriptionhistory
.*,
259 aqbooksellers
.name AS aqbooksellername
,
260 biblio
.title AS bibliotitle
,
261 subscription
.biblionumber as bibnum
263 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
264 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
265 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
266 WHERE subscription
.subscriptionid
= ?
269 $debug and warn "query : $query\nsubsid :$subscriptionid";
270 my $sth = $dbh->prepare($query);
271 $sth->execute($subscriptionid);
272 my $subscription = $sth->fetchrow_hashref;
274 return unless $subscription;
276 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
278 if ( my $mana_id = $subscription->{mana_id
} ) {
279 my $mana_subscription = Koha
::SharedContent
::get_entity_by_id
(
280 'subscription', $mana_id, {usecomments
=> 1});
281 $subscription->{comments
} = $mana_subscription->{data
}->{comments
};
284 return $subscription;
287 =head2 GetFullSubscription
289 $array_ref = GetFullSubscription($subscriptionid)
290 this function reads the serial table.
294 sub GetFullSubscription
{
295 my ($subscriptionid) = @_;
297 return unless ($subscriptionid);
299 my $dbh = C4
::Context
->dbh;
301 SELECT serial
.serialid
,
304 serial
.publisheddate
,
305 serial
.publisheddatetext
,
307 serial
.notes as notes
,
308 year
(IF
(serial
.publisheddate IS NULL
,serial
.planneddate
,serial
.publisheddate
)) as year
,
309 aqbooksellers
.name as aqbooksellername
,
310 biblio
.title as bibliotitle
,
311 subscription
.branchcode AS branchcode
,
312 subscription
.subscriptionid AS subscriptionid
314 LEFT JOIN subscription ON
315 (serial
.subscriptionid
=subscription
.subscriptionid
)
316 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
317 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
318 WHERE serial
.subscriptionid
= ?
320 IF
(serial
.publisheddate IS NULL
,serial
.planneddate
,serial
.publisheddate
) DESC
,
321 serial
.subscriptionid
323 $debug and warn "GetFullSubscription query: $query";
324 my $sth = $dbh->prepare($query);
325 $sth->execute($subscriptionid);
326 my $subscriptions = $sth->fetchall_arrayref( {} );
327 my $cannotedit = not can_edit_subscription
( $subscriptions->[0] ) if scalar @
$subscriptions;
328 for my $subscription ( @
$subscriptions ) {
329 $subscription->{cannotedit
} = $cannotedit;
331 return $subscriptions;
334 =head2 PrepareSerialsData
336 $array_ref = PrepareSerialsData($serialinfomation)
337 where serialinformation is a hashref array
341 sub PrepareSerialsData
{
344 return unless ($lines);
350 my $aqbooksellername;
354 my $previousnote = "";
356 foreach my $subs (@
{$lines}) {
357 for my $datefield ( qw(publisheddate planneddate) ) {
358 # handle 0000-00-00 dates
359 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
360 $subs->{$datefield} = undef;
363 $subs->{ "status" . $subs->{'status'} } = 1;
364 if ( grep { $_ == $subs->{status
} } ( EXPECTED
, LATE
, MISSING_STATUSES
, CLAIMED
) ) {
365 $subs->{"checked"} = 1;
368 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
369 $year = $subs->{'year'};
373 if ( $tmpresults{$year} ) {
374 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
376 $tmpresults{$year} = {
378 'aqbooksellername' => $subs->{'aqbooksellername'},
379 'bibliotitle' => $subs->{'bibliotitle'},
380 'serials' => [$subs],
385 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
386 push @res, $tmpresults{$key};
391 =head2 GetSubscriptionsFromBiblionumber
393 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
394 this function get the subscription list. it reads the subscription table.
396 reference to an array of subscriptions which have the biblionumber given on input arg.
397 each element of this array is a hashref containing
398 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
402 sub GetSubscriptionsFromBiblionumber
{
403 my ($biblionumber) = @_;
405 return unless ($biblionumber);
407 my $dbh = C4
::Context
->dbh;
409 SELECT subscription
.*,
411 subscriptionhistory
.*,
412 aqbooksellers
.name AS aqbooksellername
,
413 biblio
.title AS bibliotitle
415 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
416 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
417 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
418 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
419 WHERE subscription
.biblionumber
= ?
421 my $sth = $dbh->prepare($query);
422 $sth->execute($biblionumber);
424 while ( my $subs = $sth->fetchrow_hashref ) {
425 $subs->{startdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{startdate
} ), dateonly
=> 1 } );
426 $subs->{histstartdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histstartdate
} ), dateonly
=> 1 } );
427 if ( defined $subs->{histenddate
} ) {
428 $subs->{histenddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histenddate
} ), dateonly
=> 1 } );
430 $subs->{histenddate
} = "";
432 $subs->{opacnote
} //= "";
433 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
434 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
435 $subs->{ "status" . $subs->{'status'} } = 1;
437 if (not defined $subs->{enddate
} ) {
438 $subs->{enddate
} = '';
440 $subs->{enddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{enddate
}), dateonly
=> 1 } );
442 $subs->{'abouttoexpire'} = abouttoexpire
( $subs->{'subscriptionid'} );
443 $subs->{'subscriptionexpired'} = HasSubscriptionExpired
( $subs->{'subscriptionid'} );
444 $subs->{cannotedit
} = not can_edit_subscription
( $subs );
450 =head2 GetFullSubscriptionsFromBiblionumber
452 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
453 this function reads the serial table.
457 sub GetFullSubscriptionsFromBiblionumber
{
458 my ($biblionumber) = @_;
459 my $dbh = C4
::Context
->dbh;
461 SELECT serial
.serialid
,
464 serial
.publisheddate
,
465 serial
.publisheddatetext
,
467 serial
.notes as notes
,
468 year
(IF
(serial
.publisheddate IS NULL
,serial
.planneddate
,serial
.publisheddate
)) as year
,
469 biblio
.title as bibliotitle
,
470 subscription
.branchcode AS branchcode
,
471 subscription
.subscriptionid AS subscriptionid
473 LEFT JOIN subscription ON
474 (serial
.subscriptionid
=subscription
.subscriptionid
)
475 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
476 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
477 WHERE subscription
.biblionumber
= ?
479 IF
(serial
.publisheddate IS NULL
,serial
.planneddate
,serial
.publisheddate
) DESC
,
480 serial
.subscriptionid
482 my $sth = $dbh->prepare($query);
483 $sth->execute($biblionumber);
484 my $subscriptions = $sth->fetchall_arrayref( {} );
485 my $cannotedit = not can_edit_subscription
( $subscriptions->[0] ) if scalar @
$subscriptions;
486 for my $subscription ( @
$subscriptions ) {
487 $subscription->{cannotedit
} = $cannotedit;
489 return $subscriptions;
492 =head2 SearchSubscriptions
494 @results = SearchSubscriptions($args);
496 This function returns a list of hashrefs, one for each subscription
497 that meets the conditions specified by the $args hashref.
499 The valid search fields are:
513 The expiration_date search field is special; it specifies the maximum
514 subscription expiration date.
518 sub SearchSubscriptions
{
521 my $additional_fields = $args->{additional_fields
} // [];
522 my $matching_record_ids_for_additional_fields = [];
523 if ( @
$additional_fields ) {
524 my @subscriptions = Koha
::Subscriptions
->filter_by_additional_fields($additional_fields);
526 return () unless @subscriptions;
528 $matching_record_ids_for_additional_fields = [ map {
535 subscription
.notes AS publicnotes
,
536 subscriptionhistory
.*,
538 biblio
.notes AS biblionotes
,
542 aqbooksellers
.name AS vendorname
,
545 LEFT JOIN subscriptionhistory USING
(subscriptionid
)
546 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
547 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= subscription
.biblionumber
548 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
550 $query .= q
| WHERE
1|;
553 if( $args->{biblionumber
} ) {
554 push @where_strs, "biblio.biblionumber = ?";
555 push @where_args, $args->{biblionumber
};
558 if( $args->{title
} ){
559 my @words = split / /, $args->{title
};
561 foreach my $word (@words) {
562 push @strs, "biblio.title LIKE ?";
563 push @args, "%$word%";
566 push @where_strs, '(' . join (' AND ', @strs) . ')';
567 push @where_args, @args;
571 push @where_strs, "biblioitems.issn LIKE ?";
572 push @where_args, "%$args->{issn}%";
575 push @where_strs, "biblioitems.ean LIKE ?";
576 push @where_args, "%$args->{ean}%";
578 if ( $args->{callnumber
} ) {
579 push @where_strs, "subscription.callnumber LIKE ?";
580 push @where_args, "%$args->{callnumber}%";
582 if( $args->{publisher
} ){
583 push @where_strs, "biblioitems.publishercode LIKE ?";
584 push @where_args, "%$args->{publisher}%";
586 if( $args->{bookseller
} ){
587 push @where_strs, "aqbooksellers.name LIKE ?";
588 push @where_args, "%$args->{bookseller}%";
590 if( $args->{branch
} ){
591 push @where_strs, "subscription.branchcode = ?";
592 push @where_args, "$args->{branch}";
594 if ( $args->{location
} ) {
595 push @where_strs, "subscription.location = ?";
596 push @where_args, "$args->{location}";
598 if ( $args->{expiration_date
} ) {
599 push @where_strs, "subscription.enddate <= ?";
600 push @where_args, "$args->{expiration_date}";
602 if( defined $args->{closed
} ){
603 push @where_strs, "subscription.closed = ?";
604 push @where_args, "$args->{closed}";
608 $query .= ' AND ' . join(' AND ', @where_strs);
610 if ( @
$additional_fields ) {
611 $query .= ' AND subscriptionid IN ('
612 . join( ', ', @
$matching_record_ids_for_additional_fields )
616 $query .= " ORDER BY " . $args->{orderby
} if $args->{orderby
};
618 my $dbh = C4
::Context
->dbh;
619 my $sth = $dbh->prepare($query);
620 $sth->execute(@where_args);
621 my $results = $sth->fetchall_arrayref( {} );
623 for my $subscription ( @
$results ) {
624 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
625 $subscription->{cannotdisplay
} = not can_show_subscription
( $subscription );
627 my $subscription_object = Koha
::Subscriptions
->find($subscription->{subscriptionid
});
628 $subscription->{additional_fields
} = { map { $_->field->name => $_->value }
629 $subscription_object->additional_field_values->as_list };
639 ($totalissues,@serials) = GetSerials($subscriptionid);
640 this function gets every serial not arrived for a given subscription
641 as well as the number of issues registered in the database (all types)
642 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
644 FIXME: We should return \@serials.
649 my ( $subscriptionid, $count ) = @_;
651 return unless $subscriptionid;
653 my $dbh = C4
::Context
->dbh;
655 # status = 2 is "arrived"
657 $count = 5 unless ($count);
659 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
, NOT_ISSUED
) );
660 my $query = "SELECT serialid,serialseq, status, publisheddate,
661 publisheddatetext, planneddate,notes, routingnotes
663 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
664 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
665 my $sth = $dbh->prepare($query);
666 $sth->execute($subscriptionid);
668 while ( my $line = $sth->fetchrow_hashref ) {
669 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
670 for my $datefield ( qw( planneddate publisheddate) ) {
671 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
672 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
674 $line->{$datefield} = q{};
677 push @serials, $line;
680 # OK, now add the last 5 issues arrives/missing
681 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
682 publisheddatetext, notes, routingnotes
684 WHERE subscriptionid = ?
685 AND status IN ( $statuses )
686 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
688 $sth = $dbh->prepare($query);
689 $sth->execute($subscriptionid);
690 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
692 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
693 for my $datefield ( qw( planneddate publisheddate) ) {
694 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
695 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
697 $line->{$datefield} = q{};
701 push @serials, $line;
704 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
705 $sth = $dbh->prepare($query);
706 $sth->execute($subscriptionid);
707 my ($totalissues) = $sth->fetchrow;
708 return ( $totalissues, @serials );
713 @serials = GetSerials2($subscriptionid,$statuses);
714 this function returns every serial waited for a given subscription
715 as well as the number of issues registered in the database (all types)
716 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
718 $statuses is an arrayref of statuses and is mandatory.
723 my ( $subscription, $statuses ) = @_;
725 return unless ($subscription and @
$statuses);
727 my $dbh = C4
::Context
->dbh;
729 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,
730 publisheddatetext
, notes
, routingnotes
732 WHERE subscriptionid
=?
734 . q
| AND status IN
(| . join( ",", ('?') x @
$statuses ) . q
|)|
736 ORDER BY publisheddate
,serialid DESC
738 $debug and warn "GetSerials2 query: $query";
739 my $sth = $dbh->prepare($query);
740 $sth->execute( $subscription, @
$statuses );
743 while ( my $line = $sth->fetchrow_hashref ) {
744 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
745 # Format dates for display
746 for my $datefield ( qw( planneddate publisheddate ) ) {
747 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
748 $line->{$datefield} = q{};
751 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
754 push @serials, $line;
759 =head2 GetLatestSerials
761 \@serials = GetLatestSerials($subscriptionid,$limit)
762 get the $limit's latest serials arrived or missing for a given subscription
764 a ref to an array which contains all of the latest serials stored into a hash.
768 sub GetLatestSerials
{
769 my ( $subscriptionid, $limit ) = @_;
771 return unless ($subscriptionid and $limit);
773 my $dbh = C4
::Context
->dbh;
775 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
) );
776 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
778 WHERE subscriptionid = ?
779 AND status IN ($statuses)
780 ORDER BY publisheddate DESC LIMIT 0,$limit
782 my $sth = $dbh->prepare($strsth);
783 $sth->execute($subscriptionid);
785 while ( my $line = $sth->fetchrow_hashref ) {
786 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
787 push @serials, $line;
793 =head2 GetPreviousSerialid
795 $serialid = GetPreviousSerialid($subscriptionid, $nth)
796 get the $nth's previous serial for the given subscriptionid
802 sub GetPreviousSerialid
{
803 my ( $subscriptionid, $nth ) = @_;
805 my $dbh = C4
::Context
->dbh;
809 my $strsth = "SELECT serialid
811 WHERE subscriptionid = ?
813 ORDER BY serialid DESC LIMIT $nth,1
815 my $sth = $dbh->prepare($strsth);
816 $sth->execute($subscriptionid);
818 my $line = $sth->fetchrow_hashref;
819 $return = $line->{'serialid'} if ($line);
827 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
828 $newinnerloop1, $newinnerloop2, $newinnerloop3
829 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
831 $subscription is a hashref containing all the attributes of the table
833 $pattern is a hashref containing all the attributes of the table
834 'subscription_numberpatterns'.
835 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
836 $planneddate is a date string in iso format.
837 This function get the next issue for the subscription given on input arg
842 my ($subscription, $pattern, $frequency, $planneddate) = @_;
844 return unless ($subscription and $pattern);
846 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
847 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
850 if ($subscription->{'skip_serialseq'}) {
851 my @irreg = split /;/, $subscription->{'irregularity'};
853 my $irregularities = {};
854 $irregularities->{$_} = 1 foreach(@irreg);
855 my $issueno = GetFictiveIssueNumber
($subscription, $planneddate, $frequency) + 1;
856 while($irregularities->{$issueno}) {
863 my $numberingmethod = $pattern->{numberingmethod
};
865 if ($numberingmethod) {
866 $calculated = $numberingmethod;
867 my $locale = $subscription->{locale
};
868 $newlastvalue1 = $subscription->{lastvalue1
} || 0;
869 $newlastvalue2 = $subscription->{lastvalue2
} || 0;
870 $newlastvalue3 = $subscription->{lastvalue3
} || 0;
871 $newinnerloop1 = $subscription->{innerloop1
} || 0;
872 $newinnerloop2 = $subscription->{innerloop2
} || 0;
873 $newinnerloop3 = $subscription->{innerloop3
} || 0;
876 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
879 for(my $i = 0; $i < $count; $i++) {
881 # check if we have to increase the new value.
883 if ($newinnerloop1 >= $pattern->{every1
}) {
885 $newlastvalue1 += $pattern->{add1
};
887 # reset counter if needed.
888 $newlastvalue1 = $pattern->{setto1
} if ($newlastvalue1 > $pattern->{whenmorethan1
});
891 # check if we have to increase the new value.
893 if ($newinnerloop2 >= $pattern->{every2
}) {
895 $newlastvalue2 += $pattern->{add2
};
897 # reset counter if needed.
898 $newlastvalue2 = $pattern->{setto2
} if ($newlastvalue2 > $pattern->{whenmorethan2
});
901 # check if we have to increase the new value.
903 if ($newinnerloop3 >= $pattern->{every3
}) {
905 $newlastvalue3 += $pattern->{add3
};
907 # reset counter if needed.
908 $newlastvalue3 = $pattern->{setto3
} if ($newlastvalue3 > $pattern->{whenmorethan3
});
912 my $newlastvalue1string = _numeration
( $newlastvalue1, $pattern->{numbering1
}, $locale );
913 $calculated =~ s/\{X\}/$newlastvalue1string/g;
916 my $newlastvalue2string = _numeration
( $newlastvalue2, $pattern->{numbering2
}, $locale );
917 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
920 my $newlastvalue3string = _numeration
( $newlastvalue3, $pattern->{numbering3
}, $locale );
921 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
926 $newlastvalue1, $newlastvalue2, $newlastvalue3,
927 $newinnerloop1, $newinnerloop2, $newinnerloop3);
932 $calculated = GetSeq($subscription, $pattern)
933 $subscription is a hashref containing all the attributes of the table 'subscription'
934 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
935 this function transforms {X},{Y},{Z} to 150,0,0 for example.
937 the sequence in string format
942 my ($subscription, $pattern) = @_;
944 return unless ($subscription and $pattern);
946 my $locale = $subscription->{locale
};
948 my $calculated = $pattern->{numberingmethod
};
950 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
951 $newlastvalue1 = _numeration
($newlastvalue1, $pattern->{numbering1
}, $locale) if ($pattern->{numbering1
}); # reset counter if needed.
952 $calculated =~ s/\{X\}/$newlastvalue1/g;
954 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
955 $newlastvalue2 = _numeration
($newlastvalue2, $pattern->{numbering2
}, $locale) if ($pattern->{numbering2
}); # reset counter if needed.
956 $calculated =~ s/\{Y\}/$newlastvalue2/g;
958 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
959 $newlastvalue3 = _numeration
($newlastvalue3, $pattern->{numbering3
}, $locale) if ($pattern->{numbering3
}); # reset counter if needed.
960 $calculated =~ s/\{Z\}/$newlastvalue3/g;
964 =head2 GetExpirationDate
966 $enddate = GetExpirationDate($subscriptionid, [$startdate])
968 this function return the next expiration date for a subscription given on input args.
975 sub GetExpirationDate
{
976 my ( $subscriptionid, $startdate ) = @_;
978 return unless ($subscriptionid);
980 my $dbh = C4
::Context
->dbh;
981 my $subscription = GetSubscription
($subscriptionid);
984 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
985 $enddate = $startdate || $subscription->{startdate
};
986 my @date = split( /-/, $enddate );
988 return if ( scalar(@date) != 3 || not check_date
(@date) );
990 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
991 if ( $frequency and $frequency->{unit
} ) {
994 if ( my $length = $subscription->{numberlength
} ) {
996 #calculate the date of the last issue.
997 for ( my $i = 1 ; $i <= $length ; $i++ ) {
998 $enddate = GetNextDate
( $subscription, $enddate, $frequency );
1000 } elsif ( $subscription->{monthlength
} ) {
1001 if ( $$subscription{startdate
} ) {
1002 my @enddate = Add_Delta_YM
( $date[0], $date[1], $date[2], 0, $subscription->{monthlength
} );
1003 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1005 } elsif ( $subscription->{weeklength
} ) {
1006 if ( $$subscription{startdate
} ) {
1007 my @date = split( /-/, $subscription->{startdate
} );
1008 my @enddate = Add_Delta_Days
( $date[0], $date[1], $date[2], $subscription->{weeklength
} * 7 );
1009 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1012 $enddate = $subscription->{enddate
};
1016 return $subscription->{enddate
};
1020 =head2 CountSubscriptionFromBiblionumber
1022 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1023 this returns a count of the subscriptions for a given biblionumber
1025 the number of subscriptions
1029 sub CountSubscriptionFromBiblionumber
{
1030 my ($biblionumber) = @_;
1032 return unless ($biblionumber);
1034 my $dbh = C4
::Context
->dbh;
1035 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1036 my $sth = $dbh->prepare($query);
1037 $sth->execute($biblionumber);
1038 my $subscriptionsnumber = $sth->fetchrow;
1039 return $subscriptionsnumber;
1042 =head2 ModSubscriptionHistory
1044 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1046 this function modifies the history of a subscription. Put your new values on input arg.
1047 returns the number of rows affected
1051 sub ModSubscriptionHistory
{
1052 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1054 return unless ($subscriptionid);
1056 my $dbh = C4
::Context
->dbh;
1057 my $query = "UPDATE subscriptionhistory
1058 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1059 WHERE subscriptionid=?
1061 my $sth = $dbh->prepare($query);
1062 $receivedlist =~ s/^; // if $receivedlist;
1063 $missinglist =~ s/^; // if $missinglist;
1064 $opacnote =~ s/^; // if $opacnote;
1065 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1069 =head2 ModSerialStatus
1071 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1072 $publisheddatetext, $status, $notes);
1074 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1075 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1079 sub ModSerialStatus
{
1080 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1081 $status, $notes) = @_;
1083 return unless ($serialid);
1085 #It is a usual serial
1086 # 1st, get previous status :
1087 my $dbh = C4
::Context
->dbh;
1088 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1089 FROM serial, subscription
1090 WHERE serial.subscriptionid=subscription.subscriptionid
1092 my $sth = $dbh->prepare($query);
1093 $sth->execute($serialid);
1094 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1095 my $frequency = GetSubscriptionFrequency
($periodicity);
1097 # change status & update subscriptionhistory
1099 if ( $status == DELETED
) {
1100 DelIssue
( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1104 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1105 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1108 $sth = $dbh->prepare($query);
1109 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1110 $planneddate, $status, $notes, $routingnotes, $serialid );
1111 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1112 $sth = $dbh->prepare($query);
1113 $sth->execute($subscriptionid);
1114 my $val = $sth->fetchrow_hashref;
1115 unless ( $val->{manualhistory
} ) {
1116 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1117 $sth = $dbh->prepare($query);
1118 $sth->execute($subscriptionid);
1119 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1121 if ( $status == ARRIVED
|| ($oldstatus == ARRIVED
&& $status != ARRIVED
) ) {
1122 $recievedlist = _handle_seqno
($serialseq, $recievedlist);
1125 # in case serial has been previously marked as missing
1126 if (grep /$status/, (EXPECTED
, ARRIVED
, LATE
, CLAIMED
)) {
1127 $missinglist = _handle_seqno
($serialseq, $missinglist, 'REMOVE');
1130 $missinglist = _handle_seqno
($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES
;
1131 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED
and not _handle_seqno
($serialseq, $missinglist, 'CHECK');
1133 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1134 $sth = $dbh->prepare($query);
1135 $recievedlist =~ s/^; //;
1136 $missinglist =~ s/^; //;
1137 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1141 # create new expected entry if needed (ie : was "expected" and has changed)
1142 my $otherIssueExpected = scalar findSerialsByStatus
(EXPECTED
, $subscriptionid);
1143 if ( !$otherIssueExpected && $oldstatus == EXPECTED
&& $status != EXPECTED
) {
1144 my $subscription = GetSubscription
($subscriptionid);
1145 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1146 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1150 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1151 $newinnerloop1, $newinnerloop2, $newinnerloop3
1153 = GetNextSeq
( $subscription, $pattern, $frequency, $publisheddate );
1155 # next date (calculated from actual date & frequency parameters)
1156 my $nextpublisheddate = GetNextDate
($subscription, $publisheddate, $frequency, 1);
1157 my $nextpubdate = $nextpublisheddate;
1158 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1159 WHERE subscriptionid = ?";
1160 $sth = $dbh->prepare($query);
1161 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1162 my $newnote = C4
::Context
->preference('PreserveSerialNotes') ?
$notes : "";
1163 NewIssue
( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1164 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1165 if ( $subscription->{letter
} && $status == ARRIVED
&& $oldstatus != ARRIVED
) {
1166 require C4
::Letters
;
1167 C4
::Letters
::SendAlerts
( 'issue', $serialid, $subscription->{letter
} );
1175 # Adds or removes seqno from list when needed; returns list
1176 # Or checks and returns true when present
1178 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1180 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1182 if( !$op or $op eq 'ADD' ) {
1183 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1184 } elsif( $op eq 'REMOVE' ) {
1185 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1187 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ?
1 : q{};
1192 =head2 GetNextExpected
1194 $nextexpected = GetNextExpected($subscriptionid)
1196 Get the planneddate for the current expected issue of the subscription.
1202 planneddate => ISO date
1207 sub GetNextExpected
{
1208 my ($subscriptionid) = @_;
1210 my $dbh = C4
::Context
->dbh;
1214 WHERE subscriptionid
= ?
1218 my $sth = $dbh->prepare($query);
1220 # Each subscription has only one 'expected' issue.
1221 $sth->execute( $subscriptionid, EXPECTED
);
1222 my $nextissue = $sth->fetchrow_hashref;
1223 if ( !$nextissue ) {
1227 WHERE subscriptionid
= ?
1228 ORDER BY publisheddate DESC
1231 $sth = $dbh->prepare($query);
1232 $sth->execute($subscriptionid);
1233 $nextissue = $sth->fetchrow_hashref;
1235 foreach(qw
/planneddate publisheddate/) {
1236 if ( !defined $nextissue->{$_} ) {
1237 # or should this default to 1st Jan ???
1238 $nextissue->{$_} = strftime
( '%Y-%m-%d', localtime );
1240 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1248 =head2 ModNextExpected
1250 ModNextExpected($subscriptionid,$date)
1252 Update the planneddate for the current expected issue of the subscription.
1253 This will modify all future prediction results.
1255 C<$date> is an ISO date.
1261 sub ModNextExpected
{
1262 my ( $subscriptionid, $date ) = @_;
1263 my $dbh = C4
::Context
->dbh;
1265 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1266 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1268 # Each subscription has only one 'expected' issue.
1269 $sth->execute( $date, $date, $subscriptionid, EXPECTED
);
1274 =head2 GetSubscriptionIrregularities
1278 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1279 get the list of irregularities for a subscription
1285 sub GetSubscriptionIrregularities
{
1286 my $subscriptionid = shift;
1288 return unless $subscriptionid;
1290 my $dbh = C4
::Context
->dbh;
1294 WHERE subscriptionid
= ?
1296 my $sth = $dbh->prepare($query);
1297 $sth->execute($subscriptionid);
1299 my ($result) = $sth->fetchrow_array;
1300 my @irreg = split /;/, $result;
1305 =head2 ModSubscription
1307 this function modifies a subscription. Put all new values on input args.
1308 returns the number of rows affected
1312 sub ModSubscription
{
1314 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1315 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1316 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1317 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1318 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1319 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1320 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1321 $itemtype, $previousitemtype, $mana_id
1324 my $subscription = Koha
::Subscriptions
->find($subscriptionid);
1327 librarian
=> $auser,
1328 branchcode
=> $branchcode,
1329 aqbooksellerid
=> $aqbooksellerid,
1331 aqbudgetid
=> $aqbudgetid,
1332 biblionumber
=> $biblionumber,
1333 startdate
=> $startdate,
1334 periodicity
=> $periodicity,
1335 numberlength
=> $numberlength,
1336 weeklength
=> $weeklength,
1337 monthlength
=> $monthlength,
1338 lastvalue1
=> $lastvalue1,
1339 innerloop1
=> $innerloop1,
1340 lastvalue2
=> $lastvalue2,
1341 innerloop2
=> $innerloop2,
1342 lastvalue3
=> $lastvalue3,
1343 innerloop3
=> $innerloop3,
1347 firstacquidate
=> $firstacquidate,
1348 irregularity
=> $irregularity,
1349 numberpattern
=> $numberpattern,
1351 callnumber
=> $callnumber,
1352 manualhistory
=> $manualhistory,
1353 internalnotes
=> $internalnotes,
1354 serialsadditems
=> $serialsadditems,
1355 staffdisplaycount
=> $staffdisplaycount,
1356 opacdisplaycount
=> $opacdisplaycount,
1357 graceperiod
=> $graceperiod,
1358 location
=> $location,
1359 enddate
=> $enddate,
1360 skip_serialseq
=> $skip_serialseq,
1361 itemtype
=> $itemtype,
1362 previousitemtype
=> $previousitemtype,
1363 mana_id
=> $mana_id,
1367 logaction
( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1369 $subscription->discard_changes;
1370 return $subscription;
1373 =head2 NewSubscription
1375 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1376 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1377 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1378 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1379 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1380 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1381 $skip_serialseq, $itemtype, $previousitemtype);
1383 Create a new subscription with value given on input args.
1386 the id of this new subscription
1390 sub NewSubscription
{
1392 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1393 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1394 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1395 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1396 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1397 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1398 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1400 my $dbh = C4
::Context
->dbh;
1402 my $subscription = Koha
::Subscription
->new(
1404 librarian
=> $auser,
1405 branchcode
=> $branchcode,
1406 aqbooksellerid
=> $aqbooksellerid,
1408 aqbudgetid
=> $aqbudgetid,
1409 biblionumber
=> $biblionumber,
1410 startdate
=> $startdate,
1411 periodicity
=> $periodicity,
1412 numberlength
=> $numberlength,
1413 weeklength
=> $weeklength,
1414 monthlength
=> $monthlength,
1415 lastvalue1
=> $lastvalue1,
1416 innerloop1
=> $innerloop1,
1417 lastvalue2
=> $lastvalue2,
1418 innerloop2
=> $innerloop2,
1419 lastvalue3
=> $lastvalue3,
1420 innerloop3
=> $innerloop3,
1424 firstacquidate
=> $firstacquidate,
1425 irregularity
=> $irregularity,
1426 numberpattern
=> $numberpattern,
1428 callnumber
=> $callnumber,
1429 manualhistory
=> $manualhistory,
1430 internalnotes
=> $internalnotes,
1431 serialsadditems
=> $serialsadditems,
1432 staffdisplaycount
=> $staffdisplaycount,
1433 opacdisplaycount
=> $opacdisplaycount,
1434 graceperiod
=> $graceperiod,
1435 location
=> $location,
1436 enddate
=> $enddate,
1437 skip_serialseq
=> $skip_serialseq,
1438 itemtype
=> $itemtype,
1439 previousitemtype
=> $previousitemtype,
1440 mana_id
=> $mana_id,
1443 $subscription->discard_changes;
1444 my $subscriptionid = $subscription->subscriptionid;
1445 my ( $query, $sth );
1447 $enddate = GetExpirationDate
( $subscriptionid, $startdate );
1451 WHERE subscriptionid
=?
1453 $sth = $dbh->prepare($query);
1454 $sth->execute( $enddate, $subscriptionid );
1457 # then create the 1st expected number
1459 INSERT INTO subscriptionhistory
1460 (biblionumber
, subscriptionid
, histstartdate
, missinglist
, recievedlist
)
1461 VALUES
(?
,?
,?
, '', '')
1463 $sth = $dbh->prepare($query);
1464 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1466 # reread subscription to get a hash (for calculation of the 1st issue number)
1467 $subscription = GetSubscription
($subscriptionid); # We should not do that
1468 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1470 # calculate issue number
1471 my $serialseq = GetSeq
($subscription, $pattern) || q{};
1475 serialseq
=> $serialseq,
1476 serialseq_x
=> $subscription->{'lastvalue1'},
1477 serialseq_y
=> $subscription->{'lastvalue2'},
1478 serialseq_z
=> $subscription->{'lastvalue3'},
1479 subscriptionid
=> $subscriptionid,
1480 biblionumber
=> $biblionumber,
1482 planneddate
=> $firstacquidate,
1483 publisheddate
=> $firstacquidate,
1487 logaction
( "SERIAL", "ADD", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1489 #set serial flag on biblio if not already set.
1490 my $biblio = Koha
::Biblios
->find( $biblionumber );
1491 if ( $biblio and !$biblio->serial ) {
1492 my $record = GetMarcBiblio
({ biblionumber
=> $biblionumber });
1493 my ( $tag, $subf ) = GetMarcFromKohaField
( 'biblio.serial' );
1495 eval { $record->field($tag)->update( $subf => 1 ); };
1497 ModBiblio
( $record, $biblionumber, $biblio->frameworkcode );
1499 return $subscriptionid;
1502 =head2 GetSubscriptionLength
1504 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1506 This function calculates the subscription length.
1510 sub GetSubscriptionLength
{
1511 my ($subtype, $length) = @_;
1513 return unless looks_like_number
($length);
1517 $subtype eq 'issues' ?
$length : 0,
1518 $subtype eq 'weeks' ?
$length : 0,
1519 $subtype eq 'months' ?
$length : 0,
1524 =head2 ReNewSubscription
1526 ReNewSubscription($params);
1528 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1530 this function renew a subscription with values given on input args.
1534 sub ReNewSubscription
{
1535 my ( $params ) = @_;
1536 my $subscriptionid = $params->{subscriptionid
};
1537 my $user = $params->{user
};
1538 my $startdate = $params->{startdate
};
1539 my $numberlength = $params->{numberlength
};
1540 my $weeklength = $params->{weeklength
};
1541 my $monthlength = $params->{monthlength
};
1542 my $note = $params->{note
};
1543 my $branchcode = $params->{branchcode
};
1545 my $dbh = C4
::Context
->dbh;
1546 my $subscription = GetSubscription
($subscriptionid);
1550 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1551 WHERE biblio
.biblionumber
=?
1553 my $sth = $dbh->prepare($query);
1554 $sth->execute( $subscription->{biblionumber
} );
1555 my $biblio = $sth->fetchrow_hashref;
1557 if ( C4
::Context
->preference("RenewSerialAddsSuggestion") ) {
1558 require C4
::Suggestions
;
1559 C4
::Suggestions
::NewSuggestion
(
1560 { 'suggestedby' => $user,
1561 'title' => $subscription->{bibliotitle
},
1562 'author' => $biblio->{author
},
1563 'publishercode' => $biblio->{publishercode
},
1565 'biblionumber' => $subscription->{biblionumber
},
1566 'branchcode' => $branchcode,
1571 $numberlength ||= 0; # Should not we raise an exception instead?
1574 # renew subscription
1577 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
,reneweddate
=NOW
()
1578 WHERE subscriptionid
=?
1580 $sth = $dbh->prepare($query);
1581 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1582 my $enddate = GetExpirationDate
($subscriptionid);
1583 $debug && warn "enddate :$enddate";
1587 WHERE subscriptionid
=?
1589 $sth = $dbh->prepare($query);
1590 $sth->execute( $enddate, $subscriptionid );
1592 logaction
( "SERIAL", "RENEW", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1598 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1600 Create a new issue stored on the database.
1601 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1602 returns the serial id
1607 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1608 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1609 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1611 return unless ($subscriptionid);
1613 my $schema = Koha
::Database
->new()->schema();
1615 my $subscription = Koha
::Subscriptions
->find( $subscriptionid );
1617 my $serial = Koha
::Serial
->new(
1619 serialseq
=> $serialseq,
1620 serialseq_x
=> $subscription->lastvalue1(),
1621 serialseq_y
=> $subscription->lastvalue2(),
1622 serialseq_z
=> $subscription->lastvalue3(),
1623 subscriptionid
=> $subscriptionid,
1624 biblionumber
=> $biblionumber,
1626 planneddate
=> $planneddate,
1627 publisheddate
=> $publisheddate,
1628 publisheddatetext
=> $publisheddatetext,
1630 routingnotes
=> $routingnotes
1634 my $serialid = $serial->id();
1636 my $subscription_history = Koha
::Subscription
::Histories
->find($subscriptionid);
1637 my $missinglist = $subscription_history->missinglist();
1638 my $recievedlist = $subscription_history->recievedlist();
1640 if ( $status == ARRIVED
) {
1641 ### TODO Add a feature that improves recognition and description.
1642 ### As such count (serialseq) i.e. : N18,2(N19),N20
1643 ### Would use substr and index But be careful to previous presence of ()
1644 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1646 if ( grep { $_ eq $status } (MISSING_STATUSES
) ) {
1647 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1650 $recievedlist =~ s/^; //;
1651 $missinglist =~ s/^; //;
1653 $subscription_history->recievedlist($recievedlist);
1654 $subscription_history->missinglist($missinglist);
1655 $subscription_history->store();
1660 =head2 HasSubscriptionStrictlyExpired
1662 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1664 the subscription has stricly expired when today > the end subscription date
1667 1 if true, 0 if false, -1 if the expiration date is not set.
1671 sub HasSubscriptionStrictlyExpired
{
1673 # Getting end of subscription date
1674 my ($subscriptionid) = @_;
1676 return unless ($subscriptionid);
1678 my $dbh = C4
::Context
->dbh;
1679 my $subscription = GetSubscription
($subscriptionid);
1680 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1682 # If the expiration date is set
1683 if ( $expirationdate != 0 ) {
1684 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1686 # Getting today's date
1687 my ( $nowyear, $nowmonth, $nowday ) = Today
();
1689 # if today's date > expiration date, then the subscription has stricly expired
1690 if ( Delta_Days
( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1697 # There are some cases where the expiration date is not set
1698 # As we can't determine if the subscription has expired on a date-basis,
1704 =head2 HasSubscriptionExpired
1706 $has_expired = HasSubscriptionExpired($subscriptionid)
1708 the subscription has expired when the next issue to arrive is out of subscription limit.
1711 0 if the subscription has not expired
1712 1 if the subscription has expired
1713 2 if has subscription does not have a valid expiration date set
1717 sub HasSubscriptionExpired
{
1718 my ($subscriptionid) = @_;
1720 return unless ($subscriptionid);
1722 my $dbh = C4
::Context
->dbh;
1723 my $subscription = GetSubscription
($subscriptionid);
1724 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1725 if ( $frequency and $frequency->{unit
} ) {
1726 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1727 if (!defined $expirationdate) {
1728 $expirationdate = q{};
1731 SELECT max
(planneddate
)
1733 WHERE subscriptionid
=?
1735 my $sth = $dbh->prepare($query);
1736 $sth->execute($subscriptionid);
1737 my ($res) = $sth->fetchrow;
1738 if (!$res || $res=~m/^0000/) {
1741 my @res = split( /-/, $res );
1742 my @endofsubscriptiondate = split( /-/, $expirationdate );
1743 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date
(@res) || not check_date
(@endofsubscriptiondate) );
1745 if ( ( @endofsubscriptiondate && Delta_Days
( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1750 if ( $subscription->{'numberlength'} ) {
1751 my $countreceived = countissuesfrom
( $subscriptionid, $subscription->{'startdate'} );
1752 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1758 return 0; # Notice that you'll never get here.
1761 =head2 DelSubscription
1763 DelSubscription($subscriptionid)
1764 this function deletes subscription which has $subscriptionid as id.
1768 sub DelSubscription
{
1769 my ($subscriptionid) = @_;
1770 my $dbh = C4
::Context
->dbh;
1771 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1773 Koha
::AdditionalFieldValues
->search({
1774 'field.tablename' => 'subscription',
1775 'me.record_id' => $subscriptionid,
1776 }, { join => 'field' })->delete;
1778 logaction
( "SERIAL", "DELETE", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1783 DelIssue($serialseq,$subscriptionid)
1784 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1786 returns the number of rows affected
1791 my ($dataissue) = @_;
1792 my $dbh = C4
::Context
->dbh;
1793 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1798 AND subscriptionid
= ?
1800 my $mainsth = $dbh->prepare($query);
1801 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1803 #Delete element from subscription history
1804 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1805 my $sth = $dbh->prepare($query);
1806 $sth->execute( $dataissue->{'subscriptionid'} );
1807 my $val = $sth->fetchrow_hashref;
1808 unless ( $val->{manualhistory
} ) {
1810 SELECT
* FROM subscriptionhistory
1811 WHERE subscriptionid
= ?
1813 my $sth = $dbh->prepare($query);
1814 $sth->execute( $dataissue->{'subscriptionid'} );
1815 my $data = $sth->fetchrow_hashref;
1816 my $serialseq = $dataissue->{'serialseq'};
1817 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1818 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1819 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1820 $sth = $dbh->prepare($strsth);
1821 $sth->execute( $dataissue->{'subscriptionid'} );
1824 return $mainsth->rows;
1827 =head2 GetLateOrMissingIssues
1829 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1831 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1834 the issuelist as an array of hash refs. Each element of this array contains
1835 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1839 sub GetLateOrMissingIssues
{
1840 my ( $supplierid, $serialid, $order ) = @_;
1842 return unless ( $supplierid or $serialid );
1844 my $dbh = C4
::Context
->dbh;
1849 $byserial = "and serialid = " . $serialid;
1852 $order .= ", title";
1856 my $missing_statuses_string = join ',', (MISSING_STATUSES
);
1858 $sth = $dbh->prepare(
1860 serialid, aqbooksellerid, name,
1861 biblio.title, biblioitems.issn, planneddate, serialseq,
1862 serial.status, serial.subscriptionid, claimdate, claims_count,
1863 subscription.branchcode
1865 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1866 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1867 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1868 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1869 WHERE subscription.subscriptionid = serial.subscriptionid
1870 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1871 AND subscription.aqbooksellerid=$supplierid
1876 $sth = $dbh->prepare(
1878 serialid, aqbooksellerid, name,
1879 biblio.title, planneddate, serialseq,
1880 serial.status, serial.subscriptionid, claimdate, claims_count,
1881 subscription.branchcode
1883 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1884 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1885 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1886 WHERE subscription.subscriptionid = serial.subscriptionid
1887 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1892 $sth->execute( EXPECTED
, LATE
, CLAIMED
);
1894 while ( my $line = $sth->fetchrow_hashref ) {
1896 if ($line->{planneddate
} && $line->{planneddate
} !~/^0+\-/) {
1897 $line->{planneddateISO
} = $line->{planneddate
};
1898 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{"planneddate"} ), dateonly
=> 1 } );
1900 if ($line->{claimdate
} && $line->{claimdate
} !~/^0+\-/) {
1901 $line->{claimdateISO
} = $line->{claimdate
};
1902 $line->{claimdate
} = output_pref
( { dt
=> dt_from_string
( $line->{"claimdate"} ), dateonly
=> 1 } );
1904 $line->{"status".$line->{status
}} = 1;
1906 my $subscription_object = Koha
::Subscriptions
->find($line->{subscriptionid
});
1907 $line->{additional_fields
} = { map { $_->field->name => $_->value }
1908 $subscription_object->additional_field_values->as_list };
1910 push @issuelist, $line;
1917 &updateClaim($serialid)
1919 this function updates the time when a claim is issued for late/missing items
1921 called from claims.pl file
1926 my ($serialids) = @_;
1927 return unless $serialids;
1928 unless ( ref $serialids ) {
1929 $serialids = [ $serialids ];
1931 my $dbh = C4
::Context
->dbh;
1934 SET claimdate
= NOW
(),
1935 claims_count
= claims_count
+ 1,
1937 WHERE serialid
in (| . join( q
|,|, (q
|?
|) x @
$serialids ) . q
|)|,
1938 {}, CLAIMED
, @
$serialids );
1941 =head2 check_routing
1943 $result = &check_routing($subscriptionid)
1945 this function checks to see if a serial has a routing list and returns the count of routingid
1946 used to show either an 'add' or 'edit' link
1951 my ($subscriptionid) = @_;
1953 return unless ($subscriptionid);
1955 my $dbh = C4
::Context
->dbh;
1956 my $sth = $dbh->prepare(
1957 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1958 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1959 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1962 $sth->execute($subscriptionid);
1963 my $line = $sth->fetchrow_hashref;
1964 my $result = $line->{'routingids'};
1968 =head2 addroutingmember
1970 addroutingmember($borrowernumber,$subscriptionid)
1972 this function takes a borrowernumber and subscriptionid and adds the member to the
1973 routing list for that serial subscription and gives them a rank on the list
1974 of either 1 or highest current rank + 1
1978 sub addroutingmember
{
1979 my ( $borrowernumber, $subscriptionid ) = @_;
1981 return unless ($borrowernumber and $subscriptionid);
1984 my $dbh = C4
::Context
->dbh;
1985 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1986 $sth->execute($subscriptionid);
1987 while ( my $line = $sth->fetchrow_hashref ) {
1988 if ( $line->{'rank'} > 0 ) {
1989 $rank = $line->{'rank'} + 1;
1994 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1995 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1998 =head2 reorder_members
2000 reorder_members($subscriptionid,$routingid,$rank)
2002 this function is used to reorder the routing list
2004 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2005 - it gets all members on list puts their routingid's into an array
2006 - removes the one in the array that is $routingid
2007 - then reinjects $routingid at point indicated by $rank
2008 - then update the database with the routingids in the new order
2012 sub reorder_members
{
2013 my ( $subscriptionid, $routingid, $rank ) = @_;
2014 my $dbh = C4
::Context
->dbh;
2015 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2016 $sth->execute($subscriptionid);
2018 while ( my $line = $sth->fetchrow_hashref ) {
2019 push( @result, $line->{'routingid'} );
2022 # To find the matching index
2024 my $key = -1; # to allow for 0 being a valid response
2025 for ( $i = 0 ; $i < @result ; $i++ ) {
2026 if ( $routingid == $result[$i] ) {
2027 $key = $i; # save the index
2032 # if index exists in array then move it to new position
2033 if ( $key > -1 && $rank > 0 ) {
2034 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2035 my $moving_item = splice( @result, $key, 1 );
2036 splice( @result, $new_rank, 0, $moving_item );
2038 for ( my $j = 0 ; $j < @result ; $j++ ) {
2039 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2045 =head2 delroutingmember
2047 delroutingmember($routingid,$subscriptionid)
2049 this function either deletes one member from routing list if $routingid exists otherwise
2050 deletes all members from the routing list
2054 sub delroutingmember
{
2056 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2057 my ( $routingid, $subscriptionid ) = @_;
2058 my $dbh = C4
::Context
->dbh;
2060 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2061 $sth->execute($routingid);
2062 reorder_members
( $subscriptionid, $routingid );
2064 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2065 $sth->execute($subscriptionid);
2070 =head2 getroutinglist
2072 @routinglist = getroutinglist($subscriptionid)
2074 this gets the info from the subscriptionroutinglist for $subscriptionid
2077 the routinglist as an array. Each element of the array contains a hash_ref containing
2078 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2082 sub getroutinglist
{
2083 my ($subscriptionid) = @_;
2084 my $dbh = C4
::Context
->dbh;
2085 my $sth = $dbh->prepare(
2086 'SELECT routingid, borrowernumber, ranking, biblionumber
2088 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2089 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2091 $sth->execute($subscriptionid);
2092 my $routinglist = $sth->fetchall_arrayref({});
2093 return @
{$routinglist};
2096 =head2 countissuesfrom
2098 $result = countissuesfrom($subscriptionid,$startdate)
2100 Returns a count of serial rows matching the given subsctiptionid
2101 with published date greater than startdate
2105 sub countissuesfrom
{
2106 my ( $subscriptionid, $startdate ) = @_;
2107 my $dbh = C4
::Context
->dbh;
2111 WHERE subscriptionid
=?
2112 AND serial
.publisheddate
>?
2114 my $sth = $dbh->prepare($query);
2115 $sth->execute( $subscriptionid, $startdate );
2116 my ($countreceived) = $sth->fetchrow;
2117 return $countreceived;
2122 $result = CountIssues($subscriptionid)
2124 Returns a count of serial rows matching the given subsctiptionid
2129 my ($subscriptionid) = @_;
2130 my $dbh = C4
::Context
->dbh;
2134 WHERE subscriptionid
=?
2136 my $sth = $dbh->prepare($query);
2137 $sth->execute($subscriptionid);
2138 my ($countreceived) = $sth->fetchrow;
2139 return $countreceived;
2144 $result = HasItems($subscriptionid)
2146 returns a count of items from serial matching the subscriptionid
2151 my ($subscriptionid) = @_;
2152 my $dbh = C4
::Context
->dbh;
2154 SELECT COUNT
(serialitems
.itemnumber
)
2156 LEFT JOIN serialitems USING
(serialid
)
2157 WHERE subscriptionid
=? AND serialitems
.serialid IS NOT NULL
2159 my $sth=$dbh->prepare($query);
2160 $sth->execute($subscriptionid);
2161 my ($countitems)=$sth->fetchrow_array();
2165 =head2 abouttoexpire
2167 $result = abouttoexpire($subscriptionid)
2169 this function alerts you to the penultimate issue for a serial subscription
2171 returns 1 - if this is the penultimate issue
2177 my ($subscriptionid) = @_;
2178 my $dbh = C4
::Context
->dbh;
2179 my $subscription = GetSubscription
($subscriptionid);
2180 my $per = $subscription->{'periodicity'};
2181 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($per);
2182 if ($frequency and $frequency->{unit
}){
2184 my $expirationdate = GetExpirationDate
($subscriptionid);
2186 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2187 my $nextdate = GetNextDate
($subscription, $res, $frequency);
2189 # only compare dates if both dates exist.
2190 if ($nextdate and $expirationdate) {
2191 if(Date
::Calc
::Delta_Days
(
2192 split( /-/, $nextdate ),
2193 split( /-/, $expirationdate )
2199 } elsif ( $subscription->{numberlength
} && $subscription->{numberlength
}>0) {
2200 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2206 =head2 GetFictiveIssueNumber
2208 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2210 Get the position of the issue published at $publisheddate, considering the
2211 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2212 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2213 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2214 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2215 depending on how many rows are in serial table.
2216 The issue number calculation is based on subscription frequency, first acquisition
2217 date, and $publisheddate.
2219 Returns undef when called for irregular frequencies.
2221 The routine is used to skip irregularities when calculating the next issue
2222 date (in GetNextDate) or the next issue number (in GetNextSeq).
2226 sub GetFictiveIssueNumber
{
2227 my ($subscription, $publisheddate, $frequency) = @_;
2229 my $unit = $frequency->{unit
} ?
lc $frequency->{'unit'} : undef;
2233 my ( $year, $month, $day ) = split /-/, $publisheddate;
2234 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2235 my $delta = _delta_units
( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2237 if( $frequency->{'unitsperissue'} == 1 ) {
2238 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2239 } else { # issuesperunit == 1
2240 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2246 my ( $date1, $date2, $unit ) = @_;
2247 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2249 if( $unit eq 'day' ) {
2250 return Delta_Days
( @
$date1, @
$date2 );
2251 } elsif( $unit eq 'week' ) {
2252 return int( Delta_Days
( @
$date1, @
$date2 ) / 7 );
2255 # In case of months or years, this is a wrapper around N_Delta_YMD.
2256 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2257 # while we expect 1 month.
2258 my @delta = N_Delta_YMD
( @
$date1, @
$date2 );
2259 if( $delta[2] > 27 ) {
2260 # Check if we could add a month
2261 my @jump = Add_Delta_YM
( @
$date1, $delta[0], 1 + $delta[1] );
2262 if( Delta_Days
( @jump, @
$date2 ) >= 0 ) {
2266 if( $delta[1] >= 12 ) {
2270 # if unit is year, we only return full years
2271 return $unit eq 'month' ?
$delta[0] * 12 + $delta[1] : $delta[0];
2274 sub _get_next_date_day
{
2275 my ($subscription, $freqdata, $year, $month, $day) = @_;
2277 my @newissue; # ( yy, mm, dd )
2278 # We do not need $delta_days here, since it would be zero where used
2280 if( $freqdata->{issuesperunit
} == 1 ) {
2282 @newissue = Add_Delta_Days
(
2283 $year, $month, $day, $freqdata->{"unitsperissue"} );
2284 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2286 @newissue = ( $year, $month, $day );
2287 $subscription->{countissuesperunit
}++;
2289 # We finished a cycle of issues within a unit.
2290 # No subtraction of zero needed, just add one day
2291 @newissue = Add_Delta_Days
( $year, $month, $day, 1 );
2292 $subscription->{countissuesperunit
} = 1;
2297 sub _get_next_date_week
{
2298 my ($subscription, $freqdata, $year, $month, $day) = @_;
2300 my @newissue; # ( yy, mm, dd )
2301 my $delta_days = int( 7 / $freqdata->{issuesperunit
} );
2303 if( $freqdata->{issuesperunit
} == 1 ) {
2304 # Add full weeks (of 7 days)
2305 @newissue = Add_Delta_Days
(
2306 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2307 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2308 # Add rounded number of days based on frequency.
2309 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2310 $subscription->{countissuesperunit
}++;
2312 # We finished a cycle of issues within a unit.
2313 # Subtract delta * (issues - 1), add 1 week
2314 @newissue = Add_Delta_Days
( $year, $month, $day,
2315 -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2316 @newissue = Add_Delta_Days
( @newissue, 7 );
2317 $subscription->{countissuesperunit
} = 1;
2322 sub _get_next_date_month
{
2323 my ($subscription, $freqdata, $year, $month, $day) = @_;
2325 my @newissue; # ( yy, mm, dd )
2326 my $delta_days = int( 30 / $freqdata->{issuesperunit
} );
2328 if( $freqdata->{issuesperunit
} == 1 ) {
2330 @newissue = Add_Delta_YM
(
2331 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2332 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2333 # Add rounded number of days based on frequency.
2334 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2335 $subscription->{countissuesperunit
}++;
2337 # We finished a cycle of issues within a unit.
2338 # Subtract delta * (issues - 1), add 1 month
2339 @newissue = Add_Delta_Days
( $year, $month, $day,
2340 -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2341 @newissue = Add_Delta_YM
( @newissue, 0, 1 );
2342 $subscription->{countissuesperunit
} = 1;
2347 sub _get_next_date_year
{
2348 my ($subscription, $freqdata, $year, $month, $day) = @_;
2350 my @newissue; # ( yy, mm, dd )
2351 my $delta_days = int( 365 / $freqdata->{issuesperunit
} );
2353 if( $freqdata->{issuesperunit
} == 1 ) {
2355 @newissue = Add_Delta_YM
( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2356 } elsif ( $subscription->{countissuesperunit
} < $freqdata->{issuesperunit
} ) {
2357 # Add rounded number of days based on frequency.
2358 @newissue = Add_Delta_Days
( $year, $month, $day, $delta_days );
2359 $subscription->{countissuesperunit
}++;
2361 # We finished a cycle of issues within a unit.
2362 # Subtract delta * (issues - 1), add 1 year
2363 @newissue = Add_Delta_Days
( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit
} - 1) );
2364 @newissue = Add_Delta_YM
( @newissue, 1, 0 );
2365 $subscription->{countissuesperunit
} = 1;
2372 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2374 this function it takes the publisheddate and will return the next issue's date
2375 and will skip dates if there exists an irregularity.
2376 $publisheddate has to be an ISO date
2377 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2378 $frequency is a hashref containing frequency informations
2379 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2380 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2381 skipped then the returned date will be 2007-05-10
2384 $resultdate - then next date in the sequence (ISO date)
2386 Return undef if subscription is irregular
2391 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2393 return unless $subscription and $publisheddate;
2396 if ($freqdata->{'unit'}) {
2397 my ( $year, $month, $day ) = split /-/, $publisheddate;
2399 # Process an irregularity Hash
2400 # Suppose that irregularities are stored in a string with this structure
2401 # irreg1;irreg2;irreg3
2402 # where irregX is the number of issue which will not be received
2403 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2405 if ( $subscription->{irregularity
} ) {
2406 my @irreg = split /;/, $subscription->{'irregularity'} ;
2407 foreach my $irregularity (@irreg) {
2408 $irregularities{$irregularity} = 1;
2412 # Get the 'fictive' next issue number
2413 # It is used to check if next issue is an irregular issue.
2414 my $issueno = GetFictiveIssueNumber
($subscription, $publisheddate, $freqdata) + 1;
2416 # Then get the next date
2417 my $unit = lc $freqdata->{'unit'};
2418 if ($unit eq 'day') {
2419 while ($irregularities{$issueno}) {
2420 ($year, $month, $day) = _get_next_date_day
($subscription,
2421 $freqdata, $year, $month, $day);
2424 ($year, $month, $day) = _get_next_date_day
($subscription, $freqdata,
2425 $year, $month, $day);
2427 elsif ($unit eq 'week') {
2428 while ($irregularities{$issueno}) {
2429 ($year, $month, $day) = _get_next_date_week
($subscription,
2430 $freqdata, $year, $month, $day);
2433 ($year, $month, $day) = _get_next_date_week
($subscription,
2434 $freqdata, $year, $month, $day);
2436 elsif ($unit eq 'month') {
2437 while ($irregularities{$issueno}) {
2438 ($year, $month, $day) = _get_next_date_month
($subscription,
2439 $freqdata, $year, $month, $day);
2442 ($year, $month, $day) = _get_next_date_month
($subscription,
2443 $freqdata, $year, $month, $day);
2445 elsif ($unit eq 'year') {
2446 while ($irregularities{$issueno}) {
2447 ($year, $month, $day) = _get_next_date_year
($subscription,
2448 $freqdata, $year, $month, $day);
2451 ($year, $month, $day) = _get_next_date_year
($subscription,
2452 $freqdata, $year, $month, $day);
2456 my $dbh = C4
::Context
->dbh;
2459 SET countissuesperunit
= ?
2460 WHERE subscriptionid
= ?
2462 my $sth = $dbh->prepare($query);
2463 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2466 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2472 $string = &_numeration($value,$num_type,$locale);
2474 _numeration returns the string corresponding to $value in the num_type
2486 my ($value, $num_type, $locale) = @_;
2491 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2492 # 1970-11-01 was a Sunday
2493 $value = $value % 7;
2494 my $dt = DateTime
->new(
2500 $string = $num_type =~ /^dayname$/
2501 ?
$dt->strftime("%A")
2502 : $dt->strftime("%a");
2503 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2504 $value = $value % 12;
2505 my $dt = DateTime
->new(
2507 month
=> $value + 1,
2510 $string = $num_type =~ /^monthname$/
2511 ?
$dt->strftime("%B")
2512 : $dt->strftime("%b");
2513 } elsif ( $num_type =~ /^season$/ ) {
2514 my @seasons= qw( Spring Summer Fall Winter );
2515 $value = $value % 4;
2516 $string = $seasons[$value];
2517 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2518 my @seasonsabrv= qw( Spr Sum Fal Win );
2519 $value = $value % 4;
2520 $string = $seasonsabrv[$value];
2528 =head2 CloseSubscription
2530 Close a subscription given a subscriptionid
2534 sub CloseSubscription
{
2535 my ( $subscriptionid ) = @_;
2536 return unless $subscriptionid;
2537 my $dbh = C4
::Context
->dbh;
2538 my $sth = $dbh->prepare( q{
2541 WHERE subscriptionid = ?
2543 $sth->execute( $subscriptionid );
2545 # Set status = missing when status = stopped
2546 $sth = $dbh->prepare( q{
2549 WHERE subscriptionid = ?
2552 $sth->execute( STOPPED
, $subscriptionid, EXPECTED
);
2555 =head2 ReopenSubscription
2557 Reopen a subscription given a subscriptionid
2561 sub ReopenSubscription
{
2562 my ( $subscriptionid ) = @_;
2563 return unless $subscriptionid;
2564 my $dbh = C4
::Context
->dbh;
2565 my $sth = $dbh->prepare( q{
2568 WHERE subscriptionid = ?
2570 $sth->execute( $subscriptionid );
2572 # Set status = expected when status = stopped
2573 $sth = $dbh->prepare( q{
2576 WHERE subscriptionid = ?
2579 $sth->execute( EXPECTED
, $subscriptionid, STOPPED
);
2582 =head2 subscriptionCurrentlyOnOrder
2584 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2586 Return 1 if subscription is currently on order else 0.
2590 sub subscriptionCurrentlyOnOrder
{
2591 my ( $subscriptionid ) = @_;
2592 my $dbh = C4
::Context
->dbh;
2594 SELECT COUNT
(*) FROM aqorders
2595 WHERE subscriptionid
= ?
2596 AND datereceived IS NULL
2597 AND datecancellationprinted IS NULL
2599 my $sth = $dbh->prepare( $query );
2600 $sth->execute($subscriptionid);
2601 return $sth->fetchrow_array;
2604 =head2 can_claim_subscription
2606 $can = can_claim_subscription( $subscriptionid[, $userid] );
2608 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2612 sub can_claim_subscription
{
2613 my ( $subscription, $userid ) = @_;
2614 return _can_do_on_subscription
( $subscription, $userid, 'claim_serials' );
2617 =head2 can_edit_subscription
2619 $can = can_edit_subscription( $subscriptionid[, $userid] );
2621 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2625 sub can_edit_subscription
{
2626 my ( $subscription, $userid ) = @_;
2627 return _can_do_on_subscription
( $subscription, $userid, 'edit_subscription' );
2630 =head2 can_show_subscription
2632 $can = can_show_subscription( $subscriptionid[, $userid] );
2634 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2638 sub can_show_subscription
{
2639 my ( $subscription, $userid ) = @_;
2640 return _can_do_on_subscription
( $subscription, $userid, '*' );
2643 sub _can_do_on_subscription
{
2644 my ( $subscription, $userid, $permission ) = @_;
2645 return 0 unless C4
::Context
->userenv;
2646 my $flags = C4
::Context
->userenv->{flags
};
2647 $userid ||= C4
::Context
->userenv->{'id'};
2649 if ( C4
::Context
->preference('IndependentBranches') ) {
2651 if C4
::Context
->IsSuperLibrarian()
2653 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2655 C4
::Auth
::haspermission
( $userid,
2656 { serials
=> $permission } )
2657 and ( not defined $subscription->{branchcode
}
2658 or $subscription->{branchcode
} eq ''
2659 or $subscription->{branchcode
} eq
2660 C4
::Context
->userenv->{'branch'} )
2665 if C4
::Context
->IsSuperLibrarian()
2667 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2668 or C4
::Auth
::haspermission
(
2669 $userid, { serials
=> $permission }
2676 =head2 findSerialsByStatus
2678 @serials = findSerialsByStatus($status, $subscriptionid);
2680 Returns an array of serials matching a given status and subscription id.
2684 sub findSerialsByStatus
{
2685 my ( $status, $subscriptionid ) = @_;
2686 my $dbh = C4
::Context
->dbh;
2687 my $query = q
| SELECT
* from serial
2689 AND subscriptionid
= ?
2691 my $serials = $dbh->selectall_arrayref( $query, { Slice
=> {} }, $status, $subscriptionid );
2700 Koha Development Team <http://koha-community.org/>