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
,
351 serial
.publisheddatetext
,
353 serial
.notes as notes
,
354 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
355 aqbooksellers
.name as aqbooksellername
,
356 biblio
.title as bibliotitle
,
357 subscription
.branchcode AS branchcode
,
358 subscription
.subscriptionid AS subscriptionid
360 LEFT JOIN subscription ON
361 (serial
.subscriptionid
=subscription
.subscriptionid
)
362 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
363 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
364 WHERE serial
.subscriptionid
= ?
366 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
367 serial
.subscriptionid
369 $debug and warn "GetFullSubscription query: $query";
370 my $sth = $dbh->prepare($query);
371 $sth->execute($subscriptionid);
372 my $subscriptions = $sth->fetchall_arrayref( {} );
373 for my $subscription ( @
$subscriptions ) {
374 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
376 return $subscriptions;
379 =head2 PrepareSerialsData
381 $array_ref = PrepareSerialsData($serialinfomation)
382 where serialinformation is a hashref array
386 sub PrepareSerialsData
{
389 return unless ($lines);
395 my $aqbooksellername;
399 my $previousnote = "";
401 foreach my $subs (@
{$lines}) {
402 for my $datefield ( qw(publisheddate planneddate) ) {
403 # handle 0000-00-00 dates
404 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
405 $subs->{$datefield} = undef;
408 $subs->{ "status" . $subs->{'status'} } = 1;
409 if ( grep { $_ == $subs->{status
} } ( EXPECTED
, LATE
, MISSING_STATUSES
, CLAIMED
) ) {
410 $subs->{"checked"} = 1;
413 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
414 $year = $subs->{'year'};
418 if ( $tmpresults{$year} ) {
419 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
421 $tmpresults{$year} = {
423 'aqbooksellername' => $subs->{'aqbooksellername'},
424 'bibliotitle' => $subs->{'bibliotitle'},
425 'serials' => [$subs],
430 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
431 push @res, $tmpresults{$key};
436 =head2 GetSubscriptionsFromBiblionumber
438 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
439 this function get the subscription list. it reads the subscription table.
441 reference to an array of subscriptions which have the biblionumber given on input arg.
442 each element of this array is a hashref containing
443 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
447 sub GetSubscriptionsFromBiblionumber
{
448 my ($biblionumber) = @_;
450 return unless ($biblionumber);
452 my $dbh = C4
::Context
->dbh;
454 SELECT subscription
.*,
456 subscriptionhistory
.*,
457 aqbooksellers
.name AS aqbooksellername
,
458 biblio
.title AS bibliotitle
460 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
461 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
462 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
463 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
464 WHERE subscription
.biblionumber
= ?
466 my $sth = $dbh->prepare($query);
467 $sth->execute($biblionumber);
469 while ( my $subs = $sth->fetchrow_hashref ) {
470 $subs->{startdate
} = format_date
( $subs->{startdate
} );
471 $subs->{histstartdate
} = format_date
( $subs->{histstartdate
} );
472 $subs->{histenddate
} = format_date
( $subs->{histenddate
} );
473 $subs->{opacnote
} =~ s/\n/\<br\/\
>/g
;
474 $subs->{missinglist
} =~ s/\n/\<br\/\
>/g
;
475 $subs->{recievedlist
} =~ s/\n/\<br\/\
>/g
;
476 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
477 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
478 $subs->{ "status" . $subs->{'status'} } = 1;
480 if ( $subs->{enddate
} eq '0000-00-00' ) {
481 $subs->{enddate
} = '';
483 $subs->{enddate
} = format_date
( $subs->{enddate
} );
485 $subs->{'abouttoexpire'} = abouttoexpire
( $subs->{'subscriptionid'} );
486 $subs->{'subscriptionexpired'} = HasSubscriptionExpired
( $subs->{'subscriptionid'} );
487 $subs->{cannotedit
} = not can_edit_subscription
( $subs );
493 =head2 GetFullSubscriptionsFromBiblionumber
495 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
496 this function reads the serial table.
500 sub GetFullSubscriptionsFromBiblionumber
{
501 my ($biblionumber) = @_;
502 my $dbh = C4
::Context
->dbh;
504 SELECT serial
.serialid
,
507 serial
.publisheddate
,
508 serial
.publisheddatetext
,
510 serial
.notes as notes
,
511 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
512 biblio
.title as bibliotitle
,
513 subscription
.branchcode AS branchcode
,
514 subscription
.subscriptionid AS subscriptionid
516 LEFT JOIN subscription ON
517 (serial
.subscriptionid
=subscription
.subscriptionid
)
518 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
519 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
520 WHERE subscription
.biblionumber
= ?
522 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
523 serial
.subscriptionid
525 my $sth = $dbh->prepare($query);
526 $sth->execute($biblionumber);
527 my $subscriptions = $sth->fetchall_arrayref( {} );
528 for my $subscription ( @
$subscriptions ) {
529 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
531 return $subscriptions;
534 =head2 SearchSubscriptions
536 @results = SearchSubscriptions($args);
538 This function returns a list of hashrefs, one for each subscription
539 that meets the conditions specified by the $args hashref.
541 The valid search fields are:
555 The expiration_date search field is special; it specifies the maximum
556 subscription expiration date.
560 sub SearchSubscriptions
{
563 my $additional_fields = $args->{additional_fields
} // [];
564 my $matching_record_ids_for_additional_fields = [];
565 if ( @
$additional_fields ) {
566 $matching_record_ids_for_additional_fields = Koha
::AdditionalField
->get_matching_record_ids({
567 fields
=> $additional_fields,
568 tablename
=> 'subscription',
571 return () unless @
$matching_record_ids_for_additional_fields;
576 subscription
.notes AS publicnotes
,
577 subscriptionhistory
.*,
579 biblio
.notes AS biblionotes
,
585 LEFT JOIN subscriptionhistory USING
(subscriptionid
)
586 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
587 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= subscription
.biblionumber
588 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
590 $query .= q
| WHERE
1|;
593 if( $args->{biblionumber
} ) {
594 push @where_strs, "biblio.biblionumber = ?";
595 push @where_args, $args->{biblionumber
};
598 if( $args->{title
} ){
599 my @words = split / /, $args->{title
};
601 foreach my $word (@words) {
602 push @strs, "biblio.title LIKE ?";
603 push @args, "%$word%";
606 push @where_strs, '(' . join (' AND ', @strs) . ')';
607 push @where_args, @args;
611 push @where_strs, "biblioitems.issn LIKE ?";
612 push @where_args, "%$args->{issn}%";
615 push @where_strs, "biblioitems.ean LIKE ?";
616 push @where_args, "%$args->{ean}%";
618 if ( $args->{callnumber
} ) {
619 push @where_strs, "subscription.callnumber LIKE ?";
620 push @where_args, "%$args->{callnumber}%";
622 if( $args->{publisher
} ){
623 push @where_strs, "biblioitems.publishercode LIKE ?";
624 push @where_args, "%$args->{publisher}%";
626 if( $args->{bookseller
} ){
627 push @where_strs, "aqbooksellers.name LIKE ?";
628 push @where_args, "%$args->{bookseller}%";
630 if( $args->{branch
} ){
631 push @where_strs, "subscription.branchcode = ?";
632 push @where_args, "$args->{branch}";
634 if ( $args->{location
} ) {
635 push @where_strs, "subscription.location = ?";
636 push @where_args, "$args->{location}";
638 if ( $args->{expiration_date
} ) {
639 push @where_strs, "subscription.enddate <= ?";
640 push @where_args, "$args->{expiration_date}";
642 if( defined $args->{closed
} ){
643 push @where_strs, "subscription.closed = ?";
644 push @where_args, "$args->{closed}";
648 $query .= ' AND ' . join(' AND ', @where_strs);
650 if ( @
$additional_fields ) {
651 $query .= ' AND subscriptionid IN ('
652 . join( ', ', @
$matching_record_ids_for_additional_fields )
656 $query .= " ORDER BY " . $args->{orderby
} if $args->{orderby
};
658 my $dbh = C4
::Context
->dbh;
659 my $sth = $dbh->prepare($query);
660 $sth->execute(@where_args);
661 my $results = $sth->fetchall_arrayref( {} );
663 for my $subscription ( @
$results ) {
664 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
665 $subscription->{cannotdisplay
} = not can_show_subscription
( $subscription );
667 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
668 record_id
=> $subscription->{subscriptionid
},
669 tablename
=> 'subscription'
671 $subscription->{additional_fields
} = $additional_field_values->{$subscription->{subscriptionid
}};
680 ($totalissues,@serials) = GetSerials($subscriptionid);
681 this function gets every serial not arrived for a given subscription
682 as well as the number of issues registered in the database (all types)
683 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
685 FIXME: We should return \@serials.
690 my ( $subscriptionid, $count ) = @_;
692 return unless $subscriptionid;
694 my $dbh = C4
::Context
->dbh;
696 # status = 2 is "arrived"
698 $count = 5 unless ($count);
700 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
, NOT_ISSUED
) );
701 my $query = "SELECT serialid,serialseq, status, publisheddate,
702 publisheddatetext, planneddate,notes, routingnotes
704 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
705 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
706 my $sth = $dbh->prepare($query);
707 $sth->execute($subscriptionid);
709 while ( my $line = $sth->fetchrow_hashref ) {
710 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
711 for my $datefield ( qw( planneddate publisheddate) ) {
712 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
713 $line->{$datefield} = format_date
( $line->{$datefield});
715 $line->{$datefield} = q{};
718 push @serials, $line;
721 # OK, now add the last 5 issues arrives/missing
722 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
723 publisheddatetext, notes, routingnotes
725 WHERE subscriptionid = ?
726 AND status IN ( $statuses )
727 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
729 $sth = $dbh->prepare($query);
730 $sth->execute($subscriptionid);
731 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
733 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
734 for my $datefield ( qw( planneddate publisheddate) ) {
735 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
736 $line->{$datefield} = format_date
( $line->{$datefield});
738 $line->{$datefield} = q{};
742 push @serials, $line;
745 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
746 $sth = $dbh->prepare($query);
747 $sth->execute($subscriptionid);
748 my ($totalissues) = $sth->fetchrow;
749 return ( $totalissues, @serials );
754 @serials = GetSerials2($subscriptionid,$statuses);
755 this function returns every serial waited for a given subscription
756 as well as the number of issues registered in the database (all types)
757 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
759 $statuses is an arrayref of statuses and is mandatory.
764 my ( $subscription, $statuses ) = @_;
766 return unless ($subscription and @
$statuses);
768 my $statuses_string = join ',', @
$statuses;
770 my $dbh = C4
::Context
->dbh;
772 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,
773 publisheddatetext
, notes
, routingnotes
775 WHERE subscriptionid
=$subscription AND status IN
($statuses_string)
776 ORDER BY publisheddate
,serialid DESC
778 $debug and warn "GetSerials2 query: $query";
779 my $sth = $dbh->prepare($query);
783 while ( my $line = $sth->fetchrow_hashref ) {
784 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
785 # Format dates for display
786 for my $datefield ( qw( planneddate publisheddate ) ) {
787 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
788 $line->{$datefield} = q{};
791 $line->{$datefield} = format_date
( $line->{$datefield} );
794 push @serials, $line;
799 =head2 GetLatestSerials
801 \@serials = GetLatestSerials($subscriptionid,$limit)
802 get the $limit's latest serials arrived or missing for a given subscription
804 a ref to an array which contains all of the latest serials stored into a hash.
808 sub GetLatestSerials
{
809 my ( $subscriptionid, $limit ) = @_;
811 return unless ($subscriptionid and $limit);
813 my $dbh = C4
::Context
->dbh;
815 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
) );
816 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
818 WHERE subscriptionid = ?
819 AND status IN ($statuses)
820 ORDER BY publisheddate DESC LIMIT 0,$limit
822 my $sth = $dbh->prepare($strsth);
823 $sth->execute($subscriptionid);
825 while ( my $line = $sth->fetchrow_hashref ) {
826 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
827 $line->{"planneddate"} = format_date
( $line->{"planneddate"} );
828 $line->{"publisheddate"} = format_date
( $line->{"publisheddate"} );
829 push @serials, $line;
835 =head2 GetDistributedTo
837 $distributedto=GetDistributedTo($subscriptionid)
838 This function returns the field distributedto for the subscription matching subscriptionid
842 sub GetDistributedTo
{
843 my $dbh = C4
::Context
->dbh;
845 my ($subscriptionid) = @_;
847 return unless ($subscriptionid);
849 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
850 my $sth = $dbh->prepare($query);
851 $sth->execute($subscriptionid);
852 return ($distributedto) = $sth->fetchrow;
858 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
859 $newinnerloop1, $newinnerloop2, $newinnerloop3
860 ) = GetNextSeq( $subscription, $pattern, $planneddate );
862 $subscription is a hashref containing all the attributes of the table
864 $pattern is a hashref containing all the attributes of the table
865 'subscription_numberpatterns'.
866 $planneddate is a C4::Dates object.
867 This function get the next issue for the subscription given on input arg
872 my ($subscription, $pattern, $planneddate) = @_;
874 return unless ($subscription and $pattern);
876 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
877 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
880 if ($subscription->{'skip_serialseq'}) {
881 my @irreg = split /;/, $subscription->{'irregularity'};
883 my $irregularities = {};
884 $irregularities->{$_} = 1 foreach(@irreg);
885 my $issueno = GetFictiveIssueNumber
($subscription, $planneddate) + 1;
886 while($irregularities->{$issueno}) {
893 my $numberingmethod = $pattern->{numberingmethod
};
895 if ($numberingmethod) {
896 $calculated = $numberingmethod;
897 my $locale = $subscription->{locale
};
898 $newlastvalue1 = $subscription->{lastvalue1
} || 0;
899 $newlastvalue2 = $subscription->{lastvalue2
} || 0;
900 $newlastvalue3 = $subscription->{lastvalue3
} || 0;
901 $newinnerloop1 = $subscription->{innerloop1
} || 0;
902 $newinnerloop2 = $subscription->{innerloop2
} || 0;
903 $newinnerloop3 = $subscription->{innerloop3
} || 0;
906 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
909 for(my $i = 0; $i < $count; $i++) {
911 # check if we have to increase the new value.
913 if ($newinnerloop1 >= $pattern->{every1
}) {
915 $newlastvalue1 += $pattern->{add1
};
917 # reset counter if needed.
918 $newlastvalue1 = $pattern->{setto1
} if ($newlastvalue1 > $pattern->{whenmorethan1
});
921 # check if we have to increase the new value.
923 if ($newinnerloop2 >= $pattern->{every2
}) {
925 $newlastvalue2 += $pattern->{add2
};
927 # reset counter if needed.
928 $newlastvalue2 = $pattern->{setto2
} if ($newlastvalue2 > $pattern->{whenmorethan2
});
931 # check if we have to increase the new value.
933 if ($newinnerloop3 >= $pattern->{every3
}) {
935 $newlastvalue3 += $pattern->{add3
};
937 # reset counter if needed.
938 $newlastvalue3 = $pattern->{setto3
} if ($newlastvalue3 > $pattern->{whenmorethan3
});
942 my $newlastvalue1string = _numeration
( $newlastvalue1, $pattern->{numbering1
}, $locale );
943 $calculated =~ s/\{X\}/$newlastvalue1string/g;
946 my $newlastvalue2string = _numeration
( $newlastvalue2, $pattern->{numbering2
}, $locale );
947 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
950 my $newlastvalue3string = _numeration
( $newlastvalue3, $pattern->{numbering3
}, $locale );
951 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
956 $newlastvalue1, $newlastvalue2, $newlastvalue3,
957 $newinnerloop1, $newinnerloop2, $newinnerloop3);
962 $calculated = GetSeq($subscription, $pattern)
963 $subscription is a hashref containing all the attributes of the table 'subscription'
964 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
965 this function transforms {X},{Y},{Z} to 150,0,0 for example.
967 the sequence in string format
972 my ($subscription, $pattern) = @_;
974 return unless ($subscription and $pattern);
976 my $locale = $subscription->{locale
};
978 my $calculated = $pattern->{numberingmethod
};
980 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
981 $newlastvalue1 = _numeration
($newlastvalue1, $pattern->{numbering1
}, $locale) if ($pattern->{numbering1
}); # reset counter if needed.
982 $calculated =~ s/\{X\}/$newlastvalue1/g;
984 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
985 $newlastvalue2 = _numeration
($newlastvalue2, $pattern->{numbering2
}, $locale) if ($pattern->{numbering2
}); # reset counter if needed.
986 $calculated =~ s/\{Y\}/$newlastvalue2/g;
988 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
989 $newlastvalue3 = _numeration
($newlastvalue3, $pattern->{numbering3
}, $locale) if ($pattern->{numbering3
}); # reset counter if needed.
990 $calculated =~ s/\{Z\}/$newlastvalue3/g;
994 =head2 GetExpirationDate
996 $enddate = GetExpirationDate($subscriptionid, [$startdate])
998 this function return the next expiration date for a subscription given on input args.
1001 the enddate or undef
1005 sub GetExpirationDate
{
1006 my ( $subscriptionid, $startdate ) = @_;
1008 return unless ($subscriptionid);
1010 my $dbh = C4
::Context
->dbh;
1011 my $subscription = GetSubscription
($subscriptionid);
1014 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1015 $enddate = $startdate || $subscription->{startdate
};
1016 my @date = split( /-/, $enddate );
1018 return if ( scalar(@date) != 3 || not check_date
(@date) );
1020 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1021 if ( $frequency and $frequency->{unit
} ) {
1024 if ( my $length = $subscription->{numberlength
} ) {
1026 #calculate the date of the last issue.
1027 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1028 $enddate = GetNextDate
( $subscription, $enddate );
1030 } elsif ( $subscription->{monthlength
} ) {
1031 if ( $$subscription{startdate
} ) {
1032 my @enddate = Add_Delta_YM
( $date[0], $date[1], $date[2], 0, $subscription->{monthlength
} );
1033 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1035 } elsif ( $subscription->{weeklength
} ) {
1036 if ( $$subscription{startdate
} ) {
1037 my @date = split( /-/, $subscription->{startdate
} );
1038 my @enddate = Add_Delta_Days
( $date[0], $date[1], $date[2], $subscription->{weeklength
} * 7 );
1039 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1042 $enddate = $subscription->{enddate
};
1046 return $subscription->{enddate
};
1050 =head2 CountSubscriptionFromBiblionumber
1052 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1053 this returns a count of the subscriptions for a given biblionumber
1055 the number of subscriptions
1059 sub CountSubscriptionFromBiblionumber
{
1060 my ($biblionumber) = @_;
1062 return unless ($biblionumber);
1064 my $dbh = C4
::Context
->dbh;
1065 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1066 my $sth = $dbh->prepare($query);
1067 $sth->execute($biblionumber);
1068 my $subscriptionsnumber = $sth->fetchrow;
1069 return $subscriptionsnumber;
1072 =head2 ModSubscriptionHistory
1074 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1076 this function modifies the history of a subscription. Put your new values on input arg.
1077 returns the number of rows affected
1081 sub ModSubscriptionHistory
{
1082 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1084 return unless ($subscriptionid);
1086 my $dbh = C4
::Context
->dbh;
1087 my $query = "UPDATE subscriptionhistory
1088 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1089 WHERE subscriptionid=?
1091 my $sth = $dbh->prepare($query);
1092 $receivedlist =~ s/^; // if $receivedlist;
1093 $missinglist =~ s/^; // if $missinglist;
1094 $opacnote =~ s/^; // if $opacnote;
1095 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1099 =head2 ModSerialStatus
1101 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1102 $publisheddatetext, $status, $notes);
1104 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1105 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1109 sub ModSerialStatus
{
1110 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1111 $status, $notes) = @_;
1113 return unless ($serialid);
1115 #It is a usual serial
1116 # 1st, get previous status :
1117 my $dbh = C4
::Context
->dbh;
1118 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1119 FROM serial, subscription
1120 WHERE serial.subscriptionid=subscription.subscriptionid
1122 my $sth = $dbh->prepare($query);
1123 $sth->execute($serialid);
1124 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1125 my $frequency = GetSubscriptionFrequency
($periodicity);
1127 # change status & update subscriptionhistory
1129 if ( $status == DELETED
) {
1130 DelIssue
( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1135 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1136 planneddate = ?, status = ?, notes = ?
1139 $sth = $dbh->prepare($query);
1140 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1141 $planneddate, $status, $notes, $serialid );
1142 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1143 $sth = $dbh->prepare($query);
1144 $sth->execute($subscriptionid);
1145 my $val = $sth->fetchrow_hashref;
1146 unless ( $val->{manualhistory
} ) {
1147 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1148 $sth = $dbh->prepare($query);
1149 $sth->execute($subscriptionid);
1150 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1152 if ( $status == ARRIVED
|| ($oldstatus == ARRIVED
&& $status != ARRIVED
) ) {
1153 $recievedlist .= "; $serialseq"
1154 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1157 # in case serial has been previously marked as missing
1158 if (grep /$status/, (EXPECTED
, ARRIVED
, LATE
, CLAIMED
)) {
1159 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1162 $missinglist .= "; $serialseq"
1163 if ( ( grep { $_ == $status } ( MISSING_STATUSES
) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1164 $missinglist .= "; not issued $serialseq"
1165 if ( $status == NOT_ISSUED
&& $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1167 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1168 $sth = $dbh->prepare($query);
1169 $recievedlist =~ s/^; //;
1170 $missinglist =~ s/^; //;
1171 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1175 # create new waited entry if needed (ie : was a "waited" and has changed)
1176 if ( $oldstatus == EXPECTED
&& $status != EXPECTED
) {
1177 my $subscription = GetSubscription
($subscriptionid);
1178 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1182 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1183 $newinnerloop1, $newinnerloop2, $newinnerloop3
1185 = GetNextSeq
( $subscription, $pattern, $publisheddate );
1187 # next date (calculated from actual date & frequency parameters)
1188 my $nextpublisheddate = GetNextDate
($subscription, $publisheddate, 1);
1189 my $nextpubdate = $nextpublisheddate;
1190 NewIssue
( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1191 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1192 WHERE subscriptionid = ?";
1193 $sth = $dbh->prepare($query);
1194 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1196 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1197 if ( $subscription->{letter
} && $status == ARRIVED
&& $oldstatus != ARRIVED
) {
1198 require C4
::Letters
;
1199 C4
::Letters
::SendAlerts
( 'issue', $serialid, $subscription->{letter
} );
1206 =head2 GetNextExpected
1208 $nextexpected = GetNextExpected($subscriptionid)
1210 Get the planneddate for the current expected issue of the subscription.
1216 planneddate => ISO date
1221 sub GetNextExpected
{
1222 my ($subscriptionid) = @_;
1224 my $dbh = C4
::Context
->dbh;
1228 WHERE subscriptionid
= ?
1232 my $sth = $dbh->prepare($query);
1234 # Each subscription has only one 'expected' issue.
1235 $sth->execute( $subscriptionid, EXPECTED
);
1236 my $nextissue = $sth->fetchrow_hashref;
1237 if ( !$nextissue ) {
1241 WHERE subscriptionid
= ?
1242 ORDER BY publisheddate DESC
1245 $sth = $dbh->prepare($query);
1246 $sth->execute($subscriptionid);
1247 $nextissue = $sth->fetchrow_hashref;
1249 foreach(qw
/planneddate publisheddate/) {
1250 if ( !defined $nextissue->{$_} ) {
1251 # or should this default to 1st Jan ???
1252 $nextissue->{$_} = strftime
( '%Y-%m-%d', localtime );
1254 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1262 =head2 ModNextExpected
1264 ModNextExpected($subscriptionid,$date)
1266 Update the planneddate for the current expected issue of the subscription.
1267 This will modify all future prediction results.
1269 C<$date> is an ISO date.
1275 sub ModNextExpected
{
1276 my ( $subscriptionid, $date ) = @_;
1277 my $dbh = C4
::Context
->dbh;
1279 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1280 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1282 # Each subscription has only one 'expected' issue.
1283 $sth->execute( $date, $date, $subscriptionid, EXPECTED
);
1288 =head2 GetSubscriptionIrregularities
1292 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1293 get the list of irregularities for a subscription
1299 sub GetSubscriptionIrregularities
{
1300 my $subscriptionid = shift;
1302 return unless $subscriptionid;
1304 my $dbh = C4
::Context
->dbh;
1308 WHERE subscriptionid
= ?
1310 my $sth = $dbh->prepare($query);
1311 $sth->execute($subscriptionid);
1313 my ($result) = $sth->fetchrow_array;
1314 my @irreg = split /;/, $result;
1319 =head2 ModSubscription
1321 this function modifies a subscription. Put all new values on input args.
1322 returns the number of rows affected
1326 sub ModSubscription
{
1328 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1329 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1330 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1331 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1332 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1333 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1334 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1337 my $dbh = C4
::Context
->dbh;
1338 my $query = "UPDATE subscription
1339 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1340 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1341 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1342 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1343 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1344 callnumber=?, notes=?, letter=?, manualhistory=?,
1345 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1346 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1348 WHERE subscriptionid = ?";
1350 my $sth = $dbh->prepare($query);
1352 $auser, $branchcode, $aqbooksellerid, $cost,
1353 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1354 $irregularity, $numberpattern, $locale, $numberlength,
1355 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1356 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1357 $status, $biblionumber, $callnumber, $notes,
1358 $letter, ($manualhistory ?
$manualhistory : 0),
1359 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1360 $graceperiod, $location, $enddate, $skip_serialseq,
1363 my $rows = $sth->rows;
1365 logaction
( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1369 =head2 NewSubscription
1371 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1372 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1373 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1374 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1375 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1376 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1378 Create a new subscription with value given on input args.
1381 the id of this new subscription
1385 sub NewSubscription
{
1387 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1388 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1389 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1390 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1391 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1392 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1393 $location, $enddate, $skip_serialseq
1395 my $dbh = C4
::Context
->dbh;
1397 #save subscription (insert into database)
1399 INSERT INTO subscription
1400 (librarian
, branchcode
, aqbooksellerid
, cost
, aqbudgetid
,
1401 biblionumber
, startdate
, periodicity
, numberlength
, weeklength
,
1402 monthlength
, lastvalue1
, innerloop1
, lastvalue2
, innerloop2
,
1403 lastvalue3
, innerloop3
, status
, notes
, letter
, firstacquidate
,
1404 irregularity
, numberpattern
, locale
, callnumber
,
1405 manualhistory
, internalnotes
, serialsadditems
, staffdisplaycount
,
1406 opacdisplaycount
, graceperiod
, location
, enddate
, skip_serialseq
)
1407 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
)
1409 my $sth = $dbh->prepare($query);
1411 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1412 $startdate, $periodicity, $numberlength, $weeklength,
1413 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1414 $lastvalue3, $innerloop3, $status, $notes, $letter,
1415 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1416 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1417 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1420 my $subscriptionid = $dbh->{'mysql_insertid'};
1422 $enddate = GetExpirationDate
( $subscriptionid, $startdate );
1426 WHERE subscriptionid
=?
1428 $sth = $dbh->prepare($query);
1429 $sth->execute( $enddate, $subscriptionid );
1432 # then create the 1st expected number
1434 INSERT INTO subscriptionhistory
1435 (biblionumber
, subscriptionid
, histstartdate
)
1438 $sth = $dbh->prepare($query);
1439 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1441 # reread subscription to get a hash (for calculation of the 1st issue number)
1442 my $subscription = GetSubscription
($subscriptionid);
1443 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1445 # calculate issue number
1446 my $serialseq = GetSeq
($subscription, $pattern) || q{};
1449 (serialseq
,subscriptionid
,biblionumber
,status
, planneddate
, publisheddate
)
1450 VALUES
(?
,?
,?
,?
,?
,?
)
1452 $sth = $dbh->prepare($query);
1453 $sth->execute( $serialseq, $subscriptionid, $biblionumber, EXPECTED
, $firstacquidate, $firstacquidate );
1455 logaction
( "SERIAL", "ADD", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1457 #set serial flag on biblio if not already set.
1458 my $bib = GetBiblio
($biblionumber);
1459 if ( $bib and !$bib->{'serial'} ) {
1460 my $record = GetMarcBiblio
($biblionumber);
1461 my ( $tag, $subf ) = GetMarcFromKohaField
( 'biblio.serial', $bib->{'frameworkcode'} );
1463 eval { $record->field($tag)->update( $subf => 1 ); };
1465 ModBiblio
( $record, $biblionumber, $bib->{'frameworkcode'} );
1467 return $subscriptionid;
1470 =head2 ReNewSubscription
1472 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1474 this function renew a subscription with values given on input args.
1478 sub ReNewSubscription
{
1479 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1480 my $dbh = C4
::Context
->dbh;
1481 my $subscription = GetSubscription
($subscriptionid);
1485 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1486 WHERE biblio
.biblionumber
=?
1488 my $sth = $dbh->prepare($query);
1489 $sth->execute( $subscription->{biblionumber
} );
1490 my $biblio = $sth->fetchrow_hashref;
1492 if ( C4
::Context
->preference("RenewSerialAddsSuggestion") ) {
1493 require C4
::Suggestions
;
1494 C4
::Suggestions
::NewSuggestion
(
1495 { 'suggestedby' => $user,
1496 'title' => $subscription->{bibliotitle
},
1497 'author' => $biblio->{author
},
1498 'publishercode' => $biblio->{publishercode
},
1499 'note' => $biblio->{note
},
1500 'biblionumber' => $subscription->{biblionumber
}
1505 # renew subscription
1508 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
,reneweddate
=NOW
()
1509 WHERE subscriptionid
=?
1511 $sth = $dbh->prepare($query);
1512 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1513 my $enddate = GetExpirationDate
($subscriptionid);
1514 $debug && warn "enddate :$enddate";
1518 WHERE subscriptionid
=?
1520 $sth = $dbh->prepare($query);
1521 $sth->execute( $enddate, $subscriptionid );
1523 UPDATE subscriptionhistory
1525 WHERE subscriptionid
=?
1527 $sth = $dbh->prepare($query);
1528 $sth->execute( $enddate, $subscriptionid );
1530 logaction
( "SERIAL", "RENEW", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1536 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1538 Create a new issue stored on the database.
1539 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1540 returns the serial id
1545 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1546 $publisheddate, $publisheddatetext, $notes ) = @_;
1547 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1549 return unless ($subscriptionid);
1551 my $dbh = C4
::Context
->dbh;
1553 INSERT INTO serial
(serialseq
, subscriptionid
, biblionumber
, status
,
1554 publisheddate
, publisheddatetext
, planneddate
, notes
)
1555 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
)
1557 my $sth = $dbh->prepare($query);
1558 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1559 $publisheddate, $publisheddatetext, $planneddate, $notes );
1560 my $serialid = $dbh->{'mysql_insertid'};
1562 SELECT missinglist
,recievedlist
1563 FROM subscriptionhistory
1564 WHERE subscriptionid
=?
1566 $sth = $dbh->prepare($query);
1567 $sth->execute($subscriptionid);
1568 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1570 if ( $status == ARRIVED
) {
1571 ### TODO Add a feature that improves recognition and description.
1572 ### As such count (serialseq) i.e. : N18,2(N19),N20
1573 ### Would use substr and index But be careful to previous presence of ()
1574 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1576 if ( grep {/^$status$/} ( MISSING_STATUSES
) ) {
1577 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1580 UPDATE subscriptionhistory
1581 SET recievedlist
=?
, missinglist
=?
1582 WHERE subscriptionid
=?
1584 $sth = $dbh->prepare($query);
1585 $recievedlist =~ s/^; //;
1586 $missinglist =~ s/^; //;
1587 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1591 =head2 ItemizeSerials
1593 ItemizeSerials($serialid, $info);
1594 $info is a hashref containing barcode branch, itemcallnumber, status, location
1595 $serialid the serialid
1597 1 if the itemize is a succes.
1598 0 and @error otherwise. @error containts the list of errors found.
1602 sub ItemizeSerials
{
1603 my ( $serialid, $info ) = @_;
1605 return unless ($serialid);
1607 my $now = POSIX
::strftime
( "%Y-%m-%d", localtime );
1609 my $dbh = C4
::Context
->dbh;
1615 my $sth = $dbh->prepare($query);
1616 $sth->execute($serialid);
1617 my $data = $sth->fetchrow_hashref;
1618 if ( C4
::Context
->preference("RoutingSerials") ) {
1620 # check for existing biblioitem relating to serial issue
1621 my ( $count, @results ) = GetBiblioItemByBiblioNumber
( $data->{'biblionumber'} );
1623 for ( my $i = 0 ; $i < $count ; $i++ ) {
1624 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1625 $bibitemno = $results[$i]->{'biblioitemnumber'};
1629 if ( $bibitemno == 0 ) {
1630 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1631 $sth->execute( $data->{'biblionumber'} );
1632 my $biblioitem = $sth->fetchrow_hashref;
1633 $biblioitem->{'volumedate'} = $data->{planneddate
};
1634 $biblioitem->{'volumeddesc'} = $data->{serialseq
} . ' (' . format_date
( $data->{'planneddate'} ) . ')';
1635 $biblioitem->{'dewey'} = $info->{itemcallnumber
};
1639 my $fwk = GetFrameworkCode
( $data->{'biblionumber'} );
1640 if ( $info->{barcode
} ) {
1642 if ( is_barcode_in_use
( $info->{barcode
} ) ) {
1643 push @errors, 'barcode_not_unique';
1645 my $marcrecord = MARC
::Record
->new();
1646 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.barcode", $fwk );
1647 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{barcode
} );
1648 $marcrecord->insert_fields_ordered($newField);
1649 if ( $info->{branch
} ) {
1650 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.homebranch", $fwk );
1652 #warn "items.homebranch : $tag , $subfield";
1653 if ( $marcrecord->field($tag) ) {
1654 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch
} );
1656 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{branch
} );
1657 $marcrecord->insert_fields_ordered($newField);
1659 ( $tag, $subfield ) = GetMarcFromKohaField
( "items.holdingbranch", $fwk );
1661 #warn "items.holdingbranch : $tag , $subfield";
1662 if ( $marcrecord->field($tag) ) {
1663 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch
} );
1665 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{branch
} );
1666 $marcrecord->insert_fields_ordered($newField);
1669 if ( $info->{itemcallnumber
} ) {
1670 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.itemcallnumber", $fwk );
1672 if ( $marcrecord->field($tag) ) {
1673 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber
} );
1675 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber
} );
1676 $marcrecord->insert_fields_ordered($newField);
1679 if ( $info->{notes
} ) {
1680 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.itemnotes", $fwk );
1682 if ( $marcrecord->field($tag) ) {
1683 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes
} );
1685 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{notes
} );
1686 $marcrecord->insert_fields_ordered($newField);
1689 if ( $info->{location
} ) {
1690 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.location", $fwk );
1692 if ( $marcrecord->field($tag) ) {
1693 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location
} );
1695 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{location
} );
1696 $marcrecord->insert_fields_ordered($newField);
1699 if ( $info->{status
} ) {
1700 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.notforloan", $fwk );
1702 if ( $marcrecord->field($tag) ) {
1703 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status
} );
1705 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $info->{status
} );
1706 $marcrecord->insert_fields_ordered($newField);
1709 if ( C4
::Context
->preference("RoutingSerials") ) {
1710 my ( $tag, $subfield ) = GetMarcFromKohaField
( "items.dateaccessioned", $fwk );
1711 if ( $marcrecord->field($tag) ) {
1712 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1714 my $newField = MARC
::Field
->new( "$tag", '', '', "$subfield" => $now );
1715 $marcrecord->insert_fields_ordered($newField);
1719 C4
::Items
::AddItemFromMarc
( $marcrecord, $data->{'biblionumber'} );
1722 return ( 0, @errors );
1726 =head2 HasSubscriptionStrictlyExpired
1728 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1730 the subscription has stricly expired when today > the end subscription date
1733 1 if true, 0 if false, -1 if the expiration date is not set.
1737 sub HasSubscriptionStrictlyExpired
{
1739 # Getting end of subscription date
1740 my ($subscriptionid) = @_;
1742 return unless ($subscriptionid);
1744 my $dbh = C4
::Context
->dbh;
1745 my $subscription = GetSubscription
($subscriptionid);
1746 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1748 # If the expiration date is set
1749 if ( $expirationdate != 0 ) {
1750 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1752 # Getting today's date
1753 my ( $nowyear, $nowmonth, $nowday ) = Today
();
1755 # if today's date > expiration date, then the subscription has stricly expired
1756 if ( Delta_Days
( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1763 # There are some cases where the expiration date is not set
1764 # As we can't determine if the subscription has expired on a date-basis,
1770 =head2 HasSubscriptionExpired
1772 $has_expired = HasSubscriptionExpired($subscriptionid)
1774 the subscription has expired when the next issue to arrive is out of subscription limit.
1777 0 if the subscription has not expired
1778 1 if the subscription has expired
1779 2 if has subscription does not have a valid expiration date set
1783 sub HasSubscriptionExpired
{
1784 my ($subscriptionid) = @_;
1786 return unless ($subscriptionid);
1788 my $dbh = C4
::Context
->dbh;
1789 my $subscription = GetSubscription
($subscriptionid);
1790 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1791 if ( $frequency and $frequency->{unit
} ) {
1792 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1793 if (!defined $expirationdate) {
1794 $expirationdate = q{};
1797 SELECT max
(planneddate
)
1799 WHERE subscriptionid
=?
1801 my $sth = $dbh->prepare($query);
1802 $sth->execute($subscriptionid);
1803 my ($res) = $sth->fetchrow;
1804 if (!$res || $res=~m/^0000/) {
1807 my @res = split( /-/, $res );
1808 my @endofsubscriptiondate = split( /-/, $expirationdate );
1809 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date
(@res) || not check_date
(@endofsubscriptiondate) );
1811 if ( ( @endofsubscriptiondate && Delta_Days
( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1816 if ( $subscription->{'numberlength'} ) {
1817 my $countreceived = countissuesfrom
( $subscriptionid, $subscription->{'startdate'} );
1818 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1824 return 0; # Notice that you'll never get here.
1827 =head2 SetDistributedto
1829 SetDistributedto($distributedto,$subscriptionid);
1830 This function update the value of distributedto for a subscription given on input arg.
1834 sub SetDistributedto
{
1835 my ( $distributedto, $subscriptionid ) = @_;
1836 my $dbh = C4
::Context
->dbh;
1840 WHERE subscriptionid
=?
1842 my $sth = $dbh->prepare($query);
1843 $sth->execute( $distributedto, $subscriptionid );
1847 =head2 DelSubscription
1849 DelSubscription($subscriptionid)
1850 this function deletes subscription which has $subscriptionid as id.
1854 sub DelSubscription
{
1855 my ($subscriptionid) = @_;
1856 my $dbh = C4
::Context
->dbh;
1857 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1858 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1859 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1861 my $afs = Koha
::AdditionalField
->all({tablename
=> 'subscription'});
1862 foreach my $af (@
$afs) {
1863 $af->delete_values({record_id
=> $subscriptionid});
1866 logaction
( "SERIAL", "DELETE", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1871 DelIssue($serialseq,$subscriptionid)
1872 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1874 returns the number of rows affected
1879 my ($dataissue) = @_;
1880 my $dbh = C4
::Context
->dbh;
1881 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1886 AND subscriptionid
= ?
1888 my $mainsth = $dbh->prepare($query);
1889 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1891 #Delete element from subscription history
1892 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1893 my $sth = $dbh->prepare($query);
1894 $sth->execute( $dataissue->{'subscriptionid'} );
1895 my $val = $sth->fetchrow_hashref;
1896 unless ( $val->{manualhistory
} ) {
1898 SELECT
* FROM subscriptionhistory
1899 WHERE subscriptionid
= ?
1901 my $sth = $dbh->prepare($query);
1902 $sth->execute( $dataissue->{'subscriptionid'} );
1903 my $data = $sth->fetchrow_hashref;
1904 my $serialseq = $dataissue->{'serialseq'};
1905 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1906 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1907 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1908 $sth = $dbh->prepare($strsth);
1909 $sth->execute( $dataissue->{'subscriptionid'} );
1912 return $mainsth->rows;
1915 =head2 GetLateOrMissingIssues
1917 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1919 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1922 the issuelist as an array of hash refs. Each element of this array contains
1923 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1927 sub GetLateOrMissingIssues
{
1928 my ( $supplierid, $serialid, $order ) = @_;
1930 return unless ( $supplierid or $serialid );
1932 my $dbh = C4
::Context
->dbh;
1937 $byserial = "and serialid = " . $serialid;
1940 $order .= ", title";
1944 my $missing_statuses_string = join ',', (MISSING_STATUSES
);
1946 $sth = $dbh->prepare(
1948 serialid, aqbooksellerid, name,
1949 biblio.title, biblioitems.issn, planneddate, serialseq,
1950 serial.status, serial.subscriptionid, claimdate, claims_count,
1951 subscription.branchcode
1953 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1954 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1955 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1956 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1957 WHERE subscription.subscriptionid = serial.subscriptionid
1958 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1959 AND subscription.aqbooksellerid=$supplierid
1964 $sth = $dbh->prepare(
1966 serialid, aqbooksellerid, name,
1967 biblio.title, planneddate, serialseq,
1968 serial.status, serial.subscriptionid, claimdate, claims_count,
1969 subscription.branchcode
1971 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1972 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1973 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1974 WHERE subscription.subscriptionid = serial.subscriptionid
1975 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1980 $sth->execute( EXPECTED
, LATE
, CLAIMED
);
1982 while ( my $line = $sth->fetchrow_hashref ) {
1984 if ($line->{planneddate
} && $line->{planneddate
} !~/^0+\-/) {
1985 $line->{planneddateISO
} = $line->{planneddate
};
1986 $line->{planneddate
} = format_date
( $line->{planneddate
} );
1988 if ($line->{claimdate
} && $line->{claimdate
} !~/^0+\-/) {
1989 $line->{claimdateISO
} = $line->{claimdate
};
1990 $line->{claimdate
} = format_date
( $line->{claimdate
} );
1992 $line->{"status".$line->{status
}} = 1;
1994 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
1995 record_id
=> $line->{subscriptionid
},
1996 tablename
=> 'subscription'
1998 %$line = ( %$line, additional_fields
=> $additional_field_values->{$line->{subscriptionid
}} );
2000 push @issuelist, $line;
2007 &updateClaim($serialid)
2009 this function updates the time when a claim is issued for late/missing items
2011 called from claims.pl file
2016 my ($serialid) = @_;
2017 my $dbh = C4
::Context
->dbh;
2020 SET claimdate
= NOW
(),
2021 claims_count
= claims_count
+ 1
2027 =head2 getsupplierbyserialid
2029 $result = getsupplierbyserialid($serialid)
2031 this function is used to find the supplier id given a serial id
2034 hashref containing serialid, subscriptionid, and aqbooksellerid
2038 sub getsupplierbyserialid
{
2039 my ($serialid) = @_;
2040 my $dbh = C4
::Context
->dbh;
2041 my $sth = $dbh->prepare(
2042 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2044 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2048 $sth->execute($serialid);
2049 my $line = $sth->fetchrow_hashref;
2050 my $result = $line->{'aqbooksellerid'};
2054 =head2 check_routing
2056 $result = &check_routing($subscriptionid)
2058 this function checks to see if a serial has a routing list and returns the count of routingid
2059 used to show either an 'add' or 'edit' link
2064 my ($subscriptionid) = @_;
2066 return unless ($subscriptionid);
2068 my $dbh = C4
::Context
->dbh;
2069 my $sth = $dbh->prepare(
2070 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2071 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2072 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2075 $sth->execute($subscriptionid);
2076 my $line = $sth->fetchrow_hashref;
2077 my $result = $line->{'routingids'};
2081 =head2 addroutingmember
2083 addroutingmember($borrowernumber,$subscriptionid)
2085 this function takes a borrowernumber and subscriptionid and adds the member to the
2086 routing list for that serial subscription and gives them a rank on the list
2087 of either 1 or highest current rank + 1
2091 sub addroutingmember
{
2092 my ( $borrowernumber, $subscriptionid ) = @_;
2094 return unless ($borrowernumber and $subscriptionid);
2097 my $dbh = C4
::Context
->dbh;
2098 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2099 $sth->execute($subscriptionid);
2100 while ( my $line = $sth->fetchrow_hashref ) {
2101 if ( $line->{'rank'} > 0 ) {
2102 $rank = $line->{'rank'} + 1;
2107 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2108 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2111 =head2 reorder_members
2113 reorder_members($subscriptionid,$routingid,$rank)
2115 this function is used to reorder the routing list
2117 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2118 - it gets all members on list puts their routingid's into an array
2119 - removes the one in the array that is $routingid
2120 - then reinjects $routingid at point indicated by $rank
2121 - then update the database with the routingids in the new order
2125 sub reorder_members
{
2126 my ( $subscriptionid, $routingid, $rank ) = @_;
2127 my $dbh = C4
::Context
->dbh;
2128 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2129 $sth->execute($subscriptionid);
2131 while ( my $line = $sth->fetchrow_hashref ) {
2132 push( @result, $line->{'routingid'} );
2135 # To find the matching index
2137 my $key = -1; # to allow for 0 being a valid response
2138 for ( $i = 0 ; $i < @result ; $i++ ) {
2139 if ( $routingid == $result[$i] ) {
2140 $key = $i; # save the index
2145 # if index exists in array then move it to new position
2146 if ( $key > -1 && $rank > 0 ) {
2147 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2148 my $moving_item = splice( @result, $key, 1 );
2149 splice( @result, $new_rank, 0, $moving_item );
2151 for ( my $j = 0 ; $j < @result ; $j++ ) {
2152 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2158 =head2 delroutingmember
2160 delroutingmember($routingid,$subscriptionid)
2162 this function either deletes one member from routing list if $routingid exists otherwise
2163 deletes all members from the routing list
2167 sub delroutingmember
{
2169 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2170 my ( $routingid, $subscriptionid ) = @_;
2171 my $dbh = C4
::Context
->dbh;
2173 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2174 $sth->execute($routingid);
2175 reorder_members
( $subscriptionid, $routingid );
2177 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2178 $sth->execute($subscriptionid);
2183 =head2 getroutinglist
2185 @routinglist = getroutinglist($subscriptionid)
2187 this gets the info from the subscriptionroutinglist for $subscriptionid
2190 the routinglist as an array. Each element of the array contains a hash_ref containing
2191 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2195 sub getroutinglist
{
2196 my ($subscriptionid) = @_;
2197 my $dbh = C4
::Context
->dbh;
2198 my $sth = $dbh->prepare(
2199 'SELECT routingid, borrowernumber, ranking, biblionumber
2201 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2202 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2204 $sth->execute($subscriptionid);
2205 my $routinglist = $sth->fetchall_arrayref({});
2206 return @
{$routinglist};
2209 =head2 countissuesfrom
2211 $result = countissuesfrom($subscriptionid,$startdate)
2213 Returns a count of serial rows matching the given subsctiptionid
2214 with published date greater than startdate
2218 sub countissuesfrom
{
2219 my ( $subscriptionid, $startdate ) = @_;
2220 my $dbh = C4
::Context
->dbh;
2224 WHERE subscriptionid
=?
2225 AND serial
.publisheddate
>?
2227 my $sth = $dbh->prepare($query);
2228 $sth->execute( $subscriptionid, $startdate );
2229 my ($countreceived) = $sth->fetchrow;
2230 return $countreceived;
2235 $result = CountIssues($subscriptionid)
2237 Returns a count of serial rows matching the given subsctiptionid
2242 my ($subscriptionid) = @_;
2243 my $dbh = C4
::Context
->dbh;
2247 WHERE subscriptionid
=?
2249 my $sth = $dbh->prepare($query);
2250 $sth->execute($subscriptionid);
2251 my ($countreceived) = $sth->fetchrow;
2252 return $countreceived;
2257 $result = HasItems($subscriptionid)
2259 returns a count of items from serial matching the subscriptionid
2264 my ($subscriptionid) = @_;
2265 my $dbh = C4
::Context
->dbh;
2267 SELECT COUNT
(serialitems
.itemnumber
)
2269 LEFT JOIN serialitems USING
(serialid
)
2270 WHERE subscriptionid
=? AND serialitems
.serialid IS NOT NULL
2272 my $sth=$dbh->prepare($query);
2273 $sth->execute($subscriptionid);
2274 my ($countitems)=$sth->fetchrow_array();
2278 =head2 abouttoexpire
2280 $result = abouttoexpire($subscriptionid)
2282 this function alerts you to the penultimate issue for a serial subscription
2284 returns 1 - if this is the penultimate issue
2290 my ($subscriptionid) = @_;
2291 my $dbh = C4
::Context
->dbh;
2292 my $subscription = GetSubscription
($subscriptionid);
2293 my $per = $subscription->{'periodicity'};
2294 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($per);
2295 if ($frequency and $frequency->{unit
}){
2297 my $expirationdate = GetExpirationDate
($subscriptionid);
2299 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2300 my $nextdate = GetNextDate
($subscription, $res);
2302 # only compare dates if both dates exist.
2303 if ($nextdate and $expirationdate) {
2304 if(Date
::Calc
::Delta_Days
(
2305 split( /-/, $nextdate ),
2306 split( /-/, $expirationdate )
2312 } elsif ($subscription->{numberlength
}>0) {
2313 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2319 sub in_array
{ # used in next sub down
2320 my ( $val, @elements ) = @_;
2321 foreach my $elem (@elements) {
2322 if ( $val == $elem ) {
2329 =head2 GetSubscriptionsFromBorrower
2331 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2333 this gets the info from subscriptionroutinglist for each $subscriptionid
2336 a count of the serial subscription routing lists to which a patron belongs,
2337 with the titles of those serial subscriptions as an array. Each element of the array
2338 contains a hash_ref with subscriptionID and title of subscription.
2342 sub GetSubscriptionsFromBorrower
{
2343 my ($borrowernumber) = @_;
2344 my $dbh = C4
::Context
->dbh;
2345 my $sth = $dbh->prepare(
2346 "SELECT subscription.subscriptionid, biblio.title
2348 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2349 JOIN subscriptionroutinglist USING (subscriptionid)
2350 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2353 $sth->execute($borrowernumber);
2356 while ( my $line = $sth->fetchrow_hashref ) {
2358 push( @routinglist, $line );
2360 return ( $count, @routinglist );
2364 =head2 GetFictiveIssueNumber
2366 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2368 Get the position of the issue published at $publisheddate, considering the
2369 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2370 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2371 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2372 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2373 depending on how many rows are in serial table.
2374 The issue number calculation is based on subscription frequency, first acquisition
2375 date, and $publisheddate.
2379 sub GetFictiveIssueNumber
{
2380 my ($subscription, $publisheddate) = @_;
2382 my $frequency = GetSubscriptionFrequency
($subscription->{'periodicity'});
2383 my $unit = $frequency->{unit
} ?
lc $frequency->{'unit'} : undef;
2387 my ($year, $month, $day) = split /-/, $publisheddate;
2388 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2392 if($unit eq 'day') {
2393 $delta = Delta_Days
($fa_year, $fa_month, $fa_day, $year, $month, $day);
2394 } elsif($unit eq 'week') {
2395 ($wkno, $year) = Week_of_Year
($year, $month, $day);
2396 my ($fa_wkno, $fa_yr) = Week_of_Year
($fa_year, $fa_month, $fa_day);
2397 $delta = ($fa_yr == $year) ?
($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2398 } elsif($unit eq 'month') {
2399 $delta = ($fa_year == $year)
2400 ?
($month - $fa_month)
2401 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2402 } elsif($unit eq 'year') {
2403 $delta = $year - $fa_year;
2405 if($frequency->{'unitsperissue'} == 1) {
2406 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2408 # Assuming issuesperunit == 1
2409 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2415 sub _get_next_date_day
{
2416 my ($subscription, $freqdata, $year, $month, $day) = @_;
2418 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2419 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , $freqdata->{unitsperissue
} );
2420 $subscription->{countissuesperunit
} = 1;
2422 $subscription->{countissuesperunit
}++;
2425 return ($year, $month, $day);
2428 sub _get_next_date_week
{
2429 my ($subscription, $freqdata, $year, $month, $day) = @_;
2431 my ($wkno, $yr) = Week_of_Year
($year, $month, $day);
2432 my $fa_dow = Day_of_Week
(split /-/, $subscription->{firstacquidate
});
2434 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2435 $subscription->{countissuesperunit
} = 1;
2436 $wkno += $freqdata->{unitsperissue
};
2441 ($year,$month,$day) = Monday_of_Week
($wkno, $yr);
2442 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $fa_dow - 1);
2444 # Try to guess the next day of week
2445 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit
});
2446 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2447 $subscription->{countissuesperunit
}++;
2450 return ($year, $month, $day);
2453 sub _get_next_date_month
{
2454 my ($subscription, $freqdata, $year, $month, $day) = @_;
2457 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate
};
2459 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2460 $subscription->{countissuesperunit
} = 1;
2461 ($year,$month,$day) = Add_Delta_YM
($year,$month,$day, 0,
2462 $freqdata->{unitsperissue
});
2463 my $days_in_month = Days_in_Month
($year, $month);
2464 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2466 # Try to guess the next day in month
2467 my $days_in_month = Days_in_Month
($year, $month);
2468 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2469 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2470 $subscription->{countissuesperunit
}++;
2473 return ($year, $month, $day);
2476 sub _get_next_date_year
{
2477 my ($subscription, $freqdata, $year, $month, $day) = @_;
2479 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate
};
2481 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2482 $subscription->{countissuesperunit
} = 1;
2483 ($year) = Add_Delta_YM
($year,$month,$day, $freqdata->{"unitsperissue"},0);
2485 my $days_in_month = Days_in_Month
($year, $month);
2486 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2488 # Try to guess the next day in year
2489 my $days_in_year = Days_in_Year
($year,12); #Sum the days of all the months of this year
2490 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2491 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2492 $subscription->{countissuesperunit
}++;
2495 return ($year, $month, $day);
2500 $resultdate = GetNextDate($publisheddate,$subscription)
2502 this function it takes the publisheddate and will return the next issue's date
2503 and will skip dates if there exists an irregularity.
2504 $publisheddate has to be an ISO date
2505 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2506 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2507 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2508 skipped then the returned date will be 2007-05-10
2511 $resultdate - then next date in the sequence (ISO date)
2513 Return undef if subscription is irregular
2518 my ( $subscription, $publisheddate, $updatecount ) = @_;
2520 return unless $subscription and $publisheddate;
2522 my $freqdata = GetSubscriptionFrequency
($subscription->{'periodicity'});
2524 if ($freqdata->{'unit'}) {
2525 my ( $year, $month, $day ) = split /-/, $publisheddate;
2527 # Process an irregularity Hash
2528 # Suppose that irregularities are stored in a string with this structure
2529 # irreg1;irreg2;irreg3
2530 # where irregX is the number of issue which will not be received
2531 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2533 if ( $subscription->{irregularity
} ) {
2534 my @irreg = split /;/, $subscription->{'irregularity'} ;
2535 foreach my $irregularity (@irreg) {
2536 $irregularities{$irregularity} = 1;
2540 # Get the 'fictive' next issue number
2541 # It is used to check if next issue is an irregular issue.
2542 my $issueno = GetFictiveIssueNumber
($subscription, $publisheddate) + 1;
2544 # Then get the next date
2545 my $unit = lc $freqdata->{'unit'};
2546 if ($unit eq 'day') {
2547 while ($irregularities{$issueno}) {
2548 ($year, $month, $day) = _get_next_date_day
($subscription,
2549 $freqdata, $year, $month, $day);
2552 ($year, $month, $day) = _get_next_date_day
($subscription, $freqdata,
2553 $year, $month, $day);
2555 elsif ($unit eq 'week') {
2556 while ($irregularities{$issueno}) {
2557 ($year, $month, $day) = _get_next_date_week
($subscription,
2558 $freqdata, $year, $month, $day);
2561 ($year, $month, $day) = _get_next_date_week
($subscription,
2562 $freqdata, $year, $month, $day);
2564 elsif ($unit eq 'month') {
2565 while ($irregularities{$issueno}) {
2566 ($year, $month, $day) = _get_next_date_month
($subscription,
2567 $freqdata, $year, $month, $day);
2570 ($year, $month, $day) = _get_next_date_month
($subscription,
2571 $freqdata, $year, $month, $day);
2573 elsif ($unit eq 'year') {
2574 while ($irregularities{$issueno}) {
2575 ($year, $month, $day) = _get_next_date_year
($subscription,
2576 $freqdata, $year, $month, $day);
2579 ($year, $month, $day) = _get_next_date_year
($subscription,
2580 $freqdata, $year, $month, $day);
2584 my $dbh = C4
::Context
->dbh;
2587 SET countissuesperunit
= ?
2588 WHERE subscriptionid
= ?
2590 my $sth = $dbh->prepare($query);
2591 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2594 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2600 $string = &_numeration($value,$num_type,$locale);
2602 _numeration returns the string corresponding to $value in the num_type
2612 my ($value, $num_type, $locale) = @_;
2617 if ( $num_type =~ /^dayname$/ ) {
2618 # 1970-11-01 was a Sunday
2619 $value = $value % 7;
2620 my $dt = DateTime
->new(
2626 $string = $dt->strftime("%A");
2627 } elsif ( $num_type =~ /^monthname$/ ) {
2628 $value = $value % 12;
2629 my $dt = DateTime
->new(
2631 month
=> $value + 1,
2634 $string = $dt->strftime("%B");
2635 } elsif ( $num_type =~ /^season$/ ) {
2636 my @seasons= qw( Spring Summer Fall Winter );
2637 $value = $value % 4;
2638 $string = $seasons[$value];
2646 =head2 is_barcode_in_use
2648 Returns number of occurrences of the barcode in the items table
2649 Can be used as a boolean test of whether the barcode has
2650 been deployed as yet
2654 sub is_barcode_in_use
{
2655 my $barcode = shift;
2656 my $dbh = C4
::Context
->dbh;
2657 my $occurrences = $dbh->selectall_arrayref(
2658 'SELECT itemnumber from items where barcode = ?',
2663 return @
{$occurrences};
2666 =head2 CloseSubscription
2667 Close a subscription given a subscriptionid
2669 sub CloseSubscription
{
2670 my ( $subscriptionid ) = @_;
2671 return unless $subscriptionid;
2672 my $dbh = C4
::Context
->dbh;
2673 my $sth = $dbh->prepare( q{
2676 WHERE subscriptionid = ?
2678 $sth->execute( $subscriptionid );
2680 # Set status = missing when status = stopped
2681 $sth = $dbh->prepare( q{
2684 WHERE subscriptionid = ?
2687 $sth->execute( STOPPED
, $subscriptionid, EXPECTED
);
2690 =head2 ReopenSubscription
2691 Reopen a subscription given a subscriptionid
2693 sub ReopenSubscription
{
2694 my ( $subscriptionid ) = @_;
2695 return unless $subscriptionid;
2696 my $dbh = C4
::Context
->dbh;
2697 my $sth = $dbh->prepare( q{
2700 WHERE subscriptionid = ?
2702 $sth->execute( $subscriptionid );
2704 # Set status = expected when status = stopped
2705 $sth = $dbh->prepare( q{
2708 WHERE subscriptionid = ?
2711 $sth->execute( EXPECTED
, $subscriptionid, STOPPED
);
2714 =head2 subscriptionCurrentlyOnOrder
2716 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2718 Return 1 if subscription is currently on order else 0.
2722 sub subscriptionCurrentlyOnOrder
{
2723 my ( $subscriptionid ) = @_;
2724 my $dbh = C4
::Context
->dbh;
2726 SELECT COUNT
(*) FROM aqorders
2727 WHERE subscriptionid
= ?
2728 AND datereceived IS NULL
2729 AND datecancellationprinted IS NULL
2731 my $sth = $dbh->prepare( $query );
2732 $sth->execute($subscriptionid);
2733 return $sth->fetchrow_array;
2736 =head2 can_claim_subscription
2738 $can = can_claim_subscription( $subscriptionid[, $userid] );
2740 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2744 sub can_claim_subscription
{
2745 my ( $subscription, $userid ) = @_;
2746 return _can_do_on_subscription
( $subscription, $userid, 'claim_serials' );
2749 =head2 can_edit_subscription
2751 $can = can_edit_subscription( $subscriptionid[, $userid] );
2753 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2757 sub can_edit_subscription
{
2758 my ( $subscription, $userid ) = @_;
2759 return _can_do_on_subscription
( $subscription, $userid, 'edit_subscription' );
2762 =head2 can_show_subscription
2764 $can = can_show_subscription( $subscriptionid[, $userid] );
2766 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2770 sub can_show_subscription
{
2771 my ( $subscription, $userid ) = @_;
2772 return _can_do_on_subscription
( $subscription, $userid, '*' );
2775 sub _can_do_on_subscription
{
2776 my ( $subscription, $userid, $permission ) = @_;
2777 return 0 unless C4
::Context
->userenv;
2778 my $flags = C4
::Context
->userenv->{flags
};
2779 $userid ||= C4
::Context
->userenv->{'id'};
2781 if ( C4
::Context
->preference('IndependentBranches') ) {
2783 if C4
::Context
->IsSuperLibrarian()
2785 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2787 C4
::Auth
::haspermission
( $userid,
2788 { serials
=> $permission } )
2789 and ( not defined $subscription->{branchcode
}
2790 or $subscription->{branchcode
} eq ''
2791 or $subscription->{branchcode
} eq
2792 C4
::Context
->userenv->{'branch'} )
2797 if C4
::Context
->IsSuperLibrarian()
2799 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2800 or C4
::Auth
::haspermission
(
2801 $userid, { serials
=> $permission }
2813 Koha Development Team <http://koha-community.org/>