3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
33 use POSIX qw( strftime );
34 use Scalar::Util qw( looks_like_number );
37 use C4::Auth qw( haspermission );
38 use C4::Biblio qw( GetMarcFromKohaField ModBiblio );
40 use C4::Log qw( logaction ); # logaction
41 use C4::Serials::Frequency qw( GetSubscriptionFrequency );
42 use C4::Serials::Numberpattern;
43 use Koha::AdditionalFieldValues;
45 use Koha::DateUtils qw( dt_from_string );
47 use Koha::SharedContent;
48 use Koha::Subscription::Histories;
49 use Koha::Subscriptions;
50 use Koha::Suggestions;
51 use Koha::TemplateUtils qw( process_tt );
59 MISSING_NEVER_RECIEVED => 41,
60 MISSING_SOLD_OUT => 42,
61 MISSING_DAMAGED => 43,
69 use constant MISSING_STATUSES => (
70 MISSING, MISSING_NEVER_RECIEVED,
71 MISSING_SOLD_OUT, MISSING_DAMAGED,
75 our (@ISA, @EXPORT_OK);
80 NewSubscription ModSubscription DelSubscription
81 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
83 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
84 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
86 GetSubscriptionHistoryFromSubscriptionId
88 GetNextSeq GetSeq NewIssue GetSerials
89 GetLatestSerials ModSerialStatus GetNextDate
90 CloseSubscription ReopenSubscription
91 subscriptionCurrentlyOnOrder
92 can_claim_subscription can_edit_subscription can_show_subscription
94 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
95 GetSerialInformation AddItem2Serial
96 PrepareSerialsData GetNextExpected ModNextExpected
97 GetSubscriptionIrregularities
100 GetSuppliersWithLateIssues
101 getroutinglist delroutingmember addroutingmember
103 check_routing updateClaim
114 C4::Serials - Serials Module Functions
122 Functions for handling subscriptions, claims routing etc.
127 =head2 GetSuppliersWithLateIssues
129 $supplierlist = GetSuppliersWithLateIssues()
131 this function get all suppliers with late issues.
134 an array_ref of suppliers each entry is a hash_ref containing id and name
135 the array is in name order
139 sub GetSuppliersWithLateIssues {
140 my $dbh = C4::Context->dbh;
141 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
143 SELECT DISTINCT id, name
145 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
146 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
149 (planneddate < now() AND serial.status=1)
150 OR serial.STATUS IN ( $statuses )
152 AND subscription.closed = 0
154 return $dbh->selectall_arrayref($query, { Slice => {} });
157 =head2 GetSubscriptionHistoryFromSubscriptionId
159 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
161 This function returns the subscription history as a hashref
165 sub GetSubscriptionHistoryFromSubscriptionId {
166 my ($subscriptionid) = @_;
168 return unless $subscriptionid;
170 my $dbh = C4::Context->dbh;
173 FROM subscriptionhistory
174 WHERE subscriptionid = ?
176 my $sth = $dbh->prepare($query);
177 $sth->execute($subscriptionid);
178 my $results = $sth->fetchrow_hashref;
184 =head2 GetSerialInformation
186 $data = GetSerialInformation($serialid);
187 returns a hash_ref containing :
188 items : items marcrecord (can be an array)
190 subscription table field
191 + information about subscription expiration
195 sub GetSerialInformation {
197 my $dbh = C4::Context->dbh;
199 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
200 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
203 my $rq = $dbh->prepare($query);
204 $rq->execute($serialid);
205 my $data = $rq->fetchrow_hashref;
207 # create item information if we have serialsadditems for this subscription
208 if ( $data->{'serialsadditems'} ) {
209 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
210 $queryitem->execute($serialid);
211 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
213 if ( scalar(@$itemnumbers) > 0 ) {
214 foreach my $itemnum (@$itemnumbers) {
216 #It is ASSUMED that GetMarcItem ALWAYS WORK...
217 #Maybe GetMarcItem should return values on failure
218 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
219 $itemprocessed->{'itemnumber'} = $itemnum->[0];
220 $itemprocessed->{'itemid'} = $itemnum->[0];
221 $itemprocessed->{'serialid'} = $serialid;
222 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
223 push @{ $data->{'items'} }, $itemprocessed;
226 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
227 $itemprocessed->{'itemid'} = "N$serialid";
228 $itemprocessed->{'serialid'} = $serialid;
229 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
230 $itemprocessed->{'countitems'} = 0;
231 push @{ $data->{'items'} }, $itemprocessed;
234 $data->{ "status" . $data->{'serstatus'} } = 1;
235 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
236 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
237 $data->{cannotedit} = not can_edit_subscription( $data );
241 =head2 AddItem2Serial
243 $rows = AddItem2Serial($serialid,$itemnumber);
244 Adds an itemnumber to Serial record
245 returns the number of rows affected
250 my ( $serialid, $itemnumber ) = @_;
252 return unless ($serialid and $itemnumber);
254 my $dbh = C4::Context->dbh;
255 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
256 $rq->execute( $serialid, $itemnumber );
260 =head2 GetSubscription
262 $subs = GetSubscription($subscriptionid)
263 this function returns the subscription which has $subscriptionid as id.
265 a hashref. This hash contains
266 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
270 sub GetSubscription {
271 my ($subscriptionid) = @_;
272 my $dbh = C4::Context->dbh;
274 SELECT subscription.*,
275 subscriptionhistory.*,
276 aqbooksellers.name AS aqbooksellername,
277 biblio.title AS bibliotitle,
278 biblio.subtitle AS bibliosubtitle,
279 subscription.biblionumber as bibnum
281 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
282 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
283 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
284 WHERE subscription.subscriptionid = ?
287 my $sth = $dbh->prepare($query);
288 $sth->execute($subscriptionid);
289 my $subscription = $sth->fetchrow_hashref;
291 return unless $subscription;
293 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
295 if ( my $mana_id = $subscription->{mana_id} ) {
296 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
297 'subscription', $mana_id, {usecomments => 1});
298 $subscription->{comments} = $mana_subscription->{data}->{comments};
301 return $subscription;
304 =head2 GetFullSubscription
306 $array_ref = GetFullSubscription($subscriptionid)
307 this function reads the serial table.
311 sub GetFullSubscription {
312 my ($subscriptionid) = @_;
314 return unless ($subscriptionid);
316 my $dbh = C4::Context->dbh;
318 SELECT serial.serialid,
321 serial.publisheddate,
322 serial.publisheddatetext,
324 serial.notes as notes,
325 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
326 aqbooksellers.name as aqbooksellername,
327 biblio.title as bibliotitle,
328 subscription.branchcode AS branchcode,
329 subscription.subscriptionid AS subscriptionid
331 LEFT JOIN subscription ON
332 (serial.subscriptionid=subscription.subscriptionid )
333 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
334 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
335 WHERE serial.subscriptionid = ?
337 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
338 serial.subscriptionid
340 my $sth = $dbh->prepare($query);
341 $sth->execute($subscriptionid);
342 my $subscriptions = $sth->fetchall_arrayref( {} );
343 if (scalar @$subscriptions) {
344 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
345 for my $subscription ( @$subscriptions ) {
346 $subscription->{cannotedit} = $cannotedit;
350 return $subscriptions;
353 =head2 PrepareSerialsData
355 $array_ref = PrepareSerialsData($serialinfomation)
356 where serialinformation is a hashref array
360 sub PrepareSerialsData {
363 return unless ($lines);
370 my $previousnote = "";
372 foreach my $subs (@{$lines}) {
373 $subs->{ "status" . $subs->{'status'} } = 1;
374 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
375 $subs->{"checked"} = 1;
378 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
379 $year = $subs->{'year'};
383 if ( $tmpresults{$year} ) {
384 push @{ $tmpresults{$year}->{'serials'} }, $subs;
386 $tmpresults{$year} = {
388 'aqbooksellername' => $subs->{'aqbooksellername'},
389 'bibliotitle' => $subs->{'bibliotitle'},
390 'serials' => [$subs],
395 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
396 push @res, $tmpresults{$key};
401 =head2 GetSubscriptionsFromBiblionumber
403 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
404 this function get the subscription list. it reads the subscription table.
406 reference to an array of subscriptions which have the biblionumber given on input arg.
407 each element of this array is a hashref containing
408 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
412 sub GetSubscriptionsFromBiblionumber {
413 my ($biblionumber) = @_;
415 return unless ($biblionumber);
417 my $dbh = C4::Context->dbh;
419 SELECT subscription.*,
421 subscriptionhistory.*,
422 aqbooksellers.name AS aqbooksellername,
423 biblio.title AS bibliotitle
425 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
426 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
427 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
428 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
429 WHERE subscription.biblionumber = ?
431 my $sth = $dbh->prepare($query);
432 $sth->execute($biblionumber);
434 while ( my $subs = $sth->fetchrow_hashref ) {
435 $subs->{opacnote} //= "";
436 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
437 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
438 $subs->{ "status" . $subs->{'status'} } = 1;
440 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
441 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
442 $subs->{cannotedit} = not can_edit_subscription( $subs );
448 =head2 GetFullSubscriptionsFromBiblionumber
450 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
451 this function reads the serial table.
455 sub GetFullSubscriptionsFromBiblionumber {
456 my ($biblionumber) = @_;
457 my $dbh = C4::Context->dbh;
459 SELECT serial.serialid,
462 serial.publisheddate,
463 serial.publisheddatetext,
465 serial.notes as notes,
466 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
467 biblio.title as bibliotitle,
468 subscription.branchcode AS branchcode,
469 subscription.subscriptionid AS subscriptionid,
470 subscription.location AS location
472 LEFT JOIN subscription ON
473 (serial.subscriptionid=subscription.subscriptionid)
474 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
475 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
476 WHERE subscription.biblionumber = ?
478 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
479 serial.subscriptionid
481 my $sth = $dbh->prepare($query);
482 $sth->execute($biblionumber);
483 my $subscriptions = $sth->fetchall_arrayref( {} );
484 if (scalar @$subscriptions) {
485 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
486 for my $subscription ( @$subscriptions ) {
487 $subscription->{cannotedit} = $cannotedit;
491 return $subscriptions;
494 =head2 SearchSubscriptions
496 @results = SearchSubscriptions($args);
498 This function returns a list of hashrefs, one for each subscription
499 that meets the conditions specified by the $args hashref.
501 The valid search fields are:
516 The expiration_date search field is special; it specifies the maximum
517 subscription expiration date.
521 sub SearchSubscriptions {
522 my ( $args, $params ) = @_;
526 my $additional_fields = $args->{additional_fields} // [];
527 my $matching_record_ids_for_additional_fields = [];
528 if ( @$additional_fields ) {
529 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
531 return () unless @subscriptions;
533 $matching_record_ids_for_additional_fields = [ map {
540 subscription.notes AS publicnotes,
541 subscriptionhistory.*,
543 biblio.notes AS biblionotes,
550 aqbooksellers.name AS vendorname,
553 LEFT JOIN subscriptionhistory USING(subscriptionid)
554 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
555 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
556 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
558 if ( $args->{routinglist} ) {
560 q| INNER JOIN (SELECT DISTINCT subscriptionid FROM subscriptionroutinglist) srl ON srl.subscriptionid = subscription.subscriptionid|;
562 $query .= q| WHERE 1|;
565 if( $args->{biblionumber} ) {
566 push @where_strs, "biblio.biblionumber = ?";
567 push @where_args, $args->{biblionumber};
570 if( $args->{title} ){
571 my @words = split / /, $args->{title};
573 foreach my $word (@words) {
574 push @strs, "biblio.title LIKE ?";
575 push @args, "%$word%";
578 push @where_strs, '(' . join (' AND ', @strs) . ')';
579 push @where_args, @args;
583 push @where_strs, "biblioitems.issn LIKE ?";
584 push @where_args, "%$args->{issn}%";
587 push @where_strs, "biblioitems.ean LIKE ?";
588 push @where_args, "%$args->{ean}%";
590 if ( $args->{callnumber} ) {
591 push @where_strs, "subscription.callnumber LIKE ?";
592 push @where_args, "%$args->{callnumber}%";
594 if( $args->{publisher} ){
595 push @where_strs, "biblioitems.publishercode LIKE ?";
596 push @where_args, "%$args->{publisher}%";
598 if( $args->{bookseller} ){
599 push @where_strs, "aqbooksellers.name LIKE ?";
600 push @where_args, "%$args->{bookseller}%";
602 if( $args->{branch} ){
603 push @where_strs, "subscription.branchcode = ?";
604 push @where_args, "$args->{branch}";
606 if ( $args->{location} ) {
607 push @where_strs, "subscription.location = ?";
608 push @where_args, "$args->{location}";
610 if ( $args->{expiration_date} ) {
611 push @where_strs, "subscription.enddate <= ?";
612 push @where_args, "$args->{expiration_date}";
614 if( defined $args->{closed} ){
615 push @where_strs, "subscription.closed = ?";
616 push @where_args, "$args->{closed}";
619 $query .= ' AND ' . join(' AND ', @where_strs);
621 if ( @$additional_fields ) {
622 $query .= ' AND subscriptionid IN ('
623 . join( ', ', @$matching_record_ids_for_additional_fields )
627 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
629 my $dbh = C4::Context->dbh;
630 my $sth = $dbh->prepare($query);
631 $sth->execute(@where_args);
632 my $results = $sth->fetchall_arrayref( {} );
634 my $total_results = @{$results};
636 if ( $params->{results_limit} && $total_results > $params->{results_limit} ) {
637 $results = [ splice( @{$results}, 0, $params->{results_limit} ) ];
640 for my $subscription ( @$results ) {
641 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
642 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
644 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
645 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
646 $subscription_object->additional_field_values->as_list };
650 return wantarray ? @{$results} : { results => $results, total => $total_results };
656 ($totalissues,@serials) = GetSerials($subscriptionid);
657 this function gets every serial not arrived for a given subscription
658 as well as the number of issues registered in the database (all types)
659 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
661 FIXME: We should return \@serials.
666 my ( $subscriptionid, $count ) = @_;
668 return unless $subscriptionid;
670 my $dbh = C4::Context->dbh;
672 # status = 2 is "arrived"
674 $count = 5 unless ($count);
676 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
677 my $query = "SELECT serialid,serialseq, status, publisheddate,
678 publisheddatetext, planneddate,notes, routingnotes
680 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
681 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
682 my $sth = $dbh->prepare($query);
683 $sth->execute($subscriptionid);
685 while ( my $line = $sth->fetchrow_hashref ) {
686 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
687 push @serials, $line;
690 # OK, now add the last 5 issues arrives/missing
691 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
692 publisheddatetext, notes, routingnotes
694 WHERE subscriptionid = ?
695 AND status IN ( $statuses )
696 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
698 $sth = $dbh->prepare($query);
699 $sth->execute($subscriptionid);
700 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
702 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
704 push @serials, $line;
707 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
708 $sth = $dbh->prepare($query);
709 $sth->execute($subscriptionid);
710 my ($totalissues) = $sth->fetchrow;
711 return ( $totalissues, @serials );
716 @serials = GetSerials2($subscriptionid,$statuses);
717 this function returns every serial waited for a given subscription
718 as well as the number of issues registered in the database (all types)
719 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
721 $statuses is an arrayref of statuses and is mandatory.
726 my ( $subscription, $statuses ) = @_;
728 return unless ($subscription and @$statuses);
730 my $dbh = C4::Context->dbh;
732 SELECT serialid,serialseq, status, planneddate, publisheddate,
733 publisheddatetext, notes, routingnotes
735 WHERE subscriptionid=?
737 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
739 ORDER BY publisheddate,serialid DESC
741 my $sth = $dbh->prepare($query);
742 $sth->execute( $subscription, @$statuses );
745 while ( my $line = $sth->fetchrow_hashref ) {
746 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
747 push @serials, $line;
752 =head2 GetLatestSerials
754 \@serials = GetLatestSerials($subscriptionid,$limit)
755 get the $limit's latest serials arrived or missing for a given subscription
757 a ref to an array which contains all of the latest serials stored into a hash.
761 sub GetLatestSerials {
762 my ( $subscriptionid, $limit ) = @_;
764 return unless ($subscriptionid and $limit);
766 my $dbh = C4::Context->dbh;
768 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
769 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, publisheddatetext, notes
771 WHERE subscriptionid = ?
772 AND status IN ($statuses)
773 ORDER BY publisheddate DESC LIMIT 0,$limit
775 my $sth = $dbh->prepare($strsth);
776 $sth->execute($subscriptionid);
778 while ( my $line = $sth->fetchrow_hashref ) {
779 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
780 push @serials, $line;
786 =head2 GetPreviousSerialid
788 $serialid = GetPreviousSerialid($subscriptionid, $nth)
789 get the $nth's previous serial for the given subscriptionid
795 sub GetPreviousSerialid {
796 my ( $subscriptionid, $nth ) = @_;
798 my $dbh = C4::Context->dbh;
802 my $strsth = "SELECT serialid
804 WHERE subscriptionid = ?
806 ORDER BY serialid DESC LIMIT $nth,1
808 my $sth = $dbh->prepare($strsth);
809 $sth->execute($subscriptionid);
811 my $line = $sth->fetchrow_hashref;
812 $return = $line->{'serialid'} if ($line);
820 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
821 $newinnerloop1, $newinnerloop2, $newinnerloop3
822 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate, $count_forward );
824 $subscription is a hashref containing all the attributes of the table
826 $pattern is a hashref containing all the attributes of the table
827 'subscription_numberpatterns'.
828 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
829 $planneddate is a date string in iso format.
830 $count_forward is the number of issues to count forward, defaults to 1 if omitted
831 This function get the next issue for the subscription given on input arg
836 my ($subscription, $pattern, $frequency, $planneddate, $count_forward) = @_;
838 return unless ($subscription and $pattern);
840 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
841 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
842 my $count = $count_forward || 1;
844 if ($subscription->{'skip_serialseq'}) {
845 my @irreg = split /;/, $subscription->{'irregularity'};
847 my $irregularities = {};
848 $irregularities->{$_} = 1 foreach(@irreg);
849 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
850 while($irregularities->{$issueno}) {
857 my $numberingmethod = $pattern->{numberingmethod};
859 if ($numberingmethod) {
860 $calculated = $numberingmethod;
861 my $locale = $subscription->{locale};
862 $newlastvalue1 = $subscription->{lastvalue1} || 0;
863 $newlastvalue2 = $subscription->{lastvalue2} || 0;
864 $newlastvalue3 = $subscription->{lastvalue3} || 0;
865 $newinnerloop1 = $subscription->{innerloop1} || 0;
866 $newinnerloop2 = $subscription->{innerloop2} || 0;
867 $newinnerloop3 = $subscription->{innerloop3} || 0;
870 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
873 for(my $i = 0; $i < $count; $i++) {
875 # check if we have to increase the new value.
877 if ($newinnerloop1 >= $pattern->{every1}) {
879 $newlastvalue1 += $pattern->{add1};
881 # reset counter if needed.
882 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
885 # check if we have to increase the new value.
887 if ($newinnerloop2 >= $pattern->{every2}) {
889 $newlastvalue2 += $pattern->{add2};
891 # reset counter if needed.
892 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
895 # check if we have to increase the new value.
897 if ($newinnerloop3 >= $pattern->{every3}) {
899 $newlastvalue3 += $pattern->{add3};
901 # reset counter if needed.
902 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
906 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
907 $calculated =~ s/\{X\}/$newlastvalue1string/g;
910 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
911 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
914 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
915 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
918 my $dt = dt_from_string($planneddate);
919 $calculated =~ s/\{Month\}/$dt->month/eg;
920 $calculated =~ s/\{MonthName\}/$dt->month_name/eg;
921 $calculated =~ s/\{Year\}/$dt->year/eg;
922 $calculated =~ s/\{Day\}/$dt->day/eg;
923 $calculated =~ s/\{DayName\}/$dt->day_name/eg;
928 $newlastvalue1, $newlastvalue2, $newlastvalue3,
929 $newinnerloop1, $newinnerloop2, $newinnerloop3);
934 $calculated = GetSeq($subscription, $pattern)
935 $subscription is a hashref containing all the attributes of the table 'subscription'
936 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
937 this function transforms {X},{Y},{Z} to 150,0,0 for example.
939 the sequence in string format
944 my ($subscription, $pattern) = @_;
946 return unless ($subscription and $pattern);
948 my $locale = $subscription->{locale};
950 my $calculated = $pattern->{numberingmethod};
952 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
953 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
954 $calculated =~ s/\{X\}/$newlastvalue1/g;
956 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
957 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
958 $calculated =~ s/\{Y\}/$newlastvalue2/g;
960 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
961 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
962 $calculated =~ s/\{Z\}/$newlastvalue3/g;
964 my $dt = dt_from_string( $subscription->{firstacquidate} );
965 $calculated =~ s/\{Month\}/$dt->month/eg;
966 $calculated =~ s/\{MonthName\}/$dt->month_name/eg;
967 $calculated =~ s/\{Year\}/$dt->year/eg;
968 $calculated =~ s/\{Day\}/$dt->day/eg;
969 $calculated =~ s/\{DayName\}/$dt->day_name/eg;
974 =head2 GetExpirationDate
976 $enddate = GetExpirationDate($subscriptionid, [$startdate])
978 this function return the next expiration date for a subscription given on input args.
985 sub GetExpirationDate {
986 my ( $subscriptionid, $startdate ) = @_;
988 return unless ($subscriptionid);
990 my $dbh = C4::Context->dbh;
991 my $subscription = GetSubscription($subscriptionid);
994 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
995 $enddate = $startdate || $subscription->{startdate};
996 my @date = split( /-/, $enddate );
998 return if ( scalar(@date) != 3 || not check_date(@date) );
1000 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1001 if ( $frequency and $frequency->{unit} ) {
1004 if ( my $length = $subscription->{numberlength} ) {
1006 #calculate the date of the last issue.
1007 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1008 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1010 } elsif ( $subscription->{monthlength} ) {
1011 if ( $$subscription{startdate} ) {
1012 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1013 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1015 } elsif ( $subscription->{weeklength} ) {
1016 if ( $$subscription{startdate} ) {
1017 my @date = split( /-/, $subscription->{startdate} );
1018 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1019 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1022 $enddate = $subscription->{enddate};
1026 return $subscription->{enddate};
1030 =head2 CountSubscriptionFromBiblionumber
1032 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1033 this returns a count of the subscriptions for a given biblionumber
1035 the number of subscriptions
1039 sub CountSubscriptionFromBiblionumber {
1040 my ($biblionumber) = @_;
1042 return unless ($biblionumber);
1044 my $dbh = C4::Context->dbh;
1045 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1046 my $sth = $dbh->prepare($query);
1047 $sth->execute($biblionumber);
1048 my $subscriptionsnumber = $sth->fetchrow;
1049 return $subscriptionsnumber;
1052 =head2 ModSubscriptionHistory
1054 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1056 this function modifies the history of a subscription. Put your new values on input arg.
1057 returns the number of rows affected
1061 sub ModSubscriptionHistory {
1062 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1064 return unless ($subscriptionid);
1066 my $dbh = C4::Context->dbh;
1067 my $query = "UPDATE subscriptionhistory
1068 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1069 WHERE subscriptionid=?
1071 my $sth = $dbh->prepare($query);
1072 $receivedlist =~ s/^; // if $receivedlist;
1073 $missinglist =~ s/^; // if $missinglist;
1074 $opacnote =~ s/^; // if $opacnote;
1075 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1079 =head2 ModSerialStatus
1081 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1082 $publisheddatetext, $status, $notes, $count_forward);
1084 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1085 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1089 sub ModSerialStatus {
1090 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1091 $status, $notes, $count_forward) = @_;
1093 return unless ($serialid);
1095 my $count = $count_forward || 1;
1097 #It is a usual serial
1098 # 1st, get previous status :
1099 my $dbh = C4::Context->dbh;
1100 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1101 FROM serial, subscription
1102 WHERE serial.subscriptionid=subscription.subscriptionid
1104 my $sth = $dbh->prepare($query);
1105 $sth->execute($serialid);
1106 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1107 my $frequency = GetSubscriptionFrequency($periodicity);
1109 # change status & update subscriptionhistory
1111 if ( $status == DELETED ) {
1112 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1116 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1117 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1120 $sth = $dbh->prepare($query);
1121 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1122 $planneddate, $status, $notes, $routingnotes, $serialid );
1123 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1124 $sth = $dbh->prepare($query);
1125 $sth->execute($subscriptionid);
1126 my $val = $sth->fetchrow_hashref;
1127 unless ( $val->{manualhistory} ) {
1128 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1129 $sth = $dbh->prepare($query);
1130 $sth->execute($subscriptionid);
1131 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1133 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1134 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1137 # in case serial has been previously marked as missing
1138 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1139 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1142 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1143 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1145 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1146 $sth = $dbh->prepare($query);
1147 $recievedlist =~ s/^; //;
1148 $missinglist =~ s/^; //;
1149 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1153 # create new expected entry if needed (ie : was "expected" and has changed)
1154 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1155 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1156 my $subscription = GetSubscription($subscriptionid);
1157 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1158 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1162 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1163 $newinnerloop1, $newinnerloop2, $newinnerloop3
1165 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate, $count );
1167 # next date (calculated from actual date & frequency parameters)
1168 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1169 my $nextpubdate = $nextpublisheddate;
1170 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1171 WHERE subscriptionid = ?";
1172 $sth = $dbh->prepare($query);
1173 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1174 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1175 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1176 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1177 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1178 require C4::Letters;
1179 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1187 # Adds or removes seqno from list when needed; returns list
1188 # Or checks and returns true when present
1190 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1192 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1194 if( !$op or $op eq 'ADD' ) {
1195 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1196 } elsif( $op eq 'REMOVE' ) {
1197 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1199 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1204 =head2 GetNextExpected
1206 $nextexpected = GetNextExpected($subscriptionid)
1208 Get the planneddate for the current expected issue of the subscription.
1214 planneddate => ISO date
1219 sub GetNextExpected {
1220 my ($subscriptionid) = @_;
1222 my $dbh = C4::Context->dbh;
1226 WHERE subscriptionid = ?
1230 my $sth = $dbh->prepare($query);
1232 # Each subscription has only one 'expected' issue.
1233 $sth->execute( $subscriptionid, EXPECTED );
1234 my $nextissue = $sth->fetchrow_hashref;
1235 if ( !$nextissue ) {
1239 WHERE subscriptionid = ?
1240 ORDER BY publisheddate DESC
1243 $sth = $dbh->prepare($query);
1244 $sth->execute($subscriptionid);
1245 $nextissue = $sth->fetchrow_hashref;
1247 foreach(qw/planneddate publisheddate/) {
1248 # or should this default to 1st Jan ???
1249 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1255 =head2 ModNextExpected
1257 ModNextExpected($subscriptionid,$date)
1259 Update the planneddate for the current expected issue of the subscription.
1260 This will modify all future prediction results.
1262 C<$date> is an ISO date.
1268 sub ModNextExpected {
1269 my ( $subscriptionid, $date ) = @_;
1270 my $dbh = C4::Context->dbh;
1272 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1273 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1275 # Each subscription has only one 'expected' issue.
1276 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1281 =head2 GetSubscriptionIrregularities
1285 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1286 get the list of irregularities for a subscription
1292 sub GetSubscriptionIrregularities {
1293 my $subscriptionid = shift;
1295 return unless $subscriptionid;
1297 my $dbh = C4::Context->dbh;
1301 WHERE subscriptionid = ?
1303 my $sth = $dbh->prepare($query);
1304 $sth->execute($subscriptionid);
1306 my ($result) = $sth->fetchrow_array;
1307 my @irreg = split /;/, $result;
1312 =head2 ModSubscription
1314 this function modifies a subscription. Put all new values on input args.
1315 returns the number of rows affected
1319 sub ModSubscription {
1321 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1322 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1323 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1324 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1325 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1326 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1327 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1328 $itemtype, $previousitemtype, $mana_id, $ccode, $published_on_template
1331 my $subscription = Koha::Subscriptions->find($subscriptionid);
1334 librarian => $auser,
1335 branchcode => $branchcode,
1336 aqbooksellerid => $aqbooksellerid,
1338 aqbudgetid => $aqbudgetid,
1339 biblionumber => $biblionumber,
1340 startdate => $startdate,
1341 periodicity => $periodicity,
1342 numberlength => $numberlength,
1343 weeklength => $weeklength,
1344 monthlength => $monthlength,
1345 lastvalue1 => $lastvalue1,
1346 innerloop1 => $innerloop1,
1347 lastvalue2 => $lastvalue2,
1348 innerloop2 => $innerloop2,
1349 lastvalue3 => $lastvalue3,
1350 innerloop3 => $innerloop3,
1354 firstacquidate => $firstacquidate,
1355 irregularity => $irregularity,
1356 numberpattern => $numberpattern,
1358 callnumber => $callnumber,
1359 manualhistory => $manualhistory,
1360 internalnotes => $internalnotes,
1361 serialsadditems => $serialsadditems,
1362 staffdisplaycount => $staffdisplaycount,
1363 opacdisplaycount => $opacdisplaycount,
1364 graceperiod => $graceperiod,
1365 location => $location,
1366 enddate => $enddate,
1367 skip_serialseq => $skip_serialseq,
1368 itemtype => $itemtype,
1369 previousitemtype => $previousitemtype,
1370 mana_id => $mana_id,
1372 published_on_template => $published_on_template,
1375 # FIXME Must be $subscription->serials
1376 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1377 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1379 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1381 $subscription->discard_changes;
1382 return $subscription;
1385 =head2 NewSubscription
1387 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1388 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1389 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1390 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1391 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1392 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1393 $skip_serialseq, $itemtype, $previousitemtype);
1395 Create a new subscription with value given on input args.
1398 the id of this new subscription
1402 sub NewSubscription {
1404 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1405 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1406 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1407 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1408 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1409 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1410 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode,
1411 $published_on_template,
1413 my $dbh = C4::Context->dbh;
1415 my $subscription = Koha::Subscription->new(
1417 librarian => $auser,
1418 branchcode => $branchcode,
1419 aqbooksellerid => $aqbooksellerid,
1421 aqbudgetid => $aqbudgetid,
1422 biblionumber => $biblionumber,
1423 startdate => $startdate,
1424 periodicity => $periodicity,
1425 numberlength => $numberlength,
1426 weeklength => $weeklength,
1427 monthlength => $monthlength,
1428 lastvalue1 => $lastvalue1,
1429 innerloop1 => $innerloop1,
1430 lastvalue2 => $lastvalue2,
1431 innerloop2 => $innerloop2,
1432 lastvalue3 => $lastvalue3,
1433 innerloop3 => $innerloop3,
1437 firstacquidate => $firstacquidate,
1438 irregularity => $irregularity,
1439 numberpattern => $numberpattern,
1441 callnumber => $callnumber,
1442 manualhistory => $manualhistory,
1443 internalnotes => $internalnotes,
1444 serialsadditems => $serialsadditems,
1445 staffdisplaycount => $staffdisplaycount,
1446 opacdisplaycount => $opacdisplaycount,
1447 graceperiod => $graceperiod,
1448 location => $location,
1449 enddate => $enddate,
1450 skip_serialseq => $skip_serialseq,
1451 itemtype => $itemtype,
1452 previousitemtype => $previousitemtype,
1453 mana_id => $mana_id,
1455 published_on_template => $published_on_template,
1458 $subscription->discard_changes;
1459 my $subscriptionid = $subscription->subscriptionid;
1460 my ( $query, $sth );
1462 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1466 WHERE subscriptionid=?
1468 $sth = $dbh->prepare($query);
1469 $sth->execute( $enddate, $subscriptionid );
1472 # then create the 1st expected number
1474 INSERT INTO subscriptionhistory
1475 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1476 VALUES (?,?,?, '', '')
1478 $sth = $dbh->prepare($query);
1479 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1481 # reread subscription to get a hash (for calculation of the 1st issue number)
1482 $subscription = GetSubscription($subscriptionid); # We should not do that
1483 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1485 # calculate issue number
1486 my $serialseq = GetSeq($subscription, $pattern) || q{};
1490 serialseq => $serialseq,
1491 serialseq_x => $subscription->{'lastvalue1'},
1492 serialseq_y => $subscription->{'lastvalue2'},
1493 serialseq_z => $subscription->{'lastvalue3'},
1494 subscriptionid => $subscriptionid,
1495 biblionumber => $biblionumber,
1497 planneddate => $firstacquidate,
1498 publisheddate => $firstacquidate,
1502 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1504 #set serial flag on biblio if not already set.
1505 my $biblio = Koha::Biblios->find( $biblionumber );
1506 if ( $biblio and !$biblio->serial ) {
1507 my $record = $biblio->metadata->record;
1508 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1510 eval { $record->field($tag)->update( $subf => 1 ); };
1512 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1514 return $subscriptionid;
1517 =head2 GetSubscriptionLength
1519 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1521 This function calculates the subscription length.
1525 sub GetSubscriptionLength {
1526 my ($subtype, $length) = @_;
1528 return unless looks_like_number($length);
1532 $subtype eq 'issues' ? $length : 0,
1533 $subtype eq 'weeks' ? $length : 0,
1534 $subtype eq 'months' ? $length : 0,
1539 =head2 ReNewSubscription
1541 ReNewSubscription($params);
1543 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1545 this function renew a subscription with values given on input args.
1549 sub ReNewSubscription {
1550 my ( $params ) = @_;
1551 my $subscriptionid = $params->{subscriptionid};
1552 my $user = $params->{user};
1553 my $startdate = $params->{startdate};
1554 my $numberlength = $params->{numberlength};
1555 my $weeklength = $params->{weeklength};
1556 my $monthlength = $params->{monthlength};
1557 my $note = $params->{note};
1558 my $branchcode = $params->{branchcode};
1560 my $dbh = C4::Context->dbh;
1561 my $subscription = GetSubscription($subscriptionid);
1565 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1566 WHERE biblio.biblionumber=?
1568 my $sth = $dbh->prepare($query);
1569 $sth->execute( $subscription->{biblionumber} );
1570 my $biblio = $sth->fetchrow_hashref;
1572 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1573 Koha::Suggestion->new(
1575 'suggestedby' => $user,
1576 'title' => $subscription->{bibliotitle},
1577 'author' => $biblio->{author},
1578 'publishercode' => $biblio->{publishercode},
1580 'biblionumber' => $subscription->{biblionumber},
1581 'branchcode' => $branchcode,
1586 $numberlength ||= 0; # Should not we raise an exception instead?
1589 # renew subscription
1592 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1593 WHERE subscriptionid=?
1595 $sth = $dbh->prepare($query);
1596 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1597 my $enddate = GetExpirationDate($subscriptionid);
1601 WHERE subscriptionid=?
1603 $sth = $dbh->prepare($query);
1604 $sth->execute( $enddate, $subscriptionid );
1606 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1612 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1614 Create a new issue stored on the database.
1615 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1616 returns the serial id
1621 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1622 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1623 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1625 return unless ($subscriptionid);
1627 my $schema = Koha::Database->new()->schema();
1629 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1631 if ( my $template = $subscription->published_on_template ) {
1632 $publisheddatetext = process_tt(
1635 subscription => $subscription,
1636 serialseq => $serialseq,
1637 serialseq_x => $subscription->lastvalue1(),
1638 serialseq_y => $subscription->lastvalue2(),
1639 serialseq_z => $subscription->lastvalue3(),
1640 subscriptionid => $subscriptionid,
1641 biblionumber => $biblionumber,
1643 planneddate => $planneddate,
1644 publisheddate => $publisheddate,
1645 publisheddatetext => $publisheddatetext,
1647 routingnotes => $routingnotes,
1652 my $serial = Koha::Serial->new(
1654 serialseq => $serialseq,
1655 serialseq_x => $subscription->lastvalue1(),
1656 serialseq_y => $subscription->lastvalue2(),
1657 serialseq_z => $subscription->lastvalue3(),
1658 subscriptionid => $subscriptionid,
1659 biblionumber => $biblionumber,
1661 planneddate => $planneddate,
1662 publisheddate => $publisheddate,
1663 publisheddatetext => $publisheddatetext,
1665 routingnotes => $routingnotes,
1669 my $serialid = $serial->id();
1671 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1672 my $missinglist = $subscription_history->missinglist();
1673 my $recievedlist = $subscription_history->recievedlist();
1675 if ( $status == ARRIVED ) {
1676 ### TODO Add a feature that improves recognition and description.
1677 ### As such count (serialseq) i.e. : N18,2(N19),N20
1678 ### Would use substr and index But be careful to previous presence of ()
1679 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1681 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1682 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1685 $recievedlist =~ s/^; //;
1686 $missinglist =~ s/^; //;
1688 $subscription_history->recievedlist($recievedlist);
1689 $subscription_history->missinglist($missinglist);
1690 $subscription_history->store();
1695 =head2 HasSubscriptionStrictlyExpired
1697 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1699 the subscription has stricly expired when today > the end subscription date
1702 1 if true, 0 if false, -1 if the expiration date is not set.
1706 sub HasSubscriptionStrictlyExpired {
1708 # Getting end of subscription date
1709 my ($subscriptionid) = @_;
1711 return unless ($subscriptionid);
1713 my $dbh = C4::Context->dbh;
1714 my $subscription = GetSubscription($subscriptionid);
1715 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1717 # If the expiration date is set
1718 if ( $expirationdate != 0 ) {
1719 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1721 # Getting today's date
1722 my ( $nowyear, $nowmonth, $nowday ) = Today();
1724 # if today's date > expiration date, then the subscription has stricly expired
1725 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1732 # There are some cases where the expiration date is not set
1733 # As we can't determine if the subscription has expired on a date-basis,
1739 =head2 HasSubscriptionExpired
1741 $has_expired = HasSubscriptionExpired($subscriptionid)
1743 the subscription has expired when the next issue to arrive is out of subscription limit.
1746 0 if the subscription has not expired
1747 1 if the subscription has expired
1748 2 if has subscription does not have a valid expiration date set
1752 sub HasSubscriptionExpired {
1753 my ($subscriptionid) = @_;
1755 return unless ($subscriptionid);
1757 my $dbh = C4::Context->dbh;
1758 my $subscription = GetSubscription($subscriptionid);
1759 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1760 if ( $frequency and $frequency->{unit} ) {
1761 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1762 if (!defined $expirationdate) {
1763 $expirationdate = q{};
1766 SELECT max(planneddate)
1768 WHERE subscriptionid=?
1770 my $sth = $dbh->prepare($query);
1771 $sth->execute($subscriptionid);
1772 my ($res) = $sth->fetchrow;
1773 if (!$res || $res=~m/^0000/) {
1776 my @res = split( /-/, $res );
1777 my @endofsubscriptiondate = split( /-/, $expirationdate );
1778 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1780 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1785 if ( $subscription->{'numberlength'} ) {
1786 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1787 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1793 return 0; # Notice that you'll never get here.
1796 =head2 DelSubscription
1798 DelSubscription($subscriptionid)
1799 this function deletes subscription which has $subscriptionid as id.
1803 sub DelSubscription {
1804 my ($subscriptionid) = @_;
1805 my $dbh = C4::Context->dbh;
1806 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1808 Koha::AdditionalFieldValues->search({
1809 'field.tablename' => 'subscription',
1810 'me.record_id' => $subscriptionid,
1811 }, { join => 'field' })->delete;
1813 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1818 DelIssue($serialseq,$subscriptionid)
1819 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1821 returns the number of rows affected
1826 my ($dataissue) = @_;
1827 my $dbh = C4::Context->dbh;
1828 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1833 AND subscriptionid= ?
1835 my $mainsth = $dbh->prepare($query);
1836 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1838 #Delete element from subscription history
1839 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1840 my $sth = $dbh->prepare($query);
1841 $sth->execute( $dataissue->{'subscriptionid'} );
1842 my $val = $sth->fetchrow_hashref;
1843 unless ( $val->{manualhistory} ) {
1845 SELECT * FROM subscriptionhistory
1846 WHERE subscriptionid= ?
1848 my $sth = $dbh->prepare($query);
1849 $sth->execute( $dataissue->{'subscriptionid'} );
1850 my $data = $sth->fetchrow_hashref;
1851 my $serialseq = $dataissue->{'serialseq'};
1852 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1853 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1854 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1855 $sth = $dbh->prepare($strsth);
1856 $sth->execute( $dataissue->{'subscriptionid'} );
1859 return $mainsth->rows;
1862 =head2 GetLateOrMissingIssues
1864 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1866 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1869 the issuelist as an array of hash refs. Each element of this array contains
1870 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1874 sub GetLateOrMissingIssues {
1875 my ( $supplierid, $serialid, $order ) = @_;
1877 return unless ( $supplierid or $serialid );
1879 my $dbh = C4::Context->dbh;
1884 $byserial = "and serialid = " . $serialid;
1887 $order .= ", title";
1891 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1893 $sth = $dbh->prepare(
1895 serialid, aqbooksellerid, name,
1896 biblio.title, biblioitems.issn, planneddate, serialseq,
1897 serial.status, serial.subscriptionid, claimdate, claims_count,
1898 subscription.branchcode, serial.publisheddate
1900 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1901 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1902 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1903 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1904 WHERE subscription.subscriptionid = serial.subscriptionid
1905 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1906 AND subscription.aqbooksellerid=$supplierid
1911 $sth = $dbh->prepare(
1913 serialid, aqbooksellerid, name,
1914 biblio.title, planneddate, serialseq,
1915 serial.status, serial.subscriptionid, claimdate, claims_count,
1916 subscription.branchcode, serial.publisheddate
1918 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1919 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1920 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1921 WHERE subscription.subscriptionid = serial.subscriptionid
1922 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1927 $sth->execute( EXPECTED, LATE, CLAIMED );
1929 while ( my $line = $sth->fetchrow_hashref ) {
1930 $line->{"status".$line->{status}} = 1;
1932 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1933 $line->{additional_fields} = { map { $_->field->name => $_->value }
1934 $subscription_object->additional_field_values->as_list };
1936 push @issuelist, $line;
1943 &updateClaim($serialid)
1945 this function updates the time when a claim is issued for late/missing items
1947 called from claims.pl file
1952 my ($serialids) = @_;
1953 return unless $serialids;
1954 unless ( ref $serialids ) {
1955 $serialids = [ $serialids ];
1958 foreach my $serialid(@$serialids) {
1959 my $serial = Koha::Serials->find($serialid);
1961 C4::Serials::ModSerialStatus(
1964 $serial->planneddate,
1965 $serial->publisheddate,
1966 $serial->publisheddatetext,
1967 C4::Serials->CLAIMED,
1972 my $dbh = C4::Context->dbh;
1975 SET claimdate = NOW(),
1976 claims_count = claims_count + 1,
1978 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1979 {}, CLAIMED, @$serialids );
1982 =head2 check_routing
1984 $result = &check_routing($subscriptionid)
1986 this function checks to see if a serial has a routing list and returns the count of routingid
1987 used to show either an 'add' or 'edit' link
1992 my ($subscriptionid) = @_;
1994 return unless ($subscriptionid);
1996 my $dbh = C4::Context->dbh;
1997 my $sth = $dbh->prepare(
1998 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1999 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2000 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
2003 $sth->execute($subscriptionid);
2004 my $line = $sth->fetchrow_hashref;
2005 my $result = $line->{'routingids'};
2009 =head2 addroutingmember
2011 addroutingmember($borrowernumber,$subscriptionid)
2013 this function takes a borrowernumber and subscriptionid and adds the member to the
2014 routing list for that serial subscription and gives them a rank on the list
2015 of either 1 or highest current rank + 1
2019 sub addroutingmember {
2020 my ( $borrowernumber, $subscriptionid ) = @_;
2022 return unless ($borrowernumber and $subscriptionid);
2025 my $dbh = C4::Context->dbh;
2026 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2027 $sth->execute($subscriptionid);
2028 while ( my $line = $sth->fetchrow_hashref ) {
2029 if ( defined $line->{rank} && $line->{rank} > 0 ) {
2030 $rank = $line->{rank} + 1;
2035 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2036 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2039 =head2 reorder_members
2041 reorder_members($subscriptionid,$routingid,$rank)
2043 this function is used to reorder the routing list
2045 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2046 - it gets all members on list puts their routingid's into an array
2047 - removes the one in the array that is $routingid
2048 - then reinjects $routingid at point indicated by $rank
2049 - then update the database with the routingids in the new order
2053 sub reorder_members {
2054 my ( $subscriptionid, $routingid, $rank ) = @_;
2055 my $dbh = C4::Context->dbh;
2056 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2057 $sth->execute($subscriptionid);
2059 while ( my $line = $sth->fetchrow_hashref ) {
2060 push( @result, $line->{'routingid'} );
2063 # To find the matching index
2065 my $key = -1; # to allow for 0 being a valid response
2066 for ( $i = 0 ; $i < @result ; $i++ ) {
2067 if ( $routingid == $result[$i] ) {
2068 $key = $i; # save the index
2073 # if index exists in array then move it to new position
2074 if ( $key > -1 && $rank > 0 ) {
2075 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2076 my $moving_item = splice( @result, $key, 1 );
2077 splice( @result, $new_rank, 0, $moving_item );
2079 for ( my $j = 0 ; $j < @result ; $j++ ) {
2080 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2086 =head2 delroutingmember
2088 delroutingmember($routingid,$subscriptionid)
2090 this function either deletes one member from routing list if $routingid exists otherwise
2091 deletes all members from the routing list
2095 sub delroutingmember {
2097 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2098 my ( $routingid, $subscriptionid ) = @_;
2099 my $dbh = C4::Context->dbh;
2101 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2102 $sth->execute($routingid);
2103 reorder_members( $subscriptionid, $routingid );
2105 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2106 $sth->execute($subscriptionid);
2111 =head2 getroutinglist
2113 @routinglist = getroutinglist($subscriptionid)
2115 this gets the info from the subscriptionroutinglist for $subscriptionid
2118 the routinglist as an array. Each element of the array contains a hash_ref containing
2119 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2123 sub getroutinglist {
2124 my ($subscriptionid) = @_;
2125 my $dbh = C4::Context->dbh;
2126 my $sth = $dbh->prepare(
2127 'SELECT routingid, borrowernumber, ranking, biblionumber
2129 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2130 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2132 $sth->execute($subscriptionid);
2133 my $routinglist = $sth->fetchall_arrayref({});
2134 return @{$routinglist};
2137 =head2 countissuesfrom
2139 $result = countissuesfrom($subscriptionid,$startdate)
2141 Returns a count of serial rows matching the given subsctiptionid
2142 with published date greater than startdate
2146 sub countissuesfrom {
2147 my ( $subscriptionid, $startdate ) = @_;
2148 my $dbh = C4::Context->dbh;
2152 WHERE subscriptionid=?
2153 AND serial.publisheddate>?
2155 my $sth = $dbh->prepare($query);
2156 $sth->execute( $subscriptionid, $startdate );
2157 my ($countreceived) = $sth->fetchrow;
2158 return $countreceived;
2163 $result = CountIssues($subscriptionid)
2165 Returns a count of serial rows matching the given subsctiptionid
2170 my ($subscriptionid) = @_;
2171 my $dbh = C4::Context->dbh;
2175 WHERE subscriptionid=?
2177 my $sth = $dbh->prepare($query);
2178 $sth->execute($subscriptionid);
2179 my ($countreceived) = $sth->fetchrow;
2180 return $countreceived;
2185 $result = HasItems($subscriptionid)
2187 returns a count of items from serial matching the subscriptionid
2192 my ($subscriptionid) = @_;
2193 my $dbh = C4::Context->dbh;
2195 SELECT COUNT(serialitems.itemnumber)
2197 LEFT JOIN serialitems USING(serialid)
2198 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2200 my $sth=$dbh->prepare($query);
2201 $sth->execute($subscriptionid);
2202 my ($countitems)=$sth->fetchrow_array();
2206 =head2 abouttoexpire
2208 $result = abouttoexpire($subscriptionid)
2210 this function alerts you to the penultimate issue for a serial subscription
2212 returns 1 - if this is the penultimate issue
2218 my ($subscriptionid) = @_;
2219 my $dbh = C4::Context->dbh;
2220 my $subscription = GetSubscription($subscriptionid);
2221 my $per = $subscription->{'periodicity'};
2222 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2223 if ($frequency and $frequency->{unit}){
2225 my $expirationdate = GetExpirationDate($subscriptionid);
2227 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2228 my $nextdate = GetNextDate($subscription, $res, $frequency);
2230 # only compare dates if both dates exist.
2231 if ($nextdate and $expirationdate) {
2232 if(Date::Calc::Delta_Days(
2233 split( /-/, $nextdate ),
2234 split( /-/, $expirationdate )
2240 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2241 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2247 =head2 GetFictiveIssueNumber
2249 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2251 Get the position of the issue published at $publisheddate, considering the
2252 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2253 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2254 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2255 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2256 depending on how many rows are in serial table.
2257 The issue number calculation is based on subscription frequency, first acquisition
2258 date, and $publisheddate.
2260 Returns undef when called for irregular frequencies.
2262 The routine is used to skip irregularities when calculating the next issue
2263 date (in GetNextDate) or the next issue number (in GetNextSeq).
2267 sub GetFictiveIssueNumber {
2268 my ($subscription, $publisheddate, $frequency) = @_;
2270 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2274 my ( $year, $month, $day ) = split /-/, $publisheddate;
2275 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2276 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2278 if( $frequency->{'unitsperissue'} == 1 ) {
2279 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2280 } else { # issuesperunit == 1
2281 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2287 my ( $date1, $date2, $unit ) = @_;
2288 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2290 if( $unit eq 'day' ) {
2291 return Delta_Days( @$date1, @$date2 );
2292 } elsif( $unit eq 'week' ) {
2293 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2296 # In case of months or years, this is a wrapper around N_Delta_YMD.
2297 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2298 # while we expect 1 month.
2299 my @delta = N_Delta_YMD( @$date1, @$date2 );
2300 if( $delta[2] > 27 ) {
2301 # Check if we could add a month
2302 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2303 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2307 if( $delta[1] >= 12 ) {
2311 # if unit is year, we only return full years
2312 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2315 sub _get_next_date_day {
2316 my ($subscription, $freqdata, $year, $month, $day) = @_;
2318 my @newissue; # ( yy, mm, dd )
2319 # We do not need $delta_days here, since it would be zero where used
2321 if( $freqdata->{issuesperunit} == 1 ) {
2323 @newissue = Add_Delta_Days(
2324 $year, $month, $day, $freqdata->{"unitsperissue"} );
2325 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2327 @newissue = ( $year, $month, $day );
2328 $subscription->{countissuesperunit}++;
2330 # We finished a cycle of issues within a unit.
2331 # No subtraction of zero needed, just add one day
2332 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2333 $subscription->{countissuesperunit} = 1;
2338 sub _get_next_date_week {
2339 my ($subscription, $freqdata, $year, $month, $day) = @_;
2341 my @newissue; # ( yy, mm, dd )
2342 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2344 if( $freqdata->{issuesperunit} == 1 ) {
2345 # Add full weeks (of 7 days)
2346 @newissue = Add_Delta_Days(
2347 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2348 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2349 # Add rounded number of days based on frequency.
2350 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2351 $subscription->{countissuesperunit}++;
2353 # We finished a cycle of issues within a unit.
2354 # Subtract delta * (issues - 1), add 1 week
2355 @newissue = Add_Delta_Days( $year, $month, $day,
2356 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2357 @newissue = Add_Delta_Days( @newissue, 7 );
2358 $subscription->{countissuesperunit} = 1;
2363 sub _get_next_date_month {
2364 my ($subscription, $freqdata, $year, $month, $day) = @_;
2366 my @newissue; # ( yy, mm, dd )
2367 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2369 if( $freqdata->{issuesperunit} == 1 ) {
2371 @newissue = Add_Delta_YM(
2372 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2373 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2374 # Add rounded number of days based on frequency.
2375 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2376 $subscription->{countissuesperunit}++;
2378 # We finished a cycle of issues within a unit.
2379 # Subtract delta * (issues - 1), add 1 month
2380 @newissue = Add_Delta_Days( $year, $month, $day,
2381 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2382 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2383 $subscription->{countissuesperunit} = 1;
2388 sub _get_next_date_year {
2389 my ($subscription, $freqdata, $year, $month, $day) = @_;
2391 my @newissue; # ( yy, mm, dd )
2392 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2394 if( $freqdata->{issuesperunit} == 1 ) {
2396 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2397 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2398 # Add rounded number of days based on frequency.
2399 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2400 $subscription->{countissuesperunit}++;
2402 # We finished a cycle of issues within a unit.
2403 # Subtract delta * (issues - 1), add 1 year
2404 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2405 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2406 $subscription->{countissuesperunit} = 1;
2413 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2415 this function it takes the publisheddate and will return the next issue's date
2416 and will skip dates if there exists an irregularity.
2417 $publisheddate has to be an ISO date
2418 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2419 $frequency is a hashref containing frequency informations
2420 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2421 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2422 skipped then the returned date will be 2007-05-10
2425 $resultdate - then next date in the sequence (ISO date)
2427 Return undef if subscription is irregular
2432 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2434 return unless $subscription and $publisheddate;
2437 if ($freqdata->{'unit'}) {
2438 my ( $year, $month, $day ) = split /-/, $publisheddate;
2440 # Process an irregularity Hash
2441 # Suppose that irregularities are stored in a string with this structure
2442 # irreg1;irreg2;irreg3
2443 # where irregX is the number of issue which will not be received
2444 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2446 if ( $subscription->{irregularity} ) {
2447 my @irreg = split /;/, $subscription->{'irregularity'} ;
2448 foreach my $irregularity (@irreg) {
2449 $irregularities{$irregularity} = 1;
2453 # Get the 'fictive' next issue number
2454 # It is used to check if next issue is an irregular issue.
2455 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2457 # Then get the next date
2458 my $unit = lc $freqdata->{'unit'};
2459 if ($unit eq 'day') {
2460 while ($irregularities{$issueno}) {
2461 ($year, $month, $day) = _get_next_date_day($subscription,
2462 $freqdata, $year, $month, $day);
2465 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2466 $year, $month, $day);
2468 elsif ($unit eq 'week') {
2469 while ($irregularities{$issueno}) {
2470 ($year, $month, $day) = _get_next_date_week($subscription,
2471 $freqdata, $year, $month, $day);
2474 ($year, $month, $day) = _get_next_date_week($subscription,
2475 $freqdata, $year, $month, $day);
2477 elsif ($unit eq 'month') {
2478 while ($irregularities{$issueno}) {
2479 ($year, $month, $day) = _get_next_date_month($subscription,
2480 $freqdata, $year, $month, $day);
2483 ($year, $month, $day) = _get_next_date_month($subscription,
2484 $freqdata, $year, $month, $day);
2486 elsif ($unit eq 'year') {
2487 while ($irregularities{$issueno}) {
2488 ($year, $month, $day) = _get_next_date_year($subscription,
2489 $freqdata, $year, $month, $day);
2492 ($year, $month, $day) = _get_next_date_year($subscription,
2493 $freqdata, $year, $month, $day);
2497 my $dbh = C4::Context->dbh;
2500 SET countissuesperunit = ?
2501 WHERE subscriptionid = ?
2503 my $sth = $dbh->prepare($query);
2504 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2507 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2513 $string = &_numeration($value,$num_type,$locale);
2515 _numeration returns the string corresponding to $value in the num_type
2527 my ($value, $num_type, $locale) = @_;
2532 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2533 # 1970-11-01 was a Sunday
2534 $value = $value % 7;
2535 my $dt = DateTime->new(
2541 $string = $num_type =~ /^dayname$/
2542 ? $dt->strftime("%A")
2543 : $dt->strftime("%a");
2544 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2545 $value = $value % 12;
2546 my $dt = DateTime->new(
2548 month => $value + 1,
2551 $string = $num_type =~ /^monthname$/
2552 ? $dt->format_cldr( "LLLL" )
2553 : $dt->strftime("%b");
2554 } elsif ( $num_type =~ /^season$/ ) {
2555 my @seasons= qw( Spring Summer Fall Winter );
2556 $value = $value % 4;
2557 $string = $seasons[$value];
2558 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2559 my @seasonsabrv= qw( Spr Sum Fal Win );
2560 $value = $value % 4;
2561 $string = $seasonsabrv[$value];
2569 =head2 CloseSubscription
2571 Close a subscription given a subscriptionid
2575 sub CloseSubscription {
2576 my ( $subscriptionid ) = @_;
2577 return unless $subscriptionid;
2578 my $dbh = C4::Context->dbh;
2579 my $sth = $dbh->prepare( q{
2582 WHERE subscriptionid = ?
2584 $sth->execute( $subscriptionid );
2586 # Set status = missing when status = stopped
2587 $sth = $dbh->prepare( q{
2590 WHERE subscriptionid = ?
2593 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2596 =head2 ReopenSubscription
2598 Reopen a subscription given a subscriptionid
2602 sub ReopenSubscription {
2603 my ( $subscriptionid ) = @_;
2604 return unless $subscriptionid;
2605 my $dbh = C4::Context->dbh;
2606 my $sth = $dbh->prepare( q{
2609 WHERE subscriptionid = ?
2611 $sth->execute( $subscriptionid );
2613 # Set status = expected when status = stopped
2614 $sth = $dbh->prepare( q{
2617 WHERE subscriptionid = ?
2620 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2623 =head2 subscriptionCurrentlyOnOrder
2625 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2627 Return 1 if subscription is currently on order else 0.
2631 sub subscriptionCurrentlyOnOrder {
2632 my ( $subscriptionid ) = @_;
2633 my $dbh = C4::Context->dbh;
2635 SELECT COUNT(*) FROM aqorders
2636 WHERE subscriptionid = ?
2637 AND datereceived IS NULL
2638 AND datecancellationprinted IS NULL
2640 my $sth = $dbh->prepare( $query );
2641 $sth->execute($subscriptionid);
2642 return $sth->fetchrow_array;
2645 =head2 can_claim_subscription
2647 $can = can_claim_subscription( $subscriptionid[, $userid] );
2649 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2653 sub can_claim_subscription {
2654 my ( $subscription, $userid ) = @_;
2655 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2658 =head2 can_edit_subscription
2660 $can = can_edit_subscription( $subscriptionid[, $userid] );
2662 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2666 sub can_edit_subscription {
2667 my ( $subscription, $userid ) = @_;
2668 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2671 =head2 can_show_subscription
2673 $can = can_show_subscription( $subscriptionid[, $userid] );
2675 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2679 sub can_show_subscription {
2680 my ( $subscription, $userid ) = @_;
2681 return _can_do_on_subscription( $subscription, $userid, '*' );
2684 sub _can_do_on_subscription {
2685 my ( $subscription, $userid, $permission ) = @_;
2686 return 0 unless C4::Context->userenv;
2687 my $flags = C4::Context->userenv->{flags};
2688 $userid ||= C4::Context->userenv->{'id'};
2690 if ( C4::Context->preference('IndependentBranches') ) {
2692 if C4::Context->IsSuperLibrarian()
2694 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2696 C4::Auth::haspermission( $userid,
2697 { serials => $permission } )
2698 and ( not defined $subscription->{branchcode}
2699 or $subscription->{branchcode} eq ''
2700 or $subscription->{branchcode} eq
2701 C4::Context->userenv->{'branch'} )
2706 if C4::Context->IsSuperLibrarian()
2708 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2709 or C4::Auth::haspermission(
2710 $userid, { serials => $permission }
2717 =head2 findSerialsByStatus
2719 @serials = findSerialsByStatus($status, $subscriptionid);
2721 Returns an array of serials matching a given status and subscription id.
2725 sub findSerialsByStatus {
2726 my ( $status, $subscriptionid ) = @_;
2727 my $dbh = C4::Context->dbh;
2728 my $query = q| SELECT * from serial
2730 AND subscriptionid = ?
2732 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2741 Koha Development Team <http://koha-community.org/>