3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalField;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
39 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
81 &GetSuppliersWithLateIssues &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
188 $data = GetSerialInformation($serialid);
189 returns a hash_ref containing :
190 items : items marcrecord (can be an array)
192 subscription table field
193 + information about subscription expiration
197 sub GetSerialInformation {
199 my $dbh = C4::Context->dbh;
201 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
202 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
205 my $rq = $dbh->prepare($query);
206 $rq->execute($serialid);
207 my $data = $rq->fetchrow_hashref;
209 # create item information if we have serialsadditems for this subscription
210 if ( $data->{'serialsadditems'} ) {
211 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
212 $queryitem->execute($serialid);
213 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
215 if ( scalar(@$itemnumbers) > 0 ) {
216 foreach my $itemnum (@$itemnumbers) {
218 #It is ASSUMED that GetMarcItem ALWAYS WORK...
219 #Maybe GetMarcItem should return values on failure
220 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
221 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
222 $itemprocessed->{'itemnumber'} = $itemnum->[0];
223 $itemprocessed->{'itemid'} = $itemnum->[0];
224 $itemprocessed->{'serialid'} = $serialid;
225 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
226 push @{ $data->{'items'} }, $itemprocessed;
229 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
230 $itemprocessed->{'itemid'} = "N$serialid";
231 $itemprocessed->{'serialid'} = $serialid;
232 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
233 $itemprocessed->{'countitems'} = 0;
234 push @{ $data->{'items'} }, $itemprocessed;
237 $data->{ "status" . $data->{'serstatus'} } = 1;
238 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
239 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
240 $data->{cannotedit} = not can_edit_subscription( $data );
244 =head2 AddItem2Serial
246 $rows = AddItem2Serial($serialid,$itemnumber);
247 Adds an itemnumber to Serial record
248 returns the number of rows affected
253 my ( $serialid, $itemnumber ) = @_;
255 return unless ($serialid and $itemnumber);
257 my $dbh = C4::Context->dbh;
258 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
259 $rq->execute( $serialid, $itemnumber );
263 =head2 GetSubscription
265 $subs = GetSubscription($subscriptionid)
266 this function returns the subscription which has $subscriptionid as id.
268 a hashref. This hash containts
269 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
273 sub GetSubscription {
274 my ($subscriptionid) = @_;
275 my $dbh = C4::Context->dbh;
277 SELECT subscription.*,
278 subscriptionhistory.*,
279 aqbooksellers.name AS aqbooksellername,
280 biblio.title AS bibliotitle,
281 subscription.biblionumber as bibnum
283 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
284 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
285 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
286 WHERE subscription.subscriptionid = ?
289 $debug and warn "query : $query\nsubsid :$subscriptionid";
290 my $sth = $dbh->prepare($query);
291 $sth->execute($subscriptionid);
292 my $subscription = $sth->fetchrow_hashref;
294 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
296 # Add additional fields to the subscription into a new key "additional_fields"
297 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
298 tablename => 'subscription',
299 record_id => $subscriptionid,
301 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
303 return $subscription;
306 =head2 GetFullSubscription
308 $array_ref = GetFullSubscription($subscriptionid)
309 this function reads the serial table.
313 sub GetFullSubscription {
314 my ($subscriptionid) = @_;
316 return unless ($subscriptionid);
318 my $dbh = C4::Context->dbh;
320 SELECT serial.serialid,
323 serial.publisheddate,
324 serial.publisheddatetext,
326 serial.notes as notes,
327 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
328 aqbooksellers.name as aqbooksellername,
329 biblio.title as bibliotitle,
330 subscription.branchcode AS branchcode,
331 subscription.subscriptionid AS subscriptionid
333 LEFT JOIN subscription ON
334 (serial.subscriptionid=subscription.subscriptionid )
335 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
336 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
337 WHERE serial.subscriptionid = ?
339 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
340 serial.subscriptionid
342 $debug and warn "GetFullSubscription query: $query";
343 my $sth = $dbh->prepare($query);
344 $sth->execute($subscriptionid);
345 my $subscriptions = $sth->fetchall_arrayref( {} );
346 for my $subscription ( @$subscriptions ) {
347 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
349 return $subscriptions;
352 =head2 PrepareSerialsData
354 $array_ref = PrepareSerialsData($serialinfomation)
355 where serialinformation is a hashref array
359 sub PrepareSerialsData {
362 return unless ($lines);
368 my $aqbooksellername;
372 my $previousnote = "";
374 foreach my $subs (@{$lines}) {
375 for my $datefield ( qw(publisheddate planneddate) ) {
376 # handle 0000-00-00 dates
377 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
378 $subs->{$datefield} = undef;
381 $subs->{ "status" . $subs->{'status'} } = 1;
382 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
383 $subs->{"checked"} = 1;
386 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
387 $year = $subs->{'year'};
391 if ( $tmpresults{$year} ) {
392 push @{ $tmpresults{$year}->{'serials'} }, $subs;
394 $tmpresults{$year} = {
396 'aqbooksellername' => $subs->{'aqbooksellername'},
397 'bibliotitle' => $subs->{'bibliotitle'},
398 'serials' => [$subs],
403 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
404 push @res, $tmpresults{$key};
409 =head2 GetSubscriptionsFromBiblionumber
411 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
412 this function get the subscription list. it reads the subscription table.
414 reference to an array of subscriptions which have the biblionumber given on input arg.
415 each element of this array is a hashref containing
416 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
420 sub GetSubscriptionsFromBiblionumber {
421 my ($biblionumber) = @_;
423 return unless ($biblionumber);
425 my $dbh = C4::Context->dbh;
427 SELECT subscription.*,
429 subscriptionhistory.*,
430 aqbooksellers.name AS aqbooksellername,
431 biblio.title AS bibliotitle
433 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
434 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
435 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
436 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
437 WHERE subscription.biblionumber = ?
439 my $sth = $dbh->prepare($query);
440 $sth->execute($biblionumber);
442 while ( my $subs = $sth->fetchrow_hashref ) {
443 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
444 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
445 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
446 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
447 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
448 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
449 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
450 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
451 $subs->{ "status" . $subs->{'status'} } = 1;
453 if ( $subs->{enddate} eq '0000-00-00' ) {
454 $subs->{enddate} = '';
456 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
458 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
459 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
460 $subs->{cannotedit} = not can_edit_subscription( $subs );
466 =head2 GetFullSubscriptionsFromBiblionumber
468 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
469 this function reads the serial table.
473 sub GetFullSubscriptionsFromBiblionumber {
474 my ($biblionumber) = @_;
475 my $dbh = C4::Context->dbh;
477 SELECT serial.serialid,
480 serial.publisheddate,
481 serial.publisheddatetext,
483 serial.notes as notes,
484 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
485 biblio.title as bibliotitle,
486 subscription.branchcode AS branchcode,
487 subscription.subscriptionid AS subscriptionid
489 LEFT JOIN subscription ON
490 (serial.subscriptionid=subscription.subscriptionid)
491 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
492 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
493 WHERE subscription.biblionumber = ?
495 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
496 serial.subscriptionid
498 my $sth = $dbh->prepare($query);
499 $sth->execute($biblionumber);
500 my $subscriptions = $sth->fetchall_arrayref( {} );
501 for my $subscription ( @$subscriptions ) {
502 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
504 return $subscriptions;
507 =head2 SearchSubscriptions
509 @results = SearchSubscriptions($args);
511 This function returns a list of hashrefs, one for each subscription
512 that meets the conditions specified by the $args hashref.
514 The valid search fields are:
528 The expiration_date search field is special; it specifies the maximum
529 subscription expiration date.
533 sub SearchSubscriptions {
536 my $additional_fields = $args->{additional_fields} // [];
537 my $matching_record_ids_for_additional_fields = [];
538 if ( @$additional_fields ) {
539 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
540 fields => $additional_fields,
541 tablename => 'subscription',
544 return () unless @$matching_record_ids_for_additional_fields;
549 subscription.notes AS publicnotes,
550 subscriptionhistory.*,
552 biblio.notes AS biblionotes,
556 aqbooksellers.name AS vendorname,
559 LEFT JOIN subscriptionhistory USING(subscriptionid)
560 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
561 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
562 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
564 $query .= q| WHERE 1|;
567 if( $args->{biblionumber} ) {
568 push @where_strs, "biblio.biblionumber = ?";
569 push @where_args, $args->{biblionumber};
572 if( $args->{title} ){
573 my @words = split / /, $args->{title};
575 foreach my $word (@words) {
576 push @strs, "biblio.title LIKE ?";
577 push @args, "%$word%";
580 push @where_strs, '(' . join (' AND ', @strs) . ')';
581 push @where_args, @args;
585 push @where_strs, "biblioitems.issn LIKE ?";
586 push @where_args, "%$args->{issn}%";
589 push @where_strs, "biblioitems.ean LIKE ?";
590 push @where_args, "%$args->{ean}%";
592 if ( $args->{callnumber} ) {
593 push @where_strs, "subscription.callnumber LIKE ?";
594 push @where_args, "%$args->{callnumber}%";
596 if( $args->{publisher} ){
597 push @where_strs, "biblioitems.publishercode LIKE ?";
598 push @where_args, "%$args->{publisher}%";
600 if( $args->{bookseller} ){
601 push @where_strs, "aqbooksellers.name LIKE ?";
602 push @where_args, "%$args->{bookseller}%";
604 if( $args->{branch} ){
605 push @where_strs, "subscription.branchcode = ?";
606 push @where_args, "$args->{branch}";
608 if ( $args->{location} ) {
609 push @where_strs, "subscription.location = ?";
610 push @where_args, "$args->{location}";
612 if ( $args->{expiration_date} ) {
613 push @where_strs, "subscription.enddate <= ?";
614 push @where_args, "$args->{expiration_date}";
616 if( defined $args->{closed} ){
617 push @where_strs, "subscription.closed = ?";
618 push @where_args, "$args->{closed}";
622 $query .= ' AND ' . join(' AND ', @where_strs);
624 if ( @$additional_fields ) {
625 $query .= ' AND subscriptionid IN ('
626 . join( ', ', @$matching_record_ids_for_additional_fields )
630 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
632 my $dbh = C4::Context->dbh;
633 my $sth = $dbh->prepare($query);
634 $sth->execute(@where_args);
635 my $results = $sth->fetchall_arrayref( {} );
637 for my $subscription ( @$results ) {
638 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
639 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
641 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
642 record_id => $subscription->{subscriptionid},
643 tablename => 'subscription'
645 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
654 ($totalissues,@serials) = GetSerials($subscriptionid);
655 this function gets every serial not arrived for a given subscription
656 as well as the number of issues registered in the database (all types)
657 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
659 FIXME: We should return \@serials.
664 my ( $subscriptionid, $count ) = @_;
666 return unless $subscriptionid;
668 my $dbh = C4::Context->dbh;
670 # status = 2 is "arrived"
672 $count = 5 unless ($count);
674 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
675 my $query = "SELECT serialid,serialseq, status, publisheddate,
676 publisheddatetext, planneddate,notes, routingnotes
678 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
679 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
680 my $sth = $dbh->prepare($query);
681 $sth->execute($subscriptionid);
683 while ( my $line = $sth->fetchrow_hashref ) {
684 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
685 for my $datefield ( qw( planneddate publisheddate) ) {
686 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
687 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
689 $line->{$datefield} = q{};
692 push @serials, $line;
695 # OK, now add the last 5 issues arrives/missing
696 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
697 publisheddatetext, notes, routingnotes
699 WHERE subscriptionid = ?
700 AND status IN ( $statuses )
701 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
703 $sth = $dbh->prepare($query);
704 $sth->execute($subscriptionid);
705 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
707 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
708 for my $datefield ( qw( planneddate publisheddate) ) {
709 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
710 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
712 $line->{$datefield} = q{};
716 push @serials, $line;
719 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
720 $sth = $dbh->prepare($query);
721 $sth->execute($subscriptionid);
722 my ($totalissues) = $sth->fetchrow;
723 return ( $totalissues, @serials );
728 @serials = GetSerials2($subscriptionid,$statuses);
729 this function returns every serial waited for a given subscription
730 as well as the number of issues registered in the database (all types)
731 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
733 $statuses is an arrayref of statuses and is mandatory.
738 my ( $subscription, $statuses ) = @_;
740 return unless ($subscription and @$statuses);
742 my $dbh = C4::Context->dbh;
744 SELECT serialid,serialseq, status, planneddate, publisheddate,
745 publisheddatetext, notes, routingnotes
747 WHERE subscriptionid=?
749 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
751 ORDER BY publisheddate,serialid DESC
753 $debug and warn "GetSerials2 query: $query";
754 my $sth = $dbh->prepare($query);
755 $sth->execute( $subscription, @$statuses );
758 while ( my $line = $sth->fetchrow_hashref ) {
759 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
760 # Format dates for display
761 for my $datefield ( qw( planneddate publisheddate ) ) {
762 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
763 $line->{$datefield} = q{};
766 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
769 push @serials, $line;
774 =head2 GetLatestSerials
776 \@serials = GetLatestSerials($subscriptionid,$limit)
777 get the $limit's latest serials arrived or missing for a given subscription
779 a ref to an array which contains all of the latest serials stored into a hash.
783 sub GetLatestSerials {
784 my ( $subscriptionid, $limit ) = @_;
786 return unless ($subscriptionid and $limit);
788 my $dbh = C4::Context->dbh;
790 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
791 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
793 WHERE subscriptionid = ?
794 AND status IN ($statuses)
795 ORDER BY publisheddate DESC LIMIT 0,$limit
797 my $sth = $dbh->prepare($strsth);
798 $sth->execute($subscriptionid);
800 while ( my $line = $sth->fetchrow_hashref ) {
801 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
802 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
803 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
804 push @serials, $line;
810 =head2 GetPreviousSerialid
812 $serialid = GetPreviousSerialid($subscriptionid, $nth)
813 get the $nth's previous serial for the given subscriptionid
819 sub GetPreviousSerialid {
820 my ( $subscriptionid, $nth ) = @_;
822 my $dbh = C4::Context->dbh;
826 my $strsth = "SELECT serialid
828 WHERE subscriptionid = ?
830 ORDER BY serialid DESC LIMIT $nth,1
832 my $sth = $dbh->prepare($strsth);
833 $sth->execute($subscriptionid);
835 my $line = $sth->fetchrow_hashref;
836 $return = $line->{'serialid'} if ($line);
843 =head2 GetDistributedTo
845 $distributedto=GetDistributedTo($subscriptionid)
846 This function returns the field distributedto for the subscription matching subscriptionid
850 sub GetDistributedTo {
851 my $dbh = C4::Context->dbh;
853 my ($subscriptionid) = @_;
855 return unless ($subscriptionid);
857 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
858 my $sth = $dbh->prepare($query);
859 $sth->execute($subscriptionid);
860 return ($distributedto) = $sth->fetchrow;
866 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
867 $newinnerloop1, $newinnerloop2, $newinnerloop3
868 ) = GetNextSeq( $subscription, $pattern, $planneddate );
870 $subscription is a hashref containing all the attributes of the table
872 $pattern is a hashref containing all the attributes of the table
873 'subscription_numberpatterns'.
874 $planneddate is a date string in iso format.
875 This function get the next issue for the subscription given on input arg
880 my ($subscription, $pattern, $planneddate) = @_;
882 return unless ($subscription and $pattern);
884 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
885 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
888 if ($subscription->{'skip_serialseq'}) {
889 my @irreg = split /;/, $subscription->{'irregularity'};
891 my $irregularities = {};
892 $irregularities->{$_} = 1 foreach(@irreg);
893 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
894 while($irregularities->{$issueno}) {
901 my $numberingmethod = $pattern->{numberingmethod};
903 if ($numberingmethod) {
904 $calculated = $numberingmethod;
905 my $locale = $subscription->{locale};
906 $newlastvalue1 = $subscription->{lastvalue1} || 0;
907 $newlastvalue2 = $subscription->{lastvalue2} || 0;
908 $newlastvalue3 = $subscription->{lastvalue3} || 0;
909 $newinnerloop1 = $subscription->{innerloop1} || 0;
910 $newinnerloop2 = $subscription->{innerloop2} || 0;
911 $newinnerloop3 = $subscription->{innerloop3} || 0;
914 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
917 for(my $i = 0; $i < $count; $i++) {
919 # check if we have to increase the new value.
921 if ($newinnerloop1 >= $pattern->{every1}) {
923 $newlastvalue1 += $pattern->{add1};
925 # reset counter if needed.
926 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
929 # check if we have to increase the new value.
931 if ($newinnerloop2 >= $pattern->{every2}) {
933 $newlastvalue2 += $pattern->{add2};
935 # reset counter if needed.
936 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
939 # check if we have to increase the new value.
941 if ($newinnerloop3 >= $pattern->{every3}) {
943 $newlastvalue3 += $pattern->{add3};
945 # reset counter if needed.
946 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
950 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
951 $calculated =~ s/\{X\}/$newlastvalue1string/g;
954 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
955 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
958 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
959 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
964 $newlastvalue1, $newlastvalue2, $newlastvalue3,
965 $newinnerloop1, $newinnerloop2, $newinnerloop3);
970 $calculated = GetSeq($subscription, $pattern)
971 $subscription is a hashref containing all the attributes of the table 'subscription'
972 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
973 this function transforms {X},{Y},{Z} to 150,0,0 for example.
975 the sequence in string format
980 my ($subscription, $pattern) = @_;
982 return unless ($subscription and $pattern);
984 my $locale = $subscription->{locale};
986 my $calculated = $pattern->{numberingmethod};
988 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
989 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
990 $calculated =~ s/\{X\}/$newlastvalue1/g;
992 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
993 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
994 $calculated =~ s/\{Y\}/$newlastvalue2/g;
996 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
997 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
998 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1002 =head2 GetExpirationDate
1004 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1006 this function return the next expiration date for a subscription given on input args.
1009 the enddate or undef
1013 sub GetExpirationDate {
1014 my ( $subscriptionid, $startdate ) = @_;
1016 return unless ($subscriptionid);
1018 my $dbh = C4::Context->dbh;
1019 my $subscription = GetSubscription($subscriptionid);
1022 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1023 $enddate = $startdate || $subscription->{startdate};
1024 my @date = split( /-/, $enddate );
1026 return if ( scalar(@date) != 3 || not check_date(@date) );
1028 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1029 if ( $frequency and $frequency->{unit} ) {
1032 if ( my $length = $subscription->{numberlength} ) {
1034 #calculate the date of the last issue.
1035 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1036 $enddate = GetNextDate( $subscription, $enddate );
1038 } elsif ( $subscription->{monthlength} ) {
1039 if ( $$subscription{startdate} ) {
1040 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1041 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1043 } elsif ( $subscription->{weeklength} ) {
1044 if ( $$subscription{startdate} ) {
1045 my @date = split( /-/, $subscription->{startdate} );
1046 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1047 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1050 $enddate = $subscription->{enddate};
1054 return $subscription->{enddate};
1058 =head2 CountSubscriptionFromBiblionumber
1060 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1061 this returns a count of the subscriptions for a given biblionumber
1063 the number of subscriptions
1067 sub CountSubscriptionFromBiblionumber {
1068 my ($biblionumber) = @_;
1070 return unless ($biblionumber);
1072 my $dbh = C4::Context->dbh;
1073 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1074 my $sth = $dbh->prepare($query);
1075 $sth->execute($biblionumber);
1076 my $subscriptionsnumber = $sth->fetchrow;
1077 return $subscriptionsnumber;
1080 =head2 ModSubscriptionHistory
1082 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1084 this function modifies the history of a subscription. Put your new values on input arg.
1085 returns the number of rows affected
1089 sub ModSubscriptionHistory {
1090 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1092 return unless ($subscriptionid);
1094 my $dbh = C4::Context->dbh;
1095 my $query = "UPDATE subscriptionhistory
1096 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1097 WHERE subscriptionid=?
1099 my $sth = $dbh->prepare($query);
1100 $receivedlist =~ s/^; // if $receivedlist;
1101 $missinglist =~ s/^; // if $missinglist;
1102 $opacnote =~ s/^; // if $opacnote;
1103 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1107 =head2 ModSerialStatus
1109 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1110 $publisheddatetext, $status, $notes);
1112 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1113 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1117 sub ModSerialStatus {
1118 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1119 $status, $notes) = @_;
1121 return unless ($serialid);
1123 #It is a usual serial
1124 # 1st, get previous status :
1125 my $dbh = C4::Context->dbh;
1126 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1127 FROM serial, subscription
1128 WHERE serial.subscriptionid=subscription.subscriptionid
1130 my $sth = $dbh->prepare($query);
1131 $sth->execute($serialid);
1132 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1133 my $frequency = GetSubscriptionFrequency($periodicity);
1135 # change status & update subscriptionhistory
1137 if ( $status == DELETED ) {
1138 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1143 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1144 planneddate = ?, status = ?, notes = ?
1147 $sth = $dbh->prepare($query);
1148 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1149 $planneddate, $status, $notes, $serialid );
1150 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1151 $sth = $dbh->prepare($query);
1152 $sth->execute($subscriptionid);
1153 my $val = $sth->fetchrow_hashref;
1154 unless ( $val->{manualhistory} ) {
1155 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1156 $sth = $dbh->prepare($query);
1157 $sth->execute($subscriptionid);
1158 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1160 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1161 $recievedlist .= "; $serialseq"
1162 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1165 # in case serial has been previously marked as missing
1166 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1167 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1170 $missinglist .= "; $serialseq"
1171 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1172 $missinglist .= "; not issued $serialseq"
1173 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1175 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1176 $sth = $dbh->prepare($query);
1177 $recievedlist =~ s/^; //;
1178 $missinglist =~ s/^; //;
1179 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1183 # create new expected entry if needed (ie : was "expected" and has changed)
1184 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1185 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1186 my $subscription = GetSubscription($subscriptionid);
1187 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1191 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1192 $newinnerloop1, $newinnerloop2, $newinnerloop3
1194 = GetNextSeq( $subscription, $pattern, $publisheddate );
1196 # next date (calculated from actual date & frequency parameters)
1197 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1198 my $nextpubdate = $nextpublisheddate;
1199 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1200 WHERE subscriptionid = ?";
1201 $sth = $dbh->prepare($query);
1202 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1204 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1206 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1207 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1208 require C4::Letters;
1209 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1216 =head2 GetNextExpected
1218 $nextexpected = GetNextExpected($subscriptionid)
1220 Get the planneddate for the current expected issue of the subscription.
1226 planneddate => ISO date
1231 sub GetNextExpected {
1232 my ($subscriptionid) = @_;
1234 my $dbh = C4::Context->dbh;
1238 WHERE subscriptionid = ?
1242 my $sth = $dbh->prepare($query);
1244 # Each subscription has only one 'expected' issue.
1245 $sth->execute( $subscriptionid, EXPECTED );
1246 my $nextissue = $sth->fetchrow_hashref;
1247 if ( !$nextissue ) {
1251 WHERE subscriptionid = ?
1252 ORDER BY publisheddate DESC
1255 $sth = $dbh->prepare($query);
1256 $sth->execute($subscriptionid);
1257 $nextissue = $sth->fetchrow_hashref;
1259 foreach(qw/planneddate publisheddate/) {
1260 if ( !defined $nextissue->{$_} ) {
1261 # or should this default to 1st Jan ???
1262 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1264 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1272 =head2 ModNextExpected
1274 ModNextExpected($subscriptionid,$date)
1276 Update the planneddate for the current expected issue of the subscription.
1277 This will modify all future prediction results.
1279 C<$date> is an ISO date.
1285 sub ModNextExpected {
1286 my ( $subscriptionid, $date ) = @_;
1287 my $dbh = C4::Context->dbh;
1289 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1290 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1292 # Each subscription has only one 'expected' issue.
1293 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1298 =head2 GetSubscriptionIrregularities
1302 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1303 get the list of irregularities for a subscription
1309 sub GetSubscriptionIrregularities {
1310 my $subscriptionid = shift;
1312 return unless $subscriptionid;
1314 my $dbh = C4::Context->dbh;
1318 WHERE subscriptionid = ?
1320 my $sth = $dbh->prepare($query);
1321 $sth->execute($subscriptionid);
1323 my ($result) = $sth->fetchrow_array;
1324 my @irreg = split /;/, $result;
1329 =head2 ModSubscription
1331 this function modifies a subscription. Put all new values on input args.
1332 returns the number of rows affected
1336 sub ModSubscription {
1338 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1339 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1340 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1341 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1342 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1343 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1344 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1345 $itemtype, $previousitemtype
1348 my $dbh = C4::Context->dbh;
1349 my $query = "UPDATE subscription
1350 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1351 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1352 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1353 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1354 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1355 callnumber=?, notes=?, letter=?, manualhistory=?,
1356 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1357 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1358 skip_serialseq=?, itemtype=?, previousitemtype=?
1359 WHERE subscriptionid = ?";
1361 my $sth = $dbh->prepare($query);
1363 $auser, $branchcode, $aqbooksellerid, $cost,
1364 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1365 $irregularity, $numberpattern, $locale, $numberlength,
1366 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1367 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1368 $status, $biblionumber, $callnumber, $notes,
1369 $letter, ($manualhistory ? $manualhistory : 0),
1370 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1371 $graceperiod, $location, $enddate, $skip_serialseq,
1372 $itemtype, $previousitemtype,
1375 my $rows = $sth->rows;
1377 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1381 =head2 NewSubscription
1383 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1384 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1385 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1386 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1387 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1388 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1389 $skip_serialseq, $itemtype, $previousitemtype);
1391 Create a new subscription with value given on input args.
1394 the id of this new subscription
1398 sub NewSubscription {
1400 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1401 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1402 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1403 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1404 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1405 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1406 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1408 my $dbh = C4::Context->dbh;
1410 #save subscription (insert into database)
1412 INSERT INTO subscription
1413 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1414 biblionumber, startdate, periodicity, numberlength, weeklength,
1415 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1416 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1417 irregularity, numberpattern, locale, callnumber,
1418 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1419 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1420 itemtype, previousitemtype)
1421 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1423 my $sth = $dbh->prepare($query);
1425 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1426 $startdate, $periodicity, $numberlength, $weeklength,
1427 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1428 $lastvalue3, $innerloop3, $status, $notes, $letter,
1429 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1430 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1431 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1432 $itemtype, $previousitemtype
1435 my $subscriptionid = $dbh->{'mysql_insertid'};
1437 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1441 WHERE subscriptionid=?
1443 $sth = $dbh->prepare($query);
1444 $sth->execute( $enddate, $subscriptionid );
1447 # then create the 1st expected number
1449 INSERT INTO subscriptionhistory
1450 (biblionumber, subscriptionid, histstartdate)
1453 $sth = $dbh->prepare($query);
1454 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1456 # reread subscription to get a hash (for calculation of the 1st issue number)
1457 my $subscription = GetSubscription($subscriptionid);
1458 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1460 # calculate issue number
1461 my $serialseq = GetSeq($subscription, $pattern) || q{};
1465 serialseq => $serialseq,
1466 serialseq_x => $subscription->{'lastvalue1'},
1467 serialseq_y => $subscription->{'lastvalue2'},
1468 serialseq_z => $subscription->{'lastvalue3'},
1469 subscriptionid => $subscriptionid,
1470 biblionumber => $biblionumber,
1472 planneddate => $firstacquidate,
1473 publisheddate => $firstacquidate,
1477 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1479 #set serial flag on biblio if not already set.
1480 my $bib = GetBiblio($biblionumber);
1481 if ( $bib and !$bib->{'serial'} ) {
1482 my $record = GetMarcBiblio($biblionumber);
1483 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1485 eval { $record->field($tag)->update( $subf => 1 ); };
1487 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1489 return $subscriptionid;
1492 =head2 ReNewSubscription
1494 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1496 this function renew a subscription with values given on input args.
1500 sub ReNewSubscription {
1501 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1502 my $dbh = C4::Context->dbh;
1503 my $subscription = GetSubscription($subscriptionid);
1507 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1508 WHERE biblio.biblionumber=?
1510 my $sth = $dbh->prepare($query);
1511 $sth->execute( $subscription->{biblionumber} );
1512 my $biblio = $sth->fetchrow_hashref;
1514 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1515 require C4::Suggestions;
1516 C4::Suggestions::NewSuggestion(
1517 { 'suggestedby' => $user,
1518 'title' => $subscription->{bibliotitle},
1519 'author' => $biblio->{author},
1520 'publishercode' => $biblio->{publishercode},
1521 'note' => $biblio->{note},
1522 'biblionumber' => $subscription->{biblionumber}
1527 # renew subscription
1530 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1531 WHERE subscriptionid=?
1533 $sth = $dbh->prepare($query);
1534 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1535 my $enddate = GetExpirationDate($subscriptionid);
1536 $debug && warn "enddate :$enddate";
1540 WHERE subscriptionid=?
1542 $sth = $dbh->prepare($query);
1543 $sth->execute( $enddate, $subscriptionid );
1545 UPDATE subscriptionhistory
1547 WHERE subscriptionid=?
1549 $sth = $dbh->prepare($query);
1550 $sth->execute( $enddate, $subscriptionid );
1552 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1558 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1560 Create a new issue stored on the database.
1561 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1562 returns the serial id
1567 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1568 $publisheddate, $publisheddatetext, $notes ) = @_;
1569 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1571 return unless ($subscriptionid);
1573 my $schema = Koha::Database->new()->schema();
1575 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1577 my $serial = Koha::Serial->new(
1579 serialseq => $serialseq,
1580 serialseq_x => $subscription->lastvalue1(),
1581 serialseq_y => $subscription->lastvalue2(),
1582 serialseq_z => $subscription->lastvalue3(),
1583 subscriptionid => $subscriptionid,
1584 biblionumber => $biblionumber,
1586 planneddate => $planneddate,
1587 publisheddate => $publisheddate,
1588 publisheddatetext => $publisheddatetext,
1593 my $serialid = $serial->id();
1595 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1596 my $missinglist = $subscription_history->missinglist();
1597 my $recievedlist = $subscription_history->recievedlist();
1599 if ( $status == ARRIVED ) {
1600 ### TODO Add a feature that improves recognition and description.
1601 ### As such count (serialseq) i.e. : N18,2(N19),N20
1602 ### Would use substr and index But be careful to previous presence of ()
1603 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1605 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1606 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1609 $recievedlist =~ s/^; //;
1610 $missinglist =~ s/^; //;
1612 $subscription_history->recievedlist($recievedlist);
1613 $subscription_history->missinglist($missinglist);
1614 $subscription_history->store();
1619 =head2 HasSubscriptionStrictlyExpired
1621 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1623 the subscription has stricly expired when today > the end subscription date
1626 1 if true, 0 if false, -1 if the expiration date is not set.
1630 sub HasSubscriptionStrictlyExpired {
1632 # Getting end of subscription date
1633 my ($subscriptionid) = @_;
1635 return unless ($subscriptionid);
1637 my $dbh = C4::Context->dbh;
1638 my $subscription = GetSubscription($subscriptionid);
1639 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1641 # If the expiration date is set
1642 if ( $expirationdate != 0 ) {
1643 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1645 # Getting today's date
1646 my ( $nowyear, $nowmonth, $nowday ) = Today();
1648 # if today's date > expiration date, then the subscription has stricly expired
1649 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1656 # There are some cases where the expiration date is not set
1657 # As we can't determine if the subscription has expired on a date-basis,
1663 =head2 HasSubscriptionExpired
1665 $has_expired = HasSubscriptionExpired($subscriptionid)
1667 the subscription has expired when the next issue to arrive is out of subscription limit.
1670 0 if the subscription has not expired
1671 1 if the subscription has expired
1672 2 if has subscription does not have a valid expiration date set
1676 sub HasSubscriptionExpired {
1677 my ($subscriptionid) = @_;
1679 return unless ($subscriptionid);
1681 my $dbh = C4::Context->dbh;
1682 my $subscription = GetSubscription($subscriptionid);
1683 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1684 if ( $frequency and $frequency->{unit} ) {
1685 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1686 if (!defined $expirationdate) {
1687 $expirationdate = q{};
1690 SELECT max(planneddate)
1692 WHERE subscriptionid=?
1694 my $sth = $dbh->prepare($query);
1695 $sth->execute($subscriptionid);
1696 my ($res) = $sth->fetchrow;
1697 if (!$res || $res=~m/^0000/) {
1700 my @res = split( /-/, $res );
1701 my @endofsubscriptiondate = split( /-/, $expirationdate );
1702 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1704 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1709 if ( $subscription->{'numberlength'} ) {
1710 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1711 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1717 return 0; # Notice that you'll never get here.
1720 =head2 SetDistributedto
1722 SetDistributedto($distributedto,$subscriptionid);
1723 This function update the value of distributedto for a subscription given on input arg.
1727 sub SetDistributedto {
1728 my ( $distributedto, $subscriptionid ) = @_;
1729 my $dbh = C4::Context->dbh;
1733 WHERE subscriptionid=?
1735 my $sth = $dbh->prepare($query);
1736 $sth->execute( $distributedto, $subscriptionid );
1740 =head2 DelSubscription
1742 DelSubscription($subscriptionid)
1743 this function deletes subscription which has $subscriptionid as id.
1747 sub DelSubscription {
1748 my ($subscriptionid) = @_;
1749 my $dbh = C4::Context->dbh;
1750 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1751 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1752 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1754 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1755 foreach my $af (@$afs) {
1756 $af->delete_values({record_id => $subscriptionid});
1759 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1764 DelIssue($serialseq,$subscriptionid)
1765 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1767 returns the number of rows affected
1772 my ($dataissue) = @_;
1773 my $dbh = C4::Context->dbh;
1774 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1779 AND subscriptionid= ?
1781 my $mainsth = $dbh->prepare($query);
1782 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1784 #Delete element from subscription history
1785 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1786 my $sth = $dbh->prepare($query);
1787 $sth->execute( $dataissue->{'subscriptionid'} );
1788 my $val = $sth->fetchrow_hashref;
1789 unless ( $val->{manualhistory} ) {
1791 SELECT * FROM subscriptionhistory
1792 WHERE subscriptionid= ?
1794 my $sth = $dbh->prepare($query);
1795 $sth->execute( $dataissue->{'subscriptionid'} );
1796 my $data = $sth->fetchrow_hashref;
1797 my $serialseq = $dataissue->{'serialseq'};
1798 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1799 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1800 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1801 $sth = $dbh->prepare($strsth);
1802 $sth->execute( $dataissue->{'subscriptionid'} );
1805 return $mainsth->rows;
1808 =head2 GetLateOrMissingIssues
1810 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1812 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1815 the issuelist as an array of hash refs. Each element of this array contains
1816 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1820 sub GetLateOrMissingIssues {
1821 my ( $supplierid, $serialid, $order ) = @_;
1823 return unless ( $supplierid or $serialid );
1825 my $dbh = C4::Context->dbh;
1830 $byserial = "and serialid = " . $serialid;
1833 $order .= ", title";
1837 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1839 $sth = $dbh->prepare(
1841 serialid, aqbooksellerid, name,
1842 biblio.title, biblioitems.issn, planneddate, serialseq,
1843 serial.status, serial.subscriptionid, claimdate, claims_count,
1844 subscription.branchcode
1846 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1847 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1848 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1849 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1850 WHERE subscription.subscriptionid = serial.subscriptionid
1851 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1852 AND subscription.aqbooksellerid=$supplierid
1857 $sth = $dbh->prepare(
1859 serialid, aqbooksellerid, name,
1860 biblio.title, planneddate, serialseq,
1861 serial.status, serial.subscriptionid, claimdate, claims_count,
1862 subscription.branchcode
1864 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1865 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1866 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1867 WHERE subscription.subscriptionid = serial.subscriptionid
1868 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1873 $sth->execute( EXPECTED, LATE, CLAIMED );
1875 while ( my $line = $sth->fetchrow_hashref ) {
1877 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1878 $line->{planneddateISO} = $line->{planneddate};
1879 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1881 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1882 $line->{claimdateISO} = $line->{claimdate};
1883 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1885 $line->{"status".$line->{status}} = 1;
1887 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1888 record_id => $line->{subscriptionid},
1889 tablename => 'subscription'
1891 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1893 push @issuelist, $line;
1900 &updateClaim($serialid)
1902 this function updates the time when a claim is issued for late/missing items
1904 called from claims.pl file
1909 my ($serialids) = @_;
1910 return unless $serialids;
1911 unless ( ref $serialids ) {
1912 $serialids = [ $serialids ];
1914 my $dbh = C4::Context->dbh;
1917 SET claimdate = NOW(),
1918 claims_count = claims_count + 1,
1920 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1921 {}, CLAIMED, @$serialids );
1924 =head2 getsupplierbyserialid
1926 $result = getsupplierbyserialid($serialid)
1928 this function is used to find the supplier id given a serial id
1931 hashref containing serialid, subscriptionid, and aqbooksellerid
1935 sub getsupplierbyserialid {
1936 my ($serialid) = @_;
1937 my $dbh = C4::Context->dbh;
1938 my $sth = $dbh->prepare(
1939 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1941 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1945 $sth->execute($serialid);
1946 my $line = $sth->fetchrow_hashref;
1947 my $result = $line->{'aqbooksellerid'};
1951 =head2 check_routing
1953 $result = &check_routing($subscriptionid)
1955 this function checks to see if a serial has a routing list and returns the count of routingid
1956 used to show either an 'add' or 'edit' link
1961 my ($subscriptionid) = @_;
1963 return unless ($subscriptionid);
1965 my $dbh = C4::Context->dbh;
1966 my $sth = $dbh->prepare(
1967 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1968 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1969 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1972 $sth->execute($subscriptionid);
1973 my $line = $sth->fetchrow_hashref;
1974 my $result = $line->{'routingids'};
1978 =head2 addroutingmember
1980 addroutingmember($borrowernumber,$subscriptionid)
1982 this function takes a borrowernumber and subscriptionid and adds the member to the
1983 routing list for that serial subscription and gives them a rank on the list
1984 of either 1 or highest current rank + 1
1988 sub addroutingmember {
1989 my ( $borrowernumber, $subscriptionid ) = @_;
1991 return unless ($borrowernumber and $subscriptionid);
1994 my $dbh = C4::Context->dbh;
1995 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1996 $sth->execute($subscriptionid);
1997 while ( my $line = $sth->fetchrow_hashref ) {
1998 if ( $line->{'rank'} > 0 ) {
1999 $rank = $line->{'rank'} + 1;
2004 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2005 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2008 =head2 reorder_members
2010 reorder_members($subscriptionid,$routingid,$rank)
2012 this function is used to reorder the routing list
2014 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2015 - it gets all members on list puts their routingid's into an array
2016 - removes the one in the array that is $routingid
2017 - then reinjects $routingid at point indicated by $rank
2018 - then update the database with the routingids in the new order
2022 sub reorder_members {
2023 my ( $subscriptionid, $routingid, $rank ) = @_;
2024 my $dbh = C4::Context->dbh;
2025 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2026 $sth->execute($subscriptionid);
2028 while ( my $line = $sth->fetchrow_hashref ) {
2029 push( @result, $line->{'routingid'} );
2032 # To find the matching index
2034 my $key = -1; # to allow for 0 being a valid response
2035 for ( $i = 0 ; $i < @result ; $i++ ) {
2036 if ( $routingid == $result[$i] ) {
2037 $key = $i; # save the index
2042 # if index exists in array then move it to new position
2043 if ( $key > -1 && $rank > 0 ) {
2044 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2045 my $moving_item = splice( @result, $key, 1 );
2046 splice( @result, $new_rank, 0, $moving_item );
2048 for ( my $j = 0 ; $j < @result ; $j++ ) {
2049 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2055 =head2 delroutingmember
2057 delroutingmember($routingid,$subscriptionid)
2059 this function either deletes one member from routing list if $routingid exists otherwise
2060 deletes all members from the routing list
2064 sub delroutingmember {
2066 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2067 my ( $routingid, $subscriptionid ) = @_;
2068 my $dbh = C4::Context->dbh;
2070 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2071 $sth->execute($routingid);
2072 reorder_members( $subscriptionid, $routingid );
2074 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2075 $sth->execute($subscriptionid);
2080 =head2 getroutinglist
2082 @routinglist = getroutinglist($subscriptionid)
2084 this gets the info from the subscriptionroutinglist for $subscriptionid
2087 the routinglist as an array. Each element of the array contains a hash_ref containing
2088 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2092 sub getroutinglist {
2093 my ($subscriptionid) = @_;
2094 my $dbh = C4::Context->dbh;
2095 my $sth = $dbh->prepare(
2096 'SELECT routingid, borrowernumber, ranking, biblionumber
2098 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2099 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2101 $sth->execute($subscriptionid);
2102 my $routinglist = $sth->fetchall_arrayref({});
2103 return @{$routinglist};
2106 =head2 countissuesfrom
2108 $result = countissuesfrom($subscriptionid,$startdate)
2110 Returns a count of serial rows matching the given subsctiptionid
2111 with published date greater than startdate
2115 sub countissuesfrom {
2116 my ( $subscriptionid, $startdate ) = @_;
2117 my $dbh = C4::Context->dbh;
2121 WHERE subscriptionid=?
2122 AND serial.publisheddate>?
2124 my $sth = $dbh->prepare($query);
2125 $sth->execute( $subscriptionid, $startdate );
2126 my ($countreceived) = $sth->fetchrow;
2127 return $countreceived;
2132 $result = CountIssues($subscriptionid)
2134 Returns a count of serial rows matching the given subsctiptionid
2139 my ($subscriptionid) = @_;
2140 my $dbh = C4::Context->dbh;
2144 WHERE subscriptionid=?
2146 my $sth = $dbh->prepare($query);
2147 $sth->execute($subscriptionid);
2148 my ($countreceived) = $sth->fetchrow;
2149 return $countreceived;
2154 $result = HasItems($subscriptionid)
2156 returns a count of items from serial matching the subscriptionid
2161 my ($subscriptionid) = @_;
2162 my $dbh = C4::Context->dbh;
2164 SELECT COUNT(serialitems.itemnumber)
2166 LEFT JOIN serialitems USING(serialid)
2167 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2169 my $sth=$dbh->prepare($query);
2170 $sth->execute($subscriptionid);
2171 my ($countitems)=$sth->fetchrow_array();
2175 =head2 abouttoexpire
2177 $result = abouttoexpire($subscriptionid)
2179 this function alerts you to the penultimate issue for a serial subscription
2181 returns 1 - if this is the penultimate issue
2187 my ($subscriptionid) = @_;
2188 my $dbh = C4::Context->dbh;
2189 my $subscription = GetSubscription($subscriptionid);
2190 my $per = $subscription->{'periodicity'};
2191 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2192 if ($frequency and $frequency->{unit}){
2194 my $expirationdate = GetExpirationDate($subscriptionid);
2196 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2197 my $nextdate = GetNextDate($subscription, $res);
2199 # only compare dates if both dates exist.
2200 if ($nextdate and $expirationdate) {
2201 if(Date::Calc::Delta_Days(
2202 split( /-/, $nextdate ),
2203 split( /-/, $expirationdate )
2209 } elsif ($subscription->{numberlength}>0) {
2210 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2216 sub in_array { # used in next sub down
2217 my ( $val, @elements ) = @_;
2218 foreach my $elem (@elements) {
2219 if ( $val == $elem ) {
2226 =head2 GetSubscriptionsFromBorrower
2228 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2230 this gets the info from subscriptionroutinglist for each $subscriptionid
2233 a count of the serial subscription routing lists to which a patron belongs,
2234 with the titles of those serial subscriptions as an array. Each element of the array
2235 contains a hash_ref with subscriptionID and title of subscription.
2239 sub GetSubscriptionsFromBorrower {
2240 my ($borrowernumber) = @_;
2241 my $dbh = C4::Context->dbh;
2242 my $sth = $dbh->prepare(
2243 "SELECT subscription.subscriptionid, biblio.title
2245 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2246 JOIN subscriptionroutinglist USING (subscriptionid)
2247 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2250 $sth->execute($borrowernumber);
2253 while ( my $line = $sth->fetchrow_hashref ) {
2255 push( @routinglist, $line );
2257 return ( $count, @routinglist );
2261 =head2 GetFictiveIssueNumber
2263 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2265 Get the position of the issue published at $publisheddate, considering the
2266 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2267 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2268 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2269 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2270 depending on how many rows are in serial table.
2271 The issue number calculation is based on subscription frequency, first acquisition
2272 date, and $publisheddate.
2276 sub GetFictiveIssueNumber {
2277 my ($subscription, $publisheddate) = @_;
2279 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2280 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2284 my ($year, $month, $day) = split /-/, $publisheddate;
2285 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2289 if($unit eq 'day') {
2290 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2291 } elsif($unit eq 'week') {
2292 ($wkno, $year) = Week_of_Year($year, $month, $day);
2293 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2294 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2295 } elsif($unit eq 'month') {
2296 $delta = ($fa_year == $year)
2297 ? ($month - $fa_month)
2298 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2299 } elsif($unit eq 'year') {
2300 $delta = $year - $fa_year;
2302 if($frequency->{'unitsperissue'} == 1) {
2303 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2305 # Assuming issuesperunit == 1
2306 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2312 sub _get_next_date_day {
2313 my ($subscription, $freqdata, $year, $month, $day) = @_;
2315 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2316 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2317 $subscription->{countissuesperunit} = 1;
2319 $subscription->{countissuesperunit}++;
2322 return ($year, $month, $day);
2325 sub _get_next_date_week {
2326 my ($subscription, $freqdata, $year, $month, $day) = @_;
2328 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2329 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2331 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2332 $subscription->{countissuesperunit} = 1;
2333 $wkno += $freqdata->{unitsperissue};
2338 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2339 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2341 # Try to guess the next day of week
2342 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2343 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2344 $subscription->{countissuesperunit}++;
2347 return ($year, $month, $day);
2350 sub _get_next_date_month {
2351 my ($subscription, $freqdata, $year, $month, $day) = @_;
2354 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2356 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2357 $subscription->{countissuesperunit} = 1;
2358 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2359 $freqdata->{unitsperissue});
2360 my $days_in_month = Days_in_Month($year, $month);
2361 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2363 # Try to guess the next day in month
2364 my $days_in_month = Days_in_Month($year, $month);
2365 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2366 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2367 $subscription->{countissuesperunit}++;
2370 return ($year, $month, $day);
2373 sub _get_next_date_year {
2374 my ($subscription, $freqdata, $year, $month, $day) = @_;
2376 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2378 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2379 $subscription->{countissuesperunit} = 1;
2380 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2382 my $days_in_month = Days_in_Month($year, $month);
2383 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2385 # Try to guess the next day in year
2386 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2387 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2388 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2389 $subscription->{countissuesperunit}++;
2392 return ($year, $month, $day);
2397 $resultdate = GetNextDate($publisheddate,$subscription)
2399 this function it takes the publisheddate and will return the next issue's date
2400 and will skip dates if there exists an irregularity.
2401 $publisheddate has to be an ISO date
2402 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2403 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2404 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2405 skipped then the returned date will be 2007-05-10
2408 $resultdate - then next date in the sequence (ISO date)
2410 Return undef if subscription is irregular
2415 my ( $subscription, $publisheddate, $updatecount ) = @_;
2417 return unless $subscription and $publisheddate;
2419 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2421 if ($freqdata->{'unit'}) {
2422 my ( $year, $month, $day ) = split /-/, $publisheddate;
2424 # Process an irregularity Hash
2425 # Suppose that irregularities are stored in a string with this structure
2426 # irreg1;irreg2;irreg3
2427 # where irregX is the number of issue which will not be received
2428 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2430 if ( $subscription->{irregularity} ) {
2431 my @irreg = split /;/, $subscription->{'irregularity'} ;
2432 foreach my $irregularity (@irreg) {
2433 $irregularities{$irregularity} = 1;
2437 # Get the 'fictive' next issue number
2438 # It is used to check if next issue is an irregular issue.
2439 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2441 # Then get the next date
2442 my $unit = lc $freqdata->{'unit'};
2443 if ($unit eq 'day') {
2444 while ($irregularities{$issueno}) {
2445 ($year, $month, $day) = _get_next_date_day($subscription,
2446 $freqdata, $year, $month, $day);
2449 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2450 $year, $month, $day);
2452 elsif ($unit eq 'week') {
2453 while ($irregularities{$issueno}) {
2454 ($year, $month, $day) = _get_next_date_week($subscription,
2455 $freqdata, $year, $month, $day);
2458 ($year, $month, $day) = _get_next_date_week($subscription,
2459 $freqdata, $year, $month, $day);
2461 elsif ($unit eq 'month') {
2462 while ($irregularities{$issueno}) {
2463 ($year, $month, $day) = _get_next_date_month($subscription,
2464 $freqdata, $year, $month, $day);
2467 ($year, $month, $day) = _get_next_date_month($subscription,
2468 $freqdata, $year, $month, $day);
2470 elsif ($unit eq 'year') {
2471 while ($irregularities{$issueno}) {
2472 ($year, $month, $day) = _get_next_date_year($subscription,
2473 $freqdata, $year, $month, $day);
2476 ($year, $month, $day) = _get_next_date_year($subscription,
2477 $freqdata, $year, $month, $day);
2481 my $dbh = C4::Context->dbh;
2484 SET countissuesperunit = ?
2485 WHERE subscriptionid = ?
2487 my $sth = $dbh->prepare($query);
2488 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2491 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2497 $string = &_numeration($value,$num_type,$locale);
2499 _numeration returns the string corresponding to $value in the num_type
2512 my ($value, $num_type, $locale) = @_;
2517 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2518 # 1970-11-01 was a Sunday
2519 $value = $value % 7;
2520 my $dt = DateTime->new(
2526 $string = $num_type =~ /^dayname$/
2527 ? $dt->strftime("%A")
2528 : $dt->strftime("%a");
2529 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2530 $value = $value % 12;
2531 my $dt = DateTime->new(
2533 month => $value + 1,
2536 $string = $num_type =~ /^monthname$/
2537 ? $dt->strftime("%B")
2538 : $dt->strftime("%b");
2539 } elsif ( $num_type =~ /^season$/ ) {
2540 my @seasons= qw( Spring Summer Fall Winter );
2541 $value = $value % 4;
2542 $string = $seasons[$value];
2543 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2544 my @seasonsabrv= qw( Spr Sum Fal Win );
2545 $value = $value % 4;
2546 $string = $seasonsabrv[$value];
2554 =head2 is_barcode_in_use
2556 Returns number of occurrences of the barcode in the items table
2557 Can be used as a boolean test of whether the barcode has
2558 been deployed as yet
2562 sub is_barcode_in_use {
2563 my $barcode = shift;
2564 my $dbh = C4::Context->dbh;
2565 my $occurrences = $dbh->selectall_arrayref(
2566 'SELECT itemnumber from items where barcode = ?',
2571 return @{$occurrences};
2574 =head2 CloseSubscription
2575 Close a subscription given a subscriptionid
2577 sub CloseSubscription {
2578 my ( $subscriptionid ) = @_;
2579 return unless $subscriptionid;
2580 my $dbh = C4::Context->dbh;
2581 my $sth = $dbh->prepare( q{
2584 WHERE subscriptionid = ?
2586 $sth->execute( $subscriptionid );
2588 # Set status = missing when status = stopped
2589 $sth = $dbh->prepare( q{
2592 WHERE subscriptionid = ?
2595 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2598 =head2 ReopenSubscription
2599 Reopen a subscription given a subscriptionid
2601 sub ReopenSubscription {
2602 my ( $subscriptionid ) = @_;
2603 return unless $subscriptionid;
2604 my $dbh = C4::Context->dbh;
2605 my $sth = $dbh->prepare( q{
2608 WHERE subscriptionid = ?
2610 $sth->execute( $subscriptionid );
2612 # Set status = expected when status = stopped
2613 $sth = $dbh->prepare( q{
2616 WHERE subscriptionid = ?
2619 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2622 =head2 subscriptionCurrentlyOnOrder
2624 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2626 Return 1 if subscription is currently on order else 0.
2630 sub subscriptionCurrentlyOnOrder {
2631 my ( $subscriptionid ) = @_;
2632 my $dbh = C4::Context->dbh;
2634 SELECT COUNT(*) FROM aqorders
2635 WHERE subscriptionid = ?
2636 AND datereceived IS NULL
2637 AND datecancellationprinted IS NULL
2639 my $sth = $dbh->prepare( $query );
2640 $sth->execute($subscriptionid);
2641 return $sth->fetchrow_array;
2644 =head2 can_claim_subscription
2646 $can = can_claim_subscription( $subscriptionid[, $userid] );
2648 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2652 sub can_claim_subscription {
2653 my ( $subscription, $userid ) = @_;
2654 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2657 =head2 can_edit_subscription
2659 $can = can_edit_subscription( $subscriptionid[, $userid] );
2661 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2665 sub can_edit_subscription {
2666 my ( $subscription, $userid ) = @_;
2667 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2670 =head2 can_show_subscription
2672 $can = can_show_subscription( $subscriptionid[, $userid] );
2674 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2678 sub can_show_subscription {
2679 my ( $subscription, $userid ) = @_;
2680 return _can_do_on_subscription( $subscription, $userid, '*' );
2683 sub _can_do_on_subscription {
2684 my ( $subscription, $userid, $permission ) = @_;
2685 return 0 unless C4::Context->userenv;
2686 my $flags = C4::Context->userenv->{flags};
2687 $userid ||= C4::Context->userenv->{'id'};
2689 if ( C4::Context->preference('IndependentBranches') ) {
2691 if C4::Context->IsSuperLibrarian()
2693 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2695 C4::Auth::haspermission( $userid,
2696 { serials => $permission } )
2697 and ( not defined $subscription->{branchcode}
2698 or $subscription->{branchcode} eq ''
2699 or $subscription->{branchcode} eq
2700 C4::Context->userenv->{'branch'} )
2705 if C4::Context->IsSuperLibrarian()
2707 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2708 or C4::Auth::haspermission(
2709 $userid, { serials => $permission }
2716 =head2 findSerialsByStatus
2718 @serials = findSerialsByStatus($status, $subscriptionid);
2720 Returns an array of serials matching a given status and subscription id.
2724 sub findSerialsByStatus {
2725 my ( $status, $subscriptionid ) = @_;
2726 my $dbh = C4::Context->dbh;
2727 my $query = q| SELECT * from serial
2729 AND subscriptionid = ?
2731 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2740 Koha Development Team <http://koha-community.org/>