3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalFieldValues;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
38 use Koha::SharedContent;
40 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
48 MISSING_NEVER_RECIEVED => 41,
49 MISSING_SOLD_OUT => 42,
50 MISSING_DAMAGED => 43,
58 use constant MISSING_STATUSES => (
59 MISSING, MISSING_NEVER_RECIEVED,
60 MISSING_SOLD_OUT, MISSING_DAMAGED,
68 &NewSubscription &ModSubscription &DelSubscription
69 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
71 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
72 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
73 &GetSubscriptionHistoryFromSubscriptionId
75 &GetNextSeq &GetSeq &NewIssue &GetSerials
76 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
77 &ReNewSubscription &GetLateOrMissingIssues
78 &GetSerialInformation &AddItem2Serial
79 &PrepareSerialsData &GetNextExpected &ModNextExpected
82 &GetSuppliersWithLateIssues
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &subscriptionCurrentlyOnOrder
95 C4::Serials - Serials Module Functions
103 Functions for handling subscriptions, claims routing etc.
108 =head2 GetSuppliersWithLateIssues
110 $supplierlist = GetSuppliersWithLateIssues()
112 this function get all suppliers with late issues.
115 an array_ref of suppliers each entry is a hash_ref containing id and name
116 the array is in name order
120 sub GetSuppliersWithLateIssues {
121 my $dbh = C4::Context->dbh;
122 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
124 SELECT DISTINCT id, name
126 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
127 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 (planneddate < now() AND serial.status=1)
131 OR serial.STATUS IN ( $statuses )
133 AND subscription.closed = 0
135 return $dbh->selectall_arrayref($query, { Slice => {} });
138 =head2 GetSubscriptionHistoryFromSubscriptionId
140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
142 This function returns the subscription history as a hashref
146 sub GetSubscriptionHistoryFromSubscriptionId {
147 my ($subscriptionid) = @_;
149 return unless $subscriptionid;
151 my $dbh = C4::Context->dbh;
154 FROM subscriptionhistory
155 WHERE subscriptionid = ?
157 my $sth = $dbh->prepare($query);
158 $sth->execute($subscriptionid);
159 my $results = $sth->fetchrow_hashref;
165 =head2 GetSerialInformation
167 $data = GetSerialInformation($serialid);
168 returns a hash_ref containing :
169 items : items marcrecord (can be an array)
171 subscription table field
172 + information about subscription expiration
176 sub GetSerialInformation {
178 my $dbh = C4::Context->dbh;
180 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
181 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
184 my $rq = $dbh->prepare($query);
185 $rq->execute($serialid);
186 my $data = $rq->fetchrow_hashref;
188 # create item information if we have serialsadditems for this subscription
189 if ( $data->{'serialsadditems'} ) {
190 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
191 $queryitem->execute($serialid);
192 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
194 if ( scalar(@$itemnumbers) > 0 ) {
195 foreach my $itemnum (@$itemnumbers) {
197 #It is ASSUMED that GetMarcItem ALWAYS WORK...
198 #Maybe GetMarcItem should return values on failure
199 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
200 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
201 $itemprocessed->{'itemnumber'} = $itemnum->[0];
202 $itemprocessed->{'itemid'} = $itemnum->[0];
203 $itemprocessed->{'serialid'} = $serialid;
204 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
205 push @{ $data->{'items'} }, $itemprocessed;
208 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
209 $itemprocessed->{'itemid'} = "N$serialid";
210 $itemprocessed->{'serialid'} = $serialid;
211 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
212 $itemprocessed->{'countitems'} = 0;
213 push @{ $data->{'items'} }, $itemprocessed;
216 $data->{ "status" . $data->{'serstatus'} } = 1;
217 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
218 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
219 $data->{cannotedit} = not can_edit_subscription( $data );
223 =head2 AddItem2Serial
225 $rows = AddItem2Serial($serialid,$itemnumber);
226 Adds an itemnumber to Serial record
227 returns the number of rows affected
232 my ( $serialid, $itemnumber ) = @_;
234 return unless ($serialid and $itemnumber);
236 my $dbh = C4::Context->dbh;
237 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
238 $rq->execute( $serialid, $itemnumber );
242 =head2 GetSubscription
244 $subs = GetSubscription($subscriptionid)
245 this function returns the subscription which has $subscriptionid as id.
247 a hashref. This hash contains
248 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
252 sub GetSubscription {
253 my ($subscriptionid) = @_;
254 my $dbh = C4::Context->dbh;
256 SELECT subscription.*,
257 subscriptionhistory.*,
258 aqbooksellers.name AS aqbooksellername,
259 biblio.title AS bibliotitle,
260 subscription.biblionumber as bibnum
262 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
263 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
264 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
265 WHERE subscription.subscriptionid = ?
268 $debug and warn "query : $query\nsubsid :$subscriptionid";
269 my $sth = $dbh->prepare($query);
270 $sth->execute($subscriptionid);
271 my $subscription = $sth->fetchrow_hashref;
273 return unless $subscription;
275 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
277 if ( my $mana_id = $subscription->{mana_id} ) {
278 my $mana_subscription = Koha::SharedContent::get_entity_by_id(
279 'subscription', $mana_id, {usecomments => 1});
280 $subscription->{comments} = $mana_subscription->{data}->{comments};
283 return $subscription;
286 =head2 GetFullSubscription
288 $array_ref = GetFullSubscription($subscriptionid)
289 this function reads the serial table.
293 sub GetFullSubscription {
294 my ($subscriptionid) = @_;
296 return unless ($subscriptionid);
298 my $dbh = C4::Context->dbh;
300 SELECT serial.serialid,
303 serial.publisheddate,
304 serial.publisheddatetext,
306 serial.notes as notes,
307 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
308 aqbooksellers.name as aqbooksellername,
309 biblio.title as bibliotitle,
310 subscription.branchcode AS branchcode,
311 subscription.subscriptionid AS subscriptionid
313 LEFT JOIN subscription ON
314 (serial.subscriptionid=subscription.subscriptionid )
315 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
316 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
317 WHERE serial.subscriptionid = ?
319 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
320 serial.subscriptionid
322 $debug and warn "GetFullSubscription query: $query";
323 my $sth = $dbh->prepare($query);
324 $sth->execute($subscriptionid);
325 my $subscriptions = $sth->fetchall_arrayref( {} );
326 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
327 for my $subscription ( @$subscriptions ) {
328 $subscription->{cannotedit} = $cannotedit;
330 return $subscriptions;
333 =head2 PrepareSerialsData
335 $array_ref = PrepareSerialsData($serialinfomation)
336 where serialinformation is a hashref array
340 sub PrepareSerialsData {
343 return unless ($lines);
349 my $aqbooksellername;
353 my $previousnote = "";
355 foreach my $subs (@{$lines}) {
356 for my $datefield ( qw(publisheddate planneddate) ) {
357 # handle 0000-00-00 dates
358 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
359 $subs->{$datefield} = undef;
362 $subs->{ "status" . $subs->{'status'} } = 1;
363 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
364 $subs->{"checked"} = 1;
367 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
368 $year = $subs->{'year'};
372 if ( $tmpresults{$year} ) {
373 push @{ $tmpresults{$year}->{'serials'} }, $subs;
375 $tmpresults{$year} = {
377 'aqbooksellername' => $subs->{'aqbooksellername'},
378 'bibliotitle' => $subs->{'bibliotitle'},
379 'serials' => [$subs],
384 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
385 push @res, $tmpresults{$key};
390 =head2 GetSubscriptionsFromBiblionumber
392 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
393 this function get the subscription list. it reads the subscription table.
395 reference to an array of subscriptions which have the biblionumber given on input arg.
396 each element of this array is a hashref containing
397 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
401 sub GetSubscriptionsFromBiblionumber {
402 my ($biblionumber) = @_;
404 return unless ($biblionumber);
406 my $dbh = C4::Context->dbh;
408 SELECT subscription.*,
410 subscriptionhistory.*,
411 aqbooksellers.name AS aqbooksellername,
412 biblio.title AS bibliotitle
414 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
415 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
416 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
417 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
418 WHERE subscription.biblionumber = ?
420 my $sth = $dbh->prepare($query);
421 $sth->execute($biblionumber);
423 while ( my $subs = $sth->fetchrow_hashref ) {
424 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
425 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
426 if ( defined $subs->{histenddate} ) {
427 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
429 $subs->{histenddate} = "";
431 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
432 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
433 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
434 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
435 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
436 $subs->{ "status" . $subs->{'status'} } = 1;
438 if (not defined $subs->{enddate} ) {
439 $subs->{enddate} = '';
441 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
443 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
444 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
445 $subs->{cannotedit} = not can_edit_subscription( $subs );
451 =head2 GetFullSubscriptionsFromBiblionumber
453 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
454 this function reads the serial table.
458 sub GetFullSubscriptionsFromBiblionumber {
459 my ($biblionumber) = @_;
460 my $dbh = C4::Context->dbh;
462 SELECT serial.serialid,
465 serial.publisheddate,
466 serial.publisheddatetext,
468 serial.notes as notes,
469 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
470 biblio.title as bibliotitle,
471 subscription.branchcode AS branchcode,
472 subscription.subscriptionid AS subscriptionid
474 LEFT JOIN subscription ON
475 (serial.subscriptionid=subscription.subscriptionid)
476 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
477 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
478 WHERE subscription.biblionumber = ?
480 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
481 serial.subscriptionid
483 my $sth = $dbh->prepare($query);
484 $sth->execute($biblionumber);
485 my $subscriptions = $sth->fetchall_arrayref( {} );
486 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
487 for my $subscription ( @$subscriptions ) {
488 $subscription->{cannotedit} = $cannotedit;
490 return $subscriptions;
493 =head2 SearchSubscriptions
495 @results = SearchSubscriptions($args);
497 This function returns a list of hashrefs, one for each subscription
498 that meets the conditions specified by the $args hashref.
500 The valid search fields are:
514 The expiration_date search field is special; it specifies the maximum
515 subscription expiration date.
519 sub SearchSubscriptions {
522 my $additional_fields = $args->{additional_fields} // [];
523 my $matching_record_ids_for_additional_fields = [];
524 if ( @$additional_fields ) {
525 my @subscriptions = Koha::Subscriptions->filter_by_additional_fields($additional_fields);
527 return () unless @subscriptions;
529 $matching_record_ids_for_additional_fields = [ map {
536 subscription.notes AS publicnotes,
537 subscriptionhistory.*,
539 biblio.notes AS biblionotes,
543 aqbooksellers.name AS vendorname,
546 LEFT JOIN subscriptionhistory USING(subscriptionid)
547 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
548 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
549 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
551 $query .= q| WHERE 1|;
554 if( $args->{biblionumber} ) {
555 push @where_strs, "biblio.biblionumber = ?";
556 push @where_args, $args->{biblionumber};
559 if( $args->{title} ){
560 my @words = split / /, $args->{title};
562 foreach my $word (@words) {
563 push @strs, "biblio.title LIKE ?";
564 push @args, "%$word%";
567 push @where_strs, '(' . join (' AND ', @strs) . ')';
568 push @where_args, @args;
572 push @where_strs, "biblioitems.issn LIKE ?";
573 push @where_args, "%$args->{issn}%";
576 push @where_strs, "biblioitems.ean LIKE ?";
577 push @where_args, "%$args->{ean}%";
579 if ( $args->{callnumber} ) {
580 push @where_strs, "subscription.callnumber LIKE ?";
581 push @where_args, "%$args->{callnumber}%";
583 if( $args->{publisher} ){
584 push @where_strs, "biblioitems.publishercode LIKE ?";
585 push @where_args, "%$args->{publisher}%";
587 if( $args->{bookseller} ){
588 push @where_strs, "aqbooksellers.name LIKE ?";
589 push @where_args, "%$args->{bookseller}%";
591 if( $args->{branch} ){
592 push @where_strs, "subscription.branchcode = ?";
593 push @where_args, "$args->{branch}";
595 if ( $args->{location} ) {
596 push @where_strs, "subscription.location = ?";
597 push @where_args, "$args->{location}";
599 if ( $args->{expiration_date} ) {
600 push @where_strs, "subscription.enddate <= ?";
601 push @where_args, "$args->{expiration_date}";
603 if( defined $args->{closed} ){
604 push @where_strs, "subscription.closed = ?";
605 push @where_args, "$args->{closed}";
609 $query .= ' AND ' . join(' AND ', @where_strs);
611 if ( @$additional_fields ) {
612 $query .= ' AND subscriptionid IN ('
613 . join( ', ', @$matching_record_ids_for_additional_fields )
617 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
619 my $dbh = C4::Context->dbh;
620 my $sth = $dbh->prepare($query);
621 $sth->execute(@where_args);
622 my $results = $sth->fetchall_arrayref( {} );
624 for my $subscription ( @$results ) {
625 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
626 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
628 my $subscription_object = Koha::Subscriptions->find($subscription->{subscriptionid});
629 $subscription->{additional_fields} = { map { $_->field->name => $_->value }
630 $subscription_object->additional_field_values->as_list };
640 ($totalissues,@serials) = GetSerials($subscriptionid);
641 this function gets every serial not arrived for a given subscription
642 as well as the number of issues registered in the database (all types)
643 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
645 FIXME: We should return \@serials.
650 my ( $subscriptionid, $count ) = @_;
652 return unless $subscriptionid;
654 my $dbh = C4::Context->dbh;
656 # status = 2 is "arrived"
658 $count = 5 unless ($count);
660 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
661 my $query = "SELECT serialid,serialseq, status, publisheddate,
662 publisheddatetext, planneddate,notes, routingnotes
664 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
665 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
666 my $sth = $dbh->prepare($query);
667 $sth->execute($subscriptionid);
669 while ( my $line = $sth->fetchrow_hashref ) {
670 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
671 for my $datefield ( qw( planneddate publisheddate) ) {
672 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
673 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
675 $line->{$datefield} = q{};
678 push @serials, $line;
681 # OK, now add the last 5 issues arrives/missing
682 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
683 publisheddatetext, notes, routingnotes
685 WHERE subscriptionid = ?
686 AND status IN ( $statuses )
687 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
689 $sth = $dbh->prepare($query);
690 $sth->execute($subscriptionid);
691 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
693 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
694 for my $datefield ( qw( planneddate publisheddate) ) {
695 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
696 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
698 $line->{$datefield} = q{};
702 push @serials, $line;
705 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
706 $sth = $dbh->prepare($query);
707 $sth->execute($subscriptionid);
708 my ($totalissues) = $sth->fetchrow;
709 return ( $totalissues, @serials );
714 @serials = GetSerials2($subscriptionid,$statuses);
715 this function returns every serial waited for a given subscription
716 as well as the number of issues registered in the database (all types)
717 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
719 $statuses is an arrayref of statuses and is mandatory.
724 my ( $subscription, $statuses ) = @_;
726 return unless ($subscription and @$statuses);
728 my $dbh = C4::Context->dbh;
730 SELECT serialid,serialseq, status, planneddate, publisheddate,
731 publisheddatetext, notes, routingnotes
733 WHERE subscriptionid=?
735 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
737 ORDER BY publisheddate,serialid DESC
739 $debug and warn "GetSerials2 query: $query";
740 my $sth = $dbh->prepare($query);
741 $sth->execute( $subscription, @$statuses );
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
746 # Format dates for display
747 for my $datefield ( qw( planneddate publisheddate ) ) {
748 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
749 $line->{$datefield} = q{};
752 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
755 push @serials, $line;
760 =head2 GetLatestSerials
762 \@serials = GetLatestSerials($subscriptionid,$limit)
763 get the $limit's latest serials arrived or missing for a given subscription
765 a ref to an array which contains all of the latest serials stored into a hash.
769 sub GetLatestSerials {
770 my ( $subscriptionid, $limit ) = @_;
772 return unless ($subscriptionid and $limit);
774 my $dbh = C4::Context->dbh;
776 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
777 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
779 WHERE subscriptionid = ?
780 AND status IN ($statuses)
781 ORDER BY publisheddate DESC LIMIT 0,$limit
783 my $sth = $dbh->prepare($strsth);
784 $sth->execute($subscriptionid);
786 while ( my $line = $sth->fetchrow_hashref ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 $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, $mana_id
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=?, mana_id=?
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, $mana_id,
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 $_ ||= undef # Set to undef for integer values, not empty string
1378 $aqbooksellerid, $lastvalue1, $innerloop1, $lastvalue2,
1379 $innerloop2, $lastvalue3, $innerloop3,
1381 #save subscription (insert into database)
1383 INSERT INTO subscription
1384 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1385 biblionumber, startdate, periodicity, numberlength, weeklength,
1386 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1387 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1388 irregularity, numberpattern, locale, callnumber,
1389 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1390 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1391 itemtype, previousitemtype, mana_id)
1392 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?, ?)
1394 my $sth = $dbh->prepare($query);
1396 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1397 $startdate, $periodicity, $numberlength, $weeklength,
1398 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1399 $lastvalue3, $innerloop3, $status, $notes, $letter,
1400 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1401 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1402 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1403 $itemtype, $previousitemtype, $mana_id
1406 my $subscriptionid = $dbh->{'mysql_insertid'};
1408 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1412 WHERE subscriptionid=?
1414 $sth = $dbh->prepare($query);
1415 $sth->execute( $enddate, $subscriptionid );
1418 # then create the 1st expected number
1420 INSERT INTO subscriptionhistory
1421 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1422 VALUES (?,?,?, '', '')
1424 $sth = $dbh->prepare($query);
1425 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1427 # reread subscription to get a hash (for calculation of the 1st issue number)
1428 my $subscription = GetSubscription($subscriptionid);
1429 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1431 # calculate issue number
1432 my $serialseq = GetSeq($subscription, $pattern) || q{};
1436 serialseq => $serialseq,
1437 serialseq_x => $subscription->{'lastvalue1'},
1438 serialseq_y => $subscription->{'lastvalue2'},
1439 serialseq_z => $subscription->{'lastvalue3'},
1440 subscriptionid => $subscriptionid,
1441 biblionumber => $biblionumber,
1443 planneddate => $firstacquidate,
1444 publisheddate => $firstacquidate,
1448 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1450 #set serial flag on biblio if not already set.
1451 my $biblio = Koha::Biblios->find( $biblionumber );
1452 if ( $biblio and !$biblio->serial ) {
1453 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1454 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1456 eval { $record->field($tag)->update( $subf => 1 ); };
1458 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1460 return $subscriptionid;
1463 =head2 ReNewSubscription
1465 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1467 this function renew a subscription with values given on input args.
1471 sub ReNewSubscription {
1472 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1473 my $dbh = C4::Context->dbh;
1474 my $subscription = GetSubscription($subscriptionid);
1478 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1479 WHERE biblio.biblionumber=?
1481 my $sth = $dbh->prepare($query);
1482 $sth->execute( $subscription->{biblionumber} );
1483 my $biblio = $sth->fetchrow_hashref;
1485 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1486 require C4::Suggestions;
1487 C4::Suggestions::NewSuggestion(
1488 { 'suggestedby' => $user,
1489 'title' => $subscription->{bibliotitle},
1490 'author' => $biblio->{author},
1491 'publishercode' => $biblio->{publishercode},
1492 'note' => $biblio->{note},
1493 'biblionumber' => $subscription->{biblionumber}
1498 $numberlength ||= 0; # Should not we raise an exception instead?
1501 # renew subscription
1504 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1505 WHERE subscriptionid=?
1507 $sth = $dbh->prepare($query);
1508 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1509 my $enddate = GetExpirationDate($subscriptionid);
1510 $debug && warn "enddate :$enddate";
1514 WHERE subscriptionid=?
1516 $sth = $dbh->prepare($query);
1517 $sth->execute( $enddate, $subscriptionid );
1519 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1525 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1527 Create a new issue stored on the database.
1528 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1529 returns the serial id
1534 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1535 $publisheddate, $publisheddatetext, $notes ) = @_;
1536 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1538 return unless ($subscriptionid);
1540 my $schema = Koha::Database->new()->schema();
1542 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1544 my $serial = Koha::Serial->new(
1546 serialseq => $serialseq,
1547 serialseq_x => $subscription->lastvalue1(),
1548 serialseq_y => $subscription->lastvalue2(),
1549 serialseq_z => $subscription->lastvalue3(),
1550 subscriptionid => $subscriptionid,
1551 biblionumber => $biblionumber,
1553 planneddate => $planneddate,
1554 publisheddate => $publisheddate,
1555 publisheddatetext => $publisheddatetext,
1560 my $serialid = $serial->id();
1562 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1563 my $missinglist = $subscription_history->missinglist();
1564 my $recievedlist = $subscription_history->recievedlist();
1566 if ( $status == ARRIVED ) {
1567 ### TODO Add a feature that improves recognition and description.
1568 ### As such count (serialseq) i.e. : N18,2(N19),N20
1569 ### Would use substr and index But be careful to previous presence of ()
1570 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1572 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1573 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1576 $recievedlist =~ s/^; //;
1577 $missinglist =~ s/^; //;
1579 $subscription_history->recievedlist($recievedlist);
1580 $subscription_history->missinglist($missinglist);
1581 $subscription_history->store();
1586 =head2 HasSubscriptionStrictlyExpired
1588 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1590 the subscription has stricly expired when today > the end subscription date
1593 1 if true, 0 if false, -1 if the expiration date is not set.
1597 sub HasSubscriptionStrictlyExpired {
1599 # Getting end of subscription date
1600 my ($subscriptionid) = @_;
1602 return unless ($subscriptionid);
1604 my $dbh = C4::Context->dbh;
1605 my $subscription = GetSubscription($subscriptionid);
1606 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1608 # If the expiration date is set
1609 if ( $expirationdate != 0 ) {
1610 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1612 # Getting today's date
1613 my ( $nowyear, $nowmonth, $nowday ) = Today();
1615 # if today's date > expiration date, then the subscription has stricly expired
1616 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1623 # There are some cases where the expiration date is not set
1624 # As we can't determine if the subscription has expired on a date-basis,
1630 =head2 HasSubscriptionExpired
1632 $has_expired = HasSubscriptionExpired($subscriptionid)
1634 the subscription has expired when the next issue to arrive is out of subscription limit.
1637 0 if the subscription has not expired
1638 1 if the subscription has expired
1639 2 if has subscription does not have a valid expiration date set
1643 sub HasSubscriptionExpired {
1644 my ($subscriptionid) = @_;
1646 return unless ($subscriptionid);
1648 my $dbh = C4::Context->dbh;
1649 my $subscription = GetSubscription($subscriptionid);
1650 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1651 if ( $frequency and $frequency->{unit} ) {
1652 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1653 if (!defined $expirationdate) {
1654 $expirationdate = q{};
1657 SELECT max(planneddate)
1659 WHERE subscriptionid=?
1661 my $sth = $dbh->prepare($query);
1662 $sth->execute($subscriptionid);
1663 my ($res) = $sth->fetchrow;
1664 if (!$res || $res=~m/^0000/) {
1667 my @res = split( /-/, $res );
1668 my @endofsubscriptiondate = split( /-/, $expirationdate );
1669 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1671 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1676 if ( $subscription->{'numberlength'} ) {
1677 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1678 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1684 return 0; # Notice that you'll never get here.
1687 =head2 DelSubscription
1689 DelSubscription($subscriptionid)
1690 this function deletes subscription which has $subscriptionid as id.
1694 sub DelSubscription {
1695 my ($subscriptionid) = @_;
1696 my $dbh = C4::Context->dbh;
1697 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1698 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1699 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1701 Koha::AdditionalFieldValues->search({
1702 'field.tablename' => 'subscription',
1703 'me.record_id' => $subscriptionid,
1704 }, { join => 'field' })->delete;
1706 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1711 DelIssue($serialseq,$subscriptionid)
1712 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1714 returns the number of rows affected
1719 my ($dataissue) = @_;
1720 my $dbh = C4::Context->dbh;
1721 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1726 AND subscriptionid= ?
1728 my $mainsth = $dbh->prepare($query);
1729 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1731 #Delete element from subscription history
1732 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1733 my $sth = $dbh->prepare($query);
1734 $sth->execute( $dataissue->{'subscriptionid'} );
1735 my $val = $sth->fetchrow_hashref;
1736 unless ( $val->{manualhistory} ) {
1738 SELECT * FROM subscriptionhistory
1739 WHERE subscriptionid= ?
1741 my $sth = $dbh->prepare($query);
1742 $sth->execute( $dataissue->{'subscriptionid'} );
1743 my $data = $sth->fetchrow_hashref;
1744 my $serialseq = $dataissue->{'serialseq'};
1745 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1746 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1747 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1748 $sth = $dbh->prepare($strsth);
1749 $sth->execute( $dataissue->{'subscriptionid'} );
1752 return $mainsth->rows;
1755 =head2 GetLateOrMissingIssues
1757 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1759 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1762 the issuelist as an array of hash refs. Each element of this array contains
1763 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1767 sub GetLateOrMissingIssues {
1768 my ( $supplierid, $serialid, $order ) = @_;
1770 return unless ( $supplierid or $serialid );
1772 my $dbh = C4::Context->dbh;
1777 $byserial = "and serialid = " . $serialid;
1780 $order .= ", title";
1784 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1786 $sth = $dbh->prepare(
1788 serialid, aqbooksellerid, name,
1789 biblio.title, biblioitems.issn, planneddate, serialseq,
1790 serial.status, serial.subscriptionid, claimdate, claims_count,
1791 subscription.branchcode
1793 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1794 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1795 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1796 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1797 WHERE subscription.subscriptionid = serial.subscriptionid
1798 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1799 AND subscription.aqbooksellerid=$supplierid
1804 $sth = $dbh->prepare(
1806 serialid, aqbooksellerid, name,
1807 biblio.title, planneddate, serialseq,
1808 serial.status, serial.subscriptionid, claimdate, claims_count,
1809 subscription.branchcode
1811 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1812 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1813 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1814 WHERE subscription.subscriptionid = serial.subscriptionid
1815 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1820 $sth->execute( EXPECTED, LATE, CLAIMED );
1822 while ( my $line = $sth->fetchrow_hashref ) {
1824 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1825 $line->{planneddateISO} = $line->{planneddate};
1826 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1828 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1829 $line->{claimdateISO} = $line->{claimdate};
1830 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1832 $line->{"status".$line->{status}} = 1;
1834 my $subscription_object = Koha::Subscriptions->find($line->{subscriptionid});
1835 $line->{additional_fields} = { map { $_->field->name => $_->value }
1836 $subscription_object->additional_field_values->as_list };
1838 push @issuelist, $line;
1845 &updateClaim($serialid)
1847 this function updates the time when a claim is issued for late/missing items
1849 called from claims.pl file
1854 my ($serialids) = @_;
1855 return unless $serialids;
1856 unless ( ref $serialids ) {
1857 $serialids = [ $serialids ];
1859 my $dbh = C4::Context->dbh;
1862 SET claimdate = NOW(),
1863 claims_count = claims_count + 1,
1865 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1866 {}, CLAIMED, @$serialids );
1869 =head2 check_routing
1871 $result = &check_routing($subscriptionid)
1873 this function checks to see if a serial has a routing list and returns the count of routingid
1874 used to show either an 'add' or 'edit' link
1879 my ($subscriptionid) = @_;
1881 return unless ($subscriptionid);
1883 my $dbh = C4::Context->dbh;
1884 my $sth = $dbh->prepare(
1885 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1886 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1887 WHERE subscription.subscriptionid = ? GROUP BY routingid ORDER BY ranking ASC
1890 $sth->execute($subscriptionid);
1891 my $line = $sth->fetchrow_hashref;
1892 my $result = $line->{'routingids'};
1896 =head2 addroutingmember
1898 addroutingmember($borrowernumber,$subscriptionid)
1900 this function takes a borrowernumber and subscriptionid and adds the member to the
1901 routing list for that serial subscription and gives them a rank on the list
1902 of either 1 or highest current rank + 1
1906 sub addroutingmember {
1907 my ( $borrowernumber, $subscriptionid ) = @_;
1909 return unless ($borrowernumber and $subscriptionid);
1912 my $dbh = C4::Context->dbh;
1913 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1914 $sth->execute($subscriptionid);
1915 while ( my $line = $sth->fetchrow_hashref ) {
1916 if ( $line->{'rank'} > 0 ) {
1917 $rank = $line->{'rank'} + 1;
1922 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1923 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1926 =head2 reorder_members
1928 reorder_members($subscriptionid,$routingid,$rank)
1930 this function is used to reorder the routing list
1932 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1933 - it gets all members on list puts their routingid's into an array
1934 - removes the one in the array that is $routingid
1935 - then reinjects $routingid at point indicated by $rank
1936 - then update the database with the routingids in the new order
1940 sub reorder_members {
1941 my ( $subscriptionid, $routingid, $rank ) = @_;
1942 my $dbh = C4::Context->dbh;
1943 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1944 $sth->execute($subscriptionid);
1946 while ( my $line = $sth->fetchrow_hashref ) {
1947 push( @result, $line->{'routingid'} );
1950 # To find the matching index
1952 my $key = -1; # to allow for 0 being a valid response
1953 for ( $i = 0 ; $i < @result ; $i++ ) {
1954 if ( $routingid == $result[$i] ) {
1955 $key = $i; # save the index
1960 # if index exists in array then move it to new position
1961 if ( $key > -1 && $rank > 0 ) {
1962 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1963 my $moving_item = splice( @result, $key, 1 );
1964 splice( @result, $new_rank, 0, $moving_item );
1966 for ( my $j = 0 ; $j < @result ; $j++ ) {
1967 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1973 =head2 delroutingmember
1975 delroutingmember($routingid,$subscriptionid)
1977 this function either deletes one member from routing list if $routingid exists otherwise
1978 deletes all members from the routing list
1982 sub delroutingmember {
1984 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
1985 my ( $routingid, $subscriptionid ) = @_;
1986 my $dbh = C4::Context->dbh;
1988 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
1989 $sth->execute($routingid);
1990 reorder_members( $subscriptionid, $routingid );
1992 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
1993 $sth->execute($subscriptionid);
1998 =head2 getroutinglist
2000 @routinglist = getroutinglist($subscriptionid)
2002 this gets the info from the subscriptionroutinglist for $subscriptionid
2005 the routinglist as an array. Each element of the array contains a hash_ref containing
2006 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2010 sub getroutinglist {
2011 my ($subscriptionid) = @_;
2012 my $dbh = C4::Context->dbh;
2013 my $sth = $dbh->prepare(
2014 'SELECT routingid, borrowernumber, ranking, biblionumber
2016 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2017 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2019 $sth->execute($subscriptionid);
2020 my $routinglist = $sth->fetchall_arrayref({});
2021 return @{$routinglist};
2024 =head2 countissuesfrom
2026 $result = countissuesfrom($subscriptionid,$startdate)
2028 Returns a count of serial rows matching the given subsctiptionid
2029 with published date greater than startdate
2033 sub countissuesfrom {
2034 my ( $subscriptionid, $startdate ) = @_;
2035 my $dbh = C4::Context->dbh;
2039 WHERE subscriptionid=?
2040 AND serial.publisheddate>?
2042 my $sth = $dbh->prepare($query);
2043 $sth->execute( $subscriptionid, $startdate );
2044 my ($countreceived) = $sth->fetchrow;
2045 return $countreceived;
2050 $result = CountIssues($subscriptionid)
2052 Returns a count of serial rows matching the given subsctiptionid
2057 my ($subscriptionid) = @_;
2058 my $dbh = C4::Context->dbh;
2062 WHERE subscriptionid=?
2064 my $sth = $dbh->prepare($query);
2065 $sth->execute($subscriptionid);
2066 my ($countreceived) = $sth->fetchrow;
2067 return $countreceived;
2072 $result = HasItems($subscriptionid)
2074 returns a count of items from serial matching the subscriptionid
2079 my ($subscriptionid) = @_;
2080 my $dbh = C4::Context->dbh;
2082 SELECT COUNT(serialitems.itemnumber)
2084 LEFT JOIN serialitems USING(serialid)
2085 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2087 my $sth=$dbh->prepare($query);
2088 $sth->execute($subscriptionid);
2089 my ($countitems)=$sth->fetchrow_array();
2093 =head2 abouttoexpire
2095 $result = abouttoexpire($subscriptionid)
2097 this function alerts you to the penultimate issue for a serial subscription
2099 returns 1 - if this is the penultimate issue
2105 my ($subscriptionid) = @_;
2106 my $dbh = C4::Context->dbh;
2107 my $subscription = GetSubscription($subscriptionid);
2108 my $per = $subscription->{'periodicity'};
2109 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2110 if ($frequency and $frequency->{unit}){
2112 my $expirationdate = GetExpirationDate($subscriptionid);
2114 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2115 my $nextdate = GetNextDate($subscription, $res, $frequency);
2117 # only compare dates if both dates exist.
2118 if ($nextdate and $expirationdate) {
2119 if(Date::Calc::Delta_Days(
2120 split( /-/, $nextdate ),
2121 split( /-/, $expirationdate )
2127 } elsif ($subscription->{numberlength}>0) {
2128 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2134 =head2 GetFictiveIssueNumber
2136 $issueno = GetFictiveIssueNumber($subscription, $publishedate, $frequency);
2138 Get the position of the issue published at $publisheddate, considering the
2139 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2140 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2141 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2142 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2143 depending on how many rows are in serial table.
2144 The issue number calculation is based on subscription frequency, first acquisition
2145 date, and $publisheddate.
2147 Returns undef when called for irregular frequencies.
2149 The routine is used to skip irregularities when calculating the next issue
2150 date (in GetNextDate) or the next issue number (in GetNextSeq).
2154 sub GetFictiveIssueNumber {
2155 my ($subscription, $publisheddate, $frequency) = @_;
2157 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2161 my ( $year, $month, $day ) = split /-/, $publisheddate;
2162 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2163 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2165 if( $frequency->{'unitsperissue'} == 1 ) {
2166 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2167 } else { # issuesperunit == 1
2168 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2174 my ( $date1, $date2, $unit ) = @_;
2175 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2177 if( $unit eq 'day' ) {
2178 return Delta_Days( @$date1, @$date2 );
2179 } elsif( $unit eq 'week' ) {
2180 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2183 # In case of months or years, this is a wrapper around N_Delta_YMD.
2184 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2185 # while we expect 1 month.
2186 my @delta = N_Delta_YMD( @$date1, @$date2 );
2187 if( $delta[2] > 27 ) {
2188 # Check if we could add a month
2189 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2190 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2194 if( $delta[1] >= 12 ) {
2198 # if unit is year, we only return full years
2199 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2202 sub _get_next_date_day {
2203 my ($subscription, $freqdata, $year, $month, $day) = @_;
2205 my @newissue; # ( yy, mm, dd )
2206 # We do not need $delta_days here, since it would be zero where used
2208 if( $freqdata->{issuesperunit} == 1 ) {
2210 @newissue = Add_Delta_Days(
2211 $year, $month, $day, $freqdata->{"unitsperissue"} );
2212 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2214 @newissue = ( $year, $month, $day );
2215 $subscription->{countissuesperunit}++;
2217 # We finished a cycle of issues within a unit.
2218 # No subtraction of zero needed, just add one day
2219 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2220 $subscription->{countissuesperunit} = 1;
2225 sub _get_next_date_week {
2226 my ($subscription, $freqdata, $year, $month, $day) = @_;
2228 my @newissue; # ( yy, mm, dd )
2229 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2231 if( $freqdata->{issuesperunit} == 1 ) {
2232 # Add full weeks (of 7 days)
2233 @newissue = Add_Delta_Days(
2234 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2235 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2236 # Add rounded number of days based on frequency.
2237 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2238 $subscription->{countissuesperunit}++;
2240 # We finished a cycle of issues within a unit.
2241 # Subtract delta * (issues - 1), add 1 week
2242 @newissue = Add_Delta_Days( $year, $month, $day,
2243 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2244 @newissue = Add_Delta_Days( @newissue, 7 );
2245 $subscription->{countissuesperunit} = 1;
2250 sub _get_next_date_month {
2251 my ($subscription, $freqdata, $year, $month, $day) = @_;
2253 my @newissue; # ( yy, mm, dd )
2254 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2256 if( $freqdata->{issuesperunit} == 1 ) {
2258 @newissue = Add_Delta_YM(
2259 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2260 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2261 # Add rounded number of days based on frequency.
2262 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2263 $subscription->{countissuesperunit}++;
2265 # We finished a cycle of issues within a unit.
2266 # Subtract delta * (issues - 1), add 1 month
2267 @newissue = Add_Delta_Days( $year, $month, $day,
2268 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2269 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2270 $subscription->{countissuesperunit} = 1;
2275 sub _get_next_date_year {
2276 my ($subscription, $freqdata, $year, $month, $day) = @_;
2278 my @newissue; # ( yy, mm, dd )
2279 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2281 if( $freqdata->{issuesperunit} == 1 ) {
2283 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2284 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2285 # Add rounded number of days based on frequency.
2286 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2287 $subscription->{countissuesperunit}++;
2289 # We finished a cycle of issues within a unit.
2290 # Subtract delta * (issues - 1), add 1 year
2291 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2292 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2293 $subscription->{countissuesperunit} = 1;
2300 $resultdate = GetNextDate($publisheddate,$subscription,$freqdata,$updatecount)
2302 this function it takes the publisheddate and will return the next issue's date
2303 and will skip dates if there exists an irregularity.
2304 $publisheddate has to be an ISO date
2305 $subscription is a hashref containing at least 'firstacquidate', 'irregularity', and 'countissuesperunit'
2306 $frequency is a hashref containing frequency informations
2307 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2308 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2309 skipped then the returned date will be 2007-05-10
2312 $resultdate - then next date in the sequence (ISO date)
2314 Return undef if subscription is irregular
2319 my ( $subscription, $publisheddate, $freqdata, $updatecount ) = @_;
2321 return unless $subscription and $publisheddate;
2324 if ($freqdata->{'unit'}) {
2325 my ( $year, $month, $day ) = split /-/, $publisheddate;
2327 # Process an irregularity Hash
2328 # Suppose that irregularities are stored in a string with this structure
2329 # irreg1;irreg2;irreg3
2330 # where irregX is the number of issue which will not be received
2331 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2333 if ( $subscription->{irregularity} ) {
2334 my @irreg = split /;/, $subscription->{'irregularity'} ;
2335 foreach my $irregularity (@irreg) {
2336 $irregularities{$irregularity} = 1;
2340 # Get the 'fictive' next issue number
2341 # It is used to check if next issue is an irregular issue.
2342 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate, $freqdata) + 1;
2344 # Then get the next date
2345 my $unit = lc $freqdata->{'unit'};
2346 if ($unit eq 'day') {
2347 while ($irregularities{$issueno}) {
2348 ($year, $month, $day) = _get_next_date_day($subscription,
2349 $freqdata, $year, $month, $day);
2352 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2353 $year, $month, $day);
2355 elsif ($unit eq 'week') {
2356 while ($irregularities{$issueno}) {
2357 ($year, $month, $day) = _get_next_date_week($subscription,
2358 $freqdata, $year, $month, $day);
2361 ($year, $month, $day) = _get_next_date_week($subscription,
2362 $freqdata, $year, $month, $day);
2364 elsif ($unit eq 'month') {
2365 while ($irregularities{$issueno}) {
2366 ($year, $month, $day) = _get_next_date_month($subscription,
2367 $freqdata, $year, $month, $day);
2370 ($year, $month, $day) = _get_next_date_month($subscription,
2371 $freqdata, $year, $month, $day);
2373 elsif ($unit eq 'year') {
2374 while ($irregularities{$issueno}) {
2375 ($year, $month, $day) = _get_next_date_year($subscription,
2376 $freqdata, $year, $month, $day);
2379 ($year, $month, $day) = _get_next_date_year($subscription,
2380 $freqdata, $year, $month, $day);
2384 my $dbh = C4::Context->dbh;
2387 SET countissuesperunit = ?
2388 WHERE subscriptionid = ?
2390 my $sth = $dbh->prepare($query);
2391 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2394 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2400 $string = &_numeration($value,$num_type,$locale);
2402 _numeration returns the string corresponding to $value in the num_type
2414 my ($value, $num_type, $locale) = @_;
2419 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2420 # 1970-11-01 was a Sunday
2421 $value = $value % 7;
2422 my $dt = DateTime->new(
2428 $string = $num_type =~ /^dayname$/
2429 ? $dt->strftime("%A")
2430 : $dt->strftime("%a");
2431 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2432 $value = $value % 12;
2433 my $dt = DateTime->new(
2435 month => $value + 1,
2438 $string = $num_type =~ /^monthname$/
2439 ? $dt->strftime("%B")
2440 : $dt->strftime("%b");
2441 } elsif ( $num_type =~ /^season$/ ) {
2442 my @seasons= qw( Spring Summer Fall Winter );
2443 $value = $value % 4;
2444 $string = $seasons[$value];
2445 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2446 my @seasonsabrv= qw( Spr Sum Fal Win );
2447 $value = $value % 4;
2448 $string = $seasonsabrv[$value];
2456 =head2 CloseSubscription
2458 Close a subscription given a subscriptionid
2462 sub CloseSubscription {
2463 my ( $subscriptionid ) = @_;
2464 return unless $subscriptionid;
2465 my $dbh = C4::Context->dbh;
2466 my $sth = $dbh->prepare( q{
2469 WHERE subscriptionid = ?
2471 $sth->execute( $subscriptionid );
2473 # Set status = missing when status = stopped
2474 $sth = $dbh->prepare( q{
2477 WHERE subscriptionid = ?
2480 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2483 =head2 ReopenSubscription
2485 Reopen a subscription given a subscriptionid
2489 sub ReopenSubscription {
2490 my ( $subscriptionid ) = @_;
2491 return unless $subscriptionid;
2492 my $dbh = C4::Context->dbh;
2493 my $sth = $dbh->prepare( q{
2496 WHERE subscriptionid = ?
2498 $sth->execute( $subscriptionid );
2500 # Set status = expected when status = stopped
2501 $sth = $dbh->prepare( q{
2504 WHERE subscriptionid = ?
2507 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2510 =head2 subscriptionCurrentlyOnOrder
2512 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2514 Return 1 if subscription is currently on order else 0.
2518 sub subscriptionCurrentlyOnOrder {
2519 my ( $subscriptionid ) = @_;
2520 my $dbh = C4::Context->dbh;
2522 SELECT COUNT(*) FROM aqorders
2523 WHERE subscriptionid = ?
2524 AND datereceived IS NULL
2525 AND datecancellationprinted IS NULL
2527 my $sth = $dbh->prepare( $query );
2528 $sth->execute($subscriptionid);
2529 return $sth->fetchrow_array;
2532 =head2 can_claim_subscription
2534 $can = can_claim_subscription( $subscriptionid[, $userid] );
2536 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2540 sub can_claim_subscription {
2541 my ( $subscription, $userid ) = @_;
2542 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2545 =head2 can_edit_subscription
2547 $can = can_edit_subscription( $subscriptionid[, $userid] );
2549 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2553 sub can_edit_subscription {
2554 my ( $subscription, $userid ) = @_;
2555 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2558 =head2 can_show_subscription
2560 $can = can_show_subscription( $subscriptionid[, $userid] );
2562 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2566 sub can_show_subscription {
2567 my ( $subscription, $userid ) = @_;
2568 return _can_do_on_subscription( $subscription, $userid, '*' );
2571 sub _can_do_on_subscription {
2572 my ( $subscription, $userid, $permission ) = @_;
2573 return 0 unless C4::Context->userenv;
2574 my $flags = C4::Context->userenv->{flags};
2575 $userid ||= C4::Context->userenv->{'id'};
2577 if ( C4::Context->preference('IndependentBranches') ) {
2579 if C4::Context->IsSuperLibrarian()
2581 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2583 C4::Auth::haspermission( $userid,
2584 { serials => $permission } )
2585 and ( not defined $subscription->{branchcode}
2586 or $subscription->{branchcode} eq ''
2587 or $subscription->{branchcode} eq
2588 C4::Context->userenv->{'branch'} )
2593 if C4::Context->IsSuperLibrarian()
2595 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2596 or C4::Auth::haspermission(
2597 $userid, { serials => $permission }
2604 =head2 findSerialsByStatus
2606 @serials = findSerialsByStatus($status, $subscriptionid);
2608 Returns an array of serials matching a given status and subscription id.
2612 sub findSerialsByStatus {
2613 my ( $status, $subscriptionid ) = @_;
2614 my $dbh = C4::Context->dbh;
2615 my $query = q| SELECT * from serial
2617 AND subscriptionid = ?
2619 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2628 Koha Development Team <http://koha-community.org/>