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);
25 use C4::Dates qw(format_date format_date_in_iso);
27 use Date::Calc qw(:all);
28 use POSIX qw(strftime);
30 use C4::Log; # logaction
32 use C4::Serials::Frequency;
33 use C4::Serials::Numberpattern;
34 use Koha::AdditionalField;
36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
44 MISSING_NEVER_RECIEVED => 41,
45 MISSING_SOLD_OUT => 42,
46 MISSING_DAMAGED => 43,
54 use constant MISSING_STATUSES => (
55 MISSING, MISSING_NEVER_RECIEVED,
56 MISSING_SOLD_OUT, MISSING_DAMAGED,
61 $VERSION = 3.07.00.049; # set version for version checking
65 &NewSubscription &ModSubscription &DelSubscription
66 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
68 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
69 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
70 &GetSubscriptionHistoryFromSubscriptionId
72 &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
73 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
74 &ReNewSubscription &GetLateOrMissingIssues
75 &GetSerialInformation &AddItem2Serial
76 &PrepareSerialsData &GetNextExpected &ModNextExpected
78 &UpdateClaimdateIssues
79 &GetSuppliersWithLateIssues &getsupplierbyserialid
80 &GetDistributedTo &SetDistributedTo
81 &getroutinglist &delroutingmember &addroutingmember
83 &check_routing &updateClaim
86 &GetSubscriptionsFromBorrower
87 &subscriptionCurrentlyOnOrder
94 C4::Serials - Serials Module Functions
102 Functions for handling subscriptions, claims routing etc.
107 =head2 GetSuppliersWithLateIssues
109 $supplierlist = GetSuppliersWithLateIssues()
111 this function get all suppliers with late issues.
114 an array_ref of suppliers each entry is a hash_ref containing id and name
115 the array is in name order
119 sub GetSuppliersWithLateIssues {
120 my $dbh = C4::Context->dbh;
121 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
123 SELECT DISTINCT id, name
125 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
126 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
129 (planneddate < now() AND serial.status=1)
130 OR serial.STATUS IN ( $statuses )
132 AND subscription.closed = 0
134 return $dbh->selectall_arrayref($query, { Slice => {} });
137 =head2 GetSubscriptionHistoryFromSubscriptionId
139 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
141 This function returns the subscription history as a hashref
145 sub GetSubscriptionHistoryFromSubscriptionId {
146 my ($subscriptionid) = @_;
148 return unless $subscriptionid;
150 my $dbh = C4::Context->dbh;
153 FROM subscriptionhistory
154 WHERE subscriptionid = ?
156 my $sth = $dbh->prepare($query);
157 $sth->execute($subscriptionid);
158 my $results = $sth->fetchrow_hashref;
164 =head2 GetSerialStatusFromSerialId
166 $sth = GetSerialStatusFromSerialId();
167 this function returns a statement handle
168 After this function, don't forget to execute it by using $sth->execute($serialid)
170 $sth = $dbh->prepare($query).
174 sub GetSerialStatusFromSerialId {
175 my $dbh = C4::Context->dbh;
181 return $dbh->prepare($query);
184 =head2 GetSerialInformation
187 $data = GetSerialInformation($serialid);
188 returns a hash_ref containing :
189 items : items marcrecord (can be an array)
191 subscription table field
192 + information about subscription expiration
196 sub GetSerialInformation {
198 my $dbh = C4::Context->dbh;
200 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
201 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
204 my $rq = $dbh->prepare($query);
205 $rq->execute($serialid);
206 my $data = $rq->fetchrow_hashref;
208 # create item information if we have serialsadditems for this subscription
209 if ( $data->{'serialsadditems'} ) {
210 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
211 $queryitem->execute($serialid);
212 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
214 if ( scalar(@$itemnumbers) > 0 ) {
215 foreach my $itemnum (@$itemnumbers) {
217 #It is ASSUMED that GetMarcItem ALWAYS WORK...
218 #Maybe GetMarcItem should return values on failure
219 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
220 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
221 $itemprocessed->{'itemnumber'} = $itemnum->[0];
222 $itemprocessed->{'itemid'} = $itemnum->[0];
223 $itemprocessed->{'serialid'} = $serialid;
224 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
225 push @{ $data->{'items'} }, $itemprocessed;
228 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
229 $itemprocessed->{'itemid'} = "N$serialid";
230 $itemprocessed->{'serialid'} = $serialid;
231 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
232 $itemprocessed->{'countitems'} = 0;
233 push @{ $data->{'items'} }, $itemprocessed;
236 $data->{ "status" . $data->{'serstatus'} } = 1;
237 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
238 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
239 $data->{cannotedit} = not can_edit_subscription( $data );
243 =head2 AddItem2Serial
245 $rows = AddItem2Serial($serialid,$itemnumber);
246 Adds an itemnumber to Serial record
247 returns the number of rows affected
252 my ( $serialid, $itemnumber ) = @_;
254 return unless ($serialid and $itemnumber);
256 my $dbh = C4::Context->dbh;
257 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
258 $rq->execute( $serialid, $itemnumber );
262 =head2 UpdateClaimdateIssues
264 UpdateClaimdateIssues($serialids,[$date]);
266 Update Claimdate for issues in @$serialids list with date $date
271 sub UpdateClaimdateIssues {
272 my ( $serialids, $date ) = @_;
274 return unless ($serialids);
276 my $dbh = C4::Context->dbh;
277 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
282 claims_count = claims_count + 1
283 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
285 my $rq = $dbh->prepare($query);
286 $rq->execute($date, CLAIMED, @$serialids);
290 =head2 GetSubscription
292 $subs = GetSubscription($subscriptionid)
293 this function returns the subscription which has $subscriptionid as id.
295 a hashref. This hash containts
296 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
300 sub GetSubscription {
301 my ($subscriptionid) = @_;
302 my $dbh = C4::Context->dbh;
304 SELECT subscription.*,
305 subscriptionhistory.*,
306 aqbooksellers.name AS aqbooksellername,
307 biblio.title AS bibliotitle,
308 subscription.biblionumber as bibnum
310 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
311 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
312 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
313 WHERE subscription.subscriptionid = ?
316 $debug and warn "query : $query\nsubsid :$subscriptionid";
317 my $sth = $dbh->prepare($query);
318 $sth->execute($subscriptionid);
319 my $subscription = $sth->fetchrow_hashref;
321 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
323 # Add additional fields to the subscription into a new key "additional_fields"
324 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
325 tablename => 'subscription',
326 record_id => $subscriptionid,
328 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
330 return $subscription;
333 =head2 GetFullSubscription
335 $array_ref = GetFullSubscription($subscriptionid)
336 this function reads the serial table.
340 sub GetFullSubscription {
341 my ($subscriptionid) = @_;
343 return unless ($subscriptionid);
345 my $dbh = C4::Context->dbh;
347 SELECT serial.serialid,
350 serial.publisheddate,
352 serial.notes as notes,
353 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
354 aqbooksellers.name as aqbooksellername,
355 biblio.title as bibliotitle,
356 subscription.branchcode AS branchcode,
357 subscription.subscriptionid AS subscriptionid
359 LEFT JOIN subscription ON
360 (serial.subscriptionid=subscription.subscriptionid )
361 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
362 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
363 WHERE serial.subscriptionid = ?
365 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
366 serial.subscriptionid
368 $debug and warn "GetFullSubscription query: $query";
369 my $sth = $dbh->prepare($query);
370 $sth->execute($subscriptionid);
371 my $subscriptions = $sth->fetchall_arrayref( {} );
372 for my $subscription ( @$subscriptions ) {
373 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
375 return $subscriptions;
378 =head2 PrepareSerialsData
380 $array_ref = PrepareSerialsData($serialinfomation)
381 where serialinformation is a hashref array
385 sub PrepareSerialsData {
388 return unless ($lines);
394 my $aqbooksellername;
398 my $previousnote = "";
400 foreach my $subs (@{$lines}) {
401 for my $datefield ( qw(publisheddate planneddate) ) {
402 # handle 0000-00-00 dates
403 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
404 $subs->{$datefield} = undef;
407 $subs->{ "status" . $subs->{'status'} } = 1;
408 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
409 $subs->{"checked"} = 1;
412 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
413 $year = $subs->{'year'};
417 if ( $tmpresults{$year} ) {
418 push @{ $tmpresults{$year}->{'serials'} }, $subs;
420 $tmpresults{$year} = {
422 'aqbooksellername' => $subs->{'aqbooksellername'},
423 'bibliotitle' => $subs->{'bibliotitle'},
424 'serials' => [$subs],
429 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
430 push @res, $tmpresults{$key};
435 =head2 GetSubscriptionsFromBiblionumber
437 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
438 this function get the subscription list. it reads the subscription table.
440 reference to an array of subscriptions which have the biblionumber given on input arg.
441 each element of this array is a hashref containing
442 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
446 sub GetSubscriptionsFromBiblionumber {
447 my ($biblionumber) = @_;
449 return unless ($biblionumber);
451 my $dbh = C4::Context->dbh;
453 SELECT subscription.*,
455 subscriptionhistory.*,
456 aqbooksellers.name AS aqbooksellername,
457 biblio.title AS bibliotitle
459 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
460 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
461 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
462 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
463 WHERE subscription.biblionumber = ?
465 my $sth = $dbh->prepare($query);
466 $sth->execute($biblionumber);
468 while ( my $subs = $sth->fetchrow_hashref ) {
469 $subs->{startdate} = format_date( $subs->{startdate} );
470 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
471 $subs->{histenddate} = format_date( $subs->{histenddate} );
472 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
473 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
474 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
475 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
476 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
477 $subs->{ "status" . $subs->{'status'} } = 1;
479 if ( $subs->{enddate} eq '0000-00-00' ) {
480 $subs->{enddate} = '';
482 $subs->{enddate} = format_date( $subs->{enddate} );
484 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
485 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
486 $subs->{cannotedit} = not can_edit_subscription( $subs );
492 =head2 GetFullSubscriptionsFromBiblionumber
494 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
495 this function reads the serial table.
499 sub GetFullSubscriptionsFromBiblionumber {
500 my ($biblionumber) = @_;
501 my $dbh = C4::Context->dbh;
503 SELECT serial.serialid,
506 serial.publisheddate,
508 serial.notes as notes,
509 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
510 biblio.title as bibliotitle,
511 subscription.branchcode AS branchcode,
512 subscription.subscriptionid AS subscriptionid
514 LEFT JOIN subscription ON
515 (serial.subscriptionid=subscription.subscriptionid)
516 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
517 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
518 WHERE subscription.biblionumber = ?
520 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
521 serial.subscriptionid
523 my $sth = $dbh->prepare($query);
524 $sth->execute($biblionumber);
525 my $subscriptions = $sth->fetchall_arrayref( {} );
526 for my $subscription ( @$subscriptions ) {
527 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
529 return $subscriptions;
532 =head2 SearchSubscriptions
534 @results = SearchSubscriptions($args);
536 This function returns a list of hashrefs, one for each subscription
537 that meets the conditions specified by the $args hashref.
539 The valid search fields are:
553 The expiration_date search field is special; it specifies the maximum
554 subscription expiration date.
558 sub SearchSubscriptions {
563 subscription.notes AS publicnotes,
564 subscriptionhistory.*,
566 biblio.notes AS biblionotes,
572 LEFT JOIN subscriptionhistory USING(subscriptionid)
573 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
574 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
575 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
579 if( $args->{biblionumber} ) {
580 push @where_strs, "biblio.biblionumber = ?";
581 push @where_args, $args->{biblionumber};
583 if( $args->{title} ){
584 my @words = split / /, $args->{title};
586 foreach my $word (@words) {
587 push @strs, "biblio.title LIKE ?";
588 push @args, "%$word%";
591 push @where_strs, '(' . join (' AND ', @strs) . ')';
592 push @where_args, @args;
596 push @where_strs, "biblioitems.issn LIKE ?";
597 push @where_args, "%$args->{issn}%";
600 push @where_strs, "biblioitems.ean LIKE ?";
601 push @where_args, "%$args->{ean}%";
603 if ( $args->{callnumber} ) {
604 push @where_strs, "subscription.callnumber LIKE ?";
605 push @where_args, "%$args->{callnumber}%";
607 if( $args->{publisher} ){
608 push @where_strs, "biblioitems.publishercode LIKE ?";
609 push @where_args, "%$args->{publisher}%";
611 if( $args->{bookseller} ){
612 push @where_strs, "aqbooksellers.name LIKE ?";
613 push @where_args, "%$args->{bookseller}%";
615 if( $args->{branch} ){
616 push @where_strs, "subscription.branchcode = ?";
617 push @where_args, "$args->{branch}";
619 if ( $args->{location} ) {
620 push @where_strs, "subscription.location = ?";
621 push @where_args, "$args->{location}";
623 if ( $args->{expiration_date} ) {
624 push @where_strs, "subscription.enddate <= ?";
625 push @where_args, "$args->{expiration_date}";
627 if( defined $args->{closed} ){
628 push @where_strs, "subscription.closed = ?";
629 push @where_args, "$args->{closed}";
632 $query .= " WHERE " . join(" AND ", @where_strs);
635 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
637 my $dbh = C4::Context->dbh;
638 my $sth = $dbh->prepare($query);
639 $sth->execute(@where_args);
640 my $results = $sth->fetchall_arrayref( {} );
643 for my $subscription ( @$results ) {
644 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
645 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
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, planneddate,notes, routingnotes
677 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
678 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
679 my $sth = $dbh->prepare($query);
680 $sth->execute($subscriptionid);
682 while ( my $line = $sth->fetchrow_hashref ) {
683 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
684 for my $datefield ( qw( planneddate publisheddate) ) {
685 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
686 $line->{$datefield} = format_date( $line->{$datefield});
688 $line->{$datefield} = q{};
691 push @serials, $line;
694 # OK, now add the last 5 issues arrives/missing
695 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
697 WHERE subscriptionid = ?
698 AND status IN ( $statuses )
699 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
701 $sth = $dbh->prepare($query);
702 $sth->execute($subscriptionid);
703 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
705 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
706 for my $datefield ( qw( planneddate publisheddate) ) {
707 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
708 $line->{$datefield} = format_date( $line->{$datefield});
710 $line->{$datefield} = q{};
714 push @serials, $line;
717 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
718 $sth = $dbh->prepare($query);
719 $sth->execute($subscriptionid);
720 my ($totalissues) = $sth->fetchrow;
721 return ( $totalissues, @serials );
726 @serials = GetSerials2($subscriptionid,$statuses);
727 this function returns every serial waited for a given subscription
728 as well as the number of issues registered in the database (all types)
729 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
731 $statuses is an arrayref of statuses and is mandatory.
736 my ( $subscription, $statuses ) = @_;
738 return unless ($subscription and @$statuses);
740 my $statuses_string = join ',', @$statuses;
742 my $dbh = C4::Context->dbh;
744 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
746 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
747 ORDER BY publisheddate,serialid DESC
749 $debug and warn "GetSerials2 query: $query";
750 my $sth = $dbh->prepare($query);
754 while ( my $line = $sth->fetchrow_hashref ) {
755 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
756 # Format dates for display
757 for my $datefield ( qw( planneddate publisheddate ) ) {
758 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
759 $line->{$datefield} = q{};
762 $line->{$datefield} = format_date( $line->{$datefield} );
765 push @serials, $line;
770 =head2 GetLatestSerials
772 \@serials = GetLatestSerials($subscriptionid,$limit)
773 get the $limit's latest serials arrived or missing for a given subscription
775 a ref to an array which contains all of the latest serials stored into a hash.
779 sub GetLatestSerials {
780 my ( $subscriptionid, $limit ) = @_;
782 return unless ($subscriptionid and $limit);
784 my $dbh = C4::Context->dbh;
786 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
787 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
789 WHERE subscriptionid = ?
790 AND status IN ($statuses)
791 ORDER BY publisheddate DESC LIMIT 0,$limit
793 my $sth = $dbh->prepare($strsth);
794 $sth->execute($subscriptionid);
796 while ( my $line = $sth->fetchrow_hashref ) {
797 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
798 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
799 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
800 push @serials, $line;
806 =head2 GetDistributedTo
808 $distributedto=GetDistributedTo($subscriptionid)
809 This function returns the field distributedto for the subscription matching subscriptionid
813 sub GetDistributedTo {
814 my $dbh = C4::Context->dbh;
816 my ($subscriptionid) = @_;
818 return unless ($subscriptionid);
820 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
821 my $sth = $dbh->prepare($query);
822 $sth->execute($subscriptionid);
823 return ($distributedto) = $sth->fetchrow;
829 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
830 $newinnerloop1, $newinnerloop2, $newinnerloop3
831 ) = GetNextSeq( $subscription, $pattern, $planneddate );
833 $subscription is a hashref containing all the attributes of the table
835 $pattern is a hashref containing all the attributes of the table
836 'subscription_numberpatterns'.
837 $planneddate is a C4::Dates object.
838 This function get the next issue for the subscription given on input arg
843 my ($subscription, $pattern, $planneddate) = @_;
845 return unless ($subscription and $pattern);
847 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
848 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
851 if ($subscription->{'skip_serialseq'}) {
852 my @irreg = split /;/, $subscription->{'irregularity'};
854 my $irregularities = {};
855 $irregularities->{$_} = 1 foreach(@irreg);
856 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
857 while($irregularities->{$issueno}) {
864 my $numberingmethod = $pattern->{numberingmethod};
866 if ($numberingmethod) {
867 $calculated = $numberingmethod;
868 my $locale = $subscription->{locale};
869 $newlastvalue1 = $subscription->{lastvalue1} || 0;
870 $newlastvalue2 = $subscription->{lastvalue2} || 0;
871 $newlastvalue3 = $subscription->{lastvalue3} || 0;
872 $newinnerloop1 = $subscription->{innerloop1} || 0;
873 $newinnerloop2 = $subscription->{innerloop2} || 0;
874 $newinnerloop3 = $subscription->{innerloop3} || 0;
877 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
880 for(my $i = 0; $i < $count; $i++) {
882 # check if we have to increase the new value.
884 if ($newinnerloop1 >= $pattern->{every1}) {
886 $newlastvalue1 += $pattern->{add1};
888 # reset counter if needed.
889 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
892 # check if we have to increase the new value.
894 if ($newinnerloop2 >= $pattern->{every2}) {
896 $newlastvalue2 += $pattern->{add2};
898 # reset counter if needed.
899 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
902 # check if we have to increase the new value.
904 if ($newinnerloop3 >= $pattern->{every3}) {
906 $newlastvalue3 += $pattern->{add3};
908 # reset counter if needed.
909 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
913 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
914 $calculated =~ s/\{X\}/$newlastvalue1string/g;
917 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
918 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
921 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
922 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
927 $newlastvalue1, $newlastvalue2, $newlastvalue3,
928 $newinnerloop1, $newinnerloop2, $newinnerloop3);
933 $calculated = GetSeq($subscription, $pattern)
934 $subscription is a hashref containing all the attributes of the table 'subscription'
935 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
936 this function transforms {X},{Y},{Z} to 150,0,0 for example.
938 the sequence in string format
943 my ($subscription, $pattern) = @_;
945 return unless ($subscription and $pattern);
947 my $locale = $subscription->{locale};
949 my $calculated = $pattern->{numberingmethod};
951 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
952 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
953 $calculated =~ s/\{X\}/$newlastvalue1/g;
955 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
956 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
957 $calculated =~ s/\{Y\}/$newlastvalue2/g;
959 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
960 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
961 $calculated =~ s/\{Z\}/$newlastvalue3/g;
965 =head2 GetExpirationDate
967 $enddate = GetExpirationDate($subscriptionid, [$startdate])
969 this function return the next expiration date for a subscription given on input args.
976 sub GetExpirationDate {
977 my ( $subscriptionid, $startdate ) = @_;
979 return unless ($subscriptionid);
981 my $dbh = C4::Context->dbh;
982 my $subscription = GetSubscription($subscriptionid);
985 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
986 $enddate = $startdate || $subscription->{startdate};
987 my @date = split( /-/, $enddate );
989 return if ( scalar(@date) != 3 || not check_date(@date) );
991 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
992 if ( $frequency and $frequency->{unit} ) {
995 if ( my $length = $subscription->{numberlength} ) {
997 #calculate the date of the last issue.
998 for ( my $i = 1 ; $i <= $length ; $i++ ) {
999 $enddate = GetNextDate( $subscription, $enddate );
1001 } elsif ( $subscription->{monthlength} ) {
1002 if ( $$subscription{startdate} ) {
1003 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1004 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1006 } elsif ( $subscription->{weeklength} ) {
1007 if ( $$subscription{startdate} ) {
1008 my @date = split( /-/, $subscription->{startdate} );
1009 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1010 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1013 $enddate = $subscription->{enddate};
1017 return $subscription->{enddate};
1021 =head2 CountSubscriptionFromBiblionumber
1023 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1024 this returns a count of the subscriptions for a given biblionumber
1026 the number of subscriptions
1030 sub CountSubscriptionFromBiblionumber {
1031 my ($biblionumber) = @_;
1033 return unless ($biblionumber);
1035 my $dbh = C4::Context->dbh;
1036 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1037 my $sth = $dbh->prepare($query);
1038 $sth->execute($biblionumber);
1039 my $subscriptionsnumber = $sth->fetchrow;
1040 return $subscriptionsnumber;
1043 =head2 ModSubscriptionHistory
1045 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1047 this function modifies the history of a subscription. Put your new values on input arg.
1048 returns the number of rows affected
1052 sub ModSubscriptionHistory {
1053 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1055 return unless ($subscriptionid);
1057 my $dbh = C4::Context->dbh;
1058 my $query = "UPDATE subscriptionhistory
1059 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1060 WHERE subscriptionid=?
1062 my $sth = $dbh->prepare($query);
1063 $receivedlist =~ s/^; // if $receivedlist;
1064 $missinglist =~ s/^; // if $missinglist;
1065 $opacnote =~ s/^; // if $opacnote;
1066 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1070 =head2 ModSerialStatus
1072 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1074 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1075 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1079 sub ModSerialStatus {
1080 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1082 return unless ($serialid);
1084 #It is a usual serial
1085 # 1st, get previous status :
1086 my $dbh = C4::Context->dbh;
1087 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1088 FROM serial, subscription
1089 WHERE serial.subscriptionid=subscription.subscriptionid
1091 my $sth = $dbh->prepare($query);
1092 $sth->execute($serialid);
1093 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1094 my $frequency = GetSubscriptionFrequency($periodicity);
1096 # change status & update subscriptionhistory
1098 if ( $status == DELETED ) {
1099 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1102 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1103 $sth = $dbh->prepare($query);
1104 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1105 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1106 $sth = $dbh->prepare($query);
1107 $sth->execute($subscriptionid);
1108 my $val = $sth->fetchrow_hashref;
1109 unless ( $val->{manualhistory} ) {
1110 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1111 $sth = $dbh->prepare($query);
1112 $sth->execute($subscriptionid);
1113 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1115 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1116 $recievedlist .= "; $serialseq"
1117 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1120 # in case serial has been previously marked as missing
1121 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1122 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1125 $missinglist .= "; $serialseq"
1126 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1127 $missinglist .= "; not issued $serialseq"
1128 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1130 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1131 $sth = $dbh->prepare($query);
1132 $recievedlist =~ s/^; //;
1133 $missinglist =~ s/^; //;
1134 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1138 # create new waited entry if needed (ie : was a "waited" and has changed)
1139 if ( $oldstatus == EXPECTED && $status != EXPECTED ) {
1140 my $subscription = GetSubscription($subscriptionid);
1141 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1145 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1146 $newinnerloop1, $newinnerloop2, $newinnerloop3
1148 = GetNextSeq( $subscription, $pattern, $publisheddate );
1150 # next date (calculated from actual date & frequency parameters)
1151 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1152 my $nextpubdate = $nextpublisheddate;
1153 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1154 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1155 WHERE subscriptionid = ?";
1156 $sth = $dbh->prepare($query);
1157 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1159 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1160 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1161 require C4::Letters;
1162 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1169 =head2 GetNextExpected
1171 $nextexpected = GetNextExpected($subscriptionid)
1173 Get the planneddate for the current expected issue of the subscription.
1179 planneddate => ISO date
1184 sub GetNextExpected {
1185 my ($subscriptionid) = @_;
1187 my $dbh = C4::Context->dbh;
1191 WHERE subscriptionid = ?
1195 my $sth = $dbh->prepare($query);
1197 # Each subscription has only one 'expected' issue.
1198 $sth->execute( $subscriptionid, EXPECTED );
1199 my $nextissue = $sth->fetchrow_hashref;
1200 if ( !$nextissue ) {
1204 WHERE subscriptionid = ?
1205 ORDER BY publisheddate DESC
1208 $sth = $dbh->prepare($query);
1209 $sth->execute($subscriptionid);
1210 $nextissue = $sth->fetchrow_hashref;
1212 foreach(qw/planneddate publisheddate/) {
1213 if ( !defined $nextissue->{$_} ) {
1214 # or should this default to 1st Jan ???
1215 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1217 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1225 =head2 ModNextExpected
1227 ModNextExpected($subscriptionid,$date)
1229 Update the planneddate for the current expected issue of the subscription.
1230 This will modify all future prediction results.
1232 C<$date> is an ISO date.
1238 sub ModNextExpected {
1239 my ( $subscriptionid, $date ) = @_;
1240 my $dbh = C4::Context->dbh;
1242 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1243 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1245 # Each subscription has only one 'expected' issue.
1246 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1251 =head2 GetSubscriptionIrregularities
1255 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1256 get the list of irregularities for a subscription
1262 sub GetSubscriptionIrregularities {
1263 my $subscriptionid = shift;
1265 return unless $subscriptionid;
1267 my $dbh = C4::Context->dbh;
1271 WHERE subscriptionid = ?
1273 my $sth = $dbh->prepare($query);
1274 $sth->execute($subscriptionid);
1276 my ($result) = $sth->fetchrow_array;
1277 my @irreg = split /;/, $result;
1282 =head2 ModSubscription
1284 this function modifies a subscription. Put all new values on input args.
1285 returns the number of rows affected
1289 sub ModSubscription {
1291 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1292 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1293 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1294 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1295 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1296 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1297 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1300 my $dbh = C4::Context->dbh;
1301 my $query = "UPDATE subscription
1302 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1303 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1304 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1305 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1306 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1307 callnumber=?, notes=?, letter=?, manualhistory=?,
1308 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1309 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1311 WHERE subscriptionid = ?";
1313 my $sth = $dbh->prepare($query);
1315 $auser, $branchcode, $aqbooksellerid, $cost,
1316 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1317 $irregularity, $numberpattern, $locale, $numberlength,
1318 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1319 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1320 $status, $biblionumber, $callnumber, $notes,
1321 $letter, ($manualhistory ? $manualhistory : 0),
1322 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1323 $graceperiod, $location, $enddate, $skip_serialseq,
1326 my $rows = $sth->rows;
1328 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1332 =head2 NewSubscription
1334 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1335 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1336 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1337 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1338 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1339 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1341 Create a new subscription with value given on input args.
1344 the id of this new subscription
1348 sub NewSubscription {
1350 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1351 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1352 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1353 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1354 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1355 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1356 $location, $enddate, $skip_serialseq
1358 my $dbh = C4::Context->dbh;
1360 #save subscription (insert into database)
1362 INSERT INTO subscription
1363 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1364 biblionumber, startdate, periodicity, numberlength, weeklength,
1365 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1366 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1367 irregularity, numberpattern, locale, callnumber,
1368 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1369 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1370 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1372 my $sth = $dbh->prepare($query);
1374 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1375 $startdate, $periodicity, $numberlength, $weeklength,
1376 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1377 $lastvalue3, $innerloop3, $status, $notes, $letter,
1378 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1379 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1380 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1383 my $subscriptionid = $dbh->{'mysql_insertid'};
1385 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1389 WHERE subscriptionid=?
1391 $sth = $dbh->prepare($query);
1392 $sth->execute( $enddate, $subscriptionid );
1395 # then create the 1st expected number
1397 INSERT INTO subscriptionhistory
1398 (biblionumber, subscriptionid, histstartdate)
1401 $sth = $dbh->prepare($query);
1402 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1404 # reread subscription to get a hash (for calculation of the 1st issue number)
1405 my $subscription = GetSubscription($subscriptionid);
1406 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1408 # calculate issue number
1409 my $serialseq = GetSeq($subscription, $pattern) || q{};
1412 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1413 VALUES (?,?,?,?,?,?)
1415 $sth = $dbh->prepare($query);
1416 $sth->execute( $serialseq, $subscriptionid, $biblionumber, EXPECTED, $firstacquidate, $firstacquidate );
1418 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1420 #set serial flag on biblio if not already set.
1421 my $bib = GetBiblio($biblionumber);
1422 if ( $bib and !$bib->{'serial'} ) {
1423 my $record = GetMarcBiblio($biblionumber);
1424 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1426 eval { $record->field($tag)->update( $subf => 1 ); };
1428 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1430 return $subscriptionid;
1433 =head2 ReNewSubscription
1435 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1437 this function renew a subscription with values given on input args.
1441 sub ReNewSubscription {
1442 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1443 my $dbh = C4::Context->dbh;
1444 my $subscription = GetSubscription($subscriptionid);
1448 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1449 WHERE biblio.biblionumber=?
1451 my $sth = $dbh->prepare($query);
1452 $sth->execute( $subscription->{biblionumber} );
1453 my $biblio = $sth->fetchrow_hashref;
1455 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1456 require C4::Suggestions;
1457 C4::Suggestions::NewSuggestion(
1458 { 'suggestedby' => $user,
1459 'title' => $subscription->{bibliotitle},
1460 'author' => $biblio->{author},
1461 'publishercode' => $biblio->{publishercode},
1462 'note' => $biblio->{note},
1463 'biblionumber' => $subscription->{biblionumber}
1468 # renew subscription
1471 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1472 WHERE subscriptionid=?
1474 $sth = $dbh->prepare($query);
1475 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1476 my $enddate = GetExpirationDate($subscriptionid);
1477 $debug && warn "enddate :$enddate";
1481 WHERE subscriptionid=?
1483 $sth = $dbh->prepare($query);
1484 $sth->execute( $enddate, $subscriptionid );
1486 UPDATE subscriptionhistory
1488 WHERE subscriptionid=?
1490 $sth = $dbh->prepare($query);
1491 $sth->execute( $enddate, $subscriptionid );
1493 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1499 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1501 Create a new issue stored on the database.
1502 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1503 returns the serial id
1508 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1509 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1511 return unless ($subscriptionid);
1513 my $dbh = C4::Context->dbh;
1516 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1517 VALUES (?,?,?,?,?,?,?)
1519 my $sth = $dbh->prepare($query);
1520 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1521 my $serialid = $dbh->{'mysql_insertid'};
1523 SELECT missinglist,recievedlist
1524 FROM subscriptionhistory
1525 WHERE subscriptionid=?
1527 $sth = $dbh->prepare($query);
1528 $sth->execute($subscriptionid);
1529 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1531 if ( $status == ARRIVED ) {
1532 ### TODO Add a feature that improves recognition and description.
1533 ### As such count (serialseq) i.e. : N18,2(N19),N20
1534 ### Would use substr and index But be careful to previous presence of ()
1535 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1537 if ( grep {/^$status$/} ( MISSING_STATUSES ) ) {
1538 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1541 UPDATE subscriptionhistory
1542 SET recievedlist=?, missinglist=?
1543 WHERE subscriptionid=?
1545 $sth = $dbh->prepare($query);
1546 $recievedlist =~ s/^; //;
1547 $missinglist =~ s/^; //;
1548 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1552 =head2 ItemizeSerials
1554 ItemizeSerials($serialid, $info);
1555 $info is a hashref containing barcode branch, itemcallnumber, status, location
1556 $serialid the serialid
1558 1 if the itemize is a succes.
1559 0 and @error otherwise. @error containts the list of errors found.
1563 sub ItemizeSerials {
1564 my ( $serialid, $info ) = @_;
1566 return unless ($serialid);
1568 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1570 my $dbh = C4::Context->dbh;
1576 my $sth = $dbh->prepare($query);
1577 $sth->execute($serialid);
1578 my $data = $sth->fetchrow_hashref;
1579 if ( C4::Context->preference("RoutingSerials") ) {
1581 # check for existing biblioitem relating to serial issue
1582 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1584 for ( my $i = 0 ; $i < $count ; $i++ ) {
1585 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1586 $bibitemno = $results[$i]->{'biblioitemnumber'};
1590 if ( $bibitemno == 0 ) {
1591 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1592 $sth->execute( $data->{'biblionumber'} );
1593 my $biblioitem = $sth->fetchrow_hashref;
1594 $biblioitem->{'volumedate'} = $data->{planneddate};
1595 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1596 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1600 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1601 if ( $info->{barcode} ) {
1603 if ( is_barcode_in_use( $info->{barcode} ) ) {
1604 push @errors, 'barcode_not_unique';
1606 my $marcrecord = MARC::Record->new();
1607 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1608 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1609 $marcrecord->insert_fields_ordered($newField);
1610 if ( $info->{branch} ) {
1611 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1613 #warn "items.homebranch : $tag , $subfield";
1614 if ( $marcrecord->field($tag) ) {
1615 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1617 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1618 $marcrecord->insert_fields_ordered($newField);
1620 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1622 #warn "items.holdingbranch : $tag , $subfield";
1623 if ( $marcrecord->field($tag) ) {
1624 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1626 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1627 $marcrecord->insert_fields_ordered($newField);
1630 if ( $info->{itemcallnumber} ) {
1631 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1633 if ( $marcrecord->field($tag) ) {
1634 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1636 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1637 $marcrecord->insert_fields_ordered($newField);
1640 if ( $info->{notes} ) {
1641 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1643 if ( $marcrecord->field($tag) ) {
1644 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1646 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1647 $marcrecord->insert_fields_ordered($newField);
1650 if ( $info->{location} ) {
1651 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1653 if ( $marcrecord->field($tag) ) {
1654 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1656 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1657 $marcrecord->insert_fields_ordered($newField);
1660 if ( $info->{status} ) {
1661 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1663 if ( $marcrecord->field($tag) ) {
1664 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1666 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1667 $marcrecord->insert_fields_ordered($newField);
1670 if ( C4::Context->preference("RoutingSerials") ) {
1671 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1672 if ( $marcrecord->field($tag) ) {
1673 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1675 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1676 $marcrecord->insert_fields_ordered($newField);
1680 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1683 return ( 0, @errors );
1687 =head2 HasSubscriptionStrictlyExpired
1689 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1691 the subscription has stricly expired when today > the end subscription date
1694 1 if true, 0 if false, -1 if the expiration date is not set.
1698 sub HasSubscriptionStrictlyExpired {
1700 # Getting end of subscription date
1701 my ($subscriptionid) = @_;
1703 return unless ($subscriptionid);
1705 my $dbh = C4::Context->dbh;
1706 my $subscription = GetSubscription($subscriptionid);
1707 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1709 # If the expiration date is set
1710 if ( $expirationdate != 0 ) {
1711 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1713 # Getting today's date
1714 my ( $nowyear, $nowmonth, $nowday ) = Today();
1716 # if today's date > expiration date, then the subscription has stricly expired
1717 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1724 # There are some cases where the expiration date is not set
1725 # As we can't determine if the subscription has expired on a date-basis,
1731 =head2 HasSubscriptionExpired
1733 $has_expired = HasSubscriptionExpired($subscriptionid)
1735 the subscription has expired when the next issue to arrive is out of subscription limit.
1738 0 if the subscription has not expired
1739 1 if the subscription has expired
1740 2 if has subscription does not have a valid expiration date set
1744 sub HasSubscriptionExpired {
1745 my ($subscriptionid) = @_;
1747 return unless ($subscriptionid);
1749 my $dbh = C4::Context->dbh;
1750 my $subscription = GetSubscription($subscriptionid);
1751 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1752 if ( $frequency and $frequency->{unit} ) {
1753 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1754 if (!defined $expirationdate) {
1755 $expirationdate = q{};
1758 SELECT max(planneddate)
1760 WHERE subscriptionid=?
1762 my $sth = $dbh->prepare($query);
1763 $sth->execute($subscriptionid);
1764 my ($res) = $sth->fetchrow;
1765 if (!$res || $res=~m/^0000/) {
1768 my @res = split( /-/, $res );
1769 my @endofsubscriptiondate = split( /-/, $expirationdate );
1770 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1772 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1777 if ( $subscription->{'numberlength'} ) {
1778 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1779 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1785 return 0; # Notice that you'll never get here.
1788 =head2 SetDistributedto
1790 SetDistributedto($distributedto,$subscriptionid);
1791 This function update the value of distributedto for a subscription given on input arg.
1795 sub SetDistributedto {
1796 my ( $distributedto, $subscriptionid ) = @_;
1797 my $dbh = C4::Context->dbh;
1801 WHERE subscriptionid=?
1803 my $sth = $dbh->prepare($query);
1804 $sth->execute( $distributedto, $subscriptionid );
1808 =head2 DelSubscription
1810 DelSubscription($subscriptionid)
1811 this function deletes subscription which has $subscriptionid as id.
1815 sub DelSubscription {
1816 my ($subscriptionid) = @_;
1817 my $dbh = C4::Context->dbh;
1818 $subscriptionid = $dbh->quote($subscriptionid);
1819 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1820 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1821 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1823 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1828 DelIssue($serialseq,$subscriptionid)
1829 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1831 returns the number of rows affected
1836 my ($dataissue) = @_;
1837 my $dbh = C4::Context->dbh;
1838 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1843 AND subscriptionid= ?
1845 my $mainsth = $dbh->prepare($query);
1846 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1848 #Delete element from subscription history
1849 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1850 my $sth = $dbh->prepare($query);
1851 $sth->execute( $dataissue->{'subscriptionid'} );
1852 my $val = $sth->fetchrow_hashref;
1853 unless ( $val->{manualhistory} ) {
1855 SELECT * FROM subscriptionhistory
1856 WHERE subscriptionid= ?
1858 my $sth = $dbh->prepare($query);
1859 $sth->execute( $dataissue->{'subscriptionid'} );
1860 my $data = $sth->fetchrow_hashref;
1861 my $serialseq = $dataissue->{'serialseq'};
1862 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1863 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1864 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1865 $sth = $dbh->prepare($strsth);
1866 $sth->execute( $dataissue->{'subscriptionid'} );
1869 return $mainsth->rows;
1872 =head2 GetLateOrMissingIssues
1874 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1876 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1879 the issuelist as an array of hash refs. Each element of this array contains
1880 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1884 sub GetLateOrMissingIssues {
1885 my ( $supplierid, $serialid, $order ) = @_;
1887 return unless ( $supplierid or $serialid );
1889 my $dbh = C4::Context->dbh;
1893 $byserial = "and serialid = " . $serialid;
1896 $order .= ", title";
1900 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1902 $sth = $dbh->prepare(
1904 serialid, aqbooksellerid, name,
1905 biblio.title, biblioitems.issn, planneddate, serialseq,
1906 serial.status, serial.subscriptionid, claimdate, claims_count,
1907 subscription.branchcode
1909 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1910 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1911 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1912 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1913 WHERE subscription.subscriptionid = serial.subscriptionid
1914 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1915 AND subscription.aqbooksellerid=$supplierid
1920 $sth = $dbh->prepare(
1922 serialid, aqbooksellerid, name,
1923 biblio.title, planneddate, serialseq,
1924 serial.status, serial.subscriptionid, claimdate, claims_count,
1925 subscription.branchcode
1927 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1928 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1929 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1930 WHERE subscription.subscriptionid = serial.subscriptionid
1931 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1936 $sth->execute( EXPECTED, LATE, CLAIMED );
1938 while ( my $line = $sth->fetchrow_hashref ) {
1940 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1941 $line->{planneddateISO} = $line->{planneddate};
1942 $line->{planneddate} = format_date( $line->{planneddate} );
1944 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1945 $line->{claimdateISO} = $line->{claimdate};
1946 $line->{claimdate} = format_date( $line->{claimdate} );
1948 $line->{"status".$line->{status}} = 1;
1949 push @issuelist, $line;
1956 &updateClaim($serialid)
1958 this function updates the time when a claim is issued for late/missing items
1960 called from claims.pl file
1965 my ($serialid) = @_;
1966 my $dbh = C4::Context->dbh;
1969 SET claimdate = NOW(),
1970 claims_count = claims_count + 1
1976 =head2 getsupplierbyserialid
1978 $result = getsupplierbyserialid($serialid)
1980 this function is used to find the supplier id given a serial id
1983 hashref containing serialid, subscriptionid, and aqbooksellerid
1987 sub getsupplierbyserialid {
1988 my ($serialid) = @_;
1989 my $dbh = C4::Context->dbh;
1990 my $sth = $dbh->prepare(
1991 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1993 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1997 $sth->execute($serialid);
1998 my $line = $sth->fetchrow_hashref;
1999 my $result = $line->{'aqbooksellerid'};
2003 =head2 check_routing
2005 $result = &check_routing($subscriptionid)
2007 this function checks to see if a serial has a routing list and returns the count of routingid
2008 used to show either an 'add' or 'edit' link
2013 my ($subscriptionid) = @_;
2015 return unless ($subscriptionid);
2017 my $dbh = C4::Context->dbh;
2018 my $sth = $dbh->prepare(
2019 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2020 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2021 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2024 $sth->execute($subscriptionid);
2025 my $line = $sth->fetchrow_hashref;
2026 my $result = $line->{'routingids'};
2030 =head2 addroutingmember
2032 addroutingmember($borrowernumber,$subscriptionid)
2034 this function takes a borrowernumber and subscriptionid and adds the member to the
2035 routing list for that serial subscription and gives them a rank on the list
2036 of either 1 or highest current rank + 1
2040 sub addroutingmember {
2041 my ( $borrowernumber, $subscriptionid ) = @_;
2043 return unless ($borrowernumber and $subscriptionid);
2046 my $dbh = C4::Context->dbh;
2047 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2048 $sth->execute($subscriptionid);
2049 while ( my $line = $sth->fetchrow_hashref ) {
2050 if ( $line->{'rank'} > 0 ) {
2051 $rank = $line->{'rank'} + 1;
2056 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2057 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2060 =head2 reorder_members
2062 reorder_members($subscriptionid,$routingid,$rank)
2064 this function is used to reorder the routing list
2066 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2067 - it gets all members on list puts their routingid's into an array
2068 - removes the one in the array that is $routingid
2069 - then reinjects $routingid at point indicated by $rank
2070 - then update the database with the routingids in the new order
2074 sub reorder_members {
2075 my ( $subscriptionid, $routingid, $rank ) = @_;
2076 my $dbh = C4::Context->dbh;
2077 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2078 $sth->execute($subscriptionid);
2080 while ( my $line = $sth->fetchrow_hashref ) {
2081 push( @result, $line->{'routingid'} );
2084 # To find the matching index
2086 my $key = -1; # to allow for 0 being a valid response
2087 for ( $i = 0 ; $i < @result ; $i++ ) {
2088 if ( $routingid == $result[$i] ) {
2089 $key = $i; # save the index
2094 # if index exists in array then move it to new position
2095 if ( $key > -1 && $rank > 0 ) {
2096 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2097 my $moving_item = splice( @result, $key, 1 );
2098 splice( @result, $new_rank, 0, $moving_item );
2100 for ( my $j = 0 ; $j < @result ; $j++ ) {
2101 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2107 =head2 delroutingmember
2109 delroutingmember($routingid,$subscriptionid)
2111 this function either deletes one member from routing list if $routingid exists otherwise
2112 deletes all members from the routing list
2116 sub delroutingmember {
2118 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2119 my ( $routingid, $subscriptionid ) = @_;
2120 my $dbh = C4::Context->dbh;
2122 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2123 $sth->execute($routingid);
2124 reorder_members( $subscriptionid, $routingid );
2126 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2127 $sth->execute($subscriptionid);
2132 =head2 getroutinglist
2134 @routinglist = getroutinglist($subscriptionid)
2136 this gets the info from the subscriptionroutinglist for $subscriptionid
2139 the routinglist as an array. Each element of the array contains a hash_ref containing
2140 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2144 sub getroutinglist {
2145 my ($subscriptionid) = @_;
2146 my $dbh = C4::Context->dbh;
2147 my $sth = $dbh->prepare(
2148 'SELECT routingid, borrowernumber, ranking, biblionumber
2150 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2151 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2153 $sth->execute($subscriptionid);
2154 my $routinglist = $sth->fetchall_arrayref({});
2155 return @{$routinglist};
2158 =head2 countissuesfrom
2160 $result = countissuesfrom($subscriptionid,$startdate)
2162 Returns a count of serial rows matching the given subsctiptionid
2163 with published date greater than startdate
2167 sub countissuesfrom {
2168 my ( $subscriptionid, $startdate ) = @_;
2169 my $dbh = C4::Context->dbh;
2173 WHERE subscriptionid=?
2174 AND serial.publisheddate>?
2176 my $sth = $dbh->prepare($query);
2177 $sth->execute( $subscriptionid, $startdate );
2178 my ($countreceived) = $sth->fetchrow;
2179 return $countreceived;
2184 $result = CountIssues($subscriptionid)
2186 Returns a count of serial rows matching the given subsctiptionid
2191 my ($subscriptionid) = @_;
2192 my $dbh = C4::Context->dbh;
2196 WHERE subscriptionid=?
2198 my $sth = $dbh->prepare($query);
2199 $sth->execute($subscriptionid);
2200 my ($countreceived) = $sth->fetchrow;
2201 return $countreceived;
2206 $result = HasItems($subscriptionid)
2208 returns a count of items from serial matching the subscriptionid
2213 my ($subscriptionid) = @_;
2214 my $dbh = C4::Context->dbh;
2216 SELECT COUNT(serialitems.itemnumber)
2218 LEFT JOIN serialitems USING(serialid)
2219 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2221 my $sth=$dbh->prepare($query);
2222 $sth->execute($subscriptionid);
2223 my ($countitems)=$sth->fetchrow_array();
2227 =head2 abouttoexpire
2229 $result = abouttoexpire($subscriptionid)
2231 this function alerts you to the penultimate issue for a serial subscription
2233 returns 1 - if this is the penultimate issue
2239 my ($subscriptionid) = @_;
2240 my $dbh = C4::Context->dbh;
2241 my $subscription = GetSubscription($subscriptionid);
2242 my $per = $subscription->{'periodicity'};
2243 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2244 if ($frequency and $frequency->{unit}){
2246 my $expirationdate = GetExpirationDate($subscriptionid);
2248 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2249 my $nextdate = GetNextDate($subscription, $res);
2251 # only compare dates if both dates exist.
2252 if ($nextdate and $expirationdate) {
2253 if(Date::Calc::Delta_Days(
2254 split( /-/, $nextdate ),
2255 split( /-/, $expirationdate )
2261 } elsif ($subscription->{numberlength}>0) {
2262 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2268 sub in_array { # used in next sub down
2269 my ( $val, @elements ) = @_;
2270 foreach my $elem (@elements) {
2271 if ( $val == $elem ) {
2278 =head2 GetSubscriptionsFromBorrower
2280 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2282 this gets the info from subscriptionroutinglist for each $subscriptionid
2285 a count of the serial subscription routing lists to which a patron belongs,
2286 with the titles of those serial subscriptions as an array. Each element of the array
2287 contains a hash_ref with subscriptionID and title of subscription.
2291 sub GetSubscriptionsFromBorrower {
2292 my ($borrowernumber) = @_;
2293 my $dbh = C4::Context->dbh;
2294 my $sth = $dbh->prepare(
2295 "SELECT subscription.subscriptionid, biblio.title
2297 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2298 JOIN subscriptionroutinglist USING (subscriptionid)
2299 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2302 $sth->execute($borrowernumber);
2305 while ( my $line = $sth->fetchrow_hashref ) {
2307 push( @routinglist, $line );
2309 return ( $count, @routinglist );
2313 =head2 GetFictiveIssueNumber
2315 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2317 Get the position of the issue published at $publisheddate, considering the
2318 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2319 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2320 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2321 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2322 depending on how many rows are in serial table.
2323 The issue number calculation is based on subscription frequency, first acquisition
2324 date, and $publisheddate.
2328 sub GetFictiveIssueNumber {
2329 my ($subscription, $publisheddate) = @_;
2331 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2332 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2336 my ($year, $month, $day) = split /-/, $publisheddate;
2337 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2341 if($unit eq 'day') {
2342 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2343 } elsif($unit eq 'week') {
2344 ($wkno, $year) = Week_of_Year($year, $month, $day);
2345 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2346 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2347 } elsif($unit eq 'month') {
2348 $delta = ($fa_year == $year)
2349 ? ($month - $fa_month)
2350 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2351 } elsif($unit eq 'year') {
2352 $delta = $year - $fa_year;
2354 if($frequency->{'unitsperissue'} == 1) {
2355 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2357 # Assuming issuesperunit == 1
2358 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2364 sub _get_next_date_day {
2365 my ($subscription, $freqdata, $year, $month, $day) = @_;
2367 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2368 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2369 $subscription->{countissuesperunit} = 1;
2371 $subscription->{countissuesperunit}++;
2374 return ($year, $month, $day);
2377 sub _get_next_date_week {
2378 my ($subscription, $freqdata, $year, $month, $day) = @_;
2380 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2381 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2383 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2384 $subscription->{countissuesperunit} = 1;
2385 $wkno += $freqdata->{unitsperissue};
2390 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2391 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2393 # Try to guess the next day of week
2394 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2395 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2396 $subscription->{countissuesperunit}++;
2399 return ($year, $month, $day);
2402 sub _get_next_date_month {
2403 my ($subscription, $freqdata, $year, $month, $day) = @_;
2406 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2408 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2409 $subscription->{countissuesperunit} = 1;
2410 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2411 $freqdata->{unitsperissue});
2412 my $days_in_month = Days_in_Month($year, $month);
2413 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2415 # Try to guess the next day in month
2416 my $days_in_month = Days_in_Month($year, $month);
2417 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2418 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2419 $subscription->{countissuesperunit}++;
2422 return ($year, $month, $day);
2425 sub _get_next_date_year {
2426 my ($subscription, $freqdata, $year, $month, $day) = @_;
2428 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2430 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2431 $subscription->{countissuesperunit} = 1;
2432 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2434 my $days_in_month = Days_in_Month($year, $month);
2435 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2437 # Try to guess the next day in year
2438 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2439 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2440 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2441 $subscription->{countissuesperunit}++;
2444 return ($year, $month, $day);
2449 $resultdate = GetNextDate($publisheddate,$subscription)
2451 this function it takes the publisheddate and will return the next issue's date
2452 and will skip dates if there exists an irregularity.
2453 $publisheddate has to be an ISO date
2454 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2455 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2456 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2457 skipped then the returned date will be 2007-05-10
2460 $resultdate - then next date in the sequence (ISO date)
2462 Return undef if subscription is irregular
2467 my ( $subscription, $publisheddate, $updatecount ) = @_;
2469 return unless $subscription and $publisheddate;
2471 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2473 if ($freqdata->{'unit'}) {
2474 my ( $year, $month, $day ) = split /-/, $publisheddate;
2476 # Process an irregularity Hash
2477 # Suppose that irregularities are stored in a string with this structure
2478 # irreg1;irreg2;irreg3
2479 # where irregX is the number of issue which will not be received
2480 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2482 if ( $subscription->{irregularity} ) {
2483 my @irreg = split /;/, $subscription->{'irregularity'} ;
2484 foreach my $irregularity (@irreg) {
2485 $irregularities{$irregularity} = 1;
2489 # Get the 'fictive' next issue number
2490 # It is used to check if next issue is an irregular issue.
2491 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2493 # Then get the next date
2494 my $unit = lc $freqdata->{'unit'};
2495 if ($unit eq 'day') {
2496 while ($irregularities{$issueno}) {
2497 ($year, $month, $day) = _get_next_date_day($subscription,
2498 $freqdata, $year, $month, $day);
2501 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2502 $year, $month, $day);
2504 elsif ($unit eq 'week') {
2505 while ($irregularities{$issueno}) {
2506 ($year, $month, $day) = _get_next_date_week($subscription,
2507 $freqdata, $year, $month, $day);
2510 ($year, $month, $day) = _get_next_date_week($subscription,
2511 $freqdata, $year, $month, $day);
2513 elsif ($unit eq 'month') {
2514 while ($irregularities{$issueno}) {
2515 ($year, $month, $day) = _get_next_date_month($subscription,
2516 $freqdata, $year, $month, $day);
2519 ($year, $month, $day) = _get_next_date_month($subscription,
2520 $freqdata, $year, $month, $day);
2522 elsif ($unit eq 'year') {
2523 while ($irregularities{$issueno}) {
2524 ($year, $month, $day) = _get_next_date_year($subscription,
2525 $freqdata, $year, $month, $day);
2528 ($year, $month, $day) = _get_next_date_year($subscription,
2529 $freqdata, $year, $month, $day);
2533 my $dbh = C4::Context->dbh;
2536 SET countissuesperunit = ?
2537 WHERE subscriptionid = ?
2539 my $sth = $dbh->prepare($query);
2540 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2543 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2549 $string = &_numeration($value,$num_type,$locale);
2551 _numeration returns the string corresponding to $value in the num_type
2561 my ($value, $num_type, $locale) = @_;
2566 if ( $num_type =~ /^dayname$/ ) {
2567 # 1970-11-01 was a Sunday
2568 $value = $value % 7;
2569 my $dt = DateTime->new(
2575 $string = $dt->strftime("%A");
2576 } elsif ( $num_type =~ /^monthname$/ ) {
2577 $value = $value % 12;
2578 my $dt = DateTime->new(
2580 month => $value + 1,
2583 $string = $dt->strftime("%B");
2584 } elsif ( $num_type =~ /^season$/ ) {
2585 my @seasons= qw( Spring Summer Fall Winter );
2586 $value = $value % 4;
2587 $string = $seasons[$value];
2595 =head2 is_barcode_in_use
2597 Returns number of occurrences of the barcode in the items table
2598 Can be used as a boolean test of whether the barcode has
2599 been deployed as yet
2603 sub is_barcode_in_use {
2604 my $barcode = shift;
2605 my $dbh = C4::Context->dbh;
2606 my $occurrences = $dbh->selectall_arrayref(
2607 'SELECT itemnumber from items where barcode = ?',
2612 return @{$occurrences};
2615 =head2 CloseSubscription
2616 Close a subscription given a subscriptionid
2618 sub CloseSubscription {
2619 my ( $subscriptionid ) = @_;
2620 return unless $subscriptionid;
2621 my $dbh = C4::Context->dbh;
2622 my $sth = $dbh->prepare( q{
2625 WHERE subscriptionid = ?
2627 $sth->execute( $subscriptionid );
2629 # Set status = missing when status = stopped
2630 $sth = $dbh->prepare( q{
2633 WHERE subscriptionid = ?
2636 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2639 =head2 ReopenSubscription
2640 Reopen a subscription given a subscriptionid
2642 sub ReopenSubscription {
2643 my ( $subscriptionid ) = @_;
2644 return unless $subscriptionid;
2645 my $dbh = C4::Context->dbh;
2646 my $sth = $dbh->prepare( q{
2649 WHERE subscriptionid = ?
2651 $sth->execute( $subscriptionid );
2653 # Set status = expected when status = stopped
2654 $sth = $dbh->prepare( q{
2657 WHERE subscriptionid = ?
2660 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2663 =head2 subscriptionCurrentlyOnOrder
2665 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2667 Return 1 if subscription is currently on order else 0.
2671 sub subscriptionCurrentlyOnOrder {
2672 my ( $subscriptionid ) = @_;
2673 my $dbh = C4::Context->dbh;
2675 SELECT COUNT(*) FROM aqorders
2676 WHERE subscriptionid = ?
2677 AND datereceived IS NULL
2678 AND datecancellationprinted IS NULL
2680 my $sth = $dbh->prepare( $query );
2681 $sth->execute($subscriptionid);
2682 return $sth->fetchrow_array;
2685 =head2 can_edit_subscription
2687 $can = can_edit_subscription( $subscriptionid[, $userid] );
2689 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2693 sub can_edit_subscription {
2694 my ( $subscription, $userid ) = @_;
2695 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2698 =head2 can_show_subscription
2700 $can = can_show_subscription( $subscriptionid[, $userid] );
2702 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2706 sub can_show_subscription {
2707 my ( $subscription, $userid ) = @_;
2708 return _can_do_on_subscription( $subscription, $userid, '*' );
2711 sub _can_do_on_subscription {
2712 my ( $subscription, $userid, $permission ) = @_;
2713 return 0 unless C4::Context->userenv;
2714 my $flags = C4::Context->userenv->{flags};
2715 $userid ||= C4::Context->userenv->{'id'};
2717 if ( C4::Context->preference('IndependentBranches') ) {
2719 if C4::Context->IsSuperLibrarian()
2721 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2723 C4::Auth::haspermission( $userid,
2724 { serials => $permission } )
2725 and ( not defined $subscription->{branchcode}
2726 or $subscription->{branchcode} eq ''
2727 or $subscription->{branchcode} eq
2728 C4::Context->userenv->{'branch'} )
2733 if C4::Context->IsSuperLibrarian()
2735 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2736 or C4::Auth::haspermission(
2737 $userid, { serials => $permission }
2749 Koha Development Team <http://koha-community.org/>