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 );
34 use POSIX qw( strftime );
35 use C4::Biblio qw( GetMarcBiblio GetMarcFromKohaField ModBiblio );
36 use C4::Log qw( logaction ); # logaction
37 use C4::Serials::Frequency qw( GetSubscriptionFrequency );
38 use C4::Serials::Numberpattern;
39 use Koha::AdditionalFieldValues;
40 use Koha::DateUtils qw( dt_from_string output_pref );
42 use Koha::Subscriptions;
43 use Koha::Subscription::Histories;
44 use Koha::SharedContent;
45 use Scalar::Util qw( looks_like_number );
53 MISSING_NEVER_RECIEVED => 41,
54 MISSING_SOLD_OUT => 42,
55 MISSING_DAMAGED => 43,
63 use constant MISSING_STATUSES => (
64 MISSING, MISSING_NEVER_RECIEVED,
65 MISSING_SOLD_OUT, MISSING_DAMAGED,
69 our (@ISA, @EXPORT_OK);
74 NewSubscription ModSubscription DelSubscription
75 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
77 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
78 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
80 GetSubscriptionHistoryFromSubscriptionId
82 GetNextSeq GetSeq NewIssue GetSerials
83 GetLatestSerials ModSerialStatus GetNextDate
84 CloseSubscription ReopenSubscription
85 subscriptionCurrentlyOnOrder
86 can_claim_subscription can_edit_subscription can_show_subscription
88 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
89 GetSerialInformation AddItem2Serial
90 PrepareSerialsData GetNextExpected ModNextExpected
91 GetSubscriptionIrregularities
94 GetSuppliersWithLateIssues
95 getroutinglist delroutingmember addroutingmember
97 check_routing updateClaim
108 C4::Serials - Serials Module Functions
116 Functions for handling subscriptions, claims routing etc.
121 =head2 GetSuppliersWithLateIssues
123 $supplierlist = GetSuppliersWithLateIssues()
125 this function get all suppliers with late issues.
128 an array_ref of suppliers each entry is a hash_ref containing id and name
129 the array is in name order
133 sub GetSuppliersWithLateIssues {
134 my $dbh = C4::Context->dbh;
135 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
137 SELECT DISTINCT id, name
139 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
140 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
143 (planneddate < now() AND serial.status=1)
144 OR serial.STATUS IN ( $statuses )
146 AND subscription.closed = 0
148 return $dbh->selectall_arrayref($query, { Slice => {} });
151 =head2 GetSubscriptionHistoryFromSubscriptionId
153 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
155 This function returns the subscription history as a hashref
159 sub GetSubscriptionHistoryFromSubscriptionId {
160 my ($subscriptionid) = @_;
162 return unless $subscriptionid;
164 my $dbh = C4::Context->dbh;
167 FROM subscriptionhistory
168 WHERE subscriptionid = ?
170 my $sth = $dbh->prepare($query);
171 $sth->execute($subscriptionid);
172 my $results = $sth->fetchrow_hashref;
178 =head2 GetSerialInformation
180 $data = GetSerialInformation($serialid);
181 returns a hash_ref containing :
182 items : items marcrecord (can be an array)
184 subscription table field
185 + information about subscription expiration
189 sub GetSerialInformation {
191 my $dbh = C4::Context->dbh;
193 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
194 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
197 my $rq = $dbh->prepare($query);
198 $rq->execute($serialid);
199 my $data = $rq->fetchrow_hashref;
201 # create item information if we have serialsadditems for this subscription
202 if ( $data->{'serialsadditems'} ) {
203 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
204 $queryitem->execute($serialid);
205 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
207 if ( scalar(@$itemnumbers) > 0 ) {
208 foreach my $itemnum (@$itemnumbers) {
210 #It is ASSUMED that GetMarcItem ALWAYS WORK...
211 #Maybe GetMarcItem should return values on failure
212 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
213 $itemprocessed->{'itemnumber'} = $itemnum->[0];
214 $itemprocessed->{'itemid'} = $itemnum->[0];
215 $itemprocessed->{'serialid'} = $serialid;
216 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
217 push @{ $data->{'items'} }, $itemprocessed;
220 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
221 $itemprocessed->{'itemid'} = "N$serialid";
222 $itemprocessed->{'serialid'} = $serialid;
223 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
224 $itemprocessed->{'countitems'} = 0;
225 push @{ $data->{'items'} }, $itemprocessed;
228 $data->{ "status" . $data->{'serstatus'} } = 1;
229 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
230 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
231 $data->{cannotedit} = not can_edit_subscription( $data );
235 =head2 AddItem2Serial
237 $rows = AddItem2Serial($serialid,$itemnumber);
238 Adds an itemnumber to Serial record
239 returns the number of rows affected
244 my ( $serialid, $itemnumber ) = @_;
246 return unless ($serialid and $itemnumber);
248 my $dbh = C4::Context->dbh;
249 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
250 $rq->execute( $serialid, $itemnumber );
254 =head2 GetSubscription
256 $subs = GetSubscription($subscriptionid)
257 this function returns the subscription which has $subscriptionid as id.
259 a hashref. This hash contains
260 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
264 sub GetSubscription {
265 my ($subscriptionid) = @_;
266 my $dbh = C4::Context->dbh;
268 SELECT subscription.*,
269 subscriptionhistory.*,
270 aqbooksellers.name AS aqbooksellername,
271 biblio.title AS bibliotitle,
272 subscription.biblionumber as bibnum
274 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
275 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
276 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
277 WHERE subscription.subscriptionid = ?
280 my $sth = $dbh->prepare($query);
281 $sth->execute($subscriptionid);
282 my $subscription = $sth->fetchrow_hashref;
284 return unless $subscription;
286 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
288 if ( my $mana_id = $subscription->{mana_id} ) {
289 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
290 'subscription', $mana_id, {usecomments => 1});
291 $subscription->{comments} = $mana_subscription->{data}->{comments};
294 return $subscription;
297 =head2 GetFullSubscription
299 $array_ref = GetFullSubscription($subscriptionid)
300 this function reads the serial table.
304 sub GetFullSubscription {
305 my ($subscriptionid) = @_;
307 return unless ($subscriptionid);
309 my $dbh = C4::Context->dbh;
311 SELECT serial.serialid,
314 serial.publisheddate,
315 serial.publisheddatetext,
317 serial.notes as notes,
318 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
319 aqbooksellers.name as aqbooksellername,
320 biblio.title as bibliotitle,
321 subscription.branchcode AS branchcode,
322 subscription.subscriptionid AS subscriptionid
324 LEFT JOIN subscription ON
325 (serial.subscriptionid=subscription.subscriptionid )
326 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
327 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
328 WHERE serial.subscriptionid = ?
330 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
331 serial.subscriptionid
333 my $sth = $dbh->prepare($query);
334 $sth->execute($subscriptionid);
335 my $subscriptions = $sth->fetchall_arrayref( {} );
336 if (scalar @$subscriptions) {
337 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
338 for my $subscription ( @$subscriptions ) {
339 $subscription->{cannotedit} = $cannotedit;
343 return $subscriptions;
346 =head2 PrepareSerialsData
348 $array_ref = PrepareSerialsData($serialinfomation)
349 where serialinformation is a hashref array
353 sub PrepareSerialsData {
356 return unless ($lines);
363 my $previousnote = "";
365 foreach my $subs (@{$lines}) {
366 $subs->{ "status" . $subs->{'status'} } = 1;
367 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
368 $subs->{"checked"} = 1;
371 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
372 $year = $subs->{'year'};
376 if ( $tmpresults{$year} ) {
377 push @{ $tmpresults{$year}->{'serials'} }, $subs;
379 $tmpresults{$year} = {
381 'aqbooksellername' => $subs->{'aqbooksellername'},
382 'bibliotitle' => $subs->{'bibliotitle'},
383 'serials' => [$subs],
388 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
389 push @res, $tmpresults{$key};
394 =head2 GetSubscriptionsFromBiblionumber
396 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
397 this function get the subscription list. it reads the subscription table.
399 reference to an array of subscriptions which have the biblionumber given on input arg.
400 each element of this array is a hashref containing
401 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
405 sub GetSubscriptionsFromBiblionumber {
406 my ($biblionumber) = @_;
408 return unless ($biblionumber);
410 my $dbh = C4::Context->dbh;
412 SELECT subscription.*,
414 subscriptionhistory.*,
415 aqbooksellers.name AS aqbooksellername,
416 biblio.title AS bibliotitle
418 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
419 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
420 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
421 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
422 WHERE subscription.biblionumber = ?
424 my $sth = $dbh->prepare($query);
425 $sth->execute($biblionumber);
427 while ( my $subs = $sth->fetchrow_hashref ) {
428 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
429 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
430 if ( defined $subs->{histenddate} ) {
431 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
433 $subs->{histenddate} = "";
435 $subs->{opacnote} //= "";
436 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
437 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
438 $subs->{ "status" . $subs->{'status'} } = 1;
440 if (not defined $subs->{enddate} ) {
441 $subs->{enddate} = '';
443 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
445 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
446 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
447 $subs->{cannotedit} = not can_edit_subscription( $subs );
453 =head2 GetFullSubscriptionsFromBiblionumber
455 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
456 this function reads the serial table.
460 sub GetFullSubscriptionsFromBiblionumber {
461 my ($biblionumber) = @_;
462 my $dbh = C4::Context->dbh;
464 SELECT serial.serialid,
467 serial.publisheddate,
468 serial.publisheddatetext,
470 serial.notes as notes,
471 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
472 biblio.title as bibliotitle,
473 subscription.branchcode AS branchcode,
474 subscription.subscriptionid AS subscriptionid
476 LEFT JOIN subscription ON
477 (serial.subscriptionid=subscription.subscriptionid)
478 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
479 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
480 WHERE subscription.biblionumber = ?
482 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
483 serial.subscriptionid
485 my $sth = $dbh->prepare($query);
486 $sth->execute($biblionumber);
487 my $subscriptions = $sth->fetchall_arrayref( {} );
488 if (scalar @$subscriptions) {
489 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
490 for my $subscription ( @$subscriptions ) {
491 $subscription->{cannotedit} = $cannotedit;
495 return $subscriptions;
498 =head2 SearchSubscriptions
500 @results = SearchSubscriptions($args);
502 This function returns a list of hashrefs, one for each subscription
503 that meets the conditions specified by the $args hashref.
505 The valid search fields are:
519 The expiration_date search field is special; it specifies the maximum
520 subscription expiration date.
524 sub SearchSubscriptions {
527 my $additional_fields = $args->{additional_fields} // [];
528 my $matching_record_ids_for_additional_fields = [];
529 if ( @$additional_fields ) {
530 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
532 return () unless @subscriptions;
534 $matching_record_ids_for_additional_fields = [ map {
541 subscription.notes AS publicnotes,
542 subscriptionhistory.*,
544 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 for my $subscription ( @$results ) {
630 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
631 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
633 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
634 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
635 $subscription_object->additional_field_values->as_list };
645 ($totalissues,@serials) = GetSerials($subscriptionid);
646 this function gets every serial not arrived for a given subscription
647 as well as the number of issues registered in the database (all types)
648 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
650 FIXME: We should return \@serials.
655 my ( $subscriptionid, $count ) = @_;
657 return unless $subscriptionid;
659 my $dbh = C4::Context->dbh;
661 # status = 2 is "arrived"
663 $count = 5 unless ($count);
665 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
666 my $query = "SELECT serialid,serialseq, status, publisheddate,
667 publisheddatetext, planneddate,notes, routingnotes
669 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
670 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
671 my $sth = $dbh->prepare($query);
672 $sth->execute($subscriptionid);
674 while ( my $line = $sth->fetchrow_hashref ) {
675 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
676 for my $datefield ( qw( planneddate publisheddate) ) {
677 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
678 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
680 $line->{$datefield} = q{};
683 push @serials, $line;
686 # OK, now add the last 5 issues arrives/missing
687 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
688 publisheddatetext, notes, routingnotes
690 WHERE subscriptionid = ?
691 AND status IN ( $statuses )
692 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
694 $sth = $dbh->prepare($query);
695 $sth->execute($subscriptionid);
696 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
698 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
699 for my $datefield ( qw( planneddate publisheddate) ) {
700 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
701 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
703 $line->{$datefield} = q{};
707 push @serials, $line;
710 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
711 $sth = $dbh->prepare($query);
712 $sth->execute($subscriptionid);
713 my ($totalissues) = $sth->fetchrow;
714 return ( $totalissues, @serials );
719 @serials = GetSerials2($subscriptionid,$statuses);
720 this function returns every serial waited for a given subscription
721 as well as the number of issues registered in the database (all types)
722 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
724 $statuses is an arrayref of statuses and is mandatory.
729 my ( $subscription, $statuses ) = @_;
731 return unless ($subscription and @$statuses);
733 my $dbh = C4::Context->dbh;
735 SELECT serialid,serialseq, status, planneddate, publisheddate,
736 publisheddatetext, notes, routingnotes
738 WHERE subscriptionid=?
740 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
742 ORDER BY publisheddate,serialid DESC
744 my $sth = $dbh->prepare($query);
745 $sth->execute( $subscription, @$statuses );
748 while ( my $line = $sth->fetchrow_hashref ) {
749 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
750 # Format dates for display
751 for my $datefield ( qw( planneddate publisheddate ) ) {
752 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
753 $line->{$datefield} = q{};
756 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
759 push @serials, $line;
764 =head2 GetLatestSerials
766 \@serials = GetLatestSerials($subscriptionid,$limit)
767 get the $limit's latest serials arrived or missing for a given subscription
769 a ref to an array which contains all of the latest serials stored into a hash.
773 sub GetLatestSerials {
774 my ( $subscriptionid, $limit ) = @_;
776 return unless ($subscriptionid and $limit);
778 my $dbh = C4::Context->dbh;
780 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
781 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
783 WHERE subscriptionid = ?
784 AND status IN ($statuses)
785 ORDER BY publisheddate DESC LIMIT 0,$limit
787 my $sth = $dbh->prepare($strsth);
788 $sth->execute($subscriptionid);
790 while ( my $line = $sth->fetchrow_hashref ) {
791 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
792 push @serials, $line;
798 =head2 GetPreviousSerialid
800 $serialid = GetPreviousSerialid($subscriptionid, $nth)
801 get the $nth's previous serial for the given subscriptionid
807 sub GetPreviousSerialid {
808 my ( $subscriptionid, $nth ) = @_;
810 my $dbh = C4::Context->dbh;
814 my $strsth = "SELECT serialid
816 WHERE subscriptionid = ?
818 ORDER BY serialid DESC LIMIT $nth,1
820 my $sth = $dbh->prepare($strsth);
821 $sth->execute($subscriptionid);
823 my $line = $sth->fetchrow_hashref;
824 $return = $line->{'serialid'} if ($line);
832 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
833 $newinnerloop1, $newinnerloop2, $newinnerloop3
834 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
836 $subscription is a hashref containing all the attributes of the table
838 $pattern is a hashref containing all the attributes of the table
839 'subscription_numberpatterns'.
840 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
841 $planneddate is a date string in iso format.
842 This function get the next issue for the subscription given on input arg
847 my ($subscription, $pattern, $frequency, $planneddate) = @_;
849 return unless ($subscription and $pattern);
851 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
852 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
855 if ($subscription->{'skip_serialseq'}) {
856 my @irreg = split /;/, $subscription->{'irregularity'};
858 my $irregularities = {};
859 $irregularities->{$_} = 1 foreach(@irreg);
860 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
861 while($irregularities->{$issueno}) {
868 my $numberingmethod = $pattern->{numberingmethod};
870 if ($numberingmethod) {
871 $calculated = $numberingmethod;
872 my $locale = $subscription->{locale};
873 $newlastvalue1 = $subscription->{lastvalue1} || 0;
874 $newlastvalue2 = $subscription->{lastvalue2} || 0;
875 $newlastvalue3 = $subscription->{lastvalue3} || 0;
876 $newinnerloop1 = $subscription->{innerloop1} || 0;
877 $newinnerloop2 = $subscription->{innerloop2} || 0;
878 $newinnerloop3 = $subscription->{innerloop3} || 0;
881 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
884 for(my $i = 0; $i < $count; $i++) {
886 # check if we have to increase the new value.
888 if ($newinnerloop1 >= $pattern->{every1}) {
890 $newlastvalue1 += $pattern->{add1};
892 # reset counter if needed.
893 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
896 # check if we have to increase the new value.
898 if ($newinnerloop2 >= $pattern->{every2}) {
900 $newlastvalue2 += $pattern->{add2};
902 # reset counter if needed.
903 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
906 # check if we have to increase the new value.
908 if ($newinnerloop3 >= $pattern->{every3}) {
910 $newlastvalue3 += $pattern->{add3};
912 # reset counter if needed.
913 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
917 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
918 $calculated =~ s/\{X\}/$newlastvalue1string/g;
921 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
922 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
925 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
926 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
931 $newlastvalue1, $newlastvalue2, $newlastvalue3,
932 $newinnerloop1, $newinnerloop2, $newinnerloop3);
937 $calculated = GetSeq($subscription, $pattern)
938 $subscription is a hashref containing all the attributes of the table 'subscription'
939 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
940 this function transforms {X},{Y},{Z} to 150,0,0 for example.
942 the sequence in string format
947 my ($subscription, $pattern) = @_;
949 return unless ($subscription and $pattern);
951 my $locale = $subscription->{locale};
953 my $calculated = $pattern->{numberingmethod};
955 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
956 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
957 $calculated =~ s/\{X\}/$newlastvalue1/g;
959 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
960 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
961 $calculated =~ s/\{Y\}/$newlastvalue2/g;
963 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
964 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
965 $calculated =~ s/\{Z\}/$newlastvalue3/g;
969 =head2 GetExpirationDate
971 $enddate = GetExpirationDate($subscriptionid, [$startdate])
973 this function return the next expiration date for a subscription given on input args.
980 sub GetExpirationDate {
981 my ( $subscriptionid, $startdate ) = @_;
983 return unless ($subscriptionid);
985 my $dbh = C4::Context->dbh;
986 my $subscription = GetSubscription($subscriptionid);
989 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
990 $enddate = $startdate || $subscription->{startdate};
991 my @date = split( /-/, $enddate );
993 return if ( scalar(@date) != 3 || not check_date(@date) );
995 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
996 if ( $frequency and $frequency->{unit} ) {
999 if ( my $length = $subscription->{numberlength} ) {
1001 #calculate the date of the last issue.
1002 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1003 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1005 } elsif ( $subscription->{monthlength} ) {
1006 if ( $$subscription{startdate} ) {
1007 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1008 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1010 } elsif ( $subscription->{weeklength} ) {
1011 if ( $$subscription{startdate} ) {
1012 my @date = split( /-/, $subscription->{startdate} );
1013 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1014 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1017 $enddate = $subscription->{enddate};
1021 return $subscription->{enddate};
1025 =head2 CountSubscriptionFromBiblionumber
1027 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1028 this returns a count of the subscriptions for a given biblionumber
1030 the number of subscriptions
1034 sub CountSubscriptionFromBiblionumber {
1035 my ($biblionumber) = @_;
1037 return unless ($biblionumber);
1039 my $dbh = C4::Context->dbh;
1040 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1041 my $sth = $dbh->prepare($query);
1042 $sth->execute($biblionumber);
1043 my $subscriptionsnumber = $sth->fetchrow;
1044 return $subscriptionsnumber;
1047 =head2 ModSubscriptionHistory
1049 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1051 this function modifies the history of a subscription. Put your new values on input arg.
1052 returns the number of rows affected
1056 sub ModSubscriptionHistory {
1057 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1059 return unless ($subscriptionid);
1061 my $dbh = C4::Context->dbh;
1062 my $query = "UPDATE subscriptionhistory
1063 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1064 WHERE subscriptionid=?
1066 my $sth = $dbh->prepare($query);
1067 $receivedlist =~ s/^; // if $receivedlist;
1068 $missinglist =~ s/^; // if $missinglist;
1069 $opacnote =~ s/^; // if $opacnote;
1070 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1074 =head2 ModSerialStatus
1076 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1077 $publisheddatetext, $status, $notes);
1079 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1080 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1084 sub ModSerialStatus {
1085 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1086 $status, $notes) = @_;
1088 return unless ($serialid);
1090 #It is a usual serial
1091 # 1st, get previous status :
1092 my $dbh = C4::Context->dbh;
1093 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1094 FROM serial, subscription
1095 WHERE serial.subscriptionid=subscription.subscriptionid
1097 my $sth = $dbh->prepare($query);
1098 $sth->execute($serialid);
1099 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1100 my $frequency = GetSubscriptionFrequency($periodicity);
1102 # change status & update subscriptionhistory
1104 if ( $status == DELETED ) {
1105 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1109 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1110 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1113 $sth = $dbh->prepare($query);
1114 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1115 $planneddate, $status, $notes, $routingnotes, $serialid );
1116 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1117 $sth = $dbh->prepare($query);
1118 $sth->execute($subscriptionid);
1119 my $val = $sth->fetchrow_hashref;
1120 unless ( $val->{manualhistory} ) {
1121 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1122 $sth = $dbh->prepare($query);
1123 $sth->execute($subscriptionid);
1124 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1126 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1127 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1130 # in case serial has been previously marked as missing
1131 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1132 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1135 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1136 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1138 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1139 $sth = $dbh->prepare($query);
1140 $recievedlist =~ s/^; //;
1141 $missinglist =~ s/^; //;
1142 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1146 # create new expected entry if needed (ie : was "expected" and has changed)
1147 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1148 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1149 my $subscription = GetSubscription($subscriptionid);
1150 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1151 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1155 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1156 $newinnerloop1, $newinnerloop2, $newinnerloop3
1158 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1160 # next date (calculated from actual date & frequency parameters)
1161 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1162 my $nextpubdate = $nextpublisheddate;
1163 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1164 WHERE subscriptionid = ?";
1165 $sth = $dbh->prepare($query);
1166 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1167 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1168 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1169 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1170 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1171 require C4::Letters;
1172 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1180 # Adds or removes seqno from list when needed; returns list
1181 # Or checks and returns true when present
1183 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1185 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1187 if( !$op or $op eq 'ADD' ) {
1188 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1189 } elsif( $op eq 'REMOVE' ) {
1190 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1192 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1197 =head2 GetNextExpected
1199 $nextexpected = GetNextExpected($subscriptionid)
1201 Get the planneddate for the current expected issue of the subscription.
1207 planneddate => ISO date
1212 sub GetNextExpected {
1213 my ($subscriptionid) = @_;
1215 my $dbh = C4::Context->dbh;
1219 WHERE subscriptionid = ?
1223 my $sth = $dbh->prepare($query);
1225 # Each subscription has only one 'expected' issue.
1226 $sth->execute( $subscriptionid, EXPECTED );
1227 my $nextissue = $sth->fetchrow_hashref;
1228 if ( !$nextissue ) {
1232 WHERE subscriptionid = ?
1233 ORDER BY publisheddate DESC
1236 $sth = $dbh->prepare($query);
1237 $sth->execute($subscriptionid);
1238 $nextissue = $sth->fetchrow_hashref;
1240 foreach(qw/planneddate publisheddate/) {
1241 # or should this default to 1st Jan ???
1242 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
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,
1366 # FIXME Must be $subscription->serials
1367 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1368 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1370 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1372 $subscription->discard_changes;
1373 return $subscription;
1376 =head2 NewSubscription
1378 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1379 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1380 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1381 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1382 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1383 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1384 $skip_serialseq, $itemtype, $previousitemtype);
1386 Create a new subscription with value given on input args.
1389 the id of this new subscription
1393 sub NewSubscription {
1395 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1396 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1397 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1398 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1399 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1400 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1401 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1403 my $dbh = C4::Context->dbh;
1405 my $subscription = Koha::Subscription->new(
1407 librarian => $auser,
1408 branchcode => $branchcode,
1409 aqbooksellerid => $aqbooksellerid,
1411 aqbudgetid => $aqbudgetid,
1412 biblionumber => $biblionumber,
1413 startdate => $startdate,
1414 periodicity => $periodicity,
1415 numberlength => $numberlength,
1416 weeklength => $weeklength,
1417 monthlength => $monthlength,
1418 lastvalue1 => $lastvalue1,
1419 innerloop1 => $innerloop1,
1420 lastvalue2 => $lastvalue2,
1421 innerloop2 => $innerloop2,
1422 lastvalue3 => $lastvalue3,
1423 innerloop3 => $innerloop3,
1427 firstacquidate => $firstacquidate,
1428 irregularity => $irregularity,
1429 numberpattern => $numberpattern,
1431 callnumber => $callnumber,
1432 manualhistory => $manualhistory,
1433 internalnotes => $internalnotes,
1434 serialsadditems => $serialsadditems,
1435 staffdisplaycount => $staffdisplaycount,
1436 opacdisplaycount => $opacdisplaycount,
1437 graceperiod => $graceperiod,
1438 location => $location,
1439 enddate => $enddate,
1440 skip_serialseq => $skip_serialseq,
1441 itemtype => $itemtype,
1442 previousitemtype => $previousitemtype,
1443 mana_id => $mana_id,
1446 $subscription->discard_changes;
1447 my $subscriptionid = $subscription->subscriptionid;
1448 my ( $query, $sth );
1450 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1454 WHERE subscriptionid=?
1456 $sth = $dbh->prepare($query);
1457 $sth->execute( $enddate, $subscriptionid );
1460 # then create the 1st expected number
1462 INSERT INTO subscriptionhistory
1463 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1464 VALUES (?,?,?, '', '')
1466 $sth = $dbh->prepare($query);
1467 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1469 # reread subscription to get a hash (for calculation of the 1st issue number)
1470 $subscription = GetSubscription($subscriptionid); # We should not do that
1471 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1473 # calculate issue number
1474 my $serialseq = GetSeq($subscription, $pattern) || q{};
1478 serialseq => $serialseq,
1479 serialseq_x => $subscription->{'lastvalue1'},
1480 serialseq_y => $subscription->{'lastvalue2'},
1481 serialseq_z => $subscription->{'lastvalue3'},
1482 subscriptionid => $subscriptionid,
1483 biblionumber => $biblionumber,
1485 planneddate => $firstacquidate,
1486 publisheddate => $firstacquidate,
1490 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1492 #set serial flag on biblio if not already set.
1493 my $biblio = Koha::Biblios->find( $biblionumber );
1494 if ( $biblio and !$biblio->serial ) {
1495 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1496 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1498 eval { $record->field($tag)->update( $subf => 1 ); };
1500 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1502 return $subscriptionid;
1505 =head2 GetSubscriptionLength
1507 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1509 This function calculates the subscription length.
1513 sub GetSubscriptionLength {
1514 my ($subtype, $length) = @_;
1516 return unless looks_like_number($length);
1520 $subtype eq 'issues' ? $length : 0,
1521 $subtype eq 'weeks' ? $length : 0,
1522 $subtype eq 'months' ? $length : 0,
1527 =head2 ReNewSubscription
1529 ReNewSubscription($params);
1531 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1533 this function renew a subscription with values given on input args.
1537 sub ReNewSubscription {
1538 my ( $params ) = @_;
1539 my $subscriptionid = $params->{subscriptionid};
1540 my $user = $params->{user};
1541 my $startdate = $params->{startdate};
1542 my $numberlength = $params->{numberlength};
1543 my $weeklength = $params->{weeklength};
1544 my $monthlength = $params->{monthlength};
1545 my $note = $params->{note};
1546 my $branchcode = $params->{branchcode};
1548 my $dbh = C4::Context->dbh;
1549 my $subscription = GetSubscription($subscriptionid);
1553 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1554 WHERE biblio.biblionumber=?
1556 my $sth = $dbh->prepare($query);
1557 $sth->execute( $subscription->{biblionumber} );
1558 my $biblio = $sth->fetchrow_hashref;
1560 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1561 require C4::Suggestions;
1562 C4::Suggestions::NewSuggestion(
1563 { 'suggestedby' => $user,
1564 'title' => $subscription->{bibliotitle},
1565 'author' => $biblio->{author},
1566 'publishercode' => $biblio->{publishercode},
1568 'biblionumber' => $subscription->{biblionumber},
1569 'branchcode' => $branchcode,
1574 $numberlength ||= 0; # Should not we raise an exception instead?
1577 # renew subscription
1580 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1581 WHERE subscriptionid=?
1583 $sth = $dbh->prepare($query);
1584 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1585 my $enddate = GetExpirationDate($subscriptionid);
1589 WHERE subscriptionid=?
1591 $sth = $dbh->prepare($query);
1592 $sth->execute( $enddate, $subscriptionid );
1594 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1600 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1602 Create a new issue stored on the database.
1603 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1604 returns the serial id
1609 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1610 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1611 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1613 return unless ($subscriptionid);
1615 my $schema = Koha::Database->new()->schema();
1617 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1619 my $serial = Koha::Serial->new(
1621 serialseq => $serialseq,
1622 serialseq_x => $subscription->lastvalue1(),
1623 serialseq_y => $subscription->lastvalue2(),
1624 serialseq_z => $subscription->lastvalue3(),
1625 subscriptionid => $subscriptionid,
1626 biblionumber => $biblionumber,
1628 planneddate => $planneddate,
1629 publisheddate => $publisheddate,
1630 publisheddatetext => $publisheddatetext,
1632 routingnotes => $routingnotes
1636 my $serialid = $serial->id();
1638 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1639 my $missinglist = $subscription_history->missinglist();
1640 my $recievedlist = $subscription_history->recievedlist();
1642 if ( $status == ARRIVED ) {
1643 ### TODO Add a feature that improves recognition and description.
1644 ### As such count (serialseq) i.e. : N18,2(N19),N20
1645 ### Would use substr and index But be careful to previous presence of ()
1646 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1648 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1649 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1652 $recievedlist =~ s/^; //;
1653 $missinglist =~ s/^; //;
1655 $subscription_history->recievedlist($recievedlist);
1656 $subscription_history->missinglist($missinglist);
1657 $subscription_history->store();
1662 =head2 HasSubscriptionStrictlyExpired
1664 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1666 the subscription has stricly expired when today > the end subscription date
1669 1 if true, 0 if false, -1 if the expiration date is not set.
1673 sub HasSubscriptionStrictlyExpired {
1675 # Getting end of subscription date
1676 my ($subscriptionid) = @_;
1678 return unless ($subscriptionid);
1680 my $dbh = C4::Context->dbh;
1681 my $subscription = GetSubscription($subscriptionid);
1682 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1684 # If the expiration date is set
1685 if ( $expirationdate != 0 ) {
1686 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1688 # Getting today's date
1689 my ( $nowyear, $nowmonth, $nowday ) = Today();
1691 # if today's date > expiration date, then the subscription has stricly expired
1692 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1699 # There are some cases where the expiration date is not set
1700 # As we can't determine if the subscription has expired on a date-basis,
1706 =head2 HasSubscriptionExpired
1708 $has_expired = HasSubscriptionExpired($subscriptionid)
1710 the subscription has expired when the next issue to arrive is out of subscription limit.
1713 0 if the subscription has not expired
1714 1 if the subscription has expired
1715 2 if has subscription does not have a valid expiration date set
1719 sub HasSubscriptionExpired {
1720 my ($subscriptionid) = @_;
1722 return unless ($subscriptionid);
1724 my $dbh = C4::Context->dbh;
1725 my $subscription = GetSubscription($subscriptionid);
1726 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1727 if ( $frequency and $frequency->{unit} ) {
1728 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1729 if (!defined $expirationdate) {
1730 $expirationdate = q{};
1733 SELECT max(planneddate)
1735 WHERE subscriptionid=?
1737 my $sth = $dbh->prepare($query);
1738 $sth->execute($subscriptionid);
1739 my ($res) = $sth->fetchrow;
1740 if (!$res || $res=~m/^0000/) {
1743 my @res = split( /-/, $res );
1744 my @endofsubscriptiondate = split( /-/, $expirationdate );
1745 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1747 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1752 if ( $subscription->{'numberlength'} ) {
1753 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1754 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1760 return 0; # Notice that you'll never get here.
1763 =head2 DelSubscription
1765 DelSubscription($subscriptionid)
1766 this function deletes subscription which has $subscriptionid as id.
1770 sub DelSubscription {
1771 my ($subscriptionid) = @_;
1772 my $dbh = C4::Context->dbh;
1773 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1775 Koha::AdditionalFieldValues->search({
1776 'field.tablename' => 'subscription',
1777 'me.record_id' => $subscriptionid,
1778 }, { join => 'field' })->delete;
1780 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1785 DelIssue($serialseq,$subscriptionid)
1786 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1788 returns the number of rows affected
1793 my ($dataissue) = @_;
1794 my $dbh = C4::Context->dbh;
1795 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1800 AND subscriptionid= ?
1802 my $mainsth = $dbh->prepare($query);
1803 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1805 #Delete element from subscription history
1806 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1807 my $sth = $dbh->prepare($query);
1808 $sth->execute( $dataissue->{'subscriptionid'} );
1809 my $val = $sth->fetchrow_hashref;
1810 unless ( $val->{manualhistory} ) {
1812 SELECT * FROM subscriptionhistory
1813 WHERE subscriptionid= ?
1815 my $sth = $dbh->prepare($query);
1816 $sth->execute( $dataissue->{'subscriptionid'} );
1817 my $data = $sth->fetchrow_hashref;
1818 my $serialseq = $dataissue->{'serialseq'};
1819 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1820 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1821 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1822 $sth = $dbh->prepare($strsth);
1823 $sth->execute( $dataissue->{'subscriptionid'} );
1826 return $mainsth->rows;
1829 =head2 GetLateOrMissingIssues
1831 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1833 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1836 the issuelist as an array of hash refs. Each element of this array contains
1837 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1841 sub GetLateOrMissingIssues {
1842 my ( $supplierid, $serialid, $order ) = @_;
1844 return unless ( $supplierid or $serialid );
1846 my $dbh = C4::Context->dbh;
1851 $byserial = "and serialid = " . $serialid;
1854 $order .= ", title";
1858 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1860 $sth = $dbh->prepare(
1862 serialid, aqbooksellerid, name,
1863 biblio.title, biblioitems.issn, planneddate, serialseq,
1864 serial.status, serial.subscriptionid, claimdate, claims_count,
1865 subscription.branchcode
1867 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1868 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1869 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1870 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1871 WHERE subscription.subscriptionid = serial.subscriptionid
1872 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1873 AND subscription.aqbooksellerid=$supplierid
1878 $sth = $dbh->prepare(
1880 serialid, aqbooksellerid, name,
1881 biblio.title, planneddate, serialseq,
1882 serial.status, serial.subscriptionid, claimdate, claims_count,
1883 subscription.branchcode
1885 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1886 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1887 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1888 WHERE subscription.subscriptionid = serial.subscriptionid
1889 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1894 $sth->execute( EXPECTED, LATE, CLAIMED );
1896 while ( my $line = $sth->fetchrow_hashref ) {
1898 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1899 $line->{planneddateISO} = $line->{planneddate};
1900 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1902 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1903 $line->{claimdateISO} = $line->{claimdate};
1904 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1906 $line->{"status".$line->{status}} = 1;
1908 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1909 $line->{additional_fields} = { map { $_->field->name => $_->value }
1910 $subscription_object->additional_field_values->as_list };
1912 push @issuelist, $line;
1919 &updateClaim($serialid)
1921 this function updates the time when a claim is issued for late/missing items
1923 called from claims.pl file
1928 my ($serialids) = @_;
1929 return unless $serialids;
1930 unless ( ref $serialids ) {
1931 $serialids = [ $serialids ];
1933 my $dbh = C4::Context->dbh;
1936 SET claimdate = NOW(),
1937 claims_count = claims_count + 1,
1939 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1940 {}, CLAIMED, @$serialids );
1943 =head2 check_routing
1945 $result = &check_routing($subscriptionid)
1947 this function checks to see if a serial has a routing list and returns the count of routingid
1948 used to show either an 'add' or 'edit' link
1953 my ($subscriptionid) = @_;
1955 return unless ($subscriptionid);
1957 my $dbh = C4::Context->dbh;
1958 my $sth = $dbh->prepare(
1959 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1960 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1961 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1964 $sth->execute($subscriptionid);
1965 my $line = $sth->fetchrow_hashref;
1966 my $result = $line->{'routingids'};
1970 =head2 addroutingmember
1972 addroutingmember($borrowernumber,$subscriptionid)
1974 this function takes a borrowernumber and subscriptionid and adds the member to the
1975 routing list for that serial subscription and gives them a rank on the list
1976 of either 1 or highest current rank + 1
1980 sub addroutingmember {
1981 my ( $borrowernumber, $subscriptionid ) = @_;
1983 return unless ($borrowernumber and $subscriptionid);
1986 my $dbh = C4::Context->dbh;
1987 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1988 $sth->execute($subscriptionid);
1989 while ( my $line = $sth->fetchrow_hashref ) {
1990 if ( $line->{'rank'} > 0 ) {
1991 $rank = $line->{'rank'} + 1;
1996 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1997 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2000 =head2 reorder_members
2002 reorder_members($subscriptionid,$routingid,$rank)
2004 this function is used to reorder the routing list
2006 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2007 - it gets all members on list puts their routingid's into an array
2008 - removes the one in the array that is $routingid
2009 - then reinjects $routingid at point indicated by $rank
2010 - then update the database with the routingids in the new order
2014 sub reorder_members {
2015 my ( $subscriptionid, $routingid, $rank ) = @_;
2016 my $dbh = C4::Context->dbh;
2017 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2018 $sth->execute($subscriptionid);
2020 while ( my $line = $sth->fetchrow_hashref ) {
2021 push( @result, $line->{'routingid'} );
2024 # To find the matching index
2026 my $key = -1; # to allow for 0 being a valid response
2027 for ( $i = 0 ; $i < @result ; $i++ ) {
2028 if ( $routingid == $result[$i] ) {
2029 $key = $i; # save the index
2034 # if index exists in array then move it to new position
2035 if ( $key > -1 && $rank > 0 ) {
2036 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2037 my $moving_item = splice( @result, $key, 1 );
2038 splice( @result, $new_rank, 0, $moving_item );
2040 for ( my $j = 0 ; $j < @result ; $j++ ) {
2041 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2047 =head2 delroutingmember
2049 delroutingmember($routingid,$subscriptionid)
2051 this function either deletes one member from routing list if $routingid exists otherwise
2052 deletes all members from the routing list
2056 sub delroutingmember {
2058 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2059 my ( $routingid, $subscriptionid ) = @_;
2060 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2063 $sth->execute($routingid);
2064 reorder_members( $subscriptionid, $routingid );
2066 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2067 $sth->execute($subscriptionid);
2072 =head2 getroutinglist
2074 @routinglist = getroutinglist($subscriptionid)
2076 this gets the info from the subscriptionroutinglist for $subscriptionid
2079 the routinglist as an array. Each element of the array contains a hash_ref containing
2080 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2084 sub getroutinglist {
2085 my ($subscriptionid) = @_;
2086 my $dbh = C4::Context->dbh;
2087 my $sth = $dbh->prepare(
2088 'SELECT routingid, borrowernumber, ranking, biblionumber
2090 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2091 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2093 $sth->execute($subscriptionid);
2094 my $routinglist = $sth->fetchall_arrayref({});
2095 return @{$routinglist};
2098 =head2 countissuesfrom
2100 $result = countissuesfrom($subscriptionid,$startdate)
2102 Returns a count of serial rows matching the given subsctiptionid
2103 with published date greater than startdate
2107 sub countissuesfrom {
2108 my ( $subscriptionid, $startdate ) = @_;
2109 my $dbh = C4::Context->dbh;
2113 WHERE subscriptionid=?
2114 AND serial.publisheddate>?
2116 my $sth = $dbh->prepare($query);
2117 $sth->execute( $subscriptionid, $startdate );
2118 my ($countreceived) = $sth->fetchrow;
2119 return $countreceived;
2124 $result = CountIssues($subscriptionid)
2126 Returns a count of serial rows matching the given subsctiptionid
2131 my ($subscriptionid) = @_;
2132 my $dbh = C4::Context->dbh;
2136 WHERE subscriptionid=?
2138 my $sth = $dbh->prepare($query);
2139 $sth->execute($subscriptionid);
2140 my ($countreceived) = $sth->fetchrow;
2141 return $countreceived;
2146 $result = HasItems($subscriptionid)
2148 returns a count of items from serial matching the subscriptionid
2153 my ($subscriptionid) = @_;
2154 my $dbh = C4::Context->dbh;
2156 SELECT COUNT(serialitems.itemnumber)
2158 LEFT JOIN serialitems USING(serialid)
2159 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2161 my $sth=$dbh->prepare($query);
2162 $sth->execute($subscriptionid);
2163 my ($countitems)=$sth->fetchrow_array();
2167 =head2 abouttoexpire
2169 $result = abouttoexpire($subscriptionid)
2171 this function alerts you to the penultimate issue for a serial subscription
2173 returns 1 - if this is the penultimate issue
2179 my ($subscriptionid) = @_;
2180 my $dbh = C4::Context->dbh;
2181 my $subscription = GetSubscription($subscriptionid);
2182 my $per = $subscription->{'periodicity'};
2183 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2184 if ($frequency and $frequency->{unit}){
2186 my $expirationdate = GetExpirationDate($subscriptionid);
2188 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2189 my $nextdate = GetNextDate($subscription, $res, $frequency);
2191 # only compare dates if both dates exist.
2192 if ($nextdate and $expirationdate) {
2193 if(Date::Calc::Delta_Days(
2194 split( /-/, $nextdate ),
2195 split( /-/, $expirationdate )
2201 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2202 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2208 =head2 GetFictiveIssueNumber
2210 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2212 Get the position of the issue published at $publisheddate, considering the
2213 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2214 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2215 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2216 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2217 depending on how many rows are in serial table.
2218 The issue number calculation is based on subscription frequency, first acquisition
2219 date, and $publisheddate.
2221 Returns undef when called for irregular frequencies.
2223 The routine is used to skip irregularities when calculating the next issue
2224 date (in GetNextDate) or the next issue number (in GetNextSeq).
2228 sub GetFictiveIssueNumber {
2229 my ($subscription, $publisheddate, $frequency) = @_;
2231 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2235 my ( $year, $month, $day ) = split /-/, $publisheddate;
2236 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2237 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2239 if( $frequency->{'unitsperissue'} == 1 ) {
2240 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2241 } else { # issuesperunit == 1
2242 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2248 my ( $date1, $date2, $unit ) = @_;
2249 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2251 if( $unit eq 'day' ) {
2252 return Delta_Days( @$date1, @$date2 );
2253 } elsif( $unit eq 'week' ) {
2254 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2257 # In case of months or years, this is a wrapper around N_Delta_YMD.
2258 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2259 # while we expect 1 month.
2260 my @delta = N_Delta_YMD( @$date1, @$date2 );
2261 if( $delta[2] > 27 ) {
2262 # Check if we could add a month
2263 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2264 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2268 if( $delta[1] >= 12 ) {
2272 # if unit is year, we only return full years
2273 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2276 sub _get_next_date_day {
2277 my ($subscription, $freqdata, $year, $month, $day) = @_;
2279 my @newissue; # ( yy, mm, dd )
2280 # We do not need $delta_days here, since it would be zero where used
2282 if( $freqdata->{issuesperunit} == 1 ) {
2284 @newissue = Add_Delta_Days(
2285 $year, $month, $day, $freqdata->{"unitsperissue"} );
2286 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2288 @newissue = ( $year, $month, $day );
2289 $subscription->{countissuesperunit}++;
2291 # We finished a cycle of issues within a unit.
2292 # No subtraction of zero needed, just add one day
2293 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2294 $subscription->{countissuesperunit} = 1;
2299 sub _get_next_date_week {
2300 my ($subscription, $freqdata, $year, $month, $day) = @_;
2302 my @newissue; # ( yy, mm, dd )
2303 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2305 if( $freqdata->{issuesperunit} == 1 ) {
2306 # Add full weeks (of 7 days)
2307 @newissue = Add_Delta_Days(
2308 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2309 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2310 # Add rounded number of days based on frequency.
2311 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2312 $subscription->{countissuesperunit}++;
2314 # We finished a cycle of issues within a unit.
2315 # Subtract delta * (issues - 1), add 1 week
2316 @newissue = Add_Delta_Days( $year, $month, $day,
2317 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2318 @newissue = Add_Delta_Days( @newissue, 7 );
2319 $subscription->{countissuesperunit} = 1;
2324 sub _get_next_date_month {
2325 my ($subscription, $freqdata, $year, $month, $day) = @_;
2327 my @newissue; # ( yy, mm, dd )
2328 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2330 if( $freqdata->{issuesperunit} == 1 ) {
2332 @newissue = Add_Delta_YM(
2333 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2334 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2335 # Add rounded number of days based on frequency.
2336 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2337 $subscription->{countissuesperunit}++;
2339 # We finished a cycle of issues within a unit.
2340 # Subtract delta * (issues - 1), add 1 month
2341 @newissue = Add_Delta_Days( $year, $month, $day,
2342 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2343 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2344 $subscription->{countissuesperunit} = 1;
2349 sub _get_next_date_year {
2350 my ($subscription, $freqdata, $year, $month, $day) = @_;
2352 my @newissue; # ( yy, mm, dd )
2353 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2355 if( $freqdata->{issuesperunit} == 1 ) {
2357 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2358 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2359 # Add rounded number of days based on frequency.
2360 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2361 $subscription->{countissuesperunit}++;
2363 # We finished a cycle of issues within a unit.
2364 # Subtract delta * (issues - 1), add 1 year
2365 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2366 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2367 $subscription->{countissuesperunit} = 1;
2374 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2376 this function it takes the publisheddate and will return the next issue's date
2377 and will skip dates if there exists an irregularity.
2378 $publisheddate has to be an ISO date
2379 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2380 $frequency is a hashref containing frequency informations
2381 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2382 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2383 skipped then the returned date will be 2007-05-10
2386 $resultdate - then next date in the sequence (ISO date)
2388 Return undef if subscription is irregular
2393 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2395 return unless $subscription and $publisheddate;
2398 if ($freqdata->{'unit'}) {
2399 my ( $year, $month, $day ) = split /-/, $publisheddate;
2401 # Process an irregularity Hash
2402 # Suppose that irregularities are stored in a string with this structure
2403 # irreg1;irreg2;irreg3
2404 # where irregX is the number of issue which will not be received
2405 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2407 if ( $subscription->{irregularity} ) {
2408 my @irreg = split /;/, $subscription->{'irregularity'} ;
2409 foreach my $irregularity (@irreg) {
2410 $irregularities{$irregularity} = 1;
2414 # Get the 'fictive' next issue number
2415 # It is used to check if next issue is an irregular issue.
2416 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2418 # Then get the next date
2419 my $unit = lc $freqdata->{'unit'};
2420 if ($unit eq 'day') {
2421 while ($irregularities{$issueno}) {
2422 ($year, $month, $day) = _get_next_date_day($subscription,
2423 $freqdata, $year, $month, $day);
2426 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2427 $year, $month, $day);
2429 elsif ($unit eq 'week') {
2430 while ($irregularities{$issueno}) {
2431 ($year, $month, $day) = _get_next_date_week($subscription,
2432 $freqdata, $year, $month, $day);
2435 ($year, $month, $day) = _get_next_date_week($subscription,
2436 $freqdata, $year, $month, $day);
2438 elsif ($unit eq 'month') {
2439 while ($irregularities{$issueno}) {
2440 ($year, $month, $day) = _get_next_date_month($subscription,
2441 $freqdata, $year, $month, $day);
2444 ($year, $month, $day) = _get_next_date_month($subscription,
2445 $freqdata, $year, $month, $day);
2447 elsif ($unit eq 'year') {
2448 while ($irregularities{$issueno}) {
2449 ($year, $month, $day) = _get_next_date_year($subscription,
2450 $freqdata, $year, $month, $day);
2453 ($year, $month, $day) = _get_next_date_year($subscription,
2454 $freqdata, $year, $month, $day);
2458 my $dbh = C4::Context->dbh;
2461 SET countissuesperunit = ?
2462 WHERE subscriptionid = ?
2464 my $sth = $dbh->prepare($query);
2465 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2468 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2474 $string = &_numeration($value,$num_type,$locale);
2476 _numeration returns the string corresponding to $value in the num_type
2488 my ($value, $num_type, $locale) = @_;
2493 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2494 # 1970-11-01 was a Sunday
2495 $value = $value % 7;
2496 my $dt = DateTime->new(
2502 $string = $num_type =~ /^dayname$/
2503 ? $dt->strftime("%A")
2504 : $dt->strftime("%a");
2505 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2506 $value = $value % 12;
2507 my $dt = DateTime->new(
2509 month => $value + 1,
2512 $string = $num_type =~ /^monthname$/
2513 ? $dt->strftime("%B")
2514 : $dt->strftime("%b");
2515 } elsif ( $num_type =~ /^season$/ ) {
2516 my @seasons= qw( Spring Summer Fall Winter );
2517 $value = $value % 4;
2518 $string = $seasons[$value];
2519 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2520 my @seasonsabrv= qw( Spr Sum Fal Win );
2521 $value = $value % 4;
2522 $string = $seasonsabrv[$value];
2530 =head2 CloseSubscription
2532 Close a subscription given a subscriptionid
2536 sub CloseSubscription {
2537 my ( $subscriptionid ) = @_;
2538 return unless $subscriptionid;
2539 my $dbh = C4::Context->dbh;
2540 my $sth = $dbh->prepare( q{
2543 WHERE subscriptionid = ?
2545 $sth->execute( $subscriptionid );
2547 # Set status = missing when status = stopped
2548 $sth = $dbh->prepare( q{
2551 WHERE subscriptionid = ?
2554 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2557 =head2 ReopenSubscription
2559 Reopen a subscription given a subscriptionid
2563 sub ReopenSubscription {
2564 my ( $subscriptionid ) = @_;
2565 return unless $subscriptionid;
2566 my $dbh = C4::Context->dbh;
2567 my $sth = $dbh->prepare( q{
2570 WHERE subscriptionid = ?
2572 $sth->execute( $subscriptionid );
2574 # Set status = expected when status = stopped
2575 $sth = $dbh->prepare( q{
2578 WHERE subscriptionid = ?
2581 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2584 =head2 subscriptionCurrentlyOnOrder
2586 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2588 Return 1 if subscription is currently on order else 0.
2592 sub subscriptionCurrentlyOnOrder {
2593 my ( $subscriptionid ) = @_;
2594 my $dbh = C4::Context->dbh;
2596 SELECT COUNT(*) FROM aqorders
2597 WHERE subscriptionid = ?
2598 AND datereceived IS NULL
2599 AND datecancellationprinted IS NULL
2601 my $sth = $dbh->prepare( $query );
2602 $sth->execute($subscriptionid);
2603 return $sth->fetchrow_array;
2606 =head2 can_claim_subscription
2608 $can = can_claim_subscription( $subscriptionid[, $userid] );
2610 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2614 sub can_claim_subscription {
2615 my ( $subscription, $userid ) = @_;
2616 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2619 =head2 can_edit_subscription
2621 $can = can_edit_subscription( $subscriptionid[, $userid] );
2623 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2627 sub can_edit_subscription {
2628 my ( $subscription, $userid ) = @_;
2629 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2632 =head2 can_show_subscription
2634 $can = can_show_subscription( $subscriptionid[, $userid] );
2636 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2640 sub can_show_subscription {
2641 my ( $subscription, $userid ) = @_;
2642 return _can_do_on_subscription( $subscription, $userid, '*' );
2645 sub _can_do_on_subscription {
2646 my ( $subscription, $userid, $permission ) = @_;
2647 return 0 unless C4::Context->userenv;
2648 my $flags = C4::Context->userenv->{flags};
2649 $userid ||= C4::Context->userenv->{'id'};
2651 if ( C4::Context->preference('IndependentBranches') ) {
2653 if C4::Context->IsSuperLibrarian()
2655 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2657 C4::Auth::haspermission( $userid,
2658 { serials => $permission } )
2659 and ( not defined $subscription->{branchcode}
2660 or $subscription->{branchcode} eq ''
2661 or $subscription->{branchcode} eq
2662 C4::Context->userenv->{'branch'} )
2667 if C4::Context->IsSuperLibrarian()
2669 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2670 or C4::Auth::haspermission(
2671 $userid, { serials => $permission }
2678 =head2 findSerialsByStatus
2680 @serials = findSerialsByStatus($status, $subscriptionid);
2682 Returns an array of serials matching a given status and subscription id.
2686 sub findSerialsByStatus {
2687 my ( $status, $subscriptionid ) = @_;
2688 my $dbh = C4::Context->dbh;
2689 my $query = q| SELECT * from serial
2691 AND subscriptionid = ?
2693 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2702 Koha Development Team <http://koha-community.org/>