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;
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
38 $VERSION = 3.07.00.049; # set version for version checking
42 &NewSubscription &ModSubscription &DelSubscription
43 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
45 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
46 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
47 &GetSubscriptionHistoryFromSubscriptionId
49 &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
50 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
51 &ReNewSubscription &GetLateOrMissingIssues
52 &GetSerialInformation &AddItem2Serial
53 &PrepareSerialsData &GetNextExpected &ModNextExpected
55 &UpdateClaimdateIssues
56 &GetSuppliersWithLateIssues &getsupplierbyserialid
57 &GetDistributedTo &SetDistributedTo
58 &getroutinglist &delroutingmember &addroutingmember
60 &check_routing &updateClaim &removeMissingIssue
63 &GetSubscriptionsFromBorrower
64 &subscriptionCurrentlyOnOrder
71 C4::Serials - Serials Module Functions
79 Functions for handling subscriptions, claims routing etc.
84 =head2 GetSuppliersWithLateIssues
86 $supplierlist = GetSuppliersWithLateIssues()
88 this function get all suppliers with late issues.
91 an array_ref of suppliers each entry is a hash_ref containing id and name
92 the array is in name order
96 sub GetSuppliersWithLateIssues {
97 my $dbh = C4::Context->dbh;
99 SELECT DISTINCT id, name
101 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
102 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
105 (planneddate < now() AND serial.status=1)
106 OR serial.STATUS IN (3, 4, 41, 42, 43, 44, 7)
108 AND subscription.closed = 0
110 return $dbh->selectall_arrayref($query, { Slice => {} });
113 =head2 GetSubscriptionHistoryFromSubscriptionId
115 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
117 This function returns the subscription history as a hashref
121 sub GetSubscriptionHistoryFromSubscriptionId {
122 my ($subscriptionid) = @_;
124 return unless $subscriptionid;
126 my $dbh = C4::Context->dbh;
129 FROM subscriptionhistory
130 WHERE subscriptionid = ?
132 my $sth = $dbh->prepare($query);
133 $sth->execute($subscriptionid);
134 my $results = $sth->fetchrow_hashref;
140 =head2 GetSerialStatusFromSerialId
142 $sth = GetSerialStatusFromSerialId();
143 this function returns a statement handle
144 After this function, don't forget to execute it by using $sth->execute($serialid)
146 $sth = $dbh->prepare($query).
150 sub GetSerialStatusFromSerialId {
151 my $dbh = C4::Context->dbh;
157 return $dbh->prepare($query);
160 =head2 GetSerialInformation
163 $data = GetSerialInformation($serialid);
164 returns a hash_ref containing :
165 items : items marcrecord (can be an array)
167 subscription table field
168 + information about subscription expiration
172 sub GetSerialInformation {
174 my $dbh = C4::Context->dbh;
176 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
177 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
180 my $rq = $dbh->prepare($query);
181 $rq->execute($serialid);
182 my $data = $rq->fetchrow_hashref;
184 # create item information if we have serialsadditems for this subscription
185 if ( $data->{'serialsadditems'} ) {
186 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
187 $queryitem->execute($serialid);
188 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
190 if ( scalar(@$itemnumbers) > 0 ) {
191 foreach my $itemnum (@$itemnumbers) {
193 #It is ASSUMED that GetMarcItem ALWAYS WORK...
194 #Maybe GetMarcItem should return values on failure
195 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
196 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
197 $itemprocessed->{'itemnumber'} = $itemnum->[0];
198 $itemprocessed->{'itemid'} = $itemnum->[0];
199 $itemprocessed->{'serialid'} = $serialid;
200 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
201 push @{ $data->{'items'} }, $itemprocessed;
204 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
205 $itemprocessed->{'itemid'} = "N$serialid";
206 $itemprocessed->{'serialid'} = $serialid;
207 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
208 $itemprocessed->{'countitems'} = 0;
209 push @{ $data->{'items'} }, $itemprocessed;
212 $data->{ "status" . $data->{'serstatus'} } = 1;
213 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
214 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
215 $data->{cannotedit} = not can_edit_subscription( $data );
219 =head2 AddItem2Serial
221 $rows = AddItem2Serial($serialid,$itemnumber);
222 Adds an itemnumber to Serial record
223 returns the number of rows affected
228 my ( $serialid, $itemnumber ) = @_;
230 return unless ($serialid and $itemnumber);
232 my $dbh = C4::Context->dbh;
233 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
234 $rq->execute( $serialid, $itemnumber );
238 =head2 UpdateClaimdateIssues
240 UpdateClaimdateIssues($serialids,[$date]);
242 Update Claimdate for issues in @$serialids list with date $date
247 sub UpdateClaimdateIssues {
248 my ( $serialids, $date ) = @_;
250 return unless ($serialids);
252 my $dbh = C4::Context->dbh;
253 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
258 claims_count = claims_count + 1
259 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
261 my $rq = $dbh->prepare($query);
262 $rq->execute($date, @$serialids);
266 =head2 GetSubscription
268 $subs = GetSubscription($subscriptionid)
269 this function returns the subscription which has $subscriptionid as id.
271 a hashref. This hash containts
272 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
276 sub GetSubscription {
277 my ($subscriptionid) = @_;
278 my $dbh = C4::Context->dbh;
280 SELECT subscription.*,
281 subscriptionhistory.*,
282 aqbooksellers.name AS aqbooksellername,
283 biblio.title AS bibliotitle,
284 subscription.biblionumber as bibnum
286 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
287 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
288 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
289 WHERE subscription.subscriptionid = ?
292 $debug and warn "query : $query\nsubsid :$subscriptionid";
293 my $sth = $dbh->prepare($query);
294 $sth->execute($subscriptionid);
295 my $subscription = $sth->fetchrow_hashref;
296 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
297 return $subscription;
300 =head2 GetFullSubscription
302 $array_ref = GetFullSubscription($subscriptionid)
303 this function reads the serial table.
307 sub GetFullSubscription {
308 my ($subscriptionid) = @_;
310 return unless ($subscriptionid);
312 my $dbh = C4::Context->dbh;
314 SELECT serial.serialid,
317 serial.publisheddate,
319 serial.notes as notes,
320 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
321 aqbooksellers.name as aqbooksellername,
322 biblio.title as bibliotitle,
323 subscription.branchcode AS branchcode,
324 subscription.subscriptionid AS subscriptionid
326 LEFT JOIN subscription ON
327 (serial.subscriptionid=subscription.subscriptionid )
328 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
329 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
330 WHERE serial.subscriptionid = ?
332 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
333 serial.subscriptionid
335 $debug and warn "GetFullSubscription query: $query";
336 my $sth = $dbh->prepare($query);
337 $sth->execute($subscriptionid);
338 my $subscriptions = $sth->fetchall_arrayref( {} );
339 for my $subscription ( @$subscriptions ) {
340 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
342 return $subscriptions;
345 =head2 PrepareSerialsData
347 $array_ref = PrepareSerialsData($serialinfomation)
348 where serialinformation is a hashref array
352 sub PrepareSerialsData {
355 return unless ($lines);
361 my $aqbooksellername;
365 my $previousnote = "";
367 foreach my $subs (@{$lines}) {
368 for my $datefield ( qw(publisheddate planneddate) ) {
369 # handle 0000-00-00 dates
370 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
371 $subs->{$datefield} = undef;
374 $subs->{ "status" . $subs->{'status'} } = 1;
375 if ( grep { $_ == $subs->{status} } qw( 1 3 4 41 42 43 44 7 ) ) {
376 $subs->{"checked"} = 1;
379 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
380 $year = $subs->{'year'};
384 if ( $tmpresults{$year} ) {
385 push @{ $tmpresults{$year}->{'serials'} }, $subs;
387 $tmpresults{$year} = {
389 'aqbooksellername' => $subs->{'aqbooksellername'},
390 'bibliotitle' => $subs->{'bibliotitle'},
391 'serials' => [$subs],
396 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
397 push @res, $tmpresults{$key};
402 =head2 GetSubscriptionsFromBiblionumber
404 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
405 this function get the subscription list. it reads the subscription table.
407 reference to an array of subscriptions which have the biblionumber given on input arg.
408 each element of this array is a hashref containing
409 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
413 sub GetSubscriptionsFromBiblionumber {
414 my ($biblionumber) = @_;
416 return unless ($biblionumber);
418 my $dbh = C4::Context->dbh;
420 SELECT subscription.*,
422 subscriptionhistory.*,
423 aqbooksellers.name AS aqbooksellername,
424 biblio.title AS bibliotitle
426 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
427 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
428 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
429 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
430 WHERE subscription.biblionumber = ?
432 my $sth = $dbh->prepare($query);
433 $sth->execute($biblionumber);
435 while ( my $subs = $sth->fetchrow_hashref ) {
436 $subs->{startdate} = format_date( $subs->{startdate} );
437 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
438 $subs->{histenddate} = format_date( $subs->{histenddate} );
439 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
440 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
441 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
442 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
443 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
444 $subs->{ "status" . $subs->{'status'} } = 1;
446 if ( $subs->{enddate} eq '0000-00-00' ) {
447 $subs->{enddate} = '';
449 $subs->{enddate} = format_date( $subs->{enddate} );
451 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
452 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
453 $subs->{cannotedit} = not can_edit_subscription( $subs );
459 =head2 GetFullSubscriptionsFromBiblionumber
461 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
462 this function reads the serial table.
466 sub GetFullSubscriptionsFromBiblionumber {
467 my ($biblionumber) = @_;
468 my $dbh = C4::Context->dbh;
470 SELECT serial.serialid,
473 serial.publisheddate,
475 serial.notes as notes,
476 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
477 biblio.title as bibliotitle,
478 subscription.branchcode AS branchcode,
479 subscription.subscriptionid AS subscriptionid
481 LEFT JOIN subscription ON
482 (serial.subscriptionid=subscription.subscriptionid)
483 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
484 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
485 WHERE subscription.biblionumber = ?
487 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
488 serial.subscriptionid
490 my $sth = $dbh->prepare($query);
491 $sth->execute($biblionumber);
492 my $subscriptions = $sth->fetchall_arrayref( {} );
493 for my $subscription ( @$subscriptions ) {
494 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
496 return $subscriptions;
499 =head2 SearchSubscriptions
501 @results = SearchSubscriptions($args);
503 This function returns a list of hashrefs, one for each subscription
504 that meets the conditions specified by the $args hashref.
506 The valid search fields are:
520 The expiration_date search field is special; it specifies the maximum
521 subscription expiration date.
525 sub SearchSubscriptions {
530 subscription.notes AS publicnotes,
531 subscriptionhistory.*,
533 biblio.notes AS biblionotes,
539 LEFT JOIN subscriptionhistory USING(subscriptionid)
540 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
541 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
542 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
546 if( $args->{biblionumber} ) {
547 push @where_strs, "biblio.biblionumber = ?";
548 push @where_args, $args->{biblionumber};
550 if( $args->{title} ){
551 my @words = split / /, $args->{title};
553 foreach my $word (@words) {
554 push @strs, "biblio.title LIKE ?";
555 push @args, "%$word%";
558 push @where_strs, '(' . join (' AND ', @strs) . ')';
559 push @where_args, @args;
563 push @where_strs, "biblioitems.issn LIKE ?";
564 push @where_args, "%$args->{issn}%";
567 push @where_strs, "biblioitems.ean LIKE ?";
568 push @where_args, "%$args->{ean}%";
570 if ( $args->{callnumber} ) {
571 push @where_strs, "subscription.callnumber LIKE ?";
572 push @where_args, "%$args->{callnumber}%";
574 if( $args->{publisher} ){
575 push @where_strs, "biblioitems.publishercode LIKE ?";
576 push @where_args, "%$args->{publisher}%";
578 if( $args->{bookseller} ){
579 push @where_strs, "aqbooksellers.name LIKE ?";
580 push @where_args, "%$args->{bookseller}%";
582 if( $args->{branch} ){
583 push @where_strs, "subscription.branchcode = ?";
584 push @where_args, "$args->{branch}";
586 if ( $args->{location} ) {
587 push @where_strs, "subscription.location = ?";
588 push @where_args, "$args->{location}";
590 if ( $args->{expiration_date} ) {
591 push @where_strs, "subscription.enddate <= ?";
592 push @where_args, "$args->{expiration_date}";
594 if( defined $args->{closed} ){
595 push @where_strs, "subscription.closed = ?";
596 push @where_args, "$args->{closed}";
599 $query .= " WHERE " . join(" AND ", @where_strs);
602 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
604 my $dbh = C4::Context->dbh;
605 my $sth = $dbh->prepare($query);
606 $sth->execute(@where_args);
607 my $results = $sth->fetchall_arrayref( {} );
610 for my $subscription ( @$results ) {
611 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
612 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
621 ($totalissues,@serials) = GetSerials($subscriptionid);
622 this function gets every serial not arrived for a given subscription
623 as well as the number of issues registered in the database (all types)
624 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
626 FIXME: We should return \@serials.
631 my ( $subscriptionid, $count ) = @_;
633 return unless $subscriptionid;
635 my $dbh = C4::Context->dbh;
637 # status = 2 is "arrived"
639 $count = 5 unless ($count);
641 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
643 WHERE subscriptionid = ? AND status NOT IN (2, 4, 41, 42, 43, 44, 5)
644 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
645 my $sth = $dbh->prepare($query);
646 $sth->execute($subscriptionid);
648 while ( my $line = $sth->fetchrow_hashref ) {
649 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
650 for my $datefield ( qw( planneddate publisheddate) ) {
651 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
652 $line->{$datefield} = format_date( $line->{$datefield});
654 $line->{$datefield} = q{};
657 push @serials, $line;
660 # OK, now add the last 5 issues arrives/missing
661 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
663 WHERE subscriptionid = ?
664 AND (status in (2, 4, 41, 42, 43, 44, 5))
665 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
667 $sth = $dbh->prepare($query);
668 $sth->execute($subscriptionid);
669 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
671 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
672 for my $datefield ( qw( planneddate publisheddate) ) {
673 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
674 $line->{$datefield} = format_date( $line->{$datefield});
676 $line->{$datefield} = q{};
680 push @serials, $line;
683 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
684 $sth = $dbh->prepare($query);
685 $sth->execute($subscriptionid);
686 my ($totalissues) = $sth->fetchrow;
687 return ( $totalissues, @serials );
692 @serials = GetSerials2($subscriptionid,$status);
693 this function returns every serial waited for a given subscription
694 as well as the number of issues registered in the database (all types)
695 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
700 my ( $subscription, $status ) = @_;
702 return unless ($subscription and $status);
704 my $dbh = C4::Context->dbh;
706 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
708 WHERE subscriptionid=$subscription AND status IN ($status)
709 ORDER BY publisheddate,serialid DESC
711 $debug and warn "GetSerials2 query: $query";
712 my $sth = $dbh->prepare($query);
716 while ( my $line = $sth->fetchrow_hashref ) {
717 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
718 # Format dates for display
719 for my $datefield ( qw( planneddate publisheddate ) ) {
720 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
721 $line->{$datefield} = q{};
724 $line->{$datefield} = format_date( $line->{$datefield} );
727 push @serials, $line;
732 =head2 GetLatestSerials
734 \@serials = GetLatestSerials($subscriptionid,$limit)
735 get the $limit's latest serials arrived or missing for a given subscription
737 a ref to an array which contains all of the latest serials stored into a hash.
741 sub GetLatestSerials {
742 my ( $subscriptionid, $limit ) = @_;
744 return unless ($subscriptionid and $limit);
746 my $dbh = C4::Context->dbh;
748 # status = 2 is "arrived"
749 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
751 WHERE subscriptionid = ?
752 AND status IN (2, 4, 41, 42, 43, 44)
753 ORDER BY publisheddate DESC LIMIT 0,$limit
755 my $sth = $dbh->prepare($strsth);
756 $sth->execute($subscriptionid);
758 while ( my $line = $sth->fetchrow_hashref ) {
759 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
760 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
761 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
762 push @serials, $line;
768 =head2 GetDistributedTo
770 $distributedto=GetDistributedTo($subscriptionid)
771 This function returns the field distributedto for the subscription matching subscriptionid
775 sub GetDistributedTo {
776 my $dbh = C4::Context->dbh;
778 my ($subscriptionid) = @_;
780 return unless ($subscriptionid);
782 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
783 my $sth = $dbh->prepare($query);
784 $sth->execute($subscriptionid);
785 return ($distributedto) = $sth->fetchrow;
791 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
792 $newinnerloop1, $newinnerloop2, $newinnerloop3
793 ) = GetNextSeq( $subscription, $pattern, $planneddate );
795 $subscription is a hashref containing all the attributes of the table
797 $pattern is a hashref containing all the attributes of the table
798 'subscription_numberpatterns'.
799 $planneddate is a C4::Dates object.
800 This function get the next issue for the subscription given on input arg
805 my ($subscription, $pattern, $planneddate) = @_;
807 return unless ($subscription and $pattern);
809 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
810 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
813 if ($subscription->{'skip_serialseq'}) {
814 my @irreg = split /;/, $subscription->{'irregularity'};
816 my $irregularities = {};
817 $irregularities->{$_} = 1 foreach(@irreg);
818 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
819 while($irregularities->{$issueno}) {
826 my $numberingmethod = $pattern->{numberingmethod};
828 if ($numberingmethod) {
829 $calculated = $numberingmethod;
830 my $locale = $subscription->{locale};
831 $newlastvalue1 = $subscription->{lastvalue1} || 0;
832 $newlastvalue2 = $subscription->{lastvalue2} || 0;
833 $newlastvalue3 = $subscription->{lastvalue3} || 0;
834 $newinnerloop1 = $subscription->{innerloop1} || 0;
835 $newinnerloop2 = $subscription->{innerloop2} || 0;
836 $newinnerloop3 = $subscription->{innerloop3} || 0;
839 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
842 for(my $i = 0; $i < $count; $i++) {
844 # check if we have to increase the new value.
846 if ($newinnerloop1 >= $pattern->{every1}) {
848 $newlastvalue1 += $pattern->{add1};
850 # reset counter if needed.
851 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
854 # check if we have to increase the new value.
856 if ($newinnerloop2 >= $pattern->{every2}) {
858 $newlastvalue2 += $pattern->{add2};
860 # reset counter if needed.
861 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
864 # check if we have to increase the new value.
866 if ($newinnerloop3 >= $pattern->{every3}) {
868 $newlastvalue3 += $pattern->{add3};
870 # reset counter if needed.
871 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
875 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
876 $calculated =~ s/\{X\}/$newlastvalue1string/g;
879 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
880 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
883 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
884 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
889 $newlastvalue1, $newlastvalue2, $newlastvalue3,
890 $newinnerloop1, $newinnerloop2, $newinnerloop3);
895 $calculated = GetSeq($subscription, $pattern)
896 $subscription is a hashref containing all the attributes of the table 'subscription'
897 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
898 this function transforms {X},{Y},{Z} to 150,0,0 for example.
900 the sequence in string format
905 my ($subscription, $pattern) = @_;
907 return unless ($subscription and $pattern);
909 my $locale = $subscription->{locale};
911 my $calculated = $pattern->{numberingmethod};
913 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
914 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
915 $calculated =~ s/\{X\}/$newlastvalue1/g;
917 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
918 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
919 $calculated =~ s/\{Y\}/$newlastvalue2/g;
921 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
922 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
923 $calculated =~ s/\{Z\}/$newlastvalue3/g;
927 =head2 GetExpirationDate
929 $enddate = GetExpirationDate($subscriptionid, [$startdate])
931 this function return the next expiration date for a subscription given on input args.
938 sub GetExpirationDate {
939 my ( $subscriptionid, $startdate ) = @_;
941 return unless ($subscriptionid);
943 my $dbh = C4::Context->dbh;
944 my $subscription = GetSubscription($subscriptionid);
947 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
948 $enddate = $startdate || $subscription->{startdate};
949 my @date = split( /-/, $enddate );
951 return if ( scalar(@date) != 3 || not check_date(@date) );
953 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
954 if ( $frequency and $frequency->{unit} ) {
957 if ( my $length = $subscription->{numberlength} ) {
959 #calculate the date of the last issue.
960 for ( my $i = 1 ; $i <= $length ; $i++ ) {
961 $enddate = GetNextDate( $subscription, $enddate );
963 } elsif ( $subscription->{monthlength} ) {
964 if ( $$subscription{startdate} ) {
965 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
966 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
968 } elsif ( $subscription->{weeklength} ) {
969 if ( $$subscription{startdate} ) {
970 my @date = split( /-/, $subscription->{startdate} );
971 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
972 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
975 $enddate = $subscription->{enddate};
979 return $subscription->{enddate};
983 =head2 CountSubscriptionFromBiblionumber
985 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
986 this returns a count of the subscriptions for a given biblionumber
988 the number of subscriptions
992 sub CountSubscriptionFromBiblionumber {
993 my ($biblionumber) = @_;
995 return unless ($biblionumber);
997 my $dbh = C4::Context->dbh;
998 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
999 my $sth = $dbh->prepare($query);
1000 $sth->execute($biblionumber);
1001 my $subscriptionsnumber = $sth->fetchrow;
1002 return $subscriptionsnumber;
1005 =head2 ModSubscriptionHistory
1007 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1009 this function modifies the history of a subscription. Put your new values on input arg.
1010 returns the number of rows affected
1014 sub ModSubscriptionHistory {
1015 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1017 return unless ($subscriptionid);
1019 my $dbh = C4::Context->dbh;
1020 my $query = "UPDATE subscriptionhistory
1021 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1022 WHERE subscriptionid=?
1024 my $sth = $dbh->prepare($query);
1025 $receivedlist =~ s/^; // if $receivedlist;
1026 $missinglist =~ s/^; // if $missinglist;
1027 $opacnote =~ s/^; // if $opacnote;
1028 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1032 =head2 ModSerialStatus
1034 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1036 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1037 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1041 sub ModSerialStatus {
1042 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1044 return unless ($serialid);
1046 #It is a usual serial
1047 # 1st, get previous status :
1048 my $dbh = C4::Context->dbh;
1049 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1050 FROM serial, subscription
1051 WHERE serial.subscriptionid=subscription.subscriptionid
1053 my $sth = $dbh->prepare($query);
1054 $sth->execute($serialid);
1055 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1056 my $frequency = GetSubscriptionFrequency($periodicity);
1058 # change status & update subscriptionhistory
1060 if ( $status == 6 ) {
1061 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1064 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1065 $sth = $dbh->prepare($query);
1066 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1067 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1068 $sth = $dbh->prepare($query);
1069 $sth->execute($subscriptionid);
1070 my $val = $sth->fetchrow_hashref;
1071 unless ( $val->{manualhistory} ) {
1072 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1073 $sth = $dbh->prepare($query);
1074 $sth->execute($subscriptionid);
1075 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1077 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1078 $recievedlist .= "; $serialseq"
1079 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1082 # in case serial has been previously marked as missing
1083 if (grep /$status/, (1,2,3,7)) {
1084 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1087 my @missing_statuses = qw( 4 41 42 43 44 );
1088 $missinglist .= "; $serialseq"
1089 if ( ( grep { $_ == $status } @missing_statuses ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1090 $missinglist .= "; not issued $serialseq"
1091 if ( $status == 5 && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1093 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1094 $sth = $dbh->prepare($query);
1095 $recievedlist =~ s/^; //;
1096 $missinglist =~ s/^; //;
1097 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1101 # create new waited entry if needed (ie : was a "waited" and has changed)
1102 if ( $oldstatus == 1 && $status != 1 ) {
1103 my $subscription = GetSubscription($subscriptionid);
1104 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1108 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1109 $newinnerloop1, $newinnerloop2, $newinnerloop3
1111 = GetNextSeq( $subscription, $pattern, $publisheddate );
1113 # next date (calculated from actual date & frequency parameters)
1114 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1115 my $nextpubdate = $nextpublisheddate;
1116 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1117 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1118 WHERE subscriptionid = ?";
1119 $sth = $dbh->prepare($query);
1120 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1122 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1123 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1124 require C4::Letters;
1125 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1132 =head2 GetNextExpected
1134 $nextexpected = GetNextExpected($subscriptionid)
1136 Get the planneddate for the current expected issue of the subscription.
1142 planneddate => ISO date
1147 sub GetNextExpected {
1148 my ($subscriptionid) = @_;
1150 my $dbh = C4::Context->dbh;
1154 WHERE subscriptionid = ?
1158 my $sth = $dbh->prepare($query);
1160 # Each subscription has only one 'expected' issue, with serial.status==1.
1161 $sth->execute( $subscriptionid, 1 );
1162 my $nextissue = $sth->fetchrow_hashref;
1163 if ( !$nextissue ) {
1167 WHERE subscriptionid = ?
1168 ORDER BY publisheddate DESC
1171 $sth = $dbh->prepare($query);
1172 $sth->execute($subscriptionid);
1173 $nextissue = $sth->fetchrow_hashref;
1175 foreach(qw/planneddate publisheddate/) {
1176 if ( !defined $nextissue->{$_} ) {
1177 # or should this default to 1st Jan ???
1178 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1180 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1188 =head2 ModNextExpected
1190 ModNextExpected($subscriptionid,$date)
1192 Update the planneddate for the current expected issue of the subscription.
1193 This will modify all future prediction results.
1195 C<$date> is an ISO date.
1201 sub ModNextExpected {
1202 my ( $subscriptionid, $date ) = @_;
1203 my $dbh = C4::Context->dbh;
1205 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1206 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1208 # Each subscription has only one 'expected' issue, with serial.status==1.
1209 $sth->execute( $date, $date, $subscriptionid, 1 );
1214 =head2 GetSubscriptionIrregularities
1218 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1219 get the list of irregularities for a subscription
1225 sub GetSubscriptionIrregularities {
1226 my $subscriptionid = shift;
1228 return unless $subscriptionid;
1230 my $dbh = C4::Context->dbh;
1234 WHERE subscriptionid = ?
1236 my $sth = $dbh->prepare($query);
1237 $sth->execute($subscriptionid);
1239 my ($result) = $sth->fetchrow_array;
1240 my @irreg = split /;/, $result;
1245 =head2 ModSubscription
1247 this function modifies a subscription. Put all new values on input args.
1248 returns the number of rows affected
1252 sub ModSubscription {
1254 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1255 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1256 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1257 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1258 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1259 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1260 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1263 my $dbh = C4::Context->dbh;
1264 my $query = "UPDATE subscription
1265 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1266 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1267 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1268 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1269 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1270 callnumber=?, notes=?, letter=?, manualhistory=?,
1271 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1272 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1274 WHERE subscriptionid = ?";
1276 my $sth = $dbh->prepare($query);
1278 $auser, $branchcode, $aqbooksellerid, $cost,
1279 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1280 $irregularity, $numberpattern, $locale, $numberlength,
1281 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1282 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1283 $status, $biblionumber, $callnumber, $notes,
1284 $letter, ($manualhistory ? $manualhistory : 0),
1285 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1286 $graceperiod, $location, $enddate, $skip_serialseq,
1289 my $rows = $sth->rows;
1291 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1295 =head2 NewSubscription
1297 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1298 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1299 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1300 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1301 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1302 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1304 Create a new subscription with value given on input args.
1307 the id of this new subscription
1311 sub NewSubscription {
1313 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1314 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1315 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1316 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1317 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1318 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1319 $location, $enddate, $skip_serialseq
1321 my $dbh = C4::Context->dbh;
1323 #save subscription (insert into database)
1325 INSERT INTO subscription
1326 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1327 biblionumber, startdate, periodicity, numberlength, weeklength,
1328 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1329 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1330 irregularity, numberpattern, locale, callnumber,
1331 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1332 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1333 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1335 my $sth = $dbh->prepare($query);
1337 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1338 $startdate, $periodicity, $numberlength, $weeklength,
1339 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1340 $lastvalue3, $innerloop3, $status, $notes, $letter,
1341 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1342 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1343 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1346 my $subscriptionid = $dbh->{'mysql_insertid'};
1348 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1352 WHERE subscriptionid=?
1354 $sth = $dbh->prepare($query);
1355 $sth->execute( $enddate, $subscriptionid );
1358 # then create the 1st expected number
1360 INSERT INTO subscriptionhistory
1361 (biblionumber, subscriptionid, histstartdate)
1364 $sth = $dbh->prepare($query);
1365 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1367 # reread subscription to get a hash (for calculation of the 1st issue number)
1368 my $subscription = GetSubscription($subscriptionid);
1369 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1371 # calculate issue number
1372 my $serialseq = GetSeq($subscription, $pattern) || q{};
1375 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1376 VALUES (?,?,?,?,?,?)
1378 $sth = $dbh->prepare($query);
1379 $sth->execute( $serialseq, $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1381 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1383 #set serial flag on biblio if not already set.
1384 my $bib = GetBiblio($biblionumber);
1385 if ( $bib and !$bib->{'serial'} ) {
1386 my $record = GetMarcBiblio($biblionumber);
1387 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1389 eval { $record->field($tag)->update( $subf => 1 ); };
1391 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1393 return $subscriptionid;
1396 =head2 ReNewSubscription
1398 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1400 this function renew a subscription with values given on input args.
1404 sub ReNewSubscription {
1405 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1406 my $dbh = C4::Context->dbh;
1407 my $subscription = GetSubscription($subscriptionid);
1411 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1412 WHERE biblio.biblionumber=?
1414 my $sth = $dbh->prepare($query);
1415 $sth->execute( $subscription->{biblionumber} );
1416 my $biblio = $sth->fetchrow_hashref;
1418 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1419 require C4::Suggestions;
1420 C4::Suggestions::NewSuggestion(
1421 { 'suggestedby' => $user,
1422 'title' => $subscription->{bibliotitle},
1423 'author' => $biblio->{author},
1424 'publishercode' => $biblio->{publishercode},
1425 'note' => $biblio->{note},
1426 'biblionumber' => $subscription->{biblionumber}
1431 # renew subscription
1434 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1435 WHERE subscriptionid=?
1437 $sth = $dbh->prepare($query);
1438 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1439 my $enddate = GetExpirationDate($subscriptionid);
1440 $debug && warn "enddate :$enddate";
1444 WHERE subscriptionid=?
1446 $sth = $dbh->prepare($query);
1447 $sth->execute( $enddate, $subscriptionid );
1449 UPDATE subscriptionhistory
1451 WHERE subscriptionid=?
1453 $sth = $dbh->prepare($query);
1454 $sth->execute( $enddate, $subscriptionid );
1456 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1462 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1464 Create a new issue stored on the database.
1465 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1466 returns the serial id
1471 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1472 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1474 return unless ($subscriptionid);
1476 my $dbh = C4::Context->dbh;
1479 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1480 VALUES (?,?,?,?,?,?,?)
1482 my $sth = $dbh->prepare($query);
1483 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1484 my $serialid = $dbh->{'mysql_insertid'};
1486 SELECT missinglist,recievedlist
1487 FROM subscriptionhistory
1488 WHERE subscriptionid=?
1490 $sth = $dbh->prepare($query);
1491 $sth->execute($subscriptionid);
1492 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1494 if ( $status == 2 ) {
1495 ### TODO Add a feature that improves recognition and description.
1496 ### As such count (serialseq) i.e. : N18,2(N19),N20
1497 ### Would use substr and index But be careful to previous presence of ()
1498 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1500 if ( $status == 4 ) {
1501 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1504 UPDATE subscriptionhistory
1505 SET recievedlist=?, missinglist=?
1506 WHERE subscriptionid=?
1508 $sth = $dbh->prepare($query);
1509 $recievedlist =~ s/^; //;
1510 $missinglist =~ s/^; //;
1511 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1515 =head2 ItemizeSerials
1517 ItemizeSerials($serialid, $info);
1518 $info is a hashref containing barcode branch, itemcallnumber, status, location
1519 $serialid the serialid
1521 1 if the itemize is a succes.
1522 0 and @error otherwise. @error containts the list of errors found.
1526 sub ItemizeSerials {
1527 my ( $serialid, $info ) = @_;
1529 return unless ($serialid);
1531 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1533 my $dbh = C4::Context->dbh;
1539 my $sth = $dbh->prepare($query);
1540 $sth->execute($serialid);
1541 my $data = $sth->fetchrow_hashref;
1542 if ( C4::Context->preference("RoutingSerials") ) {
1544 # check for existing biblioitem relating to serial issue
1545 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1547 for ( my $i = 0 ; $i < $count ; $i++ ) {
1548 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1549 $bibitemno = $results[$i]->{'biblioitemnumber'};
1553 if ( $bibitemno == 0 ) {
1554 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1555 $sth->execute( $data->{'biblionumber'} );
1556 my $biblioitem = $sth->fetchrow_hashref;
1557 $biblioitem->{'volumedate'} = $data->{planneddate};
1558 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1559 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1563 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1564 if ( $info->{barcode} ) {
1566 if ( is_barcode_in_use( $info->{barcode} ) ) {
1567 push @errors, 'barcode_not_unique';
1569 my $marcrecord = MARC::Record->new();
1570 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1571 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1572 $marcrecord->insert_fields_ordered($newField);
1573 if ( $info->{branch} ) {
1574 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1576 #warn "items.homebranch : $tag , $subfield";
1577 if ( $marcrecord->field($tag) ) {
1578 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1580 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1581 $marcrecord->insert_fields_ordered($newField);
1583 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1585 #warn "items.holdingbranch : $tag , $subfield";
1586 if ( $marcrecord->field($tag) ) {
1587 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1589 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1590 $marcrecord->insert_fields_ordered($newField);
1593 if ( $info->{itemcallnumber} ) {
1594 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1596 if ( $marcrecord->field($tag) ) {
1597 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1599 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1600 $marcrecord->insert_fields_ordered($newField);
1603 if ( $info->{notes} ) {
1604 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1606 if ( $marcrecord->field($tag) ) {
1607 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1609 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1610 $marcrecord->insert_fields_ordered($newField);
1613 if ( $info->{location} ) {
1614 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1616 if ( $marcrecord->field($tag) ) {
1617 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1619 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1620 $marcrecord->insert_fields_ordered($newField);
1623 if ( $info->{status} ) {
1624 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1626 if ( $marcrecord->field($tag) ) {
1627 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1629 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1630 $marcrecord->insert_fields_ordered($newField);
1633 if ( C4::Context->preference("RoutingSerials") ) {
1634 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1635 if ( $marcrecord->field($tag) ) {
1636 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1638 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1639 $marcrecord->insert_fields_ordered($newField);
1643 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1646 return ( 0, @errors );
1650 =head2 HasSubscriptionStrictlyExpired
1652 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1654 the subscription has stricly expired when today > the end subscription date
1657 1 if true, 0 if false, -1 if the expiration date is not set.
1661 sub HasSubscriptionStrictlyExpired {
1663 # Getting end of subscription date
1664 my ($subscriptionid) = @_;
1666 return unless ($subscriptionid);
1668 my $dbh = C4::Context->dbh;
1669 my $subscription = GetSubscription($subscriptionid);
1670 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1672 # If the expiration date is set
1673 if ( $expirationdate != 0 ) {
1674 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1676 # Getting today's date
1677 my ( $nowyear, $nowmonth, $nowday ) = Today();
1679 # if today's date > expiration date, then the subscription has stricly expired
1680 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1687 # There are some cases where the expiration date is not set
1688 # As we can't determine if the subscription has expired on a date-basis,
1694 =head2 HasSubscriptionExpired
1696 $has_expired = HasSubscriptionExpired($subscriptionid)
1698 the subscription has expired when the next issue to arrive is out of subscription limit.
1701 0 if the subscription has not expired
1702 1 if the subscription has expired
1703 2 if has subscription does not have a valid expiration date set
1707 sub HasSubscriptionExpired {
1708 my ($subscriptionid) = @_;
1710 return unless ($subscriptionid);
1712 my $dbh = C4::Context->dbh;
1713 my $subscription = GetSubscription($subscriptionid);
1714 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1715 if ( $frequency and $frequency->{unit} ) {
1716 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1717 if (!defined $expirationdate) {
1718 $expirationdate = q{};
1721 SELECT max(planneddate)
1723 WHERE subscriptionid=?
1725 my $sth = $dbh->prepare($query);
1726 $sth->execute($subscriptionid);
1727 my ($res) = $sth->fetchrow;
1728 if (!$res || $res=~m/^0000/) {
1731 my @res = split( /-/, $res );
1732 my @endofsubscriptiondate = split( /-/, $expirationdate );
1733 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1735 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1740 if ( $subscription->{'numberlength'} ) {
1741 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1742 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1748 return 0; # Notice that you'll never get here.
1751 =head2 SetDistributedto
1753 SetDistributedto($distributedto,$subscriptionid);
1754 This function update the value of distributedto for a subscription given on input arg.
1758 sub SetDistributedto {
1759 my ( $distributedto, $subscriptionid ) = @_;
1760 my $dbh = C4::Context->dbh;
1764 WHERE subscriptionid=?
1766 my $sth = $dbh->prepare($query);
1767 $sth->execute( $distributedto, $subscriptionid );
1771 =head2 DelSubscription
1773 DelSubscription($subscriptionid)
1774 this function deletes subscription which has $subscriptionid as id.
1778 sub DelSubscription {
1779 my ($subscriptionid) = @_;
1780 my $dbh = C4::Context->dbh;
1781 $subscriptionid = $dbh->quote($subscriptionid);
1782 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1783 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1784 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1786 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1791 DelIssue($serialseq,$subscriptionid)
1792 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1794 returns the number of rows affected
1799 my ($dataissue) = @_;
1800 my $dbh = C4::Context->dbh;
1801 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1806 AND subscriptionid= ?
1808 my $mainsth = $dbh->prepare($query);
1809 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1811 #Delete element from subscription history
1812 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1813 my $sth = $dbh->prepare($query);
1814 $sth->execute( $dataissue->{'subscriptionid'} );
1815 my $val = $sth->fetchrow_hashref;
1816 unless ( $val->{manualhistory} ) {
1818 SELECT * FROM subscriptionhistory
1819 WHERE subscriptionid= ?
1821 my $sth = $dbh->prepare($query);
1822 $sth->execute( $dataissue->{'subscriptionid'} );
1823 my $data = $sth->fetchrow_hashref;
1824 my $serialseq = $dataissue->{'serialseq'};
1825 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1826 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1827 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1828 $sth = $dbh->prepare($strsth);
1829 $sth->execute( $dataissue->{'subscriptionid'} );
1832 return $mainsth->rows;
1835 =head2 GetLateOrMissingIssues
1837 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1839 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1842 the issuelist as an array of hash refs. Each element of this array contains
1843 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1847 sub GetLateOrMissingIssues {
1848 my ( $supplierid, $serialid, $order ) = @_;
1850 return unless ( $supplierid or $serialid );
1852 my $dbh = C4::Context->dbh;
1856 $byserial = "and serialid = " . $serialid;
1859 $order .= ", title";
1864 $sth = $dbh->prepare(
1866 serialid, aqbooksellerid, name,
1867 biblio.title, biblioitems.issn, planneddate, serialseq,
1868 serial.status, serial.subscriptionid, claimdate, claims_count,
1869 subscription.branchcode
1871 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1872 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1873 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1874 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1875 WHERE subscription.subscriptionid = serial.subscriptionid
1876 AND (serial.STATUS IN (4, 41, 42, 43, 44) OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1877 AND subscription.aqbooksellerid=$supplierid
1882 $sth = $dbh->prepare(
1884 serialid, aqbooksellerid, name,
1885 biblio.title, planneddate, serialseq,
1886 serial.status, serial.subscriptionid, claimdate, claims_count,
1887 subscription.branchcode
1889 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1890 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1891 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1892 WHERE subscription.subscriptionid = serial.subscriptionid
1893 AND (serial.STATUS IN (4, 41, 42, 43, 44) OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1900 while ( my $line = $sth->fetchrow_hashref ) {
1902 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1903 $line->{planneddateISO} = $line->{planneddate};
1904 $line->{planneddate} = format_date( $line->{planneddate} );
1906 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1907 $line->{claimdateISO} = $line->{claimdate};
1908 $line->{claimdate} = format_date( $line->{claimdate} );
1910 $line->{"status".$line->{status}} = 1;
1911 push @issuelist, $line;
1916 =head2 removeMissingIssue
1918 removeMissingIssue($subscriptionid)
1920 this function removes an issue from being part of the missing string in
1921 subscriptionlist.missinglist column
1923 called when a missing issue is found from the serials-recieve.pl file
1927 sub removeMissingIssue {
1928 my ( $sequence, $subscriptionid ) = @_;
1930 return unless ($sequence and $subscriptionid);
1932 my $dbh = C4::Context->dbh;
1933 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1934 $sth->execute($subscriptionid);
1935 my $data = $sth->fetchrow_hashref;
1936 my $missinglist = $data->{'missinglist'};
1937 my $missinglistbefore = $missinglist;
1939 # warn $missinglist." before";
1940 $missinglist =~ s/($sequence)//;
1942 # warn $missinglist." after";
1943 if ( $missinglist ne $missinglistbefore ) {
1944 $missinglist =~ s/\|\s\|/\|/g;
1945 $missinglist =~ s/^\| //g;
1946 $missinglist =~ s/\|$//g;
1947 my $sth2 = $dbh->prepare(
1948 "UPDATE subscriptionhistory
1950 WHERE subscriptionid = ?"
1952 $sth2->execute( $missinglist, $subscriptionid );
1959 &updateClaim($serialid)
1961 this function updates the time when a claim is issued for late/missing items
1963 called from claims.pl file
1968 my ($serialid) = @_;
1969 my $dbh = C4::Context->dbh;
1972 SET claimdate = NOW(),
1973 claims_count = claims_count + 1
1979 =head2 getsupplierbyserialid
1981 $result = getsupplierbyserialid($serialid)
1983 this function is used to find the supplier id given a serial id
1986 hashref containing serialid, subscriptionid, and aqbooksellerid
1990 sub getsupplierbyserialid {
1991 my ($serialid) = @_;
1992 my $dbh = C4::Context->dbh;
1993 my $sth = $dbh->prepare(
1994 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1996 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2000 $sth->execute($serialid);
2001 my $line = $sth->fetchrow_hashref;
2002 my $result = $line->{'aqbooksellerid'};
2006 =head2 check_routing
2008 $result = &check_routing($subscriptionid)
2010 this function checks to see if a serial has a routing list and returns the count of routingid
2011 used to show either an 'add' or 'edit' link
2016 my ($subscriptionid) = @_;
2018 return unless ($subscriptionid);
2020 my $dbh = C4::Context->dbh;
2021 my $sth = $dbh->prepare(
2022 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2023 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2024 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2027 $sth->execute($subscriptionid);
2028 my $line = $sth->fetchrow_hashref;
2029 my $result = $line->{'routingids'};
2033 =head2 addroutingmember
2035 addroutingmember($borrowernumber,$subscriptionid)
2037 this function takes a borrowernumber and subscriptionid and adds the member to the
2038 routing list for that serial subscription and gives them a rank on the list
2039 of either 1 or highest current rank + 1
2043 sub addroutingmember {
2044 my ( $borrowernumber, $subscriptionid ) = @_;
2046 return unless ($borrowernumber and $subscriptionid);
2049 my $dbh = C4::Context->dbh;
2050 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2051 $sth->execute($subscriptionid);
2052 while ( my $line = $sth->fetchrow_hashref ) {
2053 if ( $line->{'rank'} > 0 ) {
2054 $rank = $line->{'rank'} + 1;
2059 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2060 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2063 =head2 reorder_members
2065 reorder_members($subscriptionid,$routingid,$rank)
2067 this function is used to reorder the routing list
2069 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2070 - it gets all members on list puts their routingid's into an array
2071 - removes the one in the array that is $routingid
2072 - then reinjects $routingid at point indicated by $rank
2073 - then update the database with the routingids in the new order
2077 sub reorder_members {
2078 my ( $subscriptionid, $routingid, $rank ) = @_;
2079 my $dbh = C4::Context->dbh;
2080 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2081 $sth->execute($subscriptionid);
2083 while ( my $line = $sth->fetchrow_hashref ) {
2084 push( @result, $line->{'routingid'} );
2087 # To find the matching index
2089 my $key = -1; # to allow for 0 being a valid response
2090 for ( $i = 0 ; $i < @result ; $i++ ) {
2091 if ( $routingid == $result[$i] ) {
2092 $key = $i; # save the index
2097 # if index exists in array then move it to new position
2098 if ( $key > -1 && $rank > 0 ) {
2099 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2100 my $moving_item = splice( @result, $key, 1 );
2101 splice( @result, $new_rank, 0, $moving_item );
2103 for ( my $j = 0 ; $j < @result ; $j++ ) {
2104 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2110 =head2 delroutingmember
2112 delroutingmember($routingid,$subscriptionid)
2114 this function either deletes one member from routing list if $routingid exists otherwise
2115 deletes all members from the routing list
2119 sub delroutingmember {
2121 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2122 my ( $routingid, $subscriptionid ) = @_;
2123 my $dbh = C4::Context->dbh;
2125 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2126 $sth->execute($routingid);
2127 reorder_members( $subscriptionid, $routingid );
2129 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2130 $sth->execute($subscriptionid);
2135 =head2 getroutinglist
2137 @routinglist = getroutinglist($subscriptionid)
2139 this gets the info from the subscriptionroutinglist for $subscriptionid
2142 the routinglist as an array. Each element of the array contains a hash_ref containing
2143 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2147 sub getroutinglist {
2148 my ($subscriptionid) = @_;
2149 my $dbh = C4::Context->dbh;
2150 my $sth = $dbh->prepare(
2151 'SELECT routingid, borrowernumber, ranking, biblionumber
2153 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2154 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2156 $sth->execute($subscriptionid);
2157 my $routinglist = $sth->fetchall_arrayref({});
2158 return @{$routinglist};
2161 =head2 countissuesfrom
2163 $result = countissuesfrom($subscriptionid,$startdate)
2165 Returns a count of serial rows matching the given subsctiptionid
2166 with published date greater than startdate
2170 sub countissuesfrom {
2171 my ( $subscriptionid, $startdate ) = @_;
2172 my $dbh = C4::Context->dbh;
2176 WHERE subscriptionid=?
2177 AND serial.publisheddate>?
2179 my $sth = $dbh->prepare($query);
2180 $sth->execute( $subscriptionid, $startdate );
2181 my ($countreceived) = $sth->fetchrow;
2182 return $countreceived;
2187 $result = CountIssues($subscriptionid)
2189 Returns a count of serial rows matching the given subsctiptionid
2194 my ($subscriptionid) = @_;
2195 my $dbh = C4::Context->dbh;
2199 WHERE subscriptionid=?
2201 my $sth = $dbh->prepare($query);
2202 $sth->execute($subscriptionid);
2203 my ($countreceived) = $sth->fetchrow;
2204 return $countreceived;
2209 $result = HasItems($subscriptionid)
2211 returns a count of items from serial matching the subscriptionid
2216 my ($subscriptionid) = @_;
2217 my $dbh = C4::Context->dbh;
2219 SELECT COUNT(serialitems.itemnumber)
2221 LEFT JOIN serialitems USING(serialid)
2222 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2224 my $sth=$dbh->prepare($query);
2225 $sth->execute($subscriptionid);
2226 my ($countitems)=$sth->fetchrow_array();
2230 =head2 abouttoexpire
2232 $result = abouttoexpire($subscriptionid)
2234 this function alerts you to the penultimate issue for a serial subscription
2236 returns 1 - if this is the penultimate issue
2242 my ($subscriptionid) = @_;
2243 my $dbh = C4::Context->dbh;
2244 my $subscription = GetSubscription($subscriptionid);
2245 my $per = $subscription->{'periodicity'};
2246 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2247 if ($frequency and $frequency->{unit}){
2249 my $expirationdate = GetExpirationDate($subscriptionid);
2251 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2252 my $nextdate = GetNextDate($subscription, $res);
2254 # only compare dates if both dates exist.
2255 if ($nextdate and $expirationdate) {
2256 if(Date::Calc::Delta_Days(
2257 split( /-/, $nextdate ),
2258 split( /-/, $expirationdate )
2264 } elsif ($subscription->{numberlength}>0) {
2265 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2271 sub in_array { # used in next sub down
2272 my ( $val, @elements ) = @_;
2273 foreach my $elem (@elements) {
2274 if ( $val == $elem ) {
2281 =head2 GetSubscriptionsFromBorrower
2283 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2285 this gets the info from subscriptionroutinglist for each $subscriptionid
2288 a count of the serial subscription routing lists to which a patron belongs,
2289 with the titles of those serial subscriptions as an array. Each element of the array
2290 contains a hash_ref with subscriptionID and title of subscription.
2294 sub GetSubscriptionsFromBorrower {
2295 my ($borrowernumber) = @_;
2296 my $dbh = C4::Context->dbh;
2297 my $sth = $dbh->prepare(
2298 "SELECT subscription.subscriptionid, biblio.title
2300 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2301 JOIN subscriptionroutinglist USING (subscriptionid)
2302 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2305 $sth->execute($borrowernumber);
2308 while ( my $line = $sth->fetchrow_hashref ) {
2310 push( @routinglist, $line );
2312 return ( $count, @routinglist );
2316 =head2 GetFictiveIssueNumber
2318 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2320 Get the position of the issue published at $publisheddate, considering the
2321 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2322 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2323 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2324 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2325 depending on how many rows are in serial table.
2326 The issue number calculation is based on subscription frequency, first acquisition
2327 date, and $publisheddate.
2331 sub GetFictiveIssueNumber {
2332 my ($subscription, $publisheddate) = @_;
2334 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2335 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2339 my ($year, $month, $day) = split /-/, $publisheddate;
2340 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2344 if($unit eq 'day') {
2345 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2346 } elsif($unit eq 'week') {
2347 ($wkno, $year) = Week_of_Year($year, $month, $day);
2348 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2349 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2350 } elsif($unit eq 'month') {
2351 $delta = ($fa_year == $year)
2352 ? ($month - $fa_month)
2353 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2354 } elsif($unit eq 'year') {
2355 $delta = $year - $fa_year;
2357 if($frequency->{'unitsperissue'} == 1) {
2358 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2360 # Assuming issuesperunit == 1
2361 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2369 $resultdate = GetNextDate($publisheddate,$subscription)
2371 this function it takes the publisheddate and will return the next issue's date
2372 and will skip dates if there exists an irregularity.
2373 $publisheddate has to be an ISO date
2374 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2375 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2376 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2377 skipped then the returned date will be 2007-05-10
2380 $resultdate - then next date in the sequence (ISO date)
2382 Return undef if subscription is irregular
2387 my ( $subscription, $publisheddate, $updatecount ) = @_;
2389 return unless $subscription and $publisheddate;
2391 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2393 if ($freqdata->{'unit'}) {
2394 my ( $year, $month, $day ) = split /-/, $publisheddate;
2396 # Process an irregularity Hash
2397 # Suppose that irregularities are stored in a string with this structure
2398 # irreg1;irreg2;irreg3
2399 # where irregX is the number of issue which will not be received
2400 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2402 if ( $subscription->{irregularity} ) {
2403 my @irreg = split /;/, $subscription->{'irregularity'} ;
2404 foreach my $irregularity (@irreg) {
2405 $irregularities{$irregularity} = 1;
2409 # Get the 'fictive' next issue number
2410 # It is used to check if next issue is an irregular issue.
2411 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2413 # Then get the next date
2414 my $unit = lc $freqdata->{'unit'};
2415 if ($unit eq 'day') {
2416 while ($irregularities{$issueno}) {
2417 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2418 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2419 $subscription->{'countissuesperunit'} = 1;
2421 $subscription->{'countissuesperunit'}++;
2425 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2426 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2427 $subscription->{'countissuesperunit'} = 1;
2429 $subscription->{'countissuesperunit'}++;
2432 elsif ($unit eq 'week') {
2433 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2434 while ($irregularities{$issueno}) {
2435 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2436 $subscription->{'countissuesperunit'} = 1;
2437 $wkno += $freqdata->{"unitsperissue"};
2442 my $dow = Day_of_Week($year, $month, $day);
2443 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2444 if($freqdata->{'issuesperunit'} == 1) {
2445 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2448 $subscription->{'countissuesperunit'}++;
2452 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2453 $subscription->{'countissuesperunit'} = 1;
2454 $wkno += $freqdata->{"unitsperissue"};
2456 $wkno = $wkno % 52 ;
2459 my $dow = Day_of_Week($year, $month, $day);
2460 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2461 if($freqdata->{'issuesperunit'} == 1) {
2462 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2465 $subscription->{'countissuesperunit'}++;
2468 elsif ($unit eq 'month') {
2469 while ($irregularities{$issueno}) {
2470 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2471 $subscription->{'countissuesperunit'} = 1;
2472 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2473 unless($freqdata->{'issuesperunit'} == 1) {
2474 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2477 $subscription->{'countissuesperunit'}++;
2481 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2482 $subscription->{'countissuesperunit'} = 1;
2483 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2484 unless($freqdata->{'issuesperunit'} == 1) {
2485 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2488 $subscription->{'countissuesperunit'}++;
2491 elsif ($unit eq 'year') {
2492 while ($irregularities{$issueno}) {
2493 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2494 $subscription->{'countissuesperunit'} = 1;
2495 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2496 unless($freqdata->{'issuesperunit'} == 1) {
2497 # Jumping to the first day of year, because we don't know what day is expected
2502 $subscription->{'countissuesperunit'}++;
2506 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2507 $subscription->{'countissuesperunit'} = 1;
2508 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2509 unless($freqdata->{'issuesperunit'} == 1) {
2510 # Jumping to the first day of year, because we don't know what day is expected
2515 $subscription->{'countissuesperunit'}++;
2519 my $dbh = C4::Context->dbh;
2522 SET countissuesperunit = ?
2523 WHERE subscriptionid = ?
2525 my $sth = $dbh->prepare($query);
2526 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2528 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2534 $string = &_numeration($value,$num_type,$locale);
2536 _numeration returns the string corresponding to $value in the num_type
2546 my ($value, $num_type, $locale) = @_;
2551 if ( $num_type =~ /^dayname$/ ) {
2552 # 1970-11-01 was a Sunday
2553 $value = $value % 7;
2554 my $dt = DateTime->new(
2560 $string = $dt->strftime("%A");
2561 } elsif ( $num_type =~ /^monthname$/ ) {
2562 $value = $value % 12;
2563 my $dt = DateTime->new(
2565 month => $value + 1,
2568 $string = $dt->strftime("%B");
2569 } elsif ( $num_type =~ /^season$/ ) {
2570 my @seasons= qw( Spring Summer Fall Winter );
2571 $value = $value % 4;
2572 $string = $seasons[$value];
2580 =head2 is_barcode_in_use
2582 Returns number of occurence of the barcode in the items table
2583 Can be used as a boolean test of whether the barcode has
2584 been deployed as yet
2588 sub is_barcode_in_use {
2589 my $barcode = shift;
2590 my $dbh = C4::Context->dbh;
2591 my $occurences = $dbh->selectall_arrayref(
2592 'SELECT itemnumber from items where barcode = ?',
2597 return @{$occurences};
2600 =head2 CloseSubscription
2601 Close a subscription given a subscriptionid
2603 sub CloseSubscription {
2604 my ( $subscriptionid ) = @_;
2605 return unless $subscriptionid;
2606 my $dbh = C4::Context->dbh;
2607 my $sth = $dbh->prepare( qq{
2610 WHERE subscriptionid = ?
2612 $sth->execute( $subscriptionid );
2614 # Set status = missing when status = stopped
2615 $sth = $dbh->prepare( qq{
2618 WHERE subscriptionid = ?
2621 $sth->execute( $subscriptionid );
2624 =head2 ReopenSubscription
2625 Reopen a subscription given a subscriptionid
2627 sub ReopenSubscription {
2628 my ( $subscriptionid ) = @_;
2629 return unless $subscriptionid;
2630 my $dbh = C4::Context->dbh;
2631 my $sth = $dbh->prepare( qq{
2634 WHERE subscriptionid = ?
2636 $sth->execute( $subscriptionid );
2638 # Set status = expected when status = stopped
2639 $sth = $dbh->prepare( qq{
2642 WHERE subscriptionid = ?
2645 $sth->execute( $subscriptionid );
2648 =head2 subscriptionCurrentlyOnOrder
2650 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2652 Return 1 if subscription is currently on order else 0.
2656 sub subscriptionCurrentlyOnOrder {
2657 my ( $subscriptionid ) = @_;
2658 my $dbh = C4::Context->dbh;
2660 SELECT COUNT(*) FROM aqorders
2661 WHERE subscriptionid = ?
2662 AND datereceived IS NULL
2663 AND datecancellationprinted IS NULL
2665 my $sth = $dbh->prepare( $query );
2666 $sth->execute($subscriptionid);
2667 return $sth->fetchrow_array;
2670 =head2 can_edit_subscription
2672 $can = can_edit_subscription( $subscriptionid[, $userid] );
2674 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2678 sub can_edit_subscription {
2679 my ( $subscription, $userid ) = @_;
2680 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2683 =head2 can_show_subscription
2685 $can = can_show_subscription( $subscriptionid[, $userid] );
2687 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2691 sub can_show_subscription {
2692 my ( $subscription, $userid ) = @_;
2693 return _can_do_on_subscription( $subscription, $userid, '*' );
2696 sub _can_do_on_subscription {
2697 my ( $subscription, $userid, $permission ) = @_;
2698 return 0 unless C4::Context->userenv;
2699 my $flags = C4::Context->userenv->{flags};
2700 $userid ||= C4::Context->userenv->{'id'};
2702 if ( C4::Context->preference('IndependentBranches') ) {
2704 if C4::Context->IsSuperLibrarian()
2706 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2708 C4::Auth::haspermission( $userid,
2709 { serials => $permission } )
2710 and ( not defined $subscription->{branchcode}
2711 or $subscription->{branchcode} eq ''
2712 or $subscription->{branchcode} eq
2713 C4::Context->userenv->{'branch'} )
2718 if C4::Context->IsSuperLibrarian()
2720 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2721 or C4::Auth::haspermission(
2722 $userid, { serials => $permission }
2734 Koha Development Team <http://koha-community.org/>