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);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalFieldValues;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
38 use Koha::SharedContent;
39 use Scalar::Util qw( looks_like_number );
41 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
49 MISSING_NEVER_RECIEVED => 41,
50 MISSING_SOLD_OUT => 42,
51 MISSING_DAMAGED => 43,
59 use constant MISSING_STATUSES => (
60 MISSING, MISSING_NEVER_RECIEVED,
61 MISSING_SOLD_OUT, MISSING_DAMAGED,
69 &NewSubscription &ModSubscription &DelSubscription
70 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
72 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
73 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
74 &GetSubscriptionHistoryFromSubscriptionId
76 &GetNextSeq &GetSeq &NewIssue &GetSerials
77 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
78 &GetSubscriptionLength &ReNewSubscription &GetLateOrMissingIssues
79 &GetSerialInformation &AddItem2Serial
80 &PrepareSerialsData &GetNextExpected &ModNextExpected
83 &GetSuppliersWithLateIssues
84 &getroutinglist &delroutingmember &addroutingmember
86 &check_routing &updateClaim
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues {
122 my $dbh = C4::Context->dbh;
123 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
125 SELECT DISTINCT id, name
127 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
131 (planneddate < now() AND serial.status=1)
132 OR serial.STATUS IN ( $statuses )
134 AND subscription.closed = 0
136 return $dbh->selectall_arrayref($query, { Slice => {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId {
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4::Context->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid = ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialInformation
168 $data = GetSerialInformation($serialid);
169 returns a hash_ref containing :
170 items : items marcrecord (can be an array)
172 subscription table field
173 + information about subscription expiration
177 sub GetSerialInformation {
179 my $dbh = C4::Context->dbh;
181 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
182 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
185 my $rq = $dbh->prepare($query);
186 $rq->execute($serialid);
187 my $data = $rq->fetchrow_hashref;
189 # create item information if we have serialsadditems for this subscription
190 if ( $data->{'serialsadditems'} ) {
191 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
192 $queryitem->execute($serialid);
193 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
195 if ( scalar(@$itemnumbers) > 0 ) {
196 foreach my $itemnum (@$itemnumbers) {
198 #It is ASSUMED that GetMarcItem ALWAYS WORK...
199 #Maybe GetMarcItem should return values on failure
200 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
201 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
202 $itemprocessed->{'itemnumber'} = $itemnum->[0];
203 $itemprocessed->{'itemid'} = $itemnum->[0];
204 $itemprocessed->{'serialid'} = $serialid;
205 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
206 push @{ $data->{'items'} }, $itemprocessed;
209 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
210 $itemprocessed->{'itemid'} = "N$serialid";
211 $itemprocessed->{'serialid'} = $serialid;
212 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
213 $itemprocessed->{'countitems'} = 0;
214 push @{ $data->{'items'} }, $itemprocessed;
217 $data->{ "status" . $data->{'serstatus'} } = 1;
218 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
219 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
220 $data->{cannotedit} = not can_edit_subscription( $data );
224 =head2 AddItem2Serial
226 $rows = AddItem2Serial($serialid,$itemnumber);
227 Adds an itemnumber to Serial record
228 returns the number of rows affected
233 my ( $serialid, $itemnumber ) = @_;
235 return unless ($serialid and $itemnumber);
237 my $dbh = C4::Context->dbh;
238 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
239 $rq->execute( $serialid, $itemnumber );
243 =head2 GetSubscription
245 $subs = GetSubscription($subscriptionid)
246 this function returns the subscription which has $subscriptionid as id.
248 a hashref. This hash contains
249 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
253 sub GetSubscription {
254 my ($subscriptionid) = @_;
255 my $dbh = C4::Context->dbh;
257 SELECT subscription.*,
258 subscriptionhistory.*,
259 aqbooksellers.name AS aqbooksellername,
260 biblio.title AS bibliotitle,
261 subscription.biblionumber as bibnum
263 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
264 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
265 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
266 WHERE subscription.subscriptionid = ?
269 $debug and warn "query : $query\nsubsid :$subscriptionid";
270 my $sth = $dbh->prepare($query);
271 $sth->execute($subscriptionid);
272 my $subscription = $sth->fetchrow_hashref;
274 return unless $subscription;
276 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
278 if ( my $mana_id = $subscription->{mana_id} ) {
279 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
280 'subscription', $mana_id, {usecomments => 1});
281 $subscription->{comments} = $mana_subscription->{data}->{comments};
284 return $subscription;
287 =head2 GetFullSubscription
289 $array_ref = GetFullSubscription($subscriptionid)
290 this function reads the serial table.
294 sub GetFullSubscription {
295 my ($subscriptionid) = @_;
297 return unless ($subscriptionid);
299 my $dbh = C4::Context->dbh;
301 SELECT serial.serialid,
304 serial.publisheddate,
305 serial.publisheddatetext,
307 serial.notes as notes,
308 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
309 aqbooksellers.name as aqbooksellername,
310 biblio.title as bibliotitle,
311 subscription.branchcode AS branchcode,
312 subscription.subscriptionid AS subscriptionid
314 LEFT JOIN subscription ON
315 (serial.subscriptionid=subscription.subscriptionid )
316 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
317 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
318 WHERE serial.subscriptionid = ?
320 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
321 serial.subscriptionid
323 $debug and warn "GetFullSubscription query: $query";
324 my $sth = $dbh->prepare($query);
325 $sth->execute($subscriptionid);
326 my $subscriptions = $sth->fetchall_arrayref( {} );
327 if (scalar @$subscriptions) {
328 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
329 for my $subscription ( @$subscriptions ) {
330 $subscription->{cannotedit} = $cannotedit;
334 return $subscriptions;
337 =head2 PrepareSerialsData
339 $array_ref = PrepareSerialsData($serialinfomation)
340 where serialinformation is a hashref array
344 sub PrepareSerialsData {
347 return unless ($lines);
354 my $previousnote = "";
356 foreach my $subs (@{$lines}) {
357 $subs->{ "status" . $subs->{'status'} } = 1;
358 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
359 $subs->{"checked"} = 1;
362 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
363 $year = $subs->{'year'};
367 if ( $tmpresults{$year} ) {
368 push @{ $tmpresults{$year}->{'serials'} }, $subs;
370 $tmpresults{$year} = {
372 'aqbooksellername' => $subs->{'aqbooksellername'},
373 'bibliotitle' => $subs->{'bibliotitle'},
374 'serials' => [$subs],
379 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
380 push @res, $tmpresults{$key};
385 =head2 GetSubscriptionsFromBiblionumber
387 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
388 this function get the subscription list. it reads the subscription table.
390 reference to an array of subscriptions which have the biblionumber given on input arg.
391 each element of this array is a hashref containing
392 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
396 sub GetSubscriptionsFromBiblionumber {
397 my ($biblionumber) = @_;
399 return unless ($biblionumber);
401 my $dbh = C4::Context->dbh;
403 SELECT subscription.*,
405 subscriptionhistory.*,
406 aqbooksellers.name AS aqbooksellername,
407 biblio.title AS bibliotitle
409 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
410 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
411 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
412 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
413 WHERE subscription.biblionumber = ?
415 my $sth = $dbh->prepare($query);
416 $sth->execute($biblionumber);
418 while ( my $subs = $sth->fetchrow_hashref ) {
419 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
420 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
421 if ( defined $subs->{histenddate} ) {
422 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
424 $subs->{histenddate} = "";
426 $subs->{opacnote} //= "";
427 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
428 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
429 $subs->{ "status" . $subs->{'status'} } = 1;
431 if (not defined $subs->{enddate} ) {
432 $subs->{enddate} = '';
434 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
436 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
437 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
438 $subs->{cannotedit} = not can_edit_subscription( $subs );
444 =head2 GetFullSubscriptionsFromBiblionumber
446 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
447 this function reads the serial table.
451 sub GetFullSubscriptionsFromBiblionumber {
452 my ($biblionumber) = @_;
453 my $dbh = C4::Context->dbh;
455 SELECT serial.serialid,
458 serial.publisheddate,
459 serial.publisheddatetext,
461 serial.notes as notes,
462 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
463 biblio.title as bibliotitle,
464 subscription.branchcode AS branchcode,
465 subscription.subscriptionid AS subscriptionid
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);
523 return () unless @subscriptions;
525 $matching_record_ids_for_additional_fields = [ map {
532 subscription.notes AS publicnotes,
533 subscriptionhistory.*,
535 biblio.notes AS biblionotes,
539 aqbooksellers.name AS vendorname,
542 LEFT JOIN subscriptionhistory USING(subscriptionid)
543 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
544 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
545 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
547 $query .= q| WHERE 1|;
550 if( $args->{biblionumber} ) {
551 push @where_strs, "biblio.biblionumber = ?";
552 push @where_args, $args->{biblionumber};
555 if( $args->{title} ){
556 my @words = split / /, $args->{title};
558 foreach my $word (@words) {
559 push @strs, "biblio.title LIKE ?";
560 push @args, "%$word%";
563 push @where_strs, '(' . join (' AND ', @strs) . ')';
564 push @where_args, @args;
568 push @where_strs, "biblioitems.issn LIKE ?";
569 push @where_args, "%$args->{issn}%";
572 push @where_strs, "biblioitems.ean LIKE ?";
573 push @where_args, "%$args->{ean}%";
575 if ( $args->{callnumber} ) {
576 push @where_strs, "subscription.callnumber LIKE ?";
577 push @where_args, "%$args->{callnumber}%";
579 if( $args->{publisher} ){
580 push @where_strs, "biblioitems.publishercode LIKE ?";
581 push @where_args, "%$args->{publisher}%";
583 if( $args->{bookseller} ){
584 push @where_strs, "aqbooksellers.name LIKE ?";
585 push @where_args, "%$args->{bookseller}%";
587 if( $args->{branch} ){
588 push @where_strs, "subscription.branchcode = ?";
589 push @where_args, "$args->{branch}";
591 if ( $args->{location} ) {
592 push @where_strs, "subscription.location = ?";
593 push @where_args, "$args->{location}";
595 if ( $args->{expiration_date} ) {
596 push @where_strs, "subscription.enddate <= ?";
597 push @where_args, "$args->{expiration_date}";
599 if( defined $args->{closed} ){
600 push @where_strs, "subscription.closed = ?";
601 push @where_args, "$args->{closed}";
605 $query .= ' AND ' . join(' AND ', @where_strs);
607 if ( @$additional_fields ) {
608 $query .= ' AND subscriptionid IN ('
609 . join( ', ', @$matching_record_ids_for_additional_fields )
613 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
615 my $dbh = C4::Context->dbh;
616 my $sth = $dbh->prepare($query);
617 $sth->execute(@where_args);
618 my $results = $sth->fetchall_arrayref( {} );
620 for my $subscription ( @$results ) {
621 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
622 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
624 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
625 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
626 $subscription_object->additional_field_values->as_list };
636 ($totalissues,@serials) = GetSerials($subscriptionid);
637 this function gets every serial not arrived for a given subscription
638 as well as the number of issues registered in the database (all types)
639 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
641 FIXME: We should return \@serials.
646 my ( $subscriptionid, $count ) = @_;
648 return unless $subscriptionid;
650 my $dbh = C4::Context->dbh;
652 # status = 2 is "arrived"
654 $count = 5 unless ($count);
656 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
657 my $query = "SELECT serialid,serialseq, status, publisheddate,
658 publisheddatetext, planneddate,notes, routingnotes
660 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
661 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
662 my $sth = $dbh->prepare($query);
663 $sth->execute($subscriptionid);
665 while ( my $line = $sth->fetchrow_hashref ) {
666 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
667 for my $datefield ( qw( planneddate publisheddate) ) {
668 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
669 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
671 $line->{$datefield} = q{};
674 push @serials, $line;
677 # OK, now add the last 5 issues arrives/missing
678 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
679 publisheddatetext, notes, routingnotes
681 WHERE subscriptionid = ?
682 AND status IN ( $statuses )
683 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
685 $sth = $dbh->prepare($query);
686 $sth->execute($subscriptionid);
687 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
689 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
690 for my $datefield ( qw( planneddate publisheddate) ) {
691 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
692 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
694 $line->{$datefield} = q{};
698 push @serials, $line;
701 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
702 $sth = $dbh->prepare($query);
703 $sth->execute($subscriptionid);
704 my ($totalissues) = $sth->fetchrow;
705 return ( $totalissues, @serials );
710 @serials = GetSerials2($subscriptionid,$statuses);
711 this function returns every serial waited for a given subscription
712 as well as the number of issues registered in the database (all types)
713 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
715 $statuses is an arrayref of statuses and is mandatory.
720 my ( $subscription, $statuses ) = @_;
722 return unless ($subscription and @$statuses);
724 my $dbh = C4::Context->dbh;
726 SELECT serialid,serialseq, status, planneddate, publisheddate,
727 publisheddatetext, notes, routingnotes
729 WHERE subscriptionid=?
731 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
733 ORDER BY publisheddate,serialid DESC
735 $debug and warn "GetSerials2 query: $query";
736 my $sth = $dbh->prepare($query);
737 $sth->execute( $subscription, @$statuses );
740 while ( my $line = $sth->fetchrow_hashref ) {
741 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
742 # Format dates for display
743 for my $datefield ( qw( planneddate publisheddate ) ) {
744 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
745 $line->{$datefield} = q{};
748 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
751 push @serials, $line;
756 =head2 GetLatestSerials
758 \@serials = GetLatestSerials($subscriptionid,$limit)
759 get the $limit's latest serials arrived or missing for a given subscription
761 a ref to an array which contains all of the latest serials stored into a hash.
765 sub GetLatestSerials {
766 my ( $subscriptionid, $limit ) = @_;
768 return unless ($subscriptionid and $limit);
770 my $dbh = C4::Context->dbh;
772 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
773 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
775 WHERE subscriptionid = ?
776 AND status IN ($statuses)
777 ORDER BY publisheddate DESC LIMIT 0,$limit
779 my $sth = $dbh->prepare($strsth);
780 $sth->execute($subscriptionid);
782 while ( my $line = $sth->fetchrow_hashref ) {
783 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
784 push @serials, $line;
790 =head2 GetPreviousSerialid
792 $serialid = GetPreviousSerialid($subscriptionid, $nth)
793 get the $nth's previous serial for the given subscriptionid
799 sub GetPreviousSerialid {
800 my ( $subscriptionid, $nth ) = @_;
802 my $dbh = C4::Context->dbh;
806 my $strsth = "SELECT serialid
808 WHERE subscriptionid = ?
810 ORDER BY serialid DESC LIMIT $nth,1
812 my $sth = $dbh->prepare($strsth);
813 $sth->execute($subscriptionid);
815 my $line = $sth->fetchrow_hashref;
816 $return = $line->{'serialid'} if ($line);
824 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
825 $newinnerloop1, $newinnerloop2, $newinnerloop3
826 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
828 $subscription is a hashref containing all the attributes of the table
830 $pattern is a hashref containing all the attributes of the table
831 'subscription_numberpatterns'.
832 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
833 $planneddate is a date string in iso format.
834 This function get the next issue for the subscription given on input arg
839 my ($subscription, $pattern, $frequency, $planneddate) = @_;
841 return unless ($subscription and $pattern);
843 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
844 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
847 if ($subscription->{'skip_serialseq'}) {
848 my @irreg = split /;/, $subscription->{'irregularity'};
850 my $irregularities = {};
851 $irregularities->{$_} = 1 foreach(@irreg);
852 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
853 while($irregularities->{$issueno}) {
860 my $numberingmethod = $pattern->{numberingmethod};
862 if ($numberingmethod) {
863 $calculated = $numberingmethod;
864 my $locale = $subscription->{locale};
865 $newlastvalue1 = $subscription->{lastvalue1} || 0;
866 $newlastvalue2 = $subscription->{lastvalue2} || 0;
867 $newlastvalue3 = $subscription->{lastvalue3} || 0;
868 $newinnerloop1 = $subscription->{innerloop1} || 0;
869 $newinnerloop2 = $subscription->{innerloop2} || 0;
870 $newinnerloop3 = $subscription->{innerloop3} || 0;
873 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
876 for(my $i = 0; $i < $count; $i++) {
878 # check if we have to increase the new value.
880 if ($newinnerloop1 >= $pattern->{every1}) {
882 $newlastvalue1 += $pattern->{add1};
884 # reset counter if needed.
885 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
888 # check if we have to increase the new value.
890 if ($newinnerloop2 >= $pattern->{every2}) {
892 $newlastvalue2 += $pattern->{add2};
894 # reset counter if needed.
895 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
898 # check if we have to increase the new value.
900 if ($newinnerloop3 >= $pattern->{every3}) {
902 $newlastvalue3 += $pattern->{add3};
904 # reset counter if needed.
905 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
909 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
910 $calculated =~ s/\{X\}/$newlastvalue1string/g;
913 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
914 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
917 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
918 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
923 $newlastvalue1, $newlastvalue2, $newlastvalue3,
924 $newinnerloop1, $newinnerloop2, $newinnerloop3);
929 $calculated = GetSeq($subscription, $pattern)
930 $subscription is a hashref containing all the attributes of the table 'subscription'
931 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
932 this function transforms {X},{Y},{Z} to 150,0,0 for example.
934 the sequence in string format
939 my ($subscription, $pattern) = @_;
941 return unless ($subscription and $pattern);
943 my $locale = $subscription->{locale};
945 my $calculated = $pattern->{numberingmethod};
947 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
948 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
949 $calculated =~ s/\{X\}/$newlastvalue1/g;
951 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
952 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
953 $calculated =~ s/\{Y\}/$newlastvalue2/g;
955 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
956 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
957 $calculated =~ s/\{Z\}/$newlastvalue3/g;
961 =head2 GetExpirationDate
963 $enddate = GetExpirationDate($subscriptionid, [$startdate])
965 this function return the next expiration date for a subscription given on input args.
972 sub GetExpirationDate {
973 my ( $subscriptionid, $startdate ) = @_;
975 return unless ($subscriptionid);
977 my $dbh = C4::Context->dbh;
978 my $subscription = GetSubscription($subscriptionid);
981 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
982 $enddate = $startdate || $subscription->{startdate};
983 my @date = split( /-/, $enddate );
985 return if ( scalar(@date) != 3 || not check_date(@date) );
987 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
988 if ( $frequency and $frequency->{unit} ) {
991 if ( my $length = $subscription->{numberlength} ) {
993 #calculate the date of the last issue.
994 for ( my $i = 1 ; $i <= $length ; $i++ ) {
995 $enddate = GetNextDate( $subscription, $enddate, $frequency );
997 } elsif ( $subscription->{monthlength} ) {
998 if ( $$subscription{startdate} ) {
999 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1000 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1002 } elsif ( $subscription->{weeklength} ) {
1003 if ( $$subscription{startdate} ) {
1004 my @date = split( /-/, $subscription->{startdate} );
1005 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1006 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1009 $enddate = $subscription->{enddate};
1013 return $subscription->{enddate};
1017 =head2 CountSubscriptionFromBiblionumber
1019 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1020 this returns a count of the subscriptions for a given biblionumber
1022 the number of subscriptions
1026 sub CountSubscriptionFromBiblionumber {
1027 my ($biblionumber) = @_;
1029 return unless ($biblionumber);
1031 my $dbh = C4::Context->dbh;
1032 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1033 my $sth = $dbh->prepare($query);
1034 $sth->execute($biblionumber);
1035 my $subscriptionsnumber = $sth->fetchrow;
1036 return $subscriptionsnumber;
1039 =head2 ModSubscriptionHistory
1041 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1043 this function modifies the history of a subscription. Put your new values on input arg.
1044 returns the number of rows affected
1048 sub ModSubscriptionHistory {
1049 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1051 return unless ($subscriptionid);
1053 my $dbh = C4::Context->dbh;
1054 my $query = "UPDATE subscriptionhistory
1055 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1056 WHERE subscriptionid=?
1058 my $sth = $dbh->prepare($query);
1059 $receivedlist =~ s/^; // if $receivedlist;
1060 $missinglist =~ s/^; // if $missinglist;
1061 $opacnote =~ s/^; // if $opacnote;
1062 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1066 =head2 ModSerialStatus
1068 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1069 $publisheddatetext, $status, $notes);
1071 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1072 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1076 sub ModSerialStatus {
1077 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1078 $status, $notes) = @_;
1080 return unless ($serialid);
1082 #It is a usual serial
1083 # 1st, get previous status :
1084 my $dbh = C4::Context->dbh;
1085 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1086 FROM serial, subscription
1087 WHERE serial.subscriptionid=subscription.subscriptionid
1089 my $sth = $dbh->prepare($query);
1090 $sth->execute($serialid);
1091 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1092 my $frequency = GetSubscriptionFrequency($periodicity);
1094 # change status & update subscriptionhistory
1096 if ( $status == DELETED ) {
1097 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1101 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1102 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1105 $sth = $dbh->prepare($query);
1106 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1107 $planneddate, $status, $notes, $routingnotes, $serialid );
1108 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1109 $sth = $dbh->prepare($query);
1110 $sth->execute($subscriptionid);
1111 my $val = $sth->fetchrow_hashref;
1112 unless ( $val->{manualhistory} ) {
1113 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1114 $sth = $dbh->prepare($query);
1115 $sth->execute($subscriptionid);
1116 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1118 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1119 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1122 # in case serial has been previously marked as missing
1123 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1124 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1127 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1128 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1130 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1131 $sth = $dbh->prepare($query);
1132 $recievedlist =~ s/^; //;
1133 $missinglist =~ s/^; //;
1134 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1138 # create new expected entry if needed (ie : was "expected" and has changed)
1139 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1140 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1141 my $subscription = GetSubscription($subscriptionid);
1142 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1143 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1147 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1148 $newinnerloop1, $newinnerloop2, $newinnerloop3
1150 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1152 # next date (calculated from actual date & frequency parameters)
1153 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1154 my $nextpubdate = $nextpublisheddate;
1155 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1156 WHERE subscriptionid = ?";
1157 $sth = $dbh->prepare($query);
1158 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1159 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1160 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1161 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1162 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1163 require C4::Letters;
1164 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1172 # Adds or removes seqno from list when needed; returns list
1173 # Or checks and returns true when present
1175 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1177 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1179 if( !$op or $op eq 'ADD' ) {
1180 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1181 } elsif( $op eq 'REMOVE' ) {
1182 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1184 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1189 =head2 GetNextExpected
1191 $nextexpected = GetNextExpected($subscriptionid)
1193 Get the planneddate for the current expected issue of the subscription.
1199 planneddate => ISO date
1204 sub GetNextExpected {
1205 my ($subscriptionid) = @_;
1207 my $dbh = C4::Context->dbh;
1211 WHERE subscriptionid = ?
1215 my $sth = $dbh->prepare($query);
1217 # Each subscription has only one 'expected' issue.
1218 $sth->execute( $subscriptionid, EXPECTED );
1219 my $nextissue = $sth->fetchrow_hashref;
1220 if ( !$nextissue ) {
1224 WHERE subscriptionid = ?
1225 ORDER BY publisheddate DESC
1228 $sth = $dbh->prepare($query);
1229 $sth->execute($subscriptionid);
1230 $nextissue = $sth->fetchrow_hashref;
1232 foreach(qw/planneddate publisheddate/) {
1233 # or should this default to 1st Jan ???
1234 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1240 =head2 ModNextExpected
1242 ModNextExpected($subscriptionid,$date)
1244 Update the planneddate for the current expected issue of the subscription.
1245 This will modify all future prediction results.
1247 C<$date> is an ISO date.
1253 sub ModNextExpected {
1254 my ( $subscriptionid, $date ) = @_;
1255 my $dbh = C4::Context->dbh;
1257 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1258 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1260 # Each subscription has only one 'expected' issue.
1261 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1266 =head2 GetSubscriptionIrregularities
1270 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1271 get the list of irregularities for a subscription
1277 sub GetSubscriptionIrregularities {
1278 my $subscriptionid = shift;
1280 return unless $subscriptionid;
1282 my $dbh = C4::Context->dbh;
1286 WHERE subscriptionid = ?
1288 my $sth = $dbh->prepare($query);
1289 $sth->execute($subscriptionid);
1291 my ($result) = $sth->fetchrow_array;
1292 my @irreg = split /;/, $result;
1297 =head2 ModSubscription
1299 this function modifies a subscription. Put all new values on input args.
1300 returns the number of rows affected
1304 sub ModSubscription {
1306 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1307 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1308 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1309 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1310 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1311 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1312 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1313 $itemtype, $previousitemtype, $mana_id
1316 my $subscription = Koha::Subscriptions->find($subscriptionid);
1319 librarian => $auser,
1320 branchcode => $branchcode,
1321 aqbooksellerid => $aqbooksellerid,
1323 aqbudgetid => $aqbudgetid,
1324 biblionumber => $biblionumber,
1325 startdate => $startdate,
1326 periodicity => $periodicity,
1327 numberlength => $numberlength,
1328 weeklength => $weeklength,
1329 monthlength => $monthlength,
1330 lastvalue1 => $lastvalue1,
1331 innerloop1 => $innerloop1,
1332 lastvalue2 => $lastvalue2,
1333 innerloop2 => $innerloop2,
1334 lastvalue3 => $lastvalue3,
1335 innerloop3 => $innerloop3,
1339 firstacquidate => $firstacquidate,
1340 irregularity => $irregularity,
1341 numberpattern => $numberpattern,
1343 callnumber => $callnumber,
1344 manualhistory => $manualhistory,
1345 internalnotes => $internalnotes,
1346 serialsadditems => $serialsadditems,
1347 staffdisplaycount => $staffdisplaycount,
1348 opacdisplaycount => $opacdisplaycount,
1349 graceperiod => $graceperiod,
1350 location => $location,
1351 enddate => $enddate,
1352 skip_serialseq => $skip_serialseq,
1353 itemtype => $itemtype,
1354 previousitemtype => $previousitemtype,
1355 mana_id => $mana_id,
1359 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1361 $subscription->discard_changes;
1362 return $subscription;
1365 =head2 NewSubscription
1367 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1368 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1369 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1370 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1371 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1372 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1373 $skip_serialseq, $itemtype, $previousitemtype);
1375 Create a new subscription with value given on input args.
1378 the id of this new subscription
1382 sub NewSubscription {
1384 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1385 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1386 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1387 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1388 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1389 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1390 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1392 my $dbh = C4::Context->dbh;
1394 my $subscription = Koha::Subscription->new(
1396 librarian => $auser,
1397 branchcode => $branchcode,
1398 aqbooksellerid => $aqbooksellerid,
1400 aqbudgetid => $aqbudgetid,
1401 biblionumber => $biblionumber,
1402 startdate => $startdate,
1403 periodicity => $periodicity,
1404 numberlength => $numberlength,
1405 weeklength => $weeklength,
1406 monthlength => $monthlength,
1407 lastvalue1 => $lastvalue1,
1408 innerloop1 => $innerloop1,
1409 lastvalue2 => $lastvalue2,
1410 innerloop2 => $innerloop2,
1411 lastvalue3 => $lastvalue3,
1412 innerloop3 => $innerloop3,
1416 firstacquidate => $firstacquidate,
1417 irregularity => $irregularity,
1418 numberpattern => $numberpattern,
1420 callnumber => $callnumber,
1421 manualhistory => $manualhistory,
1422 internalnotes => $internalnotes,
1423 serialsadditems => $serialsadditems,
1424 staffdisplaycount => $staffdisplaycount,
1425 opacdisplaycount => $opacdisplaycount,
1426 graceperiod => $graceperiod,
1427 location => $location,
1428 enddate => $enddate,
1429 skip_serialseq => $skip_serialseq,
1430 itemtype => $itemtype,
1431 previousitemtype => $previousitemtype,
1432 mana_id => $mana_id,
1435 $subscription->discard_changes;
1436 my $subscriptionid = $subscription->subscriptionid;
1437 my ( $query, $sth );
1439 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1443 WHERE subscriptionid=?
1445 $sth = $dbh->prepare($query);
1446 $sth->execute( $enddate, $subscriptionid );
1449 # then create the 1st expected number
1451 INSERT INTO subscriptionhistory
1452 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1453 VALUES (?,?,?, '', '')
1455 $sth = $dbh->prepare($query);
1456 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1458 # reread subscription to get a hash (for calculation of the 1st issue number)
1459 $subscription = GetSubscription($subscriptionid); # We should not do that
1460 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1462 # calculate issue number
1463 my $serialseq = GetSeq($subscription, $pattern) || q{};
1467 serialseq => $serialseq,
1468 serialseq_x => $subscription->{'lastvalue1'},
1469 serialseq_y => $subscription->{'lastvalue2'},
1470 serialseq_z => $subscription->{'lastvalue3'},
1471 subscriptionid => $subscriptionid,
1472 biblionumber => $biblionumber,
1474 planneddate => $firstacquidate,
1475 publisheddate => $firstacquidate,
1479 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1481 #set serial flag on biblio if not already set.
1482 my $biblio = Koha::Biblios->find( $biblionumber );
1483 if ( $biblio and !$biblio->serial ) {
1484 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1485 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1487 eval { $record->field($tag)->update( $subf => 1 ); };
1489 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1491 return $subscriptionid;
1494 =head2 GetSubscriptionLength
1496 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1498 This function calculates the subscription length.
1502 sub GetSubscriptionLength {
1503 my ($subtype, $length) = @_;
1505 return unless looks_like_number($length);
1509 $subtype eq 'issues' ? $length : 0,
1510 $subtype eq 'weeks' ? $length : 0,
1511 $subtype eq 'months' ? $length : 0,
1516 =head2 ReNewSubscription
1518 ReNewSubscription($params);
1520 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1522 this function renew a subscription with values given on input args.
1526 sub ReNewSubscription {
1527 my ( $params ) = @_;
1528 my $subscriptionid = $params->{subscriptionid};
1529 my $user = $params->{user};
1530 my $startdate = $params->{startdate};
1531 my $numberlength = $params->{numberlength};
1532 my $weeklength = $params->{weeklength};
1533 my $monthlength = $params->{monthlength};
1534 my $note = $params->{note};
1535 my $branchcode = $params->{branchcode};
1537 my $dbh = C4::Context->dbh;
1538 my $subscription = GetSubscription($subscriptionid);
1542 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1543 WHERE biblio.biblionumber=?
1545 my $sth = $dbh->prepare($query);
1546 $sth->execute( $subscription->{biblionumber} );
1547 my $biblio = $sth->fetchrow_hashref;
1549 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1550 require C4::Suggestions;
1551 C4::Suggestions::NewSuggestion(
1552 { 'suggestedby' => $user,
1553 'title' => $subscription->{bibliotitle},
1554 'author' => $biblio->{author},
1555 'publishercode' => $biblio->{publishercode},
1557 'biblionumber' => $subscription->{biblionumber},
1558 'branchcode' => $branchcode,
1563 $numberlength ||= 0; # Should not we raise an exception instead?
1566 # renew subscription
1569 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1570 WHERE subscriptionid=?
1572 $sth = $dbh->prepare($query);
1573 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1574 my $enddate = GetExpirationDate($subscriptionid);
1575 $debug && warn "enddate :$enddate";
1579 WHERE subscriptionid=?
1581 $sth = $dbh->prepare($query);
1582 $sth->execute( $enddate, $subscriptionid );
1584 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1590 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1592 Create a new issue stored on the database.
1593 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1594 returns the serial id
1599 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1600 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1601 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1603 return unless ($subscriptionid);
1605 my $schema = Koha::Database->new()->schema();
1607 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1609 my $serial = Koha::Serial->new(
1611 serialseq => $serialseq,
1612 serialseq_x => $subscription->lastvalue1(),
1613 serialseq_y => $subscription->lastvalue2(),
1614 serialseq_z => $subscription->lastvalue3(),
1615 subscriptionid => $subscriptionid,
1616 biblionumber => $biblionumber,
1618 planneddate => $planneddate,
1619 publisheddate => $publisheddate,
1620 publisheddatetext => $publisheddatetext,
1622 routingnotes => $routingnotes
1626 my $serialid = $serial->id();
1628 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1629 my $missinglist = $subscription_history->missinglist();
1630 my $recievedlist = $subscription_history->recievedlist();
1632 if ( $status == ARRIVED ) {
1633 ### TODO Add a feature that improves recognition and description.
1634 ### As such count (serialseq) i.e. : N18,2(N19),N20
1635 ### Would use substr and index But be careful to previous presence of ()
1636 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1638 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1639 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1642 $recievedlist =~ s/^; //;
1643 $missinglist =~ s/^; //;
1645 $subscription_history->recievedlist($recievedlist);
1646 $subscription_history->missinglist($missinglist);
1647 $subscription_history->store();
1652 =head2 HasSubscriptionStrictlyExpired
1654 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1656 the subscription has stricly expired when today > the end subscription date
1659 1 if true, 0 if false, -1 if the expiration date is not set.
1663 sub HasSubscriptionStrictlyExpired {
1665 # Getting end of subscription date
1666 my ($subscriptionid) = @_;
1668 return unless ($subscriptionid);
1670 my $dbh = C4::Context->dbh;
1671 my $subscription = GetSubscription($subscriptionid);
1672 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1674 # If the expiration date is set
1675 if ( $expirationdate != 0 ) {
1676 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1678 # Getting today's date
1679 my ( $nowyear, $nowmonth, $nowday ) = Today();
1681 # if today's date > expiration date, then the subscription has stricly expired
1682 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1689 # There are some cases where the expiration date is not set
1690 # As we can't determine if the subscription has expired on a date-basis,
1696 =head2 HasSubscriptionExpired
1698 $has_expired = HasSubscriptionExpired($subscriptionid)
1700 the subscription has expired when the next issue to arrive is out of subscription limit.
1703 0 if the subscription has not expired
1704 1 if the subscription has expired
1705 2 if has subscription does not have a valid expiration date set
1709 sub HasSubscriptionExpired {
1710 my ($subscriptionid) = @_;
1712 return unless ($subscriptionid);
1714 my $dbh = C4::Context->dbh;
1715 my $subscription = GetSubscription($subscriptionid);
1716 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1717 if ( $frequency and $frequency->{unit} ) {
1718 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1719 if (!defined $expirationdate) {
1720 $expirationdate = q{};
1723 SELECT max(planneddate)
1725 WHERE subscriptionid=?
1727 my $sth = $dbh->prepare($query);
1728 $sth->execute($subscriptionid);
1729 my ($res) = $sth->fetchrow;
1730 if (!$res || $res=~m/^0000/) {
1733 my @res = split( /-/, $res );
1734 my @endofsubscriptiondate = split( /-/, $expirationdate );
1735 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1737 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1742 if ( $subscription->{'numberlength'} ) {
1743 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1744 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1750 return 0; # Notice that you'll never get here.
1753 =head2 DelSubscription
1755 DelSubscription($subscriptionid)
1756 this function deletes subscription which has $subscriptionid as id.
1760 sub DelSubscription {
1761 my ($subscriptionid) = @_;
1762 my $dbh = C4::Context->dbh;
1763 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1765 Koha::AdditionalFieldValues->search({
1766 'field.tablename' => 'subscription',
1767 'me.record_id' => $subscriptionid,
1768 }, { join => 'field' })->delete;
1770 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1775 DelIssue($serialseq,$subscriptionid)
1776 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1778 returns the number of rows affected
1783 my ($dataissue) = @_;
1784 my $dbh = C4::Context->dbh;
1785 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1790 AND subscriptionid= ?
1792 my $mainsth = $dbh->prepare($query);
1793 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1795 #Delete element from subscription history
1796 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1797 my $sth = $dbh->prepare($query);
1798 $sth->execute( $dataissue->{'subscriptionid'} );
1799 my $val = $sth->fetchrow_hashref;
1800 unless ( $val->{manualhistory} ) {
1802 SELECT * FROM subscriptionhistory
1803 WHERE subscriptionid= ?
1805 my $sth = $dbh->prepare($query);
1806 $sth->execute( $dataissue->{'subscriptionid'} );
1807 my $data = $sth->fetchrow_hashref;
1808 my $serialseq = $dataissue->{'serialseq'};
1809 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1810 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1811 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1812 $sth = $dbh->prepare($strsth);
1813 $sth->execute( $dataissue->{'subscriptionid'} );
1816 return $mainsth->rows;
1819 =head2 GetLateOrMissingIssues
1821 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1823 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1826 the issuelist as an array of hash refs. Each element of this array contains
1827 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1831 sub GetLateOrMissingIssues {
1832 my ( $supplierid, $serialid, $order ) = @_;
1834 return unless ( $supplierid or $serialid );
1836 my $dbh = C4::Context->dbh;
1841 $byserial = "and serialid = " . $serialid;
1844 $order .= ", title";
1848 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1850 $sth = $dbh->prepare(
1852 serialid, aqbooksellerid, name,
1853 biblio.title, biblioitems.issn, planneddate, serialseq,
1854 serial.status, serial.subscriptionid, claimdate, claims_count,
1855 subscription.branchcode
1857 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1858 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1859 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1860 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1861 WHERE subscription.subscriptionid = serial.subscriptionid
1862 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1863 AND subscription.aqbooksellerid=$supplierid
1868 $sth = $dbh->prepare(
1870 serialid, aqbooksellerid, name,
1871 biblio.title, planneddate, serialseq,
1872 serial.status, serial.subscriptionid, claimdate, claims_count,
1873 subscription.branchcode
1875 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1876 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1877 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1878 WHERE subscription.subscriptionid = serial.subscriptionid
1879 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1884 $sth->execute( EXPECTED, LATE, CLAIMED );
1886 while ( my $line = $sth->fetchrow_hashref ) {
1888 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1889 $line->{planneddateISO} = $line->{planneddate};
1890 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1892 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1893 $line->{claimdateISO} = $line->{claimdate};
1894 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1896 $line->{"status".$line->{status}} = 1;
1898 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1899 $line->{additional_fields} = { map { $_->field->name => $_->value }
1900 $subscription_object->additional_field_values->as_list };
1902 push @issuelist, $line;
1909 &updateClaim($serialid)
1911 this function updates the time when a claim is issued for late/missing items
1913 called from claims.pl file
1918 my ($serialids) = @_;
1919 return unless $serialids;
1920 unless ( ref $serialids ) {
1921 $serialids = [ $serialids ];
1923 my $dbh = C4::Context->dbh;
1926 SET claimdate = NOW(),
1927 claims_count = claims_count + 1,
1929 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1930 {}, CLAIMED, @$serialids );
1933 =head2 check_routing
1935 $result = &check_routing($subscriptionid)
1937 this function checks to see if a serial has a routing list and returns the count of routingid
1938 used to show either an 'add' or 'edit' link
1943 my ($subscriptionid) = @_;
1945 return unless ($subscriptionid);
1947 my $dbh = C4::Context->dbh;
1948 my $sth = $dbh->prepare(
1949 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1950 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1951 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1954 $sth->execute($subscriptionid);
1955 my $line = $sth->fetchrow_hashref;
1956 my $result = $line->{'routingids'};
1960 =head2 addroutingmember
1962 addroutingmember($borrowernumber,$subscriptionid)
1964 this function takes a borrowernumber and subscriptionid and adds the member to the
1965 routing list for that serial subscription and gives them a rank on the list
1966 of either 1 or highest current rank + 1
1970 sub addroutingmember {
1971 my ( $borrowernumber, $subscriptionid ) = @_;
1973 return unless ($borrowernumber and $subscriptionid);
1976 my $dbh = C4::Context->dbh;
1977 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1978 $sth->execute($subscriptionid);
1979 while ( my $line = $sth->fetchrow_hashref ) {
1980 if ( $line->{'rank'} > 0 ) {
1981 $rank = $line->{'rank'} + 1;
1986 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1987 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1990 =head2 reorder_members
1992 reorder_members($subscriptionid,$routingid,$rank)
1994 this function is used to reorder the routing list
1996 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1997 - it gets all members on list puts their routingid's into an array
1998 - removes the one in the array that is $routingid
1999 - then reinjects $routingid at point indicated by $rank
2000 - then update the database with the routingids in the new order
2004 sub reorder_members {
2005 my ( $subscriptionid, $routingid, $rank ) = @_;
2006 my $dbh = C4::Context->dbh;
2007 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2008 $sth->execute($subscriptionid);
2010 while ( my $line = $sth->fetchrow_hashref ) {
2011 push( @result, $line->{'routingid'} );
2014 # To find the matching index
2016 my $key = -1; # to allow for 0 being a valid response
2017 for ( $i = 0 ; $i < @result ; $i++ ) {
2018 if ( $routingid == $result[$i] ) {
2019 $key = $i; # save the index
2024 # if index exists in array then move it to new position
2025 if ( $key > -1 && $rank > 0 ) {
2026 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2027 my $moving_item = splice( @result, $key, 1 );
2028 splice( @result, $new_rank, 0, $moving_item );
2030 for ( my $j = 0 ; $j < @result ; $j++ ) {
2031 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2037 =head2 delroutingmember
2039 delroutingmember($routingid,$subscriptionid)
2041 this function either deletes one member from routing list if $routingid exists otherwise
2042 deletes all members from the routing list
2046 sub delroutingmember {
2048 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2049 my ( $routingid, $subscriptionid ) = @_;
2050 my $dbh = C4::Context->dbh;
2052 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2053 $sth->execute($routingid);
2054 reorder_members( $subscriptionid, $routingid );
2056 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2057 $sth->execute($subscriptionid);
2062 =head2 getroutinglist
2064 @routinglist = getroutinglist($subscriptionid)
2066 this gets the info from the subscriptionroutinglist for $subscriptionid
2069 the routinglist as an array. Each element of the array contains a hash_ref containing
2070 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2074 sub getroutinglist {
2075 my ($subscriptionid) = @_;
2076 my $dbh = C4::Context->dbh;
2077 my $sth = $dbh->prepare(
2078 'SELECT routingid, borrowernumber, ranking, biblionumber
2080 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2081 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2083 $sth->execute($subscriptionid);
2084 my $routinglist = $sth->fetchall_arrayref({});
2085 return @{$routinglist};
2088 =head2 countissuesfrom
2090 $result = countissuesfrom($subscriptionid,$startdate)
2092 Returns a count of serial rows matching the given subsctiptionid
2093 with published date greater than startdate
2097 sub countissuesfrom {
2098 my ( $subscriptionid, $startdate ) = @_;
2099 my $dbh = C4::Context->dbh;
2103 WHERE subscriptionid=?
2104 AND serial.publisheddate>?
2106 my $sth = $dbh->prepare($query);
2107 $sth->execute( $subscriptionid, $startdate );
2108 my ($countreceived) = $sth->fetchrow;
2109 return $countreceived;
2114 $result = CountIssues($subscriptionid)
2116 Returns a count of serial rows matching the given subsctiptionid
2121 my ($subscriptionid) = @_;
2122 my $dbh = C4::Context->dbh;
2126 WHERE subscriptionid=?
2128 my $sth = $dbh->prepare($query);
2129 $sth->execute($subscriptionid);
2130 my ($countreceived) = $sth->fetchrow;
2131 return $countreceived;
2136 $result = HasItems($subscriptionid)
2138 returns a count of items from serial matching the subscriptionid
2143 my ($subscriptionid) = @_;
2144 my $dbh = C4::Context->dbh;
2146 SELECT COUNT(serialitems.itemnumber)
2148 LEFT JOIN serialitems USING(serialid)
2149 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2151 my $sth=$dbh->prepare($query);
2152 $sth->execute($subscriptionid);
2153 my ($countitems)=$sth->fetchrow_array();
2157 =head2 abouttoexpire
2159 $result = abouttoexpire($subscriptionid)
2161 this function alerts you to the penultimate issue for a serial subscription
2163 returns 1 - if this is the penultimate issue
2169 my ($subscriptionid) = @_;
2170 my $dbh = C4::Context->dbh;
2171 my $subscription = GetSubscription($subscriptionid);
2172 my $per = $subscription->{'periodicity'};
2173 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2174 if ($frequency and $frequency->{unit}){
2176 my $expirationdate = GetExpirationDate($subscriptionid);
2178 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2179 my $nextdate = GetNextDate($subscription, $res, $frequency);
2181 # only compare dates if both dates exist.
2182 if ($nextdate and $expirationdate) {
2183 if(Date::Calc::Delta_Days(
2184 split( /-/, $nextdate ),
2185 split( /-/, $expirationdate )
2191 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2192 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2198 =head2 GetFictiveIssueNumber
2200 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2202 Get the position of the issue published at $publisheddate, considering the
2203 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2204 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2205 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2206 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2207 depending on how many rows are in serial table.
2208 The issue number calculation is based on subscription frequency, first acquisition
2209 date, and $publisheddate.
2211 Returns undef when called for irregular frequencies.
2213 The routine is used to skip irregularities when calculating the next issue
2214 date (in GetNextDate) or the next issue number (in GetNextSeq).
2218 sub GetFictiveIssueNumber {
2219 my ($subscription, $publisheddate, $frequency) = @_;
2221 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2225 my ( $year, $month, $day ) = split /-/, $publisheddate;
2226 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2227 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2229 if( $frequency->{'unitsperissue'} == 1 ) {
2230 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2231 } else { # issuesperunit == 1
2232 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2238 my ( $date1, $date2, $unit ) = @_;
2239 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2241 if( $unit eq 'day' ) {
2242 return Delta_Days( @$date1, @$date2 );
2243 } elsif( $unit eq 'week' ) {
2244 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2247 # In case of months or years, this is a wrapper around N_Delta_YMD.
2248 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2249 # while we expect 1 month.
2250 my @delta = N_Delta_YMD( @$date1, @$date2 );
2251 if( $delta[2] > 27 ) {
2252 # Check if we could add a month
2253 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2254 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2258 if( $delta[1] >= 12 ) {
2262 # if unit is year, we only return full years
2263 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2266 sub _get_next_date_day {
2267 my ($subscription, $freqdata, $year, $month, $day) = @_;
2269 my @newissue; # ( yy, mm, dd )
2270 # We do not need $delta_days here, since it would be zero where used
2272 if( $freqdata->{issuesperunit} == 1 ) {
2274 @newissue = Add_Delta_Days(
2275 $year, $month, $day, $freqdata->{"unitsperissue"} );
2276 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2278 @newissue = ( $year, $month, $day );
2279 $subscription->{countissuesperunit}++;
2281 # We finished a cycle of issues within a unit.
2282 # No subtraction of zero needed, just add one day
2283 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2284 $subscription->{countissuesperunit} = 1;
2289 sub _get_next_date_week {
2290 my ($subscription, $freqdata, $year, $month, $day) = @_;
2292 my @newissue; # ( yy, mm, dd )
2293 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2295 if( $freqdata->{issuesperunit} == 1 ) {
2296 # Add full weeks (of 7 days)
2297 @newissue = Add_Delta_Days(
2298 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2299 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2300 # Add rounded number of days based on frequency.
2301 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2302 $subscription->{countissuesperunit}++;
2304 # We finished a cycle of issues within a unit.
2305 # Subtract delta * (issues - 1), add 1 week
2306 @newissue = Add_Delta_Days( $year, $month, $day,
2307 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2308 @newissue = Add_Delta_Days( @newissue, 7 );
2309 $subscription->{countissuesperunit} = 1;
2314 sub _get_next_date_month {
2315 my ($subscription, $freqdata, $year, $month, $day) = @_;
2317 my @newissue; # ( yy, mm, dd )
2318 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2320 if( $freqdata->{issuesperunit} == 1 ) {
2322 @newissue = Add_Delta_YM(
2323 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2324 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2325 # Add rounded number of days based on frequency.
2326 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2327 $subscription->{countissuesperunit}++;
2329 # We finished a cycle of issues within a unit.
2330 # Subtract delta * (issues - 1), add 1 month
2331 @newissue = Add_Delta_Days( $year, $month, $day,
2332 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2333 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2334 $subscription->{countissuesperunit} = 1;
2339 sub _get_next_date_year {
2340 my ($subscription, $freqdata, $year, $month, $day) = @_;
2342 my @newissue; # ( yy, mm, dd )
2343 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2345 if( $freqdata->{issuesperunit} == 1 ) {
2347 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
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 year
2355 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2356 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2357 $subscription->{countissuesperunit} = 1;
2364 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2366 this function it takes the publisheddate and will return the next issue's date
2367 and will skip dates if there exists an irregularity.
2368 $publisheddate has to be an ISO date
2369 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2370 $frequency is a hashref containing frequency informations
2371 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2372 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2373 skipped then the returned date will be 2007-05-10
2376 $resultdate - then next date in the sequence (ISO date)
2378 Return undef if subscription is irregular
2383 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2385 return unless $subscription and $publisheddate;
2388 if ($freqdata->{'unit'}) {
2389 my ( $year, $month, $day ) = split /-/, $publisheddate;
2391 # Process an irregularity Hash
2392 # Suppose that irregularities are stored in a string with this structure
2393 # irreg1;irreg2;irreg3
2394 # where irregX is the number of issue which will not be received
2395 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2397 if ( $subscription->{irregularity} ) {
2398 my @irreg = split /;/, $subscription->{'irregularity'} ;
2399 foreach my $irregularity (@irreg) {
2400 $irregularities{$irregularity} = 1;
2404 # Get the 'fictive' next issue number
2405 # It is used to check if next issue is an irregular issue.
2406 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2408 # Then get the next date
2409 my $unit = lc $freqdata->{'unit'};
2410 if ($unit eq 'day') {
2411 while ($irregularities{$issueno}) {
2412 ($year, $month, $day) = _get_next_date_day($subscription,
2413 $freqdata, $year, $month, $day);
2416 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2417 $year, $month, $day);
2419 elsif ($unit eq 'week') {
2420 while ($irregularities{$issueno}) {
2421 ($year, $month, $day) = _get_next_date_week($subscription,
2422 $freqdata, $year, $month, $day);
2425 ($year, $month, $day) = _get_next_date_week($subscription,
2426 $freqdata, $year, $month, $day);
2428 elsif ($unit eq 'month') {
2429 while ($irregularities{$issueno}) {
2430 ($year, $month, $day) = _get_next_date_month($subscription,
2431 $freqdata, $year, $month, $day);
2434 ($year, $month, $day) = _get_next_date_month($subscription,
2435 $freqdata, $year, $month, $day);
2437 elsif ($unit eq 'year') {
2438 while ($irregularities{$issueno}) {
2439 ($year, $month, $day) = _get_next_date_year($subscription,
2440 $freqdata, $year, $month, $day);
2443 ($year, $month, $day) = _get_next_date_year($subscription,
2444 $freqdata, $year, $month, $day);
2448 my $dbh = C4::Context->dbh;
2451 SET countissuesperunit = ?
2452 WHERE subscriptionid = ?
2454 my $sth = $dbh->prepare($query);
2455 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2458 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2464 $string = &_numeration($value,$num_type,$locale);
2466 _numeration returns the string corresponding to $value in the num_type
2478 my ($value, $num_type, $locale) = @_;
2483 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2484 # 1970-11-01 was a Sunday
2485 $value = $value % 7;
2486 my $dt = DateTime->new(
2492 $string = $num_type =~ /^dayname$/
2493 ? $dt->strftime("%A")
2494 : $dt->strftime("%a");
2495 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2496 $value = $value % 12;
2497 my $dt = DateTime->new(
2499 month => $value + 1,
2502 $string = $num_type =~ /^monthname$/
2503 ? $dt->strftime("%B")
2504 : $dt->strftime("%b");
2505 } elsif ( $num_type =~ /^season$/ ) {
2506 my @seasons= qw( Spring Summer Fall Winter );
2507 $value = $value % 4;
2508 $string = $seasons[$value];
2509 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2510 my @seasonsabrv= qw( Spr Sum Fal Win );
2511 $value = $value % 4;
2512 $string = $seasonsabrv[$value];
2520 =head2 CloseSubscription
2522 Close a subscription given a subscriptionid
2526 sub CloseSubscription {
2527 my ( $subscriptionid ) = @_;
2528 return unless $subscriptionid;
2529 my $dbh = C4::Context->dbh;
2530 my $sth = $dbh->prepare( q{
2533 WHERE subscriptionid = ?
2535 $sth->execute( $subscriptionid );
2537 # Set status = missing when status = stopped
2538 $sth = $dbh->prepare( q{
2541 WHERE subscriptionid = ?
2544 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2547 =head2 ReopenSubscription
2549 Reopen a subscription given a subscriptionid
2553 sub ReopenSubscription {
2554 my ( $subscriptionid ) = @_;
2555 return unless $subscriptionid;
2556 my $dbh = C4::Context->dbh;
2557 my $sth = $dbh->prepare( q{
2560 WHERE subscriptionid = ?
2562 $sth->execute( $subscriptionid );
2564 # Set status = expected when status = stopped
2565 $sth = $dbh->prepare( q{
2568 WHERE subscriptionid = ?
2571 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2574 =head2 subscriptionCurrentlyOnOrder
2576 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2578 Return 1 if subscription is currently on order else 0.
2582 sub subscriptionCurrentlyOnOrder {
2583 my ( $subscriptionid ) = @_;
2584 my $dbh = C4::Context->dbh;
2586 SELECT COUNT(*) FROM aqorders
2587 WHERE subscriptionid = ?
2588 AND datereceived IS NULL
2589 AND datecancellationprinted IS NULL
2591 my $sth = $dbh->prepare( $query );
2592 $sth->execute($subscriptionid);
2593 return $sth->fetchrow_array;
2596 =head2 can_claim_subscription
2598 $can = can_claim_subscription( $subscriptionid[, $userid] );
2600 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2604 sub can_claim_subscription {
2605 my ( $subscription, $userid ) = @_;
2606 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2609 =head2 can_edit_subscription
2611 $can = can_edit_subscription( $subscriptionid[, $userid] );
2613 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2617 sub can_edit_subscription {
2618 my ( $subscription, $userid ) = @_;
2619 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2622 =head2 can_show_subscription
2624 $can = can_show_subscription( $subscriptionid[, $userid] );
2626 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2630 sub can_show_subscription {
2631 my ( $subscription, $userid ) = @_;
2632 return _can_do_on_subscription( $subscription, $userid, '*' );
2635 sub _can_do_on_subscription {
2636 my ( $subscription, $userid, $permission ) = @_;
2637 return 0 unless C4::Context->userenv;
2638 my $flags = C4::Context->userenv->{flags};
2639 $userid ||= C4::Context->userenv->{'id'};
2641 if ( C4::Context->preference('IndependentBranches') ) {
2643 if C4::Context->IsSuperLibrarian()
2645 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2647 C4::Auth::haspermission( $userid,
2648 { serials => $permission } )
2649 and ( not defined $subscription->{branchcode}
2650 or $subscription->{branchcode} eq ''
2651 or $subscription->{branchcode} eq
2652 C4::Context->userenv->{'branch'} )
2657 if C4::Context->IsSuperLibrarian()
2659 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2660 or C4::Auth::haspermission(
2661 $userid, { serials => $permission }
2668 =head2 findSerialsByStatus
2670 @serials = findSerialsByStatus($status, $subscriptionid);
2672 Returns an array of serials matching a given status and subscription id.
2676 sub findSerialsByStatus {
2677 my ( $status, $subscriptionid ) = @_;
2678 my $dbh = C4::Context->dbh;
2679 my $query = q| SELECT * from serial
2681 AND subscriptionid = ?
2683 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2692 Koha Development Team <http://koha-community.org/>