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 biblio.subtitle AS bibliosubtitle,
273 subscription.biblionumber as bibnum
275 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
276 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
277 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
278 WHERE subscription.subscriptionid = ?
281 my $sth = $dbh->prepare($query);
282 $sth->execute($subscriptionid);
283 my $subscription = $sth->fetchrow_hashref;
285 return unless $subscription;
287 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
289 if ( my $mana_id = $subscription->{mana_id} ) {
290 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
291 'subscription', $mana_id, {usecomments => 1});
292 $subscription->{comments} = $mana_subscription->{data}->{comments};
295 return $subscription;
298 =head2 GetFullSubscription
300 $array_ref = GetFullSubscription($subscriptionid)
301 this function reads the serial table.
305 sub GetFullSubscription {
306 my ($subscriptionid) = @_;
308 return unless ($subscriptionid);
310 my $dbh = C4::Context->dbh;
312 SELECT serial.serialid,
315 serial.publisheddate,
316 serial.publisheddatetext,
318 serial.notes as notes,
319 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
320 aqbooksellers.name as aqbooksellername,
321 biblio.title as bibliotitle,
322 subscription.branchcode AS branchcode,
323 subscription.subscriptionid AS subscriptionid
325 LEFT JOIN subscription ON
326 (serial.subscriptionid=subscription.subscriptionid )
327 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
328 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
329 WHERE serial.subscriptionid = ?
331 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
332 serial.subscriptionid
334 my $sth = $dbh->prepare($query);
335 $sth->execute($subscriptionid);
336 my $subscriptions = $sth->fetchall_arrayref( {} );
337 if (scalar @$subscriptions) {
338 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
339 for my $subscription ( @$subscriptions ) {
340 $subscription->{cannotedit} = $cannotedit;
344 return $subscriptions;
347 =head2 PrepareSerialsData
349 $array_ref = PrepareSerialsData($serialinfomation)
350 where serialinformation is a hashref array
354 sub PrepareSerialsData {
357 return unless ($lines);
364 my $previousnote = "";
366 foreach my $subs (@{$lines}) {
367 $subs->{ "status" . $subs->{'status'} } = 1;
368 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
369 $subs->{"checked"} = 1;
372 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
373 $year = $subs->{'year'};
377 if ( $tmpresults{$year} ) {
378 push @{ $tmpresults{$year}->{'serials'} }, $subs;
380 $tmpresults{$year} = {
382 'aqbooksellername' => $subs->{'aqbooksellername'},
383 'bibliotitle' => $subs->{'bibliotitle'},
384 'serials' => [$subs],
389 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
390 push @res, $tmpresults{$key};
395 =head2 GetSubscriptionsFromBiblionumber
397 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
398 this function get the subscription list. it reads the subscription table.
400 reference to an array of subscriptions which have the biblionumber given on input arg.
401 each element of this array is a hashref containing
402 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
406 sub GetSubscriptionsFromBiblionumber {
407 my ($biblionumber) = @_;
409 return unless ($biblionumber);
411 my $dbh = C4::Context->dbh;
413 SELECT subscription.*,
415 subscriptionhistory.*,
416 aqbooksellers.name AS aqbooksellername,
417 biblio.title AS bibliotitle
419 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
420 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
421 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
422 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
423 WHERE subscription.biblionumber = ?
425 my $sth = $dbh->prepare($query);
426 $sth->execute($biblionumber);
428 while ( my $subs = $sth->fetchrow_hashref ) {
429 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
430 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
431 if ( defined $subs->{histenddate} ) {
432 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
434 $subs->{histenddate} = "";
436 $subs->{opacnote} //= "";
437 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
438 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
439 $subs->{ "status" . $subs->{'status'} } = 1;
441 if (not defined $subs->{enddate} ) {
442 $subs->{enddate} = '';
444 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
446 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
447 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
448 $subs->{cannotedit} = not can_edit_subscription( $subs );
454 =head2 GetFullSubscriptionsFromBiblionumber
456 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
457 this function reads the serial table.
461 sub GetFullSubscriptionsFromBiblionumber {
462 my ($biblionumber) = @_;
463 my $dbh = C4::Context->dbh;
465 SELECT serial.serialid,
468 serial.publisheddate,
469 serial.publisheddatetext,
471 serial.notes as notes,
472 year(IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate)) as year,
473 biblio.title as bibliotitle,
474 subscription.branchcode AS branchcode,
475 subscription.subscriptionid AS subscriptionid,
476 subscription.location AS location
478 LEFT JOIN subscription ON
479 (serial.subscriptionid=subscription.subscriptionid)
480 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
481 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
482 WHERE subscription.biblionumber = ?
484 IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
485 serial.subscriptionid
487 my $sth = $dbh->prepare($query);
488 $sth->execute($biblionumber);
489 my $subscriptions = $sth->fetchall_arrayref( {} );
490 if (scalar @$subscriptions) {
491 my $cannotedit = not can_edit_subscription( $subscriptions->[0] );
492 for my $subscription ( @$subscriptions ) {
493 $subscription->{cannotedit} = $cannotedit;
497 return $subscriptions;
500 =head2 SearchSubscriptions
502 @results = SearchSubscriptions($args);
504 This function returns a list of hashrefs, one for each subscription
505 that meets the conditions specified by the $args hashref.
507 The valid search fields are:
521 The expiration_date search field is special; it specifies the maximum
522 subscription expiration date.
526 sub SearchSubscriptions {
529 my $additional_fields = $args->{additional_fields} // [];
530 my $matching_record_ids_for_additional_fields = [];
531 if ( @$additional_fields ) {
532 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields)->as_list;
534 return () unless @subscriptions;
536 $matching_record_ids_for_additional_fields = [ map {
543 subscription.notes AS publicnotes,
544 subscriptionhistory.*,
546 biblio.notes AS biblionotes,
551 aqbooksellers.name AS vendorname,
554 LEFT JOIN subscriptionhistory USING(subscriptionid)
555 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
556 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
557 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
559 $query .= q| WHERE 1|;
562 if( $args->{biblionumber} ) {
563 push @where_strs, "biblio.biblionumber = ?";
564 push @where_args, $args->{biblionumber};
567 if( $args->{title} ){
568 my @words = split / /, $args->{title};
570 foreach my $word (@words) {
571 push @strs, "biblio.title LIKE ?";
572 push @args, "%$word%";
575 push @where_strs, '(' . join (' AND ', @strs) . ')';
576 push @where_args, @args;
580 push @where_strs, "biblioitems.issn LIKE ?";
581 push @where_args, "%$args->{issn}%";
584 push @where_strs, "biblioitems.ean LIKE ?";
585 push @where_args, "%$args->{ean}%";
587 if ( $args->{callnumber} ) {
588 push @where_strs, "subscription.callnumber LIKE ?";
589 push @where_args, "%$args->{callnumber}%";
591 if( $args->{publisher} ){
592 push @where_strs, "biblioitems.publishercode LIKE ?";
593 push @where_args, "%$args->{publisher}%";
595 if( $args->{bookseller} ){
596 push @where_strs, "aqbooksellers.name LIKE ?";
597 push @where_args, "%$args->{bookseller}%";
599 if( $args->{branch} ){
600 push @where_strs, "subscription.branchcode = ?";
601 push @where_args, "$args->{branch}";
603 if ( $args->{location} ) {
604 push @where_strs, "subscription.location = ?";
605 push @where_args, "$args->{location}";
607 if ( $args->{expiration_date} ) {
608 push @where_strs, "subscription.enddate <= ?";
609 push @where_args, "$args->{expiration_date}";
611 if( defined $args->{closed} ){
612 push @where_strs, "subscription.closed = ?";
613 push @where_args, "$args->{closed}";
617 $query .= ' AND ' . join(' AND ', @where_strs);
619 if ( @$additional_fields ) {
620 $query .= ' AND subscriptionid IN ('
621 . join( ', ', @$matching_record_ids_for_additional_fields )
625 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
627 my $dbh = C4::Context->dbh;
628 my $sth = $dbh->prepare($query);
629 $sth->execute(@where_args);
630 my $results = $sth->fetchall_arrayref( {} );
632 for my $subscription ( @$results ) {
633 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
634 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
636 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
637 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
638 $subscription_object->additional_field_values->as_list };
648 ($totalissues,@serials) = GetSerials($subscriptionid);
649 this function gets every serial not arrived for a given subscription
650 as well as the number of issues registered in the database (all types)
651 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
653 FIXME: We should return \@serials.
658 my ( $subscriptionid, $count ) = @_;
660 return unless $subscriptionid;
662 my $dbh = C4::Context->dbh;
664 # status = 2 is "arrived"
666 $count = 5 unless ($count);
668 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
669 my $query = "SELECT serialid,serialseq, status, publisheddate,
670 publisheddatetext, planneddate,notes, routingnotes
672 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
673 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
674 my $sth = $dbh->prepare($query);
675 $sth->execute($subscriptionid);
677 while ( my $line = $sth->fetchrow_hashref ) {
678 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
679 for my $datefield ( qw( planneddate publisheddate) ) {
680 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
681 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
683 $line->{$datefield} = q{};
686 push @serials, $line;
689 # OK, now add the last 5 issues arrives/missing
690 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
691 publisheddatetext, notes, routingnotes
693 WHERE subscriptionid = ?
694 AND status IN ( $statuses )
695 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
697 $sth = $dbh->prepare($query);
698 $sth->execute($subscriptionid);
699 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
701 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
702 for my $datefield ( qw( planneddate publisheddate) ) {
703 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
704 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
706 $line->{$datefield} = q{};
710 push @serials, $line;
713 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
714 $sth = $dbh->prepare($query);
715 $sth->execute($subscriptionid);
716 my ($totalissues) = $sth->fetchrow;
717 return ( $totalissues, @serials );
722 @serials = GetSerials2($subscriptionid,$statuses);
723 this function returns every serial waited for a given subscription
724 as well as the number of issues registered in the database (all types)
725 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
727 $statuses is an arrayref of statuses and is mandatory.
732 my ( $subscription, $statuses ) = @_;
734 return unless ($subscription and @$statuses);
736 my $dbh = C4::Context->dbh;
738 SELECT serialid,serialseq, status, planneddate, publisheddate,
739 publisheddatetext, notes, routingnotes
741 WHERE subscriptionid=?
743 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
745 ORDER BY publisheddate,serialid DESC
747 my $sth = $dbh->prepare($query);
748 $sth->execute( $subscription, @$statuses );
751 while ( my $line = $sth->fetchrow_hashref ) {
752 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
753 # Format dates for display
754 for my $datefield ( qw( planneddate publisheddate ) ) {
755 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
756 $line->{$datefield} = q{};
759 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
762 push @serials, $line;
767 =head2 GetLatestSerials
769 \@serials = GetLatestSerials($subscriptionid,$limit)
770 get the $limit's latest serials arrived or missing for a given subscription
772 a ref to an array which contains all of the latest serials stored into a hash.
776 sub GetLatestSerials {
777 my ( $subscriptionid, $limit ) = @_;
779 return unless ($subscriptionid and $limit);
781 my $dbh = C4::Context->dbh;
783 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
784 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
786 WHERE subscriptionid = ?
787 AND status IN ($statuses)
788 ORDER BY publisheddate DESC LIMIT 0,$limit
790 my $sth = $dbh->prepare($strsth);
791 $sth->execute($subscriptionid);
793 while ( my $line = $sth->fetchrow_hashref ) {
794 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
795 push @serials, $line;
801 =head2 GetPreviousSerialid
803 $serialid = GetPreviousSerialid($subscriptionid, $nth)
804 get the $nth's previous serial for the given subscriptionid
810 sub GetPreviousSerialid {
811 my ( $subscriptionid, $nth ) = @_;
813 my $dbh = C4::Context->dbh;
817 my $strsth = "SELECT serialid
819 WHERE subscriptionid = ?
821 ORDER BY serialid DESC LIMIT $nth,1
823 my $sth = $dbh->prepare($strsth);
824 $sth->execute($subscriptionid);
826 my $line = $sth->fetchrow_hashref;
827 $return = $line->{'serialid'} if ($line);
835 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
836 $newinnerloop1, $newinnerloop2, $newinnerloop3
837 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
839 $subscription is a hashref containing all the attributes of the table
841 $pattern is a hashref containing all the attributes of the table
842 'subscription_numberpatterns'.
843 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
844 $planneddate is a date string in iso format.
845 This function get the next issue for the subscription given on input arg
850 my ($subscription, $pattern, $frequency, $planneddate) = @_;
852 return unless ($subscription and $pattern);
854 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
855 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
858 if ($subscription->{'skip_serialseq'}) {
859 my @irreg = split /;/, $subscription->{'irregularity'};
861 my $irregularities = {};
862 $irregularities->{$_} = 1 foreach(@irreg);
863 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
864 while($irregularities->{$issueno}) {
871 my $numberingmethod = $pattern->{numberingmethod};
873 if ($numberingmethod) {
874 $calculated = $numberingmethod;
875 my $locale = $subscription->{locale};
876 $newlastvalue1 = $subscription->{lastvalue1} || 0;
877 $newlastvalue2 = $subscription->{lastvalue2} || 0;
878 $newlastvalue3 = $subscription->{lastvalue3} || 0;
879 $newinnerloop1 = $subscription->{innerloop1} || 0;
880 $newinnerloop2 = $subscription->{innerloop2} || 0;
881 $newinnerloop3 = $subscription->{innerloop3} || 0;
884 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
887 for(my $i = 0; $i < $count; $i++) {
889 # check if we have to increase the new value.
891 if ($newinnerloop1 >= $pattern->{every1}) {
893 $newlastvalue1 += $pattern->{add1};
895 # reset counter if needed.
896 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
899 # check if we have to increase the new value.
901 if ($newinnerloop2 >= $pattern->{every2}) {
903 $newlastvalue2 += $pattern->{add2};
905 # reset counter if needed.
906 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
909 # check if we have to increase the new value.
911 if ($newinnerloop3 >= $pattern->{every3}) {
913 $newlastvalue3 += $pattern->{add3};
915 # reset counter if needed.
916 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
920 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
921 $calculated =~ s/\{X\}/$newlastvalue1string/g;
924 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
925 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
928 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
929 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
934 $newlastvalue1, $newlastvalue2, $newlastvalue3,
935 $newinnerloop1, $newinnerloop2, $newinnerloop3);
940 $calculated = GetSeq($subscription, $pattern)
941 $subscription is a hashref containing all the attributes of the table 'subscription'
942 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
943 this function transforms {X},{Y},{Z} to 150,0,0 for example.
945 the sequence in string format
950 my ($subscription, $pattern) = @_;
952 return unless ($subscription and $pattern);
954 my $locale = $subscription->{locale};
956 my $calculated = $pattern->{numberingmethod};
958 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
959 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
960 $calculated =~ s/\{X\}/$newlastvalue1/g;
962 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
963 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
964 $calculated =~ s/\{Y\}/$newlastvalue2/g;
966 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
967 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
968 $calculated =~ s/\{Z\}/$newlastvalue3/g;
972 =head2 GetExpirationDate
974 $enddate = GetExpirationDate($subscriptionid, [$startdate])
976 this function return the next expiration date for a subscription given on input args.
983 sub GetExpirationDate {
984 my ( $subscriptionid, $startdate ) = @_;
986 return unless ($subscriptionid);
988 my $dbh = C4::Context->dbh;
989 my $subscription = GetSubscription($subscriptionid);
992 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
993 $enddate = $startdate || $subscription->{startdate};
994 my @date = split( /-/, $enddate );
996 return if ( scalar(@date) != 3 || not check_date(@date) );
998 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
999 if ( $frequency and $frequency->{unit} ) {
1002 if ( my $length = $subscription->{numberlength} ) {
1004 #calculate the date of the last issue.
1005 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1006 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1008 } elsif ( $subscription->{monthlength} ) {
1009 if ( $$subscription{startdate} ) {
1010 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1011 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1013 } elsif ( $subscription->{weeklength} ) {
1014 if ( $$subscription{startdate} ) {
1015 my @date = split( /-/, $subscription->{startdate} );
1016 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1017 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1020 $enddate = $subscription->{enddate};
1024 return $subscription->{enddate};
1028 =head2 CountSubscriptionFromBiblionumber
1030 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1031 this returns a count of the subscriptions for a given biblionumber
1033 the number of subscriptions
1037 sub CountSubscriptionFromBiblionumber {
1038 my ($biblionumber) = @_;
1040 return unless ($biblionumber);
1042 my $dbh = C4::Context->dbh;
1043 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1044 my $sth = $dbh->prepare($query);
1045 $sth->execute($biblionumber);
1046 my $subscriptionsnumber = $sth->fetchrow;
1047 return $subscriptionsnumber;
1050 =head2 ModSubscriptionHistory
1052 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1054 this function modifies the history of a subscription. Put your new values on input arg.
1055 returns the number of rows affected
1059 sub ModSubscriptionHistory {
1060 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1062 return unless ($subscriptionid);
1064 my $dbh = C4::Context->dbh;
1065 my $query = "UPDATE subscriptionhistory
1066 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1067 WHERE subscriptionid=?
1069 my $sth = $dbh->prepare($query);
1070 $receivedlist =~ s/^; // if $receivedlist;
1071 $missinglist =~ s/^; // if $missinglist;
1072 $opacnote =~ s/^; // if $opacnote;
1073 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1077 =head2 ModSerialStatus
1079 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1080 $publisheddatetext, $status, $notes);
1082 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1083 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1087 sub ModSerialStatus {
1088 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1089 $status, $notes) = @_;
1091 return unless ($serialid);
1093 #It is a usual serial
1094 # 1st, get previous status :
1095 my $dbh = C4::Context->dbh;
1096 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1097 FROM serial, subscription
1098 WHERE serial.subscriptionid=subscription.subscriptionid
1100 my $sth = $dbh->prepare($query);
1101 $sth->execute($serialid);
1102 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1103 my $frequency = GetSubscriptionFrequency($periodicity);
1105 # change status & update subscriptionhistory
1107 if ( $status == DELETED ) {
1108 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1112 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1113 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1116 $sth = $dbh->prepare($query);
1117 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1118 $planneddate, $status, $notes, $routingnotes, $serialid );
1119 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1120 $sth = $dbh->prepare($query);
1121 $sth->execute($subscriptionid);
1122 my $val = $sth->fetchrow_hashref;
1123 unless ( $val->{manualhistory} ) {
1124 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1125 $sth = $dbh->prepare($query);
1126 $sth->execute($subscriptionid);
1127 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1129 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1130 $recievedlist = _handle_seqno($serialseq, $recievedlist);
1133 # in case serial has been previously marked as missing
1134 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1135 $missinglist = _handle_seqno($serialseq, $missinglist, 'REMOVE');
1138 $missinglist = _handle_seqno($serialseq, $missinglist) if grep { $_ == $status } MISSING_STATUSES;
1139 $missinglist .= "; not issued $serialseq" if $status == NOT_ISSUED and not _handle_seqno($serialseq, $missinglist, 'CHECK');
1141 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1142 $sth = $dbh->prepare($query);
1143 $recievedlist =~ s/^; //;
1144 $missinglist =~ s/^; //;
1145 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1149 # create new expected entry if needed (ie : was "expected" and has changed)
1150 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1151 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1152 my $subscription = GetSubscription($subscriptionid);
1153 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1154 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1158 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1159 $newinnerloop1, $newinnerloop2, $newinnerloop3
1161 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1163 # next date (calculated from actual date & frequency parameters)
1164 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1165 my $nextpubdate = $nextpublisheddate;
1166 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1167 WHERE subscriptionid = ?";
1168 $sth = $dbh->prepare($query);
1169 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1170 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1171 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1172 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1173 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1174 require C4::Letters;
1175 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1183 # Adds or removes seqno from list when needed; returns list
1184 # Or checks and returns true when present
1186 my ( $seq, $list, $op ) = @_; # op = ADD | REMOVE | CHECK (default: ADD)
1188 $seq_r =~ s/([()])/\\$1/g; # Adjust disturbing parentheses for regex, maybe extend in future
1190 if( !$op or $op eq 'ADD' ) {
1191 $list .= "; $seq" if $list !~ /(^|;)\s*$seq_r(?=;|$)/;
1192 } elsif( $op eq 'REMOVE' ) {
1193 $list=~ s/(^|;)\s*(not issued )?$seq_r(?=;|$)//g;
1195 return $list =~ /(^|;)\s*$seq_r(?=;|$)/ ? 1 : q{};
1200 =head2 GetNextExpected
1202 $nextexpected = GetNextExpected($subscriptionid)
1204 Get the planneddate for the current expected issue of the subscription.
1210 planneddate => ISO date
1215 sub GetNextExpected {
1216 my ($subscriptionid) = @_;
1218 my $dbh = C4::Context->dbh;
1222 WHERE subscriptionid = ?
1226 my $sth = $dbh->prepare($query);
1228 # Each subscription has only one 'expected' issue.
1229 $sth->execute( $subscriptionid, EXPECTED );
1230 my $nextissue = $sth->fetchrow_hashref;
1231 if ( !$nextissue ) {
1235 WHERE subscriptionid = ?
1236 ORDER BY publisheddate DESC
1239 $sth = $dbh->prepare($query);
1240 $sth->execute($subscriptionid);
1241 $nextissue = $sth->fetchrow_hashref;
1243 foreach(qw/planneddate publisheddate/) {
1244 # or should this default to 1st Jan ???
1245 $nextissue->{$_} //= strftime( '%Y-%m-%d', localtime );
1251 =head2 ModNextExpected
1253 ModNextExpected($subscriptionid,$date)
1255 Update the planneddate for the current expected issue of the subscription.
1256 This will modify all future prediction results.
1258 C<$date> is an ISO date.
1264 sub ModNextExpected {
1265 my ( $subscriptionid, $date ) = @_;
1266 my $dbh = C4::Context->dbh;
1268 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1269 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1271 # Each subscription has only one 'expected' issue.
1272 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1277 =head2 GetSubscriptionIrregularities
1281 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1282 get the list of irregularities for a subscription
1288 sub GetSubscriptionIrregularities {
1289 my $subscriptionid = shift;
1291 return unless $subscriptionid;
1293 my $dbh = C4::Context->dbh;
1297 WHERE subscriptionid = ?
1299 my $sth = $dbh->prepare($query);
1300 $sth->execute($subscriptionid);
1302 my ($result) = $sth->fetchrow_array;
1303 my @irreg = split /;/, $result;
1308 =head2 ModSubscription
1310 this function modifies a subscription. Put all new values on input args.
1311 returns the number of rows affected
1315 sub ModSubscription {
1317 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1318 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1319 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1320 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1321 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1322 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1323 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1324 $itemtype, $previousitemtype, $mana_id, $ccode
1327 my $subscription = Koha::Subscriptions->find($subscriptionid);
1330 librarian => $auser,
1331 branchcode => $branchcode,
1332 aqbooksellerid => $aqbooksellerid,
1334 aqbudgetid => $aqbudgetid,
1335 biblionumber => $biblionumber,
1336 startdate => $startdate,
1337 periodicity => $periodicity,
1338 numberlength => $numberlength,
1339 weeklength => $weeklength,
1340 monthlength => $monthlength,
1341 lastvalue1 => $lastvalue1,
1342 innerloop1 => $innerloop1,
1343 lastvalue2 => $lastvalue2,
1344 innerloop2 => $innerloop2,
1345 lastvalue3 => $lastvalue3,
1346 innerloop3 => $innerloop3,
1350 firstacquidate => $firstacquidate,
1351 irregularity => $irregularity,
1352 numberpattern => $numberpattern,
1354 callnumber => $callnumber,
1355 manualhistory => $manualhistory,
1356 internalnotes => $internalnotes,
1357 serialsadditems => $serialsadditems,
1358 staffdisplaycount => $staffdisplaycount,
1359 opacdisplaycount => $opacdisplaycount,
1360 graceperiod => $graceperiod,
1361 location => $location,
1362 enddate => $enddate,
1363 skip_serialseq => $skip_serialseq,
1364 itemtype => $itemtype,
1365 previousitemtype => $previousitemtype,
1366 mana_id => $mana_id,
1370 # FIXME Must be $subscription->serials
1371 # FIXME We shouldn't need serial.subscription (instead use serial->subscription->biblionumber)
1372 Koha::Serials->search({ subscriptionid => $subscriptionid })->update({ biblionumber => $biblionumber });
1374 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1376 $subscription->discard_changes;
1377 return $subscription;
1380 =head2 NewSubscription
1382 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1383 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1384 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1385 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1386 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1387 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1388 $skip_serialseq, $itemtype, $previousitemtype);
1390 Create a new subscription with value given on input args.
1393 the id of this new subscription
1397 sub NewSubscription {
1399 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1400 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1401 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1402 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1403 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1404 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1405 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id, $ccode
1407 my $dbh = C4::Context->dbh;
1409 my $subscription = Koha::Subscription->new(
1411 librarian => $auser,
1412 branchcode => $branchcode,
1413 aqbooksellerid => $aqbooksellerid,
1415 aqbudgetid => $aqbudgetid,
1416 biblionumber => $biblionumber,
1417 startdate => $startdate,
1418 periodicity => $periodicity,
1419 numberlength => $numberlength,
1420 weeklength => $weeklength,
1421 monthlength => $monthlength,
1422 lastvalue1 => $lastvalue1,
1423 innerloop1 => $innerloop1,
1424 lastvalue2 => $lastvalue2,
1425 innerloop2 => $innerloop2,
1426 lastvalue3 => $lastvalue3,
1427 innerloop3 => $innerloop3,
1431 firstacquidate => $firstacquidate,
1432 irregularity => $irregularity,
1433 numberpattern => $numberpattern,
1435 callnumber => $callnumber,
1436 manualhistory => $manualhistory,
1437 internalnotes => $internalnotes,
1438 serialsadditems => $serialsadditems,
1439 staffdisplaycount => $staffdisplaycount,
1440 opacdisplaycount => $opacdisplaycount,
1441 graceperiod => $graceperiod,
1442 location => $location,
1443 enddate => $enddate,
1444 skip_serialseq => $skip_serialseq,
1445 itemtype => $itemtype,
1446 previousitemtype => $previousitemtype,
1447 mana_id => $mana_id,
1451 $subscription->discard_changes;
1452 my $subscriptionid = $subscription->subscriptionid;
1453 my ( $query, $sth );
1455 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1459 WHERE subscriptionid=?
1461 $sth = $dbh->prepare($query);
1462 $sth->execute( $enddate, $subscriptionid );
1465 # then create the 1st expected number
1467 INSERT INTO subscriptionhistory
1468 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1469 VALUES (?,?,?, '', '')
1471 $sth = $dbh->prepare($query);
1472 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1474 # reread subscription to get a hash (for calculation of the 1st issue number)
1475 $subscription = GetSubscription($subscriptionid); # We should not do that
1476 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1478 # calculate issue number
1479 my $serialseq = GetSeq($subscription, $pattern) || q{};
1483 serialseq => $serialseq,
1484 serialseq_x => $subscription->{'lastvalue1'},
1485 serialseq_y => $subscription->{'lastvalue2'},
1486 serialseq_z => $subscription->{'lastvalue3'},
1487 subscriptionid => $subscriptionid,
1488 biblionumber => $biblionumber,
1490 planneddate => $firstacquidate,
1491 publisheddate => $firstacquidate,
1495 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1497 #set serial flag on biblio if not already set.
1498 my $biblio = Koha::Biblios->find( $biblionumber );
1499 if ( $biblio and !$biblio->serial ) {
1500 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1501 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1503 eval { $record->field($tag)->update( $subf => 1 ); };
1505 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1507 return $subscriptionid;
1510 =head2 GetSubscriptionLength
1512 my ($numberlength, $weeklength, $monthlength) = GetSubscriptionLength( $subtype, $sublength );
1514 This function calculates the subscription length.
1518 sub GetSubscriptionLength {
1519 my ($subtype, $length) = @_;
1521 return unless looks_like_number($length);
1525 $subtype eq 'issues' ? $length : 0,
1526 $subtype eq 'weeks' ? $length : 0,
1527 $subtype eq 'months' ? $length : 0,
1532 =head2 ReNewSubscription
1534 ReNewSubscription($params);
1536 $params is a hashref with the following keys: subscriptionid, user, startdate, numberlength, weeklength, monthlength, note, branchcode
1538 this function renew a subscription with values given on input args.
1542 sub ReNewSubscription {
1543 my ( $params ) = @_;
1544 my $subscriptionid = $params->{subscriptionid};
1545 my $user = $params->{user};
1546 my $startdate = $params->{startdate};
1547 my $numberlength = $params->{numberlength};
1548 my $weeklength = $params->{weeklength};
1549 my $monthlength = $params->{monthlength};
1550 my $note = $params->{note};
1551 my $branchcode = $params->{branchcode};
1553 my $dbh = C4::Context->dbh;
1554 my $subscription = GetSubscription($subscriptionid);
1558 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1559 WHERE biblio.biblionumber=?
1561 my $sth = $dbh->prepare($query);
1562 $sth->execute( $subscription->{biblionumber} );
1563 my $biblio = $sth->fetchrow_hashref;
1565 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1566 require C4::Suggestions;
1567 C4::Suggestions::NewSuggestion(
1568 { 'suggestedby' => $user,
1569 'title' => $subscription->{bibliotitle},
1570 'author' => $biblio->{author},
1571 'publishercode' => $biblio->{publishercode},
1573 'biblionumber' => $subscription->{biblionumber},
1574 'branchcode' => $branchcode,
1579 $numberlength ||= 0; # Should not we raise an exception instead?
1582 # renew subscription
1585 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1586 WHERE subscriptionid=?
1588 $sth = $dbh->prepare($query);
1589 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1590 my $enddate = GetExpirationDate($subscriptionid);
1594 WHERE subscriptionid=?
1596 $sth = $dbh->prepare($query);
1597 $sth->execute( $enddate, $subscriptionid );
1599 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1605 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1607 Create a new issue stored on the database.
1608 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1609 returns the serial id
1614 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1615 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1616 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1618 return unless ($subscriptionid);
1620 my $schema = Koha::Database->new()->schema();
1622 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1624 my $serial = Koha::Serial->new(
1626 serialseq => $serialseq,
1627 serialseq_x => $subscription->lastvalue1(),
1628 serialseq_y => $subscription->lastvalue2(),
1629 serialseq_z => $subscription->lastvalue3(),
1630 subscriptionid => $subscriptionid,
1631 biblionumber => $biblionumber,
1633 planneddate => $planneddate,
1634 publisheddate => $publisheddate,
1635 publisheddatetext => $publisheddatetext,
1637 routingnotes => $routingnotes
1641 my $serialid = $serial->id();
1643 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1644 my $missinglist = $subscription_history->missinglist();
1645 my $recievedlist = $subscription_history->recievedlist();
1647 if ( $status == ARRIVED ) {
1648 ### TODO Add a feature that improves recognition and description.
1649 ### As such count (serialseq) i.e. : N18,2(N19),N20
1650 ### Would use substr and index But be careful to previous presence of ()
1651 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1653 if ( grep { $_ eq $status } (MISSING_STATUSES) ) {
1654 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1657 $recievedlist =~ s/^; //;
1658 $missinglist =~ s/^; //;
1660 $subscription_history->recievedlist($recievedlist);
1661 $subscription_history->missinglist($missinglist);
1662 $subscription_history->store();
1667 =head2 HasSubscriptionStrictlyExpired
1669 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1671 the subscription has stricly expired when today > the end subscription date
1674 1 if true, 0 if false, -1 if the expiration date is not set.
1678 sub HasSubscriptionStrictlyExpired {
1680 # Getting end of subscription date
1681 my ($subscriptionid) = @_;
1683 return unless ($subscriptionid);
1685 my $dbh = C4::Context->dbh;
1686 my $subscription = GetSubscription($subscriptionid);
1687 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1689 # If the expiration date is set
1690 if ( $expirationdate != 0 ) {
1691 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1693 # Getting today's date
1694 my ( $nowyear, $nowmonth, $nowday ) = Today();
1696 # if today's date > expiration date, then the subscription has stricly expired
1697 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1704 # There are some cases where the expiration date is not set
1705 # As we can't determine if the subscription has expired on a date-basis,
1711 =head2 HasSubscriptionExpired
1713 $has_expired = HasSubscriptionExpired($subscriptionid)
1715 the subscription has expired when the next issue to arrive is out of subscription limit.
1718 0 if the subscription has not expired
1719 1 if the subscription has expired
1720 2 if has subscription does not have a valid expiration date set
1724 sub HasSubscriptionExpired {
1725 my ($subscriptionid) = @_;
1727 return unless ($subscriptionid);
1729 my $dbh = C4::Context->dbh;
1730 my $subscription = GetSubscription($subscriptionid);
1731 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1732 if ( $frequency and $frequency->{unit} ) {
1733 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1734 if (!defined $expirationdate) {
1735 $expirationdate = q{};
1738 SELECT max(planneddate)
1740 WHERE subscriptionid=?
1742 my $sth = $dbh->prepare($query);
1743 $sth->execute($subscriptionid);
1744 my ($res) = $sth->fetchrow;
1745 if (!$res || $res=~m/^0000/) {
1748 my @res = split( /-/, $res );
1749 my @endofsubscriptiondate = split( /-/, $expirationdate );
1750 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1752 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1757 if ( $subscription->{'numberlength'} ) {
1758 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1759 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1765 return 0; # Notice that you'll never get here.
1768 =head2 DelSubscription
1770 DelSubscription($subscriptionid)
1771 this function deletes subscription which has $subscriptionid as id.
1775 sub DelSubscription {
1776 my ($subscriptionid) = @_;
1777 my $dbh = C4::Context->dbh;
1778 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1780 Koha::AdditionalFieldValues->search({
1781 'field.tablename' => 'subscription',
1782 'me.record_id' => $subscriptionid,
1783 }, { join => 'field' })->delete;
1785 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1790 DelIssue($serialseq,$subscriptionid)
1791 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1793 returns the number of rows affected
1798 my ($dataissue) = @_;
1799 my $dbh = C4::Context->dbh;
1800 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1805 AND subscriptionid= ?
1807 my $mainsth = $dbh->prepare($query);
1808 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1810 #Delete element from subscription history
1811 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1812 my $sth = $dbh->prepare($query);
1813 $sth->execute( $dataissue->{'subscriptionid'} );
1814 my $val = $sth->fetchrow_hashref;
1815 unless ( $val->{manualhistory} ) {
1817 SELECT * FROM subscriptionhistory
1818 WHERE subscriptionid= ?
1820 my $sth = $dbh->prepare($query);
1821 $sth->execute( $dataissue->{'subscriptionid'} );
1822 my $data = $sth->fetchrow_hashref;
1823 my $serialseq = $dataissue->{'serialseq'};
1824 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1825 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1826 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1827 $sth = $dbh->prepare($strsth);
1828 $sth->execute( $dataissue->{'subscriptionid'} );
1831 return $mainsth->rows;
1834 =head2 GetLateOrMissingIssues
1836 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1838 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1841 the issuelist as an array of hash refs. Each element of this array contains
1842 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1846 sub GetLateOrMissingIssues {
1847 my ( $supplierid, $serialid, $order ) = @_;
1849 return unless ( $supplierid or $serialid );
1851 my $dbh = C4::Context->dbh;
1856 $byserial = "and serialid = " . $serialid;
1859 $order .= ", title";
1863 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1865 $sth = $dbh->prepare(
1867 serialid, aqbooksellerid, name,
1868 biblio.title, biblioitems.issn, planneddate, serialseq,
1869 serial.status, serial.subscriptionid, claimdate, claims_count,
1870 subscription.branchcode, serial.publisheddate
1872 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1873 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1874 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1875 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1876 WHERE subscription.subscriptionid = serial.subscriptionid
1877 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1878 AND subscription.aqbooksellerid=$supplierid
1883 $sth = $dbh->prepare(
1885 serialid, aqbooksellerid, name,
1886 biblio.title, planneddate, serialseq,
1887 serial.status, serial.subscriptionid, claimdate, claims_count,
1888 subscription.branchcode, serial.publisheddate
1890 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1891 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1892 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1893 WHERE subscription.subscriptionid = serial.subscriptionid
1894 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1899 $sth->execute( EXPECTED, LATE, CLAIMED );
1901 while ( my $line = $sth->fetchrow_hashref ) {
1903 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1904 $line->{planneddateISO} = $line->{planneddate};
1905 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1907 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1908 $line->{claimdateISO} = $line->{claimdate};
1909 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1911 $line->{"status".$line->{status}} = 1;
1913 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1914 $line->{additional_fields} = { map { $_->field->name => $_->value }
1915 $subscription_object->additional_field_values->as_list };
1917 push @issuelist, $line;
1924 &updateClaim($serialid)
1926 this function updates the time when a claim is issued for late/missing items
1928 called from claims.pl file
1933 my ($serialids) = @_;
1934 return unless $serialids;
1935 unless ( ref $serialids ) {
1936 $serialids = [ $serialids ];
1938 my $dbh = C4::Context->dbh;
1941 SET claimdate = NOW(),
1942 claims_count = claims_count + 1,
1944 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1945 {}, CLAIMED, @$serialids );
1948 =head2 check_routing
1950 $result = &check_routing($subscriptionid)
1952 this function checks to see if a serial has a routing list and returns the count of routingid
1953 used to show either an 'add' or 'edit' link
1958 my ($subscriptionid) = @_;
1960 return unless ($subscriptionid);
1962 my $dbh = C4::Context->dbh;
1963 my $sth = $dbh->prepare(
1964 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1965 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1966 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1969 $sth->execute($subscriptionid);
1970 my $line = $sth->fetchrow_hashref;
1971 my $result = $line->{'routingids'};
1975 =head2 addroutingmember
1977 addroutingmember($borrowernumber,$subscriptionid)
1979 this function takes a borrowernumber and subscriptionid and adds the member to the
1980 routing list for that serial subscription and gives them a rank on the list
1981 of either 1 or highest current rank + 1
1985 sub addroutingmember {
1986 my ( $borrowernumber, $subscriptionid ) = @_;
1988 return unless ($borrowernumber and $subscriptionid);
1991 my $dbh = C4::Context->dbh;
1992 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1993 $sth->execute($subscriptionid);
1994 while ( my $line = $sth->fetchrow_hashref ) {
1995 if ( $line->{'rank'} > 0 ) {
1996 $rank = $line->{'rank'} + 1;
2001 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2002 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2005 =head2 reorder_members
2007 reorder_members($subscriptionid,$routingid,$rank)
2009 this function is used to reorder the routing list
2011 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2012 - it gets all members on list puts their routingid's into an array
2013 - removes the one in the array that is $routingid
2014 - then reinjects $routingid at point indicated by $rank
2015 - then update the database with the routingids in the new order
2019 sub reorder_members {
2020 my ( $subscriptionid, $routingid, $rank ) = @_;
2021 my $dbh = C4::Context->dbh;
2022 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2023 $sth->execute($subscriptionid);
2025 while ( my $line = $sth->fetchrow_hashref ) {
2026 push( @result, $line->{'routingid'} );
2029 # To find the matching index
2031 my $key = -1; # to allow for 0 being a valid response
2032 for ( $i = 0 ; $i < @result ; $i++ ) {
2033 if ( $routingid == $result[$i] ) {
2034 $key = $i; # save the index
2039 # if index exists in array then move it to new position
2040 if ( $key > -1 && $rank > 0 ) {
2041 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2042 my $moving_item = splice( @result, $key, 1 );
2043 splice( @result, $new_rank, 0, $moving_item );
2045 for ( my $j = 0 ; $j < @result ; $j++ ) {
2046 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2052 =head2 delroutingmember
2054 delroutingmember($routingid,$subscriptionid)
2056 this function either deletes one member from routing list if $routingid exists otherwise
2057 deletes all members from the routing list
2061 sub delroutingmember {
2063 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2064 my ( $routingid, $subscriptionid ) = @_;
2065 my $dbh = C4::Context->dbh;
2067 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2068 $sth->execute($routingid);
2069 reorder_members( $subscriptionid, $routingid );
2071 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2072 $sth->execute($subscriptionid);
2077 =head2 getroutinglist
2079 @routinglist = getroutinglist($subscriptionid)
2081 this gets the info from the subscriptionroutinglist for $subscriptionid
2084 the routinglist as an array. Each element of the array contains a hash_ref containing
2085 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2089 sub getroutinglist {
2090 my ($subscriptionid) = @_;
2091 my $dbh = C4::Context->dbh;
2092 my $sth = $dbh->prepare(
2093 'SELECT routingid, borrowernumber, ranking, biblionumber
2095 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2096 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2098 $sth->execute($subscriptionid);
2099 my $routinglist = $sth->fetchall_arrayref({});
2100 return @{$routinglist};
2103 =head2 countissuesfrom
2105 $result = countissuesfrom($subscriptionid,$startdate)
2107 Returns a count of serial rows matching the given subsctiptionid
2108 with published date greater than startdate
2112 sub countissuesfrom {
2113 my ( $subscriptionid, $startdate ) = @_;
2114 my $dbh = C4::Context->dbh;
2118 WHERE subscriptionid=?
2119 AND serial.publisheddate>?
2121 my $sth = $dbh->prepare($query);
2122 $sth->execute( $subscriptionid, $startdate );
2123 my ($countreceived) = $sth->fetchrow;
2124 return $countreceived;
2129 $result = CountIssues($subscriptionid)
2131 Returns a count of serial rows matching the given subsctiptionid
2136 my ($subscriptionid) = @_;
2137 my $dbh = C4::Context->dbh;
2141 WHERE subscriptionid=?
2143 my $sth = $dbh->prepare($query);
2144 $sth->execute($subscriptionid);
2145 my ($countreceived) = $sth->fetchrow;
2146 return $countreceived;
2151 $result = HasItems($subscriptionid)
2153 returns a count of items from serial matching the subscriptionid
2158 my ($subscriptionid) = @_;
2159 my $dbh = C4::Context->dbh;
2161 SELECT COUNT(serialitems.itemnumber)
2163 LEFT JOIN serialitems USING(serialid)
2164 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2166 my $sth=$dbh->prepare($query);
2167 $sth->execute($subscriptionid);
2168 my ($countitems)=$sth->fetchrow_array();
2172 =head2 abouttoexpire
2174 $result = abouttoexpire($subscriptionid)
2176 this function alerts you to the penultimate issue for a serial subscription
2178 returns 1 - if this is the penultimate issue
2184 my ($subscriptionid) = @_;
2185 my $dbh = C4::Context->dbh;
2186 my $subscription = GetSubscription($subscriptionid);
2187 my $per = $subscription->{'periodicity'};
2188 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2189 if ($frequency and $frequency->{unit}){
2191 my $expirationdate = GetExpirationDate($subscriptionid);
2193 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2194 my $nextdate = GetNextDate($subscription, $res, $frequency);
2196 # only compare dates if both dates exist.
2197 if ($nextdate and $expirationdate) {
2198 if(Date::Calc::Delta_Days(
2199 split( /-/, $nextdate ),
2200 split( /-/, $expirationdate )
2206 } elsif ( $subscription->{numberlength} && $subscription->{numberlength}>0) {
2207 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2213 =head2 GetFictiveIssueNumber
2215 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2217 Get the position of the issue published at $publisheddate, considering the
2218 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2219 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2220 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2221 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2222 depending on how many rows are in serial table.
2223 The issue number calculation is based on subscription frequency, first acquisition
2224 date, and $publisheddate.
2226 Returns undef when called for irregular frequencies.
2228 The routine is used to skip irregularities when calculating the next issue
2229 date (in GetNextDate) or the next issue number (in GetNextSeq).
2233 sub GetFictiveIssueNumber {
2234 my ($subscription, $publisheddate, $frequency) = @_;
2236 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2240 my ( $year, $month, $day ) = split /-/, $publisheddate;
2241 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2242 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2244 if( $frequency->{'unitsperissue'} == 1 ) {
2245 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2246 } else { # issuesperunit == 1
2247 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2253 my ( $date1, $date2, $unit ) = @_;
2254 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2256 if( $unit eq 'day' ) {
2257 return Delta_Days( @$date1, @$date2 );
2258 } elsif( $unit eq 'week' ) {
2259 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2262 # In case of months or years, this is a wrapper around N_Delta_YMD.
2263 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2264 # while we expect 1 month.
2265 my @delta = N_Delta_YMD( @$date1, @$date2 );
2266 if( $delta[2] > 27 ) {
2267 # Check if we could add a month
2268 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2269 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2273 if( $delta[1] >= 12 ) {
2277 # if unit is year, we only return full years
2278 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2281 sub _get_next_date_day {
2282 my ($subscription, $freqdata, $year, $month, $day) = @_;
2284 my @newissue; # ( yy, mm, dd )
2285 # We do not need $delta_days here, since it would be zero where used
2287 if( $freqdata->{issuesperunit} == 1 ) {
2289 @newissue = Add_Delta_Days(
2290 $year, $month, $day, $freqdata->{"unitsperissue"} );
2291 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2293 @newissue = ( $year, $month, $day );
2294 $subscription->{countissuesperunit}++;
2296 # We finished a cycle of issues within a unit.
2297 # No subtraction of zero needed, just add one day
2298 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2299 $subscription->{countissuesperunit} = 1;
2304 sub _get_next_date_week {
2305 my ($subscription, $freqdata, $year, $month, $day) = @_;
2307 my @newissue; # ( yy, mm, dd )
2308 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2310 if( $freqdata->{issuesperunit} == 1 ) {
2311 # Add full weeks (of 7 days)
2312 @newissue = Add_Delta_Days(
2313 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2314 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2315 # Add rounded number of days based on frequency.
2316 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2317 $subscription->{countissuesperunit}++;
2319 # We finished a cycle of issues within a unit.
2320 # Subtract delta * (issues - 1), add 1 week
2321 @newissue = Add_Delta_Days( $year, $month, $day,
2322 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2323 @newissue = Add_Delta_Days( @newissue, 7 );
2324 $subscription->{countissuesperunit} = 1;
2329 sub _get_next_date_month {
2330 my ($subscription, $freqdata, $year, $month, $day) = @_;
2332 my @newissue; # ( yy, mm, dd )
2333 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2335 if( $freqdata->{issuesperunit} == 1 ) {
2337 @newissue = Add_Delta_YM(
2338 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2339 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2340 # Add rounded number of days based on frequency.
2341 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2342 $subscription->{countissuesperunit}++;
2344 # We finished a cycle of issues within a unit.
2345 # Subtract delta * (issues - 1), add 1 month
2346 @newissue = Add_Delta_Days( $year, $month, $day,
2347 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2348 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2349 $subscription->{countissuesperunit} = 1;
2354 sub _get_next_date_year {
2355 my ($subscription, $freqdata, $year, $month, $day) = @_;
2357 my @newissue; # ( yy, mm, dd )
2358 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2360 if( $freqdata->{issuesperunit} == 1 ) {
2362 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2363 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2364 # Add rounded number of days based on frequency.
2365 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2366 $subscription->{countissuesperunit}++;
2368 # We finished a cycle of issues within a unit.
2369 # Subtract delta * (issues - 1), add 1 year
2370 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2371 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2372 $subscription->{countissuesperunit} = 1;
2379 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2381 this function it takes the publisheddate and will return the next issue's date
2382 and will skip dates if there exists an irregularity.
2383 $publisheddate has to be an ISO date
2384 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2385 $frequency is a hashref containing frequency informations
2386 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2387 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2388 skipped then the returned date will be 2007-05-10
2391 $resultdate - then next date in the sequence (ISO date)
2393 Return undef if subscription is irregular
2398 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2400 return unless $subscription and $publisheddate;
2403 if ($freqdata->{'unit'}) {
2404 my ( $year, $month, $day ) = split /-/, $publisheddate;
2406 # Process an irregularity Hash
2407 # Suppose that irregularities are stored in a string with this structure
2408 # irreg1;irreg2;irreg3
2409 # where irregX is the number of issue which will not be received
2410 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2412 if ( $subscription->{irregularity} ) {
2413 my @irreg = split /;/, $subscription->{'irregularity'} ;
2414 foreach my $irregularity (@irreg) {
2415 $irregularities{$irregularity} = 1;
2419 # Get the 'fictive' next issue number
2420 # It is used to check if next issue is an irregular issue.
2421 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2423 # Then get the next date
2424 my $unit = lc $freqdata->{'unit'};
2425 if ($unit eq 'day') {
2426 while ($irregularities{$issueno}) {
2427 ($year, $month, $day) = _get_next_date_day($subscription,
2428 $freqdata, $year, $month, $day);
2431 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2432 $year, $month, $day);
2434 elsif ($unit eq 'week') {
2435 while ($irregularities{$issueno}) {
2436 ($year, $month, $day) = _get_next_date_week($subscription,
2437 $freqdata, $year, $month, $day);
2440 ($year, $month, $day) = _get_next_date_week($subscription,
2441 $freqdata, $year, $month, $day);
2443 elsif ($unit eq 'month') {
2444 while ($irregularities{$issueno}) {
2445 ($year, $month, $day) = _get_next_date_month($subscription,
2446 $freqdata, $year, $month, $day);
2449 ($year, $month, $day) = _get_next_date_month($subscription,
2450 $freqdata, $year, $month, $day);
2452 elsif ($unit eq 'year') {
2453 while ($irregularities{$issueno}) {
2454 ($year, $month, $day) = _get_next_date_year($subscription,
2455 $freqdata, $year, $month, $day);
2458 ($year, $month, $day) = _get_next_date_year($subscription,
2459 $freqdata, $year, $month, $day);
2463 my $dbh = C4::Context->dbh;
2466 SET countissuesperunit = ?
2467 WHERE subscriptionid = ?
2469 my $sth = $dbh->prepare($query);
2470 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2473 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2479 $string = &_numeration($value,$num_type,$locale);
2481 _numeration returns the string corresponding to $value in the num_type
2493 my ($value, $num_type, $locale) = @_;
2498 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2499 # 1970-11-01 was a Sunday
2500 $value = $value % 7;
2501 my $dt = DateTime->new(
2507 $string = $num_type =~ /^dayname$/
2508 ? $dt->strftime("%A")
2509 : $dt->strftime("%a");
2510 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2511 $value = $value % 12;
2512 my $dt = DateTime->new(
2514 month => $value + 1,
2517 $string = $num_type =~ /^monthname$/
2518 ? $dt->format_cldr( "LLLL" )
2519 : $dt->strftime("%b");
2520 } elsif ( $num_type =~ /^season$/ ) {
2521 my @seasons= qw( Spring Summer Fall Winter );
2522 $value = $value % 4;
2523 $string = $seasons[$value];
2524 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2525 my @seasonsabrv= qw( Spr Sum Fal Win );
2526 $value = $value % 4;
2527 $string = $seasonsabrv[$value];
2535 =head2 CloseSubscription
2537 Close a subscription given a subscriptionid
2541 sub CloseSubscription {
2542 my ( $subscriptionid ) = @_;
2543 return unless $subscriptionid;
2544 my $dbh = C4::Context->dbh;
2545 my $sth = $dbh->prepare( q{
2548 WHERE subscriptionid = ?
2550 $sth->execute( $subscriptionid );
2552 # Set status = missing when status = stopped
2553 $sth = $dbh->prepare( q{
2556 WHERE subscriptionid = ?
2559 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2562 =head2 ReopenSubscription
2564 Reopen a subscription given a subscriptionid
2568 sub ReopenSubscription {
2569 my ( $subscriptionid ) = @_;
2570 return unless $subscriptionid;
2571 my $dbh = C4::Context->dbh;
2572 my $sth = $dbh->prepare( q{
2575 WHERE subscriptionid = ?
2577 $sth->execute( $subscriptionid );
2579 # Set status = expected when status = stopped
2580 $sth = $dbh->prepare( q{
2583 WHERE subscriptionid = ?
2586 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2589 =head2 subscriptionCurrentlyOnOrder
2591 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2593 Return 1 if subscription is currently on order else 0.
2597 sub subscriptionCurrentlyOnOrder {
2598 my ( $subscriptionid ) = @_;
2599 my $dbh = C4::Context->dbh;
2601 SELECT COUNT(*) FROM aqorders
2602 WHERE subscriptionid = ?
2603 AND datereceived IS NULL
2604 AND datecancellationprinted IS NULL
2606 my $sth = $dbh->prepare( $query );
2607 $sth->execute($subscriptionid);
2608 return $sth->fetchrow_array;
2611 =head2 can_claim_subscription
2613 $can = can_claim_subscription( $subscriptionid[, $userid] );
2615 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2619 sub can_claim_subscription {
2620 my ( $subscription, $userid ) = @_;
2621 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2624 =head2 can_edit_subscription
2626 $can = can_edit_subscription( $subscriptionid[, $userid] );
2628 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2632 sub can_edit_subscription {
2633 my ( $subscription, $userid ) = @_;
2634 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2637 =head2 can_show_subscription
2639 $can = can_show_subscription( $subscriptionid[, $userid] );
2641 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2645 sub can_show_subscription {
2646 my ( $subscription, $userid ) = @_;
2647 return _can_do_on_subscription( $subscription, $userid, '*' );
2650 sub _can_do_on_subscription {
2651 my ( $subscription, $userid, $permission ) = @_;
2652 return 0 unless C4::Context->userenv;
2653 my $flags = C4::Context->userenv->{flags};
2654 $userid ||= C4::Context->userenv->{'id'};
2656 if ( C4::Context->preference('IndependentBranches') ) {
2658 if C4::Context->IsSuperLibrarian()
2660 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2662 C4::Auth::haspermission( $userid,
2663 { serials => $permission } )
2664 and ( not defined $subscription->{branchcode}
2665 or $subscription->{branchcode} eq ''
2666 or $subscription->{branchcode} eq
2667 C4::Context->userenv->{'branch'} )
2672 if C4::Context->IsSuperLibrarian()
2674 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2675 or C4::Auth::haspermission(
2676 $userid, { serials => $permission }
2683 =head2 findSerialsByStatus
2685 @serials = findSerialsByStatus($status, $subscriptionid);
2687 Returns an array of serials matching a given status and subscription id.
2691 sub findSerialsByStatus {
2692 my ( $status, $subscriptionid ) = @_;
2693 my $dbh = C4::Context->dbh;
2694 my $query = q| SELECT * from serial
2696 AND subscriptionid = ?
2698 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2707 Koha Development Team <http://koha-community.org/>