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
30 use C4::Serials::Frequency;
31 use C4::Serials::Numberpattern;
32 use Koha::AdditionalFieldValues;
35 use Koha::Subscriptions;
36 use Koha::Subscription::Histories;
37 use Koha::SharedContent;
38 use Scalar::Util qw( looks_like_number );
40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 MISSING_NEVER_RECIEVED => 41,
49 MISSING_SOLD_OUT => 42,
50 MISSING_DAMAGED => 43,
58 use constant MISSING_STATUSES => (
59 MISSING, MISSING_NEVER_RECIEVED,
60 MISSING_SOLD_OUT, MISSING_DAMAGED,
68 &NewSubscription &ModSubscription &DelSubscription
69 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
71 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
72 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
73 &GetSubscriptionHistoryFromSubscriptionId
75 &GetNextSeq &GetSeq &NewIssue &GetSerials
76 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
77 &GetSubscriptionLength &ReNewSubscription &GetLateOrMissingIssues
78 &GetSerialInformation &AddItem2Serial
79 &PrepareSerialsData &GetNextExpected &ModNextExpected
82 &GetSuppliersWithLateIssues
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &subscriptionCurrentlyOnOrder
95 C4::Serials - Serials Module Functions
103 Functions for handling subscriptions, claims routing etc.
108 =head2 GetSuppliersWithLateIssues
110 $supplierlist = GetSuppliersWithLateIssues()
112 this function get all suppliers with late issues.
115 an array_ref of suppliers each entry is a hash_ref containing id and name
116 the array is in name order
120 sub GetSuppliersWithLateIssues {
121 my $dbh = C4::Context->dbh;
122 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
124 SELECT DISTINCT id, name
126 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
127 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 (planneddate < now() AND serial.status=1)
131 OR serial.STATUS IN ( $statuses )
133 AND subscription.closed = 0
135 return $dbh->selectall_arrayref($query, { Slice => {} });
138 =head2 GetSubscriptionHistoryFromSubscriptionId
140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
142 This function returns the subscription history as a hashref
146 sub GetSubscriptionHistoryFromSubscriptionId {
147 my ($subscriptionid) = @_;
149 return unless $subscriptionid;
151 my $dbh = C4::Context->dbh;
154 FROM subscriptionhistory
155 WHERE subscriptionid = ?
157 my $sth = $dbh->prepare($query);
158 $sth->execute($subscriptionid);
159 my $results = $sth->fetchrow_hashref;
165 =head2 GetSerialInformation
167 $data = GetSerialInformation($serialid);
168 returns a hash_ref containing :
169 items : items marcrecord (can be an array)
171 subscription table field
172 + information about subscription expiration
176 sub GetSerialInformation {
178 my $dbh = C4::Context->dbh;
180 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
181 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
184 my $rq = $dbh->prepare($query);
185 $rq->execute($serialid);
186 my $data = $rq->fetchrow_hashref;
188 # create item information if we have serialsadditems for this subscription
189 if ( $data->{'serialsadditems'} ) {
190 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
191 $queryitem->execute($serialid);
192 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
194 if ( scalar(@$itemnumbers) > 0 ) {
195 foreach my $itemnum (@$itemnumbers) {
197 #It is ASSUMED that GetMarcItem ALWAYS WORK...
198 #Maybe GetMarcItem should return values on failure
199 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
200 $itemprocessed->{'itemnumber'} = $itemnum->[0];
201 $itemprocessed->{'itemid'} = $itemnum->[0];
202 $itemprocessed->{'serialid'} = $serialid;
203 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
204 push @{ $data->{'items'} }, $itemprocessed;
207 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
208 $itemprocessed->{'itemid'} = "N$serialid";
209 $itemprocessed->{'serialid'} = $serialid;
210 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
211 $itemprocessed->{'countitems'} = 0;
212 push @{ $data->{'items'} }, $itemprocessed;
215 $data->{ "status" . $data->{'serstatus'} } = 1;
216 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
217 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
218 $data->{cannotedit} = not can_edit_subscription( $data );
222 =head2 AddItem2Serial
224 $rows = AddItem2Serial($serialid,$itemnumber);
225 Adds an itemnumber to Serial record
226 returns the number of rows affected
231 my ( $serialid, $itemnumber ) = @_;
233 return unless ($serialid and $itemnumber);
235 my $dbh = C4::Context->dbh;
236 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
237 $rq->execute( $serialid, $itemnumber );
241 =head2 GetSubscription
243 $subs = GetSubscription($subscriptionid)
244 this function returns the subscription which has $subscriptionid as id.
246 a hashref. This hash contains
247 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
251 sub GetSubscription {
252 my ($subscriptionid) = @_;
253 my $dbh = C4::Context->dbh;
255 SELECT subscription.*,
256 subscriptionhistory.*,
257 aqbooksellers.name AS aqbooksellername,
258 biblio.title AS bibliotitle,
259 subscription.biblionumber as bibnum
261 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
262 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
263 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
264 WHERE subscription.subscriptionid = ?
267 my $sth = $dbh->prepare($query);
268 $sth->execute($subscriptionid);
269 my $subscription = $sth->fetchrow_hashref;
271 return unless $subscription;
273 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
275 if ( my $mana_id = $subscription->{mana_id} ) {
276 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
277 'subscription', $mana_id, {usecomments => 1});
278 $subscription->{comments} = $mana_subscription->{data}->{comments};
281 return $subscription;
284 =head2 GetFullSubscription
286 $array_ref = GetFullSubscription($subscriptionid)
287 this function reads the serial table.
291 sub GetFullSubscription {
292 my ($subscriptionid) = @_;
294 return unless ($subscriptionid);
296 my $dbh = C4::Context->dbh;
298 SELECT serial.serialid,
301 serial.publisheddate,
302 serial.publisheddatetext,
304 serial.notes as notes,
305 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
306 aqbooksellers.name as aqbooksellername,
307 biblio.title as bibliotitle,
308 subscription.branchcode AS branchcode,
309 subscription.subscriptionid AS subscriptionid
311 LEFT JOIN subscription ON
312 (serial.subscriptionid=subscription.subscriptionid )
313 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
314 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
315 WHERE serial.subscriptionid = ?
317 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
318 serial.subscriptionid
320 my $sth = $dbh->prepare($query);
321 $sth->execute($subscriptionid);
322 my $subscriptions = $sth->fetchall_arrayref( {} );
323 if (scalar @$subscriptions) {
324 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
325 for my $subscription ( @$subscriptions ) {
326 $subscription->{cannotedit} = $cannotedit;
330 return $subscriptions;
333 =head2 PrepareSerialsData
335 $array_ref = PrepareSerialsData($serialinfomation)
336 where serialinformation is a hashref array
340 sub PrepareSerialsData {
343 return unless ($lines);
350 my $previousnote = "";
352 foreach my $subs (@{$lines}) {
353 $subs->{ "status" . $subs->{'status'} } = 1;
354 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
355 $subs->{"checked"} = 1;
358 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
359 $year = $subs->{'year'};
363 if ( $tmpresults{$year} ) {
364 push @{ $tmpresults{$year}->{'serials'} }, $subs;
366 $tmpresults{$year} = {
368 'aqbooksellername' => $subs->{'aqbooksellername'},
369 'bibliotitle' => $subs->{'bibliotitle'},
370 'serials' => [$subs],
375 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
376 push @res, $tmpresults{$key};
381 =head2 GetSubscriptionsFromBiblionumber
383 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
384 this function get the subscription list. it reads the subscription table.
386 reference to an array of subscriptions which have the biblionumber given on input arg.
387 each element of this array is a hashref containing
388 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
392 sub GetSubscriptionsFromBiblionumber {
393 my ($biblionumber) = @_;
395 return unless ($biblionumber);
397 my $dbh = C4::Context->dbh;
399 SELECT subscription.*,
401 subscriptionhistory.*,
402 aqbooksellers.name AS aqbooksellername,
403 biblio.title AS bibliotitle
405 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
406 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
407 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
408 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
409 WHERE subscription.biblionumber = ?
411 my $sth = $dbh->prepare($query);
412 $sth->execute($biblionumber);
414 while ( my $subs = $sth->fetchrow_hashref ) {
415 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
416 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
417 if ( defined $subs->{histenddate} ) {
418 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
420 $subs->{histenddate} = "";
422 $subs->{opacnote} //= "";
423 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
424 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
425 $subs->{ "status" . $subs->{'status'} } = 1;
427 if (not defined $subs->{enddate} ) {
428 $subs->{enddate} = '';
430 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
432 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
433 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
434 $subs->{cannotedit} = not can_edit_subscription( $subs );
440 =head2 GetFullSubscriptionsFromBiblionumber
442 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
443 this function reads the serial table.
447 sub GetFullSubscriptionsFromBiblionumber {
448 my ($biblionumber) = @_;
449 my $dbh = C4::Context->dbh;
451 SELECT serial.serialid,
454 serial.publisheddate,
455 serial.publisheddatetext,
457 serial.notes as notes,
458 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
459 biblio.title as bibliotitle,
460 subscription.branchcode AS branchcode,
461 subscription.subscriptionid AS subscriptionid
463 LEFT JOIN subscription ON
464 (serial.subscriptionid=subscription.subscriptionid)
465 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
466 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
467 WHERE subscription.biblionumber = ?
469 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
470 serial.subscriptionid
472 my $sth = $dbh->prepare($query);
473 $sth->execute($biblionumber);
474 my $subscriptions = $sth->fetchall_arrayref( {} );
475 if (scalar @$subscriptions) {
476 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
477 for my $subscription ( @$subscriptions ) {
478 $subscription->{cannotedit} = $cannotedit;
482 return $subscriptions;
485 =head2 SearchSubscriptions
487 @results = SearchSubscriptions($args);
489 This function returns a list of hashrefs, one for each subscription
490 that meets the conditions specified by the $args hashref.
492 The valid search fields are:
506 The expiration_date search field is special; it specifies the maximum
507 subscription expiration date.
511 sub SearchSubscriptions {
514 my $additional_fields = $args->{additional_fields} // [];
515 my $matching_record_ids_for_additional_fields = [];
516 if ( @$additional_fields ) {
517 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
519 return () unless @subscriptions;
521 $matching_record_ids_for_additional_fields = [ map {
528 subscription.notes AS publicnotes,
529 subscriptionhistory.*,
531 biblio.notes AS biblionotes,
535 aqbooksellers.name AS vendorname,
538 LEFT JOIN subscriptionhistory USING(subscriptionid)
539 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
540 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
541 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
543 $query .= q| WHERE 1|;
546 if( $args->{biblionumber} ) {
547 push @where_strs, "biblio.biblionumber = ?";
548 push @where_args, $args->{biblionumber};
551 if( $args->{title} ){
552 my @words = split / /, $args->{title};
554 foreach my $word (@words) {
555 push @strs, "biblio.title LIKE ?";
556 push @args, "%$word%";
559 push @where_strs, '(' . join (' AND ', @strs) . ')';
560 push @where_args, @args;
564 push @where_strs, "biblioitems.issn LIKE ?";
565 push @where_args, "%$args->{issn}%";
568 push @where_strs, "biblioitems.ean LIKE ?";
569 push @where_args, "%$args->{ean}%";
571 if ( $args->{callnumber} ) {
572 push @where_strs, "subscription.callnumber LIKE ?";
573 push @where_args, "%$args->{callnumber}%";
575 if( $args->{publisher} ){
576 push @where_strs, "biblioitems.publishercode LIKE ?";
577 push @where_args, "%$args->{publisher}%";
579 if( $args->{bookseller} ){
580 push @where_strs, "aqbooksellers.name LIKE ?";
581 push @where_args, "%$args->{bookseller}%";
583 if( $args->{branch} ){
584 push @where_strs, "subscription.branchcode = ?";
585 push @where_args, "$args->{branch}";
587 if ( $args->{location} ) {
588 push @where_strs, "subscription.location = ?";
589 push @where_args, "$args->{location}";
591 if ( $args->{expiration_date} ) {
592 push @where_strs, "subscription.enddate <= ?";
593 push @where_args, "$args->{expiration_date}";
595 if( defined $args->{closed} ){
596 push @where_strs, "subscription.closed = ?";
597 push @where_args, "$args->{closed}";
601 $query .= ' AND ' . join(' AND ', @where_strs);
603 if ( @$additional_fields ) {
604 $query .= ' AND subscriptionid IN ('
605 . join( ', ', @$matching_record_ids_for_additional_fields )
609 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
611 my $dbh = C4::Context->dbh;
612 my $sth = $dbh->prepare($query);
613 $sth->execute(@where_args);
614 my $results = $sth->fetchall_arrayref( {} );
616 for my $subscription ( @$results ) {
617 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
618 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
620 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
621 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
622 $subscription_object->additional_field_values->as_list };
632 ($totalissues,@serials) = GetSerials($subscriptionid);
633 this function gets every serial not arrived for a given subscription
634 as well as the number of issues registered in the database (all types)
635 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
637 FIXME: We should return \@serials.
642 my ( $subscriptionid, $count ) = @_;
644 return unless $subscriptionid;
646 my $dbh = C4::Context->dbh;
648 # status = 2 is "arrived"
650 $count = 5 unless ($count);
652 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
653 my $query = "SELECT serialid,serialseq, status, publisheddate,
654 publisheddatetext, planneddate,notes, routingnotes
656 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
657 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
658 my $sth = $dbh->prepare($query);
659 $sth->execute($subscriptionid);
661 while ( my $line = $sth->fetchrow_hashref ) {
662 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
663 for my $datefield ( qw( planneddate publisheddate) ) {
664 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
665 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
667 $line->{$datefield} = q{};
670 push @serials, $line;
673 # OK, now add the last 5 issues arrives/missing
674 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
675 publisheddatetext, notes, routingnotes
677 WHERE subscriptionid = ?
678 AND status IN ( $statuses )
679 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
681 $sth = $dbh->prepare($query);
682 $sth->execute($subscriptionid);
683 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
685 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
686 for my $datefield ( qw( planneddate publisheddate) ) {
687 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
688 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
690 $line->{$datefield} = q{};
694 push @serials, $line;
697 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
698 $sth = $dbh->prepare($query);
699 $sth->execute($subscriptionid);
700 my ($totalissues) = $sth->fetchrow;
701 return ( $totalissues, @serials );
706 @serials = GetSerials2($subscriptionid,$statuses);
707 this function returns every serial waited for a given subscription
708 as well as the number of issues registered in the database (all types)
709 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
711 $statuses is an arrayref of statuses and is mandatory.
716 my ( $subscription, $statuses ) = @_;
718 return unless ($subscription and @$statuses);
720 my $dbh = C4::Context->dbh;
722 SELECT serialid,serialseq, status, planneddate, publisheddate,
723 publisheddatetext, notes, routingnotes
725 WHERE subscriptionid=?
727 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
729 ORDER BY publisheddate,serialid DESC
731 my $sth = $dbh->prepare($query);
732 $sth->execute( $subscription, @$statuses );
735 while ( my $line = $sth->fetchrow_hashref ) {
736 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
737 # Format dates for display
738 for my $datefield ( qw( planneddate publisheddate ) ) {
739 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
740 $line->{$datefield} = q{};
743 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
746 push @serials, $line;
751 =head2 GetLatestSerials
753 \@serials = GetLatestSerials($subscriptionid,$limit)
754 get the $limit's latest serials arrived or missing for a given subscription
756 a ref to an array which contains all of the latest serials stored into a hash.
760 sub GetLatestSerials {
761 my ( $subscriptionid, $limit ) = @_;
763 return unless ($subscriptionid and $limit);
765 my $dbh = C4::Context->dbh;
767 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
768 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
770 WHERE subscriptionid = ?
771 AND status IN ($statuses)
772 ORDER BY publisheddate DESC LIMIT 0,$limit
774 my $sth = $dbh->prepare($strsth);
775 $sth->execute($subscriptionid);
777 while ( my $line = $sth->fetchrow_hashref ) {
778 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
779 push @serials, $line;
785 =head2 GetPreviousSerialid
787 $serialid = GetPreviousSerialid($subscriptionid, $nth)
788 get the $nth's previous serial for the given subscriptionid
794 sub GetPreviousSerialid {
795 my ( $subscriptionid, $nth ) = @_;
797 my $dbh = C4::Context->dbh;
801 my $strsth = "SELECT serialid
803 WHERE subscriptionid = ?
805 ORDER BY serialid DESC LIMIT $nth,1
807 my $sth = $dbh->prepare($strsth);
808 $sth->execute($subscriptionid);
810 my $line = $sth->fetchrow_hashref;
811 $return = $line->{'serialid'} if ($line);
819 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
820 $newinnerloop1, $newinnerloop2, $newinnerloop3
821 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
823 $subscription is a hashref containing all the attributes of the table
825 $pattern is a hashref containing all the attributes of the table
826 'subscription_numberpatterns'.
827 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
828 $planneddate is a date string in iso format.
829 This function get the next issue for the subscription given on input arg
834 my ($subscription, $pattern, $frequency, $planneddate) = @_;
836 return unless ($subscription and $pattern);
838 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
839 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
842 if ($subscription->{'skip_serialseq'}) {
843 my @irreg = split /;/, $subscription->{'irregularity'};
845 my $irregularities = {};
846 $irregularities->{$_} = 1 foreach(@irreg);
847 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
848 while($irregularities->{$issueno}) {
855 my $numberingmethod = $pattern->{numberingmethod};
857 if ($numberingmethod) {
858 $calculated = $numberingmethod;
859 my $locale = $subscription->{locale};
860 $newlastvalue1 = $subscription->{lastvalue1} || 0;
861 $newlastvalue2 = $subscription->{lastvalue2} || 0;
862 $newlastvalue3 = $subscription->{lastvalue3} || 0;
863 $newinnerloop1 = $subscription->{innerloop1} || 0;
864 $newinnerloop2 = $subscription->{innerloop2} || 0;
865 $newinnerloop3 = $subscription->{innerloop3} || 0;
868 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
871 for(my $i = 0; $i < $count; $i++) {
873 # check if we have to increase the new value.
875 if ($newinnerloop1 >= $pattern->{every1}) {
877 $newlastvalue1 += $pattern->{add1};
879 # reset counter if needed.
880 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
883 # check if we have to increase the new value.
885 if ($newinnerloop2 >= $pattern->{every2}) {
887 $newlastvalue2 += $pattern->{add2};
889 # reset counter if needed.
890 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
893 # check if we have to increase the new value.
895 if ($newinnerloop3 >= $pattern->{every3}) {
897 $newlastvalue3 += $pattern->{add3};
899 # reset counter if needed.
900 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
904 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
905 $calculated =~ s/\{X\}/$newlastvalue1string/g;
908 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
909 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
912 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
913 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
918 $newlastvalue1, $newlastvalue2, $newlastvalue3,
919 $newinnerloop1, $newinnerloop2, $newinnerloop3);
924 $calculated = GetSeq($subscription, $pattern)
925 $subscription is a hashref containing all the attributes of the table 'subscription'
926 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
927 this function transforms {X},{Y},{Z} to 150,0,0 for example.
929 the sequence in string format
934 my ($subscription, $pattern) = @_;
936 return unless ($subscription and $pattern);
938 my $locale = $subscription->{locale};
940 my $calculated = $pattern->{numberingmethod};
942 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
943 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
944 $calculated =~ s/\{X\}/$newlastvalue1/g;
946 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
947 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
948 $calculated =~ s/\{Y\}/$newlastvalue2/g;
950 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
951 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
952 $calculated =~ s/\{Z\}/$newlastvalue3/g;
956 =head2 GetExpirationDate
958 $enddate = GetExpirationDate($subscriptionid, [$startdate])
960 this function return the next expiration date for a subscription given on input args.
967 sub GetExpirationDate {
968 my ( $subscriptionid, $startdate ) = @_;
970 return unless ($subscriptionid);
972 my $dbh = C4::Context->dbh;
973 my $subscription = GetSubscription($subscriptionid);
976 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
977 $enddate = $startdate || $subscription->{startdate};
978 my @date = split( /-/, $enddate );
980 return if ( scalar(@date) != 3 || not check_date(@date) );
982 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
983 if ( $frequency and $frequency->{unit} ) {
986 if ( my $length = $subscription->{numberlength} ) {
988 #calculate the date of the last issue.
989 for ( my $i = 1 ; $i <= $length ; $i++ ) {
990 $enddate = GetNextDate( $subscription, $enddate, $frequency );
992 } elsif ( $subscription->{monthlength} ) {
993 if ( $$subscription{startdate} ) {
994 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
995 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
997 } elsif ( $subscription->{weeklength} ) {
998 if ( $$subscription{startdate} ) {
999 my @date = split( /-/, $subscription->{startdate} );
1000 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1001 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1004 $enddate = $subscription->{enddate};
1008 return $subscription->{enddate};
1012 =head2 CountSubscriptionFromBiblionumber
1014 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1015 this returns a count of the subscriptions for a given biblionumber
1017 the number of subscriptions
1021 sub CountSubscriptionFromBiblionumber {
1022 my ($biblionumber) = @_;
1024 return unless ($biblionumber);
1026 my $dbh = C4::Context->dbh;
1027 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1028 my $sth = $dbh->prepare($query);
1029 $sth->execute($biblionumber);
1030 my $subscriptionsnumber = $sth->fetchrow;
1031 return $subscriptionsnumber;
1034 =head2 ModSubscriptionHistory
1036 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1038 this function modifies the history of a subscription. Put your new values on input arg.
1039 returns the number of rows affected
1043 sub ModSubscriptionHistory {
1044 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1046 return unless ($subscriptionid);
1048 my $dbh = C4::Context->dbh;
1049 my $query = "UPDATE subscriptionhistory
1050 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1051 WHERE subscriptionid=?
1053 my $sth = $dbh->prepare($query);
1054 $receivedlist =~ s/^; // if $receivedlist;
1055 $missinglist =~ s/^; // if $missinglist;
1056 $opacnote =~ s/^; // if $opacnote;
1057 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1061 =head2 ModSerialStatus
1063 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1064 $publisheddatetext, $status, $notes);
1066 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1067 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1071 sub ModSerialStatus {
1072 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1073 $status, $notes) = @_;
1075 return unless ($serialid);
1077 #It is a usual serial
1078 # 1st, get previous status :
1079 my $dbh = C4::Context->dbh;
1080 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1081 FROM serial, subscription
1082 WHERE serial.subscriptionid=subscription.subscriptionid
1084 my $sth = $dbh->prepare($query);
1085 $sth->execute($serialid);
1086 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1087 my $frequency = GetSubscriptionFrequency($periodicity);
1089 # change status & update subscriptionhistory
1091 if ( $status == DELETED ) {
1092 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1096 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1097 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1100 $sth = $dbh->prepare($query);
1101 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1102 $planneddate, $status, $notes, $routingnotes, $serialid );
1103 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1104 $sth = $dbh->prepare($query);
1105 $sth->execute($subscriptionid);
1106 my $val = $sth->fetchrow_hashref;
1107 unless ( $val->{manualhistory} ) {
1108 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1109 $sth = $dbh->prepare($query);
1110 $sth->execute($subscriptionid);
1111 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1113 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1114 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1117 # in case serial has been previously marked as missing
1118 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1119 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1122 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1123 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1125 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1126 $sth = $dbh->prepare($query);
1127 $recievedlist =~ s/^; //;
1128 $missinglist =~ s/^; //;
1129 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1133 # create new expected entry if needed (ie : was "expected" and has changed)
1134 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1135 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1136 my $subscription = GetSubscription($subscriptionid);
1137 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1138 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1142 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1143 $newinnerloop1, $newinnerloop2, $newinnerloop3
1145 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1147 # next date (calculated from actual date & frequency parameters)
1148 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1149 my $nextpubdate = $nextpublisheddate;
1150 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1151 WHERE subscriptionid = ?";
1152 $sth = $dbh->prepare($query);
1153 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1154 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1155 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1156 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1157 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1158 require C4::Letters;
1159 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1167 # Adds or removes seqno from list when needed; returns list
1168 # Or checks and returns true when present
1170 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1172 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1174 if( !$op or $op eq 'ADD' ) {
1175 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1176 } elsif( $op eq 'REMOVE' ) {
1177 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1179 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1184 =head2 GetNextExpected
1186 $nextexpected = GetNextExpected($subscriptionid)
1188 Get the planneddate for the current expected issue of the subscription.
1194 planneddate => ISO date
1199 sub GetNextExpected {
1200 my ($subscriptionid) = @_;
1202 my $dbh = C4::Context->dbh;
1206 WHERE subscriptionid = ?
1210 my $sth = $dbh->prepare($query);
1212 # Each subscription has only one 'expected' issue.
1213 $sth->execute( $subscriptionid, EXPECTED );
1214 my $nextissue = $sth->fetchrow_hashref;
1215 if ( !$nextissue ) {
1219 WHERE subscriptionid = ?
1220 ORDER BY publisheddate DESC
1223 $sth = $dbh->prepare($query);
1224 $sth->execute($subscriptionid);
1225 $nextissue = $sth->fetchrow_hashref;
1227 foreach(qw/planneddate publisheddate/) {
1228 # or should this default to 1st Jan ???
1229 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1235 =head2 ModNextExpected
1237 ModNextExpected($subscriptionid,$date)
1239 Update the planneddate for the current expected issue of the subscription.
1240 This will modify all future prediction results.
1242 C<$date> is an ISO date.
1248 sub ModNextExpected {
1249 my ( $subscriptionid, $date ) = @_;
1250 my $dbh = C4::Context->dbh;
1252 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1253 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1255 # Each subscription has only one 'expected' issue.
1256 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1261 =head2 GetSubscriptionIrregularities
1265 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1266 get the list of irregularities for a subscription
1272 sub GetSubscriptionIrregularities {
1273 my $subscriptionid = shift;
1275 return unless $subscriptionid;
1277 my $dbh = C4::Context->dbh;
1281 WHERE subscriptionid = ?
1283 my $sth = $dbh->prepare($query);
1284 $sth->execute($subscriptionid);
1286 my ($result) = $sth->fetchrow_array;
1287 my @irreg = split /;/, $result;
1292 =head2 ModSubscription
1294 this function modifies a subscription. Put all new values on input args.
1295 returns the number of rows affected
1299 sub ModSubscription {
1301 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1302 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1303 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1304 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1305 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1306 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1307 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1308 $itemtype, $previousitemtype, $mana_id
1311 my $subscription = Koha::Subscriptions->find($subscriptionid);
1314 librarian => $auser,
1315 branchcode => $branchcode,
1316 aqbooksellerid => $aqbooksellerid,
1318 aqbudgetid => $aqbudgetid,
1319 biblionumber => $biblionumber,
1320 startdate => $startdate,
1321 periodicity => $periodicity,
1322 numberlength => $numberlength,
1323 weeklength => $weeklength,
1324 monthlength => $monthlength,
1325 lastvalue1 => $lastvalue1,
1326 innerloop1 => $innerloop1,
1327 lastvalue2 => $lastvalue2,
1328 innerloop2 => $innerloop2,
1329 lastvalue3 => $lastvalue3,
1330 innerloop3 => $innerloop3,
1334 firstacquidate => $firstacquidate,
1335 irregularity => $irregularity,
1336 numberpattern => $numberpattern,
1338 callnumber => $callnumber,
1339 manualhistory => $manualhistory,
1340 internalnotes => $internalnotes,
1341 serialsadditems => $serialsadditems,
1342 staffdisplaycount => $staffdisplaycount,
1343 opacdisplaycount => $opacdisplaycount,
1344 graceperiod => $graceperiod,
1345 location => $location,
1346 enddate => $enddate,
1347 skip_serialseq => $skip_serialseq,
1348 itemtype => $itemtype,
1349 previousitemtype => $previousitemtype,
1350 mana_id => $mana_id,
1353 # FIXME Must be $subscription->serials
1354 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1355 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1357 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1359 $subscription->discard_changes;
1360 return $subscription;
1363 =head2 NewSubscription
1365 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1366 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1367 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1368 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1369 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1370 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1371 $skip_serialseq, $itemtype, $previousitemtype);
1373 Create a new subscription with value given on input args.
1376 the id of this new subscription
1380 sub NewSubscription {
1382 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1383 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1384 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1385 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1386 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1387 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1388 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1390 my $dbh = C4::Context->dbh;
1392 my $subscription = Koha::Subscription->new(
1394 librarian => $auser,
1395 branchcode => $branchcode,
1396 aqbooksellerid => $aqbooksellerid,
1398 aqbudgetid => $aqbudgetid,
1399 biblionumber => $biblionumber,
1400 startdate => $startdate,
1401 periodicity => $periodicity,
1402 numberlength => $numberlength,
1403 weeklength => $weeklength,
1404 monthlength => $monthlength,
1405 lastvalue1 => $lastvalue1,
1406 innerloop1 => $innerloop1,
1407 lastvalue2 => $lastvalue2,
1408 innerloop2 => $innerloop2,
1409 lastvalue3 => $lastvalue3,
1410 innerloop3 => $innerloop3,
1414 firstacquidate => $firstacquidate,
1415 irregularity => $irregularity,
1416 numberpattern => $numberpattern,
1418 callnumber => $callnumber,
1419 manualhistory => $manualhistory,
1420 internalnotes => $internalnotes,
1421 serialsadditems => $serialsadditems,
1422 staffdisplaycount => $staffdisplaycount,
1423 opacdisplaycount => $opacdisplaycount,
1424 graceperiod => $graceperiod,
1425 location => $location,
1426 enddate => $enddate,
1427 skip_serialseq => $skip_serialseq,
1428 itemtype => $itemtype,
1429 previousitemtype => $previousitemtype,
1430 mana_id => $mana_id,
1433 $subscription->discard_changes;
1434 my $subscriptionid = $subscription->subscriptionid;
1435 my ( $query, $sth );
1437 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1441 WHERE subscriptionid=?
1443 $sth = $dbh->prepare($query);
1444 $sth->execute( $enddate, $subscriptionid );
1447 # then create the 1st expected number
1449 INSERT INTO subscriptionhistory
1450 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1451 VALUES (?,?,?, '', '')
1453 $sth = $dbh->prepare($query);
1454 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1456 # reread subscription to get a hash (for calculation of the 1st issue number)
1457 $subscription = GetSubscription($subscriptionid); # We should not do that
1458 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1460 # calculate issue number
1461 my $serialseq = GetSeq($subscription, $pattern) || q{};
1465 serialseq => $serialseq,
1466 serialseq_x => $subscription->{'lastvalue1'},
1467 serialseq_y => $subscription->{'lastvalue2'},
1468 serialseq_z => $subscription->{'lastvalue3'},
1469 subscriptionid => $subscriptionid,
1470 biblionumber => $biblionumber,
1472 planneddate => $firstacquidate,
1473 publisheddate => $firstacquidate,
1477 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1479 #set serial flag on biblio if not already set.
1480 my $biblio = Koha::Biblios->find( $biblionumber );
1481 if ( $biblio and !$biblio->serial ) {
1482 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1483 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1485 eval { $record->field($tag)->update( $subf => 1 ); };
1487 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1489 return $subscriptionid;
1492 =head2 GetSubscriptionLength
1494 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1496 This function calculates the subscription length.
1500 sub GetSubscriptionLength {
1501 my ($subtype, $length) = @_;
1503 return unless looks_like_number($length);
1507 $subtype eq 'issues' ? $length : 0,
1508 $subtype eq 'weeks' ? $length : 0,
1509 $subtype eq 'months' ? $length : 0,
1514 =head2 ReNewSubscription
1516 ReNewSubscription($params);
1518 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1520 this function renew a subscription with values given on input args.
1524 sub ReNewSubscription {
1525 my ( $params ) = @_;
1526 my $subscriptionid = $params->{subscriptionid};
1527 my $user = $params->{user};
1528 my $startdate = $params->{startdate};
1529 my $numberlength = $params->{numberlength};
1530 my $weeklength = $params->{weeklength};
1531 my $monthlength = $params->{monthlength};
1532 my $note = $params->{note};
1533 my $branchcode = $params->{branchcode};
1535 my $dbh = C4::Context->dbh;
1536 my $subscription = GetSubscription($subscriptionid);
1540 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1541 WHERE biblio.biblionumber=?
1543 my $sth = $dbh->prepare($query);
1544 $sth->execute( $subscription->{biblionumber} );
1545 my $biblio = $sth->fetchrow_hashref;
1547 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1548 require C4::Suggestions;
1549 C4::Suggestions::NewSuggestion(
1550 { 'suggestedby' => $user,
1551 'title' => $subscription->{bibliotitle},
1552 'author' => $biblio->{author},
1553 'publishercode' => $biblio->{publishercode},
1555 'biblionumber' => $subscription->{biblionumber},
1556 'branchcode' => $branchcode,
1561 $numberlength ||= 0; # Should not we raise an exception instead?
1564 # renew subscription
1567 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1568 WHERE subscriptionid=?
1570 $sth = $dbh->prepare($query);
1571 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1572 my $enddate = GetExpirationDate($subscriptionid);
1576 WHERE subscriptionid=?
1578 $sth = $dbh->prepare($query);
1579 $sth->execute( $enddate, $subscriptionid );
1581 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1587 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1589 Create a new issue stored on the database.
1590 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1591 returns the serial id
1596 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1597 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1598 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1600 return unless ($subscriptionid);
1602 my $schema = Koha::Database->new()->schema();
1604 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1606 my $serial = Koha::Serial->new(
1608 serialseq => $serialseq,
1609 serialseq_x => $subscription->lastvalue1(),
1610 serialseq_y => $subscription->lastvalue2(),
1611 serialseq_z => $subscription->lastvalue3(),
1612 subscriptionid => $subscriptionid,
1613 biblionumber => $biblionumber,
1615 planneddate => $planneddate,
1616 publisheddate => $publisheddate,
1617 publisheddatetext => $publisheddatetext,
1619 routingnotes => $routingnotes
1623 my $serialid = $serial->id();
1625 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1626 my $missinglist = $subscription_history->missinglist();
1627 my $recievedlist = $subscription_history->recievedlist();
1629 if ( $status == ARRIVED ) {
1630 ### TODO Add a feature that improves recognition and description.
1631 ### As such count (serialseq) i.e. : N18,2(N19),N20
1632 ### Would use substr and index But be careful to previous presence of ()
1633 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1635 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1636 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1639 $recievedlist =~ s/^; //;
1640 $missinglist =~ s/^; //;
1642 $subscription_history->recievedlist($recievedlist);
1643 $subscription_history->missinglist($missinglist);
1644 $subscription_history->store();
1649 =head2 HasSubscriptionStrictlyExpired
1651 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1653 the subscription has stricly expired when today > the end subscription date
1656 1 if true, 0 if false, -1 if the expiration date is not set.
1660 sub HasSubscriptionStrictlyExpired {
1662 # Getting end of subscription date
1663 my ($subscriptionid) = @_;
1665 return unless ($subscriptionid);
1667 my $dbh = C4::Context->dbh;
1668 my $subscription = GetSubscription($subscriptionid);
1669 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1671 # If the expiration date is set
1672 if ( $expirationdate != 0 ) {
1673 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1675 # Getting today's date
1676 my ( $nowyear, $nowmonth, $nowday ) = Today();
1678 # if today's date > expiration date, then the subscription has stricly expired
1679 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1686 # There are some cases where the expiration date is not set
1687 # As we can't determine if the subscription has expired on a date-basis,
1693 =head2 HasSubscriptionExpired
1695 $has_expired = HasSubscriptionExpired($subscriptionid)
1697 the subscription has expired when the next issue to arrive is out of subscription limit.
1700 0 if the subscription has not expired
1701 1 if the subscription has expired
1702 2 if has subscription does not have a valid expiration date set
1706 sub HasSubscriptionExpired {
1707 my ($subscriptionid) = @_;
1709 return unless ($subscriptionid);
1711 my $dbh = C4::Context->dbh;
1712 my $subscription = GetSubscription($subscriptionid);
1713 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1714 if ( $frequency and $frequency->{unit} ) {
1715 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1716 if (!defined $expirationdate) {
1717 $expirationdate = q{};
1720 SELECT max(planneddate)
1722 WHERE subscriptionid=?
1724 my $sth = $dbh->prepare($query);
1725 $sth->execute($subscriptionid);
1726 my ($res) = $sth->fetchrow;
1727 if (!$res || $res=~m/^0000/) {
1730 my @res = split( /-/, $res );
1731 my @endofsubscriptiondate = split( /-/, $expirationdate );
1732 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1734 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1739 if ( $subscription->{'numberlength'} ) {
1740 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1741 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1747 return 0; # Notice that you'll never get here.
1750 =head2 DelSubscription
1752 DelSubscription($subscriptionid)
1753 this function deletes subscription which has $subscriptionid as id.
1757 sub DelSubscription {
1758 my ($subscriptionid) = @_;
1759 my $dbh = C4::Context->dbh;
1760 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1762 Koha::AdditionalFieldValues->search({
1763 'field.tablename' => 'subscription',
1764 'me.record_id' => $subscriptionid,
1765 }, { join => 'field' })->delete;
1767 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1772 DelIssue($serialseq,$subscriptionid)
1773 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1775 returns the number of rows affected
1780 my ($dataissue) = @_;
1781 my $dbh = C4::Context->dbh;
1782 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1787 AND subscriptionid= ?
1789 my $mainsth = $dbh->prepare($query);
1790 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1792 #Delete element from subscription history
1793 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1794 my $sth = $dbh->prepare($query);
1795 $sth->execute( $dataissue->{'subscriptionid'} );
1796 my $val = $sth->fetchrow_hashref;
1797 unless ( $val->{manualhistory} ) {
1799 SELECT * FROM subscriptionhistory
1800 WHERE subscriptionid= ?
1802 my $sth = $dbh->prepare($query);
1803 $sth->execute( $dataissue->{'subscriptionid'} );
1804 my $data = $sth->fetchrow_hashref;
1805 my $serialseq = $dataissue->{'serialseq'};
1806 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1807 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1808 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1809 $sth = $dbh->prepare($strsth);
1810 $sth->execute( $dataissue->{'subscriptionid'} );
1813 return $mainsth->rows;
1816 =head2 GetLateOrMissingIssues
1818 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1820 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1823 the issuelist as an array of hash refs. Each element of this array contains
1824 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1828 sub GetLateOrMissingIssues {
1829 my ( $supplierid, $serialid, $order ) = @_;
1831 return unless ( $supplierid or $serialid );
1833 my $dbh = C4::Context->dbh;
1838 $byserial = "and serialid = " . $serialid;
1841 $order .= ", title";
1845 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1847 $sth = $dbh->prepare(
1849 serialid, aqbooksellerid, name,
1850 biblio.title, biblioitems.issn, planneddate, serialseq,
1851 serial.status, serial.subscriptionid, claimdate, claims_count,
1852 subscription.branchcode
1854 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1855 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1856 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1857 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1858 WHERE subscription.subscriptionid = serial.subscriptionid
1859 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1860 AND subscription.aqbooksellerid=$supplierid
1865 $sth = $dbh->prepare(
1867 serialid, aqbooksellerid, name,
1868 biblio.title, planneddate, serialseq,
1869 serial.status, serial.subscriptionid, claimdate, claims_count,
1870 subscription.branchcode
1872 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1873 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1874 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1875 WHERE subscription.subscriptionid = serial.subscriptionid
1876 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1881 $sth->execute( EXPECTED, LATE, CLAIMED );
1883 while ( my $line = $sth->fetchrow_hashref ) {
1885 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1886 $line->{planneddateISO} = $line->{planneddate};
1887 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1889 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1890 $line->{claimdateISO} = $line->{claimdate};
1891 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1893 $line->{"status".$line->{status}} = 1;
1895 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1896 $line->{additional_fields} = { map { $_->field->name => $_->value }
1897 $subscription_object->additional_field_values->as_list };
1899 push @issuelist, $line;
1906 &updateClaim($serialid)
1908 this function updates the time when a claim is issued for late/missing items
1910 called from claims.pl file
1915 my ($serialids) = @_;
1916 return unless $serialids;
1917 unless ( ref $serialids ) {
1918 $serialids = [ $serialids ];
1920 my $dbh = C4::Context->dbh;
1923 SET claimdate = NOW(),
1924 claims_count = claims_count + 1,
1926 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1927 {}, CLAIMED, @$serialids );
1930 =head2 check_routing
1932 $result = &check_routing($subscriptionid)
1934 this function checks to see if a serial has a routing list and returns the count of routingid
1935 used to show either an 'add' or 'edit' link
1940 my ($subscriptionid) = @_;
1942 return unless ($subscriptionid);
1944 my $dbh = C4::Context->dbh;
1945 my $sth = $dbh->prepare(
1946 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1947 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1948 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1951 $sth->execute($subscriptionid);
1952 my $line = $sth->fetchrow_hashref;
1953 my $result = $line->{'routingids'};
1957 =head2 addroutingmember
1959 addroutingmember($borrowernumber,$subscriptionid)
1961 this function takes a borrowernumber and subscriptionid and adds the member to the
1962 routing list for that serial subscription and gives them a rank on the list
1963 of either 1 or highest current rank + 1
1967 sub addroutingmember {
1968 my ( $borrowernumber, $subscriptionid ) = @_;
1970 return unless ($borrowernumber and $subscriptionid);
1973 my $dbh = C4::Context->dbh;
1974 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1975 $sth->execute($subscriptionid);
1976 while ( my $line = $sth->fetchrow_hashref ) {
1977 if ( $line->{'rank'} > 0 ) {
1978 $rank = $line->{'rank'} + 1;
1983 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1984 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1987 =head2 reorder_members
1989 reorder_members($subscriptionid,$routingid,$rank)
1991 this function is used to reorder the routing list
1993 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1994 - it gets all members on list puts their routingid's into an array
1995 - removes the one in the array that is $routingid
1996 - then reinjects $routingid at point indicated by $rank
1997 - then update the database with the routingids in the new order
2001 sub reorder_members {
2002 my ( $subscriptionid, $routingid, $rank ) = @_;
2003 my $dbh = C4::Context->dbh;
2004 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2005 $sth->execute($subscriptionid);
2007 while ( my $line = $sth->fetchrow_hashref ) {
2008 push( @result, $line->{'routingid'} );
2011 # To find the matching index
2013 my $key = -1; # to allow for 0 being a valid response
2014 for ( $i = 0 ; $i < @result ; $i++ ) {
2015 if ( $routingid == $result[$i] ) {
2016 $key = $i; # save the index
2021 # if index exists in array then move it to new position
2022 if ( $key > -1 && $rank > 0 ) {
2023 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2024 my $moving_item = splice( @result, $key, 1 );
2025 splice( @result, $new_rank, 0, $moving_item );
2027 for ( my $j = 0 ; $j < @result ; $j++ ) {
2028 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2034 =head2 delroutingmember
2036 delroutingmember($routingid,$subscriptionid)
2038 this function either deletes one member from routing list if $routingid exists otherwise
2039 deletes all members from the routing list
2043 sub delroutingmember {
2045 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2046 my ( $routingid, $subscriptionid ) = @_;
2047 my $dbh = C4::Context->dbh;
2049 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2050 $sth->execute($routingid);
2051 reorder_members( $subscriptionid, $routingid );
2053 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2054 $sth->execute($subscriptionid);
2059 =head2 getroutinglist
2061 @routinglist = getroutinglist($subscriptionid)
2063 this gets the info from the subscriptionroutinglist for $subscriptionid
2066 the routinglist as an array. Each element of the array contains a hash_ref containing
2067 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2071 sub getroutinglist {
2072 my ($subscriptionid) = @_;
2073 my $dbh = C4::Context->dbh;
2074 my $sth = $dbh->prepare(
2075 'SELECT routingid, borrowernumber, ranking, biblionumber
2077 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2078 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2080 $sth->execute($subscriptionid);
2081 my $routinglist = $sth->fetchall_arrayref({});
2082 return @{$routinglist};
2085 =head2 countissuesfrom
2087 $result = countissuesfrom($subscriptionid,$startdate)
2089 Returns a count of serial rows matching the given subsctiptionid
2090 with published date greater than startdate
2094 sub countissuesfrom {
2095 my ( $subscriptionid, $startdate ) = @_;
2096 my $dbh = C4::Context->dbh;
2100 WHERE subscriptionid=?
2101 AND serial.publisheddate>?
2103 my $sth = $dbh->prepare($query);
2104 $sth->execute( $subscriptionid, $startdate );
2105 my ($countreceived) = $sth->fetchrow;
2106 return $countreceived;
2111 $result = CountIssues($subscriptionid)
2113 Returns a count of serial rows matching the given subsctiptionid
2118 my ($subscriptionid) = @_;
2119 my $dbh = C4::Context->dbh;
2123 WHERE subscriptionid=?
2125 my $sth = $dbh->prepare($query);
2126 $sth->execute($subscriptionid);
2127 my ($countreceived) = $sth->fetchrow;
2128 return $countreceived;
2133 $result = HasItems($subscriptionid)
2135 returns a count of items from serial matching the subscriptionid
2140 my ($subscriptionid) = @_;
2141 my $dbh = C4::Context->dbh;
2143 SELECT COUNT(serialitems.itemnumber)
2145 LEFT JOIN serialitems USING(serialid)
2146 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2148 my $sth=$dbh->prepare($query);
2149 $sth->execute($subscriptionid);
2150 my ($countitems)=$sth->fetchrow_array();
2154 =head2 abouttoexpire
2156 $result = abouttoexpire($subscriptionid)
2158 this function alerts you to the penultimate issue for a serial subscription
2160 returns 1 - if this is the penultimate issue
2166 my ($subscriptionid) = @_;
2167 my $dbh = C4::Context->dbh;
2168 my $subscription = GetSubscription($subscriptionid);
2169 my $per = $subscription->{'periodicity'};
2170 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2171 if ($frequency and $frequency->{unit}){
2173 my $expirationdate = GetExpirationDate($subscriptionid);
2175 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2176 my $nextdate = GetNextDate($subscription, $res, $frequency);
2178 # only compare dates if both dates exist.
2179 if ($nextdate and $expirationdate) {
2180 if(Date::Calc::Delta_Days(
2181 split( /-/, $nextdate ),
2182 split( /-/, $expirationdate )
2188 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2189 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2195 =head2 GetFictiveIssueNumber
2197 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2199 Get the position of the issue published at $publisheddate, considering the
2200 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2201 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2202 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2203 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2204 depending on how many rows are in serial table.
2205 The issue number calculation is based on subscription frequency, first acquisition
2206 date, and $publisheddate.
2208 Returns undef when called for irregular frequencies.
2210 The routine is used to skip irregularities when calculating the next issue
2211 date (in GetNextDate) or the next issue number (in GetNextSeq).
2215 sub GetFictiveIssueNumber {
2216 my ($subscription, $publisheddate, $frequency) = @_;
2218 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2222 my ( $year, $month, $day ) = split /-/, $publisheddate;
2223 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2224 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2226 if( $frequency->{'unitsperissue'} == 1 ) {
2227 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2228 } else { # issuesperunit == 1
2229 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2235 my ( $date1, $date2, $unit ) = @_;
2236 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2238 if( $unit eq 'day' ) {
2239 return Delta_Days( @$date1, @$date2 );
2240 } elsif( $unit eq 'week' ) {
2241 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2244 # In case of months or years, this is a wrapper around N_Delta_YMD.
2245 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2246 # while we expect 1 month.
2247 my @delta = N_Delta_YMD( @$date1, @$date2 );
2248 if( $delta[2] > 27 ) {
2249 # Check if we could add a month
2250 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2251 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2255 if( $delta[1] >= 12 ) {
2259 # if unit is year, we only return full years
2260 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2263 sub _get_next_date_day {
2264 my ($subscription, $freqdata, $year, $month, $day) = @_;
2266 my @newissue; # ( yy, mm, dd )
2267 # We do not need $delta_days here, since it would be zero where used
2269 if( $freqdata->{issuesperunit} == 1 ) {
2271 @newissue = Add_Delta_Days(
2272 $year, $month, $day, $freqdata->{"unitsperissue"} );
2273 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2275 @newissue = ( $year, $month, $day );
2276 $subscription->{countissuesperunit}++;
2278 # We finished a cycle of issues within a unit.
2279 # No subtraction of zero needed, just add one day
2280 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2281 $subscription->{countissuesperunit} = 1;
2286 sub _get_next_date_week {
2287 my ($subscription, $freqdata, $year, $month, $day) = @_;
2289 my @newissue; # ( yy, mm, dd )
2290 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2292 if( $freqdata->{issuesperunit} == 1 ) {
2293 # Add full weeks (of 7 days)
2294 @newissue = Add_Delta_Days(
2295 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2296 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2297 # Add rounded number of days based on frequency.
2298 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2299 $subscription->{countissuesperunit}++;
2301 # We finished a cycle of issues within a unit.
2302 # Subtract delta * (issues - 1), add 1 week
2303 @newissue = Add_Delta_Days( $year, $month, $day,
2304 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2305 @newissue = Add_Delta_Days( @newissue, 7 );
2306 $subscription->{countissuesperunit} = 1;
2311 sub _get_next_date_month {
2312 my ($subscription, $freqdata, $year, $month, $day) = @_;
2314 my @newissue; # ( yy, mm, dd )
2315 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2317 if( $freqdata->{issuesperunit} == 1 ) {
2319 @newissue = Add_Delta_YM(
2320 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2321 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2322 # Add rounded number of days based on frequency.
2323 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2324 $subscription->{countissuesperunit}++;
2326 # We finished a cycle of issues within a unit.
2327 # Subtract delta * (issues - 1), add 1 month
2328 @newissue = Add_Delta_Days( $year, $month, $day,
2329 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2330 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2331 $subscription->{countissuesperunit} = 1;
2336 sub _get_next_date_year {
2337 my ($subscription, $freqdata, $year, $month, $day) = @_;
2339 my @newissue; # ( yy, mm, dd )
2340 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2342 if( $freqdata->{issuesperunit} == 1 ) {
2344 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2345 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2346 # Add rounded number of days based on frequency.
2347 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2348 $subscription->{countissuesperunit}++;
2350 # We finished a cycle of issues within a unit.
2351 # Subtract delta * (issues - 1), add 1 year
2352 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2353 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2354 $subscription->{countissuesperunit} = 1;
2361 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2363 this function it takes the publisheddate and will return the next issue's date
2364 and will skip dates if there exists an irregularity.
2365 $publisheddate has to be an ISO date
2366 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2367 $frequency is a hashref containing frequency informations
2368 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2369 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2370 skipped then the returned date will be 2007-05-10
2373 $resultdate - then next date in the sequence (ISO date)
2375 Return undef if subscription is irregular
2380 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2382 return unless $subscription and $publisheddate;
2385 if ($freqdata->{'unit'}) {
2386 my ( $year, $month, $day ) = split /-/, $publisheddate;
2388 # Process an irregularity Hash
2389 # Suppose that irregularities are stored in a string with this structure
2390 # irreg1;irreg2;irreg3
2391 # where irregX is the number of issue which will not be received
2392 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2394 if ( $subscription->{irregularity} ) {
2395 my @irreg = split /;/, $subscription->{'irregularity'} ;
2396 foreach my $irregularity (@irreg) {
2397 $irregularities{$irregularity} = 1;
2401 # Get the 'fictive' next issue number
2402 # It is used to check if next issue is an irregular issue.
2403 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2405 # Then get the next date
2406 my $unit = lc $freqdata->{'unit'};
2407 if ($unit eq 'day') {
2408 while ($irregularities{$issueno}) {
2409 ($year, $month, $day) = _get_next_date_day($subscription,
2410 $freqdata, $year, $month, $day);
2413 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2414 $year, $month, $day);
2416 elsif ($unit eq 'week') {
2417 while ($irregularities{$issueno}) {
2418 ($year, $month, $day) = _get_next_date_week($subscription,
2419 $freqdata, $year, $month, $day);
2422 ($year, $month, $day) = _get_next_date_week($subscription,
2423 $freqdata, $year, $month, $day);
2425 elsif ($unit eq 'month') {
2426 while ($irregularities{$issueno}) {
2427 ($year, $month, $day) = _get_next_date_month($subscription,
2428 $freqdata, $year, $month, $day);
2431 ($year, $month, $day) = _get_next_date_month($subscription,
2432 $freqdata, $year, $month, $day);
2434 elsif ($unit eq 'year') {
2435 while ($irregularities{$issueno}) {
2436 ($year, $month, $day) = _get_next_date_year($subscription,
2437 $freqdata, $year, $month, $day);
2440 ($year, $month, $day) = _get_next_date_year($subscription,
2441 $freqdata, $year, $month, $day);
2445 my $dbh = C4::Context->dbh;
2448 SET countissuesperunit = ?
2449 WHERE subscriptionid = ?
2451 my $sth = $dbh->prepare($query);
2452 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2455 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2461 $string = &_numeration($value,$num_type,$locale);
2463 _numeration returns the string corresponding to $value in the num_type
2475 my ($value, $num_type, $locale) = @_;
2480 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2481 # 1970-11-01 was a Sunday
2482 $value = $value % 7;
2483 my $dt = DateTime->new(
2489 $string = $num_type =~ /^dayname$/
2490 ? $dt->strftime("%A")
2491 : $dt->strftime("%a");
2492 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2493 $value = $value % 12;
2494 my $dt = DateTime->new(
2496 month => $value + 1,
2499 $string = $num_type =~ /^monthname$/
2500 ? $dt->strftime("%B")
2501 : $dt->strftime("%b");
2502 } elsif ( $num_type =~ /^season$/ ) {
2503 my @seasons= qw( Spring Summer Fall Winter );
2504 $value = $value % 4;
2505 $string = $seasons[$value];
2506 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2507 my @seasonsabrv= qw( Spr Sum Fal Win );
2508 $value = $value % 4;
2509 $string = $seasonsabrv[$value];
2517 =head2 CloseSubscription
2519 Close a subscription given a subscriptionid
2523 sub CloseSubscription {
2524 my ( $subscriptionid ) = @_;
2525 return unless $subscriptionid;
2526 my $dbh = C4::Context->dbh;
2527 my $sth = $dbh->prepare( q{
2530 WHERE subscriptionid = ?
2532 $sth->execute( $subscriptionid );
2534 # Set status = missing when status = stopped
2535 $sth = $dbh->prepare( q{
2538 WHERE subscriptionid = ?
2541 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2544 =head2 ReopenSubscription
2546 Reopen a subscription given a subscriptionid
2550 sub ReopenSubscription {
2551 my ( $subscriptionid ) = @_;
2552 return unless $subscriptionid;
2553 my $dbh = C4::Context->dbh;
2554 my $sth = $dbh->prepare( q{
2557 WHERE subscriptionid = ?
2559 $sth->execute( $subscriptionid );
2561 # Set status = expected when status = stopped
2562 $sth = $dbh->prepare( q{
2565 WHERE subscriptionid = ?
2568 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2571 =head2 subscriptionCurrentlyOnOrder
2573 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2575 Return 1 if subscription is currently on order else 0.
2579 sub subscriptionCurrentlyOnOrder {
2580 my ( $subscriptionid ) = @_;
2581 my $dbh = C4::Context->dbh;
2583 SELECT COUNT(*) FROM aqorders
2584 WHERE subscriptionid = ?
2585 AND datereceived IS NULL
2586 AND datecancellationprinted IS NULL
2588 my $sth = $dbh->prepare( $query );
2589 $sth->execute($subscriptionid);
2590 return $sth->fetchrow_array;
2593 =head2 can_claim_subscription
2595 $can = can_claim_subscription( $subscriptionid[, $userid] );
2597 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2601 sub can_claim_subscription {
2602 my ( $subscription, $userid ) = @_;
2603 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2606 =head2 can_edit_subscription
2608 $can = can_edit_subscription( $subscriptionid[, $userid] );
2610 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2614 sub can_edit_subscription {
2615 my ( $subscription, $userid ) = @_;
2616 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2619 =head2 can_show_subscription
2621 $can = can_show_subscription( $subscriptionid[, $userid] );
2623 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2627 sub can_show_subscription {
2628 my ( $subscription, $userid ) = @_;
2629 return _can_do_on_subscription( $subscription, $userid, '*' );
2632 sub _can_do_on_subscription {
2633 my ( $subscription, $userid, $permission ) = @_;
2634 return 0 unless C4::Context->userenv;
2635 my $flags = C4::Context->userenv->{flags};
2636 $userid ||= C4::Context->userenv->{'id'};
2638 if ( C4::Context->preference('IndependentBranches') ) {
2640 if C4::Context->IsSuperLibrarian()
2642 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2644 C4::Auth::haspermission( $userid,
2645 { serials => $permission } )
2646 and ( not defined $subscription->{branchcode}
2647 or $subscription->{branchcode} eq ''
2648 or $subscription->{branchcode} eq
2649 C4::Context->userenv->{'branch'} )
2654 if C4::Context->IsSuperLibrarian()
2656 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2657 or C4::Auth::haspermission(
2658 $userid, { serials => $permission }
2665 =head2 findSerialsByStatus
2667 @serials = findSerialsByStatus($status, $subscriptionid);
2669 Returns an array of serials matching a given status and subscription id.
2673 sub findSerialsByStatus {
2674 my ( $status, $subscriptionid ) = @_;
2675 my $dbh = C4::Context->dbh;
2676 my $query = q| SELECT * from serial
2678 AND subscriptionid = ?
2680 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2689 Koha Development Team <http://koha-community.org/>