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 # Add additional fields to the subscription into a new key "additional_fields"
278 my %additional_field_values = map {
279 $_->field->name => $_->value
280 } Koha::Subscriptions->find($subscriptionid)->additional_field_values;
281 $subscription->{additional_fields} = \%additional_field_values;
283 if ( my $mana_id = $subscription->{mana_id} ) {
284 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
285 'subscription', $mana_id, {usecomments => 1});
286 $subscription->{comments} = $mana_subscription->{data}->{comments};
289 return $subscription;
292 =head2 GetFullSubscription
294 $array_ref = GetFullSubscription($subscriptionid)
295 this function reads the serial table.
299 sub GetFullSubscription {
300 my ($subscriptionid) = @_;
302 return unless ($subscriptionid);
304 my $dbh = C4::Context->dbh;
306 SELECT serial.serialid,
309 serial.publisheddate,
310 serial.publisheddatetext,
312 serial.notes as notes,
313 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
314 aqbooksellers.name as aqbooksellername,
315 biblio.title as bibliotitle,
316 subscription.branchcode AS branchcode,
317 subscription.subscriptionid AS subscriptionid
319 LEFT JOIN subscription ON
320 (serial.subscriptionid=subscription.subscriptionid )
321 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
322 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
323 WHERE serial.subscriptionid = ?
325 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
326 serial.subscriptionid
328 $debug and warn "GetFullSubscription query: $query";
329 my $sth = $dbh->prepare($query);
330 $sth->execute($subscriptionid);
331 my $subscriptions = $sth->fetchall_arrayref( {} );
332 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
333 for my $subscription ( @$subscriptions ) {
334 $subscription->{cannotedit} = $cannotedit;
336 return $subscriptions;
339 =head2 PrepareSerialsData
341 $array_ref = PrepareSerialsData($serialinfomation)
342 where serialinformation is a hashref array
346 sub PrepareSerialsData {
349 return unless ($lines);
355 my $aqbooksellername;
359 my $previousnote = "";
361 foreach my $subs (@{$lines}) {
362 for my $datefield ( qw(publisheddate planneddate) ) {
363 # handle 0000-00-00 dates
364 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
365 $subs->{$datefield} = undef;
368 $subs->{ "status" . $subs->{'status'} } = 1;
369 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
370 $subs->{"checked"} = 1;
373 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
374 $year = $subs->{'year'};
378 if ( $tmpresults{$year} ) {
379 push @{ $tmpresults{$year}->{'serials'} }, $subs;
381 $tmpresults{$year} = {
383 'aqbooksellername' => $subs->{'aqbooksellername'},
384 'bibliotitle' => $subs->{'bibliotitle'},
385 'serials' => [$subs],
390 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
391 push @res, $tmpresults{$key};
396 =head2 GetSubscriptionsFromBiblionumber
398 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
399 this function get the subscription list. it reads the subscription table.
401 reference to an array of subscriptions which have the biblionumber given on input arg.
402 each element of this array is a hashref containing
403 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
407 sub GetSubscriptionsFromBiblionumber {
408 my ($biblionumber) = @_;
410 return unless ($biblionumber);
412 my $dbh = C4::Context->dbh;
414 SELECT subscription.*,
416 subscriptionhistory.*,
417 aqbooksellers.name AS aqbooksellername,
418 biblio.title AS bibliotitle
420 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
421 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
422 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
423 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
424 WHERE subscription.biblionumber = ?
426 my $sth = $dbh->prepare($query);
427 $sth->execute($biblionumber);
429 while ( my $subs = $sth->fetchrow_hashref ) {
430 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
431 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
432 if ( defined $subs->{histenddate} ) {
433 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
435 $subs->{histenddate} = "";
437 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
438 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
439 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
440 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
441 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
442 $subs->{ "status" . $subs->{'status'} } = 1;
444 if (not defined $subs->{enddate} ) {
445 $subs->{enddate} = '';
447 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
449 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
450 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
451 $subs->{cannotedit} = not can_edit_subscription( $subs );
457 =head2 GetFullSubscriptionsFromBiblionumber
459 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
460 this function reads the serial table.
464 sub GetFullSubscriptionsFromBiblionumber {
465 my ($biblionumber) = @_;
466 my $dbh = C4::Context->dbh;
468 SELECT serial.serialid,
471 serial.publisheddate,
472 serial.publisheddatetext,
474 serial.notes as notes,
475 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
476 biblio.title as bibliotitle,
477 subscription.branchcode AS branchcode,
478 subscription.subscriptionid AS subscriptionid
480 LEFT JOIN subscription ON
481 (serial.subscriptionid=subscription.subscriptionid)
482 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
483 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
484 WHERE subscription.biblionumber = ?
486 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
487 serial.subscriptionid
489 my $sth = $dbh->prepare($query);
490 $sth->execute($biblionumber);
491 my $subscriptions = $sth->fetchall_arrayref( {} );
492 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
493 for my $subscription ( @$subscriptions ) {
494 $subscription->{cannotedit} = $cannotedit;
496 return $subscriptions;
499 =head2 SearchSubscriptions
501 @results = SearchSubscriptions($args);
503 This function returns a list of hashrefs, one for each subscription
504 that meets the conditions specified by the $args hashref.
506 The valid search fields are:
520 The expiration_date search field is special; it specifies the maximum
521 subscription expiration date.
525 sub SearchSubscriptions {
528 my $additional_fields = $args->{additional_fields} // [];
529 my $matching_record_ids_for_additional_fields = [];
530 if ( @$additional_fields ) {
531 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
533 return () unless @subscriptions;
535 $matching_record_ids_for_additional_fields = [ map {
542 subscription.notes AS publicnotes,
543 subscriptionhistory.*,
545 biblio.notes AS biblionotes,
549 aqbooksellers.name AS vendorname,
552 LEFT JOIN subscriptionhistory USING(subscriptionid)
553 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
554 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
555 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
557 $query .= q| WHERE 1|;
560 if( $args->{biblionumber} ) {
561 push @where_strs, "biblio.biblionumber = ?";
562 push @where_args, $args->{biblionumber};
565 if( $args->{title} ){
566 my @words = split / /, $args->{title};
568 foreach my $word (@words) {
569 push @strs, "biblio.title LIKE ?";
570 push @args, "%$word%";
573 push @where_strs, '(' . join (' AND ', @strs) . ')';
574 push @where_args, @args;
578 push @where_strs, "biblioitems.issn LIKE ?";
579 push @where_args, "%$args->{issn}%";
582 push @where_strs, "biblioitems.ean LIKE ?";
583 push @where_args, "%$args->{ean}%";
585 if ( $args->{callnumber} ) {
586 push @where_strs, "subscription.callnumber LIKE ?";
587 push @where_args, "%$args->{callnumber}%";
589 if( $args->{publisher} ){
590 push @where_strs, "biblioitems.publishercode LIKE ?";
591 push @where_args, "%$args->{publisher}%";
593 if( $args->{bookseller} ){
594 push @where_strs, "aqbooksellers.name LIKE ?";
595 push @where_args, "%$args->{bookseller}%";
597 if( $args->{branch} ){
598 push @where_strs, "subscription.branchcode = ?";
599 push @where_args, "$args->{branch}";
601 if ( $args->{location} ) {
602 push @where_strs, "subscription.location = ?";
603 push @where_args, "$args->{location}";
605 if ( $args->{expiration_date} ) {
606 push @where_strs, "subscription.enddate <= ?";
607 push @where_args, "$args->{expiration_date}";
609 if( defined $args->{closed} ){
610 push @where_strs, "subscription.closed = ?";
611 push @where_args, "$args->{closed}";
615 $query .= ' AND ' . join(' AND ', @where_strs);
617 if ( @$additional_fields ) {
618 $query .= ' AND subscriptionid IN ('
619 . join( ', ', @$matching_record_ids_for_additional_fields )
623 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
625 my $dbh = C4::Context->dbh;
626 my $sth = $dbh->prepare($query);
627 $sth->execute(@where_args);
628 my $results = $sth->fetchall_arrayref( {} );
630 for my $subscription ( @$results ) {
631 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
632 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
634 my %additional_field_values = map {
635 $_->field->name => $_->value
636 } Koha::Subscriptions->find($subscription->{subscriptionid})->additional_field_values;
637 $subscription->{additional_fields} = \%additional_field_values;
646 ($totalissues,@serials) = GetSerials($subscriptionid);
647 this function gets every serial not arrived for a given subscription
648 as well as the number of issues registered in the database (all types)
649 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
651 FIXME: We should return \@serials.
656 my ( $subscriptionid, $count ) = @_;
658 return unless $subscriptionid;
660 my $dbh = C4::Context->dbh;
662 # status = 2 is "arrived"
664 $count = 5 unless ($count);
666 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
667 my $query = "SELECT serialid,serialseq, status, publisheddate,
668 publisheddatetext, planneddate,notes, routingnotes
670 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
671 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
672 my $sth = $dbh->prepare($query);
673 $sth->execute($subscriptionid);
675 while ( my $line = $sth->fetchrow_hashref ) {
676 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
677 for my $datefield ( qw( planneddate publisheddate) ) {
678 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
679 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
681 $line->{$datefield} = q{};
684 push @serials, $line;
687 # OK, now add the last 5 issues arrives/missing
688 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
689 publisheddatetext, notes, routingnotes
691 WHERE subscriptionid = ?
692 AND status IN ( $statuses )
693 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
695 $sth = $dbh->prepare($query);
696 $sth->execute($subscriptionid);
697 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
699 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
700 for my $datefield ( qw( planneddate publisheddate) ) {
701 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
702 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
704 $line->{$datefield} = q{};
708 push @serials, $line;
711 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
712 $sth = $dbh->prepare($query);
713 $sth->execute($subscriptionid);
714 my ($totalissues) = $sth->fetchrow;
715 return ( $totalissues, @serials );
720 @serials = GetSerials2($subscriptionid,$statuses);
721 this function returns every serial waited for a given subscription
722 as well as the number of issues registered in the database (all types)
723 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
725 $statuses is an arrayref of statuses and is mandatory.
730 my ( $subscription, $statuses ) = @_;
732 return unless ($subscription and @$statuses);
734 my $dbh = C4::Context->dbh;
736 SELECT serialid,serialseq, status, planneddate, publisheddate,
737 publisheddatetext, notes, routingnotes
739 WHERE subscriptionid=?
741 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
743 ORDER BY publisheddate,serialid DESC
745 $debug and warn "GetSerials2 query: $query";
746 my $sth = $dbh->prepare($query);
747 $sth->execute( $subscription, @$statuses );
750 while ( my $line = $sth->fetchrow_hashref ) {
751 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
752 # Format dates for display
753 for my $datefield ( qw( planneddate publisheddate ) ) {
754 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
755 $line->{$datefield} = q{};
758 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
761 push @serials, $line;
766 =head2 GetLatestSerials
768 \@serials = GetLatestSerials($subscriptionid,$limit)
769 get the $limit's latest serials arrived or missing for a given subscription
771 a ref to an array which contains all of the latest serials stored into a hash.
775 sub GetLatestSerials {
776 my ( $subscriptionid, $limit ) = @_;
778 return unless ($subscriptionid and $limit);
780 my $dbh = C4::Context->dbh;
782 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
783 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
785 WHERE subscriptionid = ?
786 AND status IN ($statuses)
787 ORDER BY publisheddate DESC LIMIT 0,$limit
789 my $sth = $dbh->prepare($strsth);
790 $sth->execute($subscriptionid);
792 while ( my $line = $sth->fetchrow_hashref ) {
793 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
794 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
795 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
796 push @serials, $line;
802 =head2 GetPreviousSerialid
804 $serialid = GetPreviousSerialid($subscriptionid, $nth)
805 get the $nth's previous serial for the given subscriptionid
811 sub GetPreviousSerialid {
812 my ( $subscriptionid, $nth ) = @_;
814 my $dbh = C4::Context->dbh;
818 my $strsth = "SELECT serialid
820 WHERE subscriptionid = ?
822 ORDER BY serialid DESC LIMIT $nth,1
824 my $sth = $dbh->prepare($strsth);
825 $sth->execute($subscriptionid);
827 my $line = $sth->fetchrow_hashref;
828 $return = $line->{'serialid'} if ($line);
836 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
837 $newinnerloop1, $newinnerloop2, $newinnerloop3
838 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
840 $subscription is a hashref containing all the attributes of the table
842 $pattern is a hashref containing all the attributes of the table
843 'subscription_numberpatterns'.
844 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
845 $planneddate is a date string in iso format.
846 This function get the next issue for the subscription given on input arg
851 my ($subscription, $pattern, $frequency, $planneddate) = @_;
853 return unless ($subscription and $pattern);
855 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
856 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
859 if ($subscription->{'skip_serialseq'}) {
860 my @irreg = split /;/, $subscription->{'irregularity'};
862 my $irregularities = {};
863 $irregularities->{$_} = 1 foreach(@irreg);
864 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
865 while($irregularities->{$issueno}) {
872 my $numberingmethod = $pattern->{numberingmethod};
874 if ($numberingmethod) {
875 $calculated = $numberingmethod;
876 my $locale = $subscription->{locale};
877 $newlastvalue1 = $subscription->{lastvalue1} || 0;
878 $newlastvalue2 = $subscription->{lastvalue2} || 0;
879 $newlastvalue3 = $subscription->{lastvalue3} || 0;
880 $newinnerloop1 = $subscription->{innerloop1} || 0;
881 $newinnerloop2 = $subscription->{innerloop2} || 0;
882 $newinnerloop3 = $subscription->{innerloop3} || 0;
885 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
888 for(my $i = 0; $i < $count; $i++) {
890 # check if we have to increase the new value.
892 if ($newinnerloop1 >= $pattern->{every1}) {
894 $newlastvalue1 += $pattern->{add1};
896 # reset counter if needed.
897 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
900 # check if we have to increase the new value.
902 if ($newinnerloop2 >= $pattern->{every2}) {
904 $newlastvalue2 += $pattern->{add2};
906 # reset counter if needed.
907 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
910 # check if we have to increase the new value.
912 if ($newinnerloop3 >= $pattern->{every3}) {
914 $newlastvalue3 += $pattern->{add3};
916 # reset counter if needed.
917 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
921 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
922 $calculated =~ s/\{X\}/$newlastvalue1string/g;
925 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
926 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
929 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
930 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
935 $newlastvalue1, $newlastvalue2, $newlastvalue3,
936 $newinnerloop1, $newinnerloop2, $newinnerloop3);
941 $calculated = GetSeq($subscription, $pattern)
942 $subscription is a hashref containing all the attributes of the table 'subscription'
943 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
944 this function transforms {X},{Y},{Z} to 150,0,0 for example.
946 the sequence in string format
951 my ($subscription, $pattern) = @_;
953 return unless ($subscription and $pattern);
955 my $locale = $subscription->{locale};
957 my $calculated = $pattern->{numberingmethod};
959 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
960 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
961 $calculated =~ s/\{X\}/$newlastvalue1/g;
963 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
964 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
965 $calculated =~ s/\{Y\}/$newlastvalue2/g;
967 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
968 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
969 $calculated =~ s/\{Z\}/$newlastvalue3/g;
973 =head2 GetExpirationDate
975 $enddate = GetExpirationDate($subscriptionid, [$startdate])
977 this function return the next expiration date for a subscription given on input args.
984 sub GetExpirationDate {
985 my ( $subscriptionid, $startdate ) = @_;
987 return unless ($subscriptionid);
989 my $dbh = C4::Context->dbh;
990 my $subscription = GetSubscription($subscriptionid);
993 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
994 $enddate = $startdate || $subscription->{startdate};
995 my @date = split( /-/, $enddate );
997 return if ( scalar(@date) != 3 || not check_date(@date) );
999 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1000 if ( $frequency and $frequency->{unit} ) {
1003 if ( my $length = $subscription->{numberlength} ) {
1005 #calculate the date of the last issue.
1006 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1007 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1009 } elsif ( $subscription->{monthlength} ) {
1010 if ( $$subscription{startdate} ) {
1011 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1012 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1014 } elsif ( $subscription->{weeklength} ) {
1015 if ( $$subscription{startdate} ) {
1016 my @date = split( /-/, $subscription->{startdate} );
1017 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1018 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1021 $enddate = $subscription->{enddate};
1025 return $subscription->{enddate};
1029 =head2 CountSubscriptionFromBiblionumber
1031 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1032 this returns a count of the subscriptions for a given biblionumber
1034 the number of subscriptions
1038 sub CountSubscriptionFromBiblionumber {
1039 my ($biblionumber) = @_;
1041 return unless ($biblionumber);
1043 my $dbh = C4::Context->dbh;
1044 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1045 my $sth = $dbh->prepare($query);
1046 $sth->execute($biblionumber);
1047 my $subscriptionsnumber = $sth->fetchrow;
1048 return $subscriptionsnumber;
1051 =head2 ModSubscriptionHistory
1053 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1055 this function modifies the history of a subscription. Put your new values on input arg.
1056 returns the number of rows affected
1060 sub ModSubscriptionHistory {
1061 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1063 return unless ($subscriptionid);
1065 my $dbh = C4::Context->dbh;
1066 my $query = "UPDATE subscriptionhistory
1067 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1068 WHERE subscriptionid=?
1070 my $sth = $dbh->prepare($query);
1071 $receivedlist =~ s/^; // if $receivedlist;
1072 $missinglist =~ s/^; // if $missinglist;
1073 $opacnote =~ s/^; // if $opacnote;
1074 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1078 =head2 ModSerialStatus
1080 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1081 $publisheddatetext, $status, $notes);
1083 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1084 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1088 sub ModSerialStatus {
1089 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1090 $status, $notes) = @_;
1092 return unless ($serialid);
1094 #It is a usual serial
1095 # 1st, get previous status :
1096 my $dbh = C4::Context->dbh;
1097 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1098 FROM serial, subscription
1099 WHERE serial.subscriptionid=subscription.subscriptionid
1101 my $sth = $dbh->prepare($query);
1102 $sth->execute($serialid);
1103 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1104 my $frequency = GetSubscriptionFrequency($periodicity);
1106 # change status & update subscriptionhistory
1108 if ( $status == DELETED ) {
1109 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1114 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1115 planneddate = ?, status = ?, notes = ?
1118 $sth = $dbh->prepare($query);
1119 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1120 $planneddate, $status, $notes, $serialid );
1121 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1122 $sth = $dbh->prepare($query);
1123 $sth->execute($subscriptionid);
1124 my $val = $sth->fetchrow_hashref;
1125 unless ( $val->{manualhistory} ) {
1126 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1127 $sth = $dbh->prepare($query);
1128 $sth->execute($subscriptionid);
1129 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1131 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1132 $recievedlist .= "; $serialseq"
1133 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1136 # in case serial has been previously marked as missing
1137 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1138 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1141 $missinglist .= "; $serialseq"
1142 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1143 $missinglist .= "; not issued $serialseq"
1144 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1146 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1147 $sth = $dbh->prepare($query);
1148 $recievedlist =~ s/^; //;
1149 $missinglist =~ s/^; //;
1150 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1154 # create new expected entry if needed (ie : was "expected" and has changed)
1155 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1156 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1157 my $subscription = GetSubscription($subscriptionid);
1158 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1159 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1163 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1164 $newinnerloop1, $newinnerloop2, $newinnerloop3
1166 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1168 # next date (calculated from actual date & frequency parameters)
1169 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1170 my $nextpubdate = $nextpublisheddate;
1171 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1172 WHERE subscriptionid = ?";
1173 $sth = $dbh->prepare($query);
1174 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1176 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1178 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1179 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1180 require C4::Letters;
1181 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1188 =head2 GetNextExpected
1190 $nextexpected = GetNextExpected($subscriptionid)
1192 Get the planneddate for the current expected issue of the subscription.
1198 planneddate => ISO date
1203 sub GetNextExpected {
1204 my ($subscriptionid) = @_;
1206 my $dbh = C4::Context->dbh;
1210 WHERE subscriptionid = ?
1214 my $sth = $dbh->prepare($query);
1216 # Each subscription has only one 'expected' issue.
1217 $sth->execute( $subscriptionid, EXPECTED );
1218 my $nextissue = $sth->fetchrow_hashref;
1219 if ( !$nextissue ) {
1223 WHERE subscriptionid = ?
1224 ORDER BY publisheddate DESC
1227 $sth = $dbh->prepare($query);
1228 $sth->execute($subscriptionid);
1229 $nextissue = $sth->fetchrow_hashref;
1231 foreach(qw/planneddate publisheddate/) {
1232 if ( !defined $nextissue->{$_} ) {
1233 # or should this default to 1st Jan ???
1234 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1236 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1244 =head2 ModNextExpected
1246 ModNextExpected($subscriptionid,$date)
1248 Update the planneddate for the current expected issue of the subscription.
1249 This will modify all future prediction results.
1251 C<$date> is an ISO date.
1257 sub ModNextExpected {
1258 my ( $subscriptionid, $date ) = @_;
1259 my $dbh = C4::Context->dbh;
1261 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1262 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1264 # Each subscription has only one 'expected' issue.
1265 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1270 =head2 GetSubscriptionIrregularities
1274 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1275 get the list of irregularities for a subscription
1281 sub GetSubscriptionIrregularities {
1282 my $subscriptionid = shift;
1284 return unless $subscriptionid;
1286 my $dbh = C4::Context->dbh;
1290 WHERE subscriptionid = ?
1292 my $sth = $dbh->prepare($query);
1293 $sth->execute($subscriptionid);
1295 my ($result) = $sth->fetchrow_array;
1296 my @irreg = split /;/, $result;
1301 =head2 ModSubscription
1303 this function modifies a subscription. Put all new values on input args.
1304 returns the number of rows affected
1308 sub ModSubscription {
1310 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1311 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1312 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1313 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1314 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1315 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1316 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1317 $itemtype, $previousitemtype
1320 my $dbh = C4::Context->dbh;
1321 my $query = "UPDATE subscription
1322 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1323 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1324 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1325 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1326 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1327 callnumber=?, notes=?, letter=?, manualhistory=?,
1328 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1329 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1330 skip_serialseq=?, itemtype=?, previousitemtype=?
1331 WHERE subscriptionid = ?";
1333 my $sth = $dbh->prepare($query);
1335 $auser, $branchcode, $aqbooksellerid, $cost,
1336 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1337 $irregularity, $numberpattern, $locale, $numberlength,
1338 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1339 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1340 $status, $biblionumber, $callnumber, $notes,
1341 $letter, ($manualhistory ? $manualhistory : 0),
1342 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1343 $graceperiod, $location, $enddate, $skip_serialseq,
1344 $itemtype, $previousitemtype,
1347 my $rows = $sth->rows;
1349 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1353 =head2 NewSubscription
1355 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1356 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1357 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1358 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1359 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1360 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1361 $skip_serialseq, $itemtype, $previousitemtype);
1363 Create a new subscription with value given on input args.
1366 the id of this new subscription
1370 sub NewSubscription {
1372 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1373 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1374 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1375 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1376 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1377 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1378 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1380 my $dbh = C4::Context->dbh;
1382 #save subscription (insert into database)
1384 INSERT INTO subscription
1385 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1386 biblionumber, startdate, periodicity, numberlength, weeklength,
1387 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1388 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1389 irregularity, numberpattern, locale, callnumber,
1390 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1391 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1392 itemtype, previousitemtype, mana_id)
1393 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?, ?)
1395 my $sth = $dbh->prepare($query);
1397 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1398 $startdate, $periodicity, $numberlength, $weeklength,
1399 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1400 $lastvalue3, $innerloop3, $status, $notes, $letter,
1401 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1402 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1403 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1404 $itemtype, $previousitemtype, $mana_id
1407 my $subscriptionid = $dbh->{'mysql_insertid'};
1409 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1413 WHERE subscriptionid=?
1415 $sth = $dbh->prepare($query);
1416 $sth->execute( $enddate, $subscriptionid );
1419 # then create the 1st expected number
1421 INSERT INTO subscriptionhistory
1422 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1423 VALUES (?,?,?, '', '')
1425 $sth = $dbh->prepare($query);
1426 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1428 # reread subscription to get a hash (for calculation of the 1st issue number)
1429 my $subscription = GetSubscription($subscriptionid);
1430 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1432 # calculate issue number
1433 my $serialseq = GetSeq($subscription, $pattern) || q{};
1437 serialseq => $serialseq,
1438 serialseq_x => $subscription->{'lastvalue1'},
1439 serialseq_y => $subscription->{'lastvalue2'},
1440 serialseq_z => $subscription->{'lastvalue3'},
1441 subscriptionid => $subscriptionid,
1442 biblionumber => $biblionumber,
1444 planneddate => $firstacquidate,
1445 publisheddate => $firstacquidate,
1449 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1451 #set serial flag on biblio if not already set.
1452 my $biblio = Koha::Biblios->find( $biblionumber );
1453 if ( $biblio and !$biblio->serial ) {
1454 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1455 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1457 eval { $record->field($tag)->update( $subf => 1 ); };
1459 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1461 return $subscriptionid;
1464 =head2 ReNewSubscription
1466 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1468 this function renew a subscription with values given on input args.
1472 sub ReNewSubscription {
1473 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1474 my $dbh = C4::Context->dbh;
1475 my $subscription = GetSubscription($subscriptionid);
1479 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1480 WHERE biblio.biblionumber=?
1482 my $sth = $dbh->prepare($query);
1483 $sth->execute( $subscription->{biblionumber} );
1484 my $biblio = $sth->fetchrow_hashref;
1486 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1487 require C4::Suggestions;
1488 C4::Suggestions::NewSuggestion(
1489 { 'suggestedby' => $user,
1490 'title' => $subscription->{bibliotitle},
1491 'author' => $biblio->{author},
1492 'publishercode' => $biblio->{publishercode},
1493 'note' => $biblio->{note},
1494 'biblionumber' => $subscription->{biblionumber}
1499 $numberlength ||= 0; # Should not we raise an exception instead?
1502 # renew subscription
1505 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1506 WHERE subscriptionid=?
1508 $sth = $dbh->prepare($query);
1509 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1510 my $enddate = GetExpirationDate($subscriptionid);
1511 $debug && warn "enddate :$enddate";
1515 WHERE subscriptionid=?
1517 $sth = $dbh->prepare($query);
1518 $sth->execute( $enddate, $subscriptionid );
1520 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1526 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1528 Create a new issue stored on the database.
1529 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1530 returns the serial id
1535 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1536 $publisheddate, $publisheddatetext, $notes ) = @_;
1537 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1539 return unless ($subscriptionid);
1541 my $schema = Koha::Database->new()->schema();
1543 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1545 my $serial = Koha::Serial->new(
1547 serialseq => $serialseq,
1548 serialseq_x => $subscription->lastvalue1(),
1549 serialseq_y => $subscription->lastvalue2(),
1550 serialseq_z => $subscription->lastvalue3(),
1551 subscriptionid => $subscriptionid,
1552 biblionumber => $biblionumber,
1554 planneddate => $planneddate,
1555 publisheddate => $publisheddate,
1556 publisheddatetext => $publisheddatetext,
1561 my $serialid = $serial->id();
1563 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1564 my $missinglist = $subscription_history->missinglist();
1565 my $recievedlist = $subscription_history->recievedlist();
1567 if ( $status == ARRIVED ) {
1568 ### TODO Add a feature that improves recognition and description.
1569 ### As such count (serialseq) i.e. : N18,2(N19),N20
1570 ### Would use substr and index But be careful to previous presence of ()
1571 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1573 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1574 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1577 $recievedlist =~ s/^; //;
1578 $missinglist =~ s/^; //;
1580 $subscription_history->recievedlist($recievedlist);
1581 $subscription_history->missinglist($missinglist);
1582 $subscription_history->store();
1587 =head2 HasSubscriptionStrictlyExpired
1589 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1591 the subscription has stricly expired when today > the end subscription date
1594 1 if true, 0 if false, -1 if the expiration date is not set.
1598 sub HasSubscriptionStrictlyExpired {
1600 # Getting end of subscription date
1601 my ($subscriptionid) = @_;
1603 return unless ($subscriptionid);
1605 my $dbh = C4::Context->dbh;
1606 my $subscription = GetSubscription($subscriptionid);
1607 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1609 # If the expiration date is set
1610 if ( $expirationdate != 0 ) {
1611 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1613 # Getting today's date
1614 my ( $nowyear, $nowmonth, $nowday ) = Today();
1616 # if today's date > expiration date, then the subscription has stricly expired
1617 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1624 # There are some cases where the expiration date is not set
1625 # As we can't determine if the subscription has expired on a date-basis,
1631 =head2 HasSubscriptionExpired
1633 $has_expired = HasSubscriptionExpired($subscriptionid)
1635 the subscription has expired when the next issue to arrive is out of subscription limit.
1638 0 if the subscription has not expired
1639 1 if the subscription has expired
1640 2 if has subscription does not have a valid expiration date set
1644 sub HasSubscriptionExpired {
1645 my ($subscriptionid) = @_;
1647 return unless ($subscriptionid);
1649 my $dbh = C4::Context->dbh;
1650 my $subscription = GetSubscription($subscriptionid);
1651 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1652 if ( $frequency and $frequency->{unit} ) {
1653 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1654 if (!defined $expirationdate) {
1655 $expirationdate = q{};
1658 SELECT max(planneddate)
1660 WHERE subscriptionid=?
1662 my $sth = $dbh->prepare($query);
1663 $sth->execute($subscriptionid);
1664 my ($res) = $sth->fetchrow;
1665 if (!$res || $res=~m/^0000/) {
1668 my @res = split( /-/, $res );
1669 my @endofsubscriptiondate = split( /-/, $expirationdate );
1670 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1672 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1677 if ( $subscription->{'numberlength'} ) {
1678 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1679 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1685 return 0; # Notice that you'll never get here.
1688 =head2 DelSubscription
1690 DelSubscription($subscriptionid)
1691 this function deletes subscription which has $subscriptionid as id.
1695 sub DelSubscription {
1696 my ($subscriptionid) = @_;
1697 my $dbh = C4::Context->dbh;
1698 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1699 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1700 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1702 Koha::AdditionalFieldValues->search({
1703 'field.tablename' => 'subscription',
1704 'me.record_id' => $subscriptionid,
1705 }, { join => 'field' })->delete;
1707 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1712 DelIssue($serialseq,$subscriptionid)
1713 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1715 returns the number of rows affected
1720 my ($dataissue) = @_;
1721 my $dbh = C4::Context->dbh;
1722 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1727 AND subscriptionid= ?
1729 my $mainsth = $dbh->prepare($query);
1730 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1732 #Delete element from subscription history
1733 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1734 my $sth = $dbh->prepare($query);
1735 $sth->execute( $dataissue->{'subscriptionid'} );
1736 my $val = $sth->fetchrow_hashref;
1737 unless ( $val->{manualhistory} ) {
1739 SELECT * FROM subscriptionhistory
1740 WHERE subscriptionid= ?
1742 my $sth = $dbh->prepare($query);
1743 $sth->execute( $dataissue->{'subscriptionid'} );
1744 my $data = $sth->fetchrow_hashref;
1745 my $serialseq = $dataissue->{'serialseq'};
1746 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1747 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1748 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1749 $sth = $dbh->prepare($strsth);
1750 $sth->execute( $dataissue->{'subscriptionid'} );
1753 return $mainsth->rows;
1756 =head2 GetLateOrMissingIssues
1758 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1760 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1763 the issuelist as an array of hash refs. Each element of this array contains
1764 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1768 sub GetLateOrMissingIssues {
1769 my ( $supplierid, $serialid, $order ) = @_;
1771 return unless ( $supplierid or $serialid );
1773 my $dbh = C4::Context->dbh;
1778 $byserial = "and serialid = " . $serialid;
1781 $order .= ", title";
1785 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1787 $sth = $dbh->prepare(
1789 serialid, aqbooksellerid, name,
1790 biblio.title, biblioitems.issn, planneddate, serialseq,
1791 serial.status, serial.subscriptionid, claimdate, claims_count,
1792 subscription.branchcode
1794 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1795 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1796 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1797 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1798 WHERE subscription.subscriptionid = serial.subscriptionid
1799 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1800 AND subscription.aqbooksellerid=$supplierid
1805 $sth = $dbh->prepare(
1807 serialid, aqbooksellerid, name,
1808 biblio.title, planneddate, serialseq,
1809 serial.status, serial.subscriptionid, claimdate, claims_count,
1810 subscription.branchcode
1812 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1813 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1814 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1815 WHERE subscription.subscriptionid = serial.subscriptionid
1816 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1821 $sth->execute( EXPECTED, LATE, CLAIMED );
1823 while ( my $line = $sth->fetchrow_hashref ) {
1825 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1826 $line->{planneddateISO} = $line->{planneddate};
1827 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1829 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1830 $line->{claimdateISO} = $line->{claimdate};
1831 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1833 $line->{"status".$line->{status}} = 1;
1835 my $subscription = Koha::Subscriptions->find($line->{subscriptionid});
1836 my %additional_field_values = map {
1837 $_->field->name => $_->value
1838 } $subscription->additional_field_values;
1839 %$line = ( %$line, additional_fields => \%additional_field_values );
1841 push @issuelist, $line;
1848 &updateClaim($serialid)
1850 this function updates the time when a claim is issued for late/missing items
1852 called from claims.pl file
1857 my ($serialids) = @_;
1858 return unless $serialids;
1859 unless ( ref $serialids ) {
1860 $serialids = [ $serialids ];
1862 my $dbh = C4::Context->dbh;
1865 SET claimdate = NOW(),
1866 claims_count = claims_count + 1,
1868 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1869 {}, CLAIMED, @$serialids );
1872 =head2 check_routing
1874 $result = &check_routing($subscriptionid)
1876 this function checks to see if a serial has a routing list and returns the count of routingid
1877 used to show either an 'add' or 'edit' link
1882 my ($subscriptionid) = @_;
1884 return unless ($subscriptionid);
1886 my $dbh = C4::Context->dbh;
1887 my $sth = $dbh->prepare(
1888 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1889 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1890 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1893 $sth->execute($subscriptionid);
1894 my $line = $sth->fetchrow_hashref;
1895 my $result = $line->{'routingids'};
1899 =head2 addroutingmember
1901 addroutingmember($borrowernumber,$subscriptionid)
1903 this function takes a borrowernumber and subscriptionid and adds the member to the
1904 routing list for that serial subscription and gives them a rank on the list
1905 of either 1 or highest current rank + 1
1909 sub addroutingmember {
1910 my ( $borrowernumber, $subscriptionid ) = @_;
1912 return unless ($borrowernumber and $subscriptionid);
1915 my $dbh = C4::Context->dbh;
1916 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1917 $sth->execute($subscriptionid);
1918 while ( my $line = $sth->fetchrow_hashref ) {
1919 if ( $line->{'rank'} > 0 ) {
1920 $rank = $line->{'rank'} + 1;
1925 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1926 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1929 =head2 reorder_members
1931 reorder_members($subscriptionid,$routingid,$rank)
1933 this function is used to reorder the routing list
1935 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1936 - it gets all members on list puts their routingid's into an array
1937 - removes the one in the array that is $routingid
1938 - then reinjects $routingid at point indicated by $rank
1939 - then update the database with the routingids in the new order
1943 sub reorder_members {
1944 my ( $subscriptionid, $routingid, $rank ) = @_;
1945 my $dbh = C4::Context->dbh;
1946 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1947 $sth->execute($subscriptionid);
1949 while ( my $line = $sth->fetchrow_hashref ) {
1950 push( @result, $line->{'routingid'} );
1953 # To find the matching index
1955 my $key = -1; # to allow for 0 being a valid response
1956 for ( $i = 0 ; $i < @result ; $i++ ) {
1957 if ( $routingid == $result[$i] ) {
1958 $key = $i; # save the index
1963 # if index exists in array then move it to new position
1964 if ( $key > -1 && $rank > 0 ) {
1965 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1966 my $moving_item = splice( @result, $key, 1 );
1967 splice( @result, $new_rank, 0, $moving_item );
1969 for ( my $j = 0 ; $j < @result ; $j++ ) {
1970 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1976 =head2 delroutingmember
1978 delroutingmember($routingid,$subscriptionid)
1980 this function either deletes one member from routing list if $routingid exists otherwise
1981 deletes all members from the routing list
1985 sub delroutingmember {
1987 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1988 my ( $routingid, $subscriptionid ) = @_;
1989 my $dbh = C4::Context->dbh;
1991 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1992 $sth->execute($routingid);
1993 reorder_members( $subscriptionid, $routingid );
1995 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1996 $sth->execute($subscriptionid);
2001 =head2 getroutinglist
2003 @routinglist = getroutinglist($subscriptionid)
2005 this gets the info from the subscriptionroutinglist for $subscriptionid
2008 the routinglist as an array. Each element of the array contains a hash_ref containing
2009 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2013 sub getroutinglist {
2014 my ($subscriptionid) = @_;
2015 my $dbh = C4::Context->dbh;
2016 my $sth = $dbh->prepare(
2017 'SELECT routingid, borrowernumber, ranking, biblionumber
2019 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2020 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2022 $sth->execute($subscriptionid);
2023 my $routinglist = $sth->fetchall_arrayref({});
2024 return @{$routinglist};
2027 =head2 countissuesfrom
2029 $result = countissuesfrom($subscriptionid,$startdate)
2031 Returns a count of serial rows matching the given subsctiptionid
2032 with published date greater than startdate
2036 sub countissuesfrom {
2037 my ( $subscriptionid, $startdate ) = @_;
2038 my $dbh = C4::Context->dbh;
2042 WHERE subscriptionid=?
2043 AND serial.publisheddate>?
2045 my $sth = $dbh->prepare($query);
2046 $sth->execute( $subscriptionid, $startdate );
2047 my ($countreceived) = $sth->fetchrow;
2048 return $countreceived;
2053 $result = CountIssues($subscriptionid)
2055 Returns a count of serial rows matching the given subsctiptionid
2060 my ($subscriptionid) = @_;
2061 my $dbh = C4::Context->dbh;
2065 WHERE subscriptionid=?
2067 my $sth = $dbh->prepare($query);
2068 $sth->execute($subscriptionid);
2069 my ($countreceived) = $sth->fetchrow;
2070 return $countreceived;
2075 $result = HasItems($subscriptionid)
2077 returns a count of items from serial matching the subscriptionid
2082 my ($subscriptionid) = @_;
2083 my $dbh = C4::Context->dbh;
2085 SELECT COUNT(serialitems.itemnumber)
2087 LEFT JOIN serialitems USING(serialid)
2088 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2090 my $sth=$dbh->prepare($query);
2091 $sth->execute($subscriptionid);
2092 my ($countitems)=$sth->fetchrow_array();
2096 =head2 abouttoexpire
2098 $result = abouttoexpire($subscriptionid)
2100 this function alerts you to the penultimate issue for a serial subscription
2102 returns 1 - if this is the penultimate issue
2108 my ($subscriptionid) = @_;
2109 my $dbh = C4::Context->dbh;
2110 my $subscription = GetSubscription($subscriptionid);
2111 my $per = $subscription->{'periodicity'};
2112 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2113 if ($frequency and $frequency->{unit}){
2115 my $expirationdate = GetExpirationDate($subscriptionid);
2117 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2118 my $nextdate = GetNextDate($subscription, $res, $frequency);
2120 # only compare dates if both dates exist.
2121 if ($nextdate and $expirationdate) {
2122 if(Date::Calc::Delta_Days(
2123 split( /-/, $nextdate ),
2124 split( /-/, $expirationdate )
2130 } elsif ($subscription->{numberlength}>0) {
2131 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2137 =head2 GetFictiveIssueNumber
2139 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2141 Get the position of the issue published at $publisheddate, considering the
2142 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2143 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2144 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2145 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2146 depending on how many rows are in serial table.
2147 The issue number calculation is based on subscription frequency, first acquisition
2148 date, and $publisheddate.
2150 Returns undef when called for irregular frequencies.
2152 The routine is used to skip irregularities when calculating the next issue
2153 date (in GetNextDate) or the next issue number (in GetNextSeq).
2157 sub GetFictiveIssueNumber {
2158 my ($subscription, $publisheddate, $frequency) = @_;
2160 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2164 my ( $year, $month, $day ) = split /-/, $publisheddate;
2165 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2166 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2168 if( $frequency->{'unitsperissue'} == 1 ) {
2169 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2170 } else { # issuesperunit == 1
2171 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2177 my ( $date1, $date2, $unit ) = @_;
2178 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2180 if( $unit eq 'day' ) {
2181 return Delta_Days( @$date1, @$date2 );
2182 } elsif( $unit eq 'week' ) {
2183 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2186 # In case of months or years, this is a wrapper around N_Delta_YMD.
2187 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2188 # while we expect 1 month.
2189 my @delta = N_Delta_YMD( @$date1, @$date2 );
2190 if( $delta[2] > 27 ) {
2191 # Check if we could add a month
2192 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2193 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2197 if( $delta[1] >= 12 ) {
2201 # if unit is year, we only return full years
2202 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2205 sub _get_next_date_day {
2206 my ($subscription, $freqdata, $year, $month, $day) = @_;
2208 my @newissue; # ( yy, mm, dd )
2209 # We do not need $delta_days here, since it would be zero where used
2211 if( $freqdata->{issuesperunit} == 1 ) {
2213 @newissue = Add_Delta_Days(
2214 $year, $month, $day, $freqdata->{"unitsperissue"} );
2215 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2217 @newissue = ( $year, $month, $day );
2218 $subscription->{countissuesperunit}++;
2220 # We finished a cycle of issues within a unit.
2221 # No subtraction of zero needed, just add one day
2222 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2223 $subscription->{countissuesperunit} = 1;
2228 sub _get_next_date_week {
2229 my ($subscription, $freqdata, $year, $month, $day) = @_;
2231 my @newissue; # ( yy, mm, dd )
2232 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2234 if( $freqdata->{issuesperunit} == 1 ) {
2235 # Add full weeks (of 7 days)
2236 @newissue = Add_Delta_Days(
2237 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2238 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2239 # Add rounded number of days based on frequency.
2240 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2241 $subscription->{countissuesperunit}++;
2243 # We finished a cycle of issues within a unit.
2244 # Subtract delta * (issues - 1), add 1 week
2245 @newissue = Add_Delta_Days( $year, $month, $day,
2246 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2247 @newissue = Add_Delta_Days( @newissue, 7 );
2248 $subscription->{countissuesperunit} = 1;
2253 sub _get_next_date_month {
2254 my ($subscription, $freqdata, $year, $month, $day) = @_;
2256 my @newissue; # ( yy, mm, dd )
2257 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2259 if( $freqdata->{issuesperunit} == 1 ) {
2261 @newissue = Add_Delta_YM(
2262 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2263 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2264 # Add rounded number of days based on frequency.
2265 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2266 $subscription->{countissuesperunit}++;
2268 # We finished a cycle of issues within a unit.
2269 # Subtract delta * (issues - 1), add 1 month
2270 @newissue = Add_Delta_Days( $year, $month, $day,
2271 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2272 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2273 $subscription->{countissuesperunit} = 1;
2278 sub _get_next_date_year {
2279 my ($subscription, $freqdata, $year, $month, $day) = @_;
2281 my @newissue; # ( yy, mm, dd )
2282 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2284 if( $freqdata->{issuesperunit} == 1 ) {
2286 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2287 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2288 # Add rounded number of days based on frequency.
2289 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2290 $subscription->{countissuesperunit}++;
2292 # We finished a cycle of issues within a unit.
2293 # Subtract delta * (issues - 1), add 1 year
2294 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2295 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2296 $subscription->{countissuesperunit} = 1;
2303 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2305 this function it takes the publisheddate and will return the next issue's date
2306 and will skip dates if there exists an irregularity.
2307 $publisheddate has to be an ISO date
2308 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2309 $frequency is a hashref containing frequency informations
2310 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2311 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2312 skipped then the returned date will be 2007-05-10
2315 $resultdate - then next date in the sequence (ISO date)
2317 Return undef if subscription is irregular
2322 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2324 return unless $subscription and $publisheddate;
2327 if ($freqdata->{'unit'}) {
2328 my ( $year, $month, $day ) = split /-/, $publisheddate;
2330 # Process an irregularity Hash
2331 # Suppose that irregularities are stored in a string with this structure
2332 # irreg1;irreg2;irreg3
2333 # where irregX is the number of issue which will not be received
2334 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2336 if ( $subscription->{irregularity} ) {
2337 my @irreg = split /;/, $subscription->{'irregularity'} ;
2338 foreach my $irregularity (@irreg) {
2339 $irregularities{$irregularity} = 1;
2343 # Get the 'fictive' next issue number
2344 # It is used to check if next issue is an irregular issue.
2345 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2347 # Then get the next date
2348 my $unit = lc $freqdata->{'unit'};
2349 if ($unit eq 'day') {
2350 while ($irregularities{$issueno}) {
2351 ($year, $month, $day) = _get_next_date_day($subscription,
2352 $freqdata, $year, $month, $day);
2355 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2356 $year, $month, $day);
2358 elsif ($unit eq 'week') {
2359 while ($irregularities{$issueno}) {
2360 ($year, $month, $day) = _get_next_date_week($subscription,
2361 $freqdata, $year, $month, $day);
2364 ($year, $month, $day) = _get_next_date_week($subscription,
2365 $freqdata, $year, $month, $day);
2367 elsif ($unit eq 'month') {
2368 while ($irregularities{$issueno}) {
2369 ($year, $month, $day) = _get_next_date_month($subscription,
2370 $freqdata, $year, $month, $day);
2373 ($year, $month, $day) = _get_next_date_month($subscription,
2374 $freqdata, $year, $month, $day);
2376 elsif ($unit eq 'year') {
2377 while ($irregularities{$issueno}) {
2378 ($year, $month, $day) = _get_next_date_year($subscription,
2379 $freqdata, $year, $month, $day);
2382 ($year, $month, $day) = _get_next_date_year($subscription,
2383 $freqdata, $year, $month, $day);
2387 my $dbh = C4::Context->dbh;
2390 SET countissuesperunit = ?
2391 WHERE subscriptionid = ?
2393 my $sth = $dbh->prepare($query);
2394 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2397 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2403 $string = &_numeration($value,$num_type,$locale);
2405 _numeration returns the string corresponding to $value in the num_type
2417 my ($value, $num_type, $locale) = @_;
2422 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2423 # 1970-11-01 was a Sunday
2424 $value = $value % 7;
2425 my $dt = DateTime->new(
2431 $string = $num_type =~ /^dayname$/
2432 ? $dt->strftime("%A")
2433 : $dt->strftime("%a");
2434 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2435 $value = $value % 12;
2436 my $dt = DateTime->new(
2438 month => $value + 1,
2441 $string = $num_type =~ /^monthname$/
2442 ? $dt->strftime("%B")
2443 : $dt->strftime("%b");
2444 } elsif ( $num_type =~ /^season$/ ) {
2445 my @seasons= qw( Spring Summer Fall Winter );
2446 $value = $value % 4;
2447 $string = $seasons[$value];
2448 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2449 my @seasonsabrv= qw( Spr Sum Fal Win );
2450 $value = $value % 4;
2451 $string = $seasonsabrv[$value];
2459 =head2 CloseSubscription
2461 Close a subscription given a subscriptionid
2465 sub CloseSubscription {
2466 my ( $subscriptionid ) = @_;
2467 return unless $subscriptionid;
2468 my $dbh = C4::Context->dbh;
2469 my $sth = $dbh->prepare( q{
2472 WHERE subscriptionid = ?
2474 $sth->execute( $subscriptionid );
2476 # Set status = missing when status = stopped
2477 $sth = $dbh->prepare( q{
2480 WHERE subscriptionid = ?
2483 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2486 =head2 ReopenSubscription
2488 Reopen a subscription given a subscriptionid
2492 sub ReopenSubscription {
2493 my ( $subscriptionid ) = @_;
2494 return unless $subscriptionid;
2495 my $dbh = C4::Context->dbh;
2496 my $sth = $dbh->prepare( q{
2499 WHERE subscriptionid = ?
2501 $sth->execute( $subscriptionid );
2503 # Set status = expected when status = stopped
2504 $sth = $dbh->prepare( q{
2507 WHERE subscriptionid = ?
2510 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2513 =head2 subscriptionCurrentlyOnOrder
2515 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2517 Return 1 if subscription is currently on order else 0.
2521 sub subscriptionCurrentlyOnOrder {
2522 my ( $subscriptionid ) = @_;
2523 my $dbh = C4::Context->dbh;
2525 SELECT COUNT(*) FROM aqorders
2526 WHERE subscriptionid = ?
2527 AND datereceived IS NULL
2528 AND datecancellationprinted IS NULL
2530 my $sth = $dbh->prepare( $query );
2531 $sth->execute($subscriptionid);
2532 return $sth->fetchrow_array;
2535 =head2 can_claim_subscription
2537 $can = can_claim_subscription( $subscriptionid[, $userid] );
2539 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2543 sub can_claim_subscription {
2544 my ( $subscription, $userid ) = @_;
2545 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2548 =head2 can_edit_subscription
2550 $can = can_edit_subscription( $subscriptionid[, $userid] );
2552 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2556 sub can_edit_subscription {
2557 my ( $subscription, $userid ) = @_;
2558 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2561 =head2 can_show_subscription
2563 $can = can_show_subscription( $subscriptionid[, $userid] );
2565 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2569 sub can_show_subscription {
2570 my ( $subscription, $userid ) = @_;
2571 return _can_do_on_subscription( $subscription, $userid, '*' );
2574 sub _can_do_on_subscription {
2575 my ( $subscription, $userid, $permission ) = @_;
2576 return 0 unless C4::Context->userenv;
2577 my $flags = C4::Context->userenv->{flags};
2578 $userid ||= C4::Context->userenv->{'id'};
2580 if ( C4::Context->preference('IndependentBranches') ) {
2582 if C4::Context->IsSuperLibrarian()
2584 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2586 C4::Auth::haspermission( $userid,
2587 { serials => $permission } )
2588 and ( not defined $subscription->{branchcode}
2589 or $subscription->{branchcode} eq ''
2590 or $subscription->{branchcode} eq
2591 C4::Context->userenv->{'branch'} )
2596 if C4::Context->IsSuperLibrarian()
2598 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2599 or C4::Auth::haspermission(
2600 $userid, { serials => $permission }
2607 =head2 findSerialsByStatus
2609 @serials = findSerialsByStatus($status, $subscriptionid);
2611 Returns an array of serials matching a given status and subscription id.
2615 sub findSerialsByStatus {
2616 my ( $status, $subscriptionid ) = @_;
2617 my $dbh = C4::Context->dbh;
2618 my $query = q| SELECT * from serial
2620 AND subscriptionid = ?
2622 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2631 Koha Development Team <http://koha-community.org/>