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} =~ s/\n/\<br\/\>/g;
432 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
433 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
434 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
435 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
436 $subs->{ "status" . $subs->{'status'} } = 1;
438 if (not defined $subs->{enddate} ) {
439 $subs->{enddate} = '';
441 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
443 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
444 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
445 $subs->{cannotedit} = not can_edit_subscription( $subs );
451 =head2 GetFullSubscriptionsFromBiblionumber
453 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
454 this function reads the serial table.
458 sub GetFullSubscriptionsFromBiblionumber {
459 my ($biblionumber) = @_;
460 my $dbh = C4::Context->dbh;
462 SELECT serial.serialid,
465 serial.publisheddate,
466 serial.publisheddatetext,
468 serial.notes as notes,
469 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
470 biblio.title as bibliotitle,
471 subscription.branchcode AS branchcode,
472 subscription.subscriptionid AS subscriptionid
474 LEFT JOIN subscription ON
475 (serial.subscriptionid=subscription.subscriptionid)
476 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
477 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
478 WHERE subscription.biblionumber = ?
480 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
481 serial.subscriptionid
483 my $sth = $dbh->prepare($query);
484 $sth->execute($biblionumber);
485 my $subscriptions = $sth->fetchall_arrayref( {} );
486 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
487 for my $subscription ( @$subscriptions ) {
488 $subscription->{cannotedit} = $cannotedit;
490 return $subscriptions;
493 =head2 SearchSubscriptions
495 @results = SearchSubscriptions($args);
497 This function returns a list of hashrefs, one for each subscription
498 that meets the conditions specified by the $args hashref.
500 The valid search fields are:
514 The expiration_date search field is special; it specifies the maximum
515 subscription expiration date.
519 sub SearchSubscriptions {
522 my $additional_fields = $args->{additional_fields} // [];
523 my $matching_record_ids_for_additional_fields = [];
524 if ( @$additional_fields ) {
525 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
526 fields => $additional_fields,
527 tablename => 'subscription',
530 return () unless @$matching_record_ids_for_additional_fields;
535 subscription.notes AS publicnotes,
536 subscriptionhistory.*,
538 biblio.notes AS biblionotes,
542 aqbooksellers.name AS vendorname,
545 LEFT JOIN subscriptionhistory USING(subscriptionid)
546 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
547 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
548 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
550 $query .= q| WHERE 1|;
553 if( $args->{biblionumber} ) {
554 push @where_strs, "biblio.biblionumber = ?";
555 push @where_args, $args->{biblionumber};
558 if( $args->{title} ){
559 my @words = split / /, $args->{title};
561 foreach my $word (@words) {
562 push @strs, "biblio.title LIKE ?";
563 push @args, "%$word%";
566 push @where_strs, '(' . join (' AND ', @strs) . ')';
567 push @where_args, @args;
571 push @where_strs, "biblioitems.issn LIKE ?";
572 push @where_args, "%$args->{issn}%";
575 push @where_strs, "biblioitems.ean LIKE ?";
576 push @where_args, "%$args->{ean}%";
578 if ( $args->{callnumber} ) {
579 push @where_strs, "subscription.callnumber LIKE ?";
580 push @where_args, "%$args->{callnumber}%";
582 if( $args->{publisher} ){
583 push @where_strs, "biblioitems.publishercode LIKE ?";
584 push @where_args, "%$args->{publisher}%";
586 if( $args->{bookseller} ){
587 push @where_strs, "aqbooksellers.name LIKE ?";
588 push @where_args, "%$args->{bookseller}%";
590 if( $args->{branch} ){
591 push @where_strs, "subscription.branchcode = ?";
592 push @where_args, "$args->{branch}";
594 if ( $args->{location} ) {
595 push @where_strs, "subscription.location = ?";
596 push @where_args, "$args->{location}";
598 if ( $args->{expiration_date} ) {
599 push @where_strs, "subscription.enddate <= ?";
600 push @where_args, "$args->{expiration_date}";
602 if( defined $args->{closed} ){
603 push @where_strs, "subscription.closed = ?";
604 push @where_args, "$args->{closed}";
608 $query .= ' AND ' . join(' AND ', @where_strs);
610 if ( @$additional_fields ) {
611 $query .= ' AND subscriptionid IN ('
612 . join( ', ', @$matching_record_ids_for_additional_fields )
616 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
618 my $dbh = C4::Context->dbh;
619 my $sth = $dbh->prepare($query);
620 $sth->execute(@where_args);
621 my $results = $sth->fetchall_arrayref( {} );
623 for my $subscription ( @$results ) {
624 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
625 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
627 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
628 record_id => $subscription->{subscriptionid},
629 tablename => 'subscription'
631 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
640 ($totalissues,@serials) = GetSerials($subscriptionid);
641 this function gets every serial not arrived for a given subscription
642 as well as the number of issues registered in the database (all types)
643 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
645 FIXME: We should return \@serials.
650 my ( $subscriptionid, $count ) = @_;
652 return unless $subscriptionid;
654 my $dbh = C4::Context->dbh;
656 # status = 2 is "arrived"
658 $count = 5 unless ($count);
660 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
661 my $query = "SELECT serialid,serialseq, status, publisheddate,
662 publisheddatetext, planneddate,notes, routingnotes
664 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
665 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
666 my $sth = $dbh->prepare($query);
667 $sth->execute($subscriptionid);
669 while ( my $line = $sth->fetchrow_hashref ) {
670 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
671 for my $datefield ( qw( planneddate publisheddate) ) {
672 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
673 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
675 $line->{$datefield} = q{};
678 push @serials, $line;
681 # OK, now add the last 5 issues arrives/missing
682 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
683 publisheddatetext, notes, routingnotes
685 WHERE subscriptionid = ?
686 AND status IN ( $statuses )
687 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
689 $sth = $dbh->prepare($query);
690 $sth->execute($subscriptionid);
691 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
693 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
694 for my $datefield ( qw( planneddate publisheddate) ) {
695 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
696 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
698 $line->{$datefield} = q{};
702 push @serials, $line;
705 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
706 $sth = $dbh->prepare($query);
707 $sth->execute($subscriptionid);
708 my ($totalissues) = $sth->fetchrow;
709 return ( $totalissues, @serials );
714 @serials = GetSerials2($subscriptionid,$statuses);
715 this function returns every serial waited for a given subscription
716 as well as the number of issues registered in the database (all types)
717 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
719 $statuses is an arrayref of statuses and is mandatory.
724 my ( $subscription, $statuses ) = @_;
726 return unless ($subscription and @$statuses);
728 my $dbh = C4::Context->dbh;
730 SELECT serialid,serialseq, status, planneddate, publisheddate,
731 publisheddatetext, notes, routingnotes
733 WHERE subscriptionid=?
735 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
737 ORDER BY publisheddate,serialid DESC
739 $debug and warn "GetSerials2 query: $query";
740 my $sth = $dbh->prepare($query);
741 $sth->execute( $subscription, @$statuses );
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
746 # Format dates for display
747 for my $datefield ( qw( planneddate publisheddate ) ) {
748 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
749 $line->{$datefield} = q{};
752 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
755 push @serials, $line;
760 =head2 GetLatestSerials
762 \@serials = GetLatestSerials($subscriptionid,$limit)
763 get the $limit's latest serials arrived or missing for a given subscription
765 a ref to an array which contains all of the latest serials stored into a hash.
769 sub GetLatestSerials {
770 my ( $subscriptionid, $limit ) = @_;
772 return unless ($subscriptionid and $limit);
774 my $dbh = C4::Context->dbh;
776 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
777 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
779 WHERE subscriptionid = ?
780 AND status IN ($statuses)
781 ORDER BY publisheddate DESC LIMIT 0,$limit
783 my $sth = $dbh->prepare($strsth);
784 $sth->execute($subscriptionid);
786 while ( my $line = $sth->fetchrow_hashref ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
789 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
790 push @serials, $line;
796 =head2 GetPreviousSerialid
798 $serialid = GetPreviousSerialid($subscriptionid, $nth)
799 get the $nth's previous serial for the given subscriptionid
805 sub GetPreviousSerialid {
806 my ( $subscriptionid, $nth ) = @_;
808 my $dbh = C4::Context->dbh;
812 my $strsth = "SELECT serialid
814 WHERE subscriptionid = ?
816 ORDER BY serialid DESC LIMIT $nth,1
818 my $sth = $dbh->prepare($strsth);
819 $sth->execute($subscriptionid);
821 my $line = $sth->fetchrow_hashref;
822 $return = $line->{'serialid'} if ($line);
830 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
831 $newinnerloop1, $newinnerloop2, $newinnerloop3
832 ) = GetNextSeq( $subscription, $pattern, $frequency, $planneddate );
834 $subscription is a hashref containing all the attributes of the table
836 $pattern is a hashref containing all the attributes of the table
837 'subscription_numberpatterns'.
838 $frequency is a hashref containing all the attributes of the table 'subscription_frequencies'
839 $planneddate is a date string in iso format.
840 This function get the next issue for the subscription given on input arg
845 my ($subscription, $pattern, $frequency, $planneddate) = @_;
847 return unless ($subscription and $pattern);
849 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
850 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
853 if ($subscription->{'skip_serialseq'}) {
854 my @irreg = split /;/, $subscription->{'irregularity'};
856 my $irregularities = {};
857 $irregularities->{$_} = 1 foreach(@irreg);
858 my $issueno = GetFictiveIssueNumber($subscription, $planneddate, $frequency) + 1;
859 while($irregularities->{$issueno}) {
866 my $numberingmethod = $pattern->{numberingmethod};
868 if ($numberingmethod) {
869 $calculated = $numberingmethod;
870 my $locale = $subscription->{locale};
871 $newlastvalue1 = $subscription->{lastvalue1} || 0;
872 $newlastvalue2 = $subscription->{lastvalue2} || 0;
873 $newlastvalue3 = $subscription->{lastvalue3} || 0;
874 $newinnerloop1 = $subscription->{innerloop1} || 0;
875 $newinnerloop2 = $subscription->{innerloop2} || 0;
876 $newinnerloop3 = $subscription->{innerloop3} || 0;
879 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
882 for(my $i = 0; $i < $count; $i++) {
884 # check if we have to increase the new value.
886 if ($newinnerloop1 >= $pattern->{every1}) {
888 $newlastvalue1 += $pattern->{add1};
890 # reset counter if needed.
891 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
894 # check if we have to increase the new value.
896 if ($newinnerloop2 >= $pattern->{every2}) {
898 $newlastvalue2 += $pattern->{add2};
900 # reset counter if needed.
901 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
904 # check if we have to increase the new value.
906 if ($newinnerloop3 >= $pattern->{every3}) {
908 $newlastvalue3 += $pattern->{add3};
910 # reset counter if needed.
911 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
915 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
916 $calculated =~ s/\{X\}/$newlastvalue1string/g;
919 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
920 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
923 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
924 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
929 $newlastvalue1, $newlastvalue2, $newlastvalue3,
930 $newinnerloop1, $newinnerloop2, $newinnerloop3);
935 $calculated = GetSeq($subscription, $pattern)
936 $subscription is a hashref containing all the attributes of the table 'subscription'
937 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
938 this function transforms {X},{Y},{Z} to 150,0,0 for example.
940 the sequence in string format
945 my ($subscription, $pattern) = @_;
947 return unless ($subscription and $pattern);
949 my $locale = $subscription->{locale};
951 my $calculated = $pattern->{numberingmethod};
953 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
954 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
955 $calculated =~ s/\{X\}/$newlastvalue1/g;
957 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
958 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
959 $calculated =~ s/\{Y\}/$newlastvalue2/g;
961 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
962 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
963 $calculated =~ s/\{Z\}/$newlastvalue3/g;
967 =head2 GetExpirationDate
969 $enddate = GetExpirationDate($subscriptionid, [$startdate])
971 this function return the next expiration date for a subscription given on input args.
978 sub GetExpirationDate {
979 my ( $subscriptionid, $startdate ) = @_;
981 return unless ($subscriptionid);
983 my $dbh = C4::Context->dbh;
984 my $subscription = GetSubscription($subscriptionid);
987 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
988 $enddate = $startdate || $subscription->{startdate};
989 my @date = split( /-/, $enddate );
991 return if ( scalar(@date) != 3 || not check_date(@date) );
993 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
994 if ( $frequency and $frequency->{unit} ) {
997 if ( my $length = $subscription->{numberlength} ) {
999 #calculate the date of the last issue.
1000 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1001 $enddate = GetNextDate( $subscription, $enddate, $frequency );
1003 } elsif ( $subscription->{monthlength} ) {
1004 if ( $$subscription{startdate} ) {
1005 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1006 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1008 } elsif ( $subscription->{weeklength} ) {
1009 if ( $$subscription{startdate} ) {
1010 my @date = split( /-/, $subscription->{startdate} );
1011 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1012 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1015 $enddate = $subscription->{enddate};
1019 return $subscription->{enddate};
1023 =head2 CountSubscriptionFromBiblionumber
1025 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1026 this returns a count of the subscriptions for a given biblionumber
1028 the number of subscriptions
1032 sub CountSubscriptionFromBiblionumber {
1033 my ($biblionumber) = @_;
1035 return unless ($biblionumber);
1037 my $dbh = C4::Context->dbh;
1038 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1039 my $sth = $dbh->prepare($query);
1040 $sth->execute($biblionumber);
1041 my $subscriptionsnumber = $sth->fetchrow;
1042 return $subscriptionsnumber;
1045 =head2 ModSubscriptionHistory
1047 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1049 this function modifies the history of a subscription. Put your new values on input arg.
1050 returns the number of rows affected
1054 sub ModSubscriptionHistory {
1055 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1057 return unless ($subscriptionid);
1059 my $dbh = C4::Context->dbh;
1060 my $query = "UPDATE subscriptionhistory
1061 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1062 WHERE subscriptionid=?
1064 my $sth = $dbh->prepare($query);
1065 $receivedlist =~ s/^; // if $receivedlist;
1066 $missinglist =~ s/^; // if $missinglist;
1067 $opacnote =~ s/^; // if $opacnote;
1068 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1072 =head2 ModSerialStatus
1074 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1075 $publisheddatetext, $status, $notes);
1077 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1078 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1082 sub ModSerialStatus {
1083 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1084 $status, $notes) = @_;
1086 return unless ($serialid);
1088 #It is a usual serial
1089 # 1st, get previous status :
1090 my $dbh = C4::Context->dbh;
1091 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1092 FROM serial, subscription
1093 WHERE serial.subscriptionid=subscription.subscriptionid
1095 my $sth = $dbh->prepare($query);
1096 $sth->execute($serialid);
1097 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1098 my $frequency = GetSubscriptionFrequency($periodicity);
1100 # change status & update subscriptionhistory
1102 if ( $status == DELETED ) {
1103 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1108 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1109 planneddate = ?, status = ?, notes = ?
1112 $sth = $dbh->prepare($query);
1113 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1114 $planneddate, $status, $notes, $serialid );
1115 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1116 $sth = $dbh->prepare($query);
1117 $sth->execute($subscriptionid);
1118 my $val = $sth->fetchrow_hashref;
1119 unless ( $val->{manualhistory} ) {
1120 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1121 $sth = $dbh->prepare($query);
1122 $sth->execute($subscriptionid);
1123 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1125 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1126 $recievedlist .= "; $serialseq"
1127 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1130 # in case serial has been previously marked as missing
1131 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1132 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1135 $missinglist .= "; $serialseq"
1136 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1137 $missinglist .= "; not issued $serialseq"
1138 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1140 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1141 $sth = $dbh->prepare($query);
1142 $recievedlist =~ s/^; //;
1143 $missinglist =~ s/^; //;
1144 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1148 # create new expected entry if needed (ie : was "expected" and has changed)
1149 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1150 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1151 my $subscription = GetSubscription($subscriptionid);
1152 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1153 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1157 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1158 $newinnerloop1, $newinnerloop2, $newinnerloop3
1160 = GetNextSeq( $subscription, $pattern, $frequency, $publisheddate );
1162 # next date (calculated from actual date & frequency parameters)
1163 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, $frequency, 1);
1164 my $nextpubdate = $nextpublisheddate;
1165 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1166 WHERE subscriptionid = ?";
1167 $sth = $dbh->prepare($query);
1168 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1170 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1172 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1173 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1174 require C4::Letters;
1175 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1182 =head2 GetNextExpected
1184 $nextexpected = GetNextExpected($subscriptionid)
1186 Get the planneddate for the current expected issue of the subscription.
1192 planneddate => ISO date
1197 sub GetNextExpected {
1198 my ($subscriptionid) = @_;
1200 my $dbh = C4::Context->dbh;
1204 WHERE subscriptionid = ?
1208 my $sth = $dbh->prepare($query);
1210 # Each subscription has only one 'expected' issue.
1211 $sth->execute( $subscriptionid, EXPECTED );
1212 my $nextissue = $sth->fetchrow_hashref;
1213 if ( !$nextissue ) {
1217 WHERE subscriptionid = ?
1218 ORDER BY publisheddate DESC
1221 $sth = $dbh->prepare($query);
1222 $sth->execute($subscriptionid);
1223 $nextissue = $sth->fetchrow_hashref;
1225 foreach(qw/planneddate publisheddate/) {
1226 if ( !defined $nextissue->{$_} ) {
1227 # or should this default to 1st Jan ???
1228 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1230 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1238 =head2 ModNextExpected
1240 ModNextExpected($subscriptionid,$date)
1242 Update the planneddate for the current expected issue of the subscription.
1243 This will modify all future prediction results.
1245 C<$date> is an ISO date.
1251 sub ModNextExpected {
1252 my ( $subscriptionid, $date ) = @_;
1253 my $dbh = C4::Context->dbh;
1255 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1256 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1258 # Each subscription has only one 'expected' issue.
1259 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1264 =head2 GetSubscriptionIrregularities
1268 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1269 get the list of irregularities for a subscription
1275 sub GetSubscriptionIrregularities {
1276 my $subscriptionid = shift;
1278 return unless $subscriptionid;
1280 my $dbh = C4::Context->dbh;
1284 WHERE subscriptionid = ?
1286 my $sth = $dbh->prepare($query);
1287 $sth->execute($subscriptionid);
1289 my ($result) = $sth->fetchrow_array;
1290 my @irreg = split /;/, $result;
1295 =head2 ModSubscription
1297 this function modifies a subscription. Put all new values on input args.
1298 returns the number of rows affected
1302 sub ModSubscription {
1304 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1305 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1306 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1307 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1308 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1309 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1310 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1311 $itemtype, $previousitemtype
1314 my $dbh = C4::Context->dbh;
1315 my $query = "UPDATE subscription
1316 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1317 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1318 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1319 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1320 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1321 callnumber=?, notes=?, letter=?, manualhistory=?,
1322 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1323 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1324 skip_serialseq=?, itemtype=?, previousitemtype=?
1325 WHERE subscriptionid = ?";
1327 my $sth = $dbh->prepare($query);
1329 $auser, $branchcode, $aqbooksellerid, $cost,
1330 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1331 $irregularity, $numberpattern, $locale, $numberlength,
1332 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1333 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1334 $status, $biblionumber, $callnumber, $notes,
1335 $letter, ($manualhistory ? $manualhistory : 0),
1336 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1337 $graceperiod, $location, $enddate, $skip_serialseq,
1338 $itemtype, $previousitemtype,
1341 my $rows = $sth->rows;
1343 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1347 =head2 NewSubscription
1349 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1350 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1351 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1352 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1353 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1354 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1355 $skip_serialseq, $itemtype, $previousitemtype);
1357 Create a new subscription with value given on input args.
1360 the id of this new subscription
1364 sub NewSubscription {
1366 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1367 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1368 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1369 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1370 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1371 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1372 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype, $mana_id
1374 my $dbh = C4::Context->dbh;
1376 #save subscription (insert into database)
1378 INSERT INTO subscription
1379 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1380 biblionumber, startdate, periodicity, numberlength, weeklength,
1381 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1382 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1383 irregularity, numberpattern, locale, callnumber,
1384 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1385 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1386 itemtype, previousitemtype, mana_id)
1387 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?, ?)
1389 my $sth = $dbh->prepare($query);
1391 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1392 $startdate, $periodicity, $numberlength, $weeklength,
1393 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1394 $lastvalue3, $innerloop3, $status, $notes, $letter,
1395 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1396 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1397 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1398 $itemtype, $previousitemtype, $mana_id
1401 my $subscriptionid = $dbh->{'mysql_insertid'};
1403 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1407 WHERE subscriptionid=?
1409 $sth = $dbh->prepare($query);
1410 $sth->execute( $enddate, $subscriptionid );
1413 # then create the 1st expected number
1415 INSERT INTO subscriptionhistory
1416 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1417 VALUES (?,?,?, '', '')
1419 $sth = $dbh->prepare($query);
1420 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1422 # reread subscription to get a hash (for calculation of the 1st issue number)
1423 my $subscription = GetSubscription($subscriptionid);
1424 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1426 # calculate issue number
1427 my $serialseq = GetSeq($subscription, $pattern) || q{};
1431 serialseq => $serialseq,
1432 serialseq_x => $subscription->{'lastvalue1'},
1433 serialseq_y => $subscription->{'lastvalue2'},
1434 serialseq_z => $subscription->{'lastvalue3'},
1435 subscriptionid => $subscriptionid,
1436 biblionumber => $biblionumber,
1438 planneddate => $firstacquidate,
1439 publisheddate => $firstacquidate,
1443 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1445 #set serial flag on biblio if not already set.
1446 my $biblio = Koha::Biblios->find( $biblionumber );
1447 if ( $biblio and !$biblio->serial ) {
1448 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1449 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1451 eval { $record->field($tag)->update( $subf => 1 ); };
1453 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1455 return $subscriptionid;
1458 =head2 ReNewSubscription
1460 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1462 this function renew a subscription with values given on input args.
1466 sub ReNewSubscription {
1467 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1468 my $dbh = C4::Context->dbh;
1469 my $subscription = GetSubscription($subscriptionid);
1473 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1474 WHERE biblio.biblionumber=?
1476 my $sth = $dbh->prepare($query);
1477 $sth->execute( $subscription->{biblionumber} );
1478 my $biblio = $sth->fetchrow_hashref;
1480 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1481 require C4::Suggestions;
1482 C4::Suggestions::NewSuggestion(
1483 { 'suggestedby' => $user,
1484 'title' => $subscription->{bibliotitle},
1485 'author' => $biblio->{author},
1486 'publishercode' => $biblio->{publishercode},
1487 'note' => $biblio->{note},
1488 'biblionumber' => $subscription->{biblionumber}
1493 $numberlength ||= 0; # Should not we raise an exception instead?
1496 # renew subscription
1499 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1500 WHERE subscriptionid=?
1502 $sth = $dbh->prepare($query);
1503 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1504 my $enddate = GetExpirationDate($subscriptionid);
1505 $debug && warn "enddate :$enddate";
1509 WHERE subscriptionid=?
1511 $sth = $dbh->prepare($query);
1512 $sth->execute( $enddate, $subscriptionid );
1514 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1520 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1522 Create a new issue stored on the database.
1523 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1524 returns the serial id
1529 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1530 $publisheddate, $publisheddatetext, $notes ) = @_;
1531 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1533 return unless ($subscriptionid);
1535 my $schema = Koha::Database->new()->schema();
1537 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1539 my $serial = Koha::Serial->new(
1541 serialseq => $serialseq,
1542 serialseq_x => $subscription->lastvalue1(),
1543 serialseq_y => $subscription->lastvalue2(),
1544 serialseq_z => $subscription->lastvalue3(),
1545 subscriptionid => $subscriptionid,
1546 biblionumber => $biblionumber,
1548 planneddate => $planneddate,
1549 publisheddate => $publisheddate,
1550 publisheddatetext => $publisheddatetext,
1555 my $serialid = $serial->id();
1557 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1558 my $missinglist = $subscription_history->missinglist();
1559 my $recievedlist = $subscription_history->recievedlist();
1561 if ( $status == ARRIVED ) {
1562 ### TODO Add a feature that improves recognition and description.
1563 ### As such count (serialseq) i.e. : N18,2(N19),N20
1564 ### Would use substr and index But be careful to previous presence of ()
1565 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1567 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1568 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1571 $recievedlist =~ s/^; //;
1572 $missinglist =~ s/^; //;
1574 $subscription_history->recievedlist($recievedlist);
1575 $subscription_history->missinglist($missinglist);
1576 $subscription_history->store();
1581 =head2 HasSubscriptionStrictlyExpired
1583 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1585 the subscription has stricly expired when today > the end subscription date
1588 1 if true, 0 if false, -1 if the expiration date is not set.
1592 sub HasSubscriptionStrictlyExpired {
1594 # Getting end of subscription date
1595 my ($subscriptionid) = @_;
1597 return unless ($subscriptionid);
1599 my $dbh = C4::Context->dbh;
1600 my $subscription = GetSubscription($subscriptionid);
1601 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1603 # If the expiration date is set
1604 if ( $expirationdate != 0 ) {
1605 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1607 # Getting today's date
1608 my ( $nowyear, $nowmonth, $nowday ) = Today();
1610 # if today's date > expiration date, then the subscription has stricly expired
1611 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1618 # There are some cases where the expiration date is not set
1619 # As we can't determine if the subscription has expired on a date-basis,
1625 =head2 HasSubscriptionExpired
1627 $has_expired = HasSubscriptionExpired($subscriptionid)
1629 the subscription has expired when the next issue to arrive is out of subscription limit.
1632 0 if the subscription has not expired
1633 1 if the subscription has expired
1634 2 if has subscription does not have a valid expiration date set
1638 sub HasSubscriptionExpired {
1639 my ($subscriptionid) = @_;
1641 return unless ($subscriptionid);
1643 my $dbh = C4::Context->dbh;
1644 my $subscription = GetSubscription($subscriptionid);
1645 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1646 if ( $frequency and $frequency->{unit} ) {
1647 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1648 if (!defined $expirationdate) {
1649 $expirationdate = q{};
1652 SELECT max(planneddate)
1654 WHERE subscriptionid=?
1656 my $sth = $dbh->prepare($query);
1657 $sth->execute($subscriptionid);
1658 my ($res) = $sth->fetchrow;
1659 if (!$res || $res=~m/^0000/) {
1662 my @res = split( /-/, $res );
1663 my @endofsubscriptiondate = split( /-/, $expirationdate );
1664 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1666 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1671 if ( $subscription->{'numberlength'} ) {
1672 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1673 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1679 return 0; # Notice that you'll never get here.
1682 =head2 DelSubscription
1684 DelSubscription($subscriptionid)
1685 this function deletes subscription which has $subscriptionid as id.
1689 sub DelSubscription {
1690 my ($subscriptionid) = @_;
1691 my $dbh = C4::Context->dbh;
1692 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1693 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1694 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1696 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1697 foreach my $af (@$afs) {
1698 $af->delete_values({record_id => $subscriptionid});
1701 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1706 DelIssue($serialseq,$subscriptionid)
1707 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1709 returns the number of rows affected
1714 my ($dataissue) = @_;
1715 my $dbh = C4::Context->dbh;
1716 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1721 AND subscriptionid= ?
1723 my $mainsth = $dbh->prepare($query);
1724 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1726 #Delete element from subscription history
1727 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1728 my $sth = $dbh->prepare($query);
1729 $sth->execute( $dataissue->{'subscriptionid'} );
1730 my $val = $sth->fetchrow_hashref;
1731 unless ( $val->{manualhistory} ) {
1733 SELECT * FROM subscriptionhistory
1734 WHERE subscriptionid= ?
1736 my $sth = $dbh->prepare($query);
1737 $sth->execute( $dataissue->{'subscriptionid'} );
1738 my $data = $sth->fetchrow_hashref;
1739 my $serialseq = $dataissue->{'serialseq'};
1740 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1741 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1742 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1743 $sth = $dbh->prepare($strsth);
1744 $sth->execute( $dataissue->{'subscriptionid'} );
1747 return $mainsth->rows;
1750 =head2 GetLateOrMissingIssues
1752 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1754 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1757 the issuelist as an array of hash refs. Each element of this array contains
1758 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1762 sub GetLateOrMissingIssues {
1763 my ( $supplierid, $serialid, $order ) = @_;
1765 return unless ( $supplierid or $serialid );
1767 my $dbh = C4::Context->dbh;
1772 $byserial = "and serialid = " . $serialid;
1775 $order .= ", title";
1779 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1781 $sth = $dbh->prepare(
1783 serialid, aqbooksellerid, name,
1784 biblio.title, biblioitems.issn, planneddate, serialseq,
1785 serial.status, serial.subscriptionid, claimdate, claims_count,
1786 subscription.branchcode
1788 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1789 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1790 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1791 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1792 WHERE subscription.subscriptionid = serial.subscriptionid
1793 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1794 AND subscription.aqbooksellerid=$supplierid
1799 $sth = $dbh->prepare(
1801 serialid, aqbooksellerid, name,
1802 biblio.title, planneddate, serialseq,
1803 serial.status, serial.subscriptionid, claimdate, claims_count,
1804 subscription.branchcode
1806 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1807 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1808 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1809 WHERE subscription.subscriptionid = serial.subscriptionid
1810 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1815 $sth->execute( EXPECTED, LATE, CLAIMED );
1817 while ( my $line = $sth->fetchrow_hashref ) {
1819 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1820 $line->{planneddateISO} = $line->{planneddate};
1821 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1823 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1824 $line->{claimdateISO} = $line->{claimdate};
1825 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1827 $line->{"status".$line->{status}} = 1;
1829 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1830 record_id => $line->{subscriptionid},
1831 tablename => 'subscription'
1833 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1835 push @issuelist, $line;
1842 &updateClaim($serialid)
1844 this function updates the time when a claim is issued for late/missing items
1846 called from claims.pl file
1851 my ($serialids) = @_;
1852 return unless $serialids;
1853 unless ( ref $serialids ) {
1854 $serialids = [ $serialids ];
1856 my $dbh = C4::Context->dbh;
1859 SET claimdate = NOW(),
1860 claims_count = claims_count + 1,
1862 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1863 {}, CLAIMED, @$serialids );
1866 =head2 check_routing
1868 $result = &check_routing($subscriptionid)
1870 this function checks to see if a serial has a routing list and returns the count of routingid
1871 used to show either an 'add' or 'edit' link
1876 my ($subscriptionid) = @_;
1878 return unless ($subscriptionid);
1880 my $dbh = C4::Context->dbh;
1881 my $sth = $dbh->prepare(
1882 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1883 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1884 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1887 $sth->execute($subscriptionid);
1888 my $line = $sth->fetchrow_hashref;
1889 my $result = $line->{'routingids'};
1893 =head2 addroutingmember
1895 addroutingmember($borrowernumber,$subscriptionid)
1897 this function takes a borrowernumber and subscriptionid and adds the member to the
1898 routing list for that serial subscription and gives them a rank on the list
1899 of either 1 or highest current rank + 1
1903 sub addroutingmember {
1904 my ( $borrowernumber, $subscriptionid ) = @_;
1906 return unless ($borrowernumber and $subscriptionid);
1909 my $dbh = C4::Context->dbh;
1910 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1911 $sth->execute($subscriptionid);
1912 while ( my $line = $sth->fetchrow_hashref ) {
1913 if ( $line->{'rank'} > 0 ) {
1914 $rank = $line->{'rank'} + 1;
1919 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1920 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1923 =head2 reorder_members
1925 reorder_members($subscriptionid,$routingid,$rank)
1927 this function is used to reorder the routing list
1929 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1930 - it gets all members on list puts their routingid's into an array
1931 - removes the one in the array that is $routingid
1932 - then reinjects $routingid at point indicated by $rank
1933 - then update the database with the routingids in the new order
1937 sub reorder_members {
1938 my ( $subscriptionid, $routingid, $rank ) = @_;
1939 my $dbh = C4::Context->dbh;
1940 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1941 $sth->execute($subscriptionid);
1943 while ( my $line = $sth->fetchrow_hashref ) {
1944 push( @result, $line->{'routingid'} );
1947 # To find the matching index
1949 my $key = -1; # to allow for 0 being a valid response
1950 for ( $i = 0 ; $i < @result ; $i++ ) {
1951 if ( $routingid == $result[$i] ) {
1952 $key = $i; # save the index
1957 # if index exists in array then move it to new position
1958 if ( $key > -1 && $rank > 0 ) {
1959 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1960 my $moving_item = splice( @result, $key, 1 );
1961 splice( @result, $new_rank, 0, $moving_item );
1963 for ( my $j = 0 ; $j < @result ; $j++ ) {
1964 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1970 =head2 delroutingmember
1972 delroutingmember($routingid,$subscriptionid)
1974 this function either deletes one member from routing list if $routingid exists otherwise
1975 deletes all members from the routing list
1979 sub delroutingmember {
1981 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1982 my ( $routingid, $subscriptionid ) = @_;
1983 my $dbh = C4::Context->dbh;
1985 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1986 $sth->execute($routingid);
1987 reorder_members( $subscriptionid, $routingid );
1989 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1990 $sth->execute($subscriptionid);
1995 =head2 getroutinglist
1997 @routinglist = getroutinglist($subscriptionid)
1999 this gets the info from the subscriptionroutinglist for $subscriptionid
2002 the routinglist as an array. Each element of the array contains a hash_ref containing
2003 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2007 sub getroutinglist {
2008 my ($subscriptionid) = @_;
2009 my $dbh = C4::Context->dbh;
2010 my $sth = $dbh->prepare(
2011 'SELECT routingid, borrowernumber, ranking, biblionumber
2013 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2014 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2016 $sth->execute($subscriptionid);
2017 my $routinglist = $sth->fetchall_arrayref({});
2018 return @{$routinglist};
2021 =head2 countissuesfrom
2023 $result = countissuesfrom($subscriptionid,$startdate)
2025 Returns a count of serial rows matching the given subsctiptionid
2026 with published date greater than startdate
2030 sub countissuesfrom {
2031 my ( $subscriptionid, $startdate ) = @_;
2032 my $dbh = C4::Context->dbh;
2036 WHERE subscriptionid=?
2037 AND serial.publisheddate>?
2039 my $sth = $dbh->prepare($query);
2040 $sth->execute( $subscriptionid, $startdate );
2041 my ($countreceived) = $sth->fetchrow;
2042 return $countreceived;
2047 $result = CountIssues($subscriptionid)
2049 Returns a count of serial rows matching the given subsctiptionid
2054 my ($subscriptionid) = @_;
2055 my $dbh = C4::Context->dbh;
2059 WHERE subscriptionid=?
2061 my $sth = $dbh->prepare($query);
2062 $sth->execute($subscriptionid);
2063 my ($countreceived) = $sth->fetchrow;
2064 return $countreceived;
2069 $result = HasItems($subscriptionid)
2071 returns a count of items from serial matching the subscriptionid
2076 my ($subscriptionid) = @_;
2077 my $dbh = C4::Context->dbh;
2079 SELECT COUNT(serialitems.itemnumber)
2081 LEFT JOIN serialitems USING(serialid)
2082 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2084 my $sth=$dbh->prepare($query);
2085 $sth->execute($subscriptionid);
2086 my ($countitems)=$sth->fetchrow_array();
2090 =head2 abouttoexpire
2092 $result = abouttoexpire($subscriptionid)
2094 this function alerts you to the penultimate issue for a serial subscription
2096 returns 1 - if this is the penultimate issue
2102 my ($subscriptionid) = @_;
2103 my $dbh = C4::Context->dbh;
2104 my $subscription = GetSubscription($subscriptionid);
2105 my $per = $subscription->{'periodicity'};
2106 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2107 if ($frequency and $frequency->{unit}){
2109 my $expirationdate = GetExpirationDate($subscriptionid);
2111 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2112 my $nextdate = GetNextDate($subscription, $res, $frequency);
2114 # only compare dates if both dates exist.
2115 if ($nextdate and $expirationdate) {
2116 if(Date::Calc::Delta_Days(
2117 split( /-/, $nextdate ),
2118 split( /-/, $expirationdate )
2124 } elsif ($subscription->{numberlength}>0) {
2125 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2131 =head2 GetFictiveIssueNumber
2133 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2135 Get the position of the issue published at $publisheddate, considering the
2136 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2137 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2138 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2139 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2140 depending on how many rows are in serial table.
2141 The issue number calculation is based on subscription frequency, first acquisition
2142 date, and $publisheddate.
2144 Returns undef when called for irregular frequencies.
2146 The routine is used to skip irregularities when calculating the next issue
2147 date (in GetNextDate) or the next issue number (in GetNextSeq).
2151 sub GetFictiveIssueNumber {
2152 my ($subscription, $publisheddate, $frequency) = @_;
2154 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2158 my ( $year, $month, $day ) = split /-/, $publisheddate;
2159 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2160 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2162 if( $frequency->{'unitsperissue'} == 1 ) {
2163 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2164 } else { # issuesperunit == 1
2165 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2171 my ( $date1, $date2, $unit ) = @_;
2172 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2174 if( $unit eq 'day' ) {
2175 return Delta_Days( @$date1, @$date2 );
2176 } elsif( $unit eq 'week' ) {
2177 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2180 # In case of months or years, this is a wrapper around N_Delta_YMD.
2181 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2182 # while we expect 1 month.
2183 my @delta = N_Delta_YMD( @$date1, @$date2 );
2184 if( $delta[2] > 27 ) {
2185 # Check if we could add a month
2186 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2187 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2191 if( $delta[1] >= 12 ) {
2195 # if unit is year, we only return full years
2196 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2199 sub _get_next_date_day {
2200 my ($subscription, $freqdata, $year, $month, $day) = @_;
2202 my @newissue; # ( yy, mm, dd )
2203 # We do not need $delta_days here, since it would be zero where used
2205 if( $freqdata->{issuesperunit} == 1 ) {
2207 @newissue = Add_Delta_Days(
2208 $year, $month, $day, $freqdata->{"unitsperissue"} );
2209 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2211 @newissue = ( $year, $month, $day );
2212 $subscription->{countissuesperunit}++;
2214 # We finished a cycle of issues within a unit.
2215 # No subtraction of zero needed, just add one day
2216 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2217 $subscription->{countissuesperunit} = 1;
2222 sub _get_next_date_week {
2223 my ($subscription, $freqdata, $year, $month, $day) = @_;
2225 my @newissue; # ( yy, mm, dd )
2226 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2228 if( $freqdata->{issuesperunit} == 1 ) {
2229 # Add full weeks (of 7 days)
2230 @newissue = Add_Delta_Days(
2231 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2232 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2233 # Add rounded number of days based on frequency.
2234 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2235 $subscription->{countissuesperunit}++;
2237 # We finished a cycle of issues within a unit.
2238 # Subtract delta * (issues - 1), add 1 week
2239 @newissue = Add_Delta_Days( $year, $month, $day,
2240 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2241 @newissue = Add_Delta_Days( @newissue, 7 );
2242 $subscription->{countissuesperunit} = 1;
2247 sub _get_next_date_month {
2248 my ($subscription, $freqdata, $year, $month, $day) = @_;
2250 my @newissue; # ( yy, mm, dd )
2251 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2253 if( $freqdata->{issuesperunit} == 1 ) {
2255 @newissue = Add_Delta_YM(
2256 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2257 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2258 # Add rounded number of days based on frequency.
2259 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2260 $subscription->{countissuesperunit}++;
2262 # We finished a cycle of issues within a unit.
2263 # Subtract delta * (issues - 1), add 1 month
2264 @newissue = Add_Delta_Days( $year, $month, $day,
2265 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2266 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2267 $subscription->{countissuesperunit} = 1;
2272 sub _get_next_date_year {
2273 my ($subscription, $freqdata, $year, $month, $day) = @_;
2275 my @newissue; # ( yy, mm, dd )
2276 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2278 if( $freqdata->{issuesperunit} == 1 ) {
2280 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2281 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2282 # Add rounded number of days based on frequency.
2283 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2284 $subscription->{countissuesperunit}++;
2286 # We finished a cycle of issues within a unit.
2287 # Subtract delta * (issues - 1), add 1 year
2288 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2289 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2290 $subscription->{countissuesperunit} = 1;
2297 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2299 this function it takes the publisheddate and will return the next issue's date
2300 and will skip dates if there exists an irregularity.
2301 $publisheddate has to be an ISO date
2302 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2303 $frequency is a hashref containing frequency informations
2304 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2305 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2306 skipped then the returned date will be 2007-05-10
2309 $resultdate - then next date in the sequence (ISO date)
2311 Return undef if subscription is irregular
2316 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2318 return unless $subscription and $publisheddate;
2321 if ($freqdata->{'unit'}) {
2322 my ( $year, $month, $day ) = split /-/, $publisheddate;
2324 # Process an irregularity Hash
2325 # Suppose that irregularities are stored in a string with this structure
2326 # irreg1;irreg2;irreg3
2327 # where irregX is the number of issue which will not be received
2328 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2330 if ( $subscription->{irregularity} ) {
2331 my @irreg = split /;/, $subscription->{'irregularity'} ;
2332 foreach my $irregularity (@irreg) {
2333 $irregularities{$irregularity} = 1;
2337 # Get the 'fictive' next issue number
2338 # It is used to check if next issue is an irregular issue.
2339 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2341 # Then get the next date
2342 my $unit = lc $freqdata->{'unit'};
2343 if ($unit eq 'day') {
2344 while ($irregularities{$issueno}) {
2345 ($year, $month, $day) = _get_next_date_day($subscription,
2346 $freqdata, $year, $month, $day);
2349 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2350 $year, $month, $day);
2352 elsif ($unit eq 'week') {
2353 while ($irregularities{$issueno}) {
2354 ($year, $month, $day) = _get_next_date_week($subscription,
2355 $freqdata, $year, $month, $day);
2358 ($year, $month, $day) = _get_next_date_week($subscription,
2359 $freqdata, $year, $month, $day);
2361 elsif ($unit eq 'month') {
2362 while ($irregularities{$issueno}) {
2363 ($year, $month, $day) = _get_next_date_month($subscription,
2364 $freqdata, $year, $month, $day);
2367 ($year, $month, $day) = _get_next_date_month($subscription,
2368 $freqdata, $year, $month, $day);
2370 elsif ($unit eq 'year') {
2371 while ($irregularities{$issueno}) {
2372 ($year, $month, $day) = _get_next_date_year($subscription,
2373 $freqdata, $year, $month, $day);
2376 ($year, $month, $day) = _get_next_date_year($subscription,
2377 $freqdata, $year, $month, $day);
2381 my $dbh = C4::Context->dbh;
2384 SET countissuesperunit = ?
2385 WHERE subscriptionid = ?
2387 my $sth = $dbh->prepare($query);
2388 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2391 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2397 $string = &_numeration($value,$num_type,$locale);
2399 _numeration returns the string corresponding to $value in the num_type
2411 my ($value, $num_type, $locale) = @_;
2416 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2417 # 1970-11-01 was a Sunday
2418 $value = $value % 7;
2419 my $dt = DateTime->new(
2425 $string = $num_type =~ /^dayname$/
2426 ? $dt->strftime("%A")
2427 : $dt->strftime("%a");
2428 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2429 $value = $value % 12;
2430 my $dt = DateTime->new(
2432 month => $value + 1,
2435 $string = $num_type =~ /^monthname$/
2436 ? $dt->strftime("%B")
2437 : $dt->strftime("%b");
2438 } elsif ( $num_type =~ /^season$/ ) {
2439 my @seasons= qw( Spring Summer Fall Winter );
2440 $value = $value % 4;
2441 $string = $seasons[$value];
2442 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2443 my @seasonsabrv= qw( Spr Sum Fal Win );
2444 $value = $value % 4;
2445 $string = $seasonsabrv[$value];
2453 =head2 CloseSubscription
2455 Close a subscription given a subscriptionid
2459 sub CloseSubscription {
2460 my ( $subscriptionid ) = @_;
2461 return unless $subscriptionid;
2462 my $dbh = C4::Context->dbh;
2463 my $sth = $dbh->prepare( q{
2466 WHERE subscriptionid = ?
2468 $sth->execute( $subscriptionid );
2470 # Set status = missing when status = stopped
2471 $sth = $dbh->prepare( q{
2474 WHERE subscriptionid = ?
2477 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2480 =head2 ReopenSubscription
2482 Reopen a subscription given a subscriptionid
2486 sub ReopenSubscription {
2487 my ( $subscriptionid ) = @_;
2488 return unless $subscriptionid;
2489 my $dbh = C4::Context->dbh;
2490 my $sth = $dbh->prepare( q{
2493 WHERE subscriptionid = ?
2495 $sth->execute( $subscriptionid );
2497 # Set status = expected when status = stopped
2498 $sth = $dbh->prepare( q{
2501 WHERE subscriptionid = ?
2504 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2507 =head2 subscriptionCurrentlyOnOrder
2509 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2511 Return 1 if subscription is currently on order else 0.
2515 sub subscriptionCurrentlyOnOrder {
2516 my ( $subscriptionid ) = @_;
2517 my $dbh = C4::Context->dbh;
2519 SELECT COUNT(*) FROM aqorders
2520 WHERE subscriptionid = ?
2521 AND datereceived IS NULL
2522 AND datecancellationprinted IS NULL
2524 my $sth = $dbh->prepare( $query );
2525 $sth->execute($subscriptionid);
2526 return $sth->fetchrow_array;
2529 =head2 can_claim_subscription
2531 $can = can_claim_subscription( $subscriptionid[, $userid] );
2533 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2537 sub can_claim_subscription {
2538 my ( $subscription, $userid ) = @_;
2539 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2542 =head2 can_edit_subscription
2544 $can = can_edit_subscription( $subscriptionid[, $userid] );
2546 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2550 sub can_edit_subscription {
2551 my ( $subscription, $userid ) = @_;
2552 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2555 =head2 can_show_subscription
2557 $can = can_show_subscription( $subscriptionid[, $userid] );
2559 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2563 sub can_show_subscription {
2564 my ( $subscription, $userid ) = @_;
2565 return _can_do_on_subscription( $subscription, $userid, '*' );
2568 sub _can_do_on_subscription {
2569 my ( $subscription, $userid, $permission ) = @_;
2570 return 0 unless C4::Context->userenv;
2571 my $flags = C4::Context->userenv->{flags};
2572 $userid ||= C4::Context->userenv->{'id'};
2574 if ( C4::Context->preference('IndependentBranches') ) {
2576 if C4::Context->IsSuperLibrarian()
2578 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2580 C4::Auth::haspermission( $userid,
2581 { serials => $permission } )
2582 and ( not defined $subscription->{branchcode}
2583 or $subscription->{branchcode} eq ''
2584 or $subscription->{branchcode} eq
2585 C4::Context->userenv->{'branch'} )
2590 if C4::Context->IsSuperLibrarian()
2592 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2593 or C4::Auth::haspermission(
2594 $userid, { serials => $permission }
2601 =head2 findSerialsByStatus
2603 @serials = findSerialsByStatus($status, $subscriptionid);
2605 Returns an array of serials matching a given status and subscription id.
2609 sub findSerialsByStatus {
2610 my ( $status, $subscriptionid ) = @_;
2611 my $dbh = C4::Context->dbh;
2612 my $query = q| SELECT * from serial
2614 AND subscriptionid = ?
2616 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2625 Koha Development Team <http://koha-community.org/>