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( 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;
41 use Koha::DateUtils qw( dt_from_string output_pref );
43 use Koha::Subscriptions;
44 use Koha::Subscription::Histories;
45 use Koha::SharedContent;
46 use Scalar::Util qw( looks_like_number );
54 MISSING_NEVER_RECIEVED => 41,
55 MISSING_SOLD_OUT => 42,
56 MISSING_DAMAGED => 43,
64 use constant MISSING_STATUSES => (
65 MISSING, MISSING_NEVER_RECIEVED,
66 MISSING_SOLD_OUT, MISSING_DAMAGED,
70 our (@ISA, @EXPORT_OK);
75 NewSubscription ModSubscription DelSubscription
76 GetSubscription CountSubscriptionFromBiblionumber GetSubscriptionsFromBiblionumber
78 GetFullSubscriptionsFromBiblionumber GetFullSubscription ModSubscriptionHistory
79 HasSubscriptionStrictlyExpired HasSubscriptionExpired GetExpirationDate abouttoexpire
81 GetSubscriptionHistoryFromSubscriptionId
83 GetNextSeq GetSeq NewIssue GetSerials
84 GetLatestSerials ModSerialStatus GetNextDate
85 CloseSubscription ReopenSubscription
86 subscriptionCurrentlyOnOrder
87 can_claim_subscription can_edit_subscription can_show_subscription
89 GetSubscriptionLength ReNewSubscription GetLateOrMissingIssues
90 GetSerialInformation AddItem2Serial
91 PrepareSerialsData GetNextExpected ModNextExpected
92 GetSubscriptionIrregularities
95 GetSuppliersWithLateIssues
96 getroutinglist delroutingmember addroutingmember
98 check_routing updateClaim
109 C4::Serials - Serials Module Functions
117 Functions for handling subscriptions, claims routing etc.
122 =head2 GetSuppliersWithLateIssues
124 $supplierlist = GetSuppliersWithLateIssues()
126 this function get all suppliers with late issues.
129 an array_ref of suppliers each entry is a hash_ref containing id and name
130 the array is in name order
134 sub GetSuppliersWithLateIssues {
135 my $dbh = C4::Context->dbh;
136 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
138 SELECT DISTINCT id, name
140 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
141 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
144 (planneddate < now() AND serial.status=1)
145 OR serial.STATUS IN ( $statuses )
147 AND subscription.closed = 0
149 return $dbh->selectall_arrayref($query, { Slice => {} });
152 =head2 GetSubscriptionHistoryFromSubscriptionId
154 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
156 This function returns the subscription history as a hashref
160 sub GetSubscriptionHistoryFromSubscriptionId {
161 my ($subscriptionid) = @_;
163 return unless $subscriptionid;
165 my $dbh = C4::Context->dbh;
168 FROM subscriptionhistory
169 WHERE subscriptionid = ?
171 my $sth = $dbh->prepare($query);
172 $sth->execute($subscriptionid);
173 my $results = $sth->fetchrow_hashref;
179 =head2 GetSerialInformation
181 $data = GetSerialInformation($serialid);
182 returns a hash_ref containing :
183 items : items marcrecord (can be an array)
185 subscription table field
186 + information about subscription expiration
190 sub GetSerialInformation {
192 my $dbh = C4::Context->dbh;
194 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
195 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
198 my $rq = $dbh->prepare($query);
199 $rq->execute($serialid);
200 my $data = $rq->fetchrow_hashref;
202 # create item information if we have serialsadditems for this subscription
203 if ( $data->{'serialsadditems'} ) {
204 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
205 $queryitem->execute($serialid);
206 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
208 if ( scalar(@$itemnumbers) > 0 ) {
209 foreach my $itemnum (@$itemnumbers) {
211 #It is ASSUMED that GetMarcItem ALWAYS WORK...
212 #Maybe GetMarcItem should return values on failure
213 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
214 $itemprocessed->{'itemnumber'} = $itemnum->[0];
215 $itemprocessed->{'itemid'} = $itemnum->[0];
216 $itemprocessed->{'serialid'} = $serialid;
217 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
218 push @{ $data->{'items'} }, $itemprocessed;
221 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
222 $itemprocessed->{'itemid'} = "N$serialid";
223 $itemprocessed->{'serialid'} = $serialid;
224 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
225 $itemprocessed->{'countitems'} = 0;
226 push @{ $data->{'items'} }, $itemprocessed;
229 $data->{ "status" . $data->{'serstatus'} } = 1;
230 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
231 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
232 $data->{cannotedit} = not can_edit_subscription( $data );
236 =head2 AddItem2Serial
238 $rows = AddItem2Serial($serialid,$itemnumber);
239 Adds an itemnumber to Serial record
240 returns the number of rows affected
245 my ( $serialid, $itemnumber ) = @_;
247 return unless ($serialid and $itemnumber);
249 my $dbh = C4::Context->dbh;
250 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
251 $rq->execute( $serialid, $itemnumber );
255 =head2 GetSubscription
257 $subs = GetSubscription($subscriptionid)
258 this function returns the subscription which has $subscriptionid as id.
260 a hashref. This hash contains
261 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
265 sub GetSubscription {
266 my ($subscriptionid) = @_;
267 my $dbh = C4::Context->dbh;
269 SELECT subscription.*,
270 subscriptionhistory.*,
271 aqbooksellers.name AS aqbooksellername,
272 biblio.title AS bibliotitle,
273 biblio.subtitle AS bibliosubtitle,
274 subscription.biblionumber as bibnum
276 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
277 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
278 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
279 WHERE subscription.subscriptionid = ?
282 my $sth = $dbh->prepare($query);
283 $sth->execute($subscriptionid);
284 my $subscription = $sth->fetchrow_hashref;
286 return unless $subscription;
288 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
290 if ( my $mana_id = $subscription->{mana_id} ) {
291 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
292 'subscription', $mana_id, {usecomments => 1});
293 $subscription->{comments} = $mana_subscription->{data}->{comments};
296 return $subscription;
299 =head2 GetFullSubscription
301 $array_ref = GetFullSubscription($subscriptionid)
302 this function reads the serial table.
306 sub GetFullSubscription {
307 my ($subscriptionid) = @_;
309 return unless ($subscriptionid);
311 my $dbh = C4::Context->dbh;
313 SELECT serial.serialid,
316 serial.publisheddate,
317 serial.publisheddatetext,
319 serial.notes as notes,
320 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
321 aqbooksellers.name as aqbooksellername,
322 biblio.title as bibliotitle,
323 subscription.branchcode AS branchcode,
324 subscription.subscriptionid AS subscriptionid
326 LEFT JOIN subscription ON
327 (serial.subscriptionid=subscription.subscriptionid )
328 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
329 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
330 WHERE serial.subscriptionid = ?
332 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
333 serial.subscriptionid
335 my $sth = $dbh->prepare($query);
336 $sth->execute($subscriptionid);
337 my $subscriptions = $sth->fetchall_arrayref( {} );
338 if (scalar @$subscriptions) {
339 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
340 for my $subscription ( @$subscriptions ) {
341 $subscription->{cannotedit} = $cannotedit;
345 return $subscriptions;
348 =head2 PrepareSerialsData
350 $array_ref = PrepareSerialsData($serialinfomation)
351 where serialinformation is a hashref array
355 sub PrepareSerialsData {
358 return unless ($lines);
365 my $previousnote = "";
367 foreach my $subs (@{$lines}) {
368 $subs->{ "status" . $subs->{'status'} } = 1;
369 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
370 $subs->{"checked"} = 1;
373 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
374 $year = $subs->{'year'};
378 if ( $tmpresults{$year} ) {
379 push @{ $tmpresults{$year}->{'serials'} }, $subs;
381 $tmpresults{$year} = {
383 'aqbooksellername' => $subs->{'aqbooksellername'},
384 'bibliotitle' => $subs->{'bibliotitle'},
385 'serials' => [$subs],
390 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
391 push @res, $tmpresults{$key};
396 =head2 GetSubscriptionsFromBiblionumber
398 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
399 this function get the subscription list. it reads the subscription table.
401 reference to an array of subscriptions which have the biblionumber given on input arg.
402 each element of this array is a hashref containing
403 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
407 sub GetSubscriptionsFromBiblionumber {
408 my ($biblionumber) = @_;
410 return unless ($biblionumber);
412 my $dbh = C4::Context->dbh;
414 SELECT subscription.*,
416 subscriptionhistory.*,
417 aqbooksellers.name AS aqbooksellername,
418 biblio.title AS bibliotitle
420 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
421 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
422 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
423 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
424 WHERE subscription.biblionumber = ?
426 my $sth = $dbh->prepare($query);
427 $sth->execute($biblionumber);
429 while ( my $subs = $sth->fetchrow_hashref ) {
430 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
431 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
432 if ( defined $subs->{histenddate} ) {
433 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
435 $subs->{histenddate} = "";
437 $subs->{opacnote} //= "";
438 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
439 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
440 $subs->{ "status" . $subs->{'status'} } = 1;
442 if (not defined $subs->{enddate} ) {
443 $subs->{enddate} = '';
445 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
447 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
448 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
449 $subs->{cannotedit} = not can_edit_subscription( $subs );
455 =head2 GetFullSubscriptionsFromBiblionumber
457 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
458 this function reads the serial table.
462 sub GetFullSubscriptionsFromBiblionumber {
463 my ($biblionumber) = @_;
464 my $dbh = C4::Context->dbh;
466 SELECT serial.serialid,
469 serial.publisheddate,
470 serial.publisheddatetext,
472 serial.notes as notes,
473 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
474 biblio.title as bibliotitle,
475 subscription.branchcode AS branchcode,
476 subscription.subscriptionid AS subscriptionid,
477 subscription.location AS location
479 LEFT JOIN subscription ON
480 (serial.subscriptionid=subscription.subscriptionid)
481 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
482 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
483 WHERE subscription.biblionumber = ?
485 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
486 serial.subscriptionid
488 my $sth = $dbh->prepare($query);
489 $sth->execute($biblionumber);
490 my $subscriptions = $sth->fetchall_arrayref( {} );
491 if (scalar @$subscriptions) {
492 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
493 for my $subscription ( @$subscriptions ) {
494 $subscription->{cannotedit} = $cannotedit;
498 return $subscriptions;
501 =head2 SearchSubscriptions
503 @results = SearchSubscriptions($args);
505 This function returns a list of hashrefs, one for each subscription
506 that meets the conditions specified by the $args hashref.
508 The valid search fields are:
522 The expiration_date search field is special; it specifies the maximum
523 subscription expiration date.
527 sub SearchSubscriptions {
530 my $additional_fields = $args->{additional_fields} // [];
531 my $matching_record_ids_for_additional_fields = [];
532 if ( @$additional_fields ) {
533 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
535 return () unless @subscriptions;
537 $matching_record_ids_for_additional_fields = [ map {
544 subscription.notes AS publicnotes,
545 subscriptionhistory.*,
547 biblio.notes AS biblionotes,
552 aqbooksellers.name AS vendorname,
555 LEFT JOIN subscriptionhistory USING(subscriptionid)
556 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
557 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
558 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
560 $query .= q| WHERE 1|;
563 if( $args->{biblionumber} ) {
564 push @where_strs, "biblio.biblionumber = ?";
565 push @where_args, $args->{biblionumber};
568 if( $args->{title} ){
569 my @words = split / /, $args->{title};
571 foreach my $word (@words) {
572 push @strs, "biblio.title LIKE ?";
573 push @args, "%$word%";
576 push @where_strs, '(' . join (' AND ', @strs) . ')';
577 push @where_args, @args;
581 push @where_strs, "biblioitems.issn LIKE ?";
582 push @where_args, "%$args->{issn}%";
585 push @where_strs, "biblioitems.ean LIKE ?";
586 push @where_args, "%$args->{ean}%";
588 if ( $args->{callnumber} ) {
589 push @where_strs, "subscription.callnumber LIKE ?";
590 push @where_args, "%$args->{callnumber}%";
592 if( $args->{publisher} ){
593 push @where_strs, "biblioitems.publishercode LIKE ?";
594 push @where_args, "%$args->{publisher}%";
596 if( $args->{bookseller} ){
597 push @where_strs, "aqbooksellers.name LIKE ?";
598 push @where_args, "%$args->{bookseller}%";
600 if( $args->{branch} ){
601 push @where_strs, "subscription.branchcode = ?";
602 push @where_args, "$args->{branch}";
604 if ( $args->{location} ) {
605 push @where_strs, "subscription.location = ?";
606 push @where_args, "$args->{location}";
608 if ( $args->{expiration_date} ) {
609 push @where_strs, "subscription.enddate <= ?";
610 push @where_args, "$args->{expiration_date}";
612 if( defined $args->{closed} ){
613 push @where_strs, "subscription.closed = ?";
614 push @where_args, "$args->{closed}";
618 $query .= ' AND ' . join(' AND ', @where_strs);
620 if ( @$additional_fields ) {
621 $query .= ' AND subscriptionid IN ('
622 . join( ', ', @$matching_record_ids_for_additional_fields )
626 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
628 my $dbh = C4::Context->dbh;
629 my $sth = $dbh->prepare($query);
630 $sth->execute(@where_args);
631 my $results = $sth->fetchall_arrayref( {} );
633 for my $subscription ( @$results ) {
634 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
635 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
637 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
638 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
639 $subscription_object->additional_field_values->as_list };
649 ($totalissues,@serials) = GetSerials($subscriptionid);
650 this function gets every serial not arrived for a given subscription
651 as well as the number of issues registered in the database (all types)
652 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
654 FIXME: We should return \@serials.
659 my ( $subscriptionid, $count ) = @_;
661 return unless $subscriptionid;
663 my $dbh = C4::Context->dbh;
665 # status = 2 is "arrived"
667 $count = 5 unless ($count);
669 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
670 my $query = "SELECT serialid,serialseq, status, publisheddate,
671 publisheddatetext, planneddate,notes, routingnotes
673 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
674 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
675 my $sth = $dbh->prepare($query);
676 $sth->execute($subscriptionid);
678 while ( my $line = $sth->fetchrow_hashref ) {
679 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
680 for my $datefield ( qw( planneddate publisheddate) ) {
681 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
682 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
684 $line->{$datefield} = q{};
687 push @serials, $line;
690 # OK, now add the last 5 issues arrives/missing
691 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
692 publisheddatetext, notes, routingnotes
694 WHERE subscriptionid = ?
695 AND status IN ( $statuses )
696 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
698 $sth = $dbh->prepare($query);
699 $sth->execute($subscriptionid);
700 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
702 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
703 for my $datefield ( qw( planneddate publisheddate) ) {
704 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
705 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
707 $line->{$datefield} = q{};
711 push @serials, $line;
714 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
715 $sth = $dbh->prepare($query);
716 $sth->execute($subscriptionid);
717 my ($totalissues) = $sth->fetchrow;
718 return ( $totalissues, @serials );
723 @serials = GetSerials2($subscriptionid,$statuses);
724 this function returns every serial waited for a given subscription
725 as well as the number of issues registered in the database (all types)
726 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
728 $statuses is an arrayref of statuses and is mandatory.
733 my ( $subscription, $statuses ) = @_;
735 return unless ($subscription and @$statuses);
737 my $dbh = C4::Context->dbh;
739 SELECT serialid,serialseq, status, planneddate, publisheddate,
740 publisheddatetext, notes, routingnotes
742 WHERE subscriptionid=?
744 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
746 ORDER BY publisheddate,serialid DESC
748 my $sth = $dbh->prepare($query);
749 $sth->execute( $subscription, @$statuses );
752 while ( my $line = $sth->fetchrow_hashref ) {
753 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
754 # Format dates for display
755 for my $datefield ( qw( planneddate publisheddate ) ) {
756 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
757 $line->{$datefield} = q{};
760 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
763 push @serials, $line;
768 =head2 GetLatestSerials
770 \@serials = GetLatestSerials($subscriptionid,$limit)
771 get the $limit's latest serials arrived or missing for a given subscription
773 a ref to an array which contains all of the latest serials stored into a hash.
777 sub GetLatestSerials {
778 my ( $subscriptionid, $limit ) = @_;
780 return unless ($subscriptionid and $limit);
782 my $dbh = C4::Context->dbh;
784 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
785 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
787 WHERE subscriptionid = ?
788 AND status IN ($statuses)
789 ORDER BY publisheddate DESC LIMIT 0,$limit
791 my $sth = $dbh->prepare($strsth);
792 $sth->execute($subscriptionid);
794 while ( my $line = $sth->fetchrow_hashref ) {
795 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
796 push @serials, $line;
802 =head2 GetPreviousSerialid
804 $serialid = GetPreviousSerialid($subscriptionid, $nth)
805 get the $nth's previous serial for the given subscriptionid
811 sub GetPreviousSerialid {
812 my ( $subscriptionid, $nth ) = @_;
814 my $dbh = C4::Context->dbh;
818 my $strsth = "SELECT serialid
820 WHERE subscriptionid = ?
822 ORDER BY serialid DESC LIMIT $nth,1
824 my $sth = $dbh->prepare($strsth);
825 $sth->execute($subscriptionid);
827 my $line = $sth->fetchrow_hashref;
828 $return = $line->{'serialid'} if ($line);
836 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
837 $newinnerloop1, $newinnerloop2, $newinnerloop3
838 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
840 $subscription is a hashref containing all the attributes of the table
842 $pattern is a hashref containing all the attributes of the table
843 'subscription_numberpatterns'.
844 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
845 $planneddate is a date string in iso format.
846 This function get the next issue for the subscription given on input arg
851 my ($subscription, $pattern, $frequency, $planneddate) = @_;
853 return unless ($subscription and $pattern);
855 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
856 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
859 if ($subscription->{'skip_serialseq'}) {
860 my @irreg = split /;/, $subscription->{'irregularity'};
862 my $irregularities = {};
863 $irregularities->{$_} = 1 foreach(@irreg);
864 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
865 while($irregularities->{$issueno}) {
872 my $numberingmethod = $pattern->{numberingmethod};
874 if ($numberingmethod) {
875 $calculated = $numberingmethod;
876 my $locale = $subscription->{locale};
877 $newlastvalue1 = $subscription->{lastvalue1} || 0;
878 $newlastvalue2 = $subscription->{lastvalue2} || 0;
879 $newlastvalue3 = $subscription->{lastvalue3} || 0;
880 $newinnerloop1 = $subscription->{innerloop1} || 0;
881 $newinnerloop2 = $subscription->{innerloop2} || 0;
882 $newinnerloop3 = $subscription->{innerloop3} || 0;
885 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
888 for(my $i = 0; $i < $count; $i++) {
890 # check if we have to increase the new value.
892 if ($newinnerloop1 >= $pattern->{every1}) {
894 $newlastvalue1 += $pattern->{add1};
896 # reset counter if needed.
897 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
900 # check if we have to increase the new value.
902 if ($newinnerloop2 >= $pattern->{every2}) {
904 $newlastvalue2 += $pattern->{add2};
906 # reset counter if needed.
907 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
910 # check if we have to increase the new value.
912 if ($newinnerloop3 >= $pattern->{every3}) {
914 $newlastvalue3 += $pattern->{add3};
916 # reset counter if needed.
917 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
921 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
922 $calculated =~ s/\{X\}/$newlastvalue1string/g;
925 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
926 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
929 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
930 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
935 $newlastvalue1, $newlastvalue2, $newlastvalue3,
936 $newinnerloop1, $newinnerloop2, $newinnerloop3);
941 $calculated = GetSeq($subscription, $pattern)
942 $subscription is a hashref containing all the attributes of the table 'subscription'
943 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
944 this function transforms {X},{Y},{Z} to 150,0,0 for example.
946 the sequence in string format
951 my ($subscription, $pattern) = @_;
953 return unless ($subscription and $pattern);
955 my $locale = $subscription->{locale};
957 my $calculated = $pattern->{numberingmethod};
959 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
960 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
961 $calculated =~ s/\{X\}/$newlastvalue1/g;
963 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
964 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
965 $calculated =~ s/\{Y\}/$newlastvalue2/g;
967 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
968 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
969 $calculated =~ s/\{Z\}/$newlastvalue3/g;
973 =head2 GetExpirationDate
975 $enddate = GetExpirationDate($subscriptionid, [$startdate])
977 this function return the next expiration date for a subscription given on input args.
984 sub GetExpirationDate {
985 my ( $subscriptionid, $startdate ) = @_;
987 return unless ($subscriptionid);
989 my $dbh = C4::Context->dbh;
990 my $subscription = GetSubscription($subscriptionid);
993 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
994 $enddate = $startdate || $subscription->{startdate};
995 my @date = split( /-/, $enddate );
997 return if ( scalar(@date) != 3 || not check_date(@date) );
999 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1000 if ( $frequency and $frequency->{unit} ) {
1003 if ( my $length = $subscription->{numberlength} ) {
1005 #calculate the date of the last issue.
1006 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1007 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1009 } elsif ( $subscription->{monthlength} ) {
1010 if ( $$subscription{startdate} ) {
1011 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1012 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1014 } elsif ( $subscription->{weeklength} ) {
1015 if ( $$subscription{startdate} ) {
1016 my @date = split( /-/, $subscription->{startdate} );
1017 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1018 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1021 $enddate = $subscription->{enddate};
1025 return $subscription->{enddate};
1029 =head2 CountSubscriptionFromBiblionumber
1031 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1032 this returns a count of the subscriptions for a given biblionumber
1034 the number of subscriptions
1038 sub CountSubscriptionFromBiblionumber {
1039 my ($biblionumber) = @_;
1041 return unless ($biblionumber);
1043 my $dbh = C4::Context->dbh;
1044 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1045 my $sth = $dbh->prepare($query);
1046 $sth->execute($biblionumber);
1047 my $subscriptionsnumber = $sth->fetchrow;
1048 return $subscriptionsnumber;
1051 =head2 ModSubscriptionHistory
1053 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1055 this function modifies the history of a subscription. Put your new values on input arg.
1056 returns the number of rows affected
1060 sub ModSubscriptionHistory {
1061 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1063 return unless ($subscriptionid);
1065 my $dbh = C4::Context->dbh;
1066 my $query = "UPDATE subscriptionhistory
1067 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1068 WHERE subscriptionid=?
1070 my $sth = $dbh->prepare($query);
1071 $receivedlist =~ s/^; // if $receivedlist;
1072 $missinglist =~ s/^; // if $missinglist;
1073 $opacnote =~ s/^; // if $opacnote;
1074 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1078 =head2 ModSerialStatus
1080 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1081 $publisheddatetext, $status, $notes);
1083 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1084 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1088 sub ModSerialStatus {
1089 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1090 $status, $notes) = @_;
1092 return unless ($serialid);
1094 #It is a usual serial
1095 # 1st, get previous status :
1096 my $dbh = C4::Context->dbh;
1097 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1098 FROM serial, subscription
1099 WHERE serial.subscriptionid=subscription.subscriptionid
1101 my $sth = $dbh->prepare($query);
1102 $sth->execute($serialid);
1103 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1104 my $frequency = GetSubscriptionFrequency($periodicity);
1106 # change status & update subscriptionhistory
1108 if ( $status == DELETED ) {
1109 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1113 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1114 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1117 $sth = $dbh->prepare($query);
1118 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1119 $planneddate, $status, $notes, $routingnotes, $serialid );
1120 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1121 $sth = $dbh->prepare($query);
1122 $sth->execute($subscriptionid);
1123 my $val = $sth->fetchrow_hashref;
1124 unless ( $val->{manualhistory} ) {
1125 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1126 $sth = $dbh->prepare($query);
1127 $sth->execute($subscriptionid);
1128 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1130 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1131 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1134 # in case serial has been previously marked as missing
1135 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1136 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1139 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1140 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1142 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1143 $sth = $dbh->prepare($query);
1144 $recievedlist =~ s/^; //;
1145 $missinglist =~ s/^; //;
1146 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1150 # create new expected entry if needed (ie : was "expected" and has changed)
1151 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1152 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1153 my $subscription = GetSubscription($subscriptionid);
1154 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1155 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1159 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1160 $newinnerloop1, $newinnerloop2, $newinnerloop3
1162 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1164 # next date (calculated from actual date & frequency parameters)
1165 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1166 my $nextpubdate = $nextpublisheddate;
1167 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1168 WHERE subscriptionid = ?";
1169 $sth = $dbh->prepare($query);
1170 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1171 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1172 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1173 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1174 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1175 require C4::Letters;
1176 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1184 # Adds or removes seqno from list when needed; returns list
1185 # Or checks and returns true when present
1187 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1189 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1191 if( !$op or $op eq 'ADD' ) {
1192 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1193 } elsif( $op eq 'REMOVE' ) {
1194 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1196 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1201 =head2 GetNextExpected
1203 $nextexpected = GetNextExpected($subscriptionid)
1205 Get the planneddate for the current expected issue of the subscription.
1211 planneddate => ISO date
1216 sub GetNextExpected {
1217 my ($subscriptionid) = @_;
1219 my $dbh = C4::Context->dbh;
1223 WHERE subscriptionid = ?
1227 my $sth = $dbh->prepare($query);
1229 # Each subscription has only one 'expected' issue.
1230 $sth->execute( $subscriptionid, EXPECTED );
1231 my $nextissue = $sth->fetchrow_hashref;
1232 if ( !$nextissue ) {
1236 WHERE subscriptionid = ?
1237 ORDER BY publisheddate DESC
1240 $sth = $dbh->prepare($query);
1241 $sth->execute($subscriptionid);
1242 $nextissue = $sth->fetchrow_hashref;
1244 foreach(qw/planneddate publisheddate/) {
1245 # or should this default to 1st Jan ???
1246 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1252 =head2 ModNextExpected
1254 ModNextExpected($subscriptionid,$date)
1256 Update the planneddate for the current expected issue of the subscription.
1257 This will modify all future prediction results.
1259 C<$date> is an ISO date.
1265 sub ModNextExpected {
1266 my ( $subscriptionid, $date ) = @_;
1267 my $dbh = C4::Context->dbh;
1269 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1270 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1272 # Each subscription has only one 'expected' issue.
1273 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1278 =head2 GetSubscriptionIrregularities
1282 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1283 get the list of irregularities for a subscription
1289 sub GetSubscriptionIrregularities {
1290 my $subscriptionid = shift;
1292 return unless $subscriptionid;
1294 my $dbh = C4::Context->dbh;
1298 WHERE subscriptionid = ?
1300 my $sth = $dbh->prepare($query);
1301 $sth->execute($subscriptionid);
1303 my ($result) = $sth->fetchrow_array;
1304 my @irreg = split /;/, $result;
1309 =head2 ModSubscription
1311 this function modifies a subscription. Put all new values on input args.
1312 returns the number of rows affected
1316 sub ModSubscription {
1318 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1319 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1320 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1321 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1322 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1323 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1324 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1325 $itemtype, $previousitemtype, $mana_id, $ccode
1328 my $subscription = Koha::Subscriptions->find($subscriptionid);
1331 librarian => $auser,
1332 branchcode => $branchcode,
1333 aqbooksellerid => $aqbooksellerid,
1335 aqbudgetid => $aqbudgetid,
1336 biblionumber => $biblionumber,
1337 startdate => $startdate,
1338 periodicity => $periodicity,
1339 numberlength => $numberlength,
1340 weeklength => $weeklength,
1341 monthlength => $monthlength,
1342 lastvalue1 => $lastvalue1,
1343 innerloop1 => $innerloop1,
1344 lastvalue2 => $lastvalue2,
1345 innerloop2 => $innerloop2,
1346 lastvalue3 => $lastvalue3,
1347 innerloop3 => $innerloop3,
1351 firstacquidate => $firstacquidate,
1352 irregularity => $irregularity,
1353 numberpattern => $numberpattern,
1355 callnumber => $callnumber,
1356 manualhistory => $manualhistory,
1357 internalnotes => $internalnotes,
1358 serialsadditems => $serialsadditems,
1359 staffdisplaycount => $staffdisplaycount,
1360 opacdisplaycount => $opacdisplaycount,
1361 graceperiod => $graceperiod,
1362 location => $location,
1363 enddate => $enddate,
1364 skip_serialseq => $skip_serialseq,
1365 itemtype => $itemtype,
1366 previousitemtype => $previousitemtype,
1367 mana_id => $mana_id,
1371 # FIXME Must be $subscription->serials
1372 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1373 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1375 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1377 $subscription->discard_changes;
1378 return $subscription;
1381 =head2 NewSubscription
1383 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1384 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1385 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1386 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1387 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1388 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1389 $skip_serialseq, $itemtype, $previousitemtype);
1391 Create a new subscription with value given on input args.
1394 the id of this new subscription
1398 sub NewSubscription {
1400 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1401 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1402 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1403 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1404 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1405 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1406 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode
1408 my $dbh = C4::Context->dbh;
1410 my $subscription = Koha::Subscription->new(
1412 librarian => $auser,
1413 branchcode => $branchcode,
1414 aqbooksellerid => $aqbooksellerid,
1416 aqbudgetid => $aqbudgetid,
1417 biblionumber => $biblionumber,
1418 startdate => $startdate,
1419 periodicity => $periodicity,
1420 numberlength => $numberlength,
1421 weeklength => $weeklength,
1422 monthlength => $monthlength,
1423 lastvalue1 => $lastvalue1,
1424 innerloop1 => $innerloop1,
1425 lastvalue2 => $lastvalue2,
1426 innerloop2 => $innerloop2,
1427 lastvalue3 => $lastvalue3,
1428 innerloop3 => $innerloop3,
1432 firstacquidate => $firstacquidate,
1433 irregularity => $irregularity,
1434 numberpattern => $numberpattern,
1436 callnumber => $callnumber,
1437 manualhistory => $manualhistory,
1438 internalnotes => $internalnotes,
1439 serialsadditems => $serialsadditems,
1440 staffdisplaycount => $staffdisplaycount,
1441 opacdisplaycount => $opacdisplaycount,
1442 graceperiod => $graceperiod,
1443 location => $location,
1444 enddate => $enddate,
1445 skip_serialseq => $skip_serialseq,
1446 itemtype => $itemtype,
1447 previousitemtype => $previousitemtype,
1448 mana_id => $mana_id,
1452 $subscription->discard_changes;
1453 my $subscriptionid = $subscription->subscriptionid;
1454 my ( $query, $sth );
1456 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1460 WHERE subscriptionid=?
1462 $sth = $dbh->prepare($query);
1463 $sth->execute( $enddate, $subscriptionid );
1466 # then create the 1st expected number
1468 INSERT INTO subscriptionhistory
1469 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1470 VALUES (?,?,?, '', '')
1472 $sth = $dbh->prepare($query);
1473 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1475 # reread subscription to get a hash (for calculation of the 1st issue number)
1476 $subscription = GetSubscription($subscriptionid); # We should not do that
1477 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1479 # calculate issue number
1480 my $serialseq = GetSeq($subscription, $pattern) || q{};
1484 serialseq => $serialseq,
1485 serialseq_x => $subscription->{'lastvalue1'},
1486 serialseq_y => $subscription->{'lastvalue2'},
1487 serialseq_z => $subscription->{'lastvalue3'},
1488 subscriptionid => $subscriptionid,
1489 biblionumber => $biblionumber,
1491 planneddate => $firstacquidate,
1492 publisheddate => $firstacquidate,
1496 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1498 #set serial flag on biblio if not already set.
1499 my $biblio = Koha::Biblios->find( $biblionumber );
1500 if ( $biblio and !$biblio->serial ) {
1501 my $record = $biblio->metadata->record;
1502 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1504 eval { $record->field($tag)->update( $subf => 1 ); };
1506 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1508 return $subscriptionid;
1511 =head2 GetSubscriptionLength
1513 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1515 This function calculates the subscription length.
1519 sub GetSubscriptionLength {
1520 my ($subtype, $length) = @_;
1522 return unless looks_like_number($length);
1526 $subtype eq 'issues' ? $length : 0,
1527 $subtype eq 'weeks' ? $length : 0,
1528 $subtype eq 'months' ? $length : 0,
1533 =head2 ReNewSubscription
1535 ReNewSubscription($params);
1537 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1539 this function renew a subscription with values given on input args.
1543 sub ReNewSubscription {
1544 my ( $params ) = @_;
1545 my $subscriptionid = $params->{subscriptionid};
1546 my $user = $params->{user};
1547 my $startdate = $params->{startdate};
1548 my $numberlength = $params->{numberlength};
1549 my $weeklength = $params->{weeklength};
1550 my $monthlength = $params->{monthlength};
1551 my $note = $params->{note};
1552 my $branchcode = $params->{branchcode};
1554 my $dbh = C4::Context->dbh;
1555 my $subscription = GetSubscription($subscriptionid);
1559 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1560 WHERE biblio.biblionumber=?
1562 my $sth = $dbh->prepare($query);
1563 $sth->execute( $subscription->{biblionumber} );
1564 my $biblio = $sth->fetchrow_hashref;
1566 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1567 require C4::Suggestions;
1568 C4::Suggestions::NewSuggestion(
1569 { 'suggestedby' => $user,
1570 'title' => $subscription->{bibliotitle},
1571 'author' => $biblio->{author},
1572 'publishercode' => $biblio->{publishercode},
1574 'biblionumber' => $subscription->{biblionumber},
1575 'branchcode' => $branchcode,
1580 $numberlength ||= 0; # Should not we raise an exception instead?
1583 # renew subscription
1586 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1587 WHERE subscriptionid=?
1589 $sth = $dbh->prepare($query);
1590 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1591 my $enddate = GetExpirationDate($subscriptionid);
1595 WHERE subscriptionid=?
1597 $sth = $dbh->prepare($query);
1598 $sth->execute( $enddate, $subscriptionid );
1600 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1606 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1608 Create a new issue stored on the database.
1609 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1610 returns the serial id
1615 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1616 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1617 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1619 return unless ($subscriptionid);
1621 my $schema = Koha::Database->new()->schema();
1623 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1625 my $serial = Koha::Serial->new(
1627 serialseq => $serialseq,
1628 serialseq_x => $subscription->lastvalue1(),
1629 serialseq_y => $subscription->lastvalue2(),
1630 serialseq_z => $subscription->lastvalue3(),
1631 subscriptionid => $subscriptionid,
1632 biblionumber => $biblionumber,
1634 planneddate => $planneddate,
1635 publisheddate => $publisheddate,
1636 publisheddatetext => $publisheddatetext,
1638 routingnotes => $routingnotes
1642 my $serialid = $serial->id();
1644 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1645 my $missinglist = $subscription_history->missinglist();
1646 my $recievedlist = $subscription_history->recievedlist();
1648 if ( $status == ARRIVED ) {
1649 ### TODO Add a feature that improves recognition and description.
1650 ### As such count (serialseq) i.e. : N18,2(N19),N20
1651 ### Would use substr and index But be careful to previous presence of ()
1652 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1654 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1655 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1658 $recievedlist =~ s/^; //;
1659 $missinglist =~ s/^; //;
1661 $subscription_history->recievedlist($recievedlist);
1662 $subscription_history->missinglist($missinglist);
1663 $subscription_history->store();
1668 =head2 HasSubscriptionStrictlyExpired
1670 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1672 the subscription has stricly expired when today > the end subscription date
1675 1 if true, 0 if false, -1 if the expiration date is not set.
1679 sub HasSubscriptionStrictlyExpired {
1681 # Getting end of subscription date
1682 my ($subscriptionid) = @_;
1684 return unless ($subscriptionid);
1686 my $dbh = C4::Context->dbh;
1687 my $subscription = GetSubscription($subscriptionid);
1688 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1690 # If the expiration date is set
1691 if ( $expirationdate != 0 ) {
1692 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1694 # Getting today's date
1695 my ( $nowyear, $nowmonth, $nowday ) = Today();
1697 # if today's date > expiration date, then the subscription has stricly expired
1698 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1705 # There are some cases where the expiration date is not set
1706 # As we can't determine if the subscription has expired on a date-basis,
1712 =head2 HasSubscriptionExpired
1714 $has_expired = HasSubscriptionExpired($subscriptionid)
1716 the subscription has expired when the next issue to arrive is out of subscription limit.
1719 0 if the subscription has not expired
1720 1 if the subscription has expired
1721 2 if has subscription does not have a valid expiration date set
1725 sub HasSubscriptionExpired {
1726 my ($subscriptionid) = @_;
1728 return unless ($subscriptionid);
1730 my $dbh = C4::Context->dbh;
1731 my $subscription = GetSubscription($subscriptionid);
1732 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1733 if ( $frequency and $frequency->{unit} ) {
1734 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1735 if (!defined $expirationdate) {
1736 $expirationdate = q{};
1739 SELECT max(planneddate)
1741 WHERE subscriptionid=?
1743 my $sth = $dbh->prepare($query);
1744 $sth->execute($subscriptionid);
1745 my ($res) = $sth->fetchrow;
1746 if (!$res || $res=~m/^0000/) {
1749 my @res = split( /-/, $res );
1750 my @endofsubscriptiondate = split( /-/, $expirationdate );
1751 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1753 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1758 if ( $subscription->{'numberlength'} ) {
1759 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1760 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1766 return 0; # Notice that you'll never get here.
1769 =head2 DelSubscription
1771 DelSubscription($subscriptionid)
1772 this function deletes subscription which has $subscriptionid as id.
1776 sub DelSubscription {
1777 my ($subscriptionid) = @_;
1778 my $dbh = C4::Context->dbh;
1779 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1781 Koha::AdditionalFieldValues->search({
1782 'field.tablename' => 'subscription',
1783 'me.record_id' => $subscriptionid,
1784 }, { join => 'field' })->delete;
1786 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1791 DelIssue($serialseq,$subscriptionid)
1792 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1794 returns the number of rows affected
1799 my ($dataissue) = @_;
1800 my $dbh = C4::Context->dbh;
1801 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1806 AND subscriptionid= ?
1808 my $mainsth = $dbh->prepare($query);
1809 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1811 #Delete element from subscription history
1812 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1813 my $sth = $dbh->prepare($query);
1814 $sth->execute( $dataissue->{'subscriptionid'} );
1815 my $val = $sth->fetchrow_hashref;
1816 unless ( $val->{manualhistory} ) {
1818 SELECT * FROM subscriptionhistory
1819 WHERE subscriptionid= ?
1821 my $sth = $dbh->prepare($query);
1822 $sth->execute( $dataissue->{'subscriptionid'} );
1823 my $data = $sth->fetchrow_hashref;
1824 my $serialseq = $dataissue->{'serialseq'};
1825 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1826 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1827 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1828 $sth = $dbh->prepare($strsth);
1829 $sth->execute( $dataissue->{'subscriptionid'} );
1832 return $mainsth->rows;
1835 =head2 GetLateOrMissingIssues
1837 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1839 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1842 the issuelist as an array of hash refs. Each element of this array contains
1843 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1847 sub GetLateOrMissingIssues {
1848 my ( $supplierid, $serialid, $order ) = @_;
1850 return unless ( $supplierid or $serialid );
1852 my $dbh = C4::Context->dbh;
1857 $byserial = "and serialid = " . $serialid;
1860 $order .= ", title";
1864 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1866 $sth = $dbh->prepare(
1868 serialid, aqbooksellerid, name,
1869 biblio.title, biblioitems.issn, planneddate, serialseq,
1870 serial.status, serial.subscriptionid, claimdate, claims_count,
1871 subscription.branchcode, serial.publisheddate
1873 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1874 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1875 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1876 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1877 WHERE subscription.subscriptionid = serial.subscriptionid
1878 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1879 AND subscription.aqbooksellerid=$supplierid
1884 $sth = $dbh->prepare(
1886 serialid, aqbooksellerid, name,
1887 biblio.title, planneddate, serialseq,
1888 serial.status, serial.subscriptionid, claimdate, claims_count,
1889 subscription.branchcode, serial.publisheddate
1891 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1892 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1893 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1894 WHERE subscription.subscriptionid = serial.subscriptionid
1895 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1900 $sth->execute( EXPECTED, LATE, CLAIMED );
1902 while ( my $line = $sth->fetchrow_hashref ) {
1904 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1905 $line->{planneddateISO} = $line->{planneddate};
1906 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1908 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1909 $line->{claimdateISO} = $line->{claimdate};
1910 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1912 $line->{"status".$line->{status}} = 1;
1914 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1915 $line->{additional_fields} = { map { $_->field->name => $_->value }
1916 $subscription_object->additional_field_values->as_list };
1918 push @issuelist, $line;
1925 &updateClaim($serialid)
1927 this function updates the time when a claim is issued for late/missing items
1929 called from claims.pl file
1934 my ($serialids) = @_;
1935 return unless $serialids;
1936 unless ( ref $serialids ) {
1937 $serialids = [ $serialids ];
1939 my $dbh = C4::Context->dbh;
1942 SET claimdate = NOW(),
1943 claims_count = claims_count + 1,
1945 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1946 {}, CLAIMED, @$serialids );
1949 =head2 check_routing
1951 $result = &check_routing($subscriptionid)
1953 this function checks to see if a serial has a routing list and returns the count of routingid
1954 used to show either an 'add' or 'edit' link
1959 my ($subscriptionid) = @_;
1961 return unless ($subscriptionid);
1963 my $dbh = C4::Context->dbh;
1964 my $sth = $dbh->prepare(
1965 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1966 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1967 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1970 $sth->execute($subscriptionid);
1971 my $line = $sth->fetchrow_hashref;
1972 my $result = $line->{'routingids'};
1976 =head2 addroutingmember
1978 addroutingmember($borrowernumber,$subscriptionid)
1980 this function takes a borrowernumber and subscriptionid and adds the member to the
1981 routing list for that serial subscription and gives them a rank on the list
1982 of either 1 or highest current rank + 1
1986 sub addroutingmember {
1987 my ( $borrowernumber, $subscriptionid ) = @_;
1989 return unless ($borrowernumber and $subscriptionid);
1992 my $dbh = C4::Context->dbh;
1993 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1994 $sth->execute($subscriptionid);
1995 while ( my $line = $sth->fetchrow_hashref ) {
1996 if ( $line->{'rank'} > 0 ) {
1997 $rank = $line->{'rank'} + 1;
2002 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2003 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2006 =head2 reorder_members
2008 reorder_members($subscriptionid,$routingid,$rank)
2010 this function is used to reorder the routing list
2012 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2013 - it gets all members on list puts their routingid's into an array
2014 - removes the one in the array that is $routingid
2015 - then reinjects $routingid at point indicated by $rank
2016 - then update the database with the routingids in the new order
2020 sub reorder_members {
2021 my ( $subscriptionid, $routingid, $rank ) = @_;
2022 my $dbh = C4::Context->dbh;
2023 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2024 $sth->execute($subscriptionid);
2026 while ( my $line = $sth->fetchrow_hashref ) {
2027 push( @result, $line->{'routingid'} );
2030 # To find the matching index
2032 my $key = -1; # to allow for 0 being a valid response
2033 for ( $i = 0 ; $i < @result ; $i++ ) {
2034 if ( $routingid == $result[$i] ) {
2035 $key = $i; # save the index
2040 # if index exists in array then move it to new position
2041 if ( $key > -1 && $rank > 0 ) {
2042 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2043 my $moving_item = splice( @result, $key, 1 );
2044 splice( @result, $new_rank, 0, $moving_item );
2046 for ( my $j = 0 ; $j < @result ; $j++ ) {
2047 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2053 =head2 delroutingmember
2055 delroutingmember($routingid,$subscriptionid)
2057 this function either deletes one member from routing list if $routingid exists otherwise
2058 deletes all members from the routing list
2062 sub delroutingmember {
2064 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2065 my ( $routingid, $subscriptionid ) = @_;
2066 my $dbh = C4::Context->dbh;
2068 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2069 $sth->execute($routingid);
2070 reorder_members( $subscriptionid, $routingid );
2072 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2073 $sth->execute($subscriptionid);
2078 =head2 getroutinglist
2080 @routinglist = getroutinglist($subscriptionid)
2082 this gets the info from the subscriptionroutinglist for $subscriptionid
2085 the routinglist as an array. Each element of the array contains a hash_ref containing
2086 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2090 sub getroutinglist {
2091 my ($subscriptionid) = @_;
2092 my $dbh = C4::Context->dbh;
2093 my $sth = $dbh->prepare(
2094 'SELECT routingid, borrowernumber, ranking, biblionumber
2096 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2097 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2099 $sth->execute($subscriptionid);
2100 my $routinglist = $sth->fetchall_arrayref({});
2101 return @{$routinglist};
2104 =head2 countissuesfrom
2106 $result = countissuesfrom($subscriptionid,$startdate)
2108 Returns a count of serial rows matching the given subsctiptionid
2109 with published date greater than startdate
2113 sub countissuesfrom {
2114 my ( $subscriptionid, $startdate ) = @_;
2115 my $dbh = C4::Context->dbh;
2119 WHERE subscriptionid=?
2120 AND serial.publisheddate>?
2122 my $sth = $dbh->prepare($query);
2123 $sth->execute( $subscriptionid, $startdate );
2124 my ($countreceived) = $sth->fetchrow;
2125 return $countreceived;
2130 $result = CountIssues($subscriptionid)
2132 Returns a count of serial rows matching the given subsctiptionid
2137 my ($subscriptionid) = @_;
2138 my $dbh = C4::Context->dbh;
2142 WHERE subscriptionid=?
2144 my $sth = $dbh->prepare($query);
2145 $sth->execute($subscriptionid);
2146 my ($countreceived) = $sth->fetchrow;
2147 return $countreceived;
2152 $result = HasItems($subscriptionid)
2154 returns a count of items from serial matching the subscriptionid
2159 my ($subscriptionid) = @_;
2160 my $dbh = C4::Context->dbh;
2162 SELECT COUNT(serialitems.itemnumber)
2164 LEFT JOIN serialitems USING(serialid)
2165 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2167 my $sth=$dbh->prepare($query);
2168 $sth->execute($subscriptionid);
2169 my ($countitems)=$sth->fetchrow_array();
2173 =head2 abouttoexpire
2175 $result = abouttoexpire($subscriptionid)
2177 this function alerts you to the penultimate issue for a serial subscription
2179 returns 1 - if this is the penultimate issue
2185 my ($subscriptionid) = @_;
2186 my $dbh = C4::Context->dbh;
2187 my $subscription = GetSubscription($subscriptionid);
2188 my $per = $subscription->{'periodicity'};
2189 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2190 if ($frequency and $frequency->{unit}){
2192 my $expirationdate = GetExpirationDate($subscriptionid);
2194 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2195 my $nextdate = GetNextDate($subscription, $res, $frequency);
2197 # only compare dates if both dates exist.
2198 if ($nextdate and $expirationdate) {
2199 if(Date::Calc::Delta_Days(
2200 split( /-/, $nextdate ),
2201 split( /-/, $expirationdate )
2207 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2208 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2214 =head2 GetFictiveIssueNumber
2216 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2218 Get the position of the issue published at $publisheddate, considering the
2219 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2220 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2221 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2222 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2223 depending on how many rows are in serial table.
2224 The issue number calculation is based on subscription frequency, first acquisition
2225 date, and $publisheddate.
2227 Returns undef when called for irregular frequencies.
2229 The routine is used to skip irregularities when calculating the next issue
2230 date (in GetNextDate) or the next issue number (in GetNextSeq).
2234 sub GetFictiveIssueNumber {
2235 my ($subscription, $publisheddate, $frequency) = @_;
2237 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2241 my ( $year, $month, $day ) = split /-/, $publisheddate;
2242 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2243 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2245 if( $frequency->{'unitsperissue'} == 1 ) {
2246 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2247 } else { # issuesperunit == 1
2248 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2254 my ( $date1, $date2, $unit ) = @_;
2255 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2257 if( $unit eq 'day' ) {
2258 return Delta_Days( @$date1, @$date2 );
2259 } elsif( $unit eq 'week' ) {
2260 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2263 # In case of months or years, this is a wrapper around N_Delta_YMD.
2264 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2265 # while we expect 1 month.
2266 my @delta = N_Delta_YMD( @$date1, @$date2 );
2267 if( $delta[2] > 27 ) {
2268 # Check if we could add a month
2269 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2270 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2274 if( $delta[1] >= 12 ) {
2278 # if unit is year, we only return full years
2279 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2282 sub _get_next_date_day {
2283 my ($subscription, $freqdata, $year, $month, $day) = @_;
2285 my @newissue; # ( yy, mm, dd )
2286 # We do not need $delta_days here, since it would be zero where used
2288 if( $freqdata->{issuesperunit} == 1 ) {
2290 @newissue = Add_Delta_Days(
2291 $year, $month, $day, $freqdata->{"unitsperissue"} );
2292 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2294 @newissue = ( $year, $month, $day );
2295 $subscription->{countissuesperunit}++;
2297 # We finished a cycle of issues within a unit.
2298 # No subtraction of zero needed, just add one day
2299 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2300 $subscription->{countissuesperunit} = 1;
2305 sub _get_next_date_week {
2306 my ($subscription, $freqdata, $year, $month, $day) = @_;
2308 my @newissue; # ( yy, mm, dd )
2309 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2311 if( $freqdata->{issuesperunit} == 1 ) {
2312 # Add full weeks (of 7 days)
2313 @newissue = Add_Delta_Days(
2314 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2315 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2316 # Add rounded number of days based on frequency.
2317 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2318 $subscription->{countissuesperunit}++;
2320 # We finished a cycle of issues within a unit.
2321 # Subtract delta * (issues - 1), add 1 week
2322 @newissue = Add_Delta_Days( $year, $month, $day,
2323 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2324 @newissue = Add_Delta_Days( @newissue, 7 );
2325 $subscription->{countissuesperunit} = 1;
2330 sub _get_next_date_month {
2331 my ($subscription, $freqdata, $year, $month, $day) = @_;
2333 my @newissue; # ( yy, mm, dd )
2334 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2336 if( $freqdata->{issuesperunit} == 1 ) {
2338 @newissue = Add_Delta_YM(
2339 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2340 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2341 # Add rounded number of days based on frequency.
2342 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2343 $subscription->{countissuesperunit}++;
2345 # We finished a cycle of issues within a unit.
2346 # Subtract delta * (issues - 1), add 1 month
2347 @newissue = Add_Delta_Days( $year, $month, $day,
2348 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2349 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2350 $subscription->{countissuesperunit} = 1;
2355 sub _get_next_date_year {
2356 my ($subscription, $freqdata, $year, $month, $day) = @_;
2358 my @newissue; # ( yy, mm, dd )
2359 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2361 if( $freqdata->{issuesperunit} == 1 ) {
2363 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2364 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2365 # Add rounded number of days based on frequency.
2366 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2367 $subscription->{countissuesperunit}++;
2369 # We finished a cycle of issues within a unit.
2370 # Subtract delta * (issues - 1), add 1 year
2371 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2372 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2373 $subscription->{countissuesperunit} = 1;
2380 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2382 this function it takes the publisheddate and will return the next issue's date
2383 and will skip dates if there exists an irregularity.
2384 $publisheddate has to be an ISO date
2385 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2386 $frequency is a hashref containing frequency informations
2387 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2388 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2389 skipped then the returned date will be 2007-05-10
2392 $resultdate - then next date in the sequence (ISO date)
2394 Return undef if subscription is irregular
2399 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2401 return unless $subscription and $publisheddate;
2404 if ($freqdata->{'unit'}) {
2405 my ( $year, $month, $day ) = split /-/, $publisheddate;
2407 # Process an irregularity Hash
2408 # Suppose that irregularities are stored in a string with this structure
2409 # irreg1;irreg2;irreg3
2410 # where irregX is the number of issue which will not be received
2411 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2413 if ( $subscription->{irregularity} ) {
2414 my @irreg = split /;/, $subscription->{'irregularity'} ;
2415 foreach my $irregularity (@irreg) {
2416 $irregularities{$irregularity} = 1;
2420 # Get the 'fictive' next issue number
2421 # It is used to check if next issue is an irregular issue.
2422 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2424 # Then get the next date
2425 my $unit = lc $freqdata->{'unit'};
2426 if ($unit eq 'day') {
2427 while ($irregularities{$issueno}) {
2428 ($year, $month, $day) = _get_next_date_day($subscription,
2429 $freqdata, $year, $month, $day);
2432 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2433 $year, $month, $day);
2435 elsif ($unit eq 'week') {
2436 while ($irregularities{$issueno}) {
2437 ($year, $month, $day) = _get_next_date_week($subscription,
2438 $freqdata, $year, $month, $day);
2441 ($year, $month, $day) = _get_next_date_week($subscription,
2442 $freqdata, $year, $month, $day);
2444 elsif ($unit eq 'month') {
2445 while ($irregularities{$issueno}) {
2446 ($year, $month, $day) = _get_next_date_month($subscription,
2447 $freqdata, $year, $month, $day);
2450 ($year, $month, $day) = _get_next_date_month($subscription,
2451 $freqdata, $year, $month, $day);
2453 elsif ($unit eq 'year') {
2454 while ($irregularities{$issueno}) {
2455 ($year, $month, $day) = _get_next_date_year($subscription,
2456 $freqdata, $year, $month, $day);
2459 ($year, $month, $day) = _get_next_date_year($subscription,
2460 $freqdata, $year, $month, $day);
2464 my $dbh = C4::Context->dbh;
2467 SET countissuesperunit = ?
2468 WHERE subscriptionid = ?
2470 my $sth = $dbh->prepare($query);
2471 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2474 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2480 $string = &_numeration($value,$num_type,$locale);
2482 _numeration returns the string corresponding to $value in the num_type
2494 my ($value, $num_type, $locale) = @_;
2499 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2500 # 1970-11-01 was a Sunday
2501 $value = $value % 7;
2502 my $dt = DateTime->new(
2508 $string = $num_type =~ /^dayname$/
2509 ? $dt->strftime("%A")
2510 : $dt->strftime("%a");
2511 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2512 $value = $value % 12;
2513 my $dt = DateTime->new(
2515 month => $value + 1,
2518 $string = $num_type =~ /^monthname$/
2519 ? $dt->format_cldr( "LLLL" )
2520 : $dt->strftime("%b");
2521 } elsif ( $num_type =~ /^season$/ ) {
2522 my @seasons= qw( Spring Summer Fall Winter );
2523 $value = $value % 4;
2524 $string = $seasons[$value];
2525 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2526 my @seasonsabrv= qw( Spr Sum Fal Win );
2527 $value = $value % 4;
2528 $string = $seasonsabrv[$value];
2536 =head2 CloseSubscription
2538 Close a subscription given a subscriptionid
2542 sub CloseSubscription {
2543 my ( $subscriptionid ) = @_;
2544 return unless $subscriptionid;
2545 my $dbh = C4::Context->dbh;
2546 my $sth = $dbh->prepare( q{
2549 WHERE subscriptionid = ?
2551 $sth->execute( $subscriptionid );
2553 # Set status = missing when status = stopped
2554 $sth = $dbh->prepare( q{
2557 WHERE subscriptionid = ?
2560 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2563 =head2 ReopenSubscription
2565 Reopen a subscription given a subscriptionid
2569 sub ReopenSubscription {
2570 my ( $subscriptionid ) = @_;
2571 return unless $subscriptionid;
2572 my $dbh = C4::Context->dbh;
2573 my $sth = $dbh->prepare( q{
2576 WHERE subscriptionid = ?
2578 $sth->execute( $subscriptionid );
2580 # Set status = expected when status = stopped
2581 $sth = $dbh->prepare( q{
2584 WHERE subscriptionid = ?
2587 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2590 =head2 subscriptionCurrentlyOnOrder
2592 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2594 Return 1 if subscription is currently on order else 0.
2598 sub subscriptionCurrentlyOnOrder {
2599 my ( $subscriptionid ) = @_;
2600 my $dbh = C4::Context->dbh;
2602 SELECT COUNT(*) FROM aqorders
2603 WHERE subscriptionid = ?
2604 AND datereceived IS NULL
2605 AND datecancellationprinted IS NULL
2607 my $sth = $dbh->prepare( $query );
2608 $sth->execute($subscriptionid);
2609 return $sth->fetchrow_array;
2612 =head2 can_claim_subscription
2614 $can = can_claim_subscription( $subscriptionid[, $userid] );
2616 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2620 sub can_claim_subscription {
2621 my ( $subscription, $userid ) = @_;
2622 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2625 =head2 can_edit_subscription
2627 $can = can_edit_subscription( $subscriptionid[, $userid] );
2629 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2633 sub can_edit_subscription {
2634 my ( $subscription, $userid ) = @_;
2635 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2638 =head2 can_show_subscription
2640 $can = can_show_subscription( $subscriptionid[, $userid] );
2642 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2646 sub can_show_subscription {
2647 my ( $subscription, $userid ) = @_;
2648 return _can_do_on_subscription( $subscription, $userid, '*' );
2651 sub _can_do_on_subscription {
2652 my ( $subscription, $userid, $permission ) = @_;
2653 return 0 unless C4::Context->userenv;
2654 my $flags = C4::Context->userenv->{flags};
2655 $userid ||= C4::Context->userenv->{'id'};
2657 if ( C4::Context->preference('IndependentBranches') ) {
2659 if C4::Context->IsSuperLibrarian()
2661 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2663 C4::Auth::haspermission( $userid,
2664 { serials => $permission } )
2665 and ( not defined $subscription->{branchcode}
2666 or $subscription->{branchcode} eq ''
2667 or $subscription->{branchcode} eq
2668 C4::Context->userenv->{'branch'} )
2673 if C4::Context->IsSuperLibrarian()
2675 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2676 or C4::Auth::haspermission(
2677 $userid, { serials => $permission }
2684 =head2 findSerialsByStatus
2686 @serials = findSerialsByStatus($status, $subscriptionid);
2688 Returns an array of serials matching a given status and subscription id.
2692 sub findSerialsByStatus {
2693 my ( $status, $subscriptionid ) = @_;
2694 my $dbh = C4::Context->dbh;
2695 my $query = q| SELECT * from serial
2697 AND subscriptionid = ?
2699 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2708 Koha Development Team <http://koha-community.org/>