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 IS NULL,serial.publisheddate,serial.planneddate)) 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 IS NULL,serial.publisheddate,serial.planneddate) 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} //= "";
432 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
433 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
434 $subs->{ "status" . $subs->{'status'} } = 1;
436 if (not defined $subs->{enddate} ) {
437 $subs->{enddate} = '';
439 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
441 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
442 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
443 $subs->{cannotedit} = not can_edit_subscription( $subs );
449 =head2 GetFullSubscriptionsFromBiblionumber
451 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
452 this function reads the serial table.
456 sub GetFullSubscriptionsFromBiblionumber {
457 my ($biblionumber) = @_;
458 my $dbh = C4::Context->dbh;
460 SELECT serial.serialid,
463 serial.publisheddate,
464 serial.publisheddatetext,
466 serial.notes as notes,
467 year(IF(serial.publisheddate IS NULL,serial.publisheddate,serial.planneddate)) as year,
468 biblio.title as bibliotitle,
469 subscription.branchcode AS branchcode,
470 subscription.subscriptionid AS subscriptionid
472 LEFT JOIN subscription ON
473 (serial.subscriptionid=subscription.subscriptionid)
474 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
475 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
476 WHERE subscription.biblionumber = ?
478 IF(serial.publisheddate IS NULL,serial.publisheddate,serial.planneddate) DESC,
479 serial.subscriptionid
481 my $sth = $dbh->prepare($query);
482 $sth->execute($biblionumber);
483 my $subscriptions = $sth->fetchall_arrayref( {} );
484 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
485 for my $subscription ( @$subscriptions ) {
486 $subscription->{cannotedit} = $cannotedit;
488 return $subscriptions;
491 =head2 SearchSubscriptions
493 @results = SearchSubscriptions($args);
495 This function returns a list of hashrefs, one for each subscription
496 that meets the conditions specified by the $args hashref.
498 The valid search fields are:
512 The expiration_date search field is special; it specifies the maximum
513 subscription expiration date.
517 sub SearchSubscriptions {
520 my $additional_fields = $args->{additional_fields} // [];
521 my $matching_record_ids_for_additional_fields = [];
522 if ( @$additional_fields ) {
523 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
525 return () unless @subscriptions;
527 $matching_record_ids_for_additional_fields = [ map {
534 subscription.notes AS publicnotes,
535 subscriptionhistory.*,
537 biblio.notes AS biblionotes,
541 aqbooksellers.name AS vendorname,
544 LEFT JOIN subscriptionhistory USING(subscriptionid)
545 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
546 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
547 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
549 $query .= q| WHERE 1|;
552 if( $args->{biblionumber} ) {
553 push @where_strs, "biblio.biblionumber = ?";
554 push @where_args, $args->{biblionumber};
557 if( $args->{title} ){
558 my @words = split / /, $args->{title};
560 foreach my $word (@words) {
561 push @strs, "biblio.title LIKE ?";
562 push @args, "%$word%";
565 push @where_strs, '(' . join (' AND ', @strs) . ')';
566 push @where_args, @args;
570 push @where_strs, "biblioitems.issn LIKE ?";
571 push @where_args, "%$args->{issn}%";
574 push @where_strs, "biblioitems.ean LIKE ?";
575 push @where_args, "%$args->{ean}%";
577 if ( $args->{callnumber} ) {
578 push @where_strs, "subscription.callnumber LIKE ?";
579 push @where_args, "%$args->{callnumber}%";
581 if( $args->{publisher} ){
582 push @where_strs, "biblioitems.publishercode LIKE ?";
583 push @where_args, "%$args->{publisher}%";
585 if( $args->{bookseller} ){
586 push @where_strs, "aqbooksellers.name LIKE ?";
587 push @where_args, "%$args->{bookseller}%";
589 if( $args->{branch} ){
590 push @where_strs, "subscription.branchcode = ?";
591 push @where_args, "$args->{branch}";
593 if ( $args->{location} ) {
594 push @where_strs, "subscription.location = ?";
595 push @where_args, "$args->{location}";
597 if ( $args->{expiration_date} ) {
598 push @where_strs, "subscription.enddate <= ?";
599 push @where_args, "$args->{expiration_date}";
601 if( defined $args->{closed} ){
602 push @where_strs, "subscription.closed = ?";
603 push @where_args, "$args->{closed}";
607 $query .= ' AND ' . join(' AND ', @where_strs);
609 if ( @$additional_fields ) {
610 $query .= ' AND subscriptionid IN ('
611 . join( ', ', @$matching_record_ids_for_additional_fields )
615 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
617 my $dbh = C4::Context->dbh;
618 my $sth = $dbh->prepare($query);
619 $sth->execute(@where_args);
620 my $results = $sth->fetchall_arrayref( {} );
622 for my $subscription ( @$results ) {
623 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
624 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
626 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
627 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
628 $subscription_object->additional_field_values->as_list };
638 ($totalissues,@serials) = GetSerials($subscriptionid);
639 this function gets every serial not arrived for a given subscription
640 as well as the number of issues registered in the database (all types)
641 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
643 FIXME: We should return \@serials.
648 my ( $subscriptionid, $count ) = @_;
650 return unless $subscriptionid;
652 my $dbh = C4::Context->dbh;
654 # status = 2 is "arrived"
656 $count = 5 unless ($count);
658 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
659 my $query = "SELECT serialid,serialseq, status, publisheddate,
660 publisheddatetext, planneddate,notes, routingnotes
662 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
663 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC";
664 my $sth = $dbh->prepare($query);
665 $sth->execute($subscriptionid);
667 while ( my $line = $sth->fetchrow_hashref ) {
668 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
669 for my $datefield ( qw( planneddate publisheddate) ) {
670 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
671 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
673 $line->{$datefield} = q{};
676 push @serials, $line;
679 # OK, now add the last 5 issues arrives/missing
680 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
681 publisheddatetext, notes, routingnotes
683 WHERE subscriptionid = ?
684 AND status IN ( $statuses )
685 ORDER BY IF(publisheddate IS NULL,planneddate,publisheddate) DESC
687 $sth = $dbh->prepare($query);
688 $sth->execute($subscriptionid);
689 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
691 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
692 for my $datefield ( qw( planneddate publisheddate) ) {
693 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
694 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
696 $line->{$datefield} = q{};
700 push @serials, $line;
703 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
704 $sth = $dbh->prepare($query);
705 $sth->execute($subscriptionid);
706 my ($totalissues) = $sth->fetchrow;
707 return ( $totalissues, @serials );
712 @serials = GetSerials2($subscriptionid,$statuses);
713 this function returns every serial waited for a given subscription
714 as well as the number of issues registered in the database (all types)
715 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
717 $statuses is an arrayref of statuses and is mandatory.
722 my ( $subscription, $statuses ) = @_;
724 return unless ($subscription and @$statuses);
726 my $dbh = C4::Context->dbh;
728 SELECT serialid,serialseq, status, planneddate, publisheddate,
729 publisheddatetext, notes, routingnotes
731 WHERE subscriptionid=?
733 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
735 ORDER BY publisheddate,serialid DESC
737 $debug and warn "GetSerials2 query: $query";
738 my $sth = $dbh->prepare($query);
739 $sth->execute( $subscription, @$statuses );
742 while ( my $line = $sth->fetchrow_hashref ) {
743 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
744 # Format dates for display
745 for my $datefield ( qw( planneddate publisheddate ) ) {
746 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
747 $line->{$datefield} = q{};
750 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
753 push @serials, $line;
758 =head2 GetLatestSerials
760 \@serials = GetLatestSerials($subscriptionid,$limit)
761 get the $limit's latest serials arrived or missing for a given subscription
763 a ref to an array which contains all of the latest serials stored into a hash.
767 sub GetLatestSerials {
768 my ( $subscriptionid, $limit ) = @_;
770 return unless ($subscriptionid and $limit);
772 my $dbh = C4::Context->dbh;
774 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
775 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
777 WHERE subscriptionid = ?
778 AND status IN ($statuses)
779 ORDER BY publisheddate DESC LIMIT 0,$limit
781 my $sth = $dbh->prepare($strsth);
782 $sth->execute($subscriptionid);
784 while ( my $line = $sth->fetchrow_hashref ) {
785 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
786 push @serials, $line;
792 =head2 GetPreviousSerialid
794 $serialid = GetPreviousSerialid($subscriptionid, $nth)
795 get the $nth's previous serial for the given subscriptionid
801 sub GetPreviousSerialid {
802 my ( $subscriptionid, $nth ) = @_;
804 my $dbh = C4::Context->dbh;
808 my $strsth = "SELECT serialid
810 WHERE subscriptionid = ?
812 ORDER BY serialid DESC LIMIT $nth,1
814 my $sth = $dbh->prepare($strsth);
815 $sth->execute($subscriptionid);
817 my $line = $sth->fetchrow_hashref;
818 $return = $line->{'serialid'} if ($line);
826 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
827 $newinnerloop1, $newinnerloop2, $newinnerloop3
828 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
830 $subscription is a hashref containing all the attributes of the table
832 $pattern is a hashref containing all the attributes of the table
833 'subscription_numberpatterns'.
834 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
835 $planneddate is a date string in iso format.
836 This function get the next issue for the subscription given on input arg
841 my ($subscription, $pattern, $frequency, $planneddate) = @_;
843 return unless ($subscription and $pattern);
845 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
846 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
849 if ($subscription->{'skip_serialseq'}) {
850 my @irreg = split /;/, $subscription->{'irregularity'};
852 my $irregularities = {};
853 $irregularities->{$_} = 1 foreach(@irreg);
854 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
855 while($irregularities->{$issueno}) {
862 my $numberingmethod = $pattern->{numberingmethod};
864 if ($numberingmethod) {
865 $calculated = $numberingmethod;
866 my $locale = $subscription->{locale};
867 $newlastvalue1 = $subscription->{lastvalue1} || 0;
868 $newlastvalue2 = $subscription->{lastvalue2} || 0;
869 $newlastvalue3 = $subscription->{lastvalue3} || 0;
870 $newinnerloop1 = $subscription->{innerloop1} || 0;
871 $newinnerloop2 = $subscription->{innerloop2} || 0;
872 $newinnerloop3 = $subscription->{innerloop3} || 0;
875 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
878 for(my $i = 0; $i < $count; $i++) {
880 # check if we have to increase the new value.
882 if ($newinnerloop1 >= $pattern->{every1}) {
884 $newlastvalue1 += $pattern->{add1};
886 # reset counter if needed.
887 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
890 # check if we have to increase the new value.
892 if ($newinnerloop2 >= $pattern->{every2}) {
894 $newlastvalue2 += $pattern->{add2};
896 # reset counter if needed.
897 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
900 # check if we have to increase the new value.
902 if ($newinnerloop3 >= $pattern->{every3}) {
904 $newlastvalue3 += $pattern->{add3};
906 # reset counter if needed.
907 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
911 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
912 $calculated =~ s/\{X\}/$newlastvalue1string/g;
915 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
916 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
919 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
920 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
925 $newlastvalue1, $newlastvalue2, $newlastvalue3,
926 $newinnerloop1, $newinnerloop2, $newinnerloop3);
931 $calculated = GetSeq($subscription, $pattern)
932 $subscription is a hashref containing all the attributes of the table 'subscription'
933 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
934 this function transforms {X},{Y},{Z} to 150,0,0 for example.
936 the sequence in string format
941 my ($subscription, $pattern) = @_;
943 return unless ($subscription and $pattern);
945 my $locale = $subscription->{locale};
947 my $calculated = $pattern->{numberingmethod};
949 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
950 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
951 $calculated =~ s/\{X\}/$newlastvalue1/g;
953 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
954 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
955 $calculated =~ s/\{Y\}/$newlastvalue2/g;
957 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
958 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
959 $calculated =~ s/\{Z\}/$newlastvalue3/g;
963 =head2 GetExpirationDate
965 $enddate = GetExpirationDate($subscriptionid, [$startdate])
967 this function return the next expiration date for a subscription given on input args.
974 sub GetExpirationDate {
975 my ( $subscriptionid, $startdate ) = @_;
977 return unless ($subscriptionid);
979 my $dbh = C4::Context->dbh;
980 my $subscription = GetSubscription($subscriptionid);
983 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
984 $enddate = $startdate || $subscription->{startdate};
985 my @date = split( /-/, $enddate );
987 return if ( scalar(@date) != 3 || not check_date(@date) );
989 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
990 if ( $frequency and $frequency->{unit} ) {
993 if ( my $length = $subscription->{numberlength} ) {
995 #calculate the date of the last issue.
996 for ( my $i = 1 ; $i <= $length ; $i++ ) {
997 $enddate = GetNextDate( $subscription, $enddate, $frequency );
999 } elsif ( $subscription->{monthlength} ) {
1000 if ( $$subscription{startdate} ) {
1001 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1002 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1004 } elsif ( $subscription->{weeklength} ) {
1005 if ( $$subscription{startdate} ) {
1006 my @date = split( /-/, $subscription->{startdate} );
1007 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1008 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1011 $enddate = $subscription->{enddate};
1015 return $subscription->{enddate};
1019 =head2 CountSubscriptionFromBiblionumber
1021 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1022 this returns a count of the subscriptions for a given biblionumber
1024 the number of subscriptions
1028 sub CountSubscriptionFromBiblionumber {
1029 my ($biblionumber) = @_;
1031 return unless ($biblionumber);
1033 my $dbh = C4::Context->dbh;
1034 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1035 my $sth = $dbh->prepare($query);
1036 $sth->execute($biblionumber);
1037 my $subscriptionsnumber = $sth->fetchrow;
1038 return $subscriptionsnumber;
1041 =head2 ModSubscriptionHistory
1043 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1045 this function modifies the history of a subscription. Put your new values on input arg.
1046 returns the number of rows affected
1050 sub ModSubscriptionHistory {
1051 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1053 return unless ($subscriptionid);
1055 my $dbh = C4::Context->dbh;
1056 my $query = "UPDATE subscriptionhistory
1057 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1058 WHERE subscriptionid=?
1060 my $sth = $dbh->prepare($query);
1061 $receivedlist =~ s/^; // if $receivedlist;
1062 $missinglist =~ s/^; // if $missinglist;
1063 $opacnote =~ s/^; // if $opacnote;
1064 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1068 =head2 ModSerialStatus
1070 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1071 $publisheddatetext, $status, $notes);
1073 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1074 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1078 sub ModSerialStatus {
1079 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1080 $status, $notes) = @_;
1082 return unless ($serialid);
1084 #It is a usual serial
1085 # 1st, get previous status :
1086 my $dbh = C4::Context->dbh;
1087 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1088 FROM serial, subscription
1089 WHERE serial.subscriptionid=subscription.subscriptionid
1091 my $sth = $dbh->prepare($query);
1092 $sth->execute($serialid);
1093 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1094 my $frequency = GetSubscriptionFrequency($periodicity);
1096 # change status & update subscriptionhistory
1098 if ( $status == DELETED ) {
1099 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1103 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1104 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1107 $sth = $dbh->prepare($query);
1108 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1109 $planneddate, $status, $notes, $routingnotes, $serialid );
1110 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1111 $sth = $dbh->prepare($query);
1112 $sth->execute($subscriptionid);
1113 my $val = $sth->fetchrow_hashref;
1114 unless ( $val->{manualhistory} ) {
1115 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1116 $sth = $dbh->prepare($query);
1117 $sth->execute($subscriptionid);
1118 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1120 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1121 $recievedlist .= "; $serialseq"
1122 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1125 # in case serial has been previously marked as missing
1126 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1127 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1130 $missinglist .= "; $serialseq"
1131 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1132 $missinglist .= "; not issued $serialseq"
1133 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1135 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1136 $sth = $dbh->prepare($query);
1137 $recievedlist =~ s/^; //;
1138 $missinglist =~ s/^; //;
1139 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1143 # create new expected entry if needed (ie : was "expected" and has changed)
1144 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1145 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1146 my $subscription = GetSubscription($subscriptionid);
1147 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1148 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1152 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1153 $newinnerloop1, $newinnerloop2, $newinnerloop3
1155 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1157 # next date (calculated from actual date & frequency parameters)
1158 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1159 my $nextpubdate = $nextpublisheddate;
1160 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1161 WHERE subscriptionid = ?";
1162 $sth = $dbh->prepare($query);
1163 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1164 my $newnote = C4::Context->preference('PreserveSerialNotes') ? $notes : "";
1165 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $newnote, $routingnotes );
1166 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1167 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1168 require C4::Letters;
1169 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1176 =head2 GetNextExpected
1178 $nextexpected = GetNextExpected($subscriptionid)
1180 Get the planneddate for the current expected issue of the subscription.
1186 planneddate => ISO date
1191 sub GetNextExpected {
1192 my ($subscriptionid) = @_;
1194 my $dbh = C4::Context->dbh;
1198 WHERE subscriptionid = ?
1202 my $sth = $dbh->prepare($query);
1204 # Each subscription has only one 'expected' issue.
1205 $sth->execute( $subscriptionid, EXPECTED );
1206 my $nextissue = $sth->fetchrow_hashref;
1207 if ( !$nextissue ) {
1211 WHERE subscriptionid = ?
1212 ORDER BY publisheddate DESC
1215 $sth = $dbh->prepare($query);
1216 $sth->execute($subscriptionid);
1217 $nextissue = $sth->fetchrow_hashref;
1219 foreach(qw/planneddate publisheddate/) {
1220 if ( !defined $nextissue->{$_} ) {
1221 # or should this default to 1st Jan ???
1222 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1224 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1232 =head2 ModNextExpected
1234 ModNextExpected($subscriptionid,$date)
1236 Update the planneddate for the current expected issue of the subscription.
1237 This will modify all future prediction results.
1239 C<$date> is an ISO date.
1245 sub ModNextExpected {
1246 my ( $subscriptionid, $date ) = @_;
1247 my $dbh = C4::Context->dbh;
1249 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1250 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1252 # Each subscription has only one 'expected' issue.
1253 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1258 =head2 GetSubscriptionIrregularities
1262 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1263 get the list of irregularities for a subscription
1269 sub GetSubscriptionIrregularities {
1270 my $subscriptionid = shift;
1272 return unless $subscriptionid;
1274 my $dbh = C4::Context->dbh;
1278 WHERE subscriptionid = ?
1280 my $sth = $dbh->prepare($query);
1281 $sth->execute($subscriptionid);
1283 my ($result) = $sth->fetchrow_array;
1284 my @irreg = split /;/, $result;
1289 =head2 ModSubscription
1291 this function modifies a subscription. Put all new values on input args.
1292 returns the number of rows affected
1296 sub ModSubscription {
1298 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1299 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1300 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1301 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1302 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1303 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1304 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1305 $itemtype, $previousitemtype, $mana_id
1308 my $dbh = C4::Context->dbh;
1309 my $query = "UPDATE subscription
1310 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1311 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1312 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1313 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1314 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1315 callnumber=?, notes=?, letter=?, manualhistory=?,
1316 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1317 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1318 skip_serialseq=?, itemtype=?, previousitemtype=?, mana_id=?
1319 WHERE subscriptionid = ?";
1321 my $sth = $dbh->prepare($query);
1323 $auser, $branchcode, $aqbooksellerid, $cost,
1324 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1325 $irregularity, $numberpattern, $locale, $numberlength,
1326 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1327 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1328 $status, $biblionumber, $callnumber, $notes,
1329 $letter, ($manualhistory ? $manualhistory : 0),
1330 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1331 $graceperiod, $location, $enddate, $skip_serialseq,
1332 $itemtype, $previousitemtype, $mana_id,
1335 my $rows = $sth->rows;
1337 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1341 =head2 NewSubscription
1343 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1344 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1345 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1346 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1347 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1348 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1349 $skip_serialseq, $itemtype, $previousitemtype);
1351 Create a new subscription with value given on input args.
1354 the id of this new subscription
1358 sub NewSubscription {
1360 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1361 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1362 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1363 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1364 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1365 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1366 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1368 my $dbh = C4::Context->dbh;
1370 my $subscription = Koha::Subscription->new(
1372 librarian => $auser,
1373 branchcode => $branchcode,
1374 aqbooksellerid => $aqbooksellerid,
1376 aqbudgetid => $aqbudgetid,
1377 biblionumber => $biblionumber,
1378 startdate => $startdate,
1379 periodicity => $periodicity,
1380 numberlength => $numberlength,
1381 weeklength => $weeklength,
1382 monthlength => $monthlength,
1383 lastvalue1 => $lastvalue1,
1384 innerloop1 => $innerloop1,
1385 lastvalue2 => $lastvalue2,
1386 innerloop2 => $innerloop2,
1387 lastvalue3 => $lastvalue3,
1388 innerloop3 => $innerloop3,
1392 firstacquidate => $firstacquidate,
1393 irregularity => $irregularity,
1394 numberpattern => $numberpattern,
1396 callnumber => $callnumber,
1397 manualhistory => $manualhistory,
1398 internalnotes => $internalnotes,
1399 serialsadditems => $serialsadditems,
1400 staffdisplaycount => $staffdisplaycount,
1401 opacdisplaycount => $opacdisplaycount,
1402 graceperiod => $graceperiod,
1403 location => $location,
1404 enddate => $enddate,
1405 skip_serialseq => $skip_serialseq,
1406 itemtype => $itemtype,
1407 previousitemtype => $previousitemtype,
1408 mana_id => $mana_id,
1411 $subscription->discard_changes;
1412 my $subscriptionid = $subscription->subscriptionid;
1413 my ( $query, $sth );
1415 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1419 WHERE subscriptionid=?
1421 $sth = $dbh->prepare($query);
1422 $sth->execute( $enddate, $subscriptionid );
1425 # then create the 1st expected number
1427 INSERT INTO subscriptionhistory
1428 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1429 VALUES (?,?,?, '', '')
1431 $sth = $dbh->prepare($query);
1432 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1434 # reread subscription to get a hash (for calculation of the 1st issue number)
1435 $subscription = GetSubscription($subscriptionid); # We should not do that
1436 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1438 # calculate issue number
1439 my $serialseq = GetSeq($subscription, $pattern) || q{};
1443 serialseq => $serialseq,
1444 serialseq_x => $subscription->{'lastvalue1'},
1445 serialseq_y => $subscription->{'lastvalue2'},
1446 serialseq_z => $subscription->{'lastvalue3'},
1447 subscriptionid => $subscriptionid,
1448 biblionumber => $biblionumber,
1450 planneddate => $firstacquidate,
1451 publisheddate => $firstacquidate,
1455 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1457 #set serial flag on biblio if not already set.
1458 my $biblio = Koha::Biblios->find( $biblionumber );
1459 if ( $biblio and !$biblio->serial ) {
1460 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1461 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial' );
1463 eval { $record->field($tag)->update( $subf => 1 ); };
1465 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1467 return $subscriptionid;
1470 =head2 ReNewSubscription
1472 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1474 this function renew a subscription with values given on input args.
1478 sub ReNewSubscription {
1479 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note, $branchcode ) = @_;
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},
1501 'biblionumber' => $subscription->{biblionumber},
1502 'branchcode' => $branchcode,
1507 $numberlength ||= 0; # Should not we raise an exception instead?
1510 # renew subscription
1513 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1514 WHERE subscriptionid=?
1516 $sth = $dbh->prepare($query);
1517 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1518 my $enddate = GetExpirationDate($subscriptionid);
1519 $debug && warn "enddate :$enddate";
1523 WHERE subscriptionid=?
1525 $sth = $dbh->prepare($query);
1526 $sth->execute( $enddate, $subscriptionid );
1528 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1534 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1536 Create a new issue stored on the database.
1537 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1538 returns the serial id
1543 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1544 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1545 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1547 return unless ($subscriptionid);
1549 my $schema = Koha::Database->new()->schema();
1551 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1553 my $serial = Koha::Serial->new(
1555 serialseq => $serialseq,
1556 serialseq_x => $subscription->lastvalue1(),
1557 serialseq_y => $subscription->lastvalue2(),
1558 serialseq_z => $subscription->lastvalue3(),
1559 subscriptionid => $subscriptionid,
1560 biblionumber => $biblionumber,
1562 planneddate => $planneddate,
1563 publisheddate => $publisheddate,
1564 publisheddatetext => $publisheddatetext,
1566 routingnotes => $routingnotes
1570 my $serialid = $serial->id();
1572 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1573 my $missinglist = $subscription_history->missinglist();
1574 my $recievedlist = $subscription_history->recievedlist();
1576 if ( $status == ARRIVED ) {
1577 ### TODO Add a feature that improves recognition and description.
1578 ### As such count (serialseq) i.e. : N18,2(N19),N20
1579 ### Would use substr and index But be careful to previous presence of ()
1580 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1582 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1583 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1586 $recievedlist =~ s/^; //;
1587 $missinglist =~ s/^; //;
1589 $subscription_history->recievedlist($recievedlist);
1590 $subscription_history->missinglist($missinglist);
1591 $subscription_history->store();
1596 =head2 HasSubscriptionStrictlyExpired
1598 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1600 the subscription has stricly expired when today > the end subscription date
1603 1 if true, 0 if false, -1 if the expiration date is not set.
1607 sub HasSubscriptionStrictlyExpired {
1609 # Getting end of subscription date
1610 my ($subscriptionid) = @_;
1612 return unless ($subscriptionid);
1614 my $dbh = C4::Context->dbh;
1615 my $subscription = GetSubscription($subscriptionid);
1616 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1618 # If the expiration date is set
1619 if ( $expirationdate != 0 ) {
1620 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1622 # Getting today's date
1623 my ( $nowyear, $nowmonth, $nowday ) = Today();
1625 # if today's date > expiration date, then the subscription has stricly expired
1626 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1633 # There are some cases where the expiration date is not set
1634 # As we can't determine if the subscription has expired on a date-basis,
1640 =head2 HasSubscriptionExpired
1642 $has_expired = HasSubscriptionExpired($subscriptionid)
1644 the subscription has expired when the next issue to arrive is out of subscription limit.
1647 0 if the subscription has not expired
1648 1 if the subscription has expired
1649 2 if has subscription does not have a valid expiration date set
1653 sub HasSubscriptionExpired {
1654 my ($subscriptionid) = @_;
1656 return unless ($subscriptionid);
1658 my $dbh = C4::Context->dbh;
1659 my $subscription = GetSubscription($subscriptionid);
1660 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1661 if ( $frequency and $frequency->{unit} ) {
1662 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1663 if (!defined $expirationdate) {
1664 $expirationdate = q{};
1667 SELECT max(planneddate)
1669 WHERE subscriptionid=?
1671 my $sth = $dbh->prepare($query);
1672 $sth->execute($subscriptionid);
1673 my ($res) = $sth->fetchrow;
1674 if (!$res || $res=~m/^0000/) {
1677 my @res = split( /-/, $res );
1678 my @endofsubscriptiondate = split( /-/, $expirationdate );
1679 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1681 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1686 if ( $subscription->{'numberlength'} ) {
1687 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1688 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1694 return 0; # Notice that you'll never get here.
1697 =head2 DelSubscription
1699 DelSubscription($subscriptionid)
1700 this function deletes subscription which has $subscriptionid as id.
1704 sub DelSubscription {
1705 my ($subscriptionid) = @_;
1706 my $dbh = C4::Context->dbh;
1707 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1708 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1709 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1711 Koha::AdditionalFieldValues->search({
1712 'field.tablename' => 'subscription',
1713 'me.record_id' => $subscriptionid,
1714 }, { join => 'field' })->delete;
1716 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1721 DelIssue($serialseq,$subscriptionid)
1722 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1724 returns the number of rows affected
1729 my ($dataissue) = @_;
1730 my $dbh = C4::Context->dbh;
1731 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1736 AND subscriptionid= ?
1738 my $mainsth = $dbh->prepare($query);
1739 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1741 #Delete element from subscription history
1742 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1743 my $sth = $dbh->prepare($query);
1744 $sth->execute( $dataissue->{'subscriptionid'} );
1745 my $val = $sth->fetchrow_hashref;
1746 unless ( $val->{manualhistory} ) {
1748 SELECT * FROM subscriptionhistory
1749 WHERE subscriptionid= ?
1751 my $sth = $dbh->prepare($query);
1752 $sth->execute( $dataissue->{'subscriptionid'} );
1753 my $data = $sth->fetchrow_hashref;
1754 my $serialseq = $dataissue->{'serialseq'};
1755 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1756 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1757 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1758 $sth = $dbh->prepare($strsth);
1759 $sth->execute( $dataissue->{'subscriptionid'} );
1762 return $mainsth->rows;
1765 =head2 GetLateOrMissingIssues
1767 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1769 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1772 the issuelist as an array of hash refs. Each element of this array contains
1773 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1777 sub GetLateOrMissingIssues {
1778 my ( $supplierid, $serialid, $order ) = @_;
1780 return unless ( $supplierid or $serialid );
1782 my $dbh = C4::Context->dbh;
1787 $byserial = "and serialid = " . $serialid;
1790 $order .= ", title";
1794 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1796 $sth = $dbh->prepare(
1798 serialid, aqbooksellerid, name,
1799 biblio.title, biblioitems.issn, planneddate, serialseq,
1800 serial.status, serial.subscriptionid, claimdate, claims_count,
1801 subscription.branchcode
1803 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1804 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1805 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1806 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1807 WHERE subscription.subscriptionid = serial.subscriptionid
1808 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1809 AND subscription.aqbooksellerid=$supplierid
1814 $sth = $dbh->prepare(
1816 serialid, aqbooksellerid, name,
1817 biblio.title, planneddate, serialseq,
1818 serial.status, serial.subscriptionid, claimdate, claims_count,
1819 subscription.branchcode
1821 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1822 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1823 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1824 WHERE subscription.subscriptionid = serial.subscriptionid
1825 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1830 $sth->execute( EXPECTED, LATE, CLAIMED );
1832 while ( my $line = $sth->fetchrow_hashref ) {
1834 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1835 $line->{planneddateISO} = $line->{planneddate};
1836 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1838 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1839 $line->{claimdateISO} = $line->{claimdate};
1840 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1842 $line->{"status".$line->{status}} = 1;
1844 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1845 $line->{additional_fields} = { map { $_->field->name => $_->value }
1846 $subscription_object->additional_field_values->as_list };
1848 push @issuelist, $line;
1855 &updateClaim($serialid)
1857 this function updates the time when a claim is issued for late/missing items
1859 called from claims.pl file
1864 my ($serialids) = @_;
1865 return unless $serialids;
1866 unless ( ref $serialids ) {
1867 $serialids = [ $serialids ];
1869 my $dbh = C4::Context->dbh;
1872 SET claimdate = NOW(),
1873 claims_count = claims_count + 1,
1875 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1876 {}, CLAIMED, @$serialids );
1879 =head2 check_routing
1881 $result = &check_routing($subscriptionid)
1883 this function checks to see if a serial has a routing list and returns the count of routingid
1884 used to show either an 'add' or 'edit' link
1889 my ($subscriptionid) = @_;
1891 return unless ($subscriptionid);
1893 my $dbh = C4::Context->dbh;
1894 my $sth = $dbh->prepare(
1895 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1896 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1897 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1900 $sth->execute($subscriptionid);
1901 my $line = $sth->fetchrow_hashref;
1902 my $result = $line->{'routingids'};
1906 =head2 addroutingmember
1908 addroutingmember($borrowernumber,$subscriptionid)
1910 this function takes a borrowernumber and subscriptionid and adds the member to the
1911 routing list for that serial subscription and gives them a rank on the list
1912 of either 1 or highest current rank + 1
1916 sub addroutingmember {
1917 my ( $borrowernumber, $subscriptionid ) = @_;
1919 return unless ($borrowernumber and $subscriptionid);
1922 my $dbh = C4::Context->dbh;
1923 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1924 $sth->execute($subscriptionid);
1925 while ( my $line = $sth->fetchrow_hashref ) {
1926 if ( $line->{'rank'} > 0 ) {
1927 $rank = $line->{'rank'} + 1;
1932 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1933 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1936 =head2 reorder_members
1938 reorder_members($subscriptionid,$routingid,$rank)
1940 this function is used to reorder the routing list
1942 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1943 - it gets all members on list puts their routingid's into an array
1944 - removes the one in the array that is $routingid
1945 - then reinjects $routingid at point indicated by $rank
1946 - then update the database with the routingids in the new order
1950 sub reorder_members {
1951 my ( $subscriptionid, $routingid, $rank ) = @_;
1952 my $dbh = C4::Context->dbh;
1953 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1954 $sth->execute($subscriptionid);
1956 while ( my $line = $sth->fetchrow_hashref ) {
1957 push( @result, $line->{'routingid'} );
1960 # To find the matching index
1962 my $key = -1; # to allow for 0 being a valid response
1963 for ( $i = 0 ; $i < @result ; $i++ ) {
1964 if ( $routingid == $result[$i] ) {
1965 $key = $i; # save the index
1970 # if index exists in array then move it to new position
1971 if ( $key > -1 && $rank > 0 ) {
1972 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1973 my $moving_item = splice( @result, $key, 1 );
1974 splice( @result, $new_rank, 0, $moving_item );
1976 for ( my $j = 0 ; $j < @result ; $j++ ) {
1977 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1983 =head2 delroutingmember
1985 delroutingmember($routingid,$subscriptionid)
1987 this function either deletes one member from routing list if $routingid exists otherwise
1988 deletes all members from the routing list
1992 sub delroutingmember {
1994 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1995 my ( $routingid, $subscriptionid ) = @_;
1996 my $dbh = C4::Context->dbh;
1998 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1999 $sth->execute($routingid);
2000 reorder_members( $subscriptionid, $routingid );
2002 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2003 $sth->execute($subscriptionid);
2008 =head2 getroutinglist
2010 @routinglist = getroutinglist($subscriptionid)
2012 this gets the info from the subscriptionroutinglist for $subscriptionid
2015 the routinglist as an array. Each element of the array contains a hash_ref containing
2016 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2020 sub getroutinglist {
2021 my ($subscriptionid) = @_;
2022 my $dbh = C4::Context->dbh;
2023 my $sth = $dbh->prepare(
2024 'SELECT routingid, borrowernumber, ranking, biblionumber
2026 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2027 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2029 $sth->execute($subscriptionid);
2030 my $routinglist = $sth->fetchall_arrayref({});
2031 return @{$routinglist};
2034 =head2 countissuesfrom
2036 $result = countissuesfrom($subscriptionid,$startdate)
2038 Returns a count of serial rows matching the given subsctiptionid
2039 with published date greater than startdate
2043 sub countissuesfrom {
2044 my ( $subscriptionid, $startdate ) = @_;
2045 my $dbh = C4::Context->dbh;
2049 WHERE subscriptionid=?
2050 AND serial.publisheddate>?
2052 my $sth = $dbh->prepare($query);
2053 $sth->execute( $subscriptionid, $startdate );
2054 my ($countreceived) = $sth->fetchrow;
2055 return $countreceived;
2060 $result = CountIssues($subscriptionid)
2062 Returns a count of serial rows matching the given subsctiptionid
2067 my ($subscriptionid) = @_;
2068 my $dbh = C4::Context->dbh;
2072 WHERE subscriptionid=?
2074 my $sth = $dbh->prepare($query);
2075 $sth->execute($subscriptionid);
2076 my ($countreceived) = $sth->fetchrow;
2077 return $countreceived;
2082 $result = HasItems($subscriptionid)
2084 returns a count of items from serial matching the subscriptionid
2089 my ($subscriptionid) = @_;
2090 my $dbh = C4::Context->dbh;
2092 SELECT COUNT(serialitems.itemnumber)
2094 LEFT JOIN serialitems USING(serialid)
2095 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2097 my $sth=$dbh->prepare($query);
2098 $sth->execute($subscriptionid);
2099 my ($countitems)=$sth->fetchrow_array();
2103 =head2 abouttoexpire
2105 $result = abouttoexpire($subscriptionid)
2107 this function alerts you to the penultimate issue for a serial subscription
2109 returns 1 - if this is the penultimate issue
2115 my ($subscriptionid) = @_;
2116 my $dbh = C4::Context->dbh;
2117 my $subscription = GetSubscription($subscriptionid);
2118 my $per = $subscription->{'periodicity'};
2119 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2120 if ($frequency and $frequency->{unit}){
2122 my $expirationdate = GetExpirationDate($subscriptionid);
2124 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2125 my $nextdate = GetNextDate($subscription, $res, $frequency);
2127 # only compare dates if both dates exist.
2128 if ($nextdate and $expirationdate) {
2129 if(Date::Calc::Delta_Days(
2130 split( /-/, $nextdate ),
2131 split( /-/, $expirationdate )
2137 } elsif ($subscription->{numberlength}>0) {
2138 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2144 =head2 GetFictiveIssueNumber
2146 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2148 Get the position of the issue published at $publisheddate, considering the
2149 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2150 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2151 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2152 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2153 depending on how many rows are in serial table.
2154 The issue number calculation is based on subscription frequency, first acquisition
2155 date, and $publisheddate.
2157 Returns undef when called for irregular frequencies.
2159 The routine is used to skip irregularities when calculating the next issue
2160 date (in GetNextDate) or the next issue number (in GetNextSeq).
2164 sub GetFictiveIssueNumber {
2165 my ($subscription, $publisheddate, $frequency) = @_;
2167 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2171 my ( $year, $month, $day ) = split /-/, $publisheddate;
2172 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2173 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2175 if( $frequency->{'unitsperissue'} == 1 ) {
2176 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2177 } else { # issuesperunit == 1
2178 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2184 my ( $date1, $date2, $unit ) = @_;
2185 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2187 if( $unit eq 'day' ) {
2188 return Delta_Days( @$date1, @$date2 );
2189 } elsif( $unit eq 'week' ) {
2190 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2193 # In case of months or years, this is a wrapper around N_Delta_YMD.
2194 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2195 # while we expect 1 month.
2196 my @delta = N_Delta_YMD( @$date1, @$date2 );
2197 if( $delta[2] > 27 ) {
2198 # Check if we could add a month
2199 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2200 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2204 if( $delta[1] >= 12 ) {
2208 # if unit is year, we only return full years
2209 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2212 sub _get_next_date_day {
2213 my ($subscription, $freqdata, $year, $month, $day) = @_;
2215 my @newissue; # ( yy, mm, dd )
2216 # We do not need $delta_days here, since it would be zero where used
2218 if( $freqdata->{issuesperunit} == 1 ) {
2220 @newissue = Add_Delta_Days(
2221 $year, $month, $day, $freqdata->{"unitsperissue"} );
2222 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2224 @newissue = ( $year, $month, $day );
2225 $subscription->{countissuesperunit}++;
2227 # We finished a cycle of issues within a unit.
2228 # No subtraction of zero needed, just add one day
2229 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2230 $subscription->{countissuesperunit} = 1;
2235 sub _get_next_date_week {
2236 my ($subscription, $freqdata, $year, $month, $day) = @_;
2238 my @newissue; # ( yy, mm, dd )
2239 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2241 if( $freqdata->{issuesperunit} == 1 ) {
2242 # Add full weeks (of 7 days)
2243 @newissue = Add_Delta_Days(
2244 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2245 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2246 # Add rounded number of days based on frequency.
2247 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2248 $subscription->{countissuesperunit}++;
2250 # We finished a cycle of issues within a unit.
2251 # Subtract delta * (issues - 1), add 1 week
2252 @newissue = Add_Delta_Days( $year, $month, $day,
2253 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2254 @newissue = Add_Delta_Days( @newissue, 7 );
2255 $subscription->{countissuesperunit} = 1;
2260 sub _get_next_date_month {
2261 my ($subscription, $freqdata, $year, $month, $day) = @_;
2263 my @newissue; # ( yy, mm, dd )
2264 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2266 if( $freqdata->{issuesperunit} == 1 ) {
2268 @newissue = Add_Delta_YM(
2269 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2270 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2271 # Add rounded number of days based on frequency.
2272 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2273 $subscription->{countissuesperunit}++;
2275 # We finished a cycle of issues within a unit.
2276 # Subtract delta * (issues - 1), add 1 month
2277 @newissue = Add_Delta_Days( $year, $month, $day,
2278 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2279 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2280 $subscription->{countissuesperunit} = 1;
2285 sub _get_next_date_year {
2286 my ($subscription, $freqdata, $year, $month, $day) = @_;
2288 my @newissue; # ( yy, mm, dd )
2289 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2291 if( $freqdata->{issuesperunit} == 1 ) {
2293 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2294 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2295 # Add rounded number of days based on frequency.
2296 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2297 $subscription->{countissuesperunit}++;
2299 # We finished a cycle of issues within a unit.
2300 # Subtract delta * (issues - 1), add 1 year
2301 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2302 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2303 $subscription->{countissuesperunit} = 1;
2310 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2312 this function it takes the publisheddate and will return the next issue's date
2313 and will skip dates if there exists an irregularity.
2314 $publisheddate has to be an ISO date
2315 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2316 $frequency is a hashref containing frequency informations
2317 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2318 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2319 skipped then the returned date will be 2007-05-10
2322 $resultdate - then next date in the sequence (ISO date)
2324 Return undef if subscription is irregular
2329 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2331 return unless $subscription and $publisheddate;
2334 if ($freqdata->{'unit'}) {
2335 my ( $year, $month, $day ) = split /-/, $publisheddate;
2337 # Process an irregularity Hash
2338 # Suppose that irregularities are stored in a string with this structure
2339 # irreg1;irreg2;irreg3
2340 # where irregX is the number of issue which will not be received
2341 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2343 if ( $subscription->{irregularity} ) {
2344 my @irreg = split /;/, $subscription->{'irregularity'} ;
2345 foreach my $irregularity (@irreg) {
2346 $irregularities{$irregularity} = 1;
2350 # Get the 'fictive' next issue number
2351 # It is used to check if next issue is an irregular issue.
2352 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2354 # Then get the next date
2355 my $unit = lc $freqdata->{'unit'};
2356 if ($unit eq 'day') {
2357 while ($irregularities{$issueno}) {
2358 ($year, $month, $day) = _get_next_date_day($subscription,
2359 $freqdata, $year, $month, $day);
2362 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2363 $year, $month, $day);
2365 elsif ($unit eq 'week') {
2366 while ($irregularities{$issueno}) {
2367 ($year, $month, $day) = _get_next_date_week($subscription,
2368 $freqdata, $year, $month, $day);
2371 ($year, $month, $day) = _get_next_date_week($subscription,
2372 $freqdata, $year, $month, $day);
2374 elsif ($unit eq 'month') {
2375 while ($irregularities{$issueno}) {
2376 ($year, $month, $day) = _get_next_date_month($subscription,
2377 $freqdata, $year, $month, $day);
2380 ($year, $month, $day) = _get_next_date_month($subscription,
2381 $freqdata, $year, $month, $day);
2383 elsif ($unit eq 'year') {
2384 while ($irregularities{$issueno}) {
2385 ($year, $month, $day) = _get_next_date_year($subscription,
2386 $freqdata, $year, $month, $day);
2389 ($year, $month, $day) = _get_next_date_year($subscription,
2390 $freqdata, $year, $month, $day);
2394 my $dbh = C4::Context->dbh;
2397 SET countissuesperunit = ?
2398 WHERE subscriptionid = ?
2400 my $sth = $dbh->prepare($query);
2401 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2404 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2410 $string = &_numeration($value,$num_type,$locale);
2412 _numeration returns the string corresponding to $value in the num_type
2424 my ($value, $num_type, $locale) = @_;
2429 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2430 # 1970-11-01 was a Sunday
2431 $value = $value % 7;
2432 my $dt = DateTime->new(
2438 $string = $num_type =~ /^dayname$/
2439 ? $dt->strftime("%A")
2440 : $dt->strftime("%a");
2441 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2442 $value = $value % 12;
2443 my $dt = DateTime->new(
2445 month => $value + 1,
2448 $string = $num_type =~ /^monthname$/
2449 ? $dt->strftime("%B")
2450 : $dt->strftime("%b");
2451 } elsif ( $num_type =~ /^season$/ ) {
2452 my @seasons= qw( Spring Summer Fall Winter );
2453 $value = $value % 4;
2454 $string = $seasons[$value];
2455 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2456 my @seasonsabrv= qw( Spr Sum Fal Win );
2457 $value = $value % 4;
2458 $string = $seasonsabrv[$value];
2466 =head2 CloseSubscription
2468 Close a subscription given a subscriptionid
2472 sub CloseSubscription {
2473 my ( $subscriptionid ) = @_;
2474 return unless $subscriptionid;
2475 my $dbh = C4::Context->dbh;
2476 my $sth = $dbh->prepare( q{
2479 WHERE subscriptionid = ?
2481 $sth->execute( $subscriptionid );
2483 # Set status = missing when status = stopped
2484 $sth = $dbh->prepare( q{
2487 WHERE subscriptionid = ?
2490 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2493 =head2 ReopenSubscription
2495 Reopen a subscription given a subscriptionid
2499 sub ReopenSubscription {
2500 my ( $subscriptionid ) = @_;
2501 return unless $subscriptionid;
2502 my $dbh = C4::Context->dbh;
2503 my $sth = $dbh->prepare( q{
2506 WHERE subscriptionid = ?
2508 $sth->execute( $subscriptionid );
2510 # Set status = expected when status = stopped
2511 $sth = $dbh->prepare( q{
2514 WHERE subscriptionid = ?
2517 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2520 =head2 subscriptionCurrentlyOnOrder
2522 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2524 Return 1 if subscription is currently on order else 0.
2528 sub subscriptionCurrentlyOnOrder {
2529 my ( $subscriptionid ) = @_;
2530 my $dbh = C4::Context->dbh;
2532 SELECT COUNT(*) FROM aqorders
2533 WHERE subscriptionid = ?
2534 AND datereceived IS NULL
2535 AND datecancellationprinted IS NULL
2537 my $sth = $dbh->prepare( $query );
2538 $sth->execute($subscriptionid);
2539 return $sth->fetchrow_array;
2542 =head2 can_claim_subscription
2544 $can = can_claim_subscription( $subscriptionid[, $userid] );
2546 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2550 sub can_claim_subscription {
2551 my ( $subscription, $userid ) = @_;
2552 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2555 =head2 can_edit_subscription
2557 $can = can_edit_subscription( $subscriptionid[, $userid] );
2559 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2563 sub can_edit_subscription {
2564 my ( $subscription, $userid ) = @_;
2565 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2568 =head2 can_show_subscription
2570 $can = can_show_subscription( $subscriptionid[, $userid] );
2572 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2576 sub can_show_subscription {
2577 my ( $subscription, $userid ) = @_;
2578 return _can_do_on_subscription( $subscription, $userid, '*' );
2581 sub _can_do_on_subscription {
2582 my ( $subscription, $userid, $permission ) = @_;
2583 return 0 unless C4::Context->userenv;
2584 my $flags = C4::Context->userenv->{flags};
2585 $userid ||= C4::Context->userenv->{'id'};
2587 if ( C4::Context->preference('IndependentBranches') ) {
2589 if C4::Context->IsSuperLibrarian()
2591 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2593 C4::Auth::haspermission( $userid,
2594 { serials => $permission } )
2595 and ( not defined $subscription->{branchcode}
2596 or $subscription->{branchcode} eq ''
2597 or $subscription->{branchcode} eq
2598 C4::Context->userenv->{'branch'} )
2603 if C4::Context->IsSuperLibrarian()
2605 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2606 or C4::Auth::haspermission(
2607 $userid, { serials => $permission }
2614 =head2 findSerialsByStatus
2616 @serials = findSerialsByStatus($status, $subscriptionid);
2618 Returns an array of serials matching a given status and subscription id.
2622 sub findSerialsByStatus {
2623 my ( $status, $subscriptionid ) = @_;
2624 my $dbh = C4::Context->dbh;
2625 my $query = q| SELECT * from serial
2627 AND subscriptionid = ?
2629 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2638 Koha Development Team <http://koha-community.org/>