3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw( haspermission );
34 use POSIX qw( strftime );
35 use C4::Biblio qw( GetMarcBiblio GetMarcFromKohaField ModBiblio );
36 use C4::Log qw( logaction ); # logaction
37 use C4::Serials::Frequency qw( GetSubscriptionFrequency );
38 use C4::Serials::Numberpattern;
39 use Koha::AdditionalFieldValues;
40 use Koha::DateUtils qw( dt_from_string output_pref );
42 use Koha::Subscriptions;
43 use Koha::Subscription::Histories;
44 use Koha::SharedContent;
45 use Scalar::Util qw( looks_like_number );
53 MISSING_NEVER_RECIEVED => 41,
54 MISSING_SOLD_OUT => 42,
55 MISSING_DAMAGED => 43,
63 use constant MISSING_STATUSES => (
64 MISSING, MISSING_NEVER_RECIEVED,
65 MISSING_SOLD_OUT, MISSING_DAMAGED,
69 our (@ISA, @EXPORT_OK);
74 NewSubscription ModSubscription DelSubscription
75 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
77 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
78 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
80 GetSubscriptionHistoryFromSubscriptionId
82 GetNextSeq GetSeq NewIssue GetSerials
83 GetLatestSerials ModSerialStatus GetNextDate
84 CloseSubscription ReopenSubscription
85 subscriptionCurrentlyOnOrder
86 can_claim_subscription can_edit_subscription can_show_subscription
88 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
89 GetSerialInformation AddItem2Serial
90 PrepareSerialsData GetNextExpected ModNextExpected
91 GetSubscriptionIrregularities
94 GetSuppliersWithLateIssues
95 getroutinglist delroutingmember addroutingmember
97 check_routing updateClaim
108 C4::Serials - Serials Module Functions
116 Functions for handling subscriptions, claims routing etc.
121 =head2 GetSuppliersWithLateIssues
123 $supplierlist = GetSuppliersWithLateIssues()
125 this function get all suppliers with late issues.
128 an array_ref of suppliers each entry is a hash_ref containing id and name
129 the array is in name order
133 sub GetSuppliersWithLateIssues {
134 my $dbh = C4::Context->dbh;
135 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
137 SELECT DISTINCT id, name
139 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
140 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
143 (planneddate < now() AND serial.status=1)
144 OR serial.STATUS IN ( $statuses )
146 AND subscription.closed = 0
148 return $dbh->selectall_arrayref($query, { Slice => {} });
151 =head2 GetSubscriptionHistoryFromSubscriptionId
153 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
155 This function returns the subscription history as a hashref
159 sub GetSubscriptionHistoryFromSubscriptionId {
160 my ($subscriptionid) = @_;
162 return unless $subscriptionid;
164 my $dbh = C4::Context->dbh;
167 FROM subscriptionhistory
168 WHERE subscriptionid = ?
170 my $sth = $dbh->prepare($query);
171 $sth->execute($subscriptionid);
172 my $results = $sth->fetchrow_hashref;
178 =head2 GetSerialInformation
180 $data = GetSerialInformation($serialid);
181 returns a hash_ref containing :
182 items : items marcrecord (can be an array)
184 subscription table field
185 + information about subscription expiration
189 sub GetSerialInformation {
191 my $dbh = C4::Context->dbh;
193 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
194 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
197 my $rq = $dbh->prepare($query);
198 $rq->execute($serialid);
199 my $data = $rq->fetchrow_hashref;
201 # create item information if we have serialsadditems for this subscription
202 if ( $data->{'serialsadditems'} ) {
203 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
204 $queryitem->execute($serialid);
205 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
207 if ( scalar(@$itemnumbers) > 0 ) {
208 foreach my $itemnum (@$itemnumbers) {
210 #It is ASSUMED that GetMarcItem ALWAYS WORK...
211 #Maybe GetMarcItem should return values on failure
212 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
213 $itemprocessed->{'itemnumber'} = $itemnum->[0];
214 $itemprocessed->{'itemid'} = $itemnum->[0];
215 $itemprocessed->{'serialid'} = $serialid;
216 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
217 push @{ $data->{'items'} }, $itemprocessed;
220 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
221 $itemprocessed->{'itemid'} = "N$serialid";
222 $itemprocessed->{'serialid'} = $serialid;
223 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
224 $itemprocessed->{'countitems'} = 0;
225 push @{ $data->{'items'} }, $itemprocessed;
228 $data->{ "status" . $data->{'serstatus'} } = 1;
229 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
230 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
231 $data->{cannotedit} = not can_edit_subscription( $data );
235 =head2 AddItem2Serial
237 $rows = AddItem2Serial($serialid,$itemnumber);
238 Adds an itemnumber to Serial record
239 returns the number of rows affected
244 my ( $serialid, $itemnumber ) = @_;
246 return unless ($serialid and $itemnumber);
248 my $dbh = C4::Context->dbh;
249 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
250 $rq->execute( $serialid, $itemnumber );
254 =head2 GetSubscription
256 $subs = GetSubscription($subscriptionid)
257 this function returns the subscription which has $subscriptionid as id.
259 a hashref. This hash contains
260 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
264 sub GetSubscription {
265 my ($subscriptionid) = @_;
266 my $dbh = C4::Context->dbh;
268 SELECT subscription.*,
269 subscriptionhistory.*,
270 aqbooksellers.name AS aqbooksellername,
271 biblio.title AS bibliotitle,
272 subscription.biblionumber as bibnum
274 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
275 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
276 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
277 WHERE subscription.subscriptionid = ?
280 my $sth = $dbh->prepare($query);
281 $sth->execute($subscriptionid);
282 my $subscription = $sth->fetchrow_hashref;
284 return unless $subscription;
286 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
288 if ( my $mana_id = $subscription->{mana_id} ) {
289 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
290 'subscription', $mana_id, {usecomments => 1});
291 $subscription->{comments} = $mana_subscription->{data}->{comments};
294 return $subscription;
297 =head2 GetFullSubscription
299 $array_ref = GetFullSubscription($subscriptionid)
300 this function reads the serial table.
304 sub GetFullSubscription {
305 my ($subscriptionid) = @_;
307 return unless ($subscriptionid);
309 my $dbh = C4::Context->dbh;
311 SELECT serial.serialid,
314 serial.publisheddate,
315 serial.publisheddatetext,
317 serial.notes as notes,
318 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
319 aqbooksellers.name as aqbooksellername,
320 biblio.title as bibliotitle,
321 subscription.branchcode AS branchcode,
322 subscription.subscriptionid AS subscriptionid
324 LEFT JOIN subscription ON
325 (serial.subscriptionid=subscription.subscriptionid )
326 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
327 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
328 WHERE serial.subscriptionid = ?
330 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
331 serial.subscriptionid
333 my $sth = $dbh->prepare($query);
334 $sth->execute($subscriptionid);
335 my $subscriptions = $sth->fetchall_arrayref( {} );
336 if (scalar @$subscriptions) {
337 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
338 for my $subscription ( @$subscriptions ) {
339 $subscription->{cannotedit} = $cannotedit;
343 return $subscriptions;
346 =head2 PrepareSerialsData
348 $array_ref = PrepareSerialsData($serialinfomation)
349 where serialinformation is a hashref array
353 sub PrepareSerialsData {
356 return unless ($lines);
363 my $previousnote = "";
365 foreach my $subs (@{$lines}) {
366 $subs->{ "status" . $subs->{'status'} } = 1;
367 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
368 $subs->{"checked"} = 1;
371 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
372 $year = $subs->{'year'};
376 if ( $tmpresults{$year} ) {
377 push @{ $tmpresults{$year}->{'serials'} }, $subs;
379 $tmpresults{$year} = {
381 'aqbooksellername' => $subs->{'aqbooksellername'},
382 'bibliotitle' => $subs->{'bibliotitle'},
383 'serials' => [$subs],
388 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
389 push @res, $tmpresults{$key};
394 =head2 GetSubscriptionsFromBiblionumber
396 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
397 this function get the subscription list. it reads the subscription table.
399 reference to an array of subscriptions which have the biblionumber given on input arg.
400 each element of this array is a hashref containing
401 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
405 sub GetSubscriptionsFromBiblionumber {
406 my ($biblionumber) = @_;
408 return unless ($biblionumber);
410 my $dbh = C4::Context->dbh;
412 SELECT subscription.*,
414 subscriptionhistory.*,
415 aqbooksellers.name AS aqbooksellername,
416 biblio.title AS bibliotitle
418 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
419 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
420 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
421 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
422 WHERE subscription.biblionumber = ?
424 my $sth = $dbh->prepare($query);
425 $sth->execute($biblionumber);
427 while ( my $subs = $sth->fetchrow_hashref ) {
428 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
429 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
430 if ( defined $subs->{histenddate} ) {
431 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
433 $subs->{histenddate} = "";
435 $subs->{opacnote} //= "";
436 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
437 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
438 $subs->{ "status" . $subs->{'status'} } = 1;
440 if (not defined $subs->{enddate} ) {
441 $subs->{enddate} = '';
443 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
445 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
446 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
447 $subs->{cannotedit} = not can_edit_subscription( $subs );
453 =head2 GetFullSubscriptionsFromBiblionumber
455 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
456 this function reads the serial table.
460 sub GetFullSubscriptionsFromBiblionumber {
461 my ($biblionumber) = @_;
462 my $dbh = C4::Context->dbh;
464 SELECT serial.serialid,
467 serial.publisheddate,
468 serial.publisheddatetext,
470 serial.notes as notes,
471 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
472 biblio.title as bibliotitle,
473 subscription.branchcode AS branchcode,
474 subscription.subscriptionid AS subscriptionid,
475 subscription.location AS location
477 LEFT JOIN subscription ON
478 (serial.subscriptionid=subscription.subscriptionid)
479 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
480 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
481 WHERE subscription.biblionumber = ?
483 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
484 serial.subscriptionid
486 my $sth = $dbh->prepare($query);
487 $sth->execute($biblionumber);
488 my $subscriptions = $sth->fetchall_arrayref( {} );
489 if (scalar @$subscriptions) {
490 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
491 for my $subscription ( @$subscriptions ) {
492 $subscription->{cannotedit} = $cannotedit;
496 return $subscriptions;
499 =head2 SearchSubscriptions
501 @results = SearchSubscriptions($args);
503 This function returns a list of hashrefs, one for each subscription
504 that meets the conditions specified by the $args hashref.
506 The valid search fields are:
520 The expiration_date search field is special; it specifies the maximum
521 subscription expiration date.
525 sub SearchSubscriptions {
528 my $additional_fields = $args->{additional_fields} // [];
529 my $matching_record_ids_for_additional_fields = [];
530 if ( @$additional_fields ) {
531 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
533 return () unless @subscriptions;
535 $matching_record_ids_for_additional_fields = [ map {
542 subscription.notes AS publicnotes,
543 subscriptionhistory.*,
545 biblio.notes AS biblionotes,
549 aqbooksellers.name AS vendorname,
552 LEFT JOIN subscriptionhistory USING(subscriptionid)
553 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
554 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
555 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
557 $query .= q| WHERE 1|;
560 if( $args->{biblionumber} ) {
561 push @where_strs, "biblio.biblionumber = ?";
562 push @where_args, $args->{biblionumber};
565 if( $args->{title} ){
566 my @words = split / /, $args->{title};
568 foreach my $word (@words) {
569 push @strs, "biblio.title LIKE ?";
570 push @args, "%$word%";
573 push @where_strs, '(' . join (' AND ', @strs) . ')';
574 push @where_args, @args;
578 push @where_strs, "biblioitems.issn LIKE ?";
579 push @where_args, "%$args->{issn}%";
582 push @where_strs, "biblioitems.ean LIKE ?";
583 push @where_args, "%$args->{ean}%";
585 if ( $args->{callnumber} ) {
586 push @where_strs, "subscription.callnumber LIKE ?";
587 push @where_args, "%$args->{callnumber}%";
589 if( $args->{publisher} ){
590 push @where_strs, "biblioitems.publishercode LIKE ?";
591 push @where_args, "%$args->{publisher}%";
593 if( $args->{bookseller} ){
594 push @where_strs, "aqbooksellers.name LIKE ?";
595 push @where_args, "%$args->{bookseller}%";
597 if( $args->{branch} ){
598 push @where_strs, "subscription.branchcode = ?";
599 push @where_args, "$args->{branch}";
601 if ( $args->{location} ) {
602 push @where_strs, "subscription.location = ?";
603 push @where_args, "$args->{location}";
605 if ( $args->{expiration_date} ) {
606 push @where_strs, "subscription.enddate <= ?";
607 push @where_args, "$args->{expiration_date}";
609 if( defined $args->{closed} ){
610 push @where_strs, "subscription.closed = ?";
611 push @where_args, "$args->{closed}";
615 $query .= ' AND ' . join(' AND ', @where_strs);
617 if ( @$additional_fields ) {
618 $query .= ' AND subscriptionid IN ('
619 . join( ', ', @$matching_record_ids_for_additional_fields )
623 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
625 my $dbh = C4::Context->dbh;
626 my $sth = $dbh->prepare($query);
627 $sth->execute(@where_args);
628 my $results = $sth->fetchall_arrayref( {} );
630 for my $subscription ( @$results ) {
631 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
632 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
634 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
635 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
636 $subscription_object->additional_field_values->as_list };
646 ($totalissues,@serials) = GetSerials($subscriptionid);
647 this function gets every serial not arrived for a given subscription
648 as well as the number of issues registered in the database (all types)
649 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
651 FIXME: We should return \@serials.
656 my ( $subscriptionid, $count ) = @_;
658 return unless $subscriptionid;
660 my $dbh = C4::Context->dbh;
662 # status = 2 is "arrived"
664 $count = 5 unless ($count);
666 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
667 my $query = "SELECT serialid,serialseq, status, publisheddate,
668 publisheddatetext, planneddate,notes, routingnotes
670 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
671 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
672 my $sth = $dbh->prepare($query);
673 $sth->execute($subscriptionid);
675 while ( my $line = $sth->fetchrow_hashref ) {
676 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
677 for my $datefield ( qw( planneddate publisheddate) ) {
678 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
679 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
681 $line->{$datefield} = q{};
684 push @serials, $line;
687 # OK, now add the last 5 issues arrives/missing
688 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
689 publisheddatetext, notes, routingnotes
691 WHERE subscriptionid = ?
692 AND status IN ( $statuses )
693 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
695 $sth = $dbh->prepare($query);
696 $sth->execute($subscriptionid);
697 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
699 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
700 for my $datefield ( qw( planneddate publisheddate) ) {
701 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
702 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
704 $line->{$datefield} = q{};
708 push @serials, $line;
711 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
712 $sth = $dbh->prepare($query);
713 $sth->execute($subscriptionid);
714 my ($totalissues) = $sth->fetchrow;
715 return ( $totalissues, @serials );
720 @serials = GetSerials2($subscriptionid,$statuses);
721 this function returns every serial waited for a given subscription
722 as well as the number of issues registered in the database (all types)
723 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
725 $statuses is an arrayref of statuses and is mandatory.
730 my ( $subscription, $statuses ) = @_;
732 return unless ($subscription and @$statuses);
734 my $dbh = C4::Context->dbh;
736 SELECT serialid,serialseq, status, planneddate, publisheddate,
737 publisheddatetext, notes, routingnotes
739 WHERE subscriptionid=?
741 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
743 ORDER BY publisheddate,serialid DESC
745 my $sth = $dbh->prepare($query);
746 $sth->execute( $subscription, @$statuses );
749 while ( my $line = $sth->fetchrow_hashref ) {
750 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
751 # Format dates for display
752 for my $datefield ( qw( planneddate publisheddate ) ) {
753 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
754 $line->{$datefield} = q{};
757 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
760 push @serials, $line;
765 =head2 GetLatestSerials
767 \@serials = GetLatestSerials($subscriptionid,$limit)
768 get the $limit's latest serials arrived or missing for a given subscription
770 a ref to an array which contains all of the latest serials stored into a hash.
774 sub GetLatestSerials {
775 my ( $subscriptionid, $limit ) = @_;
777 return unless ($subscriptionid and $limit);
779 my $dbh = C4::Context->dbh;
781 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
782 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
784 WHERE subscriptionid = ?
785 AND status IN ($statuses)
786 ORDER BY publisheddate DESC LIMIT 0,$limit
788 my $sth = $dbh->prepare($strsth);
789 $sth->execute($subscriptionid);
791 while ( my $line = $sth->fetchrow_hashref ) {
792 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
793 push @serials, $line;
799 =head2 GetPreviousSerialid
801 $serialid = GetPreviousSerialid($subscriptionid, $nth)
802 get the $nth's previous serial for the given subscriptionid
808 sub GetPreviousSerialid {
809 my ( $subscriptionid, $nth ) = @_;
811 my $dbh = C4::Context->dbh;
815 my $strsth = "SELECT serialid
817 WHERE subscriptionid = ?
819 ORDER BY serialid DESC LIMIT $nth,1
821 my $sth = $dbh->prepare($strsth);
822 $sth->execute($subscriptionid);
824 my $line = $sth->fetchrow_hashref;
825 $return = $line->{'serialid'} if ($line);
833 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
834 $newinnerloop1, $newinnerloop2, $newinnerloop3
835 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
837 $subscription is a hashref containing all the attributes of the table
839 $pattern is a hashref containing all the attributes of the table
840 'subscription_numberpatterns'.
841 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
842 $planneddate is a date string in iso format.
843 This function get the next issue for the subscription given on input arg
848 my ($subscription, $pattern, $frequency, $planneddate) = @_;
850 return unless ($subscription and $pattern);
852 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
853 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
856 if ($subscription->{'skip_serialseq'}) {
857 my @irreg = split /;/, $subscription->{'irregularity'};
859 my $irregularities = {};
860 $irregularities->{$_} = 1 foreach(@irreg);
861 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
862 while($irregularities->{$issueno}) {
869 my $numberingmethod = $pattern->{numberingmethod};
871 if ($numberingmethod) {
872 $calculated = $numberingmethod;
873 my $locale = $subscription->{locale};
874 $newlastvalue1 = $subscription->{lastvalue1} || 0;
875 $newlastvalue2 = $subscription->{lastvalue2} || 0;
876 $newlastvalue3 = $subscription->{lastvalue3} || 0;
877 $newinnerloop1 = $subscription->{innerloop1} || 0;
878 $newinnerloop2 = $subscription->{innerloop2} || 0;
879 $newinnerloop3 = $subscription->{innerloop3} || 0;
882 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
885 for(my $i = 0; $i < $count; $i++) {
887 # check if we have to increase the new value.
889 if ($newinnerloop1 >= $pattern->{every1}) {
891 $newlastvalue1 += $pattern->{add1};
893 # reset counter if needed.
894 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
897 # check if we have to increase the new value.
899 if ($newinnerloop2 >= $pattern->{every2}) {
901 $newlastvalue2 += $pattern->{add2};
903 # reset counter if needed.
904 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
907 # check if we have to increase the new value.
909 if ($newinnerloop3 >= $pattern->{every3}) {
911 $newlastvalue3 += $pattern->{add3};
913 # reset counter if needed.
914 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
918 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
919 $calculated =~ s/\{X\}/$newlastvalue1string/g;
922 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
923 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
926 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
927 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
932 $newlastvalue1, $newlastvalue2, $newlastvalue3,
933 $newinnerloop1, $newinnerloop2, $newinnerloop3);
938 $calculated = GetSeq($subscription, $pattern)
939 $subscription is a hashref containing all the attributes of the table 'subscription'
940 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
941 this function transforms {X},{Y},{Z} to 150,0,0 for example.
943 the sequence in string format
948 my ($subscription, $pattern) = @_;
950 return unless ($subscription and $pattern);
952 my $locale = $subscription->{locale};
954 my $calculated = $pattern->{numberingmethod};
956 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
957 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
958 $calculated =~ s/\{X\}/$newlastvalue1/g;
960 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
961 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
962 $calculated =~ s/\{Y\}/$newlastvalue2/g;
964 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
965 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
966 $calculated =~ s/\{Z\}/$newlastvalue3/g;
970 =head2 GetExpirationDate
972 $enddate = GetExpirationDate($subscriptionid, [$startdate])
974 this function return the next expiration date for a subscription given on input args.
981 sub GetExpirationDate {
982 my ( $subscriptionid, $startdate ) = @_;
984 return unless ($subscriptionid);
986 my $dbh = C4::Context->dbh;
987 my $subscription = GetSubscription($subscriptionid);
990 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
991 $enddate = $startdate || $subscription->{startdate};
992 my @date = split( /-/, $enddate );
994 return if ( scalar(@date) != 3 || not check_date(@date) );
996 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
997 if ( $frequency and $frequency->{unit} ) {
1000 if ( my $length = $subscription->{numberlength} ) {
1002 #calculate the date of the last issue.
1003 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1004 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1006 } elsif ( $subscription->{monthlength} ) {
1007 if ( $$subscription{startdate} ) {
1008 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1009 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1011 } elsif ( $subscription->{weeklength} ) {
1012 if ( $$subscription{startdate} ) {
1013 my @date = split( /-/, $subscription->{startdate} );
1014 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1015 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1018 $enddate = $subscription->{enddate};
1022 return $subscription->{enddate};
1026 =head2 CountSubscriptionFromBiblionumber
1028 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1029 this returns a count of the subscriptions for a given biblionumber
1031 the number of subscriptions
1035 sub CountSubscriptionFromBiblionumber {
1036 my ($biblionumber) = @_;
1038 return unless ($biblionumber);
1040 my $dbh = C4::Context->dbh;
1041 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1042 my $sth = $dbh->prepare($query);
1043 $sth->execute($biblionumber);
1044 my $subscriptionsnumber = $sth->fetchrow;
1045 return $subscriptionsnumber;
1048 =head2 ModSubscriptionHistory
1050 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1052 this function modifies the history of a subscription. Put your new values on input arg.
1053 returns the number of rows affected
1057 sub ModSubscriptionHistory {
1058 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1060 return unless ($subscriptionid);
1062 my $dbh = C4::Context->dbh;
1063 my $query = "UPDATE subscriptionhistory
1064 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1065 WHERE subscriptionid=?
1067 my $sth = $dbh->prepare($query);
1068 $receivedlist =~ s/^; // if $receivedlist;
1069 $missinglist =~ s/^; // if $missinglist;
1070 $opacnote =~ s/^; // if $opacnote;
1071 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1075 =head2 ModSerialStatus
1077 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1078 $publisheddatetext, $status, $notes);
1080 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1081 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1085 sub ModSerialStatus {
1086 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1087 $status, $notes) = @_;
1089 return unless ($serialid);
1091 #It is a usual serial
1092 # 1st, get previous status :
1093 my $dbh = C4::Context->dbh;
1094 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1095 FROM serial, subscription
1096 WHERE serial.subscriptionid=subscription.subscriptionid
1098 my $sth = $dbh->prepare($query);
1099 $sth->execute($serialid);
1100 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1101 my $frequency = GetSubscriptionFrequency($periodicity);
1103 # change status & update subscriptionhistory
1105 if ( $status == DELETED ) {
1106 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1110 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1111 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1114 $sth = $dbh->prepare($query);
1115 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1116 $planneddate, $status, $notes, $routingnotes, $serialid );
1117 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1118 $sth = $dbh->prepare($query);
1119 $sth->execute($subscriptionid);
1120 my $val = $sth->fetchrow_hashref;
1121 unless ( $val->{manualhistory} ) {
1122 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1123 $sth = $dbh->prepare($query);
1124 $sth->execute($subscriptionid);
1125 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1127 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1128 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1131 # in case serial has been previously marked as missing
1132 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1133 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1136 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1137 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1139 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1140 $sth = $dbh->prepare($query);
1141 $recievedlist =~ s/^; //;
1142 $missinglist =~ s/^; //;
1143 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1147 # create new expected entry if needed (ie : was "expected" and has changed)
1148 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1149 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1150 my $subscription = GetSubscription($subscriptionid);
1151 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1152 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1156 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1157 $newinnerloop1, $newinnerloop2, $newinnerloop3
1159 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1161 # next date (calculated from actual date & frequency parameters)
1162 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1163 my $nextpubdate = $nextpublisheddate;
1164 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1165 WHERE subscriptionid = ?";
1166 $sth = $dbh->prepare($query);
1167 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1168 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1169 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1170 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1171 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1172 require C4::Letters;
1173 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1181 # Adds or removes seqno from list when needed; returns list
1182 # Or checks and returns true when present
1184 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1186 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1188 if( !$op or $op eq 'ADD' ) {
1189 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1190 } elsif( $op eq 'REMOVE' ) {
1191 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1193 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1198 =head2 GetNextExpected
1200 $nextexpected = GetNextExpected($subscriptionid)
1202 Get the planneddate for the current expected issue of the subscription.
1208 planneddate => ISO date
1213 sub GetNextExpected {
1214 my ($subscriptionid) = @_;
1216 my $dbh = C4::Context->dbh;
1220 WHERE subscriptionid = ?
1224 my $sth = $dbh->prepare($query);
1226 # Each subscription has only one 'expected' issue.
1227 $sth->execute( $subscriptionid, EXPECTED );
1228 my $nextissue = $sth->fetchrow_hashref;
1229 if ( !$nextissue ) {
1233 WHERE subscriptionid = ?
1234 ORDER BY publisheddate DESC
1237 $sth = $dbh->prepare($query);
1238 $sth->execute($subscriptionid);
1239 $nextissue = $sth->fetchrow_hashref;
1241 foreach(qw/planneddate publisheddate/) {
1242 # or should this default to 1st Jan ???
1243 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1249 =head2 ModNextExpected
1251 ModNextExpected($subscriptionid,$date)
1253 Update the planneddate for the current expected issue of the subscription.
1254 This will modify all future prediction results.
1256 C<$date> is an ISO date.
1262 sub ModNextExpected {
1263 my ( $subscriptionid, $date ) = @_;
1264 my $dbh = C4::Context->dbh;
1266 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1267 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1269 # Each subscription has only one 'expected' issue.
1270 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1275 =head2 GetSubscriptionIrregularities
1279 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1280 get the list of irregularities for a subscription
1286 sub GetSubscriptionIrregularities {
1287 my $subscriptionid = shift;
1289 return unless $subscriptionid;
1291 my $dbh = C4::Context->dbh;
1295 WHERE subscriptionid = ?
1297 my $sth = $dbh->prepare($query);
1298 $sth->execute($subscriptionid);
1300 my ($result) = $sth->fetchrow_array;
1301 my @irreg = split /;/, $result;
1306 =head2 ModSubscription
1308 this function modifies a subscription. Put all new values on input args.
1309 returns the number of rows affected
1313 sub ModSubscription {
1315 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1316 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1317 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1318 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1319 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1320 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1321 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1322 $itemtype, $previousitemtype, $mana_id
1325 my $subscription = Koha::Subscriptions->find($subscriptionid);
1328 librarian => $auser,
1329 branchcode => $branchcode,
1330 aqbooksellerid => $aqbooksellerid,
1332 aqbudgetid => $aqbudgetid,
1333 biblionumber => $biblionumber,
1334 startdate => $startdate,
1335 periodicity => $periodicity,
1336 numberlength => $numberlength,
1337 weeklength => $weeklength,
1338 monthlength => $monthlength,
1339 lastvalue1 => $lastvalue1,
1340 innerloop1 => $innerloop1,
1341 lastvalue2 => $lastvalue2,
1342 innerloop2 => $innerloop2,
1343 lastvalue3 => $lastvalue3,
1344 innerloop3 => $innerloop3,
1348 firstacquidate => $firstacquidate,
1349 irregularity => $irregularity,
1350 numberpattern => $numberpattern,
1352 callnumber => $callnumber,
1353 manualhistory => $manualhistory,
1354 internalnotes => $internalnotes,
1355 serialsadditems => $serialsadditems,
1356 staffdisplaycount => $staffdisplaycount,
1357 opacdisplaycount => $opacdisplaycount,
1358 graceperiod => $graceperiod,
1359 location => $location,
1360 enddate => $enddate,
1361 skip_serialseq => $skip_serialseq,
1362 itemtype => $itemtype,
1363 previousitemtype => $previousitemtype,
1364 mana_id => $mana_id,
1367 # FIXME Must be $subscription->serials
1368 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1369 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1371 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1373 $subscription->discard_changes;
1374 return $subscription;
1377 =head2 NewSubscription
1379 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1380 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1381 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1382 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1383 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1384 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1385 $skip_serialseq, $itemtype, $previousitemtype);
1387 Create a new subscription with value given on input args.
1390 the id of this new subscription
1394 sub NewSubscription {
1396 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1397 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1398 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1399 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1400 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1401 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1402 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1404 my $dbh = C4::Context->dbh;
1406 my $subscription = Koha::Subscription->new(
1408 librarian => $auser,
1409 branchcode => $branchcode,
1410 aqbooksellerid => $aqbooksellerid,
1412 aqbudgetid => $aqbudgetid,
1413 biblionumber => $biblionumber,
1414 startdate => $startdate,
1415 periodicity => $periodicity,
1416 numberlength => $numberlength,
1417 weeklength => $weeklength,
1418 monthlength => $monthlength,
1419 lastvalue1 => $lastvalue1,
1420 innerloop1 => $innerloop1,
1421 lastvalue2 => $lastvalue2,
1422 innerloop2 => $innerloop2,
1423 lastvalue3 => $lastvalue3,
1424 innerloop3 => $innerloop3,
1428 firstacquidate => $firstacquidate,
1429 irregularity => $irregularity,
1430 numberpattern => $numberpattern,
1432 callnumber => $callnumber,
1433 manualhistory => $manualhistory,
1434 internalnotes => $internalnotes,
1435 serialsadditems => $serialsadditems,
1436 staffdisplaycount => $staffdisplaycount,
1437 opacdisplaycount => $opacdisplaycount,
1438 graceperiod => $graceperiod,
1439 location => $location,
1440 enddate => $enddate,
1441 skip_serialseq => $skip_serialseq,
1442 itemtype => $itemtype,
1443 previousitemtype => $previousitemtype,
1444 mana_id => $mana_id,
1447 $subscription->discard_changes;
1448 my $subscriptionid = $subscription->subscriptionid;
1449 my ( $query, $sth );
1451 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1455 WHERE subscriptionid=?
1457 $sth = $dbh->prepare($query);
1458 $sth->execute( $enddate, $subscriptionid );
1461 # then create the 1st expected number
1463 INSERT INTO subscriptionhistory
1464 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1465 VALUES (?,?,?, '', '')
1467 $sth = $dbh->prepare($query);
1468 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1470 # reread subscription to get a hash (for calculation of the 1st issue number)
1471 $subscription = GetSubscription($subscriptionid); # We should not do that
1472 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1474 # calculate issue number
1475 my $serialseq = GetSeq($subscription, $pattern) || q{};
1479 serialseq => $serialseq,
1480 serialseq_x => $subscription->{'lastvalue1'},
1481 serialseq_y => $subscription->{'lastvalue2'},
1482 serialseq_z => $subscription->{'lastvalue3'},
1483 subscriptionid => $subscriptionid,
1484 biblionumber => $biblionumber,
1486 planneddate => $firstacquidate,
1487 publisheddate => $firstacquidate,
1491 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1493 #set serial flag on biblio if not already set.
1494 my $biblio = Koha::Biblios->find( $biblionumber );
1495 if ( $biblio and !$biblio->serial ) {
1496 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1497 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1499 eval { $record->field($tag)->update( $subf => 1 ); };
1501 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1503 return $subscriptionid;
1506 =head2 GetSubscriptionLength
1508 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1510 This function calculates the subscription length.
1514 sub GetSubscriptionLength {
1515 my ($subtype, $length) = @_;
1517 return unless looks_like_number($length);
1521 $subtype eq 'issues' ? $length : 0,
1522 $subtype eq 'weeks' ? $length : 0,
1523 $subtype eq 'months' ? $length : 0,
1528 =head2 ReNewSubscription
1530 ReNewSubscription($params);
1532 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1534 this function renew a subscription with values given on input args.
1538 sub ReNewSubscription {
1539 my ( $params ) = @_;
1540 my $subscriptionid = $params->{subscriptionid};
1541 my $user = $params->{user};
1542 my $startdate = $params->{startdate};
1543 my $numberlength = $params->{numberlength};
1544 my $weeklength = $params->{weeklength};
1545 my $monthlength = $params->{monthlength};
1546 my $note = $params->{note};
1547 my $branchcode = $params->{branchcode};
1549 my $dbh = C4::Context->dbh;
1550 my $subscription = GetSubscription($subscriptionid);
1554 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1555 WHERE biblio.biblionumber=?
1557 my $sth = $dbh->prepare($query);
1558 $sth->execute( $subscription->{biblionumber} );
1559 my $biblio = $sth->fetchrow_hashref;
1561 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1562 require C4::Suggestions;
1563 C4::Suggestions::NewSuggestion(
1564 { 'suggestedby' => $user,
1565 'title' => $subscription->{bibliotitle},
1566 'author' => $biblio->{author},
1567 'publishercode' => $biblio->{publishercode},
1569 'biblionumber' => $subscription->{biblionumber},
1570 'branchcode' => $branchcode,
1575 $numberlength ||= 0; # Should not we raise an exception instead?
1578 # renew subscription
1581 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1582 WHERE subscriptionid=?
1584 $sth = $dbh->prepare($query);
1585 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1586 my $enddate = GetExpirationDate($subscriptionid);
1590 WHERE subscriptionid=?
1592 $sth = $dbh->prepare($query);
1593 $sth->execute( $enddate, $subscriptionid );
1595 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1601 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1603 Create a new issue stored on the database.
1604 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1605 returns the serial id
1610 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1611 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1612 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1614 return unless ($subscriptionid);
1616 my $schema = Koha::Database->new()->schema();
1618 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1620 my $serial = Koha::Serial->new(
1622 serialseq => $serialseq,
1623 serialseq_x => $subscription->lastvalue1(),
1624 serialseq_y => $subscription->lastvalue2(),
1625 serialseq_z => $subscription->lastvalue3(),
1626 subscriptionid => $subscriptionid,
1627 biblionumber => $biblionumber,
1629 planneddate => $planneddate,
1630 publisheddate => $publisheddate,
1631 publisheddatetext => $publisheddatetext,
1633 routingnotes => $routingnotes
1637 my $serialid = $serial->id();
1639 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1640 my $missinglist = $subscription_history->missinglist();
1641 my $recievedlist = $subscription_history->recievedlist();
1643 if ( $status == ARRIVED ) {
1644 ### TODO Add a feature that improves recognition and description.
1645 ### As such count (serialseq) i.e. : N18,2(N19),N20
1646 ### Would use substr and index But be careful to previous presence of ()
1647 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1649 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1650 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1653 $recievedlist =~ s/^; //;
1654 $missinglist =~ s/^; //;
1656 $subscription_history->recievedlist($recievedlist);
1657 $subscription_history->missinglist($missinglist);
1658 $subscription_history->store();
1663 =head2 HasSubscriptionStrictlyExpired
1665 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1667 the subscription has stricly expired when today > the end subscription date
1670 1 if true, 0 if false, -1 if the expiration date is not set.
1674 sub HasSubscriptionStrictlyExpired {
1676 # Getting end of subscription date
1677 my ($subscriptionid) = @_;
1679 return unless ($subscriptionid);
1681 my $dbh = C4::Context->dbh;
1682 my $subscription = GetSubscription($subscriptionid);
1683 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1685 # If the expiration date is set
1686 if ( $expirationdate != 0 ) {
1687 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1689 # Getting today's date
1690 my ( $nowyear, $nowmonth, $nowday ) = Today();
1692 # if today's date > expiration date, then the subscription has stricly expired
1693 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1700 # There are some cases where the expiration date is not set
1701 # As we can't determine if the subscription has expired on a date-basis,
1707 =head2 HasSubscriptionExpired
1709 $has_expired = HasSubscriptionExpired($subscriptionid)
1711 the subscription has expired when the next issue to arrive is out of subscription limit.
1714 0 if the subscription has not expired
1715 1 if the subscription has expired
1716 2 if has subscription does not have a valid expiration date set
1720 sub HasSubscriptionExpired {
1721 my ($subscriptionid) = @_;
1723 return unless ($subscriptionid);
1725 my $dbh = C4::Context->dbh;
1726 my $subscription = GetSubscription($subscriptionid);
1727 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1728 if ( $frequency and $frequency->{unit} ) {
1729 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1730 if (!defined $expirationdate) {
1731 $expirationdate = q{};
1734 SELECT max(planneddate)
1736 WHERE subscriptionid=?
1738 my $sth = $dbh->prepare($query);
1739 $sth->execute($subscriptionid);
1740 my ($res) = $sth->fetchrow;
1741 if (!$res || $res=~m/^0000/) {
1744 my @res = split( /-/, $res );
1745 my @endofsubscriptiondate = split( /-/, $expirationdate );
1746 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1748 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1753 if ( $subscription->{'numberlength'} ) {
1754 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1755 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1761 return 0; # Notice that you'll never get here.
1764 =head2 DelSubscription
1766 DelSubscription($subscriptionid)
1767 this function deletes subscription which has $subscriptionid as id.
1771 sub DelSubscription {
1772 my ($subscriptionid) = @_;
1773 my $dbh = C4::Context->dbh;
1774 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1776 Koha::AdditionalFieldValues->search({
1777 'field.tablename' => 'subscription',
1778 'me.record_id' => $subscriptionid,
1779 }, { join => 'field' })->delete;
1781 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1786 DelIssue($serialseq,$subscriptionid)
1787 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1789 returns the number of rows affected
1794 my ($dataissue) = @_;
1795 my $dbh = C4::Context->dbh;
1796 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1801 AND subscriptionid= ?
1803 my $mainsth = $dbh->prepare($query);
1804 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1806 #Delete element from subscription history
1807 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1808 my $sth = $dbh->prepare($query);
1809 $sth->execute( $dataissue->{'subscriptionid'} );
1810 my $val = $sth->fetchrow_hashref;
1811 unless ( $val->{manualhistory} ) {
1813 SELECT * FROM subscriptionhistory
1814 WHERE subscriptionid= ?
1816 my $sth = $dbh->prepare($query);
1817 $sth->execute( $dataissue->{'subscriptionid'} );
1818 my $data = $sth->fetchrow_hashref;
1819 my $serialseq = $dataissue->{'serialseq'};
1820 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1821 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1822 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1823 $sth = $dbh->prepare($strsth);
1824 $sth->execute( $dataissue->{'subscriptionid'} );
1827 return $mainsth->rows;
1830 =head2 GetLateOrMissingIssues
1832 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1834 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1837 the issuelist as an array of hash refs. Each element of this array contains
1838 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1842 sub GetLateOrMissingIssues {
1843 my ( $supplierid, $serialid, $order ) = @_;
1845 return unless ( $supplierid or $serialid );
1847 my $dbh = C4::Context->dbh;
1852 $byserial = "and serialid = " . $serialid;
1855 $order .= ", title";
1859 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1861 $sth = $dbh->prepare(
1863 serialid, aqbooksellerid, name,
1864 biblio.title, biblioitems.issn, planneddate, serialseq,
1865 serial.status, serial.subscriptionid, claimdate, claims_count,
1866 subscription.branchcode
1868 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1869 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1870 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1871 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1872 WHERE subscription.subscriptionid = serial.subscriptionid
1873 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1874 AND subscription.aqbooksellerid=$supplierid
1879 $sth = $dbh->prepare(
1881 serialid, aqbooksellerid, name,
1882 biblio.title, planneddate, serialseq,
1883 serial.status, serial.subscriptionid, claimdate, claims_count,
1884 subscription.branchcode
1886 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1887 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1888 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1889 WHERE subscription.subscriptionid = serial.subscriptionid
1890 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1895 $sth->execute( EXPECTED, LATE, CLAIMED );
1897 while ( my $line = $sth->fetchrow_hashref ) {
1899 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1900 $line->{planneddateISO} = $line->{planneddate};
1901 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1903 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1904 $line->{claimdateISO} = $line->{claimdate};
1905 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1907 $line->{"status".$line->{status}} = 1;
1909 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1910 $line->{additional_fields} = { map { $_->field->name => $_->value }
1911 $subscription_object->additional_field_values->as_list };
1913 push @issuelist, $line;
1920 &updateClaim($serialid)
1922 this function updates the time when a claim is issued for late/missing items
1924 called from claims.pl file
1929 my ($serialids) = @_;
1930 return unless $serialids;
1931 unless ( ref $serialids ) {
1932 $serialids = [ $serialids ];
1934 my $dbh = C4::Context->dbh;
1937 SET claimdate = NOW(),
1938 claims_count = claims_count + 1,
1940 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1941 {}, CLAIMED, @$serialids );
1944 =head2 check_routing
1946 $result = &check_routing($subscriptionid)
1948 this function checks to see if a serial has a routing list and returns the count of routingid
1949 used to show either an 'add' or 'edit' link
1954 my ($subscriptionid) = @_;
1956 return unless ($subscriptionid);
1958 my $dbh = C4::Context->dbh;
1959 my $sth = $dbh->prepare(
1960 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1961 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1962 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1965 $sth->execute($subscriptionid);
1966 my $line = $sth->fetchrow_hashref;
1967 my $result = $line->{'routingids'};
1971 =head2 addroutingmember
1973 addroutingmember($borrowernumber,$subscriptionid)
1975 this function takes a borrowernumber and subscriptionid and adds the member to the
1976 routing list for that serial subscription and gives them a rank on the list
1977 of either 1 or highest current rank + 1
1981 sub addroutingmember {
1982 my ( $borrowernumber, $subscriptionid ) = @_;
1984 return unless ($borrowernumber and $subscriptionid);
1987 my $dbh = C4::Context->dbh;
1988 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1989 $sth->execute($subscriptionid);
1990 while ( my $line = $sth->fetchrow_hashref ) {
1991 if ( $line->{'rank'} > 0 ) {
1992 $rank = $line->{'rank'} + 1;
1997 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1998 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2001 =head2 reorder_members
2003 reorder_members($subscriptionid,$routingid,$rank)
2005 this function is used to reorder the routing list
2007 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2008 - it gets all members on list puts their routingid's into an array
2009 - removes the one in the array that is $routingid
2010 - then reinjects $routingid at point indicated by $rank
2011 - then update the database with the routingids in the new order
2015 sub reorder_members {
2016 my ( $subscriptionid, $routingid, $rank ) = @_;
2017 my $dbh = C4::Context->dbh;
2018 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2019 $sth->execute($subscriptionid);
2021 while ( my $line = $sth->fetchrow_hashref ) {
2022 push( @result, $line->{'routingid'} );
2025 # To find the matching index
2027 my $key = -1; # to allow for 0 being a valid response
2028 for ( $i = 0 ; $i < @result ; $i++ ) {
2029 if ( $routingid == $result[$i] ) {
2030 $key = $i; # save the index
2035 # if index exists in array then move it to new position
2036 if ( $key > -1 && $rank > 0 ) {
2037 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2038 my $moving_item = splice( @result, $key, 1 );
2039 splice( @result, $new_rank, 0, $moving_item );
2041 for ( my $j = 0 ; $j < @result ; $j++ ) {
2042 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2048 =head2 delroutingmember
2050 delroutingmember($routingid,$subscriptionid)
2052 this function either deletes one member from routing list if $routingid exists otherwise
2053 deletes all members from the routing list
2057 sub delroutingmember {
2059 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2060 my ( $routingid, $subscriptionid ) = @_;
2061 my $dbh = C4::Context->dbh;
2063 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2064 $sth->execute($routingid);
2065 reorder_members( $subscriptionid, $routingid );
2067 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2068 $sth->execute($subscriptionid);
2073 =head2 getroutinglist
2075 @routinglist = getroutinglist($subscriptionid)
2077 this gets the info from the subscriptionroutinglist for $subscriptionid
2080 the routinglist as an array. Each element of the array contains a hash_ref containing
2081 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2085 sub getroutinglist {
2086 my ($subscriptionid) = @_;
2087 my $dbh = C4::Context->dbh;
2088 my $sth = $dbh->prepare(
2089 'SELECT routingid, borrowernumber, ranking, biblionumber
2091 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2092 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2094 $sth->execute($subscriptionid);
2095 my $routinglist = $sth->fetchall_arrayref({});
2096 return @{$routinglist};
2099 =head2 countissuesfrom
2101 $result = countissuesfrom($subscriptionid,$startdate)
2103 Returns a count of serial rows matching the given subsctiptionid
2104 with published date greater than startdate
2108 sub countissuesfrom {
2109 my ( $subscriptionid, $startdate ) = @_;
2110 my $dbh = C4::Context->dbh;
2114 WHERE subscriptionid=?
2115 AND serial.publisheddate>?
2117 my $sth = $dbh->prepare($query);
2118 $sth->execute( $subscriptionid, $startdate );
2119 my ($countreceived) = $sth->fetchrow;
2120 return $countreceived;
2125 $result = CountIssues($subscriptionid)
2127 Returns a count of serial rows matching the given subsctiptionid
2132 my ($subscriptionid) = @_;
2133 my $dbh = C4::Context->dbh;
2137 WHERE subscriptionid=?
2139 my $sth = $dbh->prepare($query);
2140 $sth->execute($subscriptionid);
2141 my ($countreceived) = $sth->fetchrow;
2142 return $countreceived;
2147 $result = HasItems($subscriptionid)
2149 returns a count of items from serial matching the subscriptionid
2154 my ($subscriptionid) = @_;
2155 my $dbh = C4::Context->dbh;
2157 SELECT COUNT(serialitems.itemnumber)
2159 LEFT JOIN serialitems USING(serialid)
2160 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2162 my $sth=$dbh->prepare($query);
2163 $sth->execute($subscriptionid);
2164 my ($countitems)=$sth->fetchrow_array();
2168 =head2 abouttoexpire
2170 $result = abouttoexpire($subscriptionid)
2172 this function alerts you to the penultimate issue for a serial subscription
2174 returns 1 - if this is the penultimate issue
2180 my ($subscriptionid) = @_;
2181 my $dbh = C4::Context->dbh;
2182 my $subscription = GetSubscription($subscriptionid);
2183 my $per = $subscription->{'periodicity'};
2184 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2185 if ($frequency and $frequency->{unit}){
2187 my $expirationdate = GetExpirationDate($subscriptionid);
2189 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2190 my $nextdate = GetNextDate($subscription, $res, $frequency);
2192 # only compare dates if both dates exist.
2193 if ($nextdate and $expirationdate) {
2194 if(Date::Calc::Delta_Days(
2195 split( /-/, $nextdate ),
2196 split( /-/, $expirationdate )
2202 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2203 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2209 =head2 GetFictiveIssueNumber
2211 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2213 Get the position of the issue published at $publisheddate, considering the
2214 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2215 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2216 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2217 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2218 depending on how many rows are in serial table.
2219 The issue number calculation is based on subscription frequency, first acquisition
2220 date, and $publisheddate.
2222 Returns undef when called for irregular frequencies.
2224 The routine is used to skip irregularities when calculating the next issue
2225 date (in GetNextDate) or the next issue number (in GetNextSeq).
2229 sub GetFictiveIssueNumber {
2230 my ($subscription, $publisheddate, $frequency) = @_;
2232 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2236 my ( $year, $month, $day ) = split /-/, $publisheddate;
2237 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2238 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2240 if( $frequency->{'unitsperissue'} == 1 ) {
2241 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2242 } else { # issuesperunit == 1
2243 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2249 my ( $date1, $date2, $unit ) = @_;
2250 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2252 if( $unit eq 'day' ) {
2253 return Delta_Days( @$date1, @$date2 );
2254 } elsif( $unit eq 'week' ) {
2255 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2258 # In case of months or years, this is a wrapper around N_Delta_YMD.
2259 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2260 # while we expect 1 month.
2261 my @delta = N_Delta_YMD( @$date1, @$date2 );
2262 if( $delta[2] > 27 ) {
2263 # Check if we could add a month
2264 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2265 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2269 if( $delta[1] >= 12 ) {
2273 # if unit is year, we only return full years
2274 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2277 sub _get_next_date_day {
2278 my ($subscription, $freqdata, $year, $month, $day) = @_;
2280 my @newissue; # ( yy, mm, dd )
2281 # We do not need $delta_days here, since it would be zero where used
2283 if( $freqdata->{issuesperunit} == 1 ) {
2285 @newissue = Add_Delta_Days(
2286 $year, $month, $day, $freqdata->{"unitsperissue"} );
2287 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2289 @newissue = ( $year, $month, $day );
2290 $subscription->{countissuesperunit}++;
2292 # We finished a cycle of issues within a unit.
2293 # No subtraction of zero needed, just add one day
2294 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2295 $subscription->{countissuesperunit} = 1;
2300 sub _get_next_date_week {
2301 my ($subscription, $freqdata, $year, $month, $day) = @_;
2303 my @newissue; # ( yy, mm, dd )
2304 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2306 if( $freqdata->{issuesperunit} == 1 ) {
2307 # Add full weeks (of 7 days)
2308 @newissue = Add_Delta_Days(
2309 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2310 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2311 # Add rounded number of days based on frequency.
2312 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2313 $subscription->{countissuesperunit}++;
2315 # We finished a cycle of issues within a unit.
2316 # Subtract delta * (issues - 1), add 1 week
2317 @newissue = Add_Delta_Days( $year, $month, $day,
2318 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2319 @newissue = Add_Delta_Days( @newissue, 7 );
2320 $subscription->{countissuesperunit} = 1;
2325 sub _get_next_date_month {
2326 my ($subscription, $freqdata, $year, $month, $day) = @_;
2328 my @newissue; # ( yy, mm, dd )
2329 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2331 if( $freqdata->{issuesperunit} == 1 ) {
2333 @newissue = Add_Delta_YM(
2334 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2335 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2336 # Add rounded number of days based on frequency.
2337 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2338 $subscription->{countissuesperunit}++;
2340 # We finished a cycle of issues within a unit.
2341 # Subtract delta * (issues - 1), add 1 month
2342 @newissue = Add_Delta_Days( $year, $month, $day,
2343 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2344 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2345 $subscription->{countissuesperunit} = 1;
2350 sub _get_next_date_year {
2351 my ($subscription, $freqdata, $year, $month, $day) = @_;
2353 my @newissue; # ( yy, mm, dd )
2354 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2356 if( $freqdata->{issuesperunit} == 1 ) {
2358 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2359 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2360 # Add rounded number of days based on frequency.
2361 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2362 $subscription->{countissuesperunit}++;
2364 # We finished a cycle of issues within a unit.
2365 # Subtract delta * (issues - 1), add 1 year
2366 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2367 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2368 $subscription->{countissuesperunit} = 1;
2375 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2377 this function it takes the publisheddate and will return the next issue's date
2378 and will skip dates if there exists an irregularity.
2379 $publisheddate has to be an ISO date
2380 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2381 $frequency is a hashref containing frequency informations
2382 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2383 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2384 skipped then the returned date will be 2007-05-10
2387 $resultdate - then next date in the sequence (ISO date)
2389 Return undef if subscription is irregular
2394 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2396 return unless $subscription and $publisheddate;
2399 if ($freqdata->{'unit'}) {
2400 my ( $year, $month, $day ) = split /-/, $publisheddate;
2402 # Process an irregularity Hash
2403 # Suppose that irregularities are stored in a string with this structure
2404 # irreg1;irreg2;irreg3
2405 # where irregX is the number of issue which will not be received
2406 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2408 if ( $subscription->{irregularity} ) {
2409 my @irreg = split /;/, $subscription->{'irregularity'} ;
2410 foreach my $irregularity (@irreg) {
2411 $irregularities{$irregularity} = 1;
2415 # Get the 'fictive' next issue number
2416 # It is used to check if next issue is an irregular issue.
2417 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2419 # Then get the next date
2420 my $unit = lc $freqdata->{'unit'};
2421 if ($unit eq 'day') {
2422 while ($irregularities{$issueno}) {
2423 ($year, $month, $day) = _get_next_date_day($subscription,
2424 $freqdata, $year, $month, $day);
2427 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2428 $year, $month, $day);
2430 elsif ($unit eq 'week') {
2431 while ($irregularities{$issueno}) {
2432 ($year, $month, $day) = _get_next_date_week($subscription,
2433 $freqdata, $year, $month, $day);
2436 ($year, $month, $day) = _get_next_date_week($subscription,
2437 $freqdata, $year, $month, $day);
2439 elsif ($unit eq 'month') {
2440 while ($irregularities{$issueno}) {
2441 ($year, $month, $day) = _get_next_date_month($subscription,
2442 $freqdata, $year, $month, $day);
2445 ($year, $month, $day) = _get_next_date_month($subscription,
2446 $freqdata, $year, $month, $day);
2448 elsif ($unit eq 'year') {
2449 while ($irregularities{$issueno}) {
2450 ($year, $month, $day) = _get_next_date_year($subscription,
2451 $freqdata, $year, $month, $day);
2454 ($year, $month, $day) = _get_next_date_year($subscription,
2455 $freqdata, $year, $month, $day);
2459 my $dbh = C4::Context->dbh;
2462 SET countissuesperunit = ?
2463 WHERE subscriptionid = ?
2465 my $sth = $dbh->prepare($query);
2466 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2469 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2475 $string = &_numeration($value,$num_type,$locale);
2477 _numeration returns the string corresponding to $value in the num_type
2489 my ($value, $num_type, $locale) = @_;
2494 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2495 # 1970-11-01 was a Sunday
2496 $value = $value % 7;
2497 my $dt = DateTime->new(
2503 $string = $num_type =~ /^dayname$/
2504 ? $dt->strftime("%A")
2505 : $dt->strftime("%a");
2506 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2507 $value = $value % 12;
2508 my $dt = DateTime->new(
2510 month => $value + 1,
2513 $string = $num_type =~ /^monthname$/
2514 ? $dt->strftime("%B")
2515 : $dt->strftime("%b");
2516 } elsif ( $num_type =~ /^season$/ ) {
2517 my @seasons= qw( Spring Summer Fall Winter );
2518 $value = $value % 4;
2519 $string = $seasons[$value];
2520 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2521 my @seasonsabrv= qw( Spr Sum Fal Win );
2522 $value = $value % 4;
2523 $string = $seasonsabrv[$value];
2531 =head2 CloseSubscription
2533 Close a subscription given a subscriptionid
2537 sub CloseSubscription {
2538 my ( $subscriptionid ) = @_;
2539 return unless $subscriptionid;
2540 my $dbh = C4::Context->dbh;
2541 my $sth = $dbh->prepare( q{
2544 WHERE subscriptionid = ?
2546 $sth->execute( $subscriptionid );
2548 # Set status = missing when status = stopped
2549 $sth = $dbh->prepare( q{
2552 WHERE subscriptionid = ?
2555 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2558 =head2 ReopenSubscription
2560 Reopen a subscription given a subscriptionid
2564 sub ReopenSubscription {
2565 my ( $subscriptionid ) = @_;
2566 return unless $subscriptionid;
2567 my $dbh = C4::Context->dbh;
2568 my $sth = $dbh->prepare( q{
2571 WHERE subscriptionid = ?
2573 $sth->execute( $subscriptionid );
2575 # Set status = expected when status = stopped
2576 $sth = $dbh->prepare( q{
2579 WHERE subscriptionid = ?
2582 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2585 =head2 subscriptionCurrentlyOnOrder
2587 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2589 Return 1 if subscription is currently on order else 0.
2593 sub subscriptionCurrentlyOnOrder {
2594 my ( $subscriptionid ) = @_;
2595 my $dbh = C4::Context->dbh;
2597 SELECT COUNT(*) FROM aqorders
2598 WHERE subscriptionid = ?
2599 AND datereceived IS NULL
2600 AND datecancellationprinted IS NULL
2602 my $sth = $dbh->prepare( $query );
2603 $sth->execute($subscriptionid);
2604 return $sth->fetchrow_array;
2607 =head2 can_claim_subscription
2609 $can = can_claim_subscription( $subscriptionid[, $userid] );
2611 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2615 sub can_claim_subscription {
2616 my ( $subscription, $userid ) = @_;
2617 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2620 =head2 can_edit_subscription
2622 $can = can_edit_subscription( $subscriptionid[, $userid] );
2624 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2628 sub can_edit_subscription {
2629 my ( $subscription, $userid ) = @_;
2630 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2633 =head2 can_show_subscription
2635 $can = can_show_subscription( $subscriptionid[, $userid] );
2637 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2641 sub can_show_subscription {
2642 my ( $subscription, $userid ) = @_;
2643 return _can_do_on_subscription( $subscription, $userid, '*' );
2646 sub _can_do_on_subscription {
2647 my ( $subscription, $userid, $permission ) = @_;
2648 return 0 unless C4::Context->userenv;
2649 my $flags = C4::Context->userenv->{flags};
2650 $userid ||= C4::Context->userenv->{'id'};
2652 if ( C4::Context->preference('IndependentBranches') ) {
2654 if C4::Context->IsSuperLibrarian()
2656 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2658 C4::Auth::haspermission( $userid,
2659 { serials => $permission } )
2660 and ( not defined $subscription->{branchcode}
2661 or $subscription->{branchcode} eq ''
2662 or $subscription->{branchcode} eq
2663 C4::Context->userenv->{'branch'} )
2668 if C4::Context->IsSuperLibrarian()
2670 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2671 or C4::Auth::haspermission(
2672 $userid, { serials => $permission }
2679 =head2 findSerialsByStatus
2681 @serials = findSerialsByStatus($status, $subscriptionid);
2683 Returns an array of serials matching a given status and subscription id.
2687 sub findSerialsByStatus {
2688 my ( $status, $subscriptionid ) = @_;
2689 my $dbh = C4::Context->dbh;
2690 my $query = q| SELECT * from serial
2692 AND subscriptionid = ?
2694 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2703 Koha Development Team <http://koha-community.org/>