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 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
328 for my $subscription ( @$subscriptions ) {
329 $subscription->{cannotedit} = $cannotedit;
331 return $subscriptions;
334 =head2 PrepareSerialsData
336 $array_ref = PrepareSerialsData($serialinfomation)
337 where serialinformation is a hashref array
341 sub PrepareSerialsData {
344 return unless ($lines);
350 my $aqbooksellername;
354 my $previousnote = "";
356 foreach my $subs (@{$lines}) {
357 for my $datefield ( qw(publisheddate planneddate) ) {
358 # handle 0000-00-00 dates
359 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
360 $subs->{$datefield} = undef;
363 $subs->{ "status" . $subs->{'status'} } = 1;
364 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
365 $subs->{"checked"} = 1;
368 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
369 $year = $subs->{'year'};
373 if ( $tmpresults{$year} ) {
374 push @{ $tmpresults{$year}->{'serials'} }, $subs;
376 $tmpresults{$year} = {
378 'aqbooksellername' => $subs->{'aqbooksellername'},
379 'bibliotitle' => $subs->{'bibliotitle'},
380 'serials' => [$subs],
385 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
386 push @res, $tmpresults{$key};
391 =head2 GetSubscriptionsFromBiblionumber
393 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
394 this function get the subscription list. it reads the subscription table.
396 reference to an array of subscriptions which have the biblionumber given on input arg.
397 each element of this array is a hashref containing
398 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
402 sub GetSubscriptionsFromBiblionumber {
403 my ($biblionumber) = @_;
405 return unless ($biblionumber);
407 my $dbh = C4::Context->dbh;
409 SELECT subscription.*,
411 subscriptionhistory.*,
412 aqbooksellers.name AS aqbooksellername,
413 biblio.title AS bibliotitle
415 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
416 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
417 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
418 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
419 WHERE subscription.biblionumber = ?
421 my $sth = $dbh->prepare($query);
422 $sth->execute($biblionumber);
424 while ( my $subs = $sth->fetchrow_hashref ) {
425 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
426 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
427 if ( defined $subs->{histenddate} ) {
428 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
430 $subs->{histenddate} = "";
432 $subs->{opacnote} //= "";
433 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
434 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
435 $subs->{ "status" . $subs->{'status'} } = 1;
437 if (not defined $subs->{enddate} ) {
438 $subs->{enddate} = '';
440 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
442 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
443 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
444 $subs->{cannotedit} = not can_edit_subscription( $subs );
450 =head2 GetFullSubscriptionsFromBiblionumber
452 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
453 this function reads the serial table.
457 sub GetFullSubscriptionsFromBiblionumber {
458 my ($biblionumber) = @_;
459 my $dbh = C4::Context->dbh;
461 SELECT serial.serialid,
464 serial.publisheddate,
465 serial.publisheddatetext,
467 serial.notes as notes,
468 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
469 biblio.title as bibliotitle,
470 subscription.branchcode AS branchcode,
471 subscription.subscriptionid AS subscriptionid
473 LEFT JOIN subscription ON
474 (serial.subscriptionid=subscription.subscriptionid)
475 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
476 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
477 WHERE subscription.biblionumber = ?
479 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
480 serial.subscriptionid
482 my $sth = $dbh->prepare($query);
483 $sth->execute($biblionumber);
484 my $subscriptions = $sth->fetchall_arrayref( {} );
485 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
486 for my $subscription ( @$subscriptions ) {
487 $subscription->{cannotedit} = $cannotedit;
489 return $subscriptions;
492 =head2 SearchSubscriptions
494 @results = SearchSubscriptions($args);
496 This function returns a list of hashrefs, one for each subscription
497 that meets the conditions specified by the $args hashref.
499 The valid search fields are:
513 The expiration_date search field is special; it specifies the maximum
514 subscription expiration date.
518 sub SearchSubscriptions {
521 my $additional_fields = $args->{additional_fields} // [];
522 my $matching_record_ids_for_additional_fields = [];
523 if ( @$additional_fields ) {
524 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
526 return () unless @subscriptions;
528 $matching_record_ids_for_additional_fields = [ map {
535 subscription.notes AS publicnotes,
536 subscriptionhistory.*,
538 biblio.notes AS biblionotes,
542 aqbooksellers.name AS vendorname,
545 LEFT JOIN subscriptionhistory USING(subscriptionid)
546 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
547 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
548 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
550 $query .= q| WHERE 1|;
553 if( $args->{biblionumber} ) {
554 push @where_strs, "biblio.biblionumber = ?";
555 push @where_args, $args->{biblionumber};
558 if( $args->{title} ){
559 my @words = split / /, $args->{title};
561 foreach my $word (@words) {
562 push @strs, "biblio.title LIKE ?";
563 push @args, "%$word%";
566 push @where_strs, '(' . join (' AND ', @strs) . ')';
567 push @where_args, @args;
571 push @where_strs, "biblioitems.issn LIKE ?";
572 push @where_args, "%$args->{issn}%";
575 push @where_strs, "biblioitems.ean LIKE ?";
576 push @where_args, "%$args->{ean}%";
578 if ( $args->{callnumber} ) {
579 push @where_strs, "subscription.callnumber LIKE ?";
580 push @where_args, "%$args->{callnumber}%";
582 if( $args->{publisher} ){
583 push @where_strs, "biblioitems.publishercode LIKE ?";
584 push @where_args, "%$args->{publisher}%";
586 if( $args->{bookseller} ){
587 push @where_strs, "aqbooksellers.name LIKE ?";
588 push @where_args, "%$args->{bookseller}%";
590 if( $args->{branch} ){
591 push @where_strs, "subscription.branchcode = ?";
592 push @where_args, "$args->{branch}";
594 if ( $args->{location} ) {
595 push @where_strs, "subscription.location = ?";
596 push @where_args, "$args->{location}";
598 if ( $args->{expiration_date} ) {
599 push @where_strs, "subscription.enddate <= ?";
600 push @where_args, "$args->{expiration_date}";
602 if( defined $args->{closed} ){
603 push @where_strs, "subscription.closed = ?";
604 push @where_args, "$args->{closed}";
608 $query .= ' AND ' . join(' AND ', @where_strs);
610 if ( @$additional_fields ) {
611 $query .= ' AND subscriptionid IN ('
612 . join( ', ', @$matching_record_ids_for_additional_fields )
616 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
618 my $dbh = C4::Context->dbh;
619 my $sth = $dbh->prepare($query);
620 $sth->execute(@where_args);
621 my $results = $sth->fetchall_arrayref( {} );
623 for my $subscription ( @$results ) {
624 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
625 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
627 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
628 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
629 $subscription_object->additional_field_values->as_list };
639 ($totalissues,@serials) = GetSerials($subscriptionid);
640 this function gets every serial not arrived for a given subscription
641 as well as the number of issues registered in the database (all types)
642 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
644 FIXME: We should return \@serials.
649 my ( $subscriptionid, $count ) = @_;
651 return unless $subscriptionid;
653 my $dbh = C4::Context->dbh;
655 # status = 2 is "arrived"
657 $count = 5 unless ($count);
659 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
660 my $query = "SELECT serialid,serialseq, status, publisheddate,
661 publisheddatetext, planneddate,notes, routingnotes
663 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
664 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
665 my $sth = $dbh->prepare($query);
666 $sth->execute($subscriptionid);
668 while ( my $line = $sth->fetchrow_hashref ) {
669 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
670 for my $datefield ( qw( planneddate publisheddate) ) {
671 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
672 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
674 $line->{$datefield} = q{};
677 push @serials, $line;
680 # OK, now add the last 5 issues arrives/missing
681 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
682 publisheddatetext, notes, routingnotes
684 WHERE subscriptionid = ?
685 AND status IN ( $statuses )
686 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
688 $sth = $dbh->prepare($query);
689 $sth->execute($subscriptionid);
690 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
692 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
693 for my $datefield ( qw( planneddate publisheddate) ) {
694 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
695 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
697 $line->{$datefield} = q{};
701 push @serials, $line;
704 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
705 $sth = $dbh->prepare($query);
706 $sth->execute($subscriptionid);
707 my ($totalissues) = $sth->fetchrow;
708 return ( $totalissues, @serials );
713 @serials = GetSerials2($subscriptionid,$statuses);
714 this function returns every serial waited for a given subscription
715 as well as the number of issues registered in the database (all types)
716 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
718 $statuses is an arrayref of statuses and is mandatory.
723 my ( $subscription, $statuses ) = @_;
725 return unless ($subscription and @$statuses);
727 my $dbh = C4::Context->dbh;
729 SELECT serialid,serialseq, status, planneddate, publisheddate,
730 publisheddatetext, notes, routingnotes
732 WHERE subscriptionid=?
734 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
736 ORDER BY publisheddate,serialid DESC
738 $debug and warn "GetSerials2 query: $query";
739 my $sth = $dbh->prepare($query);
740 $sth->execute( $subscription, @$statuses );
743 while ( my $line = $sth->fetchrow_hashref ) {
744 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
745 # Format dates for display
746 for my $datefield ( qw( planneddate publisheddate ) ) {
747 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
748 $line->{$datefield} = q{};
751 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
754 push @serials, $line;
759 =head2 GetLatestSerials
761 \@serials = GetLatestSerials($subscriptionid,$limit)
762 get the $limit's latest serials arrived or missing for a given subscription
764 a ref to an array which contains all of the latest serials stored into a hash.
768 sub GetLatestSerials {
769 my ( $subscriptionid, $limit ) = @_;
771 return unless ($subscriptionid and $limit);
773 my $dbh = C4::Context->dbh;
775 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
776 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
778 WHERE subscriptionid = ?
779 AND status IN ($statuses)
780 ORDER BY publisheddate DESC LIMIT 0,$limit
782 my $sth = $dbh->prepare($strsth);
783 $sth->execute($subscriptionid);
785 while ( my $line = $sth->fetchrow_hashref ) {
786 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
787 push @serials, $line;
793 =head2 GetPreviousSerialid
795 $serialid = GetPreviousSerialid($subscriptionid, $nth)
796 get the $nth's previous serial for the given subscriptionid
802 sub GetPreviousSerialid {
803 my ( $subscriptionid, $nth ) = @_;
805 my $dbh = C4::Context->dbh;
809 my $strsth = "SELECT serialid
811 WHERE subscriptionid = ?
813 ORDER BY serialid DESC LIMIT $nth,1
815 my $sth = $dbh->prepare($strsth);
816 $sth->execute($subscriptionid);
818 my $line = $sth->fetchrow_hashref;
819 $return = $line->{'serialid'} if ($line);
827 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
828 $newinnerloop1, $newinnerloop2, $newinnerloop3
829 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
831 $subscription is a hashref containing all the attributes of the table
833 $pattern is a hashref containing all the attributes of the table
834 'subscription_numberpatterns'.
835 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
836 $planneddate is a date string in iso format.
837 This function get the next issue for the subscription given on input arg
842 my ($subscription, $pattern, $frequency, $planneddate) = @_;
844 return unless ($subscription and $pattern);
846 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
847 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
850 if ($subscription->{'skip_serialseq'}) {
851 my @irreg = split /;/, $subscription->{'irregularity'};
853 my $irregularities = {};
854 $irregularities->{$_} = 1 foreach(@irreg);
855 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
856 while($irregularities->{$issueno}) {
863 my $numberingmethod = $pattern->{numberingmethod};
865 if ($numberingmethod) {
866 $calculated = $numberingmethod;
867 my $locale = $subscription->{locale};
868 $newlastvalue1 = $subscription->{lastvalue1} || 0;
869 $newlastvalue2 = $subscription->{lastvalue2} || 0;
870 $newlastvalue3 = $subscription->{lastvalue3} || 0;
871 $newinnerloop1 = $subscription->{innerloop1} || 0;
872 $newinnerloop2 = $subscription->{innerloop2} || 0;
873 $newinnerloop3 = $subscription->{innerloop3} || 0;
876 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
879 for(my $i = 0; $i < $count; $i++) {
881 # check if we have to increase the new value.
883 if ($newinnerloop1 >= $pattern->{every1}) {
885 $newlastvalue1 += $pattern->{add1};
887 # reset counter if needed.
888 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
891 # check if we have to increase the new value.
893 if ($newinnerloop2 >= $pattern->{every2}) {
895 $newlastvalue2 += $pattern->{add2};
897 # reset counter if needed.
898 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
901 # check if we have to increase the new value.
903 if ($newinnerloop3 >= $pattern->{every3}) {
905 $newlastvalue3 += $pattern->{add3};
907 # reset counter if needed.
908 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
912 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
913 $calculated =~ s/\{X\}/$newlastvalue1string/g;
916 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
917 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
920 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
921 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
926 $newlastvalue1, $newlastvalue2, $newlastvalue3,
927 $newinnerloop1, $newinnerloop2, $newinnerloop3);
932 $calculated = GetSeq($subscription, $pattern)
933 $subscription is a hashref containing all the attributes of the table 'subscription'
934 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
935 this function transforms {X},{Y},{Z} to 150,0,0 for example.
937 the sequence in string format
942 my ($subscription, $pattern) = @_;
944 return unless ($subscription and $pattern);
946 my $locale = $subscription->{locale};
948 my $calculated = $pattern->{numberingmethod};
950 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
951 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
952 $calculated =~ s/\{X\}/$newlastvalue1/g;
954 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
955 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
956 $calculated =~ s/\{Y\}/$newlastvalue2/g;
958 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
959 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
960 $calculated =~ s/\{Z\}/$newlastvalue3/g;
964 =head2 GetExpirationDate
966 $enddate = GetExpirationDate($subscriptionid, [$startdate])
968 this function return the next expiration date for a subscription given on input args.
975 sub GetExpirationDate {
976 my ( $subscriptionid, $startdate ) = @_;
978 return unless ($subscriptionid);
980 my $dbh = C4::Context->dbh;
981 my $subscription = GetSubscription($subscriptionid);
984 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
985 $enddate = $startdate || $subscription->{startdate};
986 my @date = split( /-/, $enddate );
988 return if ( scalar(@date) != 3 || not check_date(@date) );
990 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
991 if ( $frequency and $frequency->{unit} ) {
994 if ( my $length = $subscription->{numberlength} ) {
996 #calculate the date of the last issue.
997 for ( my $i = 1 ; $i <= $length ; $i++ ) {
998 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1000 } elsif ( $subscription->{monthlength} ) {
1001 if ( $$subscription{startdate} ) {
1002 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1003 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1005 } elsif ( $subscription->{weeklength} ) {
1006 if ( $$subscription{startdate} ) {
1007 my @date = split( /-/, $subscription->{startdate} );
1008 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1009 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1012 $enddate = $subscription->{enddate};
1016 return $subscription->{enddate};
1020 =head2 CountSubscriptionFromBiblionumber
1022 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1023 this returns a count of the subscriptions for a given biblionumber
1025 the number of subscriptions
1029 sub CountSubscriptionFromBiblionumber {
1030 my ($biblionumber) = @_;
1032 return unless ($biblionumber);
1034 my $dbh = C4::Context->dbh;
1035 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1036 my $sth = $dbh->prepare($query);
1037 $sth->execute($biblionumber);
1038 my $subscriptionsnumber = $sth->fetchrow;
1039 return $subscriptionsnumber;
1042 =head2 ModSubscriptionHistory
1044 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1046 this function modifies the history of a subscription. Put your new values on input arg.
1047 returns the number of rows affected
1051 sub ModSubscriptionHistory {
1052 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1054 return unless ($subscriptionid);
1056 my $dbh = C4::Context->dbh;
1057 my $query = "UPDATE subscriptionhistory
1058 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1059 WHERE subscriptionid=?
1061 my $sth = $dbh->prepare($query);
1062 $receivedlist =~ s/^; // if $receivedlist;
1063 $missinglist =~ s/^; // if $missinglist;
1064 $opacnote =~ s/^; // if $opacnote;
1065 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1069 =head2 ModSerialStatus
1071 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1072 $publisheddatetext, $status, $notes);
1074 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1075 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1079 sub ModSerialStatus {
1080 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1081 $status, $notes) = @_;
1083 return unless ($serialid);
1085 #It is a usual serial
1086 # 1st, get previous status :
1087 my $dbh = C4::Context->dbh;
1088 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1089 FROM serial, subscription
1090 WHERE serial.subscriptionid=subscription.subscriptionid
1092 my $sth = $dbh->prepare($query);
1093 $sth->execute($serialid);
1094 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1095 my $frequency = GetSubscriptionFrequency($periodicity);
1097 # change status & update subscriptionhistory
1099 if ( $status == DELETED ) {
1100 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1104 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1105 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1108 $sth = $dbh->prepare($query);
1109 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1110 $planneddate, $status, $notes, $routingnotes, $serialid );
1111 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1112 $sth = $dbh->prepare($query);
1113 $sth->execute($subscriptionid);
1114 my $val = $sth->fetchrow_hashref;
1115 unless ( $val->{manualhistory} ) {
1116 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1117 $sth = $dbh->prepare($query);
1118 $sth->execute($subscriptionid);
1119 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1121 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1122 $recievedlist .= "; $serialseq"
1123 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1126 # in case serial has been previously marked as missing
1127 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1128 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1131 $missinglist .= "; $serialseq"
1132 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1133 $missinglist .= "; not issued $serialseq"
1134 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1136 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1137 $sth = $dbh->prepare($query);
1138 $recievedlist =~ s/^; //;
1139 $missinglist =~ s/^; //;
1140 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1144 # create new expected entry if needed (ie : was "expected" and has changed)
1145 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1146 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1147 my $subscription = GetSubscription($subscriptionid);
1148 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1149 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1153 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1154 $newinnerloop1, $newinnerloop2, $newinnerloop3
1156 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1158 # next date (calculated from actual date & frequency parameters)
1159 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1160 my $nextpubdate = $nextpublisheddate;
1161 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1162 WHERE subscriptionid = ?";
1163 $sth = $dbh->prepare($query);
1164 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1165 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1166 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1167 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1168 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1169 require C4::Letters;
1170 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1177 =head2 GetNextExpected
1179 $nextexpected = GetNextExpected($subscriptionid)
1181 Get the planneddate for the current expected issue of the subscription.
1187 planneddate => ISO date
1192 sub GetNextExpected {
1193 my ($subscriptionid) = @_;
1195 my $dbh = C4::Context->dbh;
1199 WHERE subscriptionid = ?
1203 my $sth = $dbh->prepare($query);
1205 # Each subscription has only one 'expected' issue.
1206 $sth->execute( $subscriptionid, EXPECTED );
1207 my $nextissue = $sth->fetchrow_hashref;
1208 if ( !$nextissue ) {
1212 WHERE subscriptionid = ?
1213 ORDER BY publisheddate DESC
1216 $sth = $dbh->prepare($query);
1217 $sth->execute($subscriptionid);
1218 $nextissue = $sth->fetchrow_hashref;
1220 foreach(qw/planneddate publisheddate/) {
1221 if ( !defined $nextissue->{$_} ) {
1222 # or should this default to 1st Jan ???
1223 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1225 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1233 =head2 ModNextExpected
1235 ModNextExpected($subscriptionid,$date)
1237 Update the planneddate for the current expected issue of the subscription.
1238 This will modify all future prediction results.
1240 C<$date> is an ISO date.
1246 sub ModNextExpected {
1247 my ( $subscriptionid, $date ) = @_;
1248 my $dbh = C4::Context->dbh;
1250 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1251 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1253 # Each subscription has only one 'expected' issue.
1254 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1259 =head2 GetSubscriptionIrregularities
1263 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1264 get the list of irregularities for a subscription
1270 sub GetSubscriptionIrregularities {
1271 my $subscriptionid = shift;
1273 return unless $subscriptionid;
1275 my $dbh = C4::Context->dbh;
1279 WHERE subscriptionid = ?
1281 my $sth = $dbh->prepare($query);
1282 $sth->execute($subscriptionid);
1284 my ($result) = $sth->fetchrow_array;
1285 my @irreg = split /;/, $result;
1290 =head2 ModSubscription
1292 this function modifies a subscription. Put all new values on input args.
1293 returns the number of rows affected
1297 sub ModSubscription {
1299 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1300 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1301 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1302 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1303 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1304 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1305 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1306 $itemtype, $previousitemtype, $mana_id
1309 my $subscription = Koha::Subscriptions->find($subscriptionid);
1312 librarian => $auser,
1313 branchcode => $branchcode,
1314 aqbooksellerid => $aqbooksellerid,
1316 aqbudgetid => $aqbudgetid,
1317 biblionumber => $biblionumber,
1318 startdate => $startdate,
1319 periodicity => $periodicity,
1320 numberlength => $numberlength,
1321 weeklength => $weeklength,
1322 monthlength => $monthlength,
1323 lastvalue1 => $lastvalue1,
1324 innerloop1 => $innerloop1,
1325 lastvalue2 => $lastvalue2,
1326 innerloop2 => $innerloop2,
1327 lastvalue3 => $lastvalue3,
1328 innerloop3 => $innerloop3,
1332 firstacquidate => $firstacquidate,
1333 irregularity => $irregularity,
1334 numberpattern => $numberpattern,
1336 callnumber => $callnumber,
1337 manualhistory => $manualhistory,
1338 internalnotes => $internalnotes,
1339 serialsadditems => $serialsadditems,
1340 staffdisplaycount => $staffdisplaycount,
1341 opacdisplaycount => $opacdisplaycount,
1342 graceperiod => $graceperiod,
1343 location => $location,
1344 enddate => $enddate,
1345 skip_serialseq => $skip_serialseq,
1346 itemtype => $itemtype,
1347 previousitemtype => $previousitemtype,
1348 mana_id => $mana_id,
1352 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1354 $subscription->discard_changes;
1355 return $subscription;
1358 =head2 NewSubscription
1360 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1361 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1362 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1363 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1364 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1365 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1366 $skip_serialseq, $itemtype, $previousitemtype);
1368 Create a new subscription with value given on input args.
1371 the id of this new subscription
1375 sub NewSubscription {
1377 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1378 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1379 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1380 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1381 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1382 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1383 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1385 my $dbh = C4::Context->dbh;
1387 my $subscription = Koha::Subscription->new(
1389 librarian => $auser,
1390 branchcode => $branchcode,
1391 aqbooksellerid => $aqbooksellerid,
1393 aqbudgetid => $aqbudgetid,
1394 biblionumber => $biblionumber,
1395 startdate => $startdate,
1396 periodicity => $periodicity,
1397 numberlength => $numberlength,
1398 weeklength => $weeklength,
1399 monthlength => $monthlength,
1400 lastvalue1 => $lastvalue1,
1401 innerloop1 => $innerloop1,
1402 lastvalue2 => $lastvalue2,
1403 innerloop2 => $innerloop2,
1404 lastvalue3 => $lastvalue3,
1405 innerloop3 => $innerloop3,
1409 firstacquidate => $firstacquidate,
1410 irregularity => $irregularity,
1411 numberpattern => $numberpattern,
1413 callnumber => $callnumber,
1414 manualhistory => $manualhistory,
1415 internalnotes => $internalnotes,
1416 serialsadditems => $serialsadditems,
1417 staffdisplaycount => $staffdisplaycount,
1418 opacdisplaycount => $opacdisplaycount,
1419 graceperiod => $graceperiod,
1420 location => $location,
1421 enddate => $enddate,
1422 skip_serialseq => $skip_serialseq,
1423 itemtype => $itemtype,
1424 previousitemtype => $previousitemtype,
1425 mana_id => $mana_id,
1428 $subscription->discard_changes;
1429 my $subscriptionid = $subscription->subscriptionid;
1430 my ( $query, $sth );
1432 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1436 WHERE subscriptionid=?
1438 $sth = $dbh->prepare($query);
1439 $sth->execute( $enddate, $subscriptionid );
1442 # then create the 1st expected number
1444 INSERT INTO subscriptionhistory
1445 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1446 VALUES (?,?,?, '', '')
1448 $sth = $dbh->prepare($query);
1449 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1451 # reread subscription to get a hash (for calculation of the 1st issue number)
1452 $subscription = GetSubscription($subscriptionid); # We should not do that
1453 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1455 # calculate issue number
1456 my $serialseq = GetSeq($subscription, $pattern) || q{};
1460 serialseq => $serialseq,
1461 serialseq_x => $subscription->{'lastvalue1'},
1462 serialseq_y => $subscription->{'lastvalue2'},
1463 serialseq_z => $subscription->{'lastvalue3'},
1464 subscriptionid => $subscriptionid,
1465 biblionumber => $biblionumber,
1467 planneddate => $firstacquidate,
1468 publisheddate => $firstacquidate,
1472 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1474 #set serial flag on biblio if not already set.
1475 my $biblio = Koha::Biblios->find( $biblionumber );
1476 if ( $biblio and !$biblio->serial ) {
1477 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1478 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1480 eval { $record->field($tag)->update( $subf => 1 ); };
1482 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1484 return $subscriptionid;
1487 =head2 GetSubscriptionLength
1489 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1491 This function calculates the subscription length.
1495 sub GetSubscriptionLength {
1496 my ($subtype, $length) = @_;
1498 return unless looks_like_number($length);
1502 $subtype eq 'issues' ? $length : 0,
1503 $subtype eq 'weeks' ? $length : 0,
1504 $subtype eq 'months' ? $length : 0,
1509 =head2 ReNewSubscription
1511 ReNewSubscription($params);
1513 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1515 this function renew a subscription with values given on input args.
1519 sub ReNewSubscription {
1520 my ( $params ) = @_;
1521 my $subscriptionid = $params->{subscriptionid};
1522 my $user = $params->{user};
1523 my $startdate = $params->{startdate};
1524 my $numberlength = $params->{numberlength};
1525 my $weeklength = $params->{weeklength};
1526 my $monthlength = $params->{monthlength};
1527 my $note = $params->{note};
1528 my $branchcode = $params->{branchcode};
1530 my $dbh = C4::Context->dbh;
1531 my $subscription = GetSubscription($subscriptionid);
1535 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1536 WHERE biblio.biblionumber=?
1538 my $sth = $dbh->prepare($query);
1539 $sth->execute( $subscription->{biblionumber} );
1540 my $biblio = $sth->fetchrow_hashref;
1542 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1543 require C4::Suggestions;
1544 C4::Suggestions::NewSuggestion(
1545 { 'suggestedby' => $user,
1546 'title' => $subscription->{bibliotitle},
1547 'author' => $biblio->{author},
1548 'publishercode' => $biblio->{publishercode},
1550 'biblionumber' => $subscription->{biblionumber},
1551 'branchcode' => $branchcode,
1556 $numberlength ||= 0; # Should not we raise an exception instead?
1559 # renew subscription
1562 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1563 WHERE subscriptionid=?
1565 $sth = $dbh->prepare($query);
1566 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1567 my $enddate = GetExpirationDate($subscriptionid);
1568 $debug && warn "enddate :$enddate";
1572 WHERE subscriptionid=?
1574 $sth = $dbh->prepare($query);
1575 $sth->execute( $enddate, $subscriptionid );
1577 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1583 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1585 Create a new issue stored on the database.
1586 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1587 returns the serial id
1592 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1593 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1594 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1596 return unless ($subscriptionid);
1598 my $schema = Koha::Database->new()->schema();
1600 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1602 my $serial = Koha::Serial->new(
1604 serialseq => $serialseq,
1605 serialseq_x => $subscription->lastvalue1(),
1606 serialseq_y => $subscription->lastvalue2(),
1607 serialseq_z => $subscription->lastvalue3(),
1608 subscriptionid => $subscriptionid,
1609 biblionumber => $biblionumber,
1611 planneddate => $planneddate,
1612 publisheddate => $publisheddate,
1613 publisheddatetext => $publisheddatetext,
1615 routingnotes => $routingnotes
1619 my $serialid = $serial->id();
1621 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1622 my $missinglist = $subscription_history->missinglist();
1623 my $recievedlist = $subscription_history->recievedlist();
1625 if ( $status == ARRIVED ) {
1626 ### TODO Add a feature that improves recognition and description.
1627 ### As such count (serialseq) i.e. : N18,2(N19),N20
1628 ### Would use substr and index But be careful to previous presence of ()
1629 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1631 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1632 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1635 $recievedlist =~ s/^; //;
1636 $missinglist =~ s/^; //;
1638 $subscription_history->recievedlist($recievedlist);
1639 $subscription_history->missinglist($missinglist);
1640 $subscription_history->store();
1645 =head2 HasSubscriptionStrictlyExpired
1647 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1649 the subscription has stricly expired when today > the end subscription date
1652 1 if true, 0 if false, -1 if the expiration date is not set.
1656 sub HasSubscriptionStrictlyExpired {
1658 # Getting end of subscription date
1659 my ($subscriptionid) = @_;
1661 return unless ($subscriptionid);
1663 my $dbh = C4::Context->dbh;
1664 my $subscription = GetSubscription($subscriptionid);
1665 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1667 # If the expiration date is set
1668 if ( $expirationdate != 0 ) {
1669 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1671 # Getting today's date
1672 my ( $nowyear, $nowmonth, $nowday ) = Today();
1674 # if today's date > expiration date, then the subscription has stricly expired
1675 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1682 # There are some cases where the expiration date is not set
1683 # As we can't determine if the subscription has expired on a date-basis,
1689 =head2 HasSubscriptionExpired
1691 $has_expired = HasSubscriptionExpired($subscriptionid)
1693 the subscription has expired when the next issue to arrive is out of subscription limit.
1696 0 if the subscription has not expired
1697 1 if the subscription has expired
1698 2 if has subscription does not have a valid expiration date set
1702 sub HasSubscriptionExpired {
1703 my ($subscriptionid) = @_;
1705 return unless ($subscriptionid);
1707 my $dbh = C4::Context->dbh;
1708 my $subscription = GetSubscription($subscriptionid);
1709 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1710 if ( $frequency and $frequency->{unit} ) {
1711 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1712 if (!defined $expirationdate) {
1713 $expirationdate = q{};
1716 SELECT max(planneddate)
1718 WHERE subscriptionid=?
1720 my $sth = $dbh->prepare($query);
1721 $sth->execute($subscriptionid);
1722 my ($res) = $sth->fetchrow;
1723 if (!$res || $res=~m/^0000/) {
1726 my @res = split( /-/, $res );
1727 my @endofsubscriptiondate = split( /-/, $expirationdate );
1728 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1730 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1735 if ( $subscription->{'numberlength'} ) {
1736 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1737 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1743 return 0; # Notice that you'll never get here.
1746 =head2 DelSubscription
1748 DelSubscription($subscriptionid)
1749 this function deletes subscription which has $subscriptionid as id.
1753 sub DelSubscription {
1754 my ($subscriptionid) = @_;
1755 my $dbh = C4::Context->dbh;
1756 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1757 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1758 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1760 Koha::AdditionalFieldValues->search({
1761 'field.tablename' => 'subscription',
1762 'me.record_id' => $subscriptionid,
1763 }, { join => 'field' })->delete;
1765 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1770 DelIssue($serialseq,$subscriptionid)
1771 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1773 returns the number of rows affected
1778 my ($dataissue) = @_;
1779 my $dbh = C4::Context->dbh;
1780 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1785 AND subscriptionid= ?
1787 my $mainsth = $dbh->prepare($query);
1788 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1790 #Delete element from subscription history
1791 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1792 my $sth = $dbh->prepare($query);
1793 $sth->execute( $dataissue->{'subscriptionid'} );
1794 my $val = $sth->fetchrow_hashref;
1795 unless ( $val->{manualhistory} ) {
1797 SELECT * FROM subscriptionhistory
1798 WHERE subscriptionid= ?
1800 my $sth = $dbh->prepare($query);
1801 $sth->execute( $dataissue->{'subscriptionid'} );
1802 my $data = $sth->fetchrow_hashref;
1803 my $serialseq = $dataissue->{'serialseq'};
1804 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1805 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1806 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1807 $sth = $dbh->prepare($strsth);
1808 $sth->execute( $dataissue->{'subscriptionid'} );
1811 return $mainsth->rows;
1814 =head2 GetLateOrMissingIssues
1816 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1818 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1821 the issuelist as an array of hash refs. Each element of this array contains
1822 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1826 sub GetLateOrMissingIssues {
1827 my ( $supplierid, $serialid, $order ) = @_;
1829 return unless ( $supplierid or $serialid );
1831 my $dbh = C4::Context->dbh;
1836 $byserial = "and serialid = " . $serialid;
1839 $order .= ", title";
1843 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1845 $sth = $dbh->prepare(
1847 serialid, aqbooksellerid, name,
1848 biblio.title, biblioitems.issn, planneddate, serialseq,
1849 serial.status, serial.subscriptionid, claimdate, claims_count,
1850 subscription.branchcode
1852 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1853 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1854 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1855 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1856 WHERE subscription.subscriptionid = serial.subscriptionid
1857 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1858 AND subscription.aqbooksellerid=$supplierid
1863 $sth = $dbh->prepare(
1865 serialid, aqbooksellerid, name,
1866 biblio.title, planneddate, serialseq,
1867 serial.status, serial.subscriptionid, claimdate, claims_count,
1868 subscription.branchcode
1870 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1871 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1872 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1873 WHERE subscription.subscriptionid = serial.subscriptionid
1874 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1879 $sth->execute( EXPECTED, LATE, CLAIMED );
1881 while ( my $line = $sth->fetchrow_hashref ) {
1883 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1884 $line->{planneddateISO} = $line->{planneddate};
1885 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1887 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1888 $line->{claimdateISO} = $line->{claimdate};
1889 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1891 $line->{"status".$line->{status}} = 1;
1893 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1894 $line->{additional_fields} = { map { $_->field->name => $_->value }
1895 $subscription_object->additional_field_values->as_list };
1897 push @issuelist, $line;
1904 &updateClaim($serialid)
1906 this function updates the time when a claim is issued for late/missing items
1908 called from claims.pl file
1913 my ($serialids) = @_;
1914 return unless $serialids;
1915 unless ( ref $serialids ) {
1916 $serialids = [ $serialids ];
1918 my $dbh = C4::Context->dbh;
1921 SET claimdate = NOW(),
1922 claims_count = claims_count + 1,
1924 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1925 {}, CLAIMED, @$serialids );
1928 =head2 check_routing
1930 $result = &check_routing($subscriptionid)
1932 this function checks to see if a serial has a routing list and returns the count of routingid
1933 used to show either an 'add' or 'edit' link
1938 my ($subscriptionid) = @_;
1940 return unless ($subscriptionid);
1942 my $dbh = C4::Context->dbh;
1943 my $sth = $dbh->prepare(
1944 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1945 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1946 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1949 $sth->execute($subscriptionid);
1950 my $line = $sth->fetchrow_hashref;
1951 my $result = $line->{'routingids'};
1955 =head2 addroutingmember
1957 addroutingmember($borrowernumber,$subscriptionid)
1959 this function takes a borrowernumber and subscriptionid and adds the member to the
1960 routing list for that serial subscription and gives them a rank on the list
1961 of either 1 or highest current rank + 1
1965 sub addroutingmember {
1966 my ( $borrowernumber, $subscriptionid ) = @_;
1968 return unless ($borrowernumber and $subscriptionid);
1971 my $dbh = C4::Context->dbh;
1972 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1973 $sth->execute($subscriptionid);
1974 while ( my $line = $sth->fetchrow_hashref ) {
1975 if ( $line->{'rank'} > 0 ) {
1976 $rank = $line->{'rank'} + 1;
1981 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1982 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1985 =head2 reorder_members
1987 reorder_members($subscriptionid,$routingid,$rank)
1989 this function is used to reorder the routing list
1991 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1992 - it gets all members on list puts their routingid's into an array
1993 - removes the one in the array that is $routingid
1994 - then reinjects $routingid at point indicated by $rank
1995 - then update the database with the routingids in the new order
1999 sub reorder_members {
2000 my ( $subscriptionid, $routingid, $rank ) = @_;
2001 my $dbh = C4::Context->dbh;
2002 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2003 $sth->execute($subscriptionid);
2005 while ( my $line = $sth->fetchrow_hashref ) {
2006 push( @result, $line->{'routingid'} );
2009 # To find the matching index
2011 my $key = -1; # to allow for 0 being a valid response
2012 for ( $i = 0 ; $i < @result ; $i++ ) {
2013 if ( $routingid == $result[$i] ) {
2014 $key = $i; # save the index
2019 # if index exists in array then move it to new position
2020 if ( $key > -1 && $rank > 0 ) {
2021 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2022 my $moving_item = splice( @result, $key, 1 );
2023 splice( @result, $new_rank, 0, $moving_item );
2025 for ( my $j = 0 ; $j < @result ; $j++ ) {
2026 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2032 =head2 delroutingmember
2034 delroutingmember($routingid,$subscriptionid)
2036 this function either deletes one member from routing list if $routingid exists otherwise
2037 deletes all members from the routing list
2041 sub delroutingmember {
2043 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2044 my ( $routingid, $subscriptionid ) = @_;
2045 my $dbh = C4::Context->dbh;
2047 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2048 $sth->execute($routingid);
2049 reorder_members( $subscriptionid, $routingid );
2051 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2052 $sth->execute($subscriptionid);
2057 =head2 getroutinglist
2059 @routinglist = getroutinglist($subscriptionid)
2061 this gets the info from the subscriptionroutinglist for $subscriptionid
2064 the routinglist as an array. Each element of the array contains a hash_ref containing
2065 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2069 sub getroutinglist {
2070 my ($subscriptionid) = @_;
2071 my $dbh = C4::Context->dbh;
2072 my $sth = $dbh->prepare(
2073 'SELECT routingid, borrowernumber, ranking, biblionumber
2075 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2076 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2078 $sth->execute($subscriptionid);
2079 my $routinglist = $sth->fetchall_arrayref({});
2080 return @{$routinglist};
2083 =head2 countissuesfrom
2085 $result = countissuesfrom($subscriptionid,$startdate)
2087 Returns a count of serial rows matching the given subsctiptionid
2088 with published date greater than startdate
2092 sub countissuesfrom {
2093 my ( $subscriptionid, $startdate ) = @_;
2094 my $dbh = C4::Context->dbh;
2098 WHERE subscriptionid=?
2099 AND serial.publisheddate>?
2101 my $sth = $dbh->prepare($query);
2102 $sth->execute( $subscriptionid, $startdate );
2103 my ($countreceived) = $sth->fetchrow;
2104 return $countreceived;
2109 $result = CountIssues($subscriptionid)
2111 Returns a count of serial rows matching the given subsctiptionid
2116 my ($subscriptionid) = @_;
2117 my $dbh = C4::Context->dbh;
2121 WHERE subscriptionid=?
2123 my $sth = $dbh->prepare($query);
2124 $sth->execute($subscriptionid);
2125 my ($countreceived) = $sth->fetchrow;
2126 return $countreceived;
2131 $result = HasItems($subscriptionid)
2133 returns a count of items from serial matching the subscriptionid
2138 my ($subscriptionid) = @_;
2139 my $dbh = C4::Context->dbh;
2141 SELECT COUNT(serialitems.itemnumber)
2143 LEFT JOIN serialitems USING(serialid)
2144 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2146 my $sth=$dbh->prepare($query);
2147 $sth->execute($subscriptionid);
2148 my ($countitems)=$sth->fetchrow_array();
2152 =head2 abouttoexpire
2154 $result = abouttoexpire($subscriptionid)
2156 this function alerts you to the penultimate issue for a serial subscription
2158 returns 1 - if this is the penultimate issue
2164 my ($subscriptionid) = @_;
2165 my $dbh = C4::Context->dbh;
2166 my $subscription = GetSubscription($subscriptionid);
2167 my $per = $subscription->{'periodicity'};
2168 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2169 if ($frequency and $frequency->{unit}){
2171 my $expirationdate = GetExpirationDate($subscriptionid);
2173 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2174 my $nextdate = GetNextDate($subscription, $res, $frequency);
2176 # only compare dates if both dates exist.
2177 if ($nextdate and $expirationdate) {
2178 if(Date::Calc::Delta_Days(
2179 split( /-/, $nextdate ),
2180 split( /-/, $expirationdate )
2186 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2187 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2193 =head2 GetFictiveIssueNumber
2195 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2197 Get the position of the issue published at $publisheddate, considering the
2198 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2199 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2200 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2201 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2202 depending on how many rows are in serial table.
2203 The issue number calculation is based on subscription frequency, first acquisition
2204 date, and $publisheddate.
2206 Returns undef when called for irregular frequencies.
2208 The routine is used to skip irregularities when calculating the next issue
2209 date (in GetNextDate) or the next issue number (in GetNextSeq).
2213 sub GetFictiveIssueNumber {
2214 my ($subscription, $publisheddate, $frequency) = @_;
2216 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2220 my ( $year, $month, $day ) = split /-/, $publisheddate;
2221 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2222 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2224 if( $frequency->{'unitsperissue'} == 1 ) {
2225 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2226 } else { # issuesperunit == 1
2227 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2233 my ( $date1, $date2, $unit ) = @_;
2234 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2236 if( $unit eq 'day' ) {
2237 return Delta_Days( @$date1, @$date2 );
2238 } elsif( $unit eq 'week' ) {
2239 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2242 # In case of months or years, this is a wrapper around N_Delta_YMD.
2243 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2244 # while we expect 1 month.
2245 my @delta = N_Delta_YMD( @$date1, @$date2 );
2246 if( $delta[2] > 27 ) {
2247 # Check if we could add a month
2248 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2249 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2253 if( $delta[1] >= 12 ) {
2257 # if unit is year, we only return full years
2258 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2261 sub _get_next_date_day {
2262 my ($subscription, $freqdata, $year, $month, $day) = @_;
2264 my @newissue; # ( yy, mm, dd )
2265 # We do not need $delta_days here, since it would be zero where used
2267 if( $freqdata->{issuesperunit} == 1 ) {
2269 @newissue = Add_Delta_Days(
2270 $year, $month, $day, $freqdata->{"unitsperissue"} );
2271 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2273 @newissue = ( $year, $month, $day );
2274 $subscription->{countissuesperunit}++;
2276 # We finished a cycle of issues within a unit.
2277 # No subtraction of zero needed, just add one day
2278 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2279 $subscription->{countissuesperunit} = 1;
2284 sub _get_next_date_week {
2285 my ($subscription, $freqdata, $year, $month, $day) = @_;
2287 my @newissue; # ( yy, mm, dd )
2288 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2290 if( $freqdata->{issuesperunit} == 1 ) {
2291 # Add full weeks (of 7 days)
2292 @newissue = Add_Delta_Days(
2293 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2294 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2295 # Add rounded number of days based on frequency.
2296 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2297 $subscription->{countissuesperunit}++;
2299 # We finished a cycle of issues within a unit.
2300 # Subtract delta * (issues - 1), add 1 week
2301 @newissue = Add_Delta_Days( $year, $month, $day,
2302 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2303 @newissue = Add_Delta_Days( @newissue, 7 );
2304 $subscription->{countissuesperunit} = 1;
2309 sub _get_next_date_month {
2310 my ($subscription, $freqdata, $year, $month, $day) = @_;
2312 my @newissue; # ( yy, mm, dd )
2313 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2315 if( $freqdata->{issuesperunit} == 1 ) {
2317 @newissue = Add_Delta_YM(
2318 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2319 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2320 # Add rounded number of days based on frequency.
2321 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2322 $subscription->{countissuesperunit}++;
2324 # We finished a cycle of issues within a unit.
2325 # Subtract delta * (issues - 1), add 1 month
2326 @newissue = Add_Delta_Days( $year, $month, $day,
2327 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2328 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2329 $subscription->{countissuesperunit} = 1;
2334 sub _get_next_date_year {
2335 my ($subscription, $freqdata, $year, $month, $day) = @_;
2337 my @newissue; # ( yy, mm, dd )
2338 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2340 if( $freqdata->{issuesperunit} == 1 ) {
2342 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2343 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2344 # Add rounded number of days based on frequency.
2345 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2346 $subscription->{countissuesperunit}++;
2348 # We finished a cycle of issues within a unit.
2349 # Subtract delta * (issues - 1), add 1 year
2350 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2351 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2352 $subscription->{countissuesperunit} = 1;
2359 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2361 this function it takes the publisheddate and will return the next issue's date
2362 and will skip dates if there exists an irregularity.
2363 $publisheddate has to be an ISO date
2364 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2365 $frequency is a hashref containing frequency informations
2366 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2367 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2368 skipped then the returned date will be 2007-05-10
2371 $resultdate - then next date in the sequence (ISO date)
2373 Return undef if subscription is irregular
2378 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2380 return unless $subscription and $publisheddate;
2383 if ($freqdata->{'unit'}) {
2384 my ( $year, $month, $day ) = split /-/, $publisheddate;
2386 # Process an irregularity Hash
2387 # Suppose that irregularities are stored in a string with this structure
2388 # irreg1;irreg2;irreg3
2389 # where irregX is the number of issue which will not be received
2390 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2392 if ( $subscription->{irregularity} ) {
2393 my @irreg = split /;/, $subscription->{'irregularity'} ;
2394 foreach my $irregularity (@irreg) {
2395 $irregularities{$irregularity} = 1;
2399 # Get the 'fictive' next issue number
2400 # It is used to check if next issue is an irregular issue.
2401 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2403 # Then get the next date
2404 my $unit = lc $freqdata->{'unit'};
2405 if ($unit eq 'day') {
2406 while ($irregularities{$issueno}) {
2407 ($year, $month, $day) = _get_next_date_day($subscription,
2408 $freqdata, $year, $month, $day);
2411 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2412 $year, $month, $day);
2414 elsif ($unit eq 'week') {
2415 while ($irregularities{$issueno}) {
2416 ($year, $month, $day) = _get_next_date_week($subscription,
2417 $freqdata, $year, $month, $day);
2420 ($year, $month, $day) = _get_next_date_week($subscription,
2421 $freqdata, $year, $month, $day);
2423 elsif ($unit eq 'month') {
2424 while ($irregularities{$issueno}) {
2425 ($year, $month, $day) = _get_next_date_month($subscription,
2426 $freqdata, $year, $month, $day);
2429 ($year, $month, $day) = _get_next_date_month($subscription,
2430 $freqdata, $year, $month, $day);
2432 elsif ($unit eq 'year') {
2433 while ($irregularities{$issueno}) {
2434 ($year, $month, $day) = _get_next_date_year($subscription,
2435 $freqdata, $year, $month, $day);
2438 ($year, $month, $day) = _get_next_date_year($subscription,
2439 $freqdata, $year, $month, $day);
2443 my $dbh = C4::Context->dbh;
2446 SET countissuesperunit = ?
2447 WHERE subscriptionid = ?
2449 my $sth = $dbh->prepare($query);
2450 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2453 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2459 $string = &_numeration($value,$num_type,$locale);
2461 _numeration returns the string corresponding to $value in the num_type
2473 my ($value, $num_type, $locale) = @_;
2478 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2479 # 1970-11-01 was a Sunday
2480 $value = $value % 7;
2481 my $dt = DateTime->new(
2487 $string = $num_type =~ /^dayname$/
2488 ? $dt->strftime("%A")
2489 : $dt->strftime("%a");
2490 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2491 $value = $value % 12;
2492 my $dt = DateTime->new(
2494 month => $value + 1,
2497 $string = $num_type =~ /^monthname$/
2498 ? $dt->strftime("%B")
2499 : $dt->strftime("%b");
2500 } elsif ( $num_type =~ /^season$/ ) {
2501 my @seasons= qw( Spring Summer Fall Winter );
2502 $value = $value % 4;
2503 $string = $seasons[$value];
2504 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2505 my @seasonsabrv= qw( Spr Sum Fal Win );
2506 $value = $value % 4;
2507 $string = $seasonsabrv[$value];
2515 =head2 CloseSubscription
2517 Close a subscription given a subscriptionid
2521 sub CloseSubscription {
2522 my ( $subscriptionid ) = @_;
2523 return unless $subscriptionid;
2524 my $dbh = C4::Context->dbh;
2525 my $sth = $dbh->prepare( q{
2528 WHERE subscriptionid = ?
2530 $sth->execute( $subscriptionid );
2532 # Set status = missing when status = stopped
2533 $sth = $dbh->prepare( q{
2536 WHERE subscriptionid = ?
2539 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2542 =head2 ReopenSubscription
2544 Reopen a subscription given a subscriptionid
2548 sub ReopenSubscription {
2549 my ( $subscriptionid ) = @_;
2550 return unless $subscriptionid;
2551 my $dbh = C4::Context->dbh;
2552 my $sth = $dbh->prepare( q{
2555 WHERE subscriptionid = ?
2557 $sth->execute( $subscriptionid );
2559 # Set status = expected when status = stopped
2560 $sth = $dbh->prepare( q{
2563 WHERE subscriptionid = ?
2566 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2569 =head2 subscriptionCurrentlyOnOrder
2571 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2573 Return 1 if subscription is currently on order else 0.
2577 sub subscriptionCurrentlyOnOrder {
2578 my ( $subscriptionid ) = @_;
2579 my $dbh = C4::Context->dbh;
2581 SELECT COUNT(*) FROM aqorders
2582 WHERE subscriptionid = ?
2583 AND datereceived IS NULL
2584 AND datecancellationprinted IS NULL
2586 my $sth = $dbh->prepare( $query );
2587 $sth->execute($subscriptionid);
2588 return $sth->fetchrow_array;
2591 =head2 can_claim_subscription
2593 $can = can_claim_subscription( $subscriptionid[, $userid] );
2595 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2599 sub can_claim_subscription {
2600 my ( $subscription, $userid ) = @_;
2601 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2604 =head2 can_edit_subscription
2606 $can = can_edit_subscription( $subscriptionid[, $userid] );
2608 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2612 sub can_edit_subscription {
2613 my ( $subscription, $userid ) = @_;
2614 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2617 =head2 can_show_subscription
2619 $can = can_show_subscription( $subscriptionid[, $userid] );
2621 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2625 sub can_show_subscription {
2626 my ( $subscription, $userid ) = @_;
2627 return _can_do_on_subscription( $subscription, $userid, '*' );
2630 sub _can_do_on_subscription {
2631 my ( $subscription, $userid, $permission ) = @_;
2632 return 0 unless C4::Context->userenv;
2633 my $flags = C4::Context->userenv->{flags};
2634 $userid ||= C4::Context->userenv->{'id'};
2636 if ( C4::Context->preference('IndependentBranches') ) {
2638 if C4::Context->IsSuperLibrarian()
2640 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2642 C4::Auth::haspermission( $userid,
2643 { serials => $permission } )
2644 and ( not defined $subscription->{branchcode}
2645 or $subscription->{branchcode} eq ''
2646 or $subscription->{branchcode} eq
2647 C4::Context->userenv->{'branch'} )
2652 if C4::Context->IsSuperLibrarian()
2654 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2655 or C4::Auth::haspermission(
2656 $userid, { serials => $permission }
2663 =head2 findSerialsByStatus
2665 @serials = findSerialsByStatus($status, $subscriptionid);
2667 Returns an array of serials matching a given status and subscription id.
2671 sub findSerialsByStatus {
2672 my ( $status, $subscriptionid ) = @_;
2673 my $dbh = C4::Context->dbh;
2674 my $query = q| SELECT * from serial
2676 AND subscriptionid = ?
2678 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2687 Koha Development Team <http://koha-community.org/>