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::Suggestions;
45 use Koha::SharedContent;
46 use Scalar::Util qw( looks_like_number );
54 MISSING_NEVER_RECIEVED => 41,
55 MISSING_SOLD_OUT => 42,
56 MISSING_DAMAGED => 43,
64 use constant MISSING_STATUSES => (
65 MISSING, MISSING_NEVER_RECIEVED,
66 MISSING_SOLD_OUT, MISSING_DAMAGED,
70 our (@ISA, @EXPORT_OK);
75 NewSubscription ModSubscription DelSubscription
76 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
78 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
79 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
81 GetSubscriptionHistoryFromSubscriptionId
83 GetNextSeq GetSeq NewIssue GetSerials
84 GetLatestSerials ModSerialStatus GetNextDate
85 CloseSubscription ReopenSubscription
86 subscriptionCurrentlyOnOrder
87 can_claim_subscription can_edit_subscription can_show_subscription
89 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
90 GetSerialInformation AddItem2Serial
91 PrepareSerialsData GetNextExpected ModNextExpected
92 GetSubscriptionIrregularities
95 GetSuppliersWithLateIssues
96 getroutinglist delroutingmember addroutingmember
98 check_routing updateClaim
109 C4::Serials - Serials Module Functions
117 Functions for handling subscriptions, claims routing etc.
122 =head2 GetSuppliersWithLateIssues
124 $supplierlist = GetSuppliersWithLateIssues()
126 this function get all suppliers with late issues.
129 an array_ref of suppliers each entry is a hash_ref containing id and name
130 the array is in name order
134 sub GetSuppliersWithLateIssues {
135 my $dbh = C4::Context->dbh;
136 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
138 SELECT DISTINCT id, name
140 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
141 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
144 (planneddate < now() AND serial.status=1)
145 OR serial.STATUS IN ( $statuses )
147 AND subscription.closed = 0
149 return $dbh->selectall_arrayref($query, { Slice => {} });
152 =head2 GetSubscriptionHistoryFromSubscriptionId
154 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
156 This function returns the subscription history as a hashref
160 sub GetSubscriptionHistoryFromSubscriptionId {
161 my ($subscriptionid) = @_;
163 return unless $subscriptionid;
165 my $dbh = C4::Context->dbh;
168 FROM subscriptionhistory
169 WHERE subscriptionid = ?
171 my $sth = $dbh->prepare($query);
172 $sth->execute($subscriptionid);
173 my $results = $sth->fetchrow_hashref;
179 =head2 GetSerialInformation
181 $data = GetSerialInformation($serialid);
182 returns a hash_ref containing :
183 items : items marcrecord (can be an array)
185 subscription table field
186 + information about subscription expiration
190 sub GetSerialInformation {
192 my $dbh = C4::Context->dbh;
194 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
195 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
198 my $rq = $dbh->prepare($query);
199 $rq->execute($serialid);
200 my $data = $rq->fetchrow_hashref;
202 # create item information if we have serialsadditems for this subscription
203 if ( $data->{'serialsadditems'} ) {
204 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
205 $queryitem->execute($serialid);
206 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
208 if ( scalar(@$itemnumbers) > 0 ) {
209 foreach my $itemnum (@$itemnumbers) {
211 #It is ASSUMED that GetMarcItem ALWAYS WORK...
212 #Maybe GetMarcItem should return values on failure
213 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
214 $itemprocessed->{'itemnumber'} = $itemnum->[0];
215 $itemprocessed->{'itemid'} = $itemnum->[0];
216 $itemprocessed->{'serialid'} = $serialid;
217 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
218 push @{ $data->{'items'} }, $itemprocessed;
221 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
222 $itemprocessed->{'itemid'} = "N$serialid";
223 $itemprocessed->{'serialid'} = $serialid;
224 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
225 $itemprocessed->{'countitems'} = 0;
226 push @{ $data->{'items'} }, $itemprocessed;
229 $data->{ "status" . $data->{'serstatus'} } = 1;
230 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
231 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
232 $data->{cannotedit} = not can_edit_subscription( $data );
236 =head2 AddItem2Serial
238 $rows = AddItem2Serial($serialid,$itemnumber);
239 Adds an itemnumber to Serial record
240 returns the number of rows affected
245 my ( $serialid, $itemnumber ) = @_;
247 return unless ($serialid and $itemnumber);
249 my $dbh = C4::Context->dbh;
250 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
251 $rq->execute( $serialid, $itemnumber );
255 =head2 GetSubscription
257 $subs = GetSubscription($subscriptionid)
258 this function returns the subscription which has $subscriptionid as id.
260 a hashref. This hash contains
261 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
265 sub GetSubscription {
266 my ($subscriptionid) = @_;
267 my $dbh = C4::Context->dbh;
269 SELECT subscription.*,
270 subscriptionhistory.*,
271 aqbooksellers.name AS aqbooksellername,
272 biblio.title AS bibliotitle,
273 biblio.subtitle AS bibliosubtitle,
274 subscription.biblionumber as bibnum
276 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
277 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
278 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
279 WHERE subscription.subscriptionid = ?
282 my $sth = $dbh->prepare($query);
283 $sth->execute($subscriptionid);
284 my $subscription = $sth->fetchrow_hashref;
286 return unless $subscription;
288 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
290 if ( my $mana_id = $subscription->{mana_id} ) {
291 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
292 'subscription', $mana_id, {usecomments => 1});
293 $subscription->{comments} = $mana_subscription->{data}->{comments};
296 return $subscription;
299 =head2 GetFullSubscription
301 $array_ref = GetFullSubscription($subscriptionid)
302 this function reads the serial table.
306 sub GetFullSubscription {
307 my ($subscriptionid) = @_;
309 return unless ($subscriptionid);
311 my $dbh = C4::Context->dbh;
313 SELECT serial.serialid,
316 serial.publisheddate,
317 serial.publisheddatetext,
319 serial.notes as notes,
320 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
321 aqbooksellers.name as aqbooksellername,
322 biblio.title as bibliotitle,
323 subscription.branchcode AS branchcode,
324 subscription.subscriptionid AS subscriptionid
326 LEFT JOIN subscription ON
327 (serial.subscriptionid=subscription.subscriptionid )
328 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
329 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
330 WHERE serial.subscriptionid = ?
332 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
333 serial.subscriptionid
335 my $sth = $dbh->prepare($query);
336 $sth->execute($subscriptionid);
337 my $subscriptions = $sth->fetchall_arrayref( {} );
338 if (scalar @$subscriptions) {
339 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
340 for my $subscription ( @$subscriptions ) {
341 $subscription->{cannotedit} = $cannotedit;
345 return $subscriptions;
348 =head2 PrepareSerialsData
350 $array_ref = PrepareSerialsData($serialinfomation)
351 where serialinformation is a hashref array
355 sub PrepareSerialsData {
358 return unless ($lines);
365 my $previousnote = "";
367 foreach my $subs (@{$lines}) {
368 $subs->{ "status" . $subs->{'status'} } = 1;
369 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
370 $subs->{"checked"} = 1;
373 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
374 $year = $subs->{'year'};
378 if ( $tmpresults{$year} ) {
379 push @{ $tmpresults{$year}->{'serials'} }, $subs;
381 $tmpresults{$year} = {
383 'aqbooksellername' => $subs->{'aqbooksellername'},
384 'bibliotitle' => $subs->{'bibliotitle'},
385 'serials' => [$subs],
390 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
391 push @res, $tmpresults{$key};
396 =head2 GetSubscriptionsFromBiblionumber
398 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
399 this function get the subscription list. it reads the subscription table.
401 reference to an array of subscriptions which have the biblionumber given on input arg.
402 each element of this array is a hashref containing
403 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
407 sub GetSubscriptionsFromBiblionumber {
408 my ($biblionumber) = @_;
410 return unless ($biblionumber);
412 my $dbh = C4::Context->dbh;
414 SELECT subscription.*,
416 subscriptionhistory.*,
417 aqbooksellers.name AS aqbooksellername,
418 biblio.title AS bibliotitle
420 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
421 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
422 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
423 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
424 WHERE subscription.biblionumber = ?
426 my $sth = $dbh->prepare($query);
427 $sth->execute($biblionumber);
429 while ( my $subs = $sth->fetchrow_hashref ) {
430 $subs->{opacnote} //= "";
431 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
432 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
433 $subs->{ "status" . $subs->{'status'} } = 1;
435 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
436 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
437 $subs->{cannotedit} = not can_edit_subscription( $subs );
443 =head2 GetFullSubscriptionsFromBiblionumber
445 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
446 this function reads the serial table.
450 sub GetFullSubscriptionsFromBiblionumber {
451 my ($biblionumber) = @_;
452 my $dbh = C4::Context->dbh;
454 SELECT serial.serialid,
457 serial.publisheddate,
458 serial.publisheddatetext,
460 serial.notes as notes,
461 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
462 biblio.title as bibliotitle,
463 subscription.branchcode AS branchcode,
464 subscription.subscriptionid AS subscriptionid,
465 subscription.location AS location
467 LEFT JOIN subscription ON
468 (serial.subscriptionid=subscription.subscriptionid)
469 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
470 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
471 WHERE subscription.biblionumber = ?
473 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
474 serial.subscriptionid
476 my $sth = $dbh->prepare($query);
477 $sth->execute($biblionumber);
478 my $subscriptions = $sth->fetchall_arrayref( {} );
479 if (scalar @$subscriptions) {
480 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
481 for my $subscription ( @$subscriptions ) {
482 $subscription->{cannotedit} = $cannotedit;
486 return $subscriptions;
489 =head2 SearchSubscriptions
491 @results = SearchSubscriptions($args);
493 This function returns a list of hashrefs, one for each subscription
494 that meets the conditions specified by the $args hashref.
496 The valid search fields are:
510 The expiration_date search field is special; it specifies the maximum
511 subscription expiration date.
515 sub SearchSubscriptions {
518 my $additional_fields = $args->{additional_fields} // [];
519 my $matching_record_ids_for_additional_fields = [];
520 if ( @$additional_fields ) {
521 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
523 return () unless @subscriptions;
525 $matching_record_ids_for_additional_fields = [ map {
532 subscription.notes AS publicnotes,
533 subscriptionhistory.*,
535 biblio.notes AS biblionotes,
540 aqbooksellers.name AS vendorname,
543 LEFT JOIN subscriptionhistory USING(subscriptionid)
544 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
545 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
546 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
548 $query .= q| WHERE 1|;
551 if( $args->{biblionumber} ) {
552 push @where_strs, "biblio.biblionumber = ?";
553 push @where_args, $args->{biblionumber};
556 if( $args->{title} ){
557 my @words = split / /, $args->{title};
559 foreach my $word (@words) {
560 push @strs, "biblio.title LIKE ?";
561 push @args, "%$word%";
564 push @where_strs, '(' . join (' AND ', @strs) . ')';
565 push @where_args, @args;
569 push @where_strs, "biblioitems.issn LIKE ?";
570 push @where_args, "%$args->{issn}%";
573 push @where_strs, "biblioitems.ean LIKE ?";
574 push @where_args, "%$args->{ean}%";
576 if ( $args->{callnumber} ) {
577 push @where_strs, "subscription.callnumber LIKE ?";
578 push @where_args, "%$args->{callnumber}%";
580 if( $args->{publisher} ){
581 push @where_strs, "biblioitems.publishercode LIKE ?";
582 push @where_args, "%$args->{publisher}%";
584 if( $args->{bookseller} ){
585 push @where_strs, "aqbooksellers.name LIKE ?";
586 push @where_args, "%$args->{bookseller}%";
588 if( $args->{branch} ){
589 push @where_strs, "subscription.branchcode = ?";
590 push @where_args, "$args->{branch}";
592 if ( $args->{location} ) {
593 push @where_strs, "subscription.location = ?";
594 push @where_args, "$args->{location}";
596 if ( $args->{expiration_date} ) {
597 push @where_strs, "subscription.enddate <= ?";
598 push @where_args, "$args->{expiration_date}";
600 if( defined $args->{closed} ){
601 push @where_strs, "subscription.closed = ?";
602 push @where_args, "$args->{closed}";
606 $query .= ' AND ' . join(' AND ', @where_strs);
608 if ( @$additional_fields ) {
609 $query .= ' AND subscriptionid IN ('
610 . join( ', ', @$matching_record_ids_for_additional_fields )
614 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
616 my $dbh = C4::Context->dbh;
617 my $sth = $dbh->prepare($query);
618 $sth->execute(@where_args);
619 my $results = $sth->fetchall_arrayref( {} );
621 for my $subscription ( @$results ) {
622 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
623 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
625 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
626 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
627 $subscription_object->additional_field_values->as_list };
637 ($totalissues,@serials) = GetSerials($subscriptionid);
638 this function gets every serial not arrived for a given subscription
639 as well as the number of issues registered in the database (all types)
640 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
642 FIXME: We should return \@serials.
647 my ( $subscriptionid, $count ) = @_;
649 return unless $subscriptionid;
651 my $dbh = C4::Context->dbh;
653 # status = 2 is "arrived"
655 $count = 5 unless ($count);
657 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
658 my $query = "SELECT serialid,serialseq, status, publisheddate,
659 publisheddatetext, planneddate,notes, routingnotes
661 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
662 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
663 my $sth = $dbh->prepare($query);
664 $sth->execute($subscriptionid);
666 while ( my $line = $sth->fetchrow_hashref ) {
667 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
668 push @serials, $line;
671 # OK, now add the last 5 issues arrives/missing
672 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
673 publisheddatetext, notes, routingnotes
675 WHERE subscriptionid = ?
676 AND status IN ( $statuses )
677 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
679 $sth = $dbh->prepare($query);
680 $sth->execute($subscriptionid);
681 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
683 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
685 push @serials, $line;
688 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
689 $sth = $dbh->prepare($query);
690 $sth->execute($subscriptionid);
691 my ($totalissues) = $sth->fetchrow;
692 return ( $totalissues, @serials );
697 @serials = GetSerials2($subscriptionid,$statuses);
698 this function returns every serial waited for a given subscription
699 as well as the number of issues registered in the database (all types)
700 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
702 $statuses is an arrayref of statuses and is mandatory.
707 my ( $subscription, $statuses ) = @_;
709 return unless ($subscription and @$statuses);
711 my $dbh = C4::Context->dbh;
713 SELECT serialid,serialseq, status, planneddate, publisheddate,
714 publisheddatetext, notes, routingnotes
716 WHERE subscriptionid=?
718 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
720 ORDER BY publisheddate,serialid DESC
722 my $sth = $dbh->prepare($query);
723 $sth->execute( $subscription, @$statuses );
726 while ( my $line = $sth->fetchrow_hashref ) {
727 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
728 push @serials, $line;
733 =head2 GetLatestSerials
735 \@serials = GetLatestSerials($subscriptionid,$limit)
736 get the $limit's latest serials arrived or missing for a given subscription
738 a ref to an array which contains all of the latest serials stored into a hash.
742 sub GetLatestSerials {
743 my ( $subscriptionid, $limit ) = @_;
745 return unless ($subscriptionid and $limit);
747 my $dbh = C4::Context->dbh;
749 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
750 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, publisheddatetext, notes
752 WHERE subscriptionid = ?
753 AND status IN ($statuses)
754 ORDER BY publisheddate DESC LIMIT 0,$limit
756 my $sth = $dbh->prepare($strsth);
757 $sth->execute($subscriptionid);
759 while ( my $line = $sth->fetchrow_hashref ) {
760 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
761 push @serials, $line;
767 =head2 GetPreviousSerialid
769 $serialid = GetPreviousSerialid($subscriptionid, $nth)
770 get the $nth's previous serial for the given subscriptionid
776 sub GetPreviousSerialid {
777 my ( $subscriptionid, $nth ) = @_;
779 my $dbh = C4::Context->dbh;
783 my $strsth = "SELECT serialid
785 WHERE subscriptionid = ?
787 ORDER BY serialid DESC LIMIT $nth,1
789 my $sth = $dbh->prepare($strsth);
790 $sth->execute($subscriptionid);
792 my $line = $sth->fetchrow_hashref;
793 $return = $line->{'serialid'} if ($line);
801 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
802 $newinnerloop1, $newinnerloop2, $newinnerloop3
803 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
805 $subscription is a hashref containing all the attributes of the table
807 $pattern is a hashref containing all the attributes of the table
808 'subscription_numberpatterns'.
809 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
810 $planneddate is a date string in iso format.
811 This function get the next issue for the subscription given on input arg
816 my ($subscription, $pattern, $frequency, $planneddate) = @_;
818 return unless ($subscription and $pattern);
820 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
821 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
824 if ($subscription->{'skip_serialseq'}) {
825 my @irreg = split /;/, $subscription->{'irregularity'};
827 my $irregularities = {};
828 $irregularities->{$_} = 1 foreach(@irreg);
829 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
830 while($irregularities->{$issueno}) {
837 my $numberingmethod = $pattern->{numberingmethod};
839 if ($numberingmethod) {
840 $calculated = $numberingmethod;
841 my $locale = $subscription->{locale};
842 $newlastvalue1 = $subscription->{lastvalue1} || 0;
843 $newlastvalue2 = $subscription->{lastvalue2} || 0;
844 $newlastvalue3 = $subscription->{lastvalue3} || 0;
845 $newinnerloop1 = $subscription->{innerloop1} || 0;
846 $newinnerloop2 = $subscription->{innerloop2} || 0;
847 $newinnerloop3 = $subscription->{innerloop3} || 0;
850 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
853 for(my $i = 0; $i < $count; $i++) {
855 # check if we have to increase the new value.
857 if ($newinnerloop1 >= $pattern->{every1}) {
859 $newlastvalue1 += $pattern->{add1};
861 # reset counter if needed.
862 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
865 # check if we have to increase the new value.
867 if ($newinnerloop2 >= $pattern->{every2}) {
869 $newlastvalue2 += $pattern->{add2};
871 # reset counter if needed.
872 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
875 # check if we have to increase the new value.
877 if ($newinnerloop3 >= $pattern->{every3}) {
879 $newlastvalue3 += $pattern->{add3};
881 # reset counter if needed.
882 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
886 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
887 $calculated =~ s/\{X\}/$newlastvalue1string/g;
890 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
891 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
894 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
895 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
900 $newlastvalue1, $newlastvalue2, $newlastvalue3,
901 $newinnerloop1, $newinnerloop2, $newinnerloop3);
906 $calculated = GetSeq($subscription, $pattern)
907 $subscription is a hashref containing all the attributes of the table 'subscription'
908 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
909 this function transforms {X},{Y},{Z} to 150,0,0 for example.
911 the sequence in string format
916 my ($subscription, $pattern) = @_;
918 return unless ($subscription and $pattern);
920 my $locale = $subscription->{locale};
922 my $calculated = $pattern->{numberingmethod};
924 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
925 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
926 $calculated =~ s/\{X\}/$newlastvalue1/g;
928 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
929 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
930 $calculated =~ s/\{Y\}/$newlastvalue2/g;
932 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
933 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
934 $calculated =~ s/\{Z\}/$newlastvalue3/g;
938 =head2 GetExpirationDate
940 $enddate = GetExpirationDate($subscriptionid, [$startdate])
942 this function return the next expiration date for a subscription given on input args.
949 sub GetExpirationDate {
950 my ( $subscriptionid, $startdate ) = @_;
952 return unless ($subscriptionid);
954 my $dbh = C4::Context->dbh;
955 my $subscription = GetSubscription($subscriptionid);
958 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
959 $enddate = $startdate || $subscription->{startdate};
960 my @date = split( /-/, $enddate );
962 return if ( scalar(@date) != 3 || not check_date(@date) );
964 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
965 if ( $frequency and $frequency->{unit} ) {
968 if ( my $length = $subscription->{numberlength} ) {
970 #calculate the date of the last issue.
971 for ( my $i = 1 ; $i <= $length ; $i++ ) {
972 $enddate = GetNextDate( $subscription, $enddate, $frequency );
974 } elsif ( $subscription->{monthlength} ) {
975 if ( $$subscription{startdate} ) {
976 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
977 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
979 } elsif ( $subscription->{weeklength} ) {
980 if ( $$subscription{startdate} ) {
981 my @date = split( /-/, $subscription->{startdate} );
982 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
983 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
986 $enddate = $subscription->{enddate};
990 return $subscription->{enddate};
994 =head2 CountSubscriptionFromBiblionumber
996 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
997 this returns a count of the subscriptions for a given biblionumber
999 the number of subscriptions
1003 sub CountSubscriptionFromBiblionumber {
1004 my ($biblionumber) = @_;
1006 return unless ($biblionumber);
1008 my $dbh = C4::Context->dbh;
1009 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1010 my $sth = $dbh->prepare($query);
1011 $sth->execute($biblionumber);
1012 my $subscriptionsnumber = $sth->fetchrow;
1013 return $subscriptionsnumber;
1016 =head2 ModSubscriptionHistory
1018 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1020 this function modifies the history of a subscription. Put your new values on input arg.
1021 returns the number of rows affected
1025 sub ModSubscriptionHistory {
1026 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1028 return unless ($subscriptionid);
1030 my $dbh = C4::Context->dbh;
1031 my $query = "UPDATE subscriptionhistory
1032 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1033 WHERE subscriptionid=?
1035 my $sth = $dbh->prepare($query);
1036 $receivedlist =~ s/^; // if $receivedlist;
1037 $missinglist =~ s/^; // if $missinglist;
1038 $opacnote =~ s/^; // if $opacnote;
1039 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1043 =head2 ModSerialStatus
1045 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1046 $publisheddatetext, $status, $notes);
1048 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1049 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1053 sub ModSerialStatus {
1054 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1055 $status, $notes) = @_;
1057 return unless ($serialid);
1059 #It is a usual serial
1060 # 1st, get previous status :
1061 my $dbh = C4::Context->dbh;
1062 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1063 FROM serial, subscription
1064 WHERE serial.subscriptionid=subscription.subscriptionid
1066 my $sth = $dbh->prepare($query);
1067 $sth->execute($serialid);
1068 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1069 my $frequency = GetSubscriptionFrequency($periodicity);
1071 # change status & update subscriptionhistory
1073 if ( $status == DELETED ) {
1074 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1078 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1079 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1082 $sth = $dbh->prepare($query);
1083 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1084 $planneddate, $status, $notes, $routingnotes, $serialid );
1085 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1086 $sth = $dbh->prepare($query);
1087 $sth->execute($subscriptionid);
1088 my $val = $sth->fetchrow_hashref;
1089 unless ( $val->{manualhistory} ) {
1090 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1091 $sth = $dbh->prepare($query);
1092 $sth->execute($subscriptionid);
1093 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1095 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1096 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1099 # in case serial has been previously marked as missing
1100 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1101 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1104 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1105 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1107 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1108 $sth = $dbh->prepare($query);
1109 $recievedlist =~ s/^; //;
1110 $missinglist =~ s/^; //;
1111 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1115 # create new expected entry if needed (ie : was "expected" and has changed)
1116 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1117 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1118 my $subscription = GetSubscription($subscriptionid);
1119 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1120 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1124 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1125 $newinnerloop1, $newinnerloop2, $newinnerloop3
1127 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1129 # next date (calculated from actual date & frequency parameters)
1130 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1131 my $nextpubdate = $nextpublisheddate;
1132 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1133 WHERE subscriptionid = ?";
1134 $sth = $dbh->prepare($query);
1135 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1136 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1137 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1138 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1139 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1140 require C4::Letters;
1141 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1149 # Adds or removes seqno from list when needed; returns list
1150 # Or checks and returns true when present
1152 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1154 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1156 if( !$op or $op eq 'ADD' ) {
1157 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1158 } elsif( $op eq 'REMOVE' ) {
1159 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1161 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1166 =head2 GetNextExpected
1168 $nextexpected = GetNextExpected($subscriptionid)
1170 Get the planneddate for the current expected issue of the subscription.
1176 planneddate => ISO date
1181 sub GetNextExpected {
1182 my ($subscriptionid) = @_;
1184 my $dbh = C4::Context->dbh;
1188 WHERE subscriptionid = ?
1192 my $sth = $dbh->prepare($query);
1194 # Each subscription has only one 'expected' issue.
1195 $sth->execute( $subscriptionid, EXPECTED );
1196 my $nextissue = $sth->fetchrow_hashref;
1197 if ( !$nextissue ) {
1201 WHERE subscriptionid = ?
1202 ORDER BY publisheddate DESC
1205 $sth = $dbh->prepare($query);
1206 $sth->execute($subscriptionid);
1207 $nextissue = $sth->fetchrow_hashref;
1209 foreach(qw/planneddate publisheddate/) {
1210 # or should this default to 1st Jan ???
1211 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1217 =head2 ModNextExpected
1219 ModNextExpected($subscriptionid,$date)
1221 Update the planneddate for the current expected issue of the subscription.
1222 This will modify all future prediction results.
1224 C<$date> is an ISO date.
1230 sub ModNextExpected {
1231 my ( $subscriptionid, $date ) = @_;
1232 my $dbh = C4::Context->dbh;
1234 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1235 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1237 # Each subscription has only one 'expected' issue.
1238 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1243 =head2 GetSubscriptionIrregularities
1247 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1248 get the list of irregularities for a subscription
1254 sub GetSubscriptionIrregularities {
1255 my $subscriptionid = shift;
1257 return unless $subscriptionid;
1259 my $dbh = C4::Context->dbh;
1263 WHERE subscriptionid = ?
1265 my $sth = $dbh->prepare($query);
1266 $sth->execute($subscriptionid);
1268 my ($result) = $sth->fetchrow_array;
1269 my @irreg = split /;/, $result;
1274 =head2 ModSubscription
1276 this function modifies a subscription. Put all new values on input args.
1277 returns the number of rows affected
1281 sub ModSubscription {
1283 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1284 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1285 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1286 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1287 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1288 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1289 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1290 $itemtype, $previousitemtype, $mana_id, $ccode
1293 my $subscription = Koha::Subscriptions->find($subscriptionid);
1296 librarian => $auser,
1297 branchcode => $branchcode,
1298 aqbooksellerid => $aqbooksellerid,
1300 aqbudgetid => $aqbudgetid,
1301 biblionumber => $biblionumber,
1302 startdate => $startdate,
1303 periodicity => $periodicity,
1304 numberlength => $numberlength,
1305 weeklength => $weeklength,
1306 monthlength => $monthlength,
1307 lastvalue1 => $lastvalue1,
1308 innerloop1 => $innerloop1,
1309 lastvalue2 => $lastvalue2,
1310 innerloop2 => $innerloop2,
1311 lastvalue3 => $lastvalue3,
1312 innerloop3 => $innerloop3,
1316 firstacquidate => $firstacquidate,
1317 irregularity => $irregularity,
1318 numberpattern => $numberpattern,
1320 callnumber => $callnumber,
1321 manualhistory => $manualhistory,
1322 internalnotes => $internalnotes,
1323 serialsadditems => $serialsadditems,
1324 staffdisplaycount => $staffdisplaycount,
1325 opacdisplaycount => $opacdisplaycount,
1326 graceperiod => $graceperiod,
1327 location => $location,
1328 enddate => $enddate,
1329 skip_serialseq => $skip_serialseq,
1330 itemtype => $itemtype,
1331 previousitemtype => $previousitemtype,
1332 mana_id => $mana_id,
1336 # FIXME Must be $subscription->serials
1337 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1338 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1340 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1342 $subscription->discard_changes;
1343 return $subscription;
1346 =head2 NewSubscription
1348 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1349 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1350 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1351 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1352 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1353 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1354 $skip_serialseq, $itemtype, $previousitemtype);
1356 Create a new subscription with value given on input args.
1359 the id of this new subscription
1363 sub NewSubscription {
1365 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1366 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1367 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1368 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1369 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1370 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1371 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode
1373 my $dbh = C4::Context->dbh;
1375 my $subscription = Koha::Subscription->new(
1377 librarian => $auser,
1378 branchcode => $branchcode,
1379 aqbooksellerid => $aqbooksellerid,
1381 aqbudgetid => $aqbudgetid,
1382 biblionumber => $biblionumber,
1383 startdate => $startdate,
1384 periodicity => $periodicity,
1385 numberlength => $numberlength,
1386 weeklength => $weeklength,
1387 monthlength => $monthlength,
1388 lastvalue1 => $lastvalue1,
1389 innerloop1 => $innerloop1,
1390 lastvalue2 => $lastvalue2,
1391 innerloop2 => $innerloop2,
1392 lastvalue3 => $lastvalue3,
1393 innerloop3 => $innerloop3,
1397 firstacquidate => $firstacquidate,
1398 irregularity => $irregularity,
1399 numberpattern => $numberpattern,
1401 callnumber => $callnumber,
1402 manualhistory => $manualhistory,
1403 internalnotes => $internalnotes,
1404 serialsadditems => $serialsadditems,
1405 staffdisplaycount => $staffdisplaycount,
1406 opacdisplaycount => $opacdisplaycount,
1407 graceperiod => $graceperiod,
1408 location => $location,
1409 enddate => $enddate,
1410 skip_serialseq => $skip_serialseq,
1411 itemtype => $itemtype,
1412 previousitemtype => $previousitemtype,
1413 mana_id => $mana_id,
1417 $subscription->discard_changes;
1418 my $subscriptionid = $subscription->subscriptionid;
1419 my ( $query, $sth );
1421 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1425 WHERE subscriptionid=?
1427 $sth = $dbh->prepare($query);
1428 $sth->execute( $enddate, $subscriptionid );
1431 # then create the 1st expected number
1433 INSERT INTO subscriptionhistory
1434 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1435 VALUES (?,?,?, '', '')
1437 $sth = $dbh->prepare($query);
1438 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1440 # reread subscription to get a hash (for calculation of the 1st issue number)
1441 $subscription = GetSubscription($subscriptionid); # We should not do that
1442 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1444 # calculate issue number
1445 my $serialseq = GetSeq($subscription, $pattern) || q{};
1449 serialseq => $serialseq,
1450 serialseq_x => $subscription->{'lastvalue1'},
1451 serialseq_y => $subscription->{'lastvalue2'},
1452 serialseq_z => $subscription->{'lastvalue3'},
1453 subscriptionid => $subscriptionid,
1454 biblionumber => $biblionumber,
1456 planneddate => $firstacquidate,
1457 publisheddate => $firstacquidate,
1461 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1463 #set serial flag on biblio if not already set.
1464 my $biblio = Koha::Biblios->find( $biblionumber );
1465 if ( $biblio and !$biblio->serial ) {
1466 my $record = $biblio->metadata->record;
1467 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1469 eval { $record->field($tag)->update( $subf => 1 ); };
1471 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1473 return $subscriptionid;
1476 =head2 GetSubscriptionLength
1478 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1480 This function calculates the subscription length.
1484 sub GetSubscriptionLength {
1485 my ($subtype, $length) = @_;
1487 return unless looks_like_number($length);
1491 $subtype eq 'issues' ? $length : 0,
1492 $subtype eq 'weeks' ? $length : 0,
1493 $subtype eq 'months' ? $length : 0,
1498 =head2 ReNewSubscription
1500 ReNewSubscription($params);
1502 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1504 this function renew a subscription with values given on input args.
1508 sub ReNewSubscription {
1509 my ( $params ) = @_;
1510 my $subscriptionid = $params->{subscriptionid};
1511 my $user = $params->{user};
1512 my $startdate = $params->{startdate};
1513 my $numberlength = $params->{numberlength};
1514 my $weeklength = $params->{weeklength};
1515 my $monthlength = $params->{monthlength};
1516 my $note = $params->{note};
1517 my $branchcode = $params->{branchcode};
1519 my $dbh = C4::Context->dbh;
1520 my $subscription = GetSubscription($subscriptionid);
1524 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1525 WHERE biblio.biblionumber=?
1527 my $sth = $dbh->prepare($query);
1528 $sth->execute( $subscription->{biblionumber} );
1529 my $biblio = $sth->fetchrow_hashref;
1531 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1532 Koha::Suggestion->new(
1534 'suggestedby' => $user,
1535 'title' => $subscription->{bibliotitle},
1536 'author' => $biblio->{author},
1537 'publishercode' => $biblio->{publishercode},
1539 'biblionumber' => $subscription->{biblionumber},
1540 'branchcode' => $branchcode,
1545 $numberlength ||= 0; # Should not we raise an exception instead?
1548 # renew subscription
1551 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1552 WHERE subscriptionid=?
1554 $sth = $dbh->prepare($query);
1555 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1556 my $enddate = GetExpirationDate($subscriptionid);
1560 WHERE subscriptionid=?
1562 $sth = $dbh->prepare($query);
1563 $sth->execute( $enddate, $subscriptionid );
1565 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1571 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1573 Create a new issue stored on the database.
1574 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1575 returns the serial id
1580 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1581 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1582 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1584 return unless ($subscriptionid);
1586 my $schema = Koha::Database->new()->schema();
1588 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1590 my $serial = Koha::Serial->new(
1592 serialseq => $serialseq,
1593 serialseq_x => $subscription->lastvalue1(),
1594 serialseq_y => $subscription->lastvalue2(),
1595 serialseq_z => $subscription->lastvalue3(),
1596 subscriptionid => $subscriptionid,
1597 biblionumber => $biblionumber,
1599 planneddate => $planneddate,
1600 publisheddate => $publisheddate,
1601 publisheddatetext => $publisheddatetext,
1603 routingnotes => $routingnotes
1607 my $serialid = $serial->id();
1609 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1610 my $missinglist = $subscription_history->missinglist();
1611 my $recievedlist = $subscription_history->recievedlist();
1613 if ( $status == ARRIVED ) {
1614 ### TODO Add a feature that improves recognition and description.
1615 ### As such count (serialseq) i.e. : N18,2(N19),N20
1616 ### Would use substr and index But be careful to previous presence of ()
1617 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1619 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1620 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1623 $recievedlist =~ s/^; //;
1624 $missinglist =~ s/^; //;
1626 $subscription_history->recievedlist($recievedlist);
1627 $subscription_history->missinglist($missinglist);
1628 $subscription_history->store();
1633 =head2 HasSubscriptionStrictlyExpired
1635 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1637 the subscription has stricly expired when today > the end subscription date
1640 1 if true, 0 if false, -1 if the expiration date is not set.
1644 sub HasSubscriptionStrictlyExpired {
1646 # Getting end of subscription date
1647 my ($subscriptionid) = @_;
1649 return unless ($subscriptionid);
1651 my $dbh = C4::Context->dbh;
1652 my $subscription = GetSubscription($subscriptionid);
1653 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1655 # If the expiration date is set
1656 if ( $expirationdate != 0 ) {
1657 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1659 # Getting today's date
1660 my ( $nowyear, $nowmonth, $nowday ) = Today();
1662 # if today's date > expiration date, then the subscription has stricly expired
1663 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1670 # There are some cases where the expiration date is not set
1671 # As we can't determine if the subscription has expired on a date-basis,
1677 =head2 HasSubscriptionExpired
1679 $has_expired = HasSubscriptionExpired($subscriptionid)
1681 the subscription has expired when the next issue to arrive is out of subscription limit.
1684 0 if the subscription has not expired
1685 1 if the subscription has expired
1686 2 if has subscription does not have a valid expiration date set
1690 sub HasSubscriptionExpired {
1691 my ($subscriptionid) = @_;
1693 return unless ($subscriptionid);
1695 my $dbh = C4::Context->dbh;
1696 my $subscription = GetSubscription($subscriptionid);
1697 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1698 if ( $frequency and $frequency->{unit} ) {
1699 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1700 if (!defined $expirationdate) {
1701 $expirationdate = q{};
1704 SELECT max(planneddate)
1706 WHERE subscriptionid=?
1708 my $sth = $dbh->prepare($query);
1709 $sth->execute($subscriptionid);
1710 my ($res) = $sth->fetchrow;
1711 if (!$res || $res=~m/^0000/) {
1714 my @res = split( /-/, $res );
1715 my @endofsubscriptiondate = split( /-/, $expirationdate );
1716 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1718 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1723 if ( $subscription->{'numberlength'} ) {
1724 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1725 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1731 return 0; # Notice that you'll never get here.
1734 =head2 DelSubscription
1736 DelSubscription($subscriptionid)
1737 this function deletes subscription which has $subscriptionid as id.
1741 sub DelSubscription {
1742 my ($subscriptionid) = @_;
1743 my $dbh = C4::Context->dbh;
1744 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1746 Koha::AdditionalFieldValues->search({
1747 'field.tablename' => 'subscription',
1748 'me.record_id' => $subscriptionid,
1749 }, { join => 'field' })->delete;
1751 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1756 DelIssue($serialseq,$subscriptionid)
1757 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1759 returns the number of rows affected
1764 my ($dataissue) = @_;
1765 my $dbh = C4::Context->dbh;
1766 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1771 AND subscriptionid= ?
1773 my $mainsth = $dbh->prepare($query);
1774 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1776 #Delete element from subscription history
1777 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1778 my $sth = $dbh->prepare($query);
1779 $sth->execute( $dataissue->{'subscriptionid'} );
1780 my $val = $sth->fetchrow_hashref;
1781 unless ( $val->{manualhistory} ) {
1783 SELECT * FROM subscriptionhistory
1784 WHERE subscriptionid= ?
1786 my $sth = $dbh->prepare($query);
1787 $sth->execute( $dataissue->{'subscriptionid'} );
1788 my $data = $sth->fetchrow_hashref;
1789 my $serialseq = $dataissue->{'serialseq'};
1790 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1791 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1792 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1793 $sth = $dbh->prepare($strsth);
1794 $sth->execute( $dataissue->{'subscriptionid'} );
1797 return $mainsth->rows;
1800 =head2 GetLateOrMissingIssues
1802 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1804 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1807 the issuelist as an array of hash refs. Each element of this array contains
1808 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1812 sub GetLateOrMissingIssues {
1813 my ( $supplierid, $serialid, $order ) = @_;
1815 return unless ( $supplierid or $serialid );
1817 my $dbh = C4::Context->dbh;
1822 $byserial = "and serialid = " . $serialid;
1825 $order .= ", title";
1829 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1831 $sth = $dbh->prepare(
1833 serialid, aqbooksellerid, name,
1834 biblio.title, biblioitems.issn, planneddate, serialseq,
1835 serial.status, serial.subscriptionid, claimdate, claims_count,
1836 subscription.branchcode, serial.publisheddate
1838 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1839 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1840 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1841 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1842 WHERE subscription.subscriptionid = serial.subscriptionid
1843 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1844 AND subscription.aqbooksellerid=$supplierid
1849 $sth = $dbh->prepare(
1851 serialid, aqbooksellerid, name,
1852 biblio.title, planneddate, serialseq,
1853 serial.status, serial.subscriptionid, claimdate, claims_count,
1854 subscription.branchcode, serial.publisheddate
1856 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1857 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1858 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1859 WHERE subscription.subscriptionid = serial.subscriptionid
1860 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1865 $sth->execute( EXPECTED, LATE, CLAIMED );
1867 while ( my $line = $sth->fetchrow_hashref ) {
1868 $line->{"status".$line->{status}} = 1;
1870 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1871 $line->{additional_fields} = { map { $_->field->name => $_->value }
1872 $subscription_object->additional_field_values->as_list };
1874 push @issuelist, $line;
1881 &updateClaim($serialid)
1883 this function updates the time when a claim is issued for late/missing items
1885 called from claims.pl file
1890 my ($serialids) = @_;
1891 return unless $serialids;
1892 unless ( ref $serialids ) {
1893 $serialids = [ $serialids ];
1896 foreach my $serialid(@$serialids) {
1897 my $serial = Koha::Serials->find($serialid);
1899 C4::Serials::ModSerialStatus(
1902 $serial->planneddate,
1903 $serial->publisheddate,
1904 $serial->publisheddatetext,
1905 C4::Serials->CLAIMED,
1910 my $dbh = C4::Context->dbh;
1913 SET claimdate = NOW(),
1914 claims_count = claims_count + 1,
1916 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1917 {}, CLAIMED, @$serialids );
1920 =head2 check_routing
1922 $result = &check_routing($subscriptionid)
1924 this function checks to see if a serial has a routing list and returns the count of routingid
1925 used to show either an 'add' or 'edit' link
1930 my ($subscriptionid) = @_;
1932 return unless ($subscriptionid);
1934 my $dbh = C4::Context->dbh;
1935 my $sth = $dbh->prepare(
1936 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1937 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1938 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1941 $sth->execute($subscriptionid);
1942 my $line = $sth->fetchrow_hashref;
1943 my $result = $line->{'routingids'};
1947 =head2 addroutingmember
1949 addroutingmember($borrowernumber,$subscriptionid)
1951 this function takes a borrowernumber and subscriptionid and adds the member to the
1952 routing list for that serial subscription and gives them a rank on the list
1953 of either 1 or highest current rank + 1
1957 sub addroutingmember {
1958 my ( $borrowernumber, $subscriptionid ) = @_;
1960 return unless ($borrowernumber and $subscriptionid);
1963 my $dbh = C4::Context->dbh;
1964 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1965 $sth->execute($subscriptionid);
1966 while ( my $line = $sth->fetchrow_hashref ) {
1967 if ( $line->{'rank'} > 0 ) {
1968 $rank = $line->{'rank'} + 1;
1973 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1974 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1977 =head2 reorder_members
1979 reorder_members($subscriptionid,$routingid,$rank)
1981 this function is used to reorder the routing list
1983 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1984 - it gets all members on list puts their routingid's into an array
1985 - removes the one in the array that is $routingid
1986 - then reinjects $routingid at point indicated by $rank
1987 - then update the database with the routingids in the new order
1991 sub reorder_members {
1992 my ( $subscriptionid, $routingid, $rank ) = @_;
1993 my $dbh = C4::Context->dbh;
1994 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1995 $sth->execute($subscriptionid);
1997 while ( my $line = $sth->fetchrow_hashref ) {
1998 push( @result, $line->{'routingid'} );
2001 # To find the matching index
2003 my $key = -1; # to allow for 0 being a valid response
2004 for ( $i = 0 ; $i < @result ; $i++ ) {
2005 if ( $routingid == $result[$i] ) {
2006 $key = $i; # save the index
2011 # if index exists in array then move it to new position
2012 if ( $key > -1 && $rank > 0 ) {
2013 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2014 my $moving_item = splice( @result, $key, 1 );
2015 splice( @result, $new_rank, 0, $moving_item );
2017 for ( my $j = 0 ; $j < @result ; $j++ ) {
2018 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2024 =head2 delroutingmember
2026 delroutingmember($routingid,$subscriptionid)
2028 this function either deletes one member from routing list if $routingid exists otherwise
2029 deletes all members from the routing list
2033 sub delroutingmember {
2035 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2036 my ( $routingid, $subscriptionid ) = @_;
2037 my $dbh = C4::Context->dbh;
2039 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2040 $sth->execute($routingid);
2041 reorder_members( $subscriptionid, $routingid );
2043 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2044 $sth->execute($subscriptionid);
2049 =head2 getroutinglist
2051 @routinglist = getroutinglist($subscriptionid)
2053 this gets the info from the subscriptionroutinglist for $subscriptionid
2056 the routinglist as an array. Each element of the array contains a hash_ref containing
2057 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2061 sub getroutinglist {
2062 my ($subscriptionid) = @_;
2063 my $dbh = C4::Context->dbh;
2064 my $sth = $dbh->prepare(
2065 'SELECT routingid, borrowernumber, ranking, biblionumber
2067 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2068 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2070 $sth->execute($subscriptionid);
2071 my $routinglist = $sth->fetchall_arrayref({});
2072 return @{$routinglist};
2075 =head2 countissuesfrom
2077 $result = countissuesfrom($subscriptionid,$startdate)
2079 Returns a count of serial rows matching the given subsctiptionid
2080 with published date greater than startdate
2084 sub countissuesfrom {
2085 my ( $subscriptionid, $startdate ) = @_;
2086 my $dbh = C4::Context->dbh;
2090 WHERE subscriptionid=?
2091 AND serial.publisheddate>?
2093 my $sth = $dbh->prepare($query);
2094 $sth->execute( $subscriptionid, $startdate );
2095 my ($countreceived) = $sth->fetchrow;
2096 return $countreceived;
2101 $result = CountIssues($subscriptionid)
2103 Returns a count of serial rows matching the given subsctiptionid
2108 my ($subscriptionid) = @_;
2109 my $dbh = C4::Context->dbh;
2113 WHERE subscriptionid=?
2115 my $sth = $dbh->prepare($query);
2116 $sth->execute($subscriptionid);
2117 my ($countreceived) = $sth->fetchrow;
2118 return $countreceived;
2123 $result = HasItems($subscriptionid)
2125 returns a count of items from serial matching the subscriptionid
2130 my ($subscriptionid) = @_;
2131 my $dbh = C4::Context->dbh;
2133 SELECT COUNT(serialitems.itemnumber)
2135 LEFT JOIN serialitems USING(serialid)
2136 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2138 my $sth=$dbh->prepare($query);
2139 $sth->execute($subscriptionid);
2140 my ($countitems)=$sth->fetchrow_array();
2144 =head2 abouttoexpire
2146 $result = abouttoexpire($subscriptionid)
2148 this function alerts you to the penultimate issue for a serial subscription
2150 returns 1 - if this is the penultimate issue
2156 my ($subscriptionid) = @_;
2157 my $dbh = C4::Context->dbh;
2158 my $subscription = GetSubscription($subscriptionid);
2159 my $per = $subscription->{'periodicity'};
2160 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2161 if ($frequency and $frequency->{unit}){
2163 my $expirationdate = GetExpirationDate($subscriptionid);
2165 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2166 my $nextdate = GetNextDate($subscription, $res, $frequency);
2168 # only compare dates if both dates exist.
2169 if ($nextdate and $expirationdate) {
2170 if(Date::Calc::Delta_Days(
2171 split( /-/, $nextdate ),
2172 split( /-/, $expirationdate )
2178 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2179 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2185 =head2 GetFictiveIssueNumber
2187 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2189 Get the position of the issue published at $publisheddate, considering the
2190 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2191 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2192 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2193 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2194 depending on how many rows are in serial table.
2195 The issue number calculation is based on subscription frequency, first acquisition
2196 date, and $publisheddate.
2198 Returns undef when called for irregular frequencies.
2200 The routine is used to skip irregularities when calculating the next issue
2201 date (in GetNextDate) or the next issue number (in GetNextSeq).
2205 sub GetFictiveIssueNumber {
2206 my ($subscription, $publisheddate, $frequency) = @_;
2208 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2212 my ( $year, $month, $day ) = split /-/, $publisheddate;
2213 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2214 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2216 if( $frequency->{'unitsperissue'} == 1 ) {
2217 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2218 } else { # issuesperunit == 1
2219 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2225 my ( $date1, $date2, $unit ) = @_;
2226 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2228 if( $unit eq 'day' ) {
2229 return Delta_Days( @$date1, @$date2 );
2230 } elsif( $unit eq 'week' ) {
2231 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2234 # In case of months or years, this is a wrapper around N_Delta_YMD.
2235 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2236 # while we expect 1 month.
2237 my @delta = N_Delta_YMD( @$date1, @$date2 );
2238 if( $delta[2] > 27 ) {
2239 # Check if we could add a month
2240 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2241 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2245 if( $delta[1] >= 12 ) {
2249 # if unit is year, we only return full years
2250 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2253 sub _get_next_date_day {
2254 my ($subscription, $freqdata, $year, $month, $day) = @_;
2256 my @newissue; # ( yy, mm, dd )
2257 # We do not need $delta_days here, since it would be zero where used
2259 if( $freqdata->{issuesperunit} == 1 ) {
2261 @newissue = Add_Delta_Days(
2262 $year, $month, $day, $freqdata->{"unitsperissue"} );
2263 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2265 @newissue = ( $year, $month, $day );
2266 $subscription->{countissuesperunit}++;
2268 # We finished a cycle of issues within a unit.
2269 # No subtraction of zero needed, just add one day
2270 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2271 $subscription->{countissuesperunit} = 1;
2276 sub _get_next_date_week {
2277 my ($subscription, $freqdata, $year, $month, $day) = @_;
2279 my @newissue; # ( yy, mm, dd )
2280 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2282 if( $freqdata->{issuesperunit} == 1 ) {
2283 # Add full weeks (of 7 days)
2284 @newissue = Add_Delta_Days(
2285 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2286 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2287 # Add rounded number of days based on frequency.
2288 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2289 $subscription->{countissuesperunit}++;
2291 # We finished a cycle of issues within a unit.
2292 # Subtract delta * (issues - 1), add 1 week
2293 @newissue = Add_Delta_Days( $year, $month, $day,
2294 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2295 @newissue = Add_Delta_Days( @newissue, 7 );
2296 $subscription->{countissuesperunit} = 1;
2301 sub _get_next_date_month {
2302 my ($subscription, $freqdata, $year, $month, $day) = @_;
2304 my @newissue; # ( yy, mm, dd )
2305 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2307 if( $freqdata->{issuesperunit} == 1 ) {
2309 @newissue = Add_Delta_YM(
2310 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2311 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2312 # Add rounded number of days based on frequency.
2313 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2314 $subscription->{countissuesperunit}++;
2316 # We finished a cycle of issues within a unit.
2317 # Subtract delta * (issues - 1), add 1 month
2318 @newissue = Add_Delta_Days( $year, $month, $day,
2319 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2320 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2321 $subscription->{countissuesperunit} = 1;
2326 sub _get_next_date_year {
2327 my ($subscription, $freqdata, $year, $month, $day) = @_;
2329 my @newissue; # ( yy, mm, dd )
2330 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2332 if( $freqdata->{issuesperunit} == 1 ) {
2334 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2335 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2336 # Add rounded number of days based on frequency.
2337 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2338 $subscription->{countissuesperunit}++;
2340 # We finished a cycle of issues within a unit.
2341 # Subtract delta * (issues - 1), add 1 year
2342 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2343 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2344 $subscription->{countissuesperunit} = 1;
2351 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2353 this function it takes the publisheddate and will return the next issue's date
2354 and will skip dates if there exists an irregularity.
2355 $publisheddate has to be an ISO date
2356 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2357 $frequency is a hashref containing frequency informations
2358 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2359 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2360 skipped then the returned date will be 2007-05-10
2363 $resultdate - then next date in the sequence (ISO date)
2365 Return undef if subscription is irregular
2370 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2372 return unless $subscription and $publisheddate;
2375 if ($freqdata->{'unit'}) {
2376 my ( $year, $month, $day ) = split /-/, $publisheddate;
2378 # Process an irregularity Hash
2379 # Suppose that irregularities are stored in a string with this structure
2380 # irreg1;irreg2;irreg3
2381 # where irregX is the number of issue which will not be received
2382 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2384 if ( $subscription->{irregularity} ) {
2385 my @irreg = split /;/, $subscription->{'irregularity'} ;
2386 foreach my $irregularity (@irreg) {
2387 $irregularities{$irregularity} = 1;
2391 # Get the 'fictive' next issue number
2392 # It is used to check if next issue is an irregular issue.
2393 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2395 # Then get the next date
2396 my $unit = lc $freqdata->{'unit'};
2397 if ($unit eq 'day') {
2398 while ($irregularities{$issueno}) {
2399 ($year, $month, $day) = _get_next_date_day($subscription,
2400 $freqdata, $year, $month, $day);
2403 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2404 $year, $month, $day);
2406 elsif ($unit eq 'week') {
2407 while ($irregularities{$issueno}) {
2408 ($year, $month, $day) = _get_next_date_week($subscription,
2409 $freqdata, $year, $month, $day);
2412 ($year, $month, $day) = _get_next_date_week($subscription,
2413 $freqdata, $year, $month, $day);
2415 elsif ($unit eq 'month') {
2416 while ($irregularities{$issueno}) {
2417 ($year, $month, $day) = _get_next_date_month($subscription,
2418 $freqdata, $year, $month, $day);
2421 ($year, $month, $day) = _get_next_date_month($subscription,
2422 $freqdata, $year, $month, $day);
2424 elsif ($unit eq 'year') {
2425 while ($irregularities{$issueno}) {
2426 ($year, $month, $day) = _get_next_date_year($subscription,
2427 $freqdata, $year, $month, $day);
2430 ($year, $month, $day) = _get_next_date_year($subscription,
2431 $freqdata, $year, $month, $day);
2435 my $dbh = C4::Context->dbh;
2438 SET countissuesperunit = ?
2439 WHERE subscriptionid = ?
2441 my $sth = $dbh->prepare($query);
2442 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2445 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2451 $string = &_numeration($value,$num_type,$locale);
2453 _numeration returns the string corresponding to $value in the num_type
2465 my ($value, $num_type, $locale) = @_;
2470 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2471 # 1970-11-01 was a Sunday
2472 $value = $value % 7;
2473 my $dt = DateTime->new(
2479 $string = $num_type =~ /^dayname$/
2480 ? $dt->strftime("%A")
2481 : $dt->strftime("%a");
2482 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2483 $value = $value % 12;
2484 my $dt = DateTime->new(
2486 month => $value + 1,
2489 $string = $num_type =~ /^monthname$/
2490 ? $dt->format_cldr( "LLLL" )
2491 : $dt->strftime("%b");
2492 } elsif ( $num_type =~ /^season$/ ) {
2493 my @seasons= qw( Spring Summer Fall Winter );
2494 $value = $value % 4;
2495 $string = $seasons[$value];
2496 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2497 my @seasonsabrv= qw( Spr Sum Fal Win );
2498 $value = $value % 4;
2499 $string = $seasonsabrv[$value];
2507 =head2 CloseSubscription
2509 Close a subscription given a subscriptionid
2513 sub CloseSubscription {
2514 my ( $subscriptionid ) = @_;
2515 return unless $subscriptionid;
2516 my $dbh = C4::Context->dbh;
2517 my $sth = $dbh->prepare( q{
2520 WHERE subscriptionid = ?
2522 $sth->execute( $subscriptionid );
2524 # Set status = missing when status = stopped
2525 $sth = $dbh->prepare( q{
2528 WHERE subscriptionid = ?
2531 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2534 =head2 ReopenSubscription
2536 Reopen a subscription given a subscriptionid
2540 sub ReopenSubscription {
2541 my ( $subscriptionid ) = @_;
2542 return unless $subscriptionid;
2543 my $dbh = C4::Context->dbh;
2544 my $sth = $dbh->prepare( q{
2547 WHERE subscriptionid = ?
2549 $sth->execute( $subscriptionid );
2551 # Set status = expected when status = stopped
2552 $sth = $dbh->prepare( q{
2555 WHERE subscriptionid = ?
2558 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2561 =head2 subscriptionCurrentlyOnOrder
2563 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2565 Return 1 if subscription is currently on order else 0.
2569 sub subscriptionCurrentlyOnOrder {
2570 my ( $subscriptionid ) = @_;
2571 my $dbh = C4::Context->dbh;
2573 SELECT COUNT(*) FROM aqorders
2574 WHERE subscriptionid = ?
2575 AND datereceived IS NULL
2576 AND datecancellationprinted IS NULL
2578 my $sth = $dbh->prepare( $query );
2579 $sth->execute($subscriptionid);
2580 return $sth->fetchrow_array;
2583 =head2 can_claim_subscription
2585 $can = can_claim_subscription( $subscriptionid[, $userid] );
2587 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2591 sub can_claim_subscription {
2592 my ( $subscription, $userid ) = @_;
2593 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2596 =head2 can_edit_subscription
2598 $can = can_edit_subscription( $subscriptionid[, $userid] );
2600 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2604 sub can_edit_subscription {
2605 my ( $subscription, $userid ) = @_;
2606 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2609 =head2 can_show_subscription
2611 $can = can_show_subscription( $subscriptionid[, $userid] );
2613 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2617 sub can_show_subscription {
2618 my ( $subscription, $userid ) = @_;
2619 return _can_do_on_subscription( $subscription, $userid, '*' );
2622 sub _can_do_on_subscription {
2623 my ( $subscription, $userid, $permission ) = @_;
2624 return 0 unless C4::Context->userenv;
2625 my $flags = C4::Context->userenv->{flags};
2626 $userid ||= C4::Context->userenv->{'id'};
2628 if ( C4::Context->preference('IndependentBranches') ) {
2630 if C4::Context->IsSuperLibrarian()
2632 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2634 C4::Auth::haspermission( $userid,
2635 { serials => $permission } )
2636 and ( not defined $subscription->{branchcode}
2637 or $subscription->{branchcode} eq ''
2638 or $subscription->{branchcode} eq
2639 C4::Context->userenv->{'branch'} )
2644 if C4::Context->IsSuperLibrarian()
2646 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2647 or C4::Auth::haspermission(
2648 $userid, { serials => $permission }
2655 =head2 findSerialsByStatus
2657 @serials = findSerialsByStatus($status, $subscriptionid);
2659 Returns an array of serials matching a given status and subscription id.
2663 sub findSerialsByStatus {
2664 my ( $status, $subscriptionid ) = @_;
2665 my $dbh = C4::Context->dbh;
2666 my $query = q| SELECT * from serial
2668 AND subscriptionid = ?
2670 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2679 Koha Development Team <http://koha-community.org/>