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
80 &UpdateClaimdateIssues
81 &GetSuppliersWithLateIssues &getsupplierbyserialid
82 &GetDistributedTo &SetDistributedTo
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &GetSubscriptionsFromBorrower
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues {
122 my $dbh = C4::Context->dbh;
123 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
125 SELECT DISTINCT id, name
127 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
131 (planneddate < now() AND serial.status=1)
132 OR serial.STATUS IN ( $statuses )
134 AND subscription.closed = 0
136 return $dbh->selectall_arrayref($query, { Slice => {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId {
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4::Context->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid = ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialStatusFromSerialId
168 $sth = GetSerialStatusFromSerialId();
169 this function returns a statement handle
170 After this function, don't forget to execute it by using $sth->execute($serialid)
172 $sth = $dbh->prepare($query).
176 sub GetSerialStatusFromSerialId {
177 my $dbh = C4::Context->dbh;
183 return $dbh->prepare($query);
186 =head2 GetSerialInformation
189 $data = GetSerialInformation($serialid);
190 returns a hash_ref containing :
191 items : items marcrecord (can be an array)
193 subscription table field
194 + information about subscription expiration
198 sub GetSerialInformation {
200 my $dbh = C4::Context->dbh;
202 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
203 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
206 my $rq = $dbh->prepare($query);
207 $rq->execute($serialid);
208 my $data = $rq->fetchrow_hashref;
210 # create item information if we have serialsadditems for this subscription
211 if ( $data->{'serialsadditems'} ) {
212 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
213 $queryitem->execute($serialid);
214 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
216 if ( scalar(@$itemnumbers) > 0 ) {
217 foreach my $itemnum (@$itemnumbers) {
219 #It is ASSUMED that GetMarcItem ALWAYS WORK...
220 #Maybe GetMarcItem should return values on failure
221 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
222 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
223 $itemprocessed->{'itemnumber'} = $itemnum->[0];
224 $itemprocessed->{'itemid'} = $itemnum->[0];
225 $itemprocessed->{'serialid'} = $serialid;
226 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
227 push @{ $data->{'items'} }, $itemprocessed;
230 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
231 $itemprocessed->{'itemid'} = "N$serialid";
232 $itemprocessed->{'serialid'} = $serialid;
233 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
234 $itemprocessed->{'countitems'} = 0;
235 push @{ $data->{'items'} }, $itemprocessed;
238 $data->{ "status" . $data->{'serstatus'} } = 1;
239 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
240 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
241 $data->{cannotedit} = not can_edit_subscription( $data );
245 =head2 AddItem2Serial
247 $rows = AddItem2Serial($serialid,$itemnumber);
248 Adds an itemnumber to Serial record
249 returns the number of rows affected
254 my ( $serialid, $itemnumber ) = @_;
256 return unless ($serialid and $itemnumber);
258 my $dbh = C4::Context->dbh;
259 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
260 $rq->execute( $serialid, $itemnumber );
264 =head2 UpdateClaimdateIssues
266 UpdateClaimdateIssues($serialids,[$date]);
268 Update Claimdate for issues in @$serialids list with date $date
273 sub UpdateClaimdateIssues {
274 my ( $serialids, $date ) = @_;
276 return unless ($serialids);
278 my $dbh = C4::Context->dbh;
279 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
284 claims_count = claims_count + 1
285 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
287 my $rq = $dbh->prepare($query);
288 $rq->execute($date, CLAIMED, @$serialids);
292 =head2 GetSubscription
294 $subs = GetSubscription($subscriptionid)
295 this function returns the subscription which has $subscriptionid as id.
297 a hashref. This hash containts
298 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
302 sub GetSubscription {
303 my ($subscriptionid) = @_;
304 my $dbh = C4::Context->dbh;
306 SELECT subscription.*,
307 subscriptionhistory.*,
308 aqbooksellers.name AS aqbooksellername,
309 biblio.title AS bibliotitle,
310 subscription.biblionumber as bibnum
312 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
313 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
314 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
315 WHERE subscription.subscriptionid = ?
318 $debug and warn "query : $query\nsubsid :$subscriptionid";
319 my $sth = $dbh->prepare($query);
320 $sth->execute($subscriptionid);
321 my $subscription = $sth->fetchrow_hashref;
323 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
325 # Add additional fields to the subscription into a new key "additional_fields"
326 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
327 tablename => 'subscription',
328 record_id => $subscriptionid,
330 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
332 return $subscription;
335 =head2 GetFullSubscription
337 $array_ref = GetFullSubscription($subscriptionid)
338 this function reads the serial table.
342 sub GetFullSubscription {
343 my ($subscriptionid) = @_;
345 return unless ($subscriptionid);
347 my $dbh = C4::Context->dbh;
349 SELECT serial.serialid,
352 serial.publisheddate,
353 serial.publisheddatetext,
355 serial.notes as notes,
356 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
357 aqbooksellers.name as aqbooksellername,
358 biblio.title as bibliotitle,
359 subscription.branchcode AS branchcode,
360 subscription.subscriptionid AS subscriptionid
362 LEFT JOIN subscription ON
363 (serial.subscriptionid=subscription.subscriptionid )
364 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
365 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
366 WHERE serial.subscriptionid = ?
368 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
369 serial.subscriptionid
371 $debug and warn "GetFullSubscription query: $query";
372 my $sth = $dbh->prepare($query);
373 $sth->execute($subscriptionid);
374 my $subscriptions = $sth->fetchall_arrayref( {} );
375 for my $subscription ( @$subscriptions ) {
376 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
378 return $subscriptions;
381 =head2 PrepareSerialsData
383 $array_ref = PrepareSerialsData($serialinfomation)
384 where serialinformation is a hashref array
388 sub PrepareSerialsData {
391 return unless ($lines);
397 my $aqbooksellername;
401 my $previousnote = "";
403 foreach my $subs (@{$lines}) {
404 for my $datefield ( qw(publisheddate planneddate) ) {
405 # handle 0000-00-00 dates
406 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
407 $subs->{$datefield} = undef;
410 $subs->{ "status" . $subs->{'status'} } = 1;
411 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
412 $subs->{"checked"} = 1;
415 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
416 $year = $subs->{'year'};
420 if ( $tmpresults{$year} ) {
421 push @{ $tmpresults{$year}->{'serials'} }, $subs;
423 $tmpresults{$year} = {
425 'aqbooksellername' => $subs->{'aqbooksellername'},
426 'bibliotitle' => $subs->{'bibliotitle'},
427 'serials' => [$subs],
432 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
433 push @res, $tmpresults{$key};
438 =head2 GetSubscriptionsFromBiblionumber
440 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
441 this function get the subscription list. it reads the subscription table.
443 reference to an array of subscriptions which have the biblionumber given on input arg.
444 each element of this array is a hashref containing
445 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
449 sub GetSubscriptionsFromBiblionumber {
450 my ($biblionumber) = @_;
452 return unless ($biblionumber);
454 my $dbh = C4::Context->dbh;
456 SELECT subscription.*,
458 subscriptionhistory.*,
459 aqbooksellers.name AS aqbooksellername,
460 biblio.title AS bibliotitle
462 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
463 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
464 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
465 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
466 WHERE subscription.biblionumber = ?
468 my $sth = $dbh->prepare($query);
469 $sth->execute($biblionumber);
471 while ( my $subs = $sth->fetchrow_hashref ) {
472 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
473 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
474 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
475 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
476 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
477 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
478 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
479 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
480 $subs->{ "status" . $subs->{'status'} } = 1;
482 if ( $subs->{enddate} eq '0000-00-00' ) {
483 $subs->{enddate} = '';
485 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
487 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
488 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
489 $subs->{cannotedit} = not can_edit_subscription( $subs );
495 =head2 GetFullSubscriptionsFromBiblionumber
497 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
498 this function reads the serial table.
502 sub GetFullSubscriptionsFromBiblionumber {
503 my ($biblionumber) = @_;
504 my $dbh = C4::Context->dbh;
506 SELECT serial.serialid,
509 serial.publisheddate,
510 serial.publisheddatetext,
512 serial.notes as notes,
513 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
514 biblio.title as bibliotitle,
515 subscription.branchcode AS branchcode,
516 subscription.subscriptionid AS subscriptionid
518 LEFT JOIN subscription ON
519 (serial.subscriptionid=subscription.subscriptionid)
520 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
521 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
522 WHERE subscription.biblionumber = ?
524 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
525 serial.subscriptionid
527 my $sth = $dbh->prepare($query);
528 $sth->execute($biblionumber);
529 my $subscriptions = $sth->fetchall_arrayref( {} );
530 for my $subscription ( @$subscriptions ) {
531 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
533 return $subscriptions;
536 =head2 SearchSubscriptions
538 @results = SearchSubscriptions($args);
540 This function returns a list of hashrefs, one for each subscription
541 that meets the conditions specified by the $args hashref.
543 The valid search fields are:
557 The expiration_date search field is special; it specifies the maximum
558 subscription expiration date.
562 sub SearchSubscriptions {
565 my $additional_fields = $args->{additional_fields} // [];
566 my $matching_record_ids_for_additional_fields = [];
567 if ( @$additional_fields ) {
568 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
569 fields => $additional_fields,
570 tablename => 'subscription',
573 return () unless @$matching_record_ids_for_additional_fields;
578 subscription.notes AS publicnotes,
579 subscriptionhistory.*,
581 biblio.notes AS biblionotes,
587 LEFT JOIN subscriptionhistory USING(subscriptionid)
588 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
589 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
590 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
592 $query .= q| WHERE 1|;
595 if( $args->{biblionumber} ) {
596 push @where_strs, "biblio.biblionumber = ?";
597 push @where_args, $args->{biblionumber};
600 if( $args->{title} ){
601 my @words = split / /, $args->{title};
603 foreach my $word (@words) {
604 push @strs, "biblio.title LIKE ?";
605 push @args, "%$word%";
608 push @where_strs, '(' . join (' AND ', @strs) . ')';
609 push @where_args, @args;
613 push @where_strs, "biblioitems.issn LIKE ?";
614 push @where_args, "%$args->{issn}%";
617 push @where_strs, "biblioitems.ean LIKE ?";
618 push @where_args, "%$args->{ean}%";
620 if ( $args->{callnumber} ) {
621 push @where_strs, "subscription.callnumber LIKE ?";
622 push @where_args, "%$args->{callnumber}%";
624 if( $args->{publisher} ){
625 push @where_strs, "biblioitems.publishercode LIKE ?";
626 push @where_args, "%$args->{publisher}%";
628 if( $args->{bookseller} ){
629 push @where_strs, "aqbooksellers.name LIKE ?";
630 push @where_args, "%$args->{bookseller}%";
632 if( $args->{branch} ){
633 push @where_strs, "subscription.branchcode = ?";
634 push @where_args, "$args->{branch}";
636 if ( $args->{location} ) {
637 push @where_strs, "subscription.location = ?";
638 push @where_args, "$args->{location}";
640 if ( $args->{expiration_date} ) {
641 push @where_strs, "subscription.enddate <= ?";
642 push @where_args, "$args->{expiration_date}";
644 if( defined $args->{closed} ){
645 push @where_strs, "subscription.closed = ?";
646 push @where_args, "$args->{closed}";
650 $query .= ' AND ' . join(' AND ', @where_strs);
652 if ( @$additional_fields ) {
653 $query .= ' AND subscriptionid IN ('
654 . join( ', ', @$matching_record_ids_for_additional_fields )
658 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
660 my $dbh = C4::Context->dbh;
661 my $sth = $dbh->prepare($query);
662 $sth->execute(@where_args);
663 my $results = $sth->fetchall_arrayref( {} );
665 for my $subscription ( @$results ) {
666 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
667 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
669 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
670 record_id => $subscription->{subscriptionid},
671 tablename => 'subscription'
673 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
682 ($totalissues,@serials) = GetSerials($subscriptionid);
683 this function gets every serial not arrived for a given subscription
684 as well as the number of issues registered in the database (all types)
685 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
687 FIXME: We should return \@serials.
692 my ( $subscriptionid, $count ) = @_;
694 return unless $subscriptionid;
696 my $dbh = C4::Context->dbh;
698 # status = 2 is "arrived"
700 $count = 5 unless ($count);
702 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
703 my $query = "SELECT serialid,serialseq, status, publisheddate,
704 publisheddatetext, planneddate,notes, routingnotes
706 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
707 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
708 my $sth = $dbh->prepare($query);
709 $sth->execute($subscriptionid);
711 while ( my $line = $sth->fetchrow_hashref ) {
712 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
713 for my $datefield ( qw( planneddate publisheddate) ) {
714 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
715 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
717 $line->{$datefield} = q{};
720 push @serials, $line;
723 # OK, now add the last 5 issues arrives/missing
724 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
725 publisheddatetext, notes, routingnotes
727 WHERE subscriptionid = ?
728 AND status IN ( $statuses )
729 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
731 $sth = $dbh->prepare($query);
732 $sth->execute($subscriptionid);
733 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
735 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
736 for my $datefield ( qw( planneddate publisheddate) ) {
737 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
738 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
740 $line->{$datefield} = q{};
744 push @serials, $line;
747 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
748 $sth = $dbh->prepare($query);
749 $sth->execute($subscriptionid);
750 my ($totalissues) = $sth->fetchrow;
751 return ( $totalissues, @serials );
756 @serials = GetSerials2($subscriptionid,$statuses);
757 this function returns every serial waited for a given subscription
758 as well as the number of issues registered in the database (all types)
759 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
761 $statuses is an arrayref of statuses and is mandatory.
766 my ( $subscription, $statuses ) = @_;
768 return unless ($subscription and @$statuses);
770 my $statuses_string = join ',', @$statuses;
772 my $dbh = C4::Context->dbh;
774 SELECT serialid,serialseq, status, planneddate, publisheddate,
775 publisheddatetext, notes, routingnotes
777 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
778 ORDER BY publisheddate,serialid DESC
780 $debug and warn "GetSerials2 query: $query";
781 my $sth = $dbh->prepare($query);
785 while ( my $line = $sth->fetchrow_hashref ) {
786 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
787 # Format dates for display
788 for my $datefield ( qw( planneddate publisheddate ) ) {
789 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
790 $line->{$datefield} = q{};
793 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
796 push @serials, $line;
801 =head2 GetLatestSerials
803 \@serials = GetLatestSerials($subscriptionid,$limit)
804 get the $limit's latest serials arrived or missing for a given subscription
806 a ref to an array which contains all of the latest serials stored into a hash.
810 sub GetLatestSerials {
811 my ( $subscriptionid, $limit ) = @_;
813 return unless ($subscriptionid and $limit);
815 my $dbh = C4::Context->dbh;
817 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
818 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
820 WHERE subscriptionid = ?
821 AND status IN ($statuses)
822 ORDER BY publisheddate DESC LIMIT 0,$limit
824 my $sth = $dbh->prepare($strsth);
825 $sth->execute($subscriptionid);
827 while ( my $line = $sth->fetchrow_hashref ) {
828 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
829 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
830 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
831 push @serials, $line;
837 =head2 GetDistributedTo
839 $distributedto=GetDistributedTo($subscriptionid)
840 This function returns the field distributedto for the subscription matching subscriptionid
844 sub GetDistributedTo {
845 my $dbh = C4::Context->dbh;
847 my ($subscriptionid) = @_;
849 return unless ($subscriptionid);
851 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
852 my $sth = $dbh->prepare($query);
853 $sth->execute($subscriptionid);
854 return ($distributedto) = $sth->fetchrow;
860 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
861 $newinnerloop1, $newinnerloop2, $newinnerloop3
862 ) = GetNextSeq( $subscription, $pattern, $planneddate );
864 $subscription is a hashref containing all the attributes of the table
866 $pattern is a hashref containing all the attributes of the table
867 'subscription_numberpatterns'.
868 $planneddate is a date string in iso format.
869 This function get the next issue for the subscription given on input arg
874 my ($subscription, $pattern, $planneddate) = @_;
876 return unless ($subscription and $pattern);
878 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
879 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
882 if ($subscription->{'skip_serialseq'}) {
883 my @irreg = split /;/, $subscription->{'irregularity'};
885 my $irregularities = {};
886 $irregularities->{$_} = 1 foreach(@irreg);
887 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
888 while($irregularities->{$issueno}) {
895 my $numberingmethod = $pattern->{numberingmethod};
897 if ($numberingmethod) {
898 $calculated = $numberingmethod;
899 my $locale = $subscription->{locale};
900 $newlastvalue1 = $subscription->{lastvalue1} || 0;
901 $newlastvalue2 = $subscription->{lastvalue2} || 0;
902 $newlastvalue3 = $subscription->{lastvalue3} || 0;
903 $newinnerloop1 = $subscription->{innerloop1} || 0;
904 $newinnerloop2 = $subscription->{innerloop2} || 0;
905 $newinnerloop3 = $subscription->{innerloop3} || 0;
908 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
911 for(my $i = 0; $i < $count; $i++) {
913 # check if we have to increase the new value.
915 if ($newinnerloop1 >= $pattern->{every1}) {
917 $newlastvalue1 += $pattern->{add1};
919 # reset counter if needed.
920 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
923 # check if we have to increase the new value.
925 if ($newinnerloop2 >= $pattern->{every2}) {
927 $newlastvalue2 += $pattern->{add2};
929 # reset counter if needed.
930 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
933 # check if we have to increase the new value.
935 if ($newinnerloop3 >= $pattern->{every3}) {
937 $newlastvalue3 += $pattern->{add3};
939 # reset counter if needed.
940 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
944 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
945 $calculated =~ s/\{X\}/$newlastvalue1string/g;
948 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
949 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
952 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
953 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
958 $newlastvalue1, $newlastvalue2, $newlastvalue3,
959 $newinnerloop1, $newinnerloop2, $newinnerloop3);
964 $calculated = GetSeq($subscription, $pattern)
965 $subscription is a hashref containing all the attributes of the table 'subscription'
966 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
967 this function transforms {X},{Y},{Z} to 150,0,0 for example.
969 the sequence in string format
974 my ($subscription, $pattern) = @_;
976 return unless ($subscription and $pattern);
978 my $locale = $subscription->{locale};
980 my $calculated = $pattern->{numberingmethod};
982 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
983 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
984 $calculated =~ s/\{X\}/$newlastvalue1/g;
986 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
987 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
988 $calculated =~ s/\{Y\}/$newlastvalue2/g;
990 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
991 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
992 $calculated =~ s/\{Z\}/$newlastvalue3/g;
996 =head2 GetExpirationDate
998 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1000 this function return the next expiration date for a subscription given on input args.
1003 the enddate or undef
1007 sub GetExpirationDate {
1008 my ( $subscriptionid, $startdate ) = @_;
1010 return unless ($subscriptionid);
1012 my $dbh = C4::Context->dbh;
1013 my $subscription = GetSubscription($subscriptionid);
1016 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1017 $enddate = $startdate || $subscription->{startdate};
1018 my @date = split( /-/, $enddate );
1020 return if ( scalar(@date) != 3 || not check_date(@date) );
1022 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1023 if ( $frequency and $frequency->{unit} ) {
1026 if ( my $length = $subscription->{numberlength} ) {
1028 #calculate the date of the last issue.
1029 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1030 $enddate = GetNextDate( $subscription, $enddate );
1032 } elsif ( $subscription->{monthlength} ) {
1033 if ( $$subscription{startdate} ) {
1034 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1035 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1037 } elsif ( $subscription->{weeklength} ) {
1038 if ( $$subscription{startdate} ) {
1039 my @date = split( /-/, $subscription->{startdate} );
1040 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1041 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1044 $enddate = $subscription->{enddate};
1048 return $subscription->{enddate};
1052 =head2 CountSubscriptionFromBiblionumber
1054 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1055 this returns a count of the subscriptions for a given biblionumber
1057 the number of subscriptions
1061 sub CountSubscriptionFromBiblionumber {
1062 my ($biblionumber) = @_;
1064 return unless ($biblionumber);
1066 my $dbh = C4::Context->dbh;
1067 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1068 my $sth = $dbh->prepare($query);
1069 $sth->execute($biblionumber);
1070 my $subscriptionsnumber = $sth->fetchrow;
1071 return $subscriptionsnumber;
1074 =head2 ModSubscriptionHistory
1076 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1078 this function modifies the history of a subscription. Put your new values on input arg.
1079 returns the number of rows affected
1083 sub ModSubscriptionHistory {
1084 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1086 return unless ($subscriptionid);
1088 my $dbh = C4::Context->dbh;
1089 my $query = "UPDATE subscriptionhistory
1090 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1091 WHERE subscriptionid=?
1093 my $sth = $dbh->prepare($query);
1094 $receivedlist =~ s/^; // if $receivedlist;
1095 $missinglist =~ s/^; // if $missinglist;
1096 $opacnote =~ s/^; // if $opacnote;
1097 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1101 =head2 ModSerialStatus
1103 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1104 $publisheddatetext, $status, $notes);
1106 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1107 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1111 sub ModSerialStatus {
1112 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1113 $status, $notes) = @_;
1115 return unless ($serialid);
1117 #It is a usual serial
1118 # 1st, get previous status :
1119 my $dbh = C4::Context->dbh;
1120 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1121 FROM serial, subscription
1122 WHERE serial.subscriptionid=subscription.subscriptionid
1124 my $sth = $dbh->prepare($query);
1125 $sth->execute($serialid);
1126 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1127 my $frequency = GetSubscriptionFrequency($periodicity);
1129 # change status & update subscriptionhistory
1131 if ( $status == DELETED ) {
1132 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1137 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1138 planneddate = ?, status = ?, notes = ?
1141 $sth = $dbh->prepare($query);
1142 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1143 $planneddate, $status, $notes, $serialid );
1144 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1145 $sth = $dbh->prepare($query);
1146 $sth->execute($subscriptionid);
1147 my $val = $sth->fetchrow_hashref;
1148 unless ( $val->{manualhistory} ) {
1149 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1150 $sth = $dbh->prepare($query);
1151 $sth->execute($subscriptionid);
1152 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1154 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1155 $recievedlist .= "; $serialseq"
1156 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1159 # in case serial has been previously marked as missing
1160 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1161 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1164 $missinglist .= "; $serialseq"
1165 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1166 $missinglist .= "; not issued $serialseq"
1167 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1169 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1170 $sth = $dbh->prepare($query);
1171 $recievedlist =~ s/^; //;
1172 $missinglist =~ s/^; //;
1173 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1177 # create new waited entry if needed (ie : was a "waited" and has changed)
1178 if ( $oldstatus == EXPECTED && $status != EXPECTED ) {
1179 my $subscription = GetSubscription($subscriptionid);
1180 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1184 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1185 $newinnerloop1, $newinnerloop2, $newinnerloop3
1187 = GetNextSeq( $subscription, $pattern, $publisheddate );
1189 # next date (calculated from actual date & frequency parameters)
1190 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1191 my $nextpubdate = $nextpublisheddate;
1192 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1193 WHERE subscriptionid = ?";
1194 $sth = $dbh->prepare($query);
1195 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1197 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1199 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1200 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1201 require C4::Letters;
1202 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1209 =head2 GetNextExpected
1211 $nextexpected = GetNextExpected($subscriptionid)
1213 Get the planneddate for the current expected issue of the subscription.
1219 planneddate => ISO date
1224 sub GetNextExpected {
1225 my ($subscriptionid) = @_;
1227 my $dbh = C4::Context->dbh;
1231 WHERE subscriptionid = ?
1235 my $sth = $dbh->prepare($query);
1237 # Each subscription has only one 'expected' issue.
1238 $sth->execute( $subscriptionid, EXPECTED );
1239 my $nextissue = $sth->fetchrow_hashref;
1240 if ( !$nextissue ) {
1244 WHERE subscriptionid = ?
1245 ORDER BY publisheddate DESC
1248 $sth = $dbh->prepare($query);
1249 $sth->execute($subscriptionid);
1250 $nextissue = $sth->fetchrow_hashref;
1252 foreach(qw/planneddate publisheddate/) {
1253 if ( !defined $nextissue->{$_} ) {
1254 # or should this default to 1st Jan ???
1255 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1257 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1265 =head2 ModNextExpected
1267 ModNextExpected($subscriptionid,$date)
1269 Update the planneddate for the current expected issue of the subscription.
1270 This will modify all future prediction results.
1272 C<$date> is an ISO date.
1278 sub ModNextExpected {
1279 my ( $subscriptionid, $date ) = @_;
1280 my $dbh = C4::Context->dbh;
1282 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1283 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1285 # Each subscription has only one 'expected' issue.
1286 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1291 =head2 GetSubscriptionIrregularities
1295 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1296 get the list of irregularities for a subscription
1302 sub GetSubscriptionIrregularities {
1303 my $subscriptionid = shift;
1305 return unless $subscriptionid;
1307 my $dbh = C4::Context->dbh;
1311 WHERE subscriptionid = ?
1313 my $sth = $dbh->prepare($query);
1314 $sth->execute($subscriptionid);
1316 my ($result) = $sth->fetchrow_array;
1317 my @irreg = split /;/, $result;
1322 =head2 ModSubscription
1324 this function modifies a subscription. Put all new values on input args.
1325 returns the number of rows affected
1329 sub ModSubscription {
1331 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1332 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1333 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1334 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1335 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1336 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1337 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1340 my $dbh = C4::Context->dbh;
1341 my $query = "UPDATE subscription
1342 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1343 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1344 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1345 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1346 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1347 callnumber=?, notes=?, letter=?, manualhistory=?,
1348 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1349 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1351 WHERE subscriptionid = ?";
1353 my $sth = $dbh->prepare($query);
1355 $auser, $branchcode, $aqbooksellerid, $cost,
1356 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1357 $irregularity, $numberpattern, $locale, $numberlength,
1358 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1359 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1360 $status, $biblionumber, $callnumber, $notes,
1361 $letter, ($manualhistory ? $manualhistory : 0),
1362 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1363 $graceperiod, $location, $enddate, $skip_serialseq,
1366 my $rows = $sth->rows;
1368 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1372 =head2 NewSubscription
1374 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1375 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1376 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1377 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1378 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1379 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1381 Create a new subscription with value given on input args.
1384 the id of this new subscription
1388 sub NewSubscription {
1390 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1391 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1392 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1393 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1394 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1395 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1396 $location, $enddate, $skip_serialseq
1398 my $dbh = C4::Context->dbh;
1400 #save subscription (insert into database)
1402 INSERT INTO subscription
1403 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1404 biblionumber, startdate, periodicity, numberlength, weeklength,
1405 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1406 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1407 irregularity, numberpattern, locale, callnumber,
1408 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1409 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1410 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1412 my $sth = $dbh->prepare($query);
1414 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1415 $startdate, $periodicity, $numberlength, $weeklength,
1416 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1417 $lastvalue3, $innerloop3, $status, $notes, $letter,
1418 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1419 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1420 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1423 my $subscriptionid = $dbh->{'mysql_insertid'};
1425 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1429 WHERE subscriptionid=?
1431 $sth = $dbh->prepare($query);
1432 $sth->execute( $enddate, $subscriptionid );
1435 # then create the 1st expected number
1437 INSERT INTO subscriptionhistory
1438 (biblionumber, subscriptionid, histstartdate)
1441 $sth = $dbh->prepare($query);
1442 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1444 # reread subscription to get a hash (for calculation of the 1st issue number)
1445 my $subscription = GetSubscription($subscriptionid);
1446 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1448 # calculate issue number
1449 my $serialseq = GetSeq($subscription, $pattern) || q{};
1453 serialseq => $serialseq,
1454 serialseq_x => $subscription->{'lastvalue1'},
1455 serialseq_y => $subscription->{'lastvalue2'},
1456 serialseq_z => $subscription->{'lastvalue3'},
1457 subscriptionid => $subscriptionid,
1458 biblionumber => $biblionumber,
1460 planneddate => $firstacquidate,
1461 publisheddate => $firstacquidate,
1465 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1467 #set serial flag on biblio if not already set.
1468 my $bib = GetBiblio($biblionumber);
1469 if ( $bib and !$bib->{'serial'} ) {
1470 my $record = GetMarcBiblio($biblionumber);
1471 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1473 eval { $record->field($tag)->update( $subf => 1 ); };
1475 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1477 return $subscriptionid;
1480 =head2 ReNewSubscription
1482 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1484 this function renew a subscription with values given on input args.
1488 sub ReNewSubscription {
1489 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1490 my $dbh = C4::Context->dbh;
1491 my $subscription = GetSubscription($subscriptionid);
1495 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1496 WHERE biblio.biblionumber=?
1498 my $sth = $dbh->prepare($query);
1499 $sth->execute( $subscription->{biblionumber} );
1500 my $biblio = $sth->fetchrow_hashref;
1502 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1503 require C4::Suggestions;
1504 C4::Suggestions::NewSuggestion(
1505 { 'suggestedby' => $user,
1506 'title' => $subscription->{bibliotitle},
1507 'author' => $biblio->{author},
1508 'publishercode' => $biblio->{publishercode},
1509 'note' => $biblio->{note},
1510 'biblionumber' => $subscription->{biblionumber}
1515 # renew subscription
1518 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1519 WHERE subscriptionid=?
1521 $sth = $dbh->prepare($query);
1522 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1523 my $enddate = GetExpirationDate($subscriptionid);
1524 $debug && warn "enddate :$enddate";
1528 WHERE subscriptionid=?
1530 $sth = $dbh->prepare($query);
1531 $sth->execute( $enddate, $subscriptionid );
1533 UPDATE subscriptionhistory
1535 WHERE subscriptionid=?
1537 $sth = $dbh->prepare($query);
1538 $sth->execute( $enddate, $subscriptionid );
1540 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1546 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1548 Create a new issue stored on the database.
1549 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1550 returns the serial id
1555 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1556 $publisheddate, $publisheddatetext, $notes ) = @_;
1557 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1559 return unless ($subscriptionid);
1561 my $schema = Koha::Database->new()->schema();
1563 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1565 my $serial = Koha::Serial->new(
1567 serialseq => $serialseq,
1568 serialseq_x => $subscription->lastvalue1(),
1569 serialseq_y => $subscription->lastvalue2(),
1570 serialseq_z => $subscription->lastvalue3(),
1571 subscriptionid => $subscriptionid,
1572 biblionumber => $biblionumber,
1574 planneddate => $planneddate,
1575 publisheddate => $publisheddate,
1576 publisheddatetext => $publisheddatetext,
1581 my $serialid = $serial->id();
1583 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1584 my $missinglist = $subscription_history->missinglist();
1585 my $recievedlist = $subscription_history->recievedlist();
1587 if ( $status == ARRIVED ) {
1588 ### TODO Add a feature that improves recognition and description.
1589 ### As such count (serialseq) i.e. : N18,2(N19),N20
1590 ### Would use substr and index But be careful to previous presence of ()
1591 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1593 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1594 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1597 $recievedlist =~ s/^; //;
1598 $missinglist =~ s/^; //;
1600 $subscription_history->recievedlist($recievedlist);
1601 $subscription_history->missinglist($missinglist);
1602 $subscription_history->update();
1607 =head2 HasSubscriptionStrictlyExpired
1609 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1611 the subscription has stricly expired when today > the end subscription date
1614 1 if true, 0 if false, -1 if the expiration date is not set.
1618 sub HasSubscriptionStrictlyExpired {
1620 # Getting end of subscription date
1621 my ($subscriptionid) = @_;
1623 return unless ($subscriptionid);
1625 my $dbh = C4::Context->dbh;
1626 my $subscription = GetSubscription($subscriptionid);
1627 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1629 # If the expiration date is set
1630 if ( $expirationdate != 0 ) {
1631 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1633 # Getting today's date
1634 my ( $nowyear, $nowmonth, $nowday ) = Today();
1636 # if today's date > expiration date, then the subscription has stricly expired
1637 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1644 # There are some cases where the expiration date is not set
1645 # As we can't determine if the subscription has expired on a date-basis,
1651 =head2 HasSubscriptionExpired
1653 $has_expired = HasSubscriptionExpired($subscriptionid)
1655 the subscription has expired when the next issue to arrive is out of subscription limit.
1658 0 if the subscription has not expired
1659 1 if the subscription has expired
1660 2 if has subscription does not have a valid expiration date set
1664 sub HasSubscriptionExpired {
1665 my ($subscriptionid) = @_;
1667 return unless ($subscriptionid);
1669 my $dbh = C4::Context->dbh;
1670 my $subscription = GetSubscription($subscriptionid);
1671 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1672 if ( $frequency and $frequency->{unit} ) {
1673 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1674 if (!defined $expirationdate) {
1675 $expirationdate = q{};
1678 SELECT max(planneddate)
1680 WHERE subscriptionid=?
1682 my $sth = $dbh->prepare($query);
1683 $sth->execute($subscriptionid);
1684 my ($res) = $sth->fetchrow;
1685 if (!$res || $res=~m/^0000/) {
1688 my @res = split( /-/, $res );
1689 my @endofsubscriptiondate = split( /-/, $expirationdate );
1690 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1692 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1697 if ( $subscription->{'numberlength'} ) {
1698 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1699 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1705 return 0; # Notice that you'll never get here.
1708 =head2 SetDistributedto
1710 SetDistributedto($distributedto,$subscriptionid);
1711 This function update the value of distributedto for a subscription given on input arg.
1715 sub SetDistributedto {
1716 my ( $distributedto, $subscriptionid ) = @_;
1717 my $dbh = C4::Context->dbh;
1721 WHERE subscriptionid=?
1723 my $sth = $dbh->prepare($query);
1724 $sth->execute( $distributedto, $subscriptionid );
1728 =head2 DelSubscription
1730 DelSubscription($subscriptionid)
1731 this function deletes subscription which has $subscriptionid as id.
1735 sub DelSubscription {
1736 my ($subscriptionid) = @_;
1737 my $dbh = C4::Context->dbh;
1738 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1739 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1740 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1742 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1743 foreach my $af (@$afs) {
1744 $af->delete_values({record_id => $subscriptionid});
1747 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1752 DelIssue($serialseq,$subscriptionid)
1753 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1755 returns the number of rows affected
1760 my ($dataissue) = @_;
1761 my $dbh = C4::Context->dbh;
1762 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1767 AND subscriptionid= ?
1769 my $mainsth = $dbh->prepare($query);
1770 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1772 #Delete element from subscription history
1773 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1774 my $sth = $dbh->prepare($query);
1775 $sth->execute( $dataissue->{'subscriptionid'} );
1776 my $val = $sth->fetchrow_hashref;
1777 unless ( $val->{manualhistory} ) {
1779 SELECT * FROM subscriptionhistory
1780 WHERE subscriptionid= ?
1782 my $sth = $dbh->prepare($query);
1783 $sth->execute( $dataissue->{'subscriptionid'} );
1784 my $data = $sth->fetchrow_hashref;
1785 my $serialseq = $dataissue->{'serialseq'};
1786 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1787 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1788 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1789 $sth = $dbh->prepare($strsth);
1790 $sth->execute( $dataissue->{'subscriptionid'} );
1793 return $mainsth->rows;
1796 =head2 GetLateOrMissingIssues
1798 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1800 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1803 the issuelist as an array of hash refs. Each element of this array contains
1804 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1808 sub GetLateOrMissingIssues {
1809 my ( $supplierid, $serialid, $order ) = @_;
1811 return unless ( $supplierid or $serialid );
1813 my $dbh = C4::Context->dbh;
1818 $byserial = "and serialid = " . $serialid;
1821 $order .= ", title";
1825 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1827 $sth = $dbh->prepare(
1829 serialid, aqbooksellerid, name,
1830 biblio.title, biblioitems.issn, planneddate, serialseq,
1831 serial.status, serial.subscriptionid, claimdate, claims_count,
1832 subscription.branchcode
1834 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1835 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1836 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1837 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1838 WHERE subscription.subscriptionid = serial.subscriptionid
1839 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1840 AND subscription.aqbooksellerid=$supplierid
1845 $sth = $dbh->prepare(
1847 serialid, aqbooksellerid, name,
1848 biblio.title, planneddate, serialseq,
1849 serial.status, serial.subscriptionid, claimdate, claims_count,
1850 subscription.branchcode
1852 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1853 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1854 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1855 WHERE subscription.subscriptionid = serial.subscriptionid
1856 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1861 $sth->execute( EXPECTED, LATE, CLAIMED );
1863 while ( my $line = $sth->fetchrow_hashref ) {
1865 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1866 $line->{planneddateISO} = $line->{planneddate};
1867 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1869 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1870 $line->{claimdateISO} = $line->{claimdate};
1871 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1873 $line->{"status".$line->{status}} = 1;
1875 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1876 record_id => $line->{subscriptionid},
1877 tablename => 'subscription'
1879 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1881 push @issuelist, $line;
1888 &updateClaim($serialid)
1890 this function updates the time when a claim is issued for late/missing items
1892 called from claims.pl file
1897 my ($serialid) = @_;
1898 my $dbh = C4::Context->dbh;
1901 SET claimdate = NOW(),
1902 claims_count = claims_count + 1
1908 =head2 getsupplierbyserialid
1910 $result = getsupplierbyserialid($serialid)
1912 this function is used to find the supplier id given a serial id
1915 hashref containing serialid, subscriptionid, and aqbooksellerid
1919 sub getsupplierbyserialid {
1920 my ($serialid) = @_;
1921 my $dbh = C4::Context->dbh;
1922 my $sth = $dbh->prepare(
1923 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1925 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1929 $sth->execute($serialid);
1930 my $line = $sth->fetchrow_hashref;
1931 my $result = $line->{'aqbooksellerid'};
1935 =head2 check_routing
1937 $result = &check_routing($subscriptionid)
1939 this function checks to see if a serial has a routing list and returns the count of routingid
1940 used to show either an 'add' or 'edit' link
1945 my ($subscriptionid) = @_;
1947 return unless ($subscriptionid);
1949 my $dbh = C4::Context->dbh;
1950 my $sth = $dbh->prepare(
1951 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1952 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1953 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1956 $sth->execute($subscriptionid);
1957 my $line = $sth->fetchrow_hashref;
1958 my $result = $line->{'routingids'};
1962 =head2 addroutingmember
1964 addroutingmember($borrowernumber,$subscriptionid)
1966 this function takes a borrowernumber and subscriptionid and adds the member to the
1967 routing list for that serial subscription and gives them a rank on the list
1968 of either 1 or highest current rank + 1
1972 sub addroutingmember {
1973 my ( $borrowernumber, $subscriptionid ) = @_;
1975 return unless ($borrowernumber and $subscriptionid);
1978 my $dbh = C4::Context->dbh;
1979 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1980 $sth->execute($subscriptionid);
1981 while ( my $line = $sth->fetchrow_hashref ) {
1982 if ( $line->{'rank'} > 0 ) {
1983 $rank = $line->{'rank'} + 1;
1988 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1989 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1992 =head2 reorder_members
1994 reorder_members($subscriptionid,$routingid,$rank)
1996 this function is used to reorder the routing list
1998 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1999 - it gets all members on list puts their routingid's into an array
2000 - removes the one in the array that is $routingid
2001 - then reinjects $routingid at point indicated by $rank
2002 - then update the database with the routingids in the new order
2006 sub reorder_members {
2007 my ( $subscriptionid, $routingid, $rank ) = @_;
2008 my $dbh = C4::Context->dbh;
2009 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2010 $sth->execute($subscriptionid);
2012 while ( my $line = $sth->fetchrow_hashref ) {
2013 push( @result, $line->{'routingid'} );
2016 # To find the matching index
2018 my $key = -1; # to allow for 0 being a valid response
2019 for ( $i = 0 ; $i < @result ; $i++ ) {
2020 if ( $routingid == $result[$i] ) {
2021 $key = $i; # save the index
2026 # if index exists in array then move it to new position
2027 if ( $key > -1 && $rank > 0 ) {
2028 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2029 my $moving_item = splice( @result, $key, 1 );
2030 splice( @result, $new_rank, 0, $moving_item );
2032 for ( my $j = 0 ; $j < @result ; $j++ ) {
2033 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2039 =head2 delroutingmember
2041 delroutingmember($routingid,$subscriptionid)
2043 this function either deletes one member from routing list if $routingid exists otherwise
2044 deletes all members from the routing list
2048 sub delroutingmember {
2050 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2051 my ( $routingid, $subscriptionid ) = @_;
2052 my $dbh = C4::Context->dbh;
2054 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2055 $sth->execute($routingid);
2056 reorder_members( $subscriptionid, $routingid );
2058 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2059 $sth->execute($subscriptionid);
2064 =head2 getroutinglist
2066 @routinglist = getroutinglist($subscriptionid)
2068 this gets the info from the subscriptionroutinglist for $subscriptionid
2071 the routinglist as an array. Each element of the array contains a hash_ref containing
2072 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2076 sub getroutinglist {
2077 my ($subscriptionid) = @_;
2078 my $dbh = C4::Context->dbh;
2079 my $sth = $dbh->prepare(
2080 'SELECT routingid, borrowernumber, ranking, biblionumber
2082 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2083 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2085 $sth->execute($subscriptionid);
2086 my $routinglist = $sth->fetchall_arrayref({});
2087 return @{$routinglist};
2090 =head2 countissuesfrom
2092 $result = countissuesfrom($subscriptionid,$startdate)
2094 Returns a count of serial rows matching the given subsctiptionid
2095 with published date greater than startdate
2099 sub countissuesfrom {
2100 my ( $subscriptionid, $startdate ) = @_;
2101 my $dbh = C4::Context->dbh;
2105 WHERE subscriptionid=?
2106 AND serial.publisheddate>?
2108 my $sth = $dbh->prepare($query);
2109 $sth->execute( $subscriptionid, $startdate );
2110 my ($countreceived) = $sth->fetchrow;
2111 return $countreceived;
2116 $result = CountIssues($subscriptionid)
2118 Returns a count of serial rows matching the given subsctiptionid
2123 my ($subscriptionid) = @_;
2124 my $dbh = C4::Context->dbh;
2128 WHERE subscriptionid=?
2130 my $sth = $dbh->prepare($query);
2131 $sth->execute($subscriptionid);
2132 my ($countreceived) = $sth->fetchrow;
2133 return $countreceived;
2138 $result = HasItems($subscriptionid)
2140 returns a count of items from serial matching the subscriptionid
2145 my ($subscriptionid) = @_;
2146 my $dbh = C4::Context->dbh;
2148 SELECT COUNT(serialitems.itemnumber)
2150 LEFT JOIN serialitems USING(serialid)
2151 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2153 my $sth=$dbh->prepare($query);
2154 $sth->execute($subscriptionid);
2155 my ($countitems)=$sth->fetchrow_array();
2159 =head2 abouttoexpire
2161 $result = abouttoexpire($subscriptionid)
2163 this function alerts you to the penultimate issue for a serial subscription
2165 returns 1 - if this is the penultimate issue
2171 my ($subscriptionid) = @_;
2172 my $dbh = C4::Context->dbh;
2173 my $subscription = GetSubscription($subscriptionid);
2174 my $per = $subscription->{'periodicity'};
2175 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2176 if ($frequency and $frequency->{unit}){
2178 my $expirationdate = GetExpirationDate($subscriptionid);
2180 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2181 my $nextdate = GetNextDate($subscription, $res);
2183 # only compare dates if both dates exist.
2184 if ($nextdate and $expirationdate) {
2185 if(Date::Calc::Delta_Days(
2186 split( /-/, $nextdate ),
2187 split( /-/, $expirationdate )
2193 } elsif ($subscription->{numberlength}>0) {
2194 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2200 sub in_array { # used in next sub down
2201 my ( $val, @elements ) = @_;
2202 foreach my $elem (@elements) {
2203 if ( $val == $elem ) {
2210 =head2 GetSubscriptionsFromBorrower
2212 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2214 this gets the info from subscriptionroutinglist for each $subscriptionid
2217 a count of the serial subscription routing lists to which a patron belongs,
2218 with the titles of those serial subscriptions as an array. Each element of the array
2219 contains a hash_ref with subscriptionID and title of subscription.
2223 sub GetSubscriptionsFromBorrower {
2224 my ($borrowernumber) = @_;
2225 my $dbh = C4::Context->dbh;
2226 my $sth = $dbh->prepare(
2227 "SELECT subscription.subscriptionid, biblio.title
2229 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2230 JOIN subscriptionroutinglist USING (subscriptionid)
2231 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2234 $sth->execute($borrowernumber);
2237 while ( my $line = $sth->fetchrow_hashref ) {
2239 push( @routinglist, $line );
2241 return ( $count, @routinglist );
2245 =head2 GetFictiveIssueNumber
2247 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2249 Get the position of the issue published at $publisheddate, considering the
2250 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2251 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2252 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2253 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2254 depending on how many rows are in serial table.
2255 The issue number calculation is based on subscription frequency, first acquisition
2256 date, and $publisheddate.
2260 sub GetFictiveIssueNumber {
2261 my ($subscription, $publisheddate) = @_;
2263 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2264 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2268 my ($year, $month, $day) = split /-/, $publisheddate;
2269 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2273 if($unit eq 'day') {
2274 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2275 } elsif($unit eq 'week') {
2276 ($wkno, $year) = Week_of_Year($year, $month, $day);
2277 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2278 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2279 } elsif($unit eq 'month') {
2280 $delta = ($fa_year == $year)
2281 ? ($month - $fa_month)
2282 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2283 } elsif($unit eq 'year') {
2284 $delta = $year - $fa_year;
2286 if($frequency->{'unitsperissue'} == 1) {
2287 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2289 # Assuming issuesperunit == 1
2290 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2296 sub _get_next_date_day {
2297 my ($subscription, $freqdata, $year, $month, $day) = @_;
2299 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2300 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2301 $subscription->{countissuesperunit} = 1;
2303 $subscription->{countissuesperunit}++;
2306 return ($year, $month, $day);
2309 sub _get_next_date_week {
2310 my ($subscription, $freqdata, $year, $month, $day) = @_;
2312 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2313 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2315 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2316 $subscription->{countissuesperunit} = 1;
2317 $wkno += $freqdata->{unitsperissue};
2322 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2323 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2325 # Try to guess the next day of week
2326 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2327 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2328 $subscription->{countissuesperunit}++;
2331 return ($year, $month, $day);
2334 sub _get_next_date_month {
2335 my ($subscription, $freqdata, $year, $month, $day) = @_;
2338 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2340 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2341 $subscription->{countissuesperunit} = 1;
2342 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2343 $freqdata->{unitsperissue});
2344 my $days_in_month = Days_in_Month($year, $month);
2345 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2347 # Try to guess the next day in month
2348 my $days_in_month = Days_in_Month($year, $month);
2349 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2350 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2351 $subscription->{countissuesperunit}++;
2354 return ($year, $month, $day);
2357 sub _get_next_date_year {
2358 my ($subscription, $freqdata, $year, $month, $day) = @_;
2360 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2362 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2363 $subscription->{countissuesperunit} = 1;
2364 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2366 my $days_in_month = Days_in_Month($year, $month);
2367 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2369 # Try to guess the next day in year
2370 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2371 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2372 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2373 $subscription->{countissuesperunit}++;
2376 return ($year, $month, $day);
2381 $resultdate = GetNextDate($publisheddate,$subscription)
2383 this function it takes the publisheddate and will return the next issue's date
2384 and will skip dates if there exists an irregularity.
2385 $publisheddate has to be an ISO date
2386 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2387 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2388 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2389 skipped then the returned date will be 2007-05-10
2392 $resultdate - then next date in the sequence (ISO date)
2394 Return undef if subscription is irregular
2399 my ( $subscription, $publisheddate, $updatecount ) = @_;
2401 return unless $subscription and $publisheddate;
2403 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2405 if ($freqdata->{'unit'}) {
2406 my ( $year, $month, $day ) = split /-/, $publisheddate;
2408 # Process an irregularity Hash
2409 # Suppose that irregularities are stored in a string with this structure
2410 # irreg1;irreg2;irreg3
2411 # where irregX is the number of issue which will not be received
2412 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2414 if ( $subscription->{irregularity} ) {
2415 my @irreg = split /;/, $subscription->{'irregularity'} ;
2416 foreach my $irregularity (@irreg) {
2417 $irregularities{$irregularity} = 1;
2421 # Get the 'fictive' next issue number
2422 # It is used to check if next issue is an irregular issue.
2423 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2425 # Then get the next date
2426 my $unit = lc $freqdata->{'unit'};
2427 if ($unit eq 'day') {
2428 while ($irregularities{$issueno}) {
2429 ($year, $month, $day) = _get_next_date_day($subscription,
2430 $freqdata, $year, $month, $day);
2433 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2434 $year, $month, $day);
2436 elsif ($unit eq 'week') {
2437 while ($irregularities{$issueno}) {
2438 ($year, $month, $day) = _get_next_date_week($subscription,
2439 $freqdata, $year, $month, $day);
2442 ($year, $month, $day) = _get_next_date_week($subscription,
2443 $freqdata, $year, $month, $day);
2445 elsif ($unit eq 'month') {
2446 while ($irregularities{$issueno}) {
2447 ($year, $month, $day) = _get_next_date_month($subscription,
2448 $freqdata, $year, $month, $day);
2451 ($year, $month, $day) = _get_next_date_month($subscription,
2452 $freqdata, $year, $month, $day);
2454 elsif ($unit eq 'year') {
2455 while ($irregularities{$issueno}) {
2456 ($year, $month, $day) = _get_next_date_year($subscription,
2457 $freqdata, $year, $month, $day);
2460 ($year, $month, $day) = _get_next_date_year($subscription,
2461 $freqdata, $year, $month, $day);
2465 my $dbh = C4::Context->dbh;
2468 SET countissuesperunit = ?
2469 WHERE subscriptionid = ?
2471 my $sth = $dbh->prepare($query);
2472 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2475 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2481 $string = &_numeration($value,$num_type,$locale);
2483 _numeration returns the string corresponding to $value in the num_type
2493 my ($value, $num_type, $locale) = @_;
2498 if ( $num_type =~ /^dayname$/ ) {
2499 # 1970-11-01 was a Sunday
2500 $value = $value % 7;
2501 my $dt = DateTime->new(
2507 $string = $dt->strftime("%A");
2508 } elsif ( $num_type =~ /^monthname$/ ) {
2509 $value = $value % 12;
2510 my $dt = DateTime->new(
2512 month => $value + 1,
2515 $string = $dt->strftime("%B");
2516 } elsif ( $num_type =~ /^season$/ ) {
2517 my @seasons= qw( Spring Summer Fall Winter );
2518 $value = $value % 4;
2519 $string = $seasons[$value];
2527 =head2 is_barcode_in_use
2529 Returns number of occurrences of the barcode in the items table
2530 Can be used as a boolean test of whether the barcode has
2531 been deployed as yet
2535 sub is_barcode_in_use {
2536 my $barcode = shift;
2537 my $dbh = C4::Context->dbh;
2538 my $occurrences = $dbh->selectall_arrayref(
2539 'SELECT itemnumber from items where barcode = ?',
2544 return @{$occurrences};
2547 =head2 CloseSubscription
2548 Close a subscription given a subscriptionid
2550 sub CloseSubscription {
2551 my ( $subscriptionid ) = @_;
2552 return unless $subscriptionid;
2553 my $dbh = C4::Context->dbh;
2554 my $sth = $dbh->prepare( q{
2557 WHERE subscriptionid = ?
2559 $sth->execute( $subscriptionid );
2561 # Set status = missing when status = stopped
2562 $sth = $dbh->prepare( q{
2565 WHERE subscriptionid = ?
2568 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2571 =head2 ReopenSubscription
2572 Reopen a subscription given a subscriptionid
2574 sub ReopenSubscription {
2575 my ( $subscriptionid ) = @_;
2576 return unless $subscriptionid;
2577 my $dbh = C4::Context->dbh;
2578 my $sth = $dbh->prepare( q{
2581 WHERE subscriptionid = ?
2583 $sth->execute( $subscriptionid );
2585 # Set status = expected when status = stopped
2586 $sth = $dbh->prepare( q{
2589 WHERE subscriptionid = ?
2592 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2595 =head2 subscriptionCurrentlyOnOrder
2597 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2599 Return 1 if subscription is currently on order else 0.
2603 sub subscriptionCurrentlyOnOrder {
2604 my ( $subscriptionid ) = @_;
2605 my $dbh = C4::Context->dbh;
2607 SELECT COUNT(*) FROM aqorders
2608 WHERE subscriptionid = ?
2609 AND datereceived IS NULL
2610 AND datecancellationprinted IS NULL
2612 my $sth = $dbh->prepare( $query );
2613 $sth->execute($subscriptionid);
2614 return $sth->fetchrow_array;
2617 =head2 can_claim_subscription
2619 $can = can_claim_subscription( $subscriptionid[, $userid] );
2621 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2625 sub can_claim_subscription {
2626 my ( $subscription, $userid ) = @_;
2627 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2630 =head2 can_edit_subscription
2632 $can = can_edit_subscription( $subscriptionid[, $userid] );
2634 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2638 sub can_edit_subscription {
2639 my ( $subscription, $userid ) = @_;
2640 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2643 =head2 can_show_subscription
2645 $can = can_show_subscription( $subscriptionid[, $userid] );
2647 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2651 sub can_show_subscription {
2652 my ( $subscription, $userid ) = @_;
2653 return _can_do_on_subscription( $subscription, $userid, '*' );
2656 sub _can_do_on_subscription {
2657 my ( $subscription, $userid, $permission ) = @_;
2658 return 0 unless C4::Context->userenv;
2659 my $flags = C4::Context->userenv->{flags};
2660 $userid ||= C4::Context->userenv->{'id'};
2662 if ( C4::Context->preference('IndependentBranches') ) {
2664 if C4::Context->IsSuperLibrarian()
2666 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2668 C4::Auth::haspermission( $userid,
2669 { serials => $permission } )
2670 and ( not defined $subscription->{branchcode}
2671 or $subscription->{branchcode} eq ''
2672 or $subscription->{branchcode} eq
2673 C4::Context->userenv->{'branch'} )
2678 if C4::Context->IsSuperLibrarian()
2680 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2681 or C4::Auth::haspermission(
2682 $userid, { serials => $permission }
2694 Koha Development Team <http://koha-community.org/>