3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalFieldValues;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
38 use Koha::SharedContent;
40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 MISSING_NEVER_RECIEVED => 41,
49 MISSING_SOLD_OUT => 42,
50 MISSING_DAMAGED => 43,
58 use constant MISSING_STATUSES => (
59 MISSING, MISSING_NEVER_RECIEVED,
60 MISSING_SOLD_OUT, MISSING_DAMAGED,
68 &NewSubscription &ModSubscription &DelSubscription
69 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
71 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
72 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
73 &GetSubscriptionHistoryFromSubscriptionId
75 &GetNextSeq &GetSeq &NewIssue &GetSerials
76 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
77 &ReNewSubscription &GetLateOrMissingIssues
78 &GetSerialInformation &AddItem2Serial
79 &PrepareSerialsData &GetNextExpected &ModNextExpected
82 &GetSuppliersWithLateIssues
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &subscriptionCurrentlyOnOrder
95 C4::Serials - Serials Module Functions
103 Functions for handling subscriptions, claims routing etc.
108 =head2 GetSuppliersWithLateIssues
110 $supplierlist = GetSuppliersWithLateIssues()
112 this function get all suppliers with late issues.
115 an array_ref of suppliers each entry is a hash_ref containing id and name
116 the array is in name order
120 sub GetSuppliersWithLateIssues {
121 my $dbh = C4::Context->dbh;
122 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
124 SELECT DISTINCT id, name
126 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
127 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 (planneddate < now() AND serial.status=1)
131 OR serial.STATUS IN ( $statuses )
133 AND subscription.closed = 0
135 return $dbh->selectall_arrayref($query, { Slice => {} });
138 =head2 GetSubscriptionHistoryFromSubscriptionId
140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
142 This function returns the subscription history as a hashref
146 sub GetSubscriptionHistoryFromSubscriptionId {
147 my ($subscriptionid) = @_;
149 return unless $subscriptionid;
151 my $dbh = C4::Context->dbh;
154 FROM subscriptionhistory
155 WHERE subscriptionid = ?
157 my $sth = $dbh->prepare($query);
158 $sth->execute($subscriptionid);
159 my $results = $sth->fetchrow_hashref;
165 =head2 GetSerialInformation
167 $data = GetSerialInformation($serialid);
168 returns a hash_ref containing :
169 items : items marcrecord (can be an array)
171 subscription table field
172 + information about subscription expiration
176 sub GetSerialInformation {
178 my $dbh = C4::Context->dbh;
180 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
181 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
184 my $rq = $dbh->prepare($query);
185 $rq->execute($serialid);
186 my $data = $rq->fetchrow_hashref;
188 # create item information if we have serialsadditems for this subscription
189 if ( $data->{'serialsadditems'} ) {
190 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
191 $queryitem->execute($serialid);
192 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
194 if ( scalar(@$itemnumbers) > 0 ) {
195 foreach my $itemnum (@$itemnumbers) {
197 #It is ASSUMED that GetMarcItem ALWAYS WORK...
198 #Maybe GetMarcItem should return values on failure
199 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
200 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
201 $itemprocessed->{'itemnumber'} = $itemnum->[0];
202 $itemprocessed->{'itemid'} = $itemnum->[0];
203 $itemprocessed->{'serialid'} = $serialid;
204 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
205 push @{ $data->{'items'} }, $itemprocessed;
208 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
209 $itemprocessed->{'itemid'} = "N$serialid";
210 $itemprocessed->{'serialid'} = $serialid;
211 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
212 $itemprocessed->{'countitems'} = 0;
213 push @{ $data->{'items'} }, $itemprocessed;
216 $data->{ "status" . $data->{'serstatus'} } = 1;
217 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
218 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
219 $data->{cannotedit} = not can_edit_subscription( $data );
223 =head2 AddItem2Serial
225 $rows = AddItem2Serial($serialid,$itemnumber);
226 Adds an itemnumber to Serial record
227 returns the number of rows affected
232 my ( $serialid, $itemnumber ) = @_;
234 return unless ($serialid and $itemnumber);
236 my $dbh = C4::Context->dbh;
237 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
238 $rq->execute( $serialid, $itemnumber );
242 =head2 GetSubscription
244 $subs = GetSubscription($subscriptionid)
245 this function returns the subscription which has $subscriptionid as id.
247 a hashref. This hash contains
248 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
252 sub GetSubscription {
253 my ($subscriptionid) = @_;
254 my $dbh = C4::Context->dbh;
256 SELECT subscription.*,
257 subscriptionhistory.*,
258 aqbooksellers.name AS aqbooksellername,
259 biblio.title AS bibliotitle,
260 subscription.biblionumber as bibnum
262 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
263 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
264 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
265 WHERE subscription.subscriptionid = ?
268 $debug and warn "query : $query\nsubsid :$subscriptionid";
269 my $sth = $dbh->prepare($query);
270 $sth->execute($subscriptionid);
271 my $subscription = $sth->fetchrow_hashref;
273 return unless $subscription;
275 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
277 if ( my $mana_id = $subscription->{mana_id} ) {
278 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
279 'subscription', $mana_id, {usecomments => 1});
280 $subscription->{comments} = $mana_subscription->{data}->{comments};
283 return $subscription;
286 =head2 GetFullSubscription
288 $array_ref = GetFullSubscription($subscriptionid)
289 this function reads the serial table.
293 sub GetFullSubscription {
294 my ($subscriptionid) = @_;
296 return unless ($subscriptionid);
298 my $dbh = C4::Context->dbh;
300 SELECT serial.serialid,
303 serial.publisheddate,
304 serial.publisheddatetext,
306 serial.notes as notes,
307 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
308 aqbooksellers.name as aqbooksellername,
309 biblio.title as bibliotitle,
310 subscription.branchcode AS branchcode,
311 subscription.subscriptionid AS subscriptionid
313 LEFT JOIN subscription ON
314 (serial.subscriptionid=subscription.subscriptionid )
315 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
316 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
317 WHERE serial.subscriptionid = ?
319 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
320 serial.subscriptionid
322 $debug and warn "GetFullSubscription query: $query";
323 my $sth = $dbh->prepare($query);
324 $sth->execute($subscriptionid);
325 my $subscriptions = $sth->fetchall_arrayref( {} );
326 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
327 for my $subscription ( @$subscriptions ) {
328 $subscription->{cannotedit} = $cannotedit;
330 return $subscriptions;
333 =head2 PrepareSerialsData
335 $array_ref = PrepareSerialsData($serialinfomation)
336 where serialinformation is a hashref array
340 sub PrepareSerialsData {
343 return unless ($lines);
349 my $aqbooksellername;
353 my $previousnote = "";
355 foreach my $subs (@{$lines}) {
356 for my $datefield ( qw(publisheddate planneddate) ) {
357 # handle 0000-00-00 dates
358 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
359 $subs->{$datefield} = undef;
362 $subs->{ "status" . $subs->{'status'} } = 1;
363 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
364 $subs->{"checked"} = 1;
367 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
368 $year = $subs->{'year'};
372 if ( $tmpresults{$year} ) {
373 push @{ $tmpresults{$year}->{'serials'} }, $subs;
375 $tmpresults{$year} = {
377 'aqbooksellername' => $subs->{'aqbooksellername'},
378 'bibliotitle' => $subs->{'bibliotitle'},
379 'serials' => [$subs],
384 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
385 push @res, $tmpresults{$key};
390 =head2 GetSubscriptionsFromBiblionumber
392 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
393 this function get the subscription list. it reads the subscription table.
395 reference to an array of subscriptions which have the biblionumber given on input arg.
396 each element of this array is a hashref containing
397 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
401 sub GetSubscriptionsFromBiblionumber {
402 my ($biblionumber) = @_;
404 return unless ($biblionumber);
406 my $dbh = C4::Context->dbh;
408 SELECT subscription.*,
410 subscriptionhistory.*,
411 aqbooksellers.name AS aqbooksellername,
412 biblio.title AS bibliotitle
414 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
415 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
416 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
417 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
418 WHERE subscription.biblionumber = ?
420 my $sth = $dbh->prepare($query);
421 $sth->execute($biblionumber);
423 while ( my $subs = $sth->fetchrow_hashref ) {
424 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
425 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
426 if ( defined $subs->{histenddate} ) {
427 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
429 $subs->{histenddate} = "";
431 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
432 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
433 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
434 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
435 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
436 $subs->{ "status" . $subs->{'status'} } = 1;
438 if (not defined $subs->{enddate} ) {
439 $subs->{enddate} = '';
441 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
443 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
444 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
445 $subs->{cannotedit} = not can_edit_subscription( $subs );
451 =head2 GetFullSubscriptionsFromBiblionumber
453 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
454 this function reads the serial table.
458 sub GetFullSubscriptionsFromBiblionumber {
459 my ($biblionumber) = @_;
460 my $dbh = C4::Context->dbh;
462 SELECT serial.serialid,
465 serial.publisheddate,
466 serial.publisheddatetext,
468 serial.notes as notes,
469 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
470 biblio.title as bibliotitle,
471 subscription.branchcode AS branchcode,
472 subscription.subscriptionid AS subscriptionid
474 LEFT JOIN subscription ON
475 (serial.subscriptionid=subscription.subscriptionid)
476 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
477 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
478 WHERE subscription.biblionumber = ?
480 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
481 serial.subscriptionid
483 my $sth = $dbh->prepare($query);
484 $sth->execute($biblionumber);
485 my $subscriptions = $sth->fetchall_arrayref( {} );
486 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
487 for my $subscription ( @$subscriptions ) {
488 $subscription->{cannotedit} = $cannotedit;
490 return $subscriptions;
493 =head2 SearchSubscriptions
495 @results = SearchSubscriptions($args);
497 This function returns a list of hashrefs, one for each subscription
498 that meets the conditions specified by the $args hashref.
500 The valid search fields are:
514 The expiration_date search field is special; it specifies the maximum
515 subscription expiration date.
519 sub SearchSubscriptions {
522 my $additional_fields = $args->{additional_fields} // [];
523 my $matching_record_ids_for_additional_fields = [];
524 if ( @$additional_fields ) {
525 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
527 return () unless @subscriptions;
529 $matching_record_ids_for_additional_fields = [ map {
536 subscription.notes AS publicnotes,
537 subscriptionhistory.*,
539 biblio.notes AS biblionotes,
543 aqbooksellers.name AS vendorname,
546 LEFT JOIN subscriptionhistory USING(subscriptionid)
547 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
548 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
549 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
551 $query .= q| WHERE 1|;
554 if( $args->{biblionumber} ) {
555 push @where_strs, "biblio.biblionumber = ?";
556 push @where_args, $args->{biblionumber};
559 if( $args->{title} ){
560 my @words = split / /, $args->{title};
562 foreach my $word (@words) {
563 push @strs, "biblio.title LIKE ?";
564 push @args, "%$word%";
567 push @where_strs, '(' . join (' AND ', @strs) . ')';
568 push @where_args, @args;
572 push @where_strs, "biblioitems.issn LIKE ?";
573 push @where_args, "%$args->{issn}%";
576 push @where_strs, "biblioitems.ean LIKE ?";
577 push @where_args, "%$args->{ean}%";
579 if ( $args->{callnumber} ) {
580 push @where_strs, "subscription.callnumber LIKE ?";
581 push @where_args, "%$args->{callnumber}%";
583 if( $args->{publisher} ){
584 push @where_strs, "biblioitems.publishercode LIKE ?";
585 push @where_args, "%$args->{publisher}%";
587 if( $args->{bookseller} ){
588 push @where_strs, "aqbooksellers.name LIKE ?";
589 push @where_args, "%$args->{bookseller}%";
591 if( $args->{branch} ){
592 push @where_strs, "subscription.branchcode = ?";
593 push @where_args, "$args->{branch}";
595 if ( $args->{location} ) {
596 push @where_strs, "subscription.location = ?";
597 push @where_args, "$args->{location}";
599 if ( $args->{expiration_date} ) {
600 push @where_strs, "subscription.enddate <= ?";
601 push @where_args, "$args->{expiration_date}";
603 if( defined $args->{closed} ){
604 push @where_strs, "subscription.closed = ?";
605 push @where_args, "$args->{closed}";
609 $query .= ' AND ' . join(' AND ', @where_strs);
611 if ( @$additional_fields ) {
612 $query .= ' AND subscriptionid IN ('
613 . join( ', ', @$matching_record_ids_for_additional_fields )
617 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
619 my $dbh = C4::Context->dbh;
620 my $sth = $dbh->prepare($query);
621 $sth->execute(@where_args);
622 my $results = $sth->fetchall_arrayref( {} );
624 for my $subscription ( @$results ) {
625 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
626 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
628 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
629 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
630 $subscription_object->additional_field_values->as_list };
640 ($totalissues,@serials) = GetSerials($subscriptionid);
641 this function gets every serial not arrived for a given subscription
642 as well as the number of issues registered in the database (all types)
643 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
645 FIXME: We should return \@serials.
650 my ( $subscriptionid, $count ) = @_;
652 return unless $subscriptionid;
654 my $dbh = C4::Context->dbh;
656 # status = 2 is "arrived"
658 $count = 5 unless ($count);
660 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
661 my $query = "SELECT serialid,serialseq, status, publisheddate,
662 publisheddatetext, planneddate,notes, routingnotes
664 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
665 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
666 my $sth = $dbh->prepare($query);
667 $sth->execute($subscriptionid);
669 while ( my $line = $sth->fetchrow_hashref ) {
670 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
671 for my $datefield ( qw( planneddate publisheddate) ) {
672 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
673 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
675 $line->{$datefield} = q{};
678 push @serials, $line;
681 # OK, now add the last 5 issues arrives/missing
682 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
683 publisheddatetext, notes, routingnotes
685 WHERE subscriptionid = ?
686 AND status IN ( $statuses )
687 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
689 $sth = $dbh->prepare($query);
690 $sth->execute($subscriptionid);
691 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
693 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
694 for my $datefield ( qw( planneddate publisheddate) ) {
695 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
696 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
698 $line->{$datefield} = q{};
702 push @serials, $line;
705 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
706 $sth = $dbh->prepare($query);
707 $sth->execute($subscriptionid);
708 my ($totalissues) = $sth->fetchrow;
709 return ( $totalissues, @serials );
714 @serials = GetSerials2($subscriptionid,$statuses);
715 this function returns every serial waited for a given subscription
716 as well as the number of issues registered in the database (all types)
717 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
719 $statuses is an arrayref of statuses and is mandatory.
724 my ( $subscription, $statuses ) = @_;
726 return unless ($subscription and @$statuses);
728 my $dbh = C4::Context->dbh;
730 SELECT serialid,serialseq, status, planneddate, publisheddate,
731 publisheddatetext, notes, routingnotes
733 WHERE subscriptionid=?
735 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
737 ORDER BY publisheddate,serialid DESC
739 $debug and warn "GetSerials2 query: $query";
740 my $sth = $dbh->prepare($query);
741 $sth->execute( $subscription, @$statuses );
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
746 # Format dates for display
747 for my $datefield ( qw( planneddate publisheddate ) ) {
748 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
749 $line->{$datefield} = q{};
752 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
755 push @serials, $line;
760 =head2 GetLatestSerials
762 \@serials = GetLatestSerials($subscriptionid,$limit)
763 get the $limit's latest serials arrived or missing for a given subscription
765 a ref to an array which contains all of the latest serials stored into a hash.
769 sub GetLatestSerials {
770 my ( $subscriptionid, $limit ) = @_;
772 return unless ($subscriptionid and $limit);
774 my $dbh = C4::Context->dbh;
776 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
777 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
779 WHERE subscriptionid = ?
780 AND status IN ($statuses)
781 ORDER BY publisheddate DESC LIMIT 0,$limit
783 my $sth = $dbh->prepare($strsth);
784 $sth->execute($subscriptionid);
786 while ( my $line = $sth->fetchrow_hashref ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 push @serials, $line;
794 =head2 GetPreviousSerialid
796 $serialid = GetPreviousSerialid($subscriptionid, $nth)
797 get the $nth's previous serial for the given subscriptionid
803 sub GetPreviousSerialid {
804 my ( $subscriptionid, $nth ) = @_;
806 my $dbh = C4::Context->dbh;
810 my $strsth = "SELECT serialid
812 WHERE subscriptionid = ?
814 ORDER BY serialid DESC LIMIT $nth,1
816 my $sth = $dbh->prepare($strsth);
817 $sth->execute($subscriptionid);
819 my $line = $sth->fetchrow_hashref;
820 $return = $line->{'serialid'} if ($line);
828 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
829 $newinnerloop1, $newinnerloop2, $newinnerloop3
830 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
832 $subscription is a hashref containing all the attributes of the table
834 $pattern is a hashref containing all the attributes of the table
835 'subscription_numberpatterns'.
836 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
837 $planneddate is a date string in iso format.
838 This function get the next issue for the subscription given on input arg
843 my ($subscription, $pattern, $frequency, $planneddate) = @_;
845 return unless ($subscription and $pattern);
847 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
848 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
851 if ($subscription->{'skip_serialseq'}) {
852 my @irreg = split /;/, $subscription->{'irregularity'};
854 my $irregularities = {};
855 $irregularities->{$_} = 1 foreach(@irreg);
856 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
857 while($irregularities->{$issueno}) {
864 my $numberingmethod = $pattern->{numberingmethod};
866 if ($numberingmethod) {
867 $calculated = $numberingmethod;
868 my $locale = $subscription->{locale};
869 $newlastvalue1 = $subscription->{lastvalue1} || 0;
870 $newlastvalue2 = $subscription->{lastvalue2} || 0;
871 $newlastvalue3 = $subscription->{lastvalue3} || 0;
872 $newinnerloop1 = $subscription->{innerloop1} || 0;
873 $newinnerloop2 = $subscription->{innerloop2} || 0;
874 $newinnerloop3 = $subscription->{innerloop3} || 0;
877 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
880 for(my $i = 0; $i < $count; $i++) {
882 # check if we have to increase the new value.
884 if ($newinnerloop1 >= $pattern->{every1}) {
886 $newlastvalue1 += $pattern->{add1};
888 # reset counter if needed.
889 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
892 # check if we have to increase the new value.
894 if ($newinnerloop2 >= $pattern->{every2}) {
896 $newlastvalue2 += $pattern->{add2};
898 # reset counter if needed.
899 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
902 # check if we have to increase the new value.
904 if ($newinnerloop3 >= $pattern->{every3}) {
906 $newlastvalue3 += $pattern->{add3};
908 # reset counter if needed.
909 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
913 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
914 $calculated =~ s/\{X\}/$newlastvalue1string/g;
917 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
918 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
921 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
922 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
927 $newlastvalue1, $newlastvalue2, $newlastvalue3,
928 $newinnerloop1, $newinnerloop2, $newinnerloop3);
933 $calculated = GetSeq($subscription, $pattern)
934 $subscription is a hashref containing all the attributes of the table 'subscription'
935 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
936 this function transforms {X},{Y},{Z} to 150,0,0 for example.
938 the sequence in string format
943 my ($subscription, $pattern) = @_;
945 return unless ($subscription and $pattern);
947 my $locale = $subscription->{locale};
949 my $calculated = $pattern->{numberingmethod};
951 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
952 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
953 $calculated =~ s/\{X\}/$newlastvalue1/g;
955 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
956 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
957 $calculated =~ s/\{Y\}/$newlastvalue2/g;
959 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
960 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
961 $calculated =~ s/\{Z\}/$newlastvalue3/g;
965 =head2 GetExpirationDate
967 $enddate = GetExpirationDate($subscriptionid, [$startdate])
969 this function return the next expiration date for a subscription given on input args.
976 sub GetExpirationDate {
977 my ( $subscriptionid, $startdate ) = @_;
979 return unless ($subscriptionid);
981 my $dbh = C4::Context->dbh;
982 my $subscription = GetSubscription($subscriptionid);
985 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
986 $enddate = $startdate || $subscription->{startdate};
987 my @date = split( /-/, $enddate );
989 return if ( scalar(@date) != 3 || not check_date(@date) );
991 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
992 if ( $frequency and $frequency->{unit} ) {
995 if ( my $length = $subscription->{numberlength} ) {
997 #calculate the date of the last issue.
998 for ( my $i = 1 ; $i <= $length ; $i++ ) {
999 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1001 } elsif ( $subscription->{monthlength} ) {
1002 if ( $$subscription{startdate} ) {
1003 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1004 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1006 } elsif ( $subscription->{weeklength} ) {
1007 if ( $$subscription{startdate} ) {
1008 my @date = split( /-/, $subscription->{startdate} );
1009 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1010 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1013 $enddate = $subscription->{enddate};
1017 return $subscription->{enddate};
1021 =head2 CountSubscriptionFromBiblionumber
1023 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1024 this returns a count of the subscriptions for a given biblionumber
1026 the number of subscriptions
1030 sub CountSubscriptionFromBiblionumber {
1031 my ($biblionumber) = @_;
1033 return unless ($biblionumber);
1035 my $dbh = C4::Context->dbh;
1036 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1037 my $sth = $dbh->prepare($query);
1038 $sth->execute($biblionumber);
1039 my $subscriptionsnumber = $sth->fetchrow;
1040 return $subscriptionsnumber;
1043 =head2 ModSubscriptionHistory
1045 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1047 this function modifies the history of a subscription. Put your new values on input arg.
1048 returns the number of rows affected
1052 sub ModSubscriptionHistory {
1053 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1055 return unless ($subscriptionid);
1057 my $dbh = C4::Context->dbh;
1058 my $query = "UPDATE subscriptionhistory
1059 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1060 WHERE subscriptionid=?
1062 my $sth = $dbh->prepare($query);
1063 $receivedlist =~ s/^; // if $receivedlist;
1064 $missinglist =~ s/^; // if $missinglist;
1065 $opacnote =~ s/^; // if $opacnote;
1066 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1070 =head2 ModSerialStatus
1072 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1073 $publisheddatetext, $status, $notes);
1075 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1076 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1080 sub ModSerialStatus {
1081 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1082 $status, $notes) = @_;
1084 return unless ($serialid);
1086 #It is a usual serial
1087 # 1st, get previous status :
1088 my $dbh = C4::Context->dbh;
1089 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1090 FROM serial, subscription
1091 WHERE serial.subscriptionid=subscription.subscriptionid
1093 my $sth = $dbh->prepare($query);
1094 $sth->execute($serialid);
1095 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1096 my $frequency = GetSubscriptionFrequency($periodicity);
1098 # change status & update subscriptionhistory
1100 if ( $status == DELETED ) {
1101 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1105 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1106 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1109 $sth = $dbh->prepare($query);
1110 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1111 $planneddate, $status, $notes, $routingnotes, $serialid );
1112 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1113 $sth = $dbh->prepare($query);
1114 $sth->execute($subscriptionid);
1115 my $val = $sth->fetchrow_hashref;
1116 unless ( $val->{manualhistory} ) {
1117 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1118 $sth = $dbh->prepare($query);
1119 $sth->execute($subscriptionid);
1120 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1122 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1123 $recievedlist .= "; $serialseq"
1124 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1127 # in case serial has been previously marked as missing
1128 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1129 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1132 $missinglist .= "; $serialseq"
1133 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1134 $missinglist .= "; not issued $serialseq"
1135 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1137 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1138 $sth = $dbh->prepare($query);
1139 $recievedlist =~ s/^; //;
1140 $missinglist =~ s/^; //;
1141 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1145 # create new expected entry if needed (ie : was "expected" and has changed)
1146 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1147 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1148 my $subscription = GetSubscription($subscriptionid);
1149 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1150 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1154 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1155 $newinnerloop1, $newinnerloop2, $newinnerloop3
1157 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1159 # next date (calculated from actual date & frequency parameters)
1160 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1161 my $nextpubdate = $nextpublisheddate;
1162 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1163 WHERE subscriptionid = ?";
1164 $sth = $dbh->prepare($query);
1165 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1166 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, $publisheddatetext, $notes, $routingnotes );
1167 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1168 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1169 require C4::Letters;
1170 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1177 =head2 GetNextExpected
1179 $nextexpected = GetNextExpected($subscriptionid)
1181 Get the planneddate for the current expected issue of the subscription.
1187 planneddate => ISO date
1192 sub GetNextExpected {
1193 my ($subscriptionid) = @_;
1195 my $dbh = C4::Context->dbh;
1199 WHERE subscriptionid = ?
1203 my $sth = $dbh->prepare($query);
1205 # Each subscription has only one 'expected' issue.
1206 $sth->execute( $subscriptionid, EXPECTED );
1207 my $nextissue = $sth->fetchrow_hashref;
1208 if ( !$nextissue ) {
1212 WHERE subscriptionid = ?
1213 ORDER BY publisheddate DESC
1216 $sth = $dbh->prepare($query);
1217 $sth->execute($subscriptionid);
1218 $nextissue = $sth->fetchrow_hashref;
1220 foreach(qw/planneddate publisheddate/) {
1221 if ( !defined $nextissue->{$_} ) {
1222 # or should this default to 1st Jan ???
1223 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1225 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1233 =head2 ModNextExpected
1235 ModNextExpected($subscriptionid,$date)
1237 Update the planneddate for the current expected issue of the subscription.
1238 This will modify all future prediction results.
1240 C<$date> is an ISO date.
1246 sub ModNextExpected {
1247 my ( $subscriptionid, $date ) = @_;
1248 my $dbh = C4::Context->dbh;
1250 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1251 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1253 # Each subscription has only one 'expected' issue.
1254 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1259 =head2 GetSubscriptionIrregularities
1263 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1264 get the list of irregularities for a subscription
1270 sub GetSubscriptionIrregularities {
1271 my $subscriptionid = shift;
1273 return unless $subscriptionid;
1275 my $dbh = C4::Context->dbh;
1279 WHERE subscriptionid = ?
1281 my $sth = $dbh->prepare($query);
1282 $sth->execute($subscriptionid);
1284 my ($result) = $sth->fetchrow_array;
1285 my @irreg = split /;/, $result;
1290 =head2 ModSubscription
1292 this function modifies a subscription. Put all new values on input args.
1293 returns the number of rows affected
1297 sub ModSubscription {
1299 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1300 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1301 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1302 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1303 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1304 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1305 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1306 $itemtype, $previousitemtype, $mana_id
1309 my $dbh = C4::Context->dbh;
1310 my $query = "UPDATE subscription
1311 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1312 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1313 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1314 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1315 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1316 callnumber=?, notes=?, letter=?, manualhistory=?,
1317 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1318 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1319 skip_serialseq=?, itemtype=?, previousitemtype=?, mana_id=?
1320 WHERE subscriptionid = ?";
1322 my $sth = $dbh->prepare($query);
1324 $auser, $branchcode, $aqbooksellerid, $cost,
1325 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1326 $irregularity, $numberpattern, $locale, $numberlength,
1327 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1328 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1329 $status, $biblionumber, $callnumber, $notes,
1330 $letter, ($manualhistory ? $manualhistory : 0),
1331 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1332 $graceperiod, $location, $enddate, $skip_serialseq,
1333 $itemtype, $previousitemtype, $mana_id,
1336 my $rows = $sth->rows;
1338 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1342 =head2 NewSubscription
1344 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1345 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1346 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1347 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1348 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1349 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1350 $skip_serialseq, $itemtype, $previousitemtype);
1352 Create a new subscription with value given on input args.
1355 the id of this new subscription
1359 sub NewSubscription {
1361 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1362 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1363 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1364 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1365 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1366 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1367 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1369 my $dbh = C4::Context->dbh;
1371 my $subscription = Koha::Subscription->new(
1373 librarian => $auser,
1374 branchcode => $branchcode,
1375 aqbooksellerid => $aqbooksellerid,
1377 aqbudgetid => $aqbudgetid,
1378 biblionumber => $biblionumber,
1379 startdate => $startdate,
1380 periodicity => $periodicity,
1381 numberlength => $numberlength,
1382 weeklength => $weeklength,
1383 monthlength => $monthlength,
1384 lastvalue1 => $lastvalue1,
1385 innerloop1 => $innerloop1,
1386 lastvalue2 => $lastvalue2,
1387 innerloop2 => $innerloop2,
1388 lastvalue3 => $lastvalue3,
1389 innerloop3 => $innerloop3,
1393 firstacquidate => $firstacquidate,
1394 irregularity => $irregularity,
1395 numberpattern => $numberpattern,
1397 callnumber => $callnumber,
1398 manualhistory => $manualhistory,
1399 internalnotes => $internalnotes,
1400 serialsadditems => $serialsadditems,
1401 staffdisplaycount => $staffdisplaycount,
1402 opacdisplaycount => $opacdisplaycount,
1403 graceperiod => $graceperiod,
1404 location => $location,
1405 enddate => $enddate,
1406 skip_serialseq => $skip_serialseq,
1407 itemtype => $itemtype,
1408 previousitemtype => $previousitemtype,
1409 mana_id => $mana_id,
1412 $subscription->discard_changes;
1413 my $subscriptionid = $subscription->subscriptionid;
1414 my ( $query, $sth );
1416 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1420 WHERE subscriptionid=?
1422 $sth = $dbh->prepare($query);
1423 $sth->execute( $enddate, $subscriptionid );
1426 # then create the 1st expected number
1428 INSERT INTO subscriptionhistory
1429 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1430 VALUES (?,?,?, '', '')
1432 $sth = $dbh->prepare($query);
1433 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1435 # reread subscription to get a hash (for calculation of the 1st issue number)
1436 $subscription = GetSubscription($subscriptionid); # We should not do that
1437 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1439 # calculate issue number
1440 my $serialseq = GetSeq($subscription, $pattern) || q{};
1444 serialseq => $serialseq,
1445 serialseq_x => $subscription->{'lastvalue1'},
1446 serialseq_y => $subscription->{'lastvalue2'},
1447 serialseq_z => $subscription->{'lastvalue3'},
1448 subscriptionid => $subscriptionid,
1449 biblionumber => $biblionumber,
1451 planneddate => $firstacquidate,
1452 publisheddate => $firstacquidate,
1456 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1458 #set serial flag on biblio if not already set.
1459 my $biblio = Koha::Biblios->find( $biblionumber );
1460 if ( $biblio and !$biblio->serial ) {
1461 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1462 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1464 eval { $record->field($tag)->update( $subf => 1 ); };
1466 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1468 return $subscriptionid;
1471 =head2 ReNewSubscription
1473 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1475 this function renew a subscription with values given on input args.
1479 sub ReNewSubscription {
1480 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1481 my $dbh = C4::Context->dbh;
1482 my $subscription = GetSubscription($subscriptionid);
1486 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1487 WHERE biblio.biblionumber=?
1489 my $sth = $dbh->prepare($query);
1490 $sth->execute( $subscription->{biblionumber} );
1491 my $biblio = $sth->fetchrow_hashref;
1493 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1494 require C4::Suggestions;
1495 C4::Suggestions::NewSuggestion(
1496 { 'suggestedby' => $user,
1497 'title' => $subscription->{bibliotitle},
1498 'author' => $biblio->{author},
1499 'publishercode' => $biblio->{publishercode},
1500 'note' => $biblio->{note},
1501 'biblionumber' => $subscription->{biblionumber}
1506 $numberlength ||= 0; # Should not we raise an exception instead?
1509 # renew subscription
1512 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1513 WHERE subscriptionid=?
1515 $sth = $dbh->prepare($query);
1516 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1517 my $enddate = GetExpirationDate($subscriptionid);
1518 $debug && warn "enddate :$enddate";
1522 WHERE subscriptionid=?
1524 $sth = $dbh->prepare($query);
1525 $sth->execute( $enddate, $subscriptionid );
1527 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1533 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1535 Create a new issue stored on the database.
1536 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1537 returns the serial id
1542 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1543 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1544 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1546 return unless ($subscriptionid);
1548 my $schema = Koha::Database->new()->schema();
1550 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1552 my $serial = Koha::Serial->new(
1554 serialseq => $serialseq,
1555 serialseq_x => $subscription->lastvalue1(),
1556 serialseq_y => $subscription->lastvalue2(),
1557 serialseq_z => $subscription->lastvalue3(),
1558 subscriptionid => $subscriptionid,
1559 biblionumber => $biblionumber,
1561 planneddate => $planneddate,
1562 publisheddate => $publisheddate,
1563 publisheddatetext => $publisheddatetext,
1565 routingnotes => $routingnotes
1569 my $serialid = $serial->id();
1571 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1572 my $missinglist = $subscription_history->missinglist();
1573 my $recievedlist = $subscription_history->recievedlist();
1575 if ( $status == ARRIVED ) {
1576 ### TODO Add a feature that improves recognition and description.
1577 ### As such count (serialseq) i.e. : N18,2(N19),N20
1578 ### Would use substr and index But be careful to previous presence of ()
1579 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1581 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1582 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1585 $recievedlist =~ s/^; //;
1586 $missinglist =~ s/^; //;
1588 $subscription_history->recievedlist($recievedlist);
1589 $subscription_history->missinglist($missinglist);
1590 $subscription_history->store();
1595 =head2 HasSubscriptionStrictlyExpired
1597 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1599 the subscription has stricly expired when today > the end subscription date
1602 1 if true, 0 if false, -1 if the expiration date is not set.
1606 sub HasSubscriptionStrictlyExpired {
1608 # Getting end of subscription date
1609 my ($subscriptionid) = @_;
1611 return unless ($subscriptionid);
1613 my $dbh = C4::Context->dbh;
1614 my $subscription = GetSubscription($subscriptionid);
1615 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1617 # If the expiration date is set
1618 if ( $expirationdate != 0 ) {
1619 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1621 # Getting today's date
1622 my ( $nowyear, $nowmonth, $nowday ) = Today();
1624 # if today's date > expiration date, then the subscription has stricly expired
1625 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1632 # There are some cases where the expiration date is not set
1633 # As we can't determine if the subscription has expired on a date-basis,
1639 =head2 HasSubscriptionExpired
1641 $has_expired = HasSubscriptionExpired($subscriptionid)
1643 the subscription has expired when the next issue to arrive is out of subscription limit.
1646 0 if the subscription has not expired
1647 1 if the subscription has expired
1648 2 if has subscription does not have a valid expiration date set
1652 sub HasSubscriptionExpired {
1653 my ($subscriptionid) = @_;
1655 return unless ($subscriptionid);
1657 my $dbh = C4::Context->dbh;
1658 my $subscription = GetSubscription($subscriptionid);
1659 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1660 if ( $frequency and $frequency->{unit} ) {
1661 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1662 if (!defined $expirationdate) {
1663 $expirationdate = q{};
1666 SELECT max(planneddate)
1668 WHERE subscriptionid=?
1670 my $sth = $dbh->prepare($query);
1671 $sth->execute($subscriptionid);
1672 my ($res) = $sth->fetchrow;
1673 if (!$res || $res=~m/^0000/) {
1676 my @res = split( /-/, $res );
1677 my @endofsubscriptiondate = split( /-/, $expirationdate );
1678 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1680 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1685 if ( $subscription->{'numberlength'} ) {
1686 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1687 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1693 return 0; # Notice that you'll never get here.
1696 =head2 DelSubscription
1698 DelSubscription($subscriptionid)
1699 this function deletes subscription which has $subscriptionid as id.
1703 sub DelSubscription {
1704 my ($subscriptionid) = @_;
1705 my $dbh = C4::Context->dbh;
1706 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1707 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1708 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1710 Koha::AdditionalFieldValues->search({
1711 'field.tablename' => 'subscription',
1712 'me.record_id' => $subscriptionid,
1713 }, { join => 'field' })->delete;
1715 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1720 DelIssue($serialseq,$subscriptionid)
1721 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1723 returns the number of rows affected
1728 my ($dataissue) = @_;
1729 my $dbh = C4::Context->dbh;
1730 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1735 AND subscriptionid= ?
1737 my $mainsth = $dbh->prepare($query);
1738 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1740 #Delete element from subscription history
1741 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1742 my $sth = $dbh->prepare($query);
1743 $sth->execute( $dataissue->{'subscriptionid'} );
1744 my $val = $sth->fetchrow_hashref;
1745 unless ( $val->{manualhistory} ) {
1747 SELECT * FROM subscriptionhistory
1748 WHERE subscriptionid= ?
1750 my $sth = $dbh->prepare($query);
1751 $sth->execute( $dataissue->{'subscriptionid'} );
1752 my $data = $sth->fetchrow_hashref;
1753 my $serialseq = $dataissue->{'serialseq'};
1754 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1755 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1756 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1757 $sth = $dbh->prepare($strsth);
1758 $sth->execute( $dataissue->{'subscriptionid'} );
1761 return $mainsth->rows;
1764 =head2 GetLateOrMissingIssues
1766 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1768 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1771 the issuelist as an array of hash refs. Each element of this array contains
1772 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1776 sub GetLateOrMissingIssues {
1777 my ( $supplierid, $serialid, $order ) = @_;
1779 return unless ( $supplierid or $serialid );
1781 my $dbh = C4::Context->dbh;
1786 $byserial = "and serialid = " . $serialid;
1789 $order .= ", title";
1793 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1795 $sth = $dbh->prepare(
1797 serialid, aqbooksellerid, name,
1798 biblio.title, biblioitems.issn, planneddate, serialseq,
1799 serial.status, serial.subscriptionid, claimdate, claims_count,
1800 subscription.branchcode
1802 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1803 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1804 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1805 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1806 WHERE subscription.subscriptionid = serial.subscriptionid
1807 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1808 AND subscription.aqbooksellerid=$supplierid
1813 $sth = $dbh->prepare(
1815 serialid, aqbooksellerid, name,
1816 biblio.title, planneddate, serialseq,
1817 serial.status, serial.subscriptionid, claimdate, claims_count,
1818 subscription.branchcode
1820 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1821 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1822 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1823 WHERE subscription.subscriptionid = serial.subscriptionid
1824 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1829 $sth->execute( EXPECTED, LATE, CLAIMED );
1831 while ( my $line = $sth->fetchrow_hashref ) {
1833 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1834 $line->{planneddateISO} = $line->{planneddate};
1835 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1837 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1838 $line->{claimdateISO} = $line->{claimdate};
1839 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1841 $line->{"status".$line->{status}} = 1;
1843 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1844 $line->{additional_fields} = { map { $_->field->name => $_->value }
1845 $subscription_object->additional_field_values->as_list };
1847 push @issuelist, $line;
1854 &updateClaim($serialid)
1856 this function updates the time when a claim is issued for late/missing items
1858 called from claims.pl file
1863 my ($serialids) = @_;
1864 return unless $serialids;
1865 unless ( ref $serialids ) {
1866 $serialids = [ $serialids ];
1868 my $dbh = C4::Context->dbh;
1871 SET claimdate = NOW(),
1872 claims_count = claims_count + 1,
1874 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1875 {}, CLAIMED, @$serialids );
1878 =head2 check_routing
1880 $result = &check_routing($subscriptionid)
1882 this function checks to see if a serial has a routing list and returns the count of routingid
1883 used to show either an 'add' or 'edit' link
1888 my ($subscriptionid) = @_;
1890 return unless ($subscriptionid);
1892 my $dbh = C4::Context->dbh;
1893 my $sth = $dbh->prepare(
1894 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1895 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1896 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1899 $sth->execute($subscriptionid);
1900 my $line = $sth->fetchrow_hashref;
1901 my $result = $line->{'routingids'};
1905 =head2 addroutingmember
1907 addroutingmember($borrowernumber,$subscriptionid)
1909 this function takes a borrowernumber and subscriptionid and adds the member to the
1910 routing list for that serial subscription and gives them a rank on the list
1911 of either 1 or highest current rank + 1
1915 sub addroutingmember {
1916 my ( $borrowernumber, $subscriptionid ) = @_;
1918 return unless ($borrowernumber and $subscriptionid);
1921 my $dbh = C4::Context->dbh;
1922 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1923 $sth->execute($subscriptionid);
1924 while ( my $line = $sth->fetchrow_hashref ) {
1925 if ( $line->{'rank'} > 0 ) {
1926 $rank = $line->{'rank'} + 1;
1931 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1932 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1935 =head2 reorder_members
1937 reorder_members($subscriptionid,$routingid,$rank)
1939 this function is used to reorder the routing list
1941 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1942 - it gets all members on list puts their routingid's into an array
1943 - removes the one in the array that is $routingid
1944 - then reinjects $routingid at point indicated by $rank
1945 - then update the database with the routingids in the new order
1949 sub reorder_members {
1950 my ( $subscriptionid, $routingid, $rank ) = @_;
1951 my $dbh = C4::Context->dbh;
1952 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1953 $sth->execute($subscriptionid);
1955 while ( my $line = $sth->fetchrow_hashref ) {
1956 push( @result, $line->{'routingid'} );
1959 # To find the matching index
1961 my $key = -1; # to allow for 0 being a valid response
1962 for ( $i = 0 ; $i < @result ; $i++ ) {
1963 if ( $routingid == $result[$i] ) {
1964 $key = $i; # save the index
1969 # if index exists in array then move it to new position
1970 if ( $key > -1 && $rank > 0 ) {
1971 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1972 my $moving_item = splice( @result, $key, 1 );
1973 splice( @result, $new_rank, 0, $moving_item );
1975 for ( my $j = 0 ; $j < @result ; $j++ ) {
1976 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1982 =head2 delroutingmember
1984 delroutingmember($routingid,$subscriptionid)
1986 this function either deletes one member from routing list if $routingid exists otherwise
1987 deletes all members from the routing list
1991 sub delroutingmember {
1993 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1994 my ( $routingid, $subscriptionid ) = @_;
1995 my $dbh = C4::Context->dbh;
1997 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1998 $sth->execute($routingid);
1999 reorder_members( $subscriptionid, $routingid );
2001 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2002 $sth->execute($subscriptionid);
2007 =head2 getroutinglist
2009 @routinglist = getroutinglist($subscriptionid)
2011 this gets the info from the subscriptionroutinglist for $subscriptionid
2014 the routinglist as an array. Each element of the array contains a hash_ref containing
2015 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2019 sub getroutinglist {
2020 my ($subscriptionid) = @_;
2021 my $dbh = C4::Context->dbh;
2022 my $sth = $dbh->prepare(
2023 'SELECT routingid, borrowernumber, ranking, biblionumber
2025 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2026 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2028 $sth->execute($subscriptionid);
2029 my $routinglist = $sth->fetchall_arrayref({});
2030 return @{$routinglist};
2033 =head2 countissuesfrom
2035 $result = countissuesfrom($subscriptionid,$startdate)
2037 Returns a count of serial rows matching the given subsctiptionid
2038 with published date greater than startdate
2042 sub countissuesfrom {
2043 my ( $subscriptionid, $startdate ) = @_;
2044 my $dbh = C4::Context->dbh;
2048 WHERE subscriptionid=?
2049 AND serial.publisheddate>?
2051 my $sth = $dbh->prepare($query);
2052 $sth->execute( $subscriptionid, $startdate );
2053 my ($countreceived) = $sth->fetchrow;
2054 return $countreceived;
2059 $result = CountIssues($subscriptionid)
2061 Returns a count of serial rows matching the given subsctiptionid
2066 my ($subscriptionid) = @_;
2067 my $dbh = C4::Context->dbh;
2071 WHERE subscriptionid=?
2073 my $sth = $dbh->prepare($query);
2074 $sth->execute($subscriptionid);
2075 my ($countreceived) = $sth->fetchrow;
2076 return $countreceived;
2081 $result = HasItems($subscriptionid)
2083 returns a count of items from serial matching the subscriptionid
2088 my ($subscriptionid) = @_;
2089 my $dbh = C4::Context->dbh;
2091 SELECT COUNT(serialitems.itemnumber)
2093 LEFT JOIN serialitems USING(serialid)
2094 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2096 my $sth=$dbh->prepare($query);
2097 $sth->execute($subscriptionid);
2098 my ($countitems)=$sth->fetchrow_array();
2102 =head2 abouttoexpire
2104 $result = abouttoexpire($subscriptionid)
2106 this function alerts you to the penultimate issue for a serial subscription
2108 returns 1 - if this is the penultimate issue
2114 my ($subscriptionid) = @_;
2115 my $dbh = C4::Context->dbh;
2116 my $subscription = GetSubscription($subscriptionid);
2117 my $per = $subscription->{'periodicity'};
2118 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2119 if ($frequency and $frequency->{unit}){
2121 my $expirationdate = GetExpirationDate($subscriptionid);
2123 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2124 my $nextdate = GetNextDate($subscription, $res, $frequency);
2126 # only compare dates if both dates exist.
2127 if ($nextdate and $expirationdate) {
2128 if(Date::Calc::Delta_Days(
2129 split( /-/, $nextdate ),
2130 split( /-/, $expirationdate )
2136 } elsif ($subscription->{numberlength}>0) {
2137 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2143 =head2 GetFictiveIssueNumber
2145 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2147 Get the position of the issue published at $publisheddate, considering the
2148 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2149 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2150 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2151 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2152 depending on how many rows are in serial table.
2153 The issue number calculation is based on subscription frequency, first acquisition
2154 date, and $publisheddate.
2156 Returns undef when called for irregular frequencies.
2158 The routine is used to skip irregularities when calculating the next issue
2159 date (in GetNextDate) or the next issue number (in GetNextSeq).
2163 sub GetFictiveIssueNumber {
2164 my ($subscription, $publisheddate, $frequency) = @_;
2166 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2170 my ( $year, $month, $day ) = split /-/, $publisheddate;
2171 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2172 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2174 if( $frequency->{'unitsperissue'} == 1 ) {
2175 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2176 } else { # issuesperunit == 1
2177 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2183 my ( $date1, $date2, $unit ) = @_;
2184 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2186 if( $unit eq 'day' ) {
2187 return Delta_Days( @$date1, @$date2 );
2188 } elsif( $unit eq 'week' ) {
2189 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2192 # In case of months or years, this is a wrapper around N_Delta_YMD.
2193 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2194 # while we expect 1 month.
2195 my @delta = N_Delta_YMD( @$date1, @$date2 );
2196 if( $delta[2] > 27 ) {
2197 # Check if we could add a month
2198 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2199 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2203 if( $delta[1] >= 12 ) {
2207 # if unit is year, we only return full years
2208 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2211 sub _get_next_date_day {
2212 my ($subscription, $freqdata, $year, $month, $day) = @_;
2214 my @newissue; # ( yy, mm, dd )
2215 # We do not need $delta_days here, since it would be zero where used
2217 if( $freqdata->{issuesperunit} == 1 ) {
2219 @newissue = Add_Delta_Days(
2220 $year, $month, $day, $freqdata->{"unitsperissue"} );
2221 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2223 @newissue = ( $year, $month, $day );
2224 $subscription->{countissuesperunit}++;
2226 # We finished a cycle of issues within a unit.
2227 # No subtraction of zero needed, just add one day
2228 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2229 $subscription->{countissuesperunit} = 1;
2234 sub _get_next_date_week {
2235 my ($subscription, $freqdata, $year, $month, $day) = @_;
2237 my @newissue; # ( yy, mm, dd )
2238 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2240 if( $freqdata->{issuesperunit} == 1 ) {
2241 # Add full weeks (of 7 days)
2242 @newissue = Add_Delta_Days(
2243 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2244 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2245 # Add rounded number of days based on frequency.
2246 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2247 $subscription->{countissuesperunit}++;
2249 # We finished a cycle of issues within a unit.
2250 # Subtract delta * (issues - 1), add 1 week
2251 @newissue = Add_Delta_Days( $year, $month, $day,
2252 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2253 @newissue = Add_Delta_Days( @newissue, 7 );
2254 $subscription->{countissuesperunit} = 1;
2259 sub _get_next_date_month {
2260 my ($subscription, $freqdata, $year, $month, $day) = @_;
2262 my @newissue; # ( yy, mm, dd )
2263 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2265 if( $freqdata->{issuesperunit} == 1 ) {
2267 @newissue = Add_Delta_YM(
2268 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2269 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2270 # Add rounded number of days based on frequency.
2271 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2272 $subscription->{countissuesperunit}++;
2274 # We finished a cycle of issues within a unit.
2275 # Subtract delta * (issues - 1), add 1 month
2276 @newissue = Add_Delta_Days( $year, $month, $day,
2277 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2278 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2279 $subscription->{countissuesperunit} = 1;
2284 sub _get_next_date_year {
2285 my ($subscription, $freqdata, $year, $month, $day) = @_;
2287 my @newissue; # ( yy, mm, dd )
2288 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2290 if( $freqdata->{issuesperunit} == 1 ) {
2292 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2293 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2294 # Add rounded number of days based on frequency.
2295 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2296 $subscription->{countissuesperunit}++;
2298 # We finished a cycle of issues within a unit.
2299 # Subtract delta * (issues - 1), add 1 year
2300 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2301 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2302 $subscription->{countissuesperunit} = 1;
2309 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2311 this function it takes the publisheddate and will return the next issue's date
2312 and will skip dates if there exists an irregularity.
2313 $publisheddate has to be an ISO date
2314 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2315 $frequency is a hashref containing frequency informations
2316 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2317 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2318 skipped then the returned date will be 2007-05-10
2321 $resultdate - then next date in the sequence (ISO date)
2323 Return undef if subscription is irregular
2328 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2330 return unless $subscription and $publisheddate;
2333 if ($freqdata->{'unit'}) {
2334 my ( $year, $month, $day ) = split /-/, $publisheddate;
2336 # Process an irregularity Hash
2337 # Suppose that irregularities are stored in a string with this structure
2338 # irreg1;irreg2;irreg3
2339 # where irregX is the number of issue which will not be received
2340 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2342 if ( $subscription->{irregularity} ) {
2343 my @irreg = split /;/, $subscription->{'irregularity'} ;
2344 foreach my $irregularity (@irreg) {
2345 $irregularities{$irregularity} = 1;
2349 # Get the 'fictive' next issue number
2350 # It is used to check if next issue is an irregular issue.
2351 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2353 # Then get the next date
2354 my $unit = lc $freqdata->{'unit'};
2355 if ($unit eq 'day') {
2356 while ($irregularities{$issueno}) {
2357 ($year, $month, $day) = _get_next_date_day($subscription,
2358 $freqdata, $year, $month, $day);
2361 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2362 $year, $month, $day);
2364 elsif ($unit eq 'week') {
2365 while ($irregularities{$issueno}) {
2366 ($year, $month, $day) = _get_next_date_week($subscription,
2367 $freqdata, $year, $month, $day);
2370 ($year, $month, $day) = _get_next_date_week($subscription,
2371 $freqdata, $year, $month, $day);
2373 elsif ($unit eq 'month') {
2374 while ($irregularities{$issueno}) {
2375 ($year, $month, $day) = _get_next_date_month($subscription,
2376 $freqdata, $year, $month, $day);
2379 ($year, $month, $day) = _get_next_date_month($subscription,
2380 $freqdata, $year, $month, $day);
2382 elsif ($unit eq 'year') {
2383 while ($irregularities{$issueno}) {
2384 ($year, $month, $day) = _get_next_date_year($subscription,
2385 $freqdata, $year, $month, $day);
2388 ($year, $month, $day) = _get_next_date_year($subscription,
2389 $freqdata, $year, $month, $day);
2393 my $dbh = C4::Context->dbh;
2396 SET countissuesperunit = ?
2397 WHERE subscriptionid = ?
2399 my $sth = $dbh->prepare($query);
2400 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2403 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2409 $string = &_numeration($value,$num_type,$locale);
2411 _numeration returns the string corresponding to $value in the num_type
2423 my ($value, $num_type, $locale) = @_;
2428 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2429 # 1970-11-01 was a Sunday
2430 $value = $value % 7;
2431 my $dt = DateTime->new(
2437 $string = $num_type =~ /^dayname$/
2438 ? $dt->strftime("%A")
2439 : $dt->strftime("%a");
2440 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2441 $value = $value % 12;
2442 my $dt = DateTime->new(
2444 month => $value + 1,
2447 $string = $num_type =~ /^monthname$/
2448 ? $dt->strftime("%B")
2449 : $dt->strftime("%b");
2450 } elsif ( $num_type =~ /^season$/ ) {
2451 my @seasons= qw( Spring Summer Fall Winter );
2452 $value = $value % 4;
2453 $string = $seasons[$value];
2454 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2455 my @seasonsabrv= qw( Spr Sum Fal Win );
2456 $value = $value % 4;
2457 $string = $seasonsabrv[$value];
2465 =head2 CloseSubscription
2467 Close a subscription given a subscriptionid
2471 sub CloseSubscription {
2472 my ( $subscriptionid ) = @_;
2473 return unless $subscriptionid;
2474 my $dbh = C4::Context->dbh;
2475 my $sth = $dbh->prepare( q{
2478 WHERE subscriptionid = ?
2480 $sth->execute( $subscriptionid );
2482 # Set status = missing when status = stopped
2483 $sth = $dbh->prepare( q{
2486 WHERE subscriptionid = ?
2489 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2492 =head2 ReopenSubscription
2494 Reopen a subscription given a subscriptionid
2498 sub ReopenSubscription {
2499 my ( $subscriptionid ) = @_;
2500 return unless $subscriptionid;
2501 my $dbh = C4::Context->dbh;
2502 my $sth = $dbh->prepare( q{
2505 WHERE subscriptionid = ?
2507 $sth->execute( $subscriptionid );
2509 # Set status = expected when status = stopped
2510 $sth = $dbh->prepare( q{
2513 WHERE subscriptionid = ?
2516 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2519 =head2 subscriptionCurrentlyOnOrder
2521 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2523 Return 1 if subscription is currently on order else 0.
2527 sub subscriptionCurrentlyOnOrder {
2528 my ( $subscriptionid ) = @_;
2529 my $dbh = C4::Context->dbh;
2531 SELECT COUNT(*) FROM aqorders
2532 WHERE subscriptionid = ?
2533 AND datereceived IS NULL
2534 AND datecancellationprinted IS NULL
2536 my $sth = $dbh->prepare( $query );
2537 $sth->execute($subscriptionid);
2538 return $sth->fetchrow_array;
2541 =head2 can_claim_subscription
2543 $can = can_claim_subscription( $subscriptionid[, $userid] );
2545 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2549 sub can_claim_subscription {
2550 my ( $subscription, $userid ) = @_;
2551 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2554 =head2 can_edit_subscription
2556 $can = can_edit_subscription( $subscriptionid[, $userid] );
2558 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2562 sub can_edit_subscription {
2563 my ( $subscription, $userid ) = @_;
2564 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2567 =head2 can_show_subscription
2569 $can = can_show_subscription( $subscriptionid[, $userid] );
2571 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2575 sub can_show_subscription {
2576 my ( $subscription, $userid ) = @_;
2577 return _can_do_on_subscription( $subscription, $userid, '*' );
2580 sub _can_do_on_subscription {
2581 my ( $subscription, $userid, $permission ) = @_;
2582 return 0 unless C4::Context->userenv;
2583 my $flags = C4::Context->userenv->{flags};
2584 $userid ||= C4::Context->userenv->{'id'};
2586 if ( C4::Context->preference('IndependentBranches') ) {
2588 if C4::Context->IsSuperLibrarian()
2590 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2592 C4::Auth::haspermission( $userid,
2593 { serials => $permission } )
2594 and ( not defined $subscription->{branchcode}
2595 or $subscription->{branchcode} eq ''
2596 or $subscription->{branchcode} eq
2597 C4::Context->userenv->{'branch'} )
2602 if C4::Context->IsSuperLibrarian()
2604 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2605 or C4::Auth::haspermission(
2606 $userid, { serials => $permission }
2613 =head2 findSerialsByStatus
2615 @serials = findSerialsByStatus($status, $subscriptionid);
2617 Returns an array of serials matching a given status and subscription id.
2621 sub findSerialsByStatus {
2622 my ( $status, $subscriptionid ) = @_;
2623 my $dbh = C4::Context->dbh;
2624 my $query = q| SELECT * from serial
2626 AND subscriptionid = ?
2628 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2637 Koha Development Team <http://koha-community.org/>