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( 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;
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 biblio.subtitle AS bibliosubtitle,
273 subscription.biblionumber as bibnum
275 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
276 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
277 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
278 WHERE subscription.subscriptionid = ?
281 my $sth = $dbh->prepare($query);
282 $sth->execute($subscriptionid);
283 my $subscription = $sth->fetchrow_hashref;
285 return unless $subscription;
287 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
289 if ( my $mana_id = $subscription->{mana_id} ) {
290 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
291 'subscription', $mana_id, {usecomments => 1});
292 $subscription->{comments} = $mana_subscription->{data}->{comments};
295 return $subscription;
298 =head2 GetFullSubscription
300 $array_ref = GetFullSubscription($subscriptionid)
301 this function reads the serial table.
305 sub GetFullSubscription {
306 my ($subscriptionid) = @_;
308 return unless ($subscriptionid);
310 my $dbh = C4::Context->dbh;
312 SELECT serial.serialid,
315 serial.publisheddate,
316 serial.publisheddatetext,
318 serial.notes as notes,
319 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
320 aqbooksellers.name as aqbooksellername,
321 biblio.title as bibliotitle,
322 subscription.branchcode AS branchcode,
323 subscription.subscriptionid AS subscriptionid
325 LEFT JOIN subscription ON
326 (serial.subscriptionid=subscription.subscriptionid )
327 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
328 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
329 WHERE serial.subscriptionid = ?
331 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
332 serial.subscriptionid
334 my $sth = $dbh->prepare($query);
335 $sth->execute($subscriptionid);
336 my $subscriptions = $sth->fetchall_arrayref( {} );
337 if (scalar @$subscriptions) {
338 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
339 for my $subscription ( @$subscriptions ) {
340 $subscription->{cannotedit} = $cannotedit;
344 return $subscriptions;
347 =head2 PrepareSerialsData
349 $array_ref = PrepareSerialsData($serialinfomation)
350 where serialinformation is a hashref array
354 sub PrepareSerialsData {
357 return unless ($lines);
364 my $previousnote = "";
366 foreach my $subs (@{$lines}) {
367 $subs->{ "status" . $subs->{'status'} } = 1;
368 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
369 $subs->{"checked"} = 1;
372 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
373 $year = $subs->{'year'};
377 if ( $tmpresults{$year} ) {
378 push @{ $tmpresults{$year}->{'serials'} }, $subs;
380 $tmpresults{$year} = {
382 'aqbooksellername' => $subs->{'aqbooksellername'},
383 'bibliotitle' => $subs->{'bibliotitle'},
384 'serials' => [$subs],
389 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
390 push @res, $tmpresults{$key};
395 =head2 GetSubscriptionsFromBiblionumber
397 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
398 this function get the subscription list. it reads the subscription table.
400 reference to an array of subscriptions which have the biblionumber given on input arg.
401 each element of this array is a hashref containing
402 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
406 sub GetSubscriptionsFromBiblionumber {
407 my ($biblionumber) = @_;
409 return unless ($biblionumber);
411 my $dbh = C4::Context->dbh;
413 SELECT subscription.*,
415 subscriptionhistory.*,
416 aqbooksellers.name AS aqbooksellername,
417 biblio.title AS bibliotitle
419 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
420 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
421 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
422 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
423 WHERE subscription.biblionumber = ?
425 my $sth = $dbh->prepare($query);
426 $sth->execute($biblionumber);
428 while ( my $subs = $sth->fetchrow_hashref ) {
429 $subs->{opacnote} //= "";
430 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
431 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
432 $subs->{ "status" . $subs->{'status'} } = 1;
434 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
435 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
436 $subs->{cannotedit} = not can_edit_subscription( $subs );
442 =head2 GetFullSubscriptionsFromBiblionumber
444 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
445 this function reads the serial table.
449 sub GetFullSubscriptionsFromBiblionumber {
450 my ($biblionumber) = @_;
451 my $dbh = C4::Context->dbh;
453 SELECT serial.serialid,
456 serial.publisheddate,
457 serial.publisheddatetext,
459 serial.notes as notes,
460 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
461 biblio.title as bibliotitle,
462 subscription.branchcode AS branchcode,
463 subscription.subscriptionid AS subscriptionid,
464 subscription.location AS location
466 LEFT JOIN subscription ON
467 (serial.subscriptionid=subscription.subscriptionid)
468 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
469 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
470 WHERE subscription.biblionumber = ?
472 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
473 serial.subscriptionid
475 my $sth = $dbh->prepare($query);
476 $sth->execute($biblionumber);
477 my $subscriptions = $sth->fetchall_arrayref( {} );
478 if (scalar @$subscriptions) {
479 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
480 for my $subscription ( @$subscriptions ) {
481 $subscription->{cannotedit} = $cannotedit;
485 return $subscriptions;
488 =head2 SearchSubscriptions
490 @results = SearchSubscriptions($args);
492 This function returns a list of hashrefs, one for each subscription
493 that meets the conditions specified by the $args hashref.
495 The valid search fields are:
509 The expiration_date search field is special; it specifies the maximum
510 subscription expiration date.
514 sub SearchSubscriptions {
517 my $additional_fields = $args->{additional_fields} // [];
518 my $matching_record_ids_for_additional_fields = [];
519 if ( @$additional_fields ) {
520 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
522 return () unless @subscriptions;
524 $matching_record_ids_for_additional_fields = [ map {
531 subscription.notes AS publicnotes,
532 subscriptionhistory.*,
534 biblio.notes AS biblionotes,
539 aqbooksellers.name AS vendorname,
542 LEFT JOIN subscriptionhistory USING(subscriptionid)
543 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
544 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
545 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
547 $query .= q| WHERE 1|;
550 if( $args->{biblionumber} ) {
551 push @where_strs, "biblio.biblionumber = ?";
552 push @where_args, $args->{biblionumber};
555 if( $args->{title} ){
556 my @words = split / /, $args->{title};
558 foreach my $word (@words) {
559 push @strs, "biblio.title LIKE ?";
560 push @args, "%$word%";
563 push @where_strs, '(' . join (' AND ', @strs) . ')';
564 push @where_args, @args;
568 push @where_strs, "biblioitems.issn LIKE ?";
569 push @where_args, "%$args->{issn}%";
572 push @where_strs, "biblioitems.ean LIKE ?";
573 push @where_args, "%$args->{ean}%";
575 if ( $args->{callnumber} ) {
576 push @where_strs, "subscription.callnumber LIKE ?";
577 push @where_args, "%$args->{callnumber}%";
579 if( $args->{publisher} ){
580 push @where_strs, "biblioitems.publishercode LIKE ?";
581 push @where_args, "%$args->{publisher}%";
583 if( $args->{bookseller} ){
584 push @where_strs, "aqbooksellers.name LIKE ?";
585 push @where_args, "%$args->{bookseller}%";
587 if( $args->{branch} ){
588 push @where_strs, "subscription.branchcode = ?";
589 push @where_args, "$args->{branch}";
591 if ( $args->{location} ) {
592 push @where_strs, "subscription.location = ?";
593 push @where_args, "$args->{location}";
595 if ( $args->{expiration_date} ) {
596 push @where_strs, "subscription.enddate <= ?";
597 push @where_args, "$args->{expiration_date}";
599 if( defined $args->{closed} ){
600 push @where_strs, "subscription.closed = ?";
601 push @where_args, "$args->{closed}";
605 $query .= ' AND ' . join(' AND ', @where_strs);
607 if ( @$additional_fields ) {
608 $query .= ' AND subscriptionid IN ('
609 . join( ', ', @$matching_record_ids_for_additional_fields )
613 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
615 my $dbh = C4::Context->dbh;
616 my $sth = $dbh->prepare($query);
617 $sth->execute(@where_args);
618 my $results = $sth->fetchall_arrayref( {} );
620 for my $subscription ( @$results ) {
621 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
622 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
624 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
625 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
626 $subscription_object->additional_field_values->as_list };
636 ($totalissues,@serials) = GetSerials($subscriptionid);
637 this function gets every serial not arrived for a given subscription
638 as well as the number of issues registered in the database (all types)
639 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
641 FIXME: We should return \@serials.
646 my ( $subscriptionid, $count ) = @_;
648 return unless $subscriptionid;
650 my $dbh = C4::Context->dbh;
652 # status = 2 is "arrived"
654 $count = 5 unless ($count);
656 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
657 my $query = "SELECT serialid,serialseq, status, publisheddate,
658 publisheddatetext, planneddate,notes, routingnotes
660 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
661 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
662 my $sth = $dbh->prepare($query);
663 $sth->execute($subscriptionid);
665 while ( my $line = $sth->fetchrow_hashref ) {
666 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
667 push @serials, $line;
670 # OK, now add the last 5 issues arrives/missing
671 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
672 publisheddatetext, notes, routingnotes
674 WHERE subscriptionid = ?
675 AND status IN ( $statuses )
676 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
678 $sth = $dbh->prepare($query);
679 $sth->execute($subscriptionid);
680 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
682 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
684 push @serials, $line;
687 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
688 $sth = $dbh->prepare($query);
689 $sth->execute($subscriptionid);
690 my ($totalissues) = $sth->fetchrow;
691 return ( $totalissues, @serials );
696 @serials = GetSerials2($subscriptionid,$statuses);
697 this function returns every serial waited for a given subscription
698 as well as the number of issues registered in the database (all types)
699 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
701 $statuses is an arrayref of statuses and is mandatory.
706 my ( $subscription, $statuses ) = @_;
708 return unless ($subscription and @$statuses);
710 my $dbh = C4::Context->dbh;
712 SELECT serialid,serialseq, status, planneddate, publisheddate,
713 publisheddatetext, notes, routingnotes
715 WHERE subscriptionid=?
717 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
719 ORDER BY publisheddate,serialid DESC
721 my $sth = $dbh->prepare($query);
722 $sth->execute( $subscription, @$statuses );
725 while ( my $line = $sth->fetchrow_hashref ) {
726 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
727 push @serials, $line;
732 =head2 GetLatestSerials
734 \@serials = GetLatestSerials($subscriptionid,$limit)
735 get the $limit's latest serials arrived or missing for a given subscription
737 a ref to an array which contains all of the latest serials stored into a hash.
741 sub GetLatestSerials {
742 my ( $subscriptionid, $limit ) = @_;
744 return unless ($subscriptionid and $limit);
746 my $dbh = C4::Context->dbh;
748 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
749 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
751 WHERE subscriptionid = ?
752 AND status IN ($statuses)
753 ORDER BY publisheddate DESC LIMIT 0,$limit
755 my $sth = $dbh->prepare($strsth);
756 $sth->execute($subscriptionid);
758 while ( my $line = $sth->fetchrow_hashref ) {
759 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
760 push @serials, $line;
766 =head2 GetPreviousSerialid
768 $serialid = GetPreviousSerialid($subscriptionid, $nth)
769 get the $nth's previous serial for the given subscriptionid
775 sub GetPreviousSerialid {
776 my ( $subscriptionid, $nth ) = @_;
778 my $dbh = C4::Context->dbh;
782 my $strsth = "SELECT serialid
784 WHERE subscriptionid = ?
786 ORDER BY serialid DESC LIMIT $nth,1
788 my $sth = $dbh->prepare($strsth);
789 $sth->execute($subscriptionid);
791 my $line = $sth->fetchrow_hashref;
792 $return = $line->{'serialid'} if ($line);
800 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
801 $newinnerloop1, $newinnerloop2, $newinnerloop3
802 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
804 $subscription is a hashref containing all the attributes of the table
806 $pattern is a hashref containing all the attributes of the table
807 'subscription_numberpatterns'.
808 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
809 $planneddate is a date string in iso format.
810 This function get the next issue for the subscription given on input arg
815 my ($subscription, $pattern, $frequency, $planneddate) = @_;
817 return unless ($subscription and $pattern);
819 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
820 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
823 if ($subscription->{'skip_serialseq'}) {
824 my @irreg = split /;/, $subscription->{'irregularity'};
826 my $irregularities = {};
827 $irregularities->{$_} = 1 foreach(@irreg);
828 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
829 while($irregularities->{$issueno}) {
836 my $numberingmethod = $pattern->{numberingmethod};
838 if ($numberingmethod) {
839 $calculated = $numberingmethod;
840 my $locale = $subscription->{locale};
841 $newlastvalue1 = $subscription->{lastvalue1} || 0;
842 $newlastvalue2 = $subscription->{lastvalue2} || 0;
843 $newlastvalue3 = $subscription->{lastvalue3} || 0;
844 $newinnerloop1 = $subscription->{innerloop1} || 0;
845 $newinnerloop2 = $subscription->{innerloop2} || 0;
846 $newinnerloop3 = $subscription->{innerloop3} || 0;
849 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
852 for(my $i = 0; $i < $count; $i++) {
854 # check if we have to increase the new value.
856 if ($newinnerloop1 >= $pattern->{every1}) {
858 $newlastvalue1 += $pattern->{add1};
860 # reset counter if needed.
861 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
864 # check if we have to increase the new value.
866 if ($newinnerloop2 >= $pattern->{every2}) {
868 $newlastvalue2 += $pattern->{add2};
870 # reset counter if needed.
871 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
874 # check if we have to increase the new value.
876 if ($newinnerloop3 >= $pattern->{every3}) {
878 $newlastvalue3 += $pattern->{add3};
880 # reset counter if needed.
881 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
885 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
886 $calculated =~ s/\{X\}/$newlastvalue1string/g;
889 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
890 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
893 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
894 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
899 $newlastvalue1, $newlastvalue2, $newlastvalue3,
900 $newinnerloop1, $newinnerloop2, $newinnerloop3);
905 $calculated = GetSeq($subscription, $pattern)
906 $subscription is a hashref containing all the attributes of the table 'subscription'
907 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
908 this function transforms {X},{Y},{Z} to 150,0,0 for example.
910 the sequence in string format
915 my ($subscription, $pattern) = @_;
917 return unless ($subscription and $pattern);
919 my $locale = $subscription->{locale};
921 my $calculated = $pattern->{numberingmethod};
923 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
924 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
925 $calculated =~ s/\{X\}/$newlastvalue1/g;
927 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
928 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
929 $calculated =~ s/\{Y\}/$newlastvalue2/g;
931 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
932 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
933 $calculated =~ s/\{Z\}/$newlastvalue3/g;
937 =head2 GetExpirationDate
939 $enddate = GetExpirationDate($subscriptionid, [$startdate])
941 this function return the next expiration date for a subscription given on input args.
948 sub GetExpirationDate {
949 my ( $subscriptionid, $startdate ) = @_;
951 return unless ($subscriptionid);
953 my $dbh = C4::Context->dbh;
954 my $subscription = GetSubscription($subscriptionid);
957 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
958 $enddate = $startdate || $subscription->{startdate};
959 my @date = split( /-/, $enddate );
961 return if ( scalar(@date) != 3 || not check_date(@date) );
963 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
964 if ( $frequency and $frequency->{unit} ) {
967 if ( my $length = $subscription->{numberlength} ) {
969 #calculate the date of the last issue.
970 for ( my $i = 1 ; $i <= $length ; $i++ ) {
971 $enddate = GetNextDate( $subscription, $enddate, $frequency );
973 } elsif ( $subscription->{monthlength} ) {
974 if ( $$subscription{startdate} ) {
975 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
976 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
978 } elsif ( $subscription->{weeklength} ) {
979 if ( $$subscription{startdate} ) {
980 my @date = split( /-/, $subscription->{startdate} );
981 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
982 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
985 $enddate = $subscription->{enddate};
989 return $subscription->{enddate};
993 =head2 CountSubscriptionFromBiblionumber
995 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
996 this returns a count of the subscriptions for a given biblionumber
998 the number of subscriptions
1002 sub CountSubscriptionFromBiblionumber {
1003 my ($biblionumber) = @_;
1005 return unless ($biblionumber);
1007 my $dbh = C4::Context->dbh;
1008 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1009 my $sth = $dbh->prepare($query);
1010 $sth->execute($biblionumber);
1011 my $subscriptionsnumber = $sth->fetchrow;
1012 return $subscriptionsnumber;
1015 =head2 ModSubscriptionHistory
1017 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1019 this function modifies the history of a subscription. Put your new values on input arg.
1020 returns the number of rows affected
1024 sub ModSubscriptionHistory {
1025 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1027 return unless ($subscriptionid);
1029 my $dbh = C4::Context->dbh;
1030 my $query = "UPDATE subscriptionhistory
1031 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1032 WHERE subscriptionid=?
1034 my $sth = $dbh->prepare($query);
1035 $receivedlist =~ s/^; // if $receivedlist;
1036 $missinglist =~ s/^; // if $missinglist;
1037 $opacnote =~ s/^; // if $opacnote;
1038 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1042 =head2 ModSerialStatus
1044 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1045 $publisheddatetext, $status, $notes);
1047 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1048 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1052 sub ModSerialStatus {
1053 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1054 $status, $notes) = @_;
1056 return unless ($serialid);
1058 #It is a usual serial
1059 # 1st, get previous status :
1060 my $dbh = C4::Context->dbh;
1061 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1062 FROM serial, subscription
1063 WHERE serial.subscriptionid=subscription.subscriptionid
1065 my $sth = $dbh->prepare($query);
1066 $sth->execute($serialid);
1067 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1068 my $frequency = GetSubscriptionFrequency($periodicity);
1070 # change status & update subscriptionhistory
1072 if ( $status == DELETED ) {
1073 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1077 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1078 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1081 $sth = $dbh->prepare($query);
1082 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1083 $planneddate, $status, $notes, $routingnotes, $serialid );
1084 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1085 $sth = $dbh->prepare($query);
1086 $sth->execute($subscriptionid);
1087 my $val = $sth->fetchrow_hashref;
1088 unless ( $val->{manualhistory} ) {
1089 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1090 $sth = $dbh->prepare($query);
1091 $sth->execute($subscriptionid);
1092 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1094 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1095 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1098 # in case serial has been previously marked as missing
1099 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1100 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1103 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1104 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1106 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1107 $sth = $dbh->prepare($query);
1108 $recievedlist =~ s/^; //;
1109 $missinglist =~ s/^; //;
1110 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1114 # create new expected entry if needed (ie : was "expected" and has changed)
1115 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1116 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1117 my $subscription = GetSubscription($subscriptionid);
1118 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1119 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1123 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1124 $newinnerloop1, $newinnerloop2, $newinnerloop3
1126 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1128 # next date (calculated from actual date & frequency parameters)
1129 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1130 my $nextpubdate = $nextpublisheddate;
1131 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1132 WHERE subscriptionid = ?";
1133 $sth = $dbh->prepare($query);
1134 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1135 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1136 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1137 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1138 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1139 require C4::Letters;
1140 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1148 # Adds or removes seqno from list when needed; returns list
1149 # Or checks and returns true when present
1151 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1153 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1155 if( !$op or $op eq 'ADD' ) {
1156 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1157 } elsif( $op eq 'REMOVE' ) {
1158 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1160 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1165 =head2 GetNextExpected
1167 $nextexpected = GetNextExpected($subscriptionid)
1169 Get the planneddate for the current expected issue of the subscription.
1175 planneddate => ISO date
1180 sub GetNextExpected {
1181 my ($subscriptionid) = @_;
1183 my $dbh = C4::Context->dbh;
1187 WHERE subscriptionid = ?
1191 my $sth = $dbh->prepare($query);
1193 # Each subscription has only one 'expected' issue.
1194 $sth->execute( $subscriptionid, EXPECTED );
1195 my $nextissue = $sth->fetchrow_hashref;
1196 if ( !$nextissue ) {
1200 WHERE subscriptionid = ?
1201 ORDER BY publisheddate DESC
1204 $sth = $dbh->prepare($query);
1205 $sth->execute($subscriptionid);
1206 $nextissue = $sth->fetchrow_hashref;
1208 foreach(qw/planneddate publisheddate/) {
1209 # or should this default to 1st Jan ???
1210 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1216 =head2 ModNextExpected
1218 ModNextExpected($subscriptionid,$date)
1220 Update the planneddate for the current expected issue of the subscription.
1221 This will modify all future prediction results.
1223 C<$date> is an ISO date.
1229 sub ModNextExpected {
1230 my ( $subscriptionid, $date ) = @_;
1231 my $dbh = C4::Context->dbh;
1233 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1234 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1236 # Each subscription has only one 'expected' issue.
1237 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1242 =head2 GetSubscriptionIrregularities
1246 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1247 get the list of irregularities for a subscription
1253 sub GetSubscriptionIrregularities {
1254 my $subscriptionid = shift;
1256 return unless $subscriptionid;
1258 my $dbh = C4::Context->dbh;
1262 WHERE subscriptionid = ?
1264 my $sth = $dbh->prepare($query);
1265 $sth->execute($subscriptionid);
1267 my ($result) = $sth->fetchrow_array;
1268 my @irreg = split /;/, $result;
1273 =head2 ModSubscription
1275 this function modifies a subscription. Put all new values on input args.
1276 returns the number of rows affected
1280 sub ModSubscription {
1282 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1283 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1284 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1285 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1286 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1287 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1288 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1289 $itemtype, $previousitemtype, $mana_id, $ccode
1292 my $subscription = Koha::Subscriptions->find($subscriptionid);
1295 librarian => $auser,
1296 branchcode => $branchcode,
1297 aqbooksellerid => $aqbooksellerid,
1299 aqbudgetid => $aqbudgetid,
1300 biblionumber => $biblionumber,
1301 startdate => $startdate,
1302 periodicity => $periodicity,
1303 numberlength => $numberlength,
1304 weeklength => $weeklength,
1305 monthlength => $monthlength,
1306 lastvalue1 => $lastvalue1,
1307 innerloop1 => $innerloop1,
1308 lastvalue2 => $lastvalue2,
1309 innerloop2 => $innerloop2,
1310 lastvalue3 => $lastvalue3,
1311 innerloop3 => $innerloop3,
1315 firstacquidate => $firstacquidate,
1316 irregularity => $irregularity,
1317 numberpattern => $numberpattern,
1319 callnumber => $callnumber,
1320 manualhistory => $manualhistory,
1321 internalnotes => $internalnotes,
1322 serialsadditems => $serialsadditems,
1323 staffdisplaycount => $staffdisplaycount,
1324 opacdisplaycount => $opacdisplaycount,
1325 graceperiod => $graceperiod,
1326 location => $location,
1327 enddate => $enddate,
1328 skip_serialseq => $skip_serialseq,
1329 itemtype => $itemtype,
1330 previousitemtype => $previousitemtype,
1331 mana_id => $mana_id,
1335 # FIXME Must be $subscription->serials
1336 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1337 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1339 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1341 $subscription->discard_changes;
1342 return $subscription;
1345 =head2 NewSubscription
1347 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1348 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1349 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1350 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1351 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1352 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1353 $skip_serialseq, $itemtype, $previousitemtype);
1355 Create a new subscription with value given on input args.
1358 the id of this new subscription
1362 sub NewSubscription {
1364 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1365 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1366 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1367 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1368 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1369 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1370 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode
1372 my $dbh = C4::Context->dbh;
1374 my $subscription = Koha::Subscription->new(
1376 librarian => $auser,
1377 branchcode => $branchcode,
1378 aqbooksellerid => $aqbooksellerid,
1380 aqbudgetid => $aqbudgetid,
1381 biblionumber => $biblionumber,
1382 startdate => $startdate,
1383 periodicity => $periodicity,
1384 numberlength => $numberlength,
1385 weeklength => $weeklength,
1386 monthlength => $monthlength,
1387 lastvalue1 => $lastvalue1,
1388 innerloop1 => $innerloop1,
1389 lastvalue2 => $lastvalue2,
1390 innerloop2 => $innerloop2,
1391 lastvalue3 => $lastvalue3,
1392 innerloop3 => $innerloop3,
1396 firstacquidate => $firstacquidate,
1397 irregularity => $irregularity,
1398 numberpattern => $numberpattern,
1400 callnumber => $callnumber,
1401 manualhistory => $manualhistory,
1402 internalnotes => $internalnotes,
1403 serialsadditems => $serialsadditems,
1404 staffdisplaycount => $staffdisplaycount,
1405 opacdisplaycount => $opacdisplaycount,
1406 graceperiod => $graceperiod,
1407 location => $location,
1408 enddate => $enddate,
1409 skip_serialseq => $skip_serialseq,
1410 itemtype => $itemtype,
1411 previousitemtype => $previousitemtype,
1412 mana_id => $mana_id,
1416 $subscription->discard_changes;
1417 my $subscriptionid = $subscription->subscriptionid;
1418 my ( $query, $sth );
1420 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1424 WHERE subscriptionid=?
1426 $sth = $dbh->prepare($query);
1427 $sth->execute( $enddate, $subscriptionid );
1430 # then create the 1st expected number
1432 INSERT INTO subscriptionhistory
1433 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1434 VALUES (?,?,?, '', '')
1436 $sth = $dbh->prepare($query);
1437 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1439 # reread subscription to get a hash (for calculation of the 1st issue number)
1440 $subscription = GetSubscription($subscriptionid); # We should not do that
1441 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1443 # calculate issue number
1444 my $serialseq = GetSeq($subscription, $pattern) || q{};
1448 serialseq => $serialseq,
1449 serialseq_x => $subscription->{'lastvalue1'},
1450 serialseq_y => $subscription->{'lastvalue2'},
1451 serialseq_z => $subscription->{'lastvalue3'},
1452 subscriptionid => $subscriptionid,
1453 biblionumber => $biblionumber,
1455 planneddate => $firstacquidate,
1456 publisheddate => $firstacquidate,
1460 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1462 #set serial flag on biblio if not already set.
1463 my $biblio = Koha::Biblios->find( $biblionumber );
1464 if ( $biblio and !$biblio->serial ) {
1465 my $record = $biblio->metadata->record;
1466 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1468 eval { $record->field($tag)->update( $subf => 1 ); };
1470 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1472 return $subscriptionid;
1475 =head2 GetSubscriptionLength
1477 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1479 This function calculates the subscription length.
1483 sub GetSubscriptionLength {
1484 my ($subtype, $length) = @_;
1486 return unless looks_like_number($length);
1490 $subtype eq 'issues' ? $length : 0,
1491 $subtype eq 'weeks' ? $length : 0,
1492 $subtype eq 'months' ? $length : 0,
1497 =head2 ReNewSubscription
1499 ReNewSubscription($params);
1501 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1503 this function renew a subscription with values given on input args.
1507 sub ReNewSubscription {
1508 my ( $params ) = @_;
1509 my $subscriptionid = $params->{subscriptionid};
1510 my $user = $params->{user};
1511 my $startdate = $params->{startdate};
1512 my $numberlength = $params->{numberlength};
1513 my $weeklength = $params->{weeklength};
1514 my $monthlength = $params->{monthlength};
1515 my $note = $params->{note};
1516 my $branchcode = $params->{branchcode};
1518 my $dbh = C4::Context->dbh;
1519 my $subscription = GetSubscription($subscriptionid);
1523 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1524 WHERE biblio.biblionumber=?
1526 my $sth = $dbh->prepare($query);
1527 $sth->execute( $subscription->{biblionumber} );
1528 my $biblio = $sth->fetchrow_hashref;
1530 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1531 require C4::Suggestions;
1532 C4::Suggestions::NewSuggestion(
1533 { 'suggestedby' => $user,
1534 'title' => $subscription->{bibliotitle},
1535 'author' => $biblio->{author},
1536 'publishercode' => $biblio->{publishercode},
1538 'biblionumber' => $subscription->{biblionumber},
1539 'branchcode' => $branchcode,
1544 $numberlength ||= 0; # Should not we raise an exception instead?
1547 # renew subscription
1550 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1551 WHERE subscriptionid=?
1553 $sth = $dbh->prepare($query);
1554 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1555 my $enddate = GetExpirationDate($subscriptionid);
1559 WHERE subscriptionid=?
1561 $sth = $dbh->prepare($query);
1562 $sth->execute( $enddate, $subscriptionid );
1564 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1570 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1572 Create a new issue stored on the database.
1573 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1574 returns the serial id
1579 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1580 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1581 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1583 return unless ($subscriptionid);
1585 my $schema = Koha::Database->new()->schema();
1587 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1589 my $serial = Koha::Serial->new(
1591 serialseq => $serialseq,
1592 serialseq_x => $subscription->lastvalue1(),
1593 serialseq_y => $subscription->lastvalue2(),
1594 serialseq_z => $subscription->lastvalue3(),
1595 subscriptionid => $subscriptionid,
1596 biblionumber => $biblionumber,
1598 planneddate => $planneddate,
1599 publisheddate => $publisheddate,
1600 publisheddatetext => $publisheddatetext,
1602 routingnotes => $routingnotes
1606 my $serialid = $serial->id();
1608 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1609 my $missinglist = $subscription_history->missinglist();
1610 my $recievedlist = $subscription_history->recievedlist();
1612 if ( $status == ARRIVED ) {
1613 ### TODO Add a feature that improves recognition and description.
1614 ### As such count (serialseq) i.e. : N18,2(N19),N20
1615 ### Would use substr and index But be careful to previous presence of ()
1616 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1618 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1619 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1622 $recievedlist =~ s/^; //;
1623 $missinglist =~ s/^; //;
1625 $subscription_history->recievedlist($recievedlist);
1626 $subscription_history->missinglist($missinglist);
1627 $subscription_history->store();
1632 =head2 HasSubscriptionStrictlyExpired
1634 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1636 the subscription has stricly expired when today > the end subscription date
1639 1 if true, 0 if false, -1 if the expiration date is not set.
1643 sub HasSubscriptionStrictlyExpired {
1645 # Getting end of subscription date
1646 my ($subscriptionid) = @_;
1648 return unless ($subscriptionid);
1650 my $dbh = C4::Context->dbh;
1651 my $subscription = GetSubscription($subscriptionid);
1652 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1654 # If the expiration date is set
1655 if ( $expirationdate != 0 ) {
1656 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1658 # Getting today's date
1659 my ( $nowyear, $nowmonth, $nowday ) = Today();
1661 # if today's date > expiration date, then the subscription has stricly expired
1662 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1669 # There are some cases where the expiration date is not set
1670 # As we can't determine if the subscription has expired on a date-basis,
1676 =head2 HasSubscriptionExpired
1678 $has_expired = HasSubscriptionExpired($subscriptionid)
1680 the subscription has expired when the next issue to arrive is out of subscription limit.
1683 0 if the subscription has not expired
1684 1 if the subscription has expired
1685 2 if has subscription does not have a valid expiration date set
1689 sub HasSubscriptionExpired {
1690 my ($subscriptionid) = @_;
1692 return unless ($subscriptionid);
1694 my $dbh = C4::Context->dbh;
1695 my $subscription = GetSubscription($subscriptionid);
1696 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1697 if ( $frequency and $frequency->{unit} ) {
1698 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1699 if (!defined $expirationdate) {
1700 $expirationdate = q{};
1703 SELECT max(planneddate)
1705 WHERE subscriptionid=?
1707 my $sth = $dbh->prepare($query);
1708 $sth->execute($subscriptionid);
1709 my ($res) = $sth->fetchrow;
1710 if (!$res || $res=~m/^0000/) {
1713 my @res = split( /-/, $res );
1714 my @endofsubscriptiondate = split( /-/, $expirationdate );
1715 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1717 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1722 if ( $subscription->{'numberlength'} ) {
1723 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1724 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1730 return 0; # Notice that you'll never get here.
1733 =head2 DelSubscription
1735 DelSubscription($subscriptionid)
1736 this function deletes subscription which has $subscriptionid as id.
1740 sub DelSubscription {
1741 my ($subscriptionid) = @_;
1742 my $dbh = C4::Context->dbh;
1743 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1745 Koha::AdditionalFieldValues->search({
1746 'field.tablename' => 'subscription',
1747 'me.record_id' => $subscriptionid,
1748 }, { join => 'field' })->delete;
1750 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1755 DelIssue($serialseq,$subscriptionid)
1756 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1758 returns the number of rows affected
1763 my ($dataissue) = @_;
1764 my $dbh = C4::Context->dbh;
1765 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1770 AND subscriptionid= ?
1772 my $mainsth = $dbh->prepare($query);
1773 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1775 #Delete element from subscription history
1776 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1777 my $sth = $dbh->prepare($query);
1778 $sth->execute( $dataissue->{'subscriptionid'} );
1779 my $val = $sth->fetchrow_hashref;
1780 unless ( $val->{manualhistory} ) {
1782 SELECT * FROM subscriptionhistory
1783 WHERE subscriptionid= ?
1785 my $sth = $dbh->prepare($query);
1786 $sth->execute( $dataissue->{'subscriptionid'} );
1787 my $data = $sth->fetchrow_hashref;
1788 my $serialseq = $dataissue->{'serialseq'};
1789 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1790 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1791 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1792 $sth = $dbh->prepare($strsth);
1793 $sth->execute( $dataissue->{'subscriptionid'} );
1796 return $mainsth->rows;
1799 =head2 GetLateOrMissingIssues
1801 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1803 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1806 the issuelist as an array of hash refs. Each element of this array contains
1807 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1811 sub GetLateOrMissingIssues {
1812 my ( $supplierid, $serialid, $order ) = @_;
1814 return unless ( $supplierid or $serialid );
1816 my $dbh = C4::Context->dbh;
1821 $byserial = "and serialid = " . $serialid;
1824 $order .= ", title";
1828 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1830 $sth = $dbh->prepare(
1832 serialid, aqbooksellerid, name,
1833 biblio.title, biblioitems.issn, planneddate, serialseq,
1834 serial.status, serial.subscriptionid, claimdate, claims_count,
1835 subscription.branchcode, serial.publisheddate
1837 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1838 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1839 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1840 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1841 WHERE subscription.subscriptionid = serial.subscriptionid
1842 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1843 AND subscription.aqbooksellerid=$supplierid
1848 $sth = $dbh->prepare(
1850 serialid, aqbooksellerid, name,
1851 biblio.title, planneddate, serialseq,
1852 serial.status, serial.subscriptionid, claimdate, claims_count,
1853 subscription.branchcode, serial.publisheddate
1855 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1856 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1857 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1858 WHERE subscription.subscriptionid = serial.subscriptionid
1859 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1864 $sth->execute( EXPECTED, LATE, CLAIMED );
1866 while ( my $line = $sth->fetchrow_hashref ) {
1867 $line->{"status".$line->{status}} = 1;
1869 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1870 $line->{additional_fields} = { map { $_->field->name => $_->value }
1871 $subscription_object->additional_field_values->as_list };
1873 push @issuelist, $line;
1880 &updateClaim($serialid)
1882 this function updates the time when a claim is issued for late/missing items
1884 called from claims.pl file
1889 my ($serialids) = @_;
1890 return unless $serialids;
1891 unless ( ref $serialids ) {
1892 $serialids = [ $serialids ];
1894 my $dbh = C4::Context->dbh;
1897 SET claimdate = NOW(),
1898 claims_count = claims_count + 1,
1900 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1901 {}, CLAIMED, @$serialids );
1904 =head2 check_routing
1906 $result = &check_routing($subscriptionid)
1908 this function checks to see if a serial has a routing list and returns the count of routingid
1909 used to show either an 'add' or 'edit' link
1914 my ($subscriptionid) = @_;
1916 return unless ($subscriptionid);
1918 my $dbh = C4::Context->dbh;
1919 my $sth = $dbh->prepare(
1920 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1921 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1922 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1925 $sth->execute($subscriptionid);
1926 my $line = $sth->fetchrow_hashref;
1927 my $result = $line->{'routingids'};
1931 =head2 addroutingmember
1933 addroutingmember($borrowernumber,$subscriptionid)
1935 this function takes a borrowernumber and subscriptionid and adds the member to the
1936 routing list for that serial subscription and gives them a rank on the list
1937 of either 1 or highest current rank + 1
1941 sub addroutingmember {
1942 my ( $borrowernumber, $subscriptionid ) = @_;
1944 return unless ($borrowernumber and $subscriptionid);
1947 my $dbh = C4::Context->dbh;
1948 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1949 $sth->execute($subscriptionid);
1950 while ( my $line = $sth->fetchrow_hashref ) {
1951 if ( $line->{'rank'} > 0 ) {
1952 $rank = $line->{'rank'} + 1;
1957 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1958 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1961 =head2 reorder_members
1963 reorder_members($subscriptionid,$routingid,$rank)
1965 this function is used to reorder the routing list
1967 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1968 - it gets all members on list puts their routingid's into an array
1969 - removes the one in the array that is $routingid
1970 - then reinjects $routingid at point indicated by $rank
1971 - then update the database with the routingids in the new order
1975 sub reorder_members {
1976 my ( $subscriptionid, $routingid, $rank ) = @_;
1977 my $dbh = C4::Context->dbh;
1978 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1979 $sth->execute($subscriptionid);
1981 while ( my $line = $sth->fetchrow_hashref ) {
1982 push( @result, $line->{'routingid'} );
1985 # To find the matching index
1987 my $key = -1; # to allow for 0 being a valid response
1988 for ( $i = 0 ; $i < @result ; $i++ ) {
1989 if ( $routingid == $result[$i] ) {
1990 $key = $i; # save the index
1995 # if index exists in array then move it to new position
1996 if ( $key > -1 && $rank > 0 ) {
1997 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1998 my $moving_item = splice( @result, $key, 1 );
1999 splice( @result, $new_rank, 0, $moving_item );
2001 for ( my $j = 0 ; $j < @result ; $j++ ) {
2002 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2008 =head2 delroutingmember
2010 delroutingmember($routingid,$subscriptionid)
2012 this function either deletes one member from routing list if $routingid exists otherwise
2013 deletes all members from the routing list
2017 sub delroutingmember {
2019 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2020 my ( $routingid, $subscriptionid ) = @_;
2021 my $dbh = C4::Context->dbh;
2023 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2024 $sth->execute($routingid);
2025 reorder_members( $subscriptionid, $routingid );
2027 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2028 $sth->execute($subscriptionid);
2033 =head2 getroutinglist
2035 @routinglist = getroutinglist($subscriptionid)
2037 this gets the info from the subscriptionroutinglist for $subscriptionid
2040 the routinglist as an array. Each element of the array contains a hash_ref containing
2041 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2045 sub getroutinglist {
2046 my ($subscriptionid) = @_;
2047 my $dbh = C4::Context->dbh;
2048 my $sth = $dbh->prepare(
2049 'SELECT routingid, borrowernumber, ranking, biblionumber
2051 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2052 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2054 $sth->execute($subscriptionid);
2055 my $routinglist = $sth->fetchall_arrayref({});
2056 return @{$routinglist};
2059 =head2 countissuesfrom
2061 $result = countissuesfrom($subscriptionid,$startdate)
2063 Returns a count of serial rows matching the given subsctiptionid
2064 with published date greater than startdate
2068 sub countissuesfrom {
2069 my ( $subscriptionid, $startdate ) = @_;
2070 my $dbh = C4::Context->dbh;
2074 WHERE subscriptionid=?
2075 AND serial.publisheddate>?
2077 my $sth = $dbh->prepare($query);
2078 $sth->execute( $subscriptionid, $startdate );
2079 my ($countreceived) = $sth->fetchrow;
2080 return $countreceived;
2085 $result = CountIssues($subscriptionid)
2087 Returns a count of serial rows matching the given subsctiptionid
2092 my ($subscriptionid) = @_;
2093 my $dbh = C4::Context->dbh;
2097 WHERE subscriptionid=?
2099 my $sth = $dbh->prepare($query);
2100 $sth->execute($subscriptionid);
2101 my ($countreceived) = $sth->fetchrow;
2102 return $countreceived;
2107 $result = HasItems($subscriptionid)
2109 returns a count of items from serial matching the subscriptionid
2114 my ($subscriptionid) = @_;
2115 my $dbh = C4::Context->dbh;
2117 SELECT COUNT(serialitems.itemnumber)
2119 LEFT JOIN serialitems USING(serialid)
2120 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2122 my $sth=$dbh->prepare($query);
2123 $sth->execute($subscriptionid);
2124 my ($countitems)=$sth->fetchrow_array();
2128 =head2 abouttoexpire
2130 $result = abouttoexpire($subscriptionid)
2132 this function alerts you to the penultimate issue for a serial subscription
2134 returns 1 - if this is the penultimate issue
2140 my ($subscriptionid) = @_;
2141 my $dbh = C4::Context->dbh;
2142 my $subscription = GetSubscription($subscriptionid);
2143 my $per = $subscription->{'periodicity'};
2144 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2145 if ($frequency and $frequency->{unit}){
2147 my $expirationdate = GetExpirationDate($subscriptionid);
2149 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2150 my $nextdate = GetNextDate($subscription, $res, $frequency);
2152 # only compare dates if both dates exist.
2153 if ($nextdate and $expirationdate) {
2154 if(Date::Calc::Delta_Days(
2155 split( /-/, $nextdate ),
2156 split( /-/, $expirationdate )
2162 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2163 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2169 =head2 GetFictiveIssueNumber
2171 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2173 Get the position of the issue published at $publisheddate, considering the
2174 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2175 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2176 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2177 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2178 depending on how many rows are in serial table.
2179 The issue number calculation is based on subscription frequency, first acquisition
2180 date, and $publisheddate.
2182 Returns undef when called for irregular frequencies.
2184 The routine is used to skip irregularities when calculating the next issue
2185 date (in GetNextDate) or the next issue number (in GetNextSeq).
2189 sub GetFictiveIssueNumber {
2190 my ($subscription, $publisheddate, $frequency) = @_;
2192 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2196 my ( $year, $month, $day ) = split /-/, $publisheddate;
2197 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2198 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2200 if( $frequency->{'unitsperissue'} == 1 ) {
2201 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2202 } else { # issuesperunit == 1
2203 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2209 my ( $date1, $date2, $unit ) = @_;
2210 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2212 if( $unit eq 'day' ) {
2213 return Delta_Days( @$date1, @$date2 );
2214 } elsif( $unit eq 'week' ) {
2215 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2218 # In case of months or years, this is a wrapper around N_Delta_YMD.
2219 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2220 # while we expect 1 month.
2221 my @delta = N_Delta_YMD( @$date1, @$date2 );
2222 if( $delta[2] > 27 ) {
2223 # Check if we could add a month
2224 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2225 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2229 if( $delta[1] >= 12 ) {
2233 # if unit is year, we only return full years
2234 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2237 sub _get_next_date_day {
2238 my ($subscription, $freqdata, $year, $month, $day) = @_;
2240 my @newissue; # ( yy, mm, dd )
2241 # We do not need $delta_days here, since it would be zero where used
2243 if( $freqdata->{issuesperunit} == 1 ) {
2245 @newissue = Add_Delta_Days(
2246 $year, $month, $day, $freqdata->{"unitsperissue"} );
2247 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2249 @newissue = ( $year, $month, $day );
2250 $subscription->{countissuesperunit}++;
2252 # We finished a cycle of issues within a unit.
2253 # No subtraction of zero needed, just add one day
2254 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2255 $subscription->{countissuesperunit} = 1;
2260 sub _get_next_date_week {
2261 my ($subscription, $freqdata, $year, $month, $day) = @_;
2263 my @newissue; # ( yy, mm, dd )
2264 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2266 if( $freqdata->{issuesperunit} == 1 ) {
2267 # Add full weeks (of 7 days)
2268 @newissue = Add_Delta_Days(
2269 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2270 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2271 # Add rounded number of days based on frequency.
2272 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2273 $subscription->{countissuesperunit}++;
2275 # We finished a cycle of issues within a unit.
2276 # Subtract delta * (issues - 1), add 1 week
2277 @newissue = Add_Delta_Days( $year, $month, $day,
2278 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2279 @newissue = Add_Delta_Days( @newissue, 7 );
2280 $subscription->{countissuesperunit} = 1;
2285 sub _get_next_date_month {
2286 my ($subscription, $freqdata, $year, $month, $day) = @_;
2288 my @newissue; # ( yy, mm, dd )
2289 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2291 if( $freqdata->{issuesperunit} == 1 ) {
2293 @newissue = Add_Delta_YM(
2294 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2295 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2296 # Add rounded number of days based on frequency.
2297 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2298 $subscription->{countissuesperunit}++;
2300 # We finished a cycle of issues within a unit.
2301 # Subtract delta * (issues - 1), add 1 month
2302 @newissue = Add_Delta_Days( $year, $month, $day,
2303 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2304 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2305 $subscription->{countissuesperunit} = 1;
2310 sub _get_next_date_year {
2311 my ($subscription, $freqdata, $year, $month, $day) = @_;
2313 my @newissue; # ( yy, mm, dd )
2314 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2316 if( $freqdata->{issuesperunit} == 1 ) {
2318 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2319 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2320 # Add rounded number of days based on frequency.
2321 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2322 $subscription->{countissuesperunit}++;
2324 # We finished a cycle of issues within a unit.
2325 # Subtract delta * (issues - 1), add 1 year
2326 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2327 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2328 $subscription->{countissuesperunit} = 1;
2335 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2337 this function it takes the publisheddate and will return the next issue's date
2338 and will skip dates if there exists an irregularity.
2339 $publisheddate has to be an ISO date
2340 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2341 $frequency is a hashref containing frequency informations
2342 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2343 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2344 skipped then the returned date will be 2007-05-10
2347 $resultdate - then next date in the sequence (ISO date)
2349 Return undef if subscription is irregular
2354 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2356 return unless $subscription and $publisheddate;
2359 if ($freqdata->{'unit'}) {
2360 my ( $year, $month, $day ) = split /-/, $publisheddate;
2362 # Process an irregularity Hash
2363 # Suppose that irregularities are stored in a string with this structure
2364 # irreg1;irreg2;irreg3
2365 # where irregX is the number of issue which will not be received
2366 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2368 if ( $subscription->{irregularity} ) {
2369 my @irreg = split /;/, $subscription->{'irregularity'} ;
2370 foreach my $irregularity (@irreg) {
2371 $irregularities{$irregularity} = 1;
2375 # Get the 'fictive' next issue number
2376 # It is used to check if next issue is an irregular issue.
2377 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2379 # Then get the next date
2380 my $unit = lc $freqdata->{'unit'};
2381 if ($unit eq 'day') {
2382 while ($irregularities{$issueno}) {
2383 ($year, $month, $day) = _get_next_date_day($subscription,
2384 $freqdata, $year, $month, $day);
2387 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2388 $year, $month, $day);
2390 elsif ($unit eq 'week') {
2391 while ($irregularities{$issueno}) {
2392 ($year, $month, $day) = _get_next_date_week($subscription,
2393 $freqdata, $year, $month, $day);
2396 ($year, $month, $day) = _get_next_date_week($subscription,
2397 $freqdata, $year, $month, $day);
2399 elsif ($unit eq 'month') {
2400 while ($irregularities{$issueno}) {
2401 ($year, $month, $day) = _get_next_date_month($subscription,
2402 $freqdata, $year, $month, $day);
2405 ($year, $month, $day) = _get_next_date_month($subscription,
2406 $freqdata, $year, $month, $day);
2408 elsif ($unit eq 'year') {
2409 while ($irregularities{$issueno}) {
2410 ($year, $month, $day) = _get_next_date_year($subscription,
2411 $freqdata, $year, $month, $day);
2414 ($year, $month, $day) = _get_next_date_year($subscription,
2415 $freqdata, $year, $month, $day);
2419 my $dbh = C4::Context->dbh;
2422 SET countissuesperunit = ?
2423 WHERE subscriptionid = ?
2425 my $sth = $dbh->prepare($query);
2426 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2429 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2435 $string = &_numeration($value,$num_type,$locale);
2437 _numeration returns the string corresponding to $value in the num_type
2449 my ($value, $num_type, $locale) = @_;
2454 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2455 # 1970-11-01 was a Sunday
2456 $value = $value % 7;
2457 my $dt = DateTime->new(
2463 $string = $num_type =~ /^dayname$/
2464 ? $dt->strftime("%A")
2465 : $dt->strftime("%a");
2466 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2467 $value = $value % 12;
2468 my $dt = DateTime->new(
2470 month => $value + 1,
2473 $string = $num_type =~ /^monthname$/
2474 ? $dt->format_cldr( "LLLL" )
2475 : $dt->strftime("%b");
2476 } elsif ( $num_type =~ /^season$/ ) {
2477 my @seasons= qw( Spring Summer Fall Winter );
2478 $value = $value % 4;
2479 $string = $seasons[$value];
2480 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2481 my @seasonsabrv= qw( Spr Sum Fal Win );
2482 $value = $value % 4;
2483 $string = $seasonsabrv[$value];
2491 =head2 CloseSubscription
2493 Close a subscription given a subscriptionid
2497 sub CloseSubscription {
2498 my ( $subscriptionid ) = @_;
2499 return unless $subscriptionid;
2500 my $dbh = C4::Context->dbh;
2501 my $sth = $dbh->prepare( q{
2504 WHERE subscriptionid = ?
2506 $sth->execute( $subscriptionid );
2508 # Set status = missing when status = stopped
2509 $sth = $dbh->prepare( q{
2512 WHERE subscriptionid = ?
2515 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2518 =head2 ReopenSubscription
2520 Reopen a subscription given a subscriptionid
2524 sub ReopenSubscription {
2525 my ( $subscriptionid ) = @_;
2526 return unless $subscriptionid;
2527 my $dbh = C4::Context->dbh;
2528 my $sth = $dbh->prepare( q{
2531 WHERE subscriptionid = ?
2533 $sth->execute( $subscriptionid );
2535 # Set status = expected when status = stopped
2536 $sth = $dbh->prepare( q{
2539 WHERE subscriptionid = ?
2542 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2545 =head2 subscriptionCurrentlyOnOrder
2547 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2549 Return 1 if subscription is currently on order else 0.
2553 sub subscriptionCurrentlyOnOrder {
2554 my ( $subscriptionid ) = @_;
2555 my $dbh = C4::Context->dbh;
2557 SELECT COUNT(*) FROM aqorders
2558 WHERE subscriptionid = ?
2559 AND datereceived IS NULL
2560 AND datecancellationprinted IS NULL
2562 my $sth = $dbh->prepare( $query );
2563 $sth->execute($subscriptionid);
2564 return $sth->fetchrow_array;
2567 =head2 can_claim_subscription
2569 $can = can_claim_subscription( $subscriptionid[, $userid] );
2571 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2575 sub can_claim_subscription {
2576 my ( $subscription, $userid ) = @_;
2577 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2580 =head2 can_edit_subscription
2582 $can = can_edit_subscription( $subscriptionid[, $userid] );
2584 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2588 sub can_edit_subscription {
2589 my ( $subscription, $userid ) = @_;
2590 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2593 =head2 can_show_subscription
2595 $can = can_show_subscription( $subscriptionid[, $userid] );
2597 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2601 sub can_show_subscription {
2602 my ( $subscription, $userid ) = @_;
2603 return _can_do_on_subscription( $subscription, $userid, '*' );
2606 sub _can_do_on_subscription {
2607 my ( $subscription, $userid, $permission ) = @_;
2608 return 0 unless C4::Context->userenv;
2609 my $flags = C4::Context->userenv->{flags};
2610 $userid ||= C4::Context->userenv->{'id'};
2612 if ( C4::Context->preference('IndependentBranches') ) {
2614 if C4::Context->IsSuperLibrarian()
2616 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2618 C4::Auth::haspermission( $userid,
2619 { serials => $permission } )
2620 and ( not defined $subscription->{branchcode}
2621 or $subscription->{branchcode} eq ''
2622 or $subscription->{branchcode} eq
2623 C4::Context->userenv->{'branch'} )
2628 if C4::Context->IsSuperLibrarian()
2630 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2631 or C4::Auth::haspermission(
2632 $userid, { serials => $permission }
2639 =head2 findSerialsByStatus
2641 @serials = findSerialsByStatus($status, $subscriptionid);
2643 Returns an array of serials matching a given status and subscription id.
2647 sub findSerialsByStatus {
2648 my ( $status, $subscriptionid ) = @_;
2649 my $dbh = C4::Context->dbh;
2650 my $query = q| SELECT * from serial
2652 AND subscriptionid = ?
2654 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2663 Koha Development Team <http://koha-community.org/>