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>.
33 use POSIX qw( strftime );
34 use Scalar::Util qw( looks_like_number );
37 use C4::Auth qw( haspermission );
38 use C4::Biblio qw( GetMarcFromKohaField ModBiblio );
40 use C4::Log qw( logaction ); # logaction
41 use C4::Serials::Frequency qw( GetSubscriptionFrequency );
42 use C4::Serials::Numberpattern;
43 use Koha::AdditionalFieldValues;
46 use Koha::SharedContent;
47 use Koha::Subscription::Histories;
48 use Koha::Subscriptions;
49 use Koha::Suggestions;
50 use Koha::TemplateUtils qw( process_tt );
58 MISSING_NEVER_RECIEVED => 41,
59 MISSING_SOLD_OUT => 42,
60 MISSING_DAMAGED => 43,
68 use constant MISSING_STATUSES => (
69 MISSING, MISSING_NEVER_RECIEVED,
70 MISSING_SOLD_OUT, MISSING_DAMAGED,
74 our (@ISA, @EXPORT_OK);
79 NewSubscription ModSubscription DelSubscription
80 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
82 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
83 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
85 GetSubscriptionHistoryFromSubscriptionId
87 GetNextSeq GetSeq NewIssue GetSerials
88 GetLatestSerials ModSerialStatus GetNextDate
89 CloseSubscription ReopenSubscription
90 subscriptionCurrentlyOnOrder
91 can_claim_subscription can_edit_subscription can_show_subscription
93 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
94 GetSerialInformation AddItem2Serial
95 PrepareSerialsData GetNextExpected ModNextExpected
96 GetSubscriptionIrregularities
99 GetSuppliersWithLateIssues
100 getroutinglist delroutingmember addroutingmember
102 check_routing updateClaim
113 C4::Serials - Serials Module Functions
121 Functions for handling subscriptions, claims routing etc.
126 =head2 GetSuppliersWithLateIssues
128 $supplierlist = GetSuppliersWithLateIssues()
130 this function get all suppliers with late issues.
133 an array_ref of suppliers each entry is a hash_ref containing id and name
134 the array is in name order
138 sub GetSuppliersWithLateIssues {
139 my $dbh = C4::Context->dbh;
140 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
142 SELECT DISTINCT id, name
144 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
145 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
148 (planneddate < now() AND serial.status=1)
149 OR serial.STATUS IN ( $statuses )
151 AND subscription.closed = 0
153 return $dbh->selectall_arrayref($query, { Slice => {} });
156 =head2 GetSubscriptionHistoryFromSubscriptionId
158 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
160 This function returns the subscription history as a hashref
164 sub GetSubscriptionHistoryFromSubscriptionId {
165 my ($subscriptionid) = @_;
167 return unless $subscriptionid;
169 my $dbh = C4::Context->dbh;
172 FROM subscriptionhistory
173 WHERE subscriptionid = ?
175 my $sth = $dbh->prepare($query);
176 $sth->execute($subscriptionid);
177 my $results = $sth->fetchrow_hashref;
183 =head2 GetSerialInformation
185 $data = GetSerialInformation($serialid);
186 returns a hash_ref containing :
187 items : items marcrecord (can be an array)
189 subscription table field
190 + information about subscription expiration
194 sub GetSerialInformation {
196 my $dbh = C4::Context->dbh;
198 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
199 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
202 my $rq = $dbh->prepare($query);
203 $rq->execute($serialid);
204 my $data = $rq->fetchrow_hashref;
206 # create item information if we have serialsadditems for this subscription
207 if ( $data->{'serialsadditems'} ) {
208 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
209 $queryitem->execute($serialid);
210 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
212 if ( scalar(@$itemnumbers) > 0 ) {
213 foreach my $itemnum (@$itemnumbers) {
215 #It is ASSUMED that GetMarcItem ALWAYS WORK...
216 #Maybe GetMarcItem should return values on failure
217 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
218 $itemprocessed->{'itemnumber'} = $itemnum->[0];
219 $itemprocessed->{'itemid'} = $itemnum->[0];
220 $itemprocessed->{'serialid'} = $serialid;
221 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
222 push @{ $data->{'items'} }, $itemprocessed;
225 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
226 $itemprocessed->{'itemid'} = "N$serialid";
227 $itemprocessed->{'serialid'} = $serialid;
228 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
229 $itemprocessed->{'countitems'} = 0;
230 push @{ $data->{'items'} }, $itemprocessed;
233 $data->{ "status" . $data->{'serstatus'} } = 1;
234 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
235 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
236 $data->{cannotedit} = not can_edit_subscription( $data );
240 =head2 AddItem2Serial
242 $rows = AddItem2Serial($serialid,$itemnumber);
243 Adds an itemnumber to Serial record
244 returns the number of rows affected
249 my ( $serialid, $itemnumber ) = @_;
251 return unless ($serialid and $itemnumber);
253 my $dbh = C4::Context->dbh;
254 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
255 $rq->execute( $serialid, $itemnumber );
259 =head2 GetSubscription
261 $subs = GetSubscription($subscriptionid)
262 this function returns the subscription which has $subscriptionid as id.
264 a hashref. This hash contains
265 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
269 sub GetSubscription {
270 my ($subscriptionid) = @_;
271 my $dbh = C4::Context->dbh;
273 SELECT subscription.*,
274 subscriptionhistory.*,
275 aqbooksellers.name AS aqbooksellername,
276 biblio.title AS bibliotitle,
277 biblio.subtitle AS bibliosubtitle,
278 subscription.biblionumber as bibnum
280 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
281 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
282 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
283 WHERE subscription.subscriptionid = ?
286 my $sth = $dbh->prepare($query);
287 $sth->execute($subscriptionid);
288 my $subscription = $sth->fetchrow_hashref;
290 return unless $subscription;
292 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
294 if ( my $mana_id = $subscription->{mana_id} ) {
295 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
296 'subscription', $mana_id, {usecomments => 1});
297 $subscription->{comments} = $mana_subscription->{data}->{comments};
300 return $subscription;
303 =head2 GetFullSubscription
305 $array_ref = GetFullSubscription($subscriptionid)
306 this function reads the serial table.
310 sub GetFullSubscription {
311 my ($subscriptionid) = @_;
313 return unless ($subscriptionid);
315 my $dbh = C4::Context->dbh;
317 SELECT serial.serialid,
320 serial.publisheddate,
321 serial.publisheddatetext,
323 serial.notes as notes,
324 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
325 aqbooksellers.name as aqbooksellername,
326 biblio.title as bibliotitle,
327 subscription.branchcode AS branchcode,
328 subscription.subscriptionid AS subscriptionid
330 LEFT JOIN subscription ON
331 (serial.subscriptionid=subscription.subscriptionid )
332 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
333 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
334 WHERE serial.subscriptionid = ?
336 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
337 serial.subscriptionid
339 my $sth = $dbh->prepare($query);
340 $sth->execute($subscriptionid);
341 my $subscriptions = $sth->fetchall_arrayref( {} );
342 if (scalar @$subscriptions) {
343 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
344 for my $subscription ( @$subscriptions ) {
345 $subscription->{cannotedit} = $cannotedit;
349 return $subscriptions;
352 =head2 PrepareSerialsData
354 $array_ref = PrepareSerialsData($serialinfomation)
355 where serialinformation is a hashref array
359 sub PrepareSerialsData {
362 return unless ($lines);
369 my $previousnote = "";
371 foreach my $subs (@{$lines}) {
372 $subs->{ "status" . $subs->{'status'} } = 1;
373 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
374 $subs->{"checked"} = 1;
377 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
378 $year = $subs->{'year'};
382 if ( $tmpresults{$year} ) {
383 push @{ $tmpresults{$year}->{'serials'} }, $subs;
385 $tmpresults{$year} = {
387 'aqbooksellername' => $subs->{'aqbooksellername'},
388 'bibliotitle' => $subs->{'bibliotitle'},
389 'serials' => [$subs],
394 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
395 push @res, $tmpresults{$key};
400 =head2 GetSubscriptionsFromBiblionumber
402 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
403 this function get the subscription list. it reads the subscription table.
405 reference to an array of subscriptions which have the biblionumber given on input arg.
406 each element of this array is a hashref containing
407 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
411 sub GetSubscriptionsFromBiblionumber {
412 my ($biblionumber) = @_;
414 return unless ($biblionumber);
416 my $dbh = C4::Context->dbh;
418 SELECT subscription.*,
420 subscriptionhistory.*,
421 aqbooksellers.name AS aqbooksellername,
422 biblio.title AS bibliotitle
424 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
425 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
426 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
427 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
428 WHERE subscription.biblionumber = ?
430 my $sth = $dbh->prepare($query);
431 $sth->execute($biblionumber);
433 while ( my $subs = $sth->fetchrow_hashref ) {
434 $subs->{opacnote} //= "";
435 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
436 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
437 $subs->{ "status" . $subs->{'status'} } = 1;
439 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
440 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
441 $subs->{cannotedit} = not can_edit_subscription( $subs );
447 =head2 GetFullSubscriptionsFromBiblionumber
449 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
450 this function reads the serial table.
454 sub GetFullSubscriptionsFromBiblionumber {
455 my ($biblionumber) = @_;
456 my $dbh = C4::Context->dbh;
458 SELECT serial.serialid,
461 serial.publisheddate,
462 serial.publisheddatetext,
464 serial.notes as notes,
465 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
466 biblio.title as bibliotitle,
467 subscription.branchcode AS branchcode,
468 subscription.subscriptionid AS subscriptionid,
469 subscription.location AS location
471 LEFT JOIN subscription ON
472 (serial.subscriptionid=subscription.subscriptionid)
473 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
474 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
475 WHERE subscription.biblionumber = ?
477 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
478 serial.subscriptionid
480 my $sth = $dbh->prepare($query);
481 $sth->execute($biblionumber);
482 my $subscriptions = $sth->fetchall_arrayref( {} );
483 if (scalar @$subscriptions) {
484 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
485 for my $subscription ( @$subscriptions ) {
486 $subscription->{cannotedit} = $cannotedit;
490 return $subscriptions;
493 =head2 SearchSubscriptions
495 @results = SearchSubscriptions($args);
497 This function returns a list of hashrefs, one for each subscription
498 that meets the conditions specified by the $args hashref.
500 The valid search fields are:
514 The expiration_date search field is special; it specifies the maximum
515 subscription expiration date.
519 sub SearchSubscriptions {
520 my ( $args, $params ) = @_;
524 my $additional_fields = $args->{additional_fields} // [];
525 my $matching_record_ids_for_additional_fields = [];
526 if ( @$additional_fields ) {
527 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
529 return () unless @subscriptions;
531 $matching_record_ids_for_additional_fields = [ map {
538 subscription.notes AS publicnotes,
539 subscriptionhistory.*,
541 biblio.notes AS biblionotes,
548 aqbooksellers.name AS vendorname,
551 LEFT JOIN subscriptionhistory USING(subscriptionid)
552 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
553 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
554 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
556 $query .= q| WHERE 1|;
559 if( $args->{biblionumber} ) {
560 push @where_strs, "biblio.biblionumber = ?";
561 push @where_args, $args->{biblionumber};
564 if( $args->{title} ){
565 my @words = split / /, $args->{title};
567 foreach my $word (@words) {
568 push @strs, "biblio.title LIKE ?";
569 push @args, "%$word%";
572 push @where_strs, '(' . join (' AND ', @strs) . ')';
573 push @where_args, @args;
577 push @where_strs, "biblioitems.issn LIKE ?";
578 push @where_args, "%$args->{issn}%";
581 push @where_strs, "biblioitems.ean LIKE ?";
582 push @where_args, "%$args->{ean}%";
584 if ( $args->{callnumber} ) {
585 push @where_strs, "subscription.callnumber LIKE ?";
586 push @where_args, "%$args->{callnumber}%";
588 if( $args->{publisher} ){
589 push @where_strs, "biblioitems.publishercode LIKE ?";
590 push @where_args, "%$args->{publisher}%";
592 if( $args->{bookseller} ){
593 push @where_strs, "aqbooksellers.name LIKE ?";
594 push @where_args, "%$args->{bookseller}%";
596 if( $args->{branch} ){
597 push @where_strs, "subscription.branchcode = ?";
598 push @where_args, "$args->{branch}";
600 if ( $args->{location} ) {
601 push @where_strs, "subscription.location = ?";
602 push @where_args, "$args->{location}";
604 if ( $args->{expiration_date} ) {
605 push @where_strs, "subscription.enddate <= ?";
606 push @where_args, "$args->{expiration_date}";
608 if( defined $args->{closed} ){
609 push @where_strs, "subscription.closed = ?";
610 push @where_args, "$args->{closed}";
614 $query .= ' AND ' . join(' AND ', @where_strs);
616 if ( @$additional_fields ) {
617 $query .= ' AND subscriptionid IN ('
618 . join( ', ', @$matching_record_ids_for_additional_fields )
622 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
624 my $dbh = C4::Context->dbh;
625 my $sth = $dbh->prepare($query);
626 $sth->execute(@where_args);
627 my $results = $sth->fetchall_arrayref( {} );
629 my $total_results = @{$results};
631 if ( $params->{results_limit} && $total_results > $params->{results_limit} ) {
632 $results = [ splice( @{$results}, 0, $params->{results_limit} ) ];
635 for my $subscription ( @$results ) {
636 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
637 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
639 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
640 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
641 $subscription_object->additional_field_values->as_list };
645 return wantarray ? @{$results} : { results => $results, total => $total_results };
651 ($totalissues,@serials) = GetSerials($subscriptionid);
652 this function gets every serial not arrived for a given subscription
653 as well as the number of issues registered in the database (all types)
654 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
656 FIXME: We should return \@serials.
661 my ( $subscriptionid, $count ) = @_;
663 return unless $subscriptionid;
665 my $dbh = C4::Context->dbh;
667 # status = 2 is "arrived"
669 $count = 5 unless ($count);
671 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
672 my $query = "SELECT serialid,serialseq, status, publisheddate,
673 publisheddatetext, planneddate,notes, routingnotes
675 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
676 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
677 my $sth = $dbh->prepare($query);
678 $sth->execute($subscriptionid);
680 while ( my $line = $sth->fetchrow_hashref ) {
681 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
682 push @serials, $line;
685 # OK, now add the last 5 issues arrives/missing
686 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
687 publisheddatetext, notes, routingnotes
689 WHERE subscriptionid = ?
690 AND status IN ( $statuses )
691 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
693 $sth = $dbh->prepare($query);
694 $sth->execute($subscriptionid);
695 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
697 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
699 push @serials, $line;
702 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
703 $sth = $dbh->prepare($query);
704 $sth->execute($subscriptionid);
705 my ($totalissues) = $sth->fetchrow;
706 return ( $totalissues, @serials );
711 @serials = GetSerials2($subscriptionid,$statuses);
712 this function returns every serial waited for a given subscription
713 as well as the number of issues registered in the database (all types)
714 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
716 $statuses is an arrayref of statuses and is mandatory.
721 my ( $subscription, $statuses ) = @_;
723 return unless ($subscription and @$statuses);
725 my $dbh = C4::Context->dbh;
727 SELECT serialid,serialseq, status, planneddate, publisheddate,
728 publisheddatetext, notes, routingnotes
730 WHERE subscriptionid=?
732 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
734 ORDER BY publisheddate,serialid DESC
736 my $sth = $dbh->prepare($query);
737 $sth->execute( $subscription, @$statuses );
740 while ( my $line = $sth->fetchrow_hashref ) {
741 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
742 push @serials, $line;
747 =head2 GetLatestSerials
749 \@serials = GetLatestSerials($subscriptionid,$limit)
750 get the $limit's latest serials arrived or missing for a given subscription
752 a ref to an array which contains all of the latest serials stored into a hash.
756 sub GetLatestSerials {
757 my ( $subscriptionid, $limit ) = @_;
759 return unless ($subscriptionid and $limit);
761 my $dbh = C4::Context->dbh;
763 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
764 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, publisheddatetext, notes
766 WHERE subscriptionid = ?
767 AND status IN ($statuses)
768 ORDER BY publisheddate DESC LIMIT 0,$limit
770 my $sth = $dbh->prepare($strsth);
771 $sth->execute($subscriptionid);
773 while ( my $line = $sth->fetchrow_hashref ) {
774 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
775 push @serials, $line;
781 =head2 GetPreviousSerialid
783 $serialid = GetPreviousSerialid($subscriptionid, $nth)
784 get the $nth's previous serial for the given subscriptionid
790 sub GetPreviousSerialid {
791 my ( $subscriptionid, $nth ) = @_;
793 my $dbh = C4::Context->dbh;
797 my $strsth = "SELECT serialid
799 WHERE subscriptionid = ?
801 ORDER BY serialid DESC LIMIT $nth,1
803 my $sth = $dbh->prepare($strsth);
804 $sth->execute($subscriptionid);
806 my $line = $sth->fetchrow_hashref;
807 $return = $line->{'serialid'} if ($line);
815 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
816 $newinnerloop1, $newinnerloop2, $newinnerloop3
817 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
819 $subscription is a hashref containing all the attributes of the table
821 $pattern is a hashref containing all the attributes of the table
822 'subscription_numberpatterns'.
823 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
824 $planneddate is a date string in iso format.
825 This function get the next issue for the subscription given on input arg
830 my ($subscription, $pattern, $frequency, $planneddate) = @_;
832 return unless ($subscription and $pattern);
834 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
835 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
838 if ($subscription->{'skip_serialseq'}) {
839 my @irreg = split /;/, $subscription->{'irregularity'};
841 my $irregularities = {};
842 $irregularities->{$_} = 1 foreach(@irreg);
843 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
844 while($irregularities->{$issueno}) {
851 my $numberingmethod = $pattern->{numberingmethod};
853 if ($numberingmethod) {
854 $calculated = $numberingmethod;
855 my $locale = $subscription->{locale};
856 $newlastvalue1 = $subscription->{lastvalue1} || 0;
857 $newlastvalue2 = $subscription->{lastvalue2} || 0;
858 $newlastvalue3 = $subscription->{lastvalue3} || 0;
859 $newinnerloop1 = $subscription->{innerloop1} || 0;
860 $newinnerloop2 = $subscription->{innerloop2} || 0;
861 $newinnerloop3 = $subscription->{innerloop3} || 0;
864 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
867 for(my $i = 0; $i < $count; $i++) {
869 # check if we have to increase the new value.
871 if ($newinnerloop1 >= $pattern->{every1}) {
873 $newlastvalue1 += $pattern->{add1};
875 # reset counter if needed.
876 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
879 # check if we have to increase the new value.
881 if ($newinnerloop2 >= $pattern->{every2}) {
883 $newlastvalue2 += $pattern->{add2};
885 # reset counter if needed.
886 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
889 # check if we have to increase the new value.
891 if ($newinnerloop3 >= $pattern->{every3}) {
893 $newlastvalue3 += $pattern->{add3};
895 # reset counter if needed.
896 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
900 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
901 $calculated =~ s/\{X\}/$newlastvalue1string/g;
904 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
905 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
908 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
909 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
915 $newlastvalue1, $newlastvalue2, $newlastvalue3,
916 $newinnerloop1, $newinnerloop2, $newinnerloop3);
921 $calculated = GetSeq($subscription, $pattern)
922 $subscription is a hashref containing all the attributes of the table 'subscription'
923 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
924 this function transforms {X},{Y},{Z} to 150,0,0 for example.
926 the sequence in string format
931 my ($subscription, $pattern) = @_;
933 return unless ($subscription and $pattern);
935 my $locale = $subscription->{locale};
937 my $calculated = $pattern->{numberingmethod};
939 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
940 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
941 $calculated =~ s/\{X\}/$newlastvalue1/g;
943 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
944 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
945 $calculated =~ s/\{Y\}/$newlastvalue2/g;
947 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
948 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
949 $calculated =~ s/\{Z\}/$newlastvalue3/g;
953 =head2 GetExpirationDate
955 $enddate = GetExpirationDate($subscriptionid, [$startdate])
957 this function return the next expiration date for a subscription given on input args.
964 sub GetExpirationDate {
965 my ( $subscriptionid, $startdate ) = @_;
967 return unless ($subscriptionid);
969 my $dbh = C4::Context->dbh;
970 my $subscription = GetSubscription($subscriptionid);
973 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
974 $enddate = $startdate || $subscription->{startdate};
975 my @date = split( /-/, $enddate );
977 return if ( scalar(@date) != 3 || not check_date(@date) );
979 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
980 if ( $frequency and $frequency->{unit} ) {
983 if ( my $length = $subscription->{numberlength} ) {
985 #calculate the date of the last issue.
986 for ( my $i = 1 ; $i <= $length ; $i++ ) {
987 $enddate = GetNextDate( $subscription, $enddate, $frequency );
989 } elsif ( $subscription->{monthlength} ) {
990 if ( $$subscription{startdate} ) {
991 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
992 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
994 } elsif ( $subscription->{weeklength} ) {
995 if ( $$subscription{startdate} ) {
996 my @date = split( /-/, $subscription->{startdate} );
997 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
998 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1001 $enddate = $subscription->{enddate};
1005 return $subscription->{enddate};
1009 =head2 CountSubscriptionFromBiblionumber
1011 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1012 this returns a count of the subscriptions for a given biblionumber
1014 the number of subscriptions
1018 sub CountSubscriptionFromBiblionumber {
1019 my ($biblionumber) = @_;
1021 return unless ($biblionumber);
1023 my $dbh = C4::Context->dbh;
1024 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1025 my $sth = $dbh->prepare($query);
1026 $sth->execute($biblionumber);
1027 my $subscriptionsnumber = $sth->fetchrow;
1028 return $subscriptionsnumber;
1031 =head2 ModSubscriptionHistory
1033 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1035 this function modifies the history of a subscription. Put your new values on input arg.
1036 returns the number of rows affected
1040 sub ModSubscriptionHistory {
1041 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1043 return unless ($subscriptionid);
1045 my $dbh = C4::Context->dbh;
1046 my $query = "UPDATE subscriptionhistory
1047 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1048 WHERE subscriptionid=?
1050 my $sth = $dbh->prepare($query);
1051 $receivedlist =~ s/^; // if $receivedlist;
1052 $missinglist =~ s/^; // if $missinglist;
1053 $opacnote =~ s/^; // if $opacnote;
1054 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1058 =head2 ModSerialStatus
1060 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1061 $publisheddatetext, $status, $notes);
1063 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1064 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1068 sub ModSerialStatus {
1069 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1070 $status, $notes) = @_;
1072 return unless ($serialid);
1074 #It is a usual serial
1075 # 1st, get previous status :
1076 my $dbh = C4::Context->dbh;
1077 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1078 FROM serial, subscription
1079 WHERE serial.subscriptionid=subscription.subscriptionid
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($serialid);
1083 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1084 my $frequency = GetSubscriptionFrequency($periodicity);
1086 # change status & update subscriptionhistory
1088 if ( $status == DELETED ) {
1089 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1093 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1094 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1097 $sth = $dbh->prepare($query);
1098 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1099 $planneddate, $status, $notes, $routingnotes, $serialid );
1100 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1101 $sth = $dbh->prepare($query);
1102 $sth->execute($subscriptionid);
1103 my $val = $sth->fetchrow_hashref;
1104 unless ( $val->{manualhistory} ) {
1105 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1106 $sth = $dbh->prepare($query);
1107 $sth->execute($subscriptionid);
1108 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1110 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1111 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1114 # in case serial has been previously marked as missing
1115 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1116 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1119 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1120 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1122 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1123 $sth = $dbh->prepare($query);
1124 $recievedlist =~ s/^; //;
1125 $missinglist =~ s/^; //;
1126 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1130 # create new expected entry if needed (ie : was "expected" and has changed)
1131 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1132 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1133 my $subscription = GetSubscription($subscriptionid);
1134 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1135 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1139 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1140 $newinnerloop1, $newinnerloop2, $newinnerloop3
1142 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1144 # next date (calculated from actual date & frequency parameters)
1145 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1146 my $nextpubdate = $nextpublisheddate;
1147 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1148 WHERE subscriptionid = ?";
1149 $sth = $dbh->prepare($query);
1150 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1151 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1152 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1153 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1154 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1155 require C4::Letters;
1156 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1164 # Adds or removes seqno from list when needed; returns list
1165 # Or checks and returns true when present
1167 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1169 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1171 if( !$op or $op eq 'ADD' ) {
1172 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1173 } elsif( $op eq 'REMOVE' ) {
1174 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1176 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1181 =head2 GetNextExpected
1183 $nextexpected = GetNextExpected($subscriptionid)
1185 Get the planneddate for the current expected issue of the subscription.
1191 planneddate => ISO date
1196 sub GetNextExpected {
1197 my ($subscriptionid) = @_;
1199 my $dbh = C4::Context->dbh;
1203 WHERE subscriptionid = ?
1207 my $sth = $dbh->prepare($query);
1209 # Each subscription has only one 'expected' issue.
1210 $sth->execute( $subscriptionid, EXPECTED );
1211 my $nextissue = $sth->fetchrow_hashref;
1212 if ( !$nextissue ) {
1216 WHERE subscriptionid = ?
1217 ORDER BY publisheddate DESC
1220 $sth = $dbh->prepare($query);
1221 $sth->execute($subscriptionid);
1222 $nextissue = $sth->fetchrow_hashref;
1224 foreach(qw/planneddate publisheddate/) {
1225 # or should this default to 1st Jan ???
1226 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
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, $ccode, $published_on_template
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,
1349 published_on_template => $published_on_template,
1352 # FIXME Must be $subscription->serials
1353 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1354 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1356 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1358 $subscription->discard_changes;
1359 return $subscription;
1362 =head2 NewSubscription
1364 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1365 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1366 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1367 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1368 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1369 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1370 $skip_serialseq, $itemtype, $previousitemtype);
1372 Create a new subscription with value given on input args.
1375 the id of this new subscription
1379 sub NewSubscription {
1381 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1382 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1383 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1384 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1385 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1386 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1387 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode,
1388 $published_on_template,
1390 my $dbh = C4::Context->dbh;
1392 my $subscription = Koha::Subscription->new(
1394 librarian => $auser,
1395 branchcode => $branchcode,
1396 aqbooksellerid => $aqbooksellerid,
1398 aqbudgetid => $aqbudgetid,
1399 biblionumber => $biblionumber,
1400 startdate => $startdate,
1401 periodicity => $periodicity,
1402 numberlength => $numberlength,
1403 weeklength => $weeklength,
1404 monthlength => $monthlength,
1405 lastvalue1 => $lastvalue1,
1406 innerloop1 => $innerloop1,
1407 lastvalue2 => $lastvalue2,
1408 innerloop2 => $innerloop2,
1409 lastvalue3 => $lastvalue3,
1410 innerloop3 => $innerloop3,
1414 firstacquidate => $firstacquidate,
1415 irregularity => $irregularity,
1416 numberpattern => $numberpattern,
1418 callnumber => $callnumber,
1419 manualhistory => $manualhistory,
1420 internalnotes => $internalnotes,
1421 serialsadditems => $serialsadditems,
1422 staffdisplaycount => $staffdisplaycount,
1423 opacdisplaycount => $opacdisplaycount,
1424 graceperiod => $graceperiod,
1425 location => $location,
1426 enddate => $enddate,
1427 skip_serialseq => $skip_serialseq,
1428 itemtype => $itemtype,
1429 previousitemtype => $previousitemtype,
1430 mana_id => $mana_id,
1432 published_on_template => $published_on_template,
1435 $subscription->discard_changes;
1436 my $subscriptionid = $subscription->subscriptionid;
1437 my ( $query, $sth );
1439 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1443 WHERE subscriptionid=?
1445 $sth = $dbh->prepare($query);
1446 $sth->execute( $enddate, $subscriptionid );
1449 # then create the 1st expected number
1451 INSERT INTO subscriptionhistory
1452 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1453 VALUES (?,?,?, '', '')
1455 $sth = $dbh->prepare($query);
1456 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1458 # reread subscription to get a hash (for calculation of the 1st issue number)
1459 $subscription = GetSubscription($subscriptionid); # We should not do that
1460 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1462 # calculate issue number
1463 my $serialseq = GetSeq($subscription, $pattern) || q{};
1467 serialseq => $serialseq,
1468 serialseq_x => $subscription->{'lastvalue1'},
1469 serialseq_y => $subscription->{'lastvalue2'},
1470 serialseq_z => $subscription->{'lastvalue3'},
1471 subscriptionid => $subscriptionid,
1472 biblionumber => $biblionumber,
1474 planneddate => $firstacquidate,
1475 publisheddate => $firstacquidate,
1479 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1481 #set serial flag on biblio if not already set.
1482 my $biblio = Koha::Biblios->find( $biblionumber );
1483 if ( $biblio and !$biblio->serial ) {
1484 my $record = $biblio->metadata->record;
1485 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1487 eval { $record->field($tag)->update( $subf => 1 ); };
1489 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1491 return $subscriptionid;
1494 =head2 GetSubscriptionLength
1496 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1498 This function calculates the subscription length.
1502 sub GetSubscriptionLength {
1503 my ($subtype, $length) = @_;
1505 return unless looks_like_number($length);
1509 $subtype eq 'issues' ? $length : 0,
1510 $subtype eq 'weeks' ? $length : 0,
1511 $subtype eq 'months' ? $length : 0,
1516 =head2 ReNewSubscription
1518 ReNewSubscription($params);
1520 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1522 this function renew a subscription with values given on input args.
1526 sub ReNewSubscription {
1527 my ( $params ) = @_;
1528 my $subscriptionid = $params->{subscriptionid};
1529 my $user = $params->{user};
1530 my $startdate = $params->{startdate};
1531 my $numberlength = $params->{numberlength};
1532 my $weeklength = $params->{weeklength};
1533 my $monthlength = $params->{monthlength};
1534 my $note = $params->{note};
1535 my $branchcode = $params->{branchcode};
1537 my $dbh = C4::Context->dbh;
1538 my $subscription = GetSubscription($subscriptionid);
1542 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1543 WHERE biblio.biblionumber=?
1545 my $sth = $dbh->prepare($query);
1546 $sth->execute( $subscription->{biblionumber} );
1547 my $biblio = $sth->fetchrow_hashref;
1549 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1550 Koha::Suggestion->new(
1552 'suggestedby' => $user,
1553 'title' => $subscription->{bibliotitle},
1554 'author' => $biblio->{author},
1555 'publishercode' => $biblio->{publishercode},
1557 'biblionumber' => $subscription->{biblionumber},
1558 'branchcode' => $branchcode,
1563 $numberlength ||= 0; # Should not we raise an exception instead?
1566 # renew subscription
1569 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1570 WHERE subscriptionid=?
1572 $sth = $dbh->prepare($query);
1573 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1574 my $enddate = GetExpirationDate($subscriptionid);
1578 WHERE subscriptionid=?
1580 $sth = $dbh->prepare($query);
1581 $sth->execute( $enddate, $subscriptionid );
1583 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1589 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1591 Create a new issue stored on the database.
1592 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1593 returns the serial id
1598 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1599 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1600 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1602 return unless ($subscriptionid);
1604 my $schema = Koha::Database->new()->schema();
1606 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1608 if ( my $template = $subscription->published_on_template ) {
1609 $publisheddatetext = process_tt(
1612 subscription => $subscription,
1613 serialseq => $serialseq,
1614 serialseq_x => $subscription->lastvalue1(),
1615 serialseq_y => $subscription->lastvalue2(),
1616 serialseq_z => $subscription->lastvalue3(),
1617 subscriptionid => $subscriptionid,
1618 biblionumber => $biblionumber,
1620 planneddate => $planneddate,
1621 publisheddate => $publisheddate,
1622 publisheddatetext => $publisheddatetext,
1624 routingnotes => $routingnotes,
1629 my $serial = Koha::Serial->new(
1631 serialseq => $serialseq,
1632 serialseq_x => $subscription->lastvalue1(),
1633 serialseq_y => $subscription->lastvalue2(),
1634 serialseq_z => $subscription->lastvalue3(),
1635 subscriptionid => $subscriptionid,
1636 biblionumber => $biblionumber,
1638 planneddate => $planneddate,
1639 publisheddate => $publisheddate,
1640 publisheddatetext => $publisheddatetext,
1642 routingnotes => $routingnotes,
1646 my $serialid = $serial->id();
1648 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1649 my $missinglist = $subscription_history->missinglist();
1650 my $recievedlist = $subscription_history->recievedlist();
1652 if ( $status == ARRIVED ) {
1653 ### TODO Add a feature that improves recognition and description.
1654 ### As such count (serialseq) i.e. : N18,2(N19),N20
1655 ### Would use substr and index But be careful to previous presence of ()
1656 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1658 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1659 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1662 $recievedlist =~ s/^; //;
1663 $missinglist =~ s/^; //;
1665 $subscription_history->recievedlist($recievedlist);
1666 $subscription_history->missinglist($missinglist);
1667 $subscription_history->store();
1672 =head2 HasSubscriptionStrictlyExpired
1674 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1676 the subscription has stricly expired when today > the end subscription date
1679 1 if true, 0 if false, -1 if the expiration date is not set.
1683 sub HasSubscriptionStrictlyExpired {
1685 # Getting end of subscription date
1686 my ($subscriptionid) = @_;
1688 return unless ($subscriptionid);
1690 my $dbh = C4::Context->dbh;
1691 my $subscription = GetSubscription($subscriptionid);
1692 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1694 # If the expiration date is set
1695 if ( $expirationdate != 0 ) {
1696 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1698 # Getting today's date
1699 my ( $nowyear, $nowmonth, $nowday ) = Today();
1701 # if today's date > expiration date, then the subscription has stricly expired
1702 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1709 # There are some cases where the expiration date is not set
1710 # As we can't determine if the subscription has expired on a date-basis,
1716 =head2 HasSubscriptionExpired
1718 $has_expired = HasSubscriptionExpired($subscriptionid)
1720 the subscription has expired when the next issue to arrive is out of subscription limit.
1723 0 if the subscription has not expired
1724 1 if the subscription has expired
1725 2 if has subscription does not have a valid expiration date set
1729 sub HasSubscriptionExpired {
1730 my ($subscriptionid) = @_;
1732 return unless ($subscriptionid);
1734 my $dbh = C4::Context->dbh;
1735 my $subscription = GetSubscription($subscriptionid);
1736 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1737 if ( $frequency and $frequency->{unit} ) {
1738 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1739 if (!defined $expirationdate) {
1740 $expirationdate = q{};
1743 SELECT max(planneddate)
1745 WHERE subscriptionid=?
1747 my $sth = $dbh->prepare($query);
1748 $sth->execute($subscriptionid);
1749 my ($res) = $sth->fetchrow;
1750 if (!$res || $res=~m/^0000/) {
1753 my @res = split( /-/, $res );
1754 my @endofsubscriptiondate = split( /-/, $expirationdate );
1755 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1757 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1762 if ( $subscription->{'numberlength'} ) {
1763 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1764 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1770 return 0; # Notice that you'll never get here.
1773 =head2 DelSubscription
1775 DelSubscription($subscriptionid)
1776 this function deletes subscription which has $subscriptionid as id.
1780 sub DelSubscription {
1781 my ($subscriptionid) = @_;
1782 my $dbh = C4::Context->dbh;
1783 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1785 Koha::AdditionalFieldValues->search({
1786 'field.tablename' => 'subscription',
1787 'me.record_id' => $subscriptionid,
1788 }, { join => 'field' })->delete;
1790 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1795 DelIssue($serialseq,$subscriptionid)
1796 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1798 returns the number of rows affected
1803 my ($dataissue) = @_;
1804 my $dbh = C4::Context->dbh;
1805 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1810 AND subscriptionid= ?
1812 my $mainsth = $dbh->prepare($query);
1813 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1815 #Delete element from subscription history
1816 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1817 my $sth = $dbh->prepare($query);
1818 $sth->execute( $dataissue->{'subscriptionid'} );
1819 my $val = $sth->fetchrow_hashref;
1820 unless ( $val->{manualhistory} ) {
1822 SELECT * FROM subscriptionhistory
1823 WHERE subscriptionid= ?
1825 my $sth = $dbh->prepare($query);
1826 $sth->execute( $dataissue->{'subscriptionid'} );
1827 my $data = $sth->fetchrow_hashref;
1828 my $serialseq = $dataissue->{'serialseq'};
1829 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1830 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1831 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1832 $sth = $dbh->prepare($strsth);
1833 $sth->execute( $dataissue->{'subscriptionid'} );
1836 return $mainsth->rows;
1839 =head2 GetLateOrMissingIssues
1841 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1843 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1846 the issuelist as an array of hash refs. Each element of this array contains
1847 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1851 sub GetLateOrMissingIssues {
1852 my ( $supplierid, $serialid, $order ) = @_;
1854 return unless ( $supplierid or $serialid );
1856 my $dbh = C4::Context->dbh;
1861 $byserial = "and serialid = " . $serialid;
1864 $order .= ", title";
1868 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1870 $sth = $dbh->prepare(
1872 serialid, aqbooksellerid, name,
1873 biblio.title, biblioitems.issn, planneddate, serialseq,
1874 serial.status, serial.subscriptionid, claimdate, claims_count,
1875 subscription.branchcode, serial.publisheddate
1877 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1878 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1879 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1880 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1881 WHERE subscription.subscriptionid = serial.subscriptionid
1882 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1883 AND subscription.aqbooksellerid=$supplierid
1888 $sth = $dbh->prepare(
1890 serialid, aqbooksellerid, name,
1891 biblio.title, planneddate, serialseq,
1892 serial.status, serial.subscriptionid, claimdate, claims_count,
1893 subscription.branchcode, serial.publisheddate
1895 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1896 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1897 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1898 WHERE subscription.subscriptionid = serial.subscriptionid
1899 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1904 $sth->execute( EXPECTED, LATE, CLAIMED );
1906 while ( my $line = $sth->fetchrow_hashref ) {
1907 $line->{"status".$line->{status}} = 1;
1909 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1910 $line->{additional_fields} = { map { $_->field->name => $_->value }
1911 $subscription_object->additional_field_values->as_list };
1913 push @issuelist, $line;
1920 &updateClaim($serialid)
1922 this function updates the time when a claim is issued for late/missing items
1924 called from claims.pl file
1929 my ($serialids) = @_;
1930 return unless $serialids;
1931 unless ( ref $serialids ) {
1932 $serialids = [ $serialids ];
1935 foreach my $serialid(@$serialids) {
1936 my $serial = Koha::Serials->find($serialid);
1938 C4::Serials::ModSerialStatus(
1941 $serial->planneddate,
1942 $serial->publisheddate,
1943 $serial->publisheddatetext,
1944 C4::Serials->CLAIMED,
1949 my $dbh = C4::Context->dbh;
1952 SET claimdate = NOW(),
1953 claims_count = claims_count + 1,
1955 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1956 {}, CLAIMED, @$serialids );
1959 =head2 check_routing
1961 $result = &check_routing($subscriptionid)
1963 this function checks to see if a serial has a routing list and returns the count of routingid
1964 used to show either an 'add' or 'edit' link
1969 my ($subscriptionid) = @_;
1971 return unless ($subscriptionid);
1973 my $dbh = C4::Context->dbh;
1974 my $sth = $dbh->prepare(
1975 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1976 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1977 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1980 $sth->execute($subscriptionid);
1981 my $line = $sth->fetchrow_hashref;
1982 my $result = $line->{'routingids'};
1986 =head2 addroutingmember
1988 addroutingmember($borrowernumber,$subscriptionid)
1990 this function takes a borrowernumber and subscriptionid and adds the member to the
1991 routing list for that serial subscription and gives them a rank on the list
1992 of either 1 or highest current rank + 1
1996 sub addroutingmember {
1997 my ( $borrowernumber, $subscriptionid ) = @_;
1999 return unless ($borrowernumber and $subscriptionid);
2002 my $dbh = C4::Context->dbh;
2003 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2004 $sth->execute($subscriptionid);
2005 while ( my $line = $sth->fetchrow_hashref ) {
2006 if ( $line->{'rank'} > 0 ) {
2007 $rank = $line->{'rank'} + 1;
2012 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2013 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2016 =head2 reorder_members
2018 reorder_members($subscriptionid,$routingid,$rank)
2020 this function is used to reorder the routing list
2022 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2023 - it gets all members on list puts their routingid's into an array
2024 - removes the one in the array that is $routingid
2025 - then reinjects $routingid at point indicated by $rank
2026 - then update the database with the routingids in the new order
2030 sub reorder_members {
2031 my ( $subscriptionid, $routingid, $rank ) = @_;
2032 my $dbh = C4::Context->dbh;
2033 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2034 $sth->execute($subscriptionid);
2036 while ( my $line = $sth->fetchrow_hashref ) {
2037 push( @result, $line->{'routingid'} );
2040 # To find the matching index
2042 my $key = -1; # to allow for 0 being a valid response
2043 for ( $i = 0 ; $i < @result ; $i++ ) {
2044 if ( $routingid == $result[$i] ) {
2045 $key = $i; # save the index
2050 # if index exists in array then move it to new position
2051 if ( $key > -1 && $rank > 0 ) {
2052 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2053 my $moving_item = splice( @result, $key, 1 );
2054 splice( @result, $new_rank, 0, $moving_item );
2056 for ( my $j = 0 ; $j < @result ; $j++ ) {
2057 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2063 =head2 delroutingmember
2065 delroutingmember($routingid,$subscriptionid)
2067 this function either deletes one member from routing list if $routingid exists otherwise
2068 deletes all members from the routing list
2072 sub delroutingmember {
2074 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2075 my ( $routingid, $subscriptionid ) = @_;
2076 my $dbh = C4::Context->dbh;
2078 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2079 $sth->execute($routingid);
2080 reorder_members( $subscriptionid, $routingid );
2082 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2083 $sth->execute($subscriptionid);
2088 =head2 getroutinglist
2090 @routinglist = getroutinglist($subscriptionid)
2092 this gets the info from the subscriptionroutinglist for $subscriptionid
2095 the routinglist as an array. Each element of the array contains a hash_ref containing
2096 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2100 sub getroutinglist {
2101 my ($subscriptionid) = @_;
2102 my $dbh = C4::Context->dbh;
2103 my $sth = $dbh->prepare(
2104 'SELECT routingid, borrowernumber, ranking, biblionumber
2106 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2107 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2109 $sth->execute($subscriptionid);
2110 my $routinglist = $sth->fetchall_arrayref({});
2111 return @{$routinglist};
2114 =head2 countissuesfrom
2116 $result = countissuesfrom($subscriptionid,$startdate)
2118 Returns a count of serial rows matching the given subsctiptionid
2119 with published date greater than startdate
2123 sub countissuesfrom {
2124 my ( $subscriptionid, $startdate ) = @_;
2125 my $dbh = C4::Context->dbh;
2129 WHERE subscriptionid=?
2130 AND serial.publisheddate>?
2132 my $sth = $dbh->prepare($query);
2133 $sth->execute( $subscriptionid, $startdate );
2134 my ($countreceived) = $sth->fetchrow;
2135 return $countreceived;
2140 $result = CountIssues($subscriptionid)
2142 Returns a count of serial rows matching the given subsctiptionid
2147 my ($subscriptionid) = @_;
2148 my $dbh = C4::Context->dbh;
2152 WHERE subscriptionid=?
2154 my $sth = $dbh->prepare($query);
2155 $sth->execute($subscriptionid);
2156 my ($countreceived) = $sth->fetchrow;
2157 return $countreceived;
2162 $result = HasItems($subscriptionid)
2164 returns a count of items from serial matching the subscriptionid
2169 my ($subscriptionid) = @_;
2170 my $dbh = C4::Context->dbh;
2172 SELECT COUNT(serialitems.itemnumber)
2174 LEFT JOIN serialitems USING(serialid)
2175 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2177 my $sth=$dbh->prepare($query);
2178 $sth->execute($subscriptionid);
2179 my ($countitems)=$sth->fetchrow_array();
2183 =head2 abouttoexpire
2185 $result = abouttoexpire($subscriptionid)
2187 this function alerts you to the penultimate issue for a serial subscription
2189 returns 1 - if this is the penultimate issue
2195 my ($subscriptionid) = @_;
2196 my $dbh = C4::Context->dbh;
2197 my $subscription = GetSubscription($subscriptionid);
2198 my $per = $subscription->{'periodicity'};
2199 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2200 if ($frequency and $frequency->{unit}){
2202 my $expirationdate = GetExpirationDate($subscriptionid);
2204 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2205 my $nextdate = GetNextDate($subscription, $res, $frequency);
2207 # only compare dates if both dates exist.
2208 if ($nextdate and $expirationdate) {
2209 if(Date::Calc::Delta_Days(
2210 split( /-/, $nextdate ),
2211 split( /-/, $expirationdate )
2217 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2218 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2224 =head2 GetFictiveIssueNumber
2226 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2228 Get the position of the issue published at $publisheddate, considering the
2229 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2230 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2231 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2232 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2233 depending on how many rows are in serial table.
2234 The issue number calculation is based on subscription frequency, first acquisition
2235 date, and $publisheddate.
2237 Returns undef when called for irregular frequencies.
2239 The routine is used to skip irregularities when calculating the next issue
2240 date (in GetNextDate) or the next issue number (in GetNextSeq).
2244 sub GetFictiveIssueNumber {
2245 my ($subscription, $publisheddate, $frequency) = @_;
2247 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2251 my ( $year, $month, $day ) = split /-/, $publisheddate;
2252 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2253 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2255 if( $frequency->{'unitsperissue'} == 1 ) {
2256 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2257 } else { # issuesperunit == 1
2258 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2264 my ( $date1, $date2, $unit ) = @_;
2265 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2267 if( $unit eq 'day' ) {
2268 return Delta_Days( @$date1, @$date2 );
2269 } elsif( $unit eq 'week' ) {
2270 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2273 # In case of months or years, this is a wrapper around N_Delta_YMD.
2274 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2275 # while we expect 1 month.
2276 my @delta = N_Delta_YMD( @$date1, @$date2 );
2277 if( $delta[2] > 27 ) {
2278 # Check if we could add a month
2279 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2280 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2284 if( $delta[1] >= 12 ) {
2288 # if unit is year, we only return full years
2289 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2292 sub _get_next_date_day {
2293 my ($subscription, $freqdata, $year, $month, $day) = @_;
2295 my @newissue; # ( yy, mm, dd )
2296 # We do not need $delta_days here, since it would be zero where used
2298 if( $freqdata->{issuesperunit} == 1 ) {
2300 @newissue = Add_Delta_Days(
2301 $year, $month, $day, $freqdata->{"unitsperissue"} );
2302 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2304 @newissue = ( $year, $month, $day );
2305 $subscription->{countissuesperunit}++;
2307 # We finished a cycle of issues within a unit.
2308 # No subtraction of zero needed, just add one day
2309 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2310 $subscription->{countissuesperunit} = 1;
2315 sub _get_next_date_week {
2316 my ($subscription, $freqdata, $year, $month, $day) = @_;
2318 my @newissue; # ( yy, mm, dd )
2319 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2321 if( $freqdata->{issuesperunit} == 1 ) {
2322 # Add full weeks (of 7 days)
2323 @newissue = Add_Delta_Days(
2324 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2325 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2326 # Add rounded number of days based on frequency.
2327 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2328 $subscription->{countissuesperunit}++;
2330 # We finished a cycle of issues within a unit.
2331 # Subtract delta * (issues - 1), add 1 week
2332 @newissue = Add_Delta_Days( $year, $month, $day,
2333 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2334 @newissue = Add_Delta_Days( @newissue, 7 );
2335 $subscription->{countissuesperunit} = 1;
2340 sub _get_next_date_month {
2341 my ($subscription, $freqdata, $year, $month, $day) = @_;
2343 my @newissue; # ( yy, mm, dd )
2344 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2346 if( $freqdata->{issuesperunit} == 1 ) {
2348 @newissue = Add_Delta_YM(
2349 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2350 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2351 # Add rounded number of days based on frequency.
2352 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2353 $subscription->{countissuesperunit}++;
2355 # We finished a cycle of issues within a unit.
2356 # Subtract delta * (issues - 1), add 1 month
2357 @newissue = Add_Delta_Days( $year, $month, $day,
2358 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2359 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2360 $subscription->{countissuesperunit} = 1;
2365 sub _get_next_date_year {
2366 my ($subscription, $freqdata, $year, $month, $day) = @_;
2368 my @newissue; # ( yy, mm, dd )
2369 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2371 if( $freqdata->{issuesperunit} == 1 ) {
2373 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2374 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2375 # Add rounded number of days based on frequency.
2376 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2377 $subscription->{countissuesperunit}++;
2379 # We finished a cycle of issues within a unit.
2380 # Subtract delta * (issues - 1), add 1 year
2381 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2382 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2383 $subscription->{countissuesperunit} = 1;
2390 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2392 this function it takes the publisheddate and will return the next issue's date
2393 and will skip dates if there exists an irregularity.
2394 $publisheddate has to be an ISO date
2395 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2396 $frequency is a hashref containing frequency informations
2397 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2398 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2399 skipped then the returned date will be 2007-05-10
2402 $resultdate - then next date in the sequence (ISO date)
2404 Return undef if subscription is irregular
2409 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2411 return unless $subscription and $publisheddate;
2414 if ($freqdata->{'unit'}) {
2415 my ( $year, $month, $day ) = split /-/, $publisheddate;
2417 # Process an irregularity Hash
2418 # Suppose that irregularities are stored in a string with this structure
2419 # irreg1;irreg2;irreg3
2420 # where irregX is the number of issue which will not be received
2421 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2423 if ( $subscription->{irregularity} ) {
2424 my @irreg = split /;/, $subscription->{'irregularity'} ;
2425 foreach my $irregularity (@irreg) {
2426 $irregularities{$irregularity} = 1;
2430 # Get the 'fictive' next issue number
2431 # It is used to check if next issue is an irregular issue.
2432 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2434 # Then get the next date
2435 my $unit = lc $freqdata->{'unit'};
2436 if ($unit eq 'day') {
2437 while ($irregularities{$issueno}) {
2438 ($year, $month, $day) = _get_next_date_day($subscription,
2439 $freqdata, $year, $month, $day);
2442 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2443 $year, $month, $day);
2445 elsif ($unit eq 'week') {
2446 while ($irregularities{$issueno}) {
2447 ($year, $month, $day) = _get_next_date_week($subscription,
2448 $freqdata, $year, $month, $day);
2451 ($year, $month, $day) = _get_next_date_week($subscription,
2452 $freqdata, $year, $month, $day);
2454 elsif ($unit eq 'month') {
2455 while ($irregularities{$issueno}) {
2456 ($year, $month, $day) = _get_next_date_month($subscription,
2457 $freqdata, $year, $month, $day);
2460 ($year, $month, $day) = _get_next_date_month($subscription,
2461 $freqdata, $year, $month, $day);
2463 elsif ($unit eq 'year') {
2464 while ($irregularities{$issueno}) {
2465 ($year, $month, $day) = _get_next_date_year($subscription,
2466 $freqdata, $year, $month, $day);
2469 ($year, $month, $day) = _get_next_date_year($subscription,
2470 $freqdata, $year, $month, $day);
2474 my $dbh = C4::Context->dbh;
2477 SET countissuesperunit = ?
2478 WHERE subscriptionid = ?
2480 my $sth = $dbh->prepare($query);
2481 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2484 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2490 $string = &_numeration($value,$num_type,$locale);
2492 _numeration returns the string corresponding to $value in the num_type
2504 my ($value, $num_type, $locale) = @_;
2509 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2510 # 1970-11-01 was a Sunday
2511 $value = $value % 7;
2512 my $dt = DateTime->new(
2518 $string = $num_type =~ /^dayname$/
2519 ? $dt->strftime("%A")
2520 : $dt->strftime("%a");
2521 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2522 $value = $value % 12;
2523 my $dt = DateTime->new(
2525 month => $value + 1,
2528 $string = $num_type =~ /^monthname$/
2529 ? $dt->format_cldr( "LLLL" )
2530 : $dt->strftime("%b");
2531 } elsif ( $num_type =~ /^season$/ ) {
2532 my @seasons= qw( Spring Summer Fall Winter );
2533 $value = $value % 4;
2534 $string = $seasons[$value];
2535 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2536 my @seasonsabrv= qw( Spr Sum Fal Win );
2537 $value = $value % 4;
2538 $string = $seasonsabrv[$value];
2546 =head2 CloseSubscription
2548 Close a subscription given a subscriptionid
2552 sub CloseSubscription {
2553 my ( $subscriptionid ) = @_;
2554 return unless $subscriptionid;
2555 my $dbh = C4::Context->dbh;
2556 my $sth = $dbh->prepare( q{
2559 WHERE subscriptionid = ?
2561 $sth->execute( $subscriptionid );
2563 # Set status = missing when status = stopped
2564 $sth = $dbh->prepare( q{
2567 WHERE subscriptionid = ?
2570 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2573 =head2 ReopenSubscription
2575 Reopen a subscription given a subscriptionid
2579 sub ReopenSubscription {
2580 my ( $subscriptionid ) = @_;
2581 return unless $subscriptionid;
2582 my $dbh = C4::Context->dbh;
2583 my $sth = $dbh->prepare( q{
2586 WHERE subscriptionid = ?
2588 $sth->execute( $subscriptionid );
2590 # Set status = expected when status = stopped
2591 $sth = $dbh->prepare( q{
2594 WHERE subscriptionid = ?
2597 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2600 =head2 subscriptionCurrentlyOnOrder
2602 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2604 Return 1 if subscription is currently on order else 0.
2608 sub subscriptionCurrentlyOnOrder {
2609 my ( $subscriptionid ) = @_;
2610 my $dbh = C4::Context->dbh;
2612 SELECT COUNT(*) FROM aqorders
2613 WHERE subscriptionid = ?
2614 AND datereceived IS NULL
2615 AND datecancellationprinted IS NULL
2617 my $sth = $dbh->prepare( $query );
2618 $sth->execute($subscriptionid);
2619 return $sth->fetchrow_array;
2622 =head2 can_claim_subscription
2624 $can = can_claim_subscription( $subscriptionid[, $userid] );
2626 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2630 sub can_claim_subscription {
2631 my ( $subscription, $userid ) = @_;
2632 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2635 =head2 can_edit_subscription
2637 $can = can_edit_subscription( $subscriptionid[, $userid] );
2639 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2643 sub can_edit_subscription {
2644 my ( $subscription, $userid ) = @_;
2645 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2648 =head2 can_show_subscription
2650 $can = can_show_subscription( $subscriptionid[, $userid] );
2652 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2656 sub can_show_subscription {
2657 my ( $subscription, $userid ) = @_;
2658 return _can_do_on_subscription( $subscription, $userid, '*' );
2661 sub _can_do_on_subscription {
2662 my ( $subscription, $userid, $permission ) = @_;
2663 return 0 unless C4::Context->userenv;
2664 my $flags = C4::Context->userenv->{flags};
2665 $userid ||= C4::Context->userenv->{'id'};
2667 if ( C4::Context->preference('IndependentBranches') ) {
2669 if C4::Context->IsSuperLibrarian()
2671 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2673 C4::Auth::haspermission( $userid,
2674 { serials => $permission } )
2675 and ( not defined $subscription->{branchcode}
2676 or $subscription->{branchcode} eq ''
2677 or $subscription->{branchcode} eq
2678 C4::Context->userenv->{'branch'} )
2683 if C4::Context->IsSuperLibrarian()
2685 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2686 or C4::Auth::haspermission(
2687 $userid, { serials => $permission }
2694 =head2 findSerialsByStatus
2696 @serials = findSerialsByStatus($status, $subscriptionid);
2698 Returns an array of serials matching a given status and subscription id.
2702 sub findSerialsByStatus {
2703 my ( $status, $subscriptionid ) = @_;
2704 my $dbh = C4::Context->dbh;
2705 my $query = q| SELECT * from serial
2707 AND subscriptionid = ?
2709 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2718 Koha Development Team <http://koha-community.org/>