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::AdditionalField;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
39 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
81 &GetSuppliersWithLateIssues
82 &getroutinglist &delroutingmember &addroutingmember
84 &check_routing &updateClaim
87 &subscriptionCurrentlyOnOrder
94 C4::Serials - Serials Module Functions
102 Functions for handling subscriptions, claims routing etc.
107 =head2 GetSuppliersWithLateIssues
109 $supplierlist = GetSuppliersWithLateIssues()
111 this function get all suppliers with late issues.
114 an array_ref of suppliers each entry is a hash_ref containing id and name
115 the array is in name order
119 sub GetSuppliersWithLateIssues {
120 my $dbh = C4::Context->dbh;
121 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
123 SELECT DISTINCT id, name
125 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
126 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
129 (planneddate < now() AND serial.status=1)
130 OR serial.STATUS IN ( $statuses )
132 AND subscription.closed = 0
134 return $dbh->selectall_arrayref($query, { Slice => {} });
137 =head2 GetSubscriptionHistoryFromSubscriptionId
139 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
141 This function returns the subscription history as a hashref
145 sub GetSubscriptionHistoryFromSubscriptionId {
146 my ($subscriptionid) = @_;
148 return unless $subscriptionid;
150 my $dbh = C4::Context->dbh;
153 FROM subscriptionhistory
154 WHERE subscriptionid = ?
156 my $sth = $dbh->prepare($query);
157 $sth->execute($subscriptionid);
158 my $results = $sth->fetchrow_hashref;
164 =head2 GetSerialInformation
166 $data = GetSerialInformation($serialid);
167 returns a hash_ref containing :
168 items : items marcrecord (can be an array)
170 subscription table field
171 + information about subscription expiration
175 sub GetSerialInformation {
177 my $dbh = C4::Context->dbh;
179 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
180 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
183 my $rq = $dbh->prepare($query);
184 $rq->execute($serialid);
185 my $data = $rq->fetchrow_hashref;
187 # create item information if we have serialsadditems for this subscription
188 if ( $data->{'serialsadditems'} ) {
189 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
190 $queryitem->execute($serialid);
191 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
193 if ( scalar(@$itemnumbers) > 0 ) {
194 foreach my $itemnum (@$itemnumbers) {
196 #It is ASSUMED that GetMarcItem ALWAYS WORK...
197 #Maybe GetMarcItem should return values on failure
198 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
199 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
200 $itemprocessed->{'itemnumber'} = $itemnum->[0];
201 $itemprocessed->{'itemid'} = $itemnum->[0];
202 $itemprocessed->{'serialid'} = $serialid;
203 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
204 push @{ $data->{'items'} }, $itemprocessed;
207 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
208 $itemprocessed->{'itemid'} = "N$serialid";
209 $itemprocessed->{'serialid'} = $serialid;
210 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
211 $itemprocessed->{'countitems'} = 0;
212 push @{ $data->{'items'} }, $itemprocessed;
215 $data->{ "status" . $data->{'serstatus'} } = 1;
216 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
217 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
218 $data->{cannotedit} = not can_edit_subscription( $data );
222 =head2 AddItem2Serial
224 $rows = AddItem2Serial($serialid,$itemnumber);
225 Adds an itemnumber to Serial record
226 returns the number of rows affected
231 my ( $serialid, $itemnumber ) = @_;
233 return unless ($serialid and $itemnumber);
235 my $dbh = C4::Context->dbh;
236 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
237 $rq->execute( $serialid, $itemnumber );
241 =head2 GetSubscription
243 $subs = GetSubscription($subscriptionid)
244 this function returns the subscription which has $subscriptionid as id.
246 a hashref. This hash contains
247 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
251 sub GetSubscription {
252 my ($subscriptionid) = @_;
253 my $dbh = C4::Context->dbh;
255 SELECT subscription.*,
256 subscriptionhistory.*,
257 aqbooksellers.name AS aqbooksellername,
258 biblio.title AS bibliotitle,
259 subscription.biblionumber as bibnum
261 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
262 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
263 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
264 WHERE subscription.subscriptionid = ?
267 $debug and warn "query : $query\nsubsid :$subscriptionid";
268 my $sth = $dbh->prepare($query);
269 $sth->execute($subscriptionid);
270 my $subscription = $sth->fetchrow_hashref;
272 return unless $subscription;
274 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
276 # Add additional fields to the subscription into a new key "additional_fields"
277 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
278 tablename => 'subscription',
279 record_id => $subscriptionid,
281 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
283 return $subscription;
286 =head2 GetFullSubscription
288 $array_ref = GetFullSubscription($subscriptionid)
289 this function reads the serial table.
293 sub GetFullSubscription {
294 my ($subscriptionid) = @_;
296 return unless ($subscriptionid);
298 my $dbh = C4::Context->dbh;
300 SELECT serial.serialid,
303 serial.publisheddate,
304 serial.publisheddatetext,
306 serial.notes as notes,
307 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
308 aqbooksellers.name as aqbooksellername,
309 biblio.title as bibliotitle,
310 subscription.branchcode AS branchcode,
311 subscription.subscriptionid AS subscriptionid
313 LEFT JOIN subscription ON
314 (serial.subscriptionid=subscription.subscriptionid )
315 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
316 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
317 WHERE serial.subscriptionid = ?
319 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
320 serial.subscriptionid
322 $debug and warn "GetFullSubscription query: $query";
323 my $sth = $dbh->prepare($query);
324 $sth->execute($subscriptionid);
325 my $subscriptions = $sth->fetchall_arrayref( {} );
326 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
327 for my $subscription ( @$subscriptions ) {
328 $subscription->{cannotedit} = $cannotedit;
330 return $subscriptions;
333 =head2 PrepareSerialsData
335 $array_ref = PrepareSerialsData($serialinfomation)
336 where serialinformation is a hashref array
340 sub PrepareSerialsData {
343 return unless ($lines);
349 my $aqbooksellername;
353 my $previousnote = "";
355 foreach my $subs (@{$lines}) {
356 for my $datefield ( qw(publisheddate planneddate) ) {
357 # handle 0000-00-00 dates
358 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
359 $subs->{$datefield} = undef;
362 $subs->{ "status" . $subs->{'status'} } = 1;
363 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
364 $subs->{"checked"} = 1;
367 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
368 $year = $subs->{'year'};
372 if ( $tmpresults{$year} ) {
373 push @{ $tmpresults{$year}->{'serials'} }, $subs;
375 $tmpresults{$year} = {
377 'aqbooksellername' => $subs->{'aqbooksellername'},
378 'bibliotitle' => $subs->{'bibliotitle'},
379 'serials' => [$subs],
384 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
385 push @res, $tmpresults{$key};
390 =head2 GetSubscriptionsFromBiblionumber
392 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
393 this function get the subscription list. it reads the subscription table.
395 reference to an array of subscriptions which have the biblionumber given on input arg.
396 each element of this array is a hashref containing
397 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
401 sub GetSubscriptionsFromBiblionumber {
402 my ($biblionumber) = @_;
404 return unless ($biblionumber);
406 my $dbh = C4::Context->dbh;
408 SELECT subscription.*,
410 subscriptionhistory.*,
411 aqbooksellers.name AS aqbooksellername,
412 biblio.title AS bibliotitle
414 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
415 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
416 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
417 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
418 WHERE subscription.biblionumber = ?
420 my $sth = $dbh->prepare($query);
421 $sth->execute($biblionumber);
423 while ( my $subs = $sth->fetchrow_hashref ) {
424 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
425 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
426 if ( defined $subs->{histenddate} ) {
427 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
429 $subs->{histenddate} = "";
431 $subs->{opacnote} //= "";
432 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
433 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
434 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
435 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
436 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
437 $subs->{ "status" . $subs->{'status'} } = 1;
439 if (not defined $subs->{enddate} ) {
440 $subs->{enddate} = '';
442 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
444 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
445 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
446 $subs->{cannotedit} = not can_edit_subscription( $subs );
452 =head2 GetFullSubscriptionsFromBiblionumber
454 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
455 this function reads the serial table.
459 sub GetFullSubscriptionsFromBiblionumber {
460 my ($biblionumber) = @_;
461 my $dbh = C4::Context->dbh;
463 SELECT serial.serialid,
466 serial.publisheddate,
467 serial.publisheddatetext,
469 serial.notes as notes,
470 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
471 biblio.title as bibliotitle,
472 subscription.branchcode AS branchcode,
473 subscription.subscriptionid AS subscriptionid
475 LEFT JOIN subscription ON
476 (serial.subscriptionid=subscription.subscriptionid)
477 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
478 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
479 WHERE subscription.biblionumber = ?
481 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
482 serial.subscriptionid
484 my $sth = $dbh->prepare($query);
485 $sth->execute($biblionumber);
486 my $subscriptions = $sth->fetchall_arrayref( {} );
487 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
488 for my $subscription ( @$subscriptions ) {
489 $subscription->{cannotedit} = $cannotedit;
491 return $subscriptions;
494 =head2 SearchSubscriptions
496 @results = SearchSubscriptions($args);
498 This function returns a list of hashrefs, one for each subscription
499 that meets the conditions specified by the $args hashref.
501 The valid search fields are:
515 The expiration_date search field is special; it specifies the maximum
516 subscription expiration date.
520 sub SearchSubscriptions {
523 my $additional_fields = $args->{additional_fields} // [];
524 my $matching_record_ids_for_additional_fields = [];
525 if ( @$additional_fields ) {
526 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
527 fields => $additional_fields,
528 tablename => 'subscription',
531 return () unless @$matching_record_ids_for_additional_fields;
536 subscription.notes AS publicnotes,
537 subscriptionhistory.*,
539 biblio.notes AS biblionotes,
543 aqbooksellers.name AS vendorname,
546 LEFT JOIN subscriptionhistory USING(subscriptionid)
547 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
548 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
549 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
551 $query .= q| WHERE 1|;
554 if( $args->{biblionumber} ) {
555 push @where_strs, "biblio.biblionumber = ?";
556 push @where_args, $args->{biblionumber};
559 if( $args->{title} ){
560 my @words = split / /, $args->{title};
562 foreach my $word (@words) {
563 push @strs, "biblio.title LIKE ?";
564 push @args, "%$word%";
567 push @where_strs, '(' . join (' AND ', @strs) . ')';
568 push @where_args, @args;
572 push @where_strs, "biblioitems.issn LIKE ?";
573 push @where_args, "%$args->{issn}%";
576 push @where_strs, "biblioitems.ean LIKE ?";
577 push @where_args, "%$args->{ean}%";
579 if ( $args->{callnumber} ) {
580 push @where_strs, "subscription.callnumber LIKE ?";
581 push @where_args, "%$args->{callnumber}%";
583 if( $args->{publisher} ){
584 push @where_strs, "biblioitems.publishercode LIKE ?";
585 push @where_args, "%$args->{publisher}%";
587 if( $args->{bookseller} ){
588 push @where_strs, "aqbooksellers.name LIKE ?";
589 push @where_args, "%$args->{bookseller}%";
591 if( $args->{branch} ){
592 push @where_strs, "subscription.branchcode = ?";
593 push @where_args, "$args->{branch}";
595 if ( $args->{location} ) {
596 push @where_strs, "subscription.location = ?";
597 push @where_args, "$args->{location}";
599 if ( $args->{expiration_date} ) {
600 push @where_strs, "subscription.enddate <= ?";
601 push @where_args, "$args->{expiration_date}";
603 if( defined $args->{closed} ){
604 push @where_strs, "subscription.closed = ?";
605 push @where_args, "$args->{closed}";
609 $query .= ' AND ' . join(' AND ', @where_strs);
611 if ( @$additional_fields ) {
612 $query .= ' AND subscriptionid IN ('
613 . join( ', ', @$matching_record_ids_for_additional_fields )
617 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
619 my $dbh = C4::Context->dbh;
620 my $sth = $dbh->prepare($query);
621 $sth->execute(@where_args);
622 my $results = $sth->fetchall_arrayref( {} );
624 for my $subscription ( @$results ) {
625 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
626 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
628 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
629 record_id => $subscription->{subscriptionid},
630 tablename => 'subscription'
632 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
641 ($totalissues,@serials) = GetSerials($subscriptionid);
642 this function gets every serial not arrived for a given subscription
643 as well as the number of issues registered in the database (all types)
644 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
646 FIXME: We should return \@serials.
651 my ( $subscriptionid, $count ) = @_;
653 return unless $subscriptionid;
655 my $dbh = C4::Context->dbh;
657 # status = 2 is "arrived"
659 $count = 5 unless ($count);
661 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
662 my $query = "SELECT serialid,serialseq, status, publisheddate,
663 publisheddatetext, planneddate,notes, routingnotes
665 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
666 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
667 my $sth = $dbh->prepare($query);
668 $sth->execute($subscriptionid);
670 while ( my $line = $sth->fetchrow_hashref ) {
671 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
672 for my $datefield ( qw( planneddate publisheddate) ) {
673 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
674 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
676 $line->{$datefield} = q{};
679 push @serials, $line;
682 # OK, now add the last 5 issues arrives/missing
683 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
684 publisheddatetext, notes, routingnotes
686 WHERE subscriptionid = ?
687 AND status IN ( $statuses )
688 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
690 $sth = $dbh->prepare($query);
691 $sth->execute($subscriptionid);
692 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
694 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
695 for my $datefield ( qw( planneddate publisheddate) ) {
696 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
697 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
699 $line->{$datefield} = q{};
703 push @serials, $line;
706 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
707 $sth = $dbh->prepare($query);
708 $sth->execute($subscriptionid);
709 my ($totalissues) = $sth->fetchrow;
710 return ( $totalissues, @serials );
715 @serials = GetSerials2($subscriptionid,$statuses);
716 this function returns every serial waited for a given subscription
717 as well as the number of issues registered in the database (all types)
718 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
720 $statuses is an arrayref of statuses and is mandatory.
725 my ( $subscription, $statuses ) = @_;
727 return unless ($subscription and @$statuses);
729 my $dbh = C4::Context->dbh;
731 SELECT serialid,serialseq, status, planneddate, publisheddate,
732 publisheddatetext, notes, routingnotes
734 WHERE subscriptionid=?
736 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
738 ORDER BY publisheddate,serialid DESC
740 $debug and warn "GetSerials2 query: $query";
741 my $sth = $dbh->prepare($query);
742 $sth->execute( $subscription, @$statuses );
745 while ( my $line = $sth->fetchrow_hashref ) {
746 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
747 # Format dates for display
748 for my $datefield ( qw( planneddate publisheddate ) ) {
749 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
750 $line->{$datefield} = q{};
753 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
756 push @serials, $line;
761 =head2 GetLatestSerials
763 \@serials = GetLatestSerials($subscriptionid,$limit)
764 get the $limit's latest serials arrived or missing for a given subscription
766 a ref to an array which contains all of the latest serials stored into a hash.
770 sub GetLatestSerials {
771 my ( $subscriptionid, $limit ) = @_;
773 return unless ($subscriptionid and $limit);
775 my $dbh = C4::Context->dbh;
777 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
778 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
780 WHERE subscriptionid = ?
781 AND status IN ($statuses)
782 ORDER BY publisheddate DESC LIMIT 0,$limit
784 my $sth = $dbh->prepare($strsth);
785 $sth->execute($subscriptionid);
787 while ( my $line = $sth->fetchrow_hashref ) {
788 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
789 push @serials, $line;
795 =head2 GetPreviousSerialid
797 $serialid = GetPreviousSerialid($subscriptionid, $nth)
798 get the $nth's previous serial for the given subscriptionid
804 sub GetPreviousSerialid {
805 my ( $subscriptionid, $nth ) = @_;
807 my $dbh = C4::Context->dbh;
811 my $strsth = "SELECT serialid
813 WHERE subscriptionid = ?
815 ORDER BY serialid DESC LIMIT $nth,1
817 my $sth = $dbh->prepare($strsth);
818 $sth->execute($subscriptionid);
820 my $line = $sth->fetchrow_hashref;
821 $return = $line->{'serialid'} if ($line);
829 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
830 $newinnerloop1, $newinnerloop2, $newinnerloop3
831 ) = GetNextSeq( $subscription, $pattern, $planneddate );
833 $subscription is a hashref containing all the attributes of the table
835 $pattern is a hashref containing all the attributes of the table
836 'subscription_numberpatterns'.
837 $planneddate is a date string in iso format.
838 This function get the next issue for the subscription given on input arg
843 my ($subscription, $pattern, $planneddate) = @_;
845 return unless ($subscription and $pattern);
847 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
848 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
851 if ($subscription->{'skip_serialseq'}) {
852 my @irreg = split /;/, $subscription->{'irregularity'};
854 my $irregularities = {};
855 $irregularities->{$_} = 1 foreach(@irreg);
856 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
857 while($irregularities->{$issueno}) {
864 my $numberingmethod = $pattern->{numberingmethod};
866 if ($numberingmethod) {
867 $calculated = $numberingmethod;
868 my $locale = $subscription->{locale};
869 $newlastvalue1 = $subscription->{lastvalue1} || 0;
870 $newlastvalue2 = $subscription->{lastvalue2} || 0;
871 $newlastvalue3 = $subscription->{lastvalue3} || 0;
872 $newinnerloop1 = $subscription->{innerloop1} || 0;
873 $newinnerloop2 = $subscription->{innerloop2} || 0;
874 $newinnerloop3 = $subscription->{innerloop3} || 0;
877 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
880 for(my $i = 0; $i < $count; $i++) {
882 # check if we have to increase the new value.
884 if ($newinnerloop1 >= $pattern->{every1}) {
886 $newlastvalue1 += $pattern->{add1};
888 # reset counter if needed.
889 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
892 # check if we have to increase the new value.
894 if ($newinnerloop2 >= $pattern->{every2}) {
896 $newlastvalue2 += $pattern->{add2};
898 # reset counter if needed.
899 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
902 # check if we have to increase the new value.
904 if ($newinnerloop3 >= $pattern->{every3}) {
906 $newlastvalue3 += $pattern->{add3};
908 # reset counter if needed.
909 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
913 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
914 $calculated =~ s/\{X\}/$newlastvalue1string/g;
917 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
918 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
921 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
922 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
927 $newlastvalue1, $newlastvalue2, $newlastvalue3,
928 $newinnerloop1, $newinnerloop2, $newinnerloop3);
933 $calculated = GetSeq($subscription, $pattern)
934 $subscription is a hashref containing all the attributes of the table 'subscription'
935 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
936 this function transforms {X},{Y},{Z} to 150,0,0 for example.
938 the sequence in string format
943 my ($subscription, $pattern) = @_;
945 return unless ($subscription and $pattern);
947 my $locale = $subscription->{locale};
949 my $calculated = $pattern->{numberingmethod};
951 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
952 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
953 $calculated =~ s/\{X\}/$newlastvalue1/g;
955 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
956 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
957 $calculated =~ s/\{Y\}/$newlastvalue2/g;
959 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
960 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
961 $calculated =~ s/\{Z\}/$newlastvalue3/g;
965 =head2 GetExpirationDate
967 $enddate = GetExpirationDate($subscriptionid, [$startdate])
969 this function return the next expiration date for a subscription given on input args.
976 sub GetExpirationDate {
977 my ( $subscriptionid, $startdate ) = @_;
979 return unless ($subscriptionid);
981 my $dbh = C4::Context->dbh;
982 my $subscription = GetSubscription($subscriptionid);
985 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
986 $enddate = $startdate || $subscription->{startdate};
987 my @date = split( /-/, $enddate );
989 return if ( scalar(@date) != 3 || not check_date(@date) );
991 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
992 if ( $frequency and $frequency->{unit} ) {
995 if ( my $length = $subscription->{numberlength} ) {
997 #calculate the date of the last issue.
998 for ( my $i = 1 ; $i <= $length ; $i++ ) {
999 $enddate = GetNextDate( $subscription, $enddate );
1001 } elsif ( $subscription->{monthlength} ) {
1002 if ( $$subscription{startdate} ) {
1003 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1004 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1006 } elsif ( $subscription->{weeklength} ) {
1007 if ( $$subscription{startdate} ) {
1008 my @date = split( /-/, $subscription->{startdate} );
1009 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1010 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1013 $enddate = $subscription->{enddate};
1017 return $subscription->{enddate};
1021 =head2 CountSubscriptionFromBiblionumber
1023 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1024 this returns a count of the subscriptions for a given biblionumber
1026 the number of subscriptions
1030 sub CountSubscriptionFromBiblionumber {
1031 my ($biblionumber) = @_;
1033 return unless ($biblionumber);
1035 my $dbh = C4::Context->dbh;
1036 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1037 my $sth = $dbh->prepare($query);
1038 $sth->execute($biblionumber);
1039 my $subscriptionsnumber = $sth->fetchrow;
1040 return $subscriptionsnumber;
1043 =head2 ModSubscriptionHistory
1045 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1047 this function modifies the history of a subscription. Put your new values on input arg.
1048 returns the number of rows affected
1052 sub ModSubscriptionHistory {
1053 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1055 return unless ($subscriptionid);
1057 my $dbh = C4::Context->dbh;
1058 my $query = "UPDATE subscriptionhistory
1059 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1060 WHERE subscriptionid=?
1062 my $sth = $dbh->prepare($query);
1063 $receivedlist =~ s/^; // if $receivedlist;
1064 $missinglist =~ s/^; // if $missinglist;
1065 $opacnote =~ s/^; // if $opacnote;
1066 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1070 =head2 ModSerialStatus
1072 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1073 $publisheddatetext, $status, $notes);
1075 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1076 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1080 sub ModSerialStatus {
1081 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1082 $status, $notes) = @_;
1084 return unless ($serialid);
1086 #It is a usual serial
1087 # 1st, get previous status :
1088 my $dbh = C4::Context->dbh;
1089 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity,serial.routingnotes
1090 FROM serial, subscription
1091 WHERE serial.subscriptionid=subscription.subscriptionid
1093 my $sth = $dbh->prepare($query);
1094 $sth->execute($serialid);
1095 my ( $subscriptionid, $oldstatus, $periodicity, $routingnotes ) = $sth->fetchrow;
1096 my $frequency = GetSubscriptionFrequency($periodicity);
1098 # change status & update subscriptionhistory
1100 if ( $status == DELETED ) {
1101 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1105 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1106 planneddate = ?, status = ?, notes = ?, routingnotes = ?
1109 $sth = $dbh->prepare($query);
1110 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1111 $planneddate, $status, $notes, $routingnotes, $serialid );
1112 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1113 $sth = $dbh->prepare($query);
1114 $sth->execute($subscriptionid);
1115 my $val = $sth->fetchrow_hashref;
1116 unless ( $val->{manualhistory} ) {
1117 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1118 $sth = $dbh->prepare($query);
1119 $sth->execute($subscriptionid);
1120 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1122 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1123 $recievedlist .= "; $serialseq"
1124 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1127 # in case serial has been previously marked as missing
1128 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1129 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1132 $missinglist .= "; $serialseq"
1133 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1134 $missinglist .= "; not issued $serialseq"
1135 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1137 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1138 $sth = $dbh->prepare($query);
1139 $recievedlist =~ s/^; //;
1140 $missinglist =~ s/^; //;
1141 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1145 # create new expected entry if needed (ie : was "expected" and has changed)
1146 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1147 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1148 my $subscription = GetSubscription($subscriptionid);
1149 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1153 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1154 $newinnerloop1, $newinnerloop2, $newinnerloop3
1156 = GetNextSeq( $subscription, $pattern, $publisheddate );
1158 # next date (calculated from actual date & frequency parameters)
1159 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1160 my $nextpubdate = $nextpublisheddate;
1161 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1162 WHERE subscriptionid = ?";
1163 $sth = $dbh->prepare($query);
1164 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1165 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate, undef, $notes, $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
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=?
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,
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
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,
1410 $subscription->discard_changes;
1411 my $subscriptionid = $subscription->subscriptionid;
1412 my ( $query, $sth );
1414 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1418 WHERE subscriptionid=?
1420 $sth = $dbh->prepare($query);
1421 $sth->execute( $enddate, $subscriptionid );
1424 # then create the 1st expected number
1426 INSERT INTO subscriptionhistory
1427 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1428 VALUES (?,?,?, '', '')
1430 $sth = $dbh->prepare($query);
1431 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1433 # reread subscription to get a hash (for calculation of the 1st issue number)
1434 $subscription = GetSubscription($subscriptionid); # We should not do that
1435 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1437 # calculate issue number
1438 my $serialseq = GetSeq($subscription, $pattern) || q{};
1442 serialseq => $serialseq,
1443 serialseq_x => $subscription->{'lastvalue1'},
1444 serialseq_y => $subscription->{'lastvalue2'},
1445 serialseq_z => $subscription->{'lastvalue3'},
1446 subscriptionid => $subscriptionid,
1447 biblionumber => $biblionumber,
1449 planneddate => $firstacquidate,
1450 publisheddate => $firstacquidate,
1454 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1456 #set serial flag on biblio if not already set.
1457 my $biblio = Koha::Biblios->find( $biblionumber );
1458 if ( $biblio and !$biblio->serial ) {
1459 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1460 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1462 eval { $record->field($tag)->update( $subf => 1 ); };
1464 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1466 return $subscriptionid;
1469 =head2 ReNewSubscription
1471 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1473 this function renew a subscription with values given on input args.
1477 sub ReNewSubscription {
1478 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1479 my $dbh = C4::Context->dbh;
1480 my $subscription = GetSubscription($subscriptionid);
1484 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1485 WHERE biblio.biblionumber=?
1487 my $sth = $dbh->prepare($query);
1488 $sth->execute( $subscription->{biblionumber} );
1489 my $biblio = $sth->fetchrow_hashref;
1491 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1492 require C4::Suggestions;
1493 C4::Suggestions::NewSuggestion(
1494 { 'suggestedby' => $user,
1495 'title' => $subscription->{bibliotitle},
1496 'author' => $biblio->{author},
1497 'publishercode' => $biblio->{publishercode},
1498 'note' => $biblio->{note},
1499 'biblionumber' => $subscription->{biblionumber}
1504 $numberlength ||= 0; # Should not we raise an exception instead?
1507 # renew subscription
1510 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1511 WHERE subscriptionid=?
1513 $sth = $dbh->prepare($query);
1514 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1515 my $enddate = GetExpirationDate($subscriptionid);
1516 $debug && warn "enddate :$enddate";
1520 WHERE subscriptionid=?
1522 $sth = $dbh->prepare($query);
1523 $sth->execute( $enddate, $subscriptionid );
1525 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1531 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes, $routingnotes)
1533 Create a new issue stored on the database.
1534 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1535 returns the serial id
1540 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1541 $publisheddate, $publisheddatetext, $notes, $routingnotes ) = @_;
1542 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1544 return unless ($subscriptionid);
1546 my $schema = Koha::Database->new()->schema();
1548 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1550 my $serial = Koha::Serial->new(
1552 serialseq => $serialseq,
1553 serialseq_x => $subscription->lastvalue1(),
1554 serialseq_y => $subscription->lastvalue2(),
1555 serialseq_z => $subscription->lastvalue3(),
1556 subscriptionid => $subscriptionid,
1557 biblionumber => $biblionumber,
1559 planneddate => $planneddate,
1560 publisheddate => $publisheddate,
1561 publisheddatetext => $publisheddatetext,
1563 routingnotes => $routingnotes
1567 my $serialid = $serial->id();
1569 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1570 my $missinglist = $subscription_history->missinglist();
1571 my $recievedlist = $subscription_history->recievedlist();
1573 if ( $status == ARRIVED ) {
1574 ### TODO Add a feature that improves recognition and description.
1575 ### As such count (serialseq) i.e. : N18,2(N19),N20
1576 ### Would use substr and index But be careful to previous presence of ()
1577 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1579 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1580 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1583 $recievedlist =~ s/^; //;
1584 $missinglist =~ s/^; //;
1586 $subscription_history->recievedlist($recievedlist);
1587 $subscription_history->missinglist($missinglist);
1588 $subscription_history->store();
1593 =head2 HasSubscriptionStrictlyExpired
1595 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1597 the subscription has stricly expired when today > the end subscription date
1600 1 if true, 0 if false, -1 if the expiration date is not set.
1604 sub HasSubscriptionStrictlyExpired {
1606 # Getting end of subscription date
1607 my ($subscriptionid) = @_;
1609 return unless ($subscriptionid);
1611 my $dbh = C4::Context->dbh;
1612 my $subscription = GetSubscription($subscriptionid);
1613 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1615 # If the expiration date is set
1616 if ( $expirationdate != 0 ) {
1617 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1619 # Getting today's date
1620 my ( $nowyear, $nowmonth, $nowday ) = Today();
1622 # if today's date > expiration date, then the subscription has stricly expired
1623 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1630 # There are some cases where the expiration date is not set
1631 # As we can't determine if the subscription has expired on a date-basis,
1637 =head2 HasSubscriptionExpired
1639 $has_expired = HasSubscriptionExpired($subscriptionid)
1641 the subscription has expired when the next issue to arrive is out of subscription limit.
1644 0 if the subscription has not expired
1645 1 if the subscription has expired
1646 2 if has subscription does not have a valid expiration date set
1650 sub HasSubscriptionExpired {
1651 my ($subscriptionid) = @_;
1653 return unless ($subscriptionid);
1655 my $dbh = C4::Context->dbh;
1656 my $subscription = GetSubscription($subscriptionid);
1657 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1658 if ( $frequency and $frequency->{unit} ) {
1659 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1660 if (!defined $expirationdate) {
1661 $expirationdate = q{};
1664 SELECT max(planneddate)
1666 WHERE subscriptionid=?
1668 my $sth = $dbh->prepare($query);
1669 $sth->execute($subscriptionid);
1670 my ($res) = $sth->fetchrow;
1671 if (!$res || $res=~m/^0000/) {
1674 my @res = split( /-/, $res );
1675 my @endofsubscriptiondate = split( /-/, $expirationdate );
1676 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1678 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1683 if ( $subscription->{'numberlength'} ) {
1684 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1685 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1691 return 0; # Notice that you'll never get here.
1694 =head2 DelSubscription
1696 DelSubscription($subscriptionid)
1697 this function deletes subscription which has $subscriptionid as id.
1701 sub DelSubscription {
1702 my ($subscriptionid) = @_;
1703 my $dbh = C4::Context->dbh;
1704 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1705 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1706 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1708 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1709 foreach my $af (@$afs) {
1710 $af->delete_values({record_id => $subscriptionid});
1713 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1718 DelIssue($serialseq,$subscriptionid)
1719 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1721 returns the number of rows affected
1726 my ($dataissue) = @_;
1727 my $dbh = C4::Context->dbh;
1728 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1733 AND subscriptionid= ?
1735 my $mainsth = $dbh->prepare($query);
1736 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1738 #Delete element from subscription history
1739 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1740 my $sth = $dbh->prepare($query);
1741 $sth->execute( $dataissue->{'subscriptionid'} );
1742 my $val = $sth->fetchrow_hashref;
1743 unless ( $val->{manualhistory} ) {
1745 SELECT * FROM subscriptionhistory
1746 WHERE subscriptionid= ?
1748 my $sth = $dbh->prepare($query);
1749 $sth->execute( $dataissue->{'subscriptionid'} );
1750 my $data = $sth->fetchrow_hashref;
1751 my $serialseq = $dataissue->{'serialseq'};
1752 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1753 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1754 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1755 $sth = $dbh->prepare($strsth);
1756 $sth->execute( $dataissue->{'subscriptionid'} );
1759 return $mainsth->rows;
1762 =head2 GetLateOrMissingIssues
1764 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1766 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1769 the issuelist as an array of hash refs. Each element of this array contains
1770 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1774 sub GetLateOrMissingIssues {
1775 my ( $supplierid, $serialid, $order ) = @_;
1777 return unless ( $supplierid or $serialid );
1779 my $dbh = C4::Context->dbh;
1784 $byserial = "and serialid = " . $serialid;
1787 $order .= ", title";
1791 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1793 $sth = $dbh->prepare(
1795 serialid, aqbooksellerid, name,
1796 biblio.title, biblioitems.issn, planneddate, serialseq,
1797 serial.status, serial.subscriptionid, claimdate, claims_count,
1798 subscription.branchcode
1800 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1801 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1802 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1803 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1804 WHERE subscription.subscriptionid = serial.subscriptionid
1805 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1806 AND subscription.aqbooksellerid=$supplierid
1811 $sth = $dbh->prepare(
1813 serialid, aqbooksellerid, name,
1814 biblio.title, planneddate, serialseq,
1815 serial.status, serial.subscriptionid, claimdate, claims_count,
1816 subscription.branchcode
1818 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1819 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1820 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1821 WHERE subscription.subscriptionid = serial.subscriptionid
1822 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1827 $sth->execute( EXPECTED, LATE, CLAIMED );
1829 while ( my $line = $sth->fetchrow_hashref ) {
1831 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1832 $line->{planneddateISO} = $line->{planneddate};
1833 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1835 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1836 $line->{claimdateISO} = $line->{claimdate};
1837 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1839 $line->{"status".$line->{status}} = 1;
1841 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1842 record_id => $line->{subscriptionid},
1843 tablename => 'subscription'
1845 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1847 push @issuelist, $line;
1854 &updateClaim($serialid)
1856 this function updates the time when a claim is issued for late/missing items
1858 called from claims.pl file
1863 my ($serialids) = @_;
1864 return unless $serialids;
1865 unless ( ref $serialids ) {
1866 $serialids = [ $serialids ];
1868 my $dbh = C4::Context->dbh;
1871 SET claimdate = NOW(),
1872 claims_count = claims_count + 1,
1874 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1875 {}, CLAIMED, @$serialids );
1878 =head2 check_routing
1880 $result = &check_routing($subscriptionid)
1882 this function checks to see if a serial has a routing list and returns the count of routingid
1883 used to show either an 'add' or 'edit' link
1888 my ($subscriptionid) = @_;
1890 return unless ($subscriptionid);
1892 my $dbh = C4::Context->dbh;
1893 my $sth = $dbh->prepare(
1894 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1895 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1896 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1899 $sth->execute($subscriptionid);
1900 my $line = $sth->fetchrow_hashref;
1901 my $result = $line->{'routingids'};
1905 =head2 addroutingmember
1907 addroutingmember($borrowernumber,$subscriptionid)
1909 this function takes a borrowernumber and subscriptionid and adds the member to the
1910 routing list for that serial subscription and gives them a rank on the list
1911 of either 1 or highest current rank + 1
1915 sub addroutingmember {
1916 my ( $borrowernumber, $subscriptionid ) = @_;
1918 return unless ($borrowernumber and $subscriptionid);
1921 my $dbh = C4::Context->dbh;
1922 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1923 $sth->execute($subscriptionid);
1924 while ( my $line = $sth->fetchrow_hashref ) {
1925 if ( $line->{'rank'} > 0 ) {
1926 $rank = $line->{'rank'} + 1;
1931 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1932 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1935 =head2 reorder_members
1937 reorder_members($subscriptionid,$routingid,$rank)
1939 this function is used to reorder the routing list
1941 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1942 - it gets all members on list puts their routingid's into an array
1943 - removes the one in the array that is $routingid
1944 - then reinjects $routingid at point indicated by $rank
1945 - then update the database with the routingids in the new order
1949 sub reorder_members {
1950 my ( $subscriptionid, $routingid, $rank ) = @_;
1951 my $dbh = C4::Context->dbh;
1952 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1953 $sth->execute($subscriptionid);
1955 while ( my $line = $sth->fetchrow_hashref ) {
1956 push( @result, $line->{'routingid'} );
1959 # To find the matching index
1961 my $key = -1; # to allow for 0 being a valid response
1962 for ( $i = 0 ; $i < @result ; $i++ ) {
1963 if ( $routingid == $result[$i] ) {
1964 $key = $i; # save the index
1969 # if index exists in array then move it to new position
1970 if ( $key > -1 && $rank > 0 ) {
1971 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1972 my $moving_item = splice( @result, $key, 1 );
1973 splice( @result, $new_rank, 0, $moving_item );
1975 for ( my $j = 0 ; $j < @result ; $j++ ) {
1976 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1982 =head2 delroutingmember
1984 delroutingmember($routingid,$subscriptionid)
1986 this function either deletes one member from routing list if $routingid exists otherwise
1987 deletes all members from the routing list
1991 sub delroutingmember {
1993 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1994 my ( $routingid, $subscriptionid ) = @_;
1995 my $dbh = C4::Context->dbh;
1997 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1998 $sth->execute($routingid);
1999 reorder_members( $subscriptionid, $routingid );
2001 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2002 $sth->execute($subscriptionid);
2007 =head2 getroutinglist
2009 @routinglist = getroutinglist($subscriptionid)
2011 this gets the info from the subscriptionroutinglist for $subscriptionid
2014 the routinglist as an array. Each element of the array contains a hash_ref containing
2015 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2019 sub getroutinglist {
2020 my ($subscriptionid) = @_;
2021 my $dbh = C4::Context->dbh;
2022 my $sth = $dbh->prepare(
2023 'SELECT routingid, borrowernumber, ranking, biblionumber
2025 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2026 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2028 $sth->execute($subscriptionid);
2029 my $routinglist = $sth->fetchall_arrayref({});
2030 return @{$routinglist};
2033 =head2 countissuesfrom
2035 $result = countissuesfrom($subscriptionid,$startdate)
2037 Returns a count of serial rows matching the given subsctiptionid
2038 with published date greater than startdate
2042 sub countissuesfrom {
2043 my ( $subscriptionid, $startdate ) = @_;
2044 my $dbh = C4::Context->dbh;
2048 WHERE subscriptionid=?
2049 AND serial.publisheddate>?
2051 my $sth = $dbh->prepare($query);
2052 $sth->execute( $subscriptionid, $startdate );
2053 my ($countreceived) = $sth->fetchrow;
2054 return $countreceived;
2059 $result = CountIssues($subscriptionid)
2061 Returns a count of serial rows matching the given subsctiptionid
2066 my ($subscriptionid) = @_;
2067 my $dbh = C4::Context->dbh;
2071 WHERE subscriptionid=?
2073 my $sth = $dbh->prepare($query);
2074 $sth->execute($subscriptionid);
2075 my ($countreceived) = $sth->fetchrow;
2076 return $countreceived;
2081 $result = HasItems($subscriptionid)
2083 returns a count of items from serial matching the subscriptionid
2088 my ($subscriptionid) = @_;
2089 my $dbh = C4::Context->dbh;
2091 SELECT COUNT(serialitems.itemnumber)
2093 LEFT JOIN serialitems USING(serialid)
2094 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2096 my $sth=$dbh->prepare($query);
2097 $sth->execute($subscriptionid);
2098 my ($countitems)=$sth->fetchrow_array();
2102 =head2 abouttoexpire
2104 $result = abouttoexpire($subscriptionid)
2106 this function alerts you to the penultimate issue for a serial subscription
2108 returns 1 - if this is the penultimate issue
2114 my ($subscriptionid) = @_;
2115 my $dbh = C4::Context->dbh;
2116 my $subscription = GetSubscription($subscriptionid);
2117 my $per = $subscription->{'periodicity'};
2118 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2119 if ($frequency and $frequency->{unit}){
2121 my $expirationdate = GetExpirationDate($subscriptionid);
2123 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2124 my $nextdate = GetNextDate($subscription, $res);
2126 # only compare dates if both dates exist.
2127 if ($nextdate and $expirationdate) {
2128 if(Date::Calc::Delta_Days(
2129 split( /-/, $nextdate ),
2130 split( /-/, $expirationdate )
2136 } elsif ($subscription->{numberlength}>0) {
2137 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2143 =head2 GetFictiveIssueNumber
2145 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2147 Get the position of the issue published at $publisheddate, considering the
2148 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2149 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2150 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2151 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2152 depending on how many rows are in serial table.
2153 The issue number calculation is based on subscription frequency, first acquisition
2154 date, and $publisheddate.
2156 Returns undef when called for irregular frequencies.
2158 The routine is used to skip irregularities when calculating the next issue
2159 date (in GetNextDate) or the next issue number (in GetNextSeq).
2163 sub GetFictiveIssueNumber {
2164 my ($subscription, $publisheddate) = @_;
2166 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
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)
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 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2316 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2317 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2318 skipped then the returned date will be 2007-05-10
2321 $resultdate - then next date in the sequence (ISO date)
2323 Return undef if subscription is irregular
2328 my ( $subscription, $publisheddate, $updatecount ) = @_;
2330 return unless $subscription and $publisheddate;
2332 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
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) + 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/>