3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4
::Auth
qw(haspermission);
26 use Date
::Calc
qw(:all);
27 use POSIX
qw(strftime);
29 use C4
::Log
; # logaction
31 use C4
::Serials
::Frequency
;
32 use C4
::Serials
::Numberpattern
;
33 use Koha
::AdditionalField
;
36 use Koha
::Subscriptions
;
37 use Koha
::Subscription
::Histories
;
39 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
80 &UpdateClaimdateIssues
81 &GetSuppliersWithLateIssues &getsupplierbyserialid
82 &GetDistributedTo &SetDistributedTo
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &GetSubscriptionsFromBorrower
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues
{
122 my $dbh = C4
::Context
->dbh;
123 my $statuses = join(',', ( LATE
, MISSING_STATUSES
, CLAIMED
) );
125 SELECT DISTINCT id
, name
127 LEFT JOIN serial ON serial
.subscriptionid
=subscription
.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
131 (planneddate
< now
() AND serial
.status
=1)
132 OR serial
.STATUS IN
( $statuses )
134 AND subscription
.closed
= 0
136 return $dbh->selectall_arrayref($query, { Slice
=> {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId
{
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4
::Context
->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid
= ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialStatusFromSerialId
168 $sth = GetSerialStatusFromSerialId();
169 this function returns a statement handle
170 After this function, don't forget to execute it by using $sth->execute($serialid)
172 $sth = $dbh->prepare($query).
176 sub GetSerialStatusFromSerialId
{
177 my $dbh = C4
::Context
->dbh;
183 return $dbh->prepare($query);
186 =head2 GetSerialInformation
189 $data = GetSerialInformation($serialid);
190 returns a hash_ref containing :
191 items : items marcrecord (can be an array)
193 subscription table field
194 + information about subscription expiration
198 sub GetSerialInformation
{
200 my $dbh = C4
::Context
->dbh;
202 SELECT serial
.*, serial
.notes as sernotes
, serial
.status as serstatus
,subscription
.*,subscription
.subscriptionid as subsid
203 FROM serial LEFT JOIN subscription ON subscription
.subscriptionid
=serial
.subscriptionid
206 my $rq = $dbh->prepare($query);
207 $rq->execute($serialid);
208 my $data = $rq->fetchrow_hashref;
210 # create item information if we have serialsadditems for this subscription
211 if ( $data->{'serialsadditems'} ) {
212 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
213 $queryitem->execute($serialid);
214 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
216 if ( scalar(@
$itemnumbers) > 0 ) {
217 foreach my $itemnum (@
$itemnumbers) {
219 #It is ASSUMED that GetMarcItem ALWAYS WORK...
220 #Maybe GetMarcItem should return values on failure
221 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
222 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, $itemnum->[0], $data );
223 $itemprocessed->{'itemnumber'} = $itemnum->[0];
224 $itemprocessed->{'itemid'} = $itemnum->[0];
225 $itemprocessed->{'serialid'} = $serialid;
226 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
227 push @
{ $data->{'items'} }, $itemprocessed;
230 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, '', $data );
231 $itemprocessed->{'itemid'} = "N$serialid";
232 $itemprocessed->{'serialid'} = $serialid;
233 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
234 $itemprocessed->{'countitems'} = 0;
235 push @
{ $data->{'items'} }, $itemprocessed;
238 $data->{ "status" . $data->{'serstatus'} } = 1;
239 $data->{'subscriptionexpired'} = HasSubscriptionExpired
( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
240 $data->{'abouttoexpire'} = abouttoexpire
( $data->{'subscriptionid'} );
241 $data->{cannotedit
} = not can_edit_subscription
( $data );
245 =head2 AddItem2Serial
247 $rows = AddItem2Serial($serialid,$itemnumber);
248 Adds an itemnumber to Serial record
249 returns the number of rows affected
254 my ( $serialid, $itemnumber ) = @_;
256 return unless ($serialid and $itemnumber);
258 my $dbh = C4
::Context
->dbh;
259 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
260 $rq->execute( $serialid, $itemnumber );
264 =head2 UpdateClaimdateIssues
266 UpdateClaimdateIssues($serialids,[$date]);
268 Update Claimdate for issues in @$serialids list with date $date
273 sub UpdateClaimdateIssues
{
274 my ( $serialids, $date ) = @_;
276 return unless ($serialids);
278 my $dbh = C4
::Context
->dbh;
279 $date = strftime
( "%Y-%m-%d", localtime ) unless ($date);
284 claims_count = claims_count + 1
285 WHERE serialid in (" . join( ",", map { '?' } @
$serialids ) . ")
287 my $rq = $dbh->prepare($query);
288 $rq->execute($date, CLAIMED
, @
$serialids);
292 =head2 GetSubscription
294 $subs = GetSubscription($subscriptionid)
295 this function returns the subscription which has $subscriptionid as id.
297 a hashref. This hash containts
298 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
302 sub GetSubscription
{
303 my ($subscriptionid) = @_;
304 my $dbh = C4
::Context
->dbh;
306 SELECT subscription
.*,
307 subscriptionhistory
.*,
308 aqbooksellers
.name AS aqbooksellername
,
309 biblio
.title AS bibliotitle
,
310 subscription
.biblionumber as bibnum
312 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
313 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
314 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
315 WHERE subscription
.subscriptionid
= ?
318 $debug and warn "query : $query\nsubsid :$subscriptionid";
319 my $sth = $dbh->prepare($query);
320 $sth->execute($subscriptionid);
321 my $subscription = $sth->fetchrow_hashref;
323 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
325 # Add additional fields to the subscription into a new key "additional_fields"
326 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
327 tablename
=> 'subscription',
328 record_id
=> $subscriptionid,
330 $subscription->{additional_fields
} = $additional_field_values->{$subscriptionid};
332 return $subscription;
335 =head2 GetFullSubscription
337 $array_ref = GetFullSubscription($subscriptionid)
338 this function reads the serial table.
342 sub GetFullSubscription
{
343 my ($subscriptionid) = @_;
345 return unless ($subscriptionid);
347 my $dbh = C4
::Context
->dbh;
349 SELECT serial
.serialid
,
352 serial
.publisheddate
,
353 serial
.publisheddatetext
,
355 serial
.notes as notes
,
356 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
357 aqbooksellers
.name as aqbooksellername
,
358 biblio
.title as bibliotitle
,
359 subscription
.branchcode AS branchcode
,
360 subscription
.subscriptionid AS subscriptionid
362 LEFT JOIN subscription ON
363 (serial
.subscriptionid
=subscription
.subscriptionid
)
364 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
365 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
366 WHERE serial
.subscriptionid
= ?
368 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
369 serial
.subscriptionid
371 $debug and warn "GetFullSubscription query: $query";
372 my $sth = $dbh->prepare($query);
373 $sth->execute($subscriptionid);
374 my $subscriptions = $sth->fetchall_arrayref( {} );
375 for my $subscription ( @
$subscriptions ) {
376 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
378 return $subscriptions;
381 =head2 PrepareSerialsData
383 $array_ref = PrepareSerialsData($serialinfomation)
384 where serialinformation is a hashref array
388 sub PrepareSerialsData
{
391 return unless ($lines);
397 my $aqbooksellername;
401 my $previousnote = "";
403 foreach my $subs (@
{$lines}) {
404 for my $datefield ( qw(publisheddate planneddate) ) {
405 # handle 0000-00-00 dates
406 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
407 $subs->{$datefield} = undef;
410 $subs->{ "status" . $subs->{'status'} } = 1;
411 if ( grep { $_ == $subs->{status
} } ( EXPECTED
, LATE
, MISSING_STATUSES
, CLAIMED
) ) {
412 $subs->{"checked"} = 1;
415 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
416 $year = $subs->{'year'};
420 if ( $tmpresults{$year} ) {
421 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
423 $tmpresults{$year} = {
425 'aqbooksellername' => $subs->{'aqbooksellername'},
426 'bibliotitle' => $subs->{'bibliotitle'},
427 'serials' => [$subs],
432 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
433 push @res, $tmpresults{$key};
438 =head2 GetSubscriptionsFromBiblionumber
440 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
441 this function get the subscription list. it reads the subscription table.
443 reference to an array of subscriptions which have the biblionumber given on input arg.
444 each element of this array is a hashref containing
445 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
449 sub GetSubscriptionsFromBiblionumber
{
450 my ($biblionumber) = @_;
452 return unless ($biblionumber);
454 my $dbh = C4
::Context
->dbh;
456 SELECT subscription
.*,
458 subscriptionhistory
.*,
459 aqbooksellers
.name AS aqbooksellername
,
460 biblio
.title AS bibliotitle
462 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
463 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
464 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
465 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
466 WHERE subscription
.biblionumber
= ?
468 my $sth = $dbh->prepare($query);
469 $sth->execute($biblionumber);
471 while ( my $subs = $sth->fetchrow_hashref ) {
472 $subs->{startdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{startdate
} ), dateonly
=> 1 } );
473 $subs->{histstartdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histstartdate
} ), dateonly
=> 1 } );
474 $subs->{histenddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histenddate
} ), dateonly
=> 1 } );
475 $subs->{opacnote
} =~ s/\n/\<br\/\
>/g
;
476 $subs->{missinglist
} =~ s/\n/\<br\/\
>/g
;
477 $subs->{recievedlist
} =~ s/\n/\<br\/\
>/g
;
478 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
479 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
480 $subs->{ "status" . $subs->{'status'} } = 1;
482 if ( $subs->{enddate
} eq '0000-00-00' ) {
483 $subs->{enddate
} = '';
485 $subs->{enddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{enddate
}), dateonly
=> 1 } );
487 $subs->{'abouttoexpire'} = abouttoexpire
( $subs->{'subscriptionid'} );
488 $subs->{'subscriptionexpired'} = HasSubscriptionExpired
( $subs->{'subscriptionid'} );
489 $subs->{cannotedit
} = not can_edit_subscription
( $subs );
495 =head2 GetFullSubscriptionsFromBiblionumber
497 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
498 this function reads the serial table.
502 sub GetFullSubscriptionsFromBiblionumber
{
503 my ($biblionumber) = @_;
504 my $dbh = C4
::Context
->dbh;
506 SELECT serial
.serialid
,
509 serial
.publisheddate
,
510 serial
.publisheddatetext
,
512 serial
.notes as notes
,
513 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
514 biblio
.title as bibliotitle
,
515 subscription
.branchcode AS branchcode
,
516 subscription
.subscriptionid AS subscriptionid
518 LEFT JOIN subscription ON
519 (serial
.subscriptionid
=subscription
.subscriptionid
)
520 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
521 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
522 WHERE subscription
.biblionumber
= ?
524 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
525 serial
.subscriptionid
527 my $sth = $dbh->prepare($query);
528 $sth->execute($biblionumber);
529 my $subscriptions = $sth->fetchall_arrayref( {} );
530 for my $subscription ( @
$subscriptions ) {
531 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
533 return $subscriptions;
536 =head2 SearchSubscriptions
538 @results = SearchSubscriptions($args);
540 This function returns a list of hashrefs, one for each subscription
541 that meets the conditions specified by the $args hashref.
543 The valid search fields are:
557 The expiration_date search field is special; it specifies the maximum
558 subscription expiration date.
562 sub SearchSubscriptions
{
565 my $additional_fields = $args->{additional_fields
} // [];
566 my $matching_record_ids_for_additional_fields = [];
567 if ( @
$additional_fields ) {
568 $matching_record_ids_for_additional_fields = Koha
::AdditionalField
->get_matching_record_ids({
569 fields
=> $additional_fields,
570 tablename
=> 'subscription',
573 return () unless @
$matching_record_ids_for_additional_fields;
578 subscription
.notes AS publicnotes
,
579 subscriptionhistory
.*,
581 biblio
.notes AS biblionotes
,
587 LEFT JOIN subscriptionhistory USING
(subscriptionid
)
588 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
589 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= subscription
.biblionumber
590 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
592 $query .= q
| WHERE
1|;
595 if( $args->{biblionumber
} ) {
596 push @where_strs, "biblio.biblionumber = ?";
597 push @where_args, $args->{biblionumber
};
600 if( $args->{title
} ){
601 my @words = split / /, $args->{title
};
603 foreach my $word (@words) {
604 push @strs, "biblio.title LIKE ?";
605 push @args, "%$word%";
608 push @where_strs, '(' . join (' AND ', @strs) . ')';
609 push @where_args, @args;
613 push @where_strs, "biblioitems.issn LIKE ?";
614 push @where_args, "%$args->{issn}%";
617 push @where_strs, "biblioitems.ean LIKE ?";
618 push @where_args, "%$args->{ean}%";
620 if ( $args->{callnumber
} ) {
621 push @where_strs, "subscription.callnumber LIKE ?";
622 push @where_args, "%$args->{callnumber}%";
624 if( $args->{publisher
} ){
625 push @where_strs, "biblioitems.publishercode LIKE ?";
626 push @where_args, "%$args->{publisher}%";
628 if( $args->{bookseller
} ){
629 push @where_strs, "aqbooksellers.name LIKE ?";
630 push @where_args, "%$args->{bookseller}%";
632 if( $args->{branch
} ){
633 push @where_strs, "subscription.branchcode = ?";
634 push @where_args, "$args->{branch}";
636 if ( $args->{location
} ) {
637 push @where_strs, "subscription.location = ?";
638 push @where_args, "$args->{location}";
640 if ( $args->{expiration_date
} ) {
641 push @where_strs, "subscription.enddate <= ?";
642 push @where_args, "$args->{expiration_date}";
644 if( defined $args->{closed
} ){
645 push @where_strs, "subscription.closed = ?";
646 push @where_args, "$args->{closed}";
650 $query .= ' AND ' . join(' AND ', @where_strs);
652 if ( @
$additional_fields ) {
653 $query .= ' AND subscriptionid IN ('
654 . join( ', ', @
$matching_record_ids_for_additional_fields )
658 $query .= " ORDER BY " . $args->{orderby
} if $args->{orderby
};
660 my $dbh = C4
::Context
->dbh;
661 my $sth = $dbh->prepare($query);
662 $sth->execute(@where_args);
663 my $results = $sth->fetchall_arrayref( {} );
665 for my $subscription ( @
$results ) {
666 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
667 $subscription->{cannotdisplay
} = not can_show_subscription
( $subscription );
669 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
670 record_id
=> $subscription->{subscriptionid
},
671 tablename
=> 'subscription'
673 $subscription->{additional_fields
} = $additional_field_values->{$subscription->{subscriptionid
}};
682 ($totalissues,@serials) = GetSerials($subscriptionid);
683 this function gets every serial not arrived for a given subscription
684 as well as the number of issues registered in the database (all types)
685 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
687 FIXME: We should return \@serials.
692 my ( $subscriptionid, $count ) = @_;
694 return unless $subscriptionid;
696 my $dbh = C4
::Context
->dbh;
698 # status = 2 is "arrived"
700 $count = 5 unless ($count);
702 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
, NOT_ISSUED
) );
703 my $query = "SELECT serialid,serialseq, status, publisheddate,
704 publisheddatetext, planneddate,notes, routingnotes
706 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
707 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
708 my $sth = $dbh->prepare($query);
709 $sth->execute($subscriptionid);
711 while ( my $line = $sth->fetchrow_hashref ) {
712 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
713 for my $datefield ( qw( planneddate publisheddate) ) {
714 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
715 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
717 $line->{$datefield} = q{};
720 push @serials, $line;
723 # OK, now add the last 5 issues arrives/missing
724 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
725 publisheddatetext, notes, routingnotes
727 WHERE subscriptionid = ?
728 AND status IN ( $statuses )
729 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
731 $sth = $dbh->prepare($query);
732 $sth->execute($subscriptionid);
733 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
735 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
736 for my $datefield ( qw( planneddate publisheddate) ) {
737 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
738 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
740 $line->{$datefield} = q{};
744 push @serials, $line;
747 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
748 $sth = $dbh->prepare($query);
749 $sth->execute($subscriptionid);
750 my ($totalissues) = $sth->fetchrow;
751 return ( $totalissues, @serials );
756 @serials = GetSerials2($subscriptionid,$statuses);
757 this function returns every serial waited for a given subscription
758 as well as the number of issues registered in the database (all types)
759 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
761 $statuses is an arrayref of statuses and is mandatory.
766 my ( $subscription, $statuses ) = @_;
768 return unless ($subscription and @
$statuses);
770 my $statuses_string = join ',', @
$statuses;
772 my $dbh = C4
::Context
->dbh;
774 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,
775 publisheddatetext
, notes
, routingnotes
777 WHERE subscriptionid
=$subscription AND status IN
($statuses_string)
778 ORDER BY publisheddate
,serialid DESC
780 $debug and warn "GetSerials2 query: $query";
781 my $sth = $dbh->prepare($query);
785 while ( my $line = $sth->fetchrow_hashref ) {
786 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
787 # Format dates for display
788 for my $datefield ( qw( planneddate publisheddate ) ) {
789 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
790 $line->{$datefield} = q{};
793 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
796 push @serials, $line;
801 =head2 GetLatestSerials
803 \@serials = GetLatestSerials($subscriptionid,$limit)
804 get the $limit's latest serials arrived or missing for a given subscription
806 a ref to an array which contains all of the latest serials stored into a hash.
810 sub GetLatestSerials
{
811 my ( $subscriptionid, $limit ) = @_;
813 return unless ($subscriptionid and $limit);
815 my $dbh = C4
::Context
->dbh;
817 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
) );
818 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
820 WHERE subscriptionid = ?
821 AND status IN ($statuses)
822 ORDER BY publisheddate DESC LIMIT 0,$limit
824 my $sth = $dbh->prepare($strsth);
825 $sth->execute($subscriptionid);
827 while ( my $line = $sth->fetchrow_hashref ) {
828 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
829 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{planneddate
} ), dateonly
=> 1 } );
830 $line->{publisheddate
} = output_pref
( { dt
=> dt_from_string
( $line->{publisheddate
} ), dateonly
=> 1 } );
831 push @serials, $line;
837 =head2 GetDistributedTo
839 $distributedto=GetDistributedTo($subscriptionid)
840 This function returns the field distributedto for the subscription matching subscriptionid
844 sub GetDistributedTo
{
845 my $dbh = C4
::Context
->dbh;
847 my ($subscriptionid) = @_;
849 return unless ($subscriptionid);
851 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
852 my $sth = $dbh->prepare($query);
853 $sth->execute($subscriptionid);
854 return ($distributedto) = $sth->fetchrow;
860 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
861 $newinnerloop1, $newinnerloop2, $newinnerloop3
862 ) = GetNextSeq( $subscription, $pattern, $planneddate );
864 $subscription is a hashref containing all the attributes of the table
866 $pattern is a hashref containing all the attributes of the table
867 'subscription_numberpatterns'.
868 $planneddate is a date string in iso format.
869 This function get the next issue for the subscription given on input arg
874 my ($subscription, $pattern, $planneddate) = @_;
876 return unless ($subscription and $pattern);
878 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
879 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
882 if ($subscription->{'skip_serialseq'}) {
883 my @irreg = split /;/, $subscription->{'irregularity'};
885 my $irregularities = {};
886 $irregularities->{$_} = 1 foreach(@irreg);
887 my $issueno = GetFictiveIssueNumber
($subscription, $planneddate) + 1;
888 while($irregularities->{$issueno}) {
895 my $numberingmethod = $pattern->{numberingmethod
};
897 if ($numberingmethod) {
898 $calculated = $numberingmethod;
899 my $locale = $subscription->{locale
};
900 $newlastvalue1 = $subscription->{lastvalue1
} || 0;
901 $newlastvalue2 = $subscription->{lastvalue2
} || 0;
902 $newlastvalue3 = $subscription->{lastvalue3
} || 0;
903 $newinnerloop1 = $subscription->{innerloop1
} || 0;
904 $newinnerloop2 = $subscription->{innerloop2
} || 0;
905 $newinnerloop3 = $subscription->{innerloop3
} || 0;
908 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
911 for(my $i = 0; $i < $count; $i++) {
913 # check if we have to increase the new value.
915 if ($newinnerloop1 >= $pattern->{every1
}) {
917 $newlastvalue1 += $pattern->{add1
};
919 # reset counter if needed.
920 $newlastvalue1 = $pattern->{setto1
} if ($newlastvalue1 > $pattern->{whenmorethan1
});
923 # check if we have to increase the new value.
925 if ($newinnerloop2 >= $pattern->{every2
}) {
927 $newlastvalue2 += $pattern->{add2
};
929 # reset counter if needed.
930 $newlastvalue2 = $pattern->{setto2
} if ($newlastvalue2 > $pattern->{whenmorethan2
});
933 # check if we have to increase the new value.
935 if ($newinnerloop3 >= $pattern->{every3
}) {
937 $newlastvalue3 += $pattern->{add3
};
939 # reset counter if needed.
940 $newlastvalue3 = $pattern->{setto3
} if ($newlastvalue3 > $pattern->{whenmorethan3
});
944 my $newlastvalue1string = _numeration
( $newlastvalue1, $pattern->{numbering1
}, $locale );
945 $calculated =~ s/\{X\}/$newlastvalue1string/g;
948 my $newlastvalue2string = _numeration
( $newlastvalue2, $pattern->{numbering2
}, $locale );
949 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
952 my $newlastvalue3string = _numeration
( $newlastvalue3, $pattern->{numbering3
}, $locale );
953 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
958 $newlastvalue1, $newlastvalue2, $newlastvalue3,
959 $newinnerloop1, $newinnerloop2, $newinnerloop3);
964 $calculated = GetSeq($subscription, $pattern)
965 $subscription is a hashref containing all the attributes of the table 'subscription'
966 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
967 this function transforms {X},{Y},{Z} to 150,0,0 for example.
969 the sequence in string format
974 my ($subscription, $pattern) = @_;
976 return unless ($subscription and $pattern);
978 my $locale = $subscription->{locale
};
980 my $calculated = $pattern->{numberingmethod
};
982 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
983 $newlastvalue1 = _numeration
($newlastvalue1, $pattern->{numbering1
}, $locale) if ($pattern->{numbering1
}); # reset counter if needed.
984 $calculated =~ s/\{X\}/$newlastvalue1/g;
986 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
987 $newlastvalue2 = _numeration
($newlastvalue2, $pattern->{numbering2
}, $locale) if ($pattern->{numbering2
}); # reset counter if needed.
988 $calculated =~ s/\{Y\}/$newlastvalue2/g;
990 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
991 $newlastvalue3 = _numeration
($newlastvalue3, $pattern->{numbering3
}, $locale) if ($pattern->{numbering3
}); # reset counter if needed.
992 $calculated =~ s/\{Z\}/$newlastvalue3/g;
996 =head2 GetExpirationDate
998 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1000 this function return the next expiration date for a subscription given on input args.
1003 the enddate or undef
1007 sub GetExpirationDate
{
1008 my ( $subscriptionid, $startdate ) = @_;
1010 return unless ($subscriptionid);
1012 my $dbh = C4
::Context
->dbh;
1013 my $subscription = GetSubscription
($subscriptionid);
1016 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1017 $enddate = $startdate || $subscription->{startdate
};
1018 my @date = split( /-/, $enddate );
1020 return if ( scalar(@date) != 3 || not check_date
(@date) );
1022 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1023 if ( $frequency and $frequency->{unit
} ) {
1026 if ( my $length = $subscription->{numberlength
} ) {
1028 #calculate the date of the last issue.
1029 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1030 $enddate = GetNextDate
( $subscription, $enddate );
1032 } elsif ( $subscription->{monthlength
} ) {
1033 if ( $$subscription{startdate
} ) {
1034 my @enddate = Add_Delta_YM
( $date[0], $date[1], $date[2], 0, $subscription->{monthlength
} );
1035 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1037 } elsif ( $subscription->{weeklength
} ) {
1038 if ( $$subscription{startdate
} ) {
1039 my @date = split( /-/, $subscription->{startdate
} );
1040 my @enddate = Add_Delta_Days
( $date[0], $date[1], $date[2], $subscription->{weeklength
} * 7 );
1041 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1044 $enddate = $subscription->{enddate
};
1048 return $subscription->{enddate
};
1052 =head2 CountSubscriptionFromBiblionumber
1054 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1055 this returns a count of the subscriptions for a given biblionumber
1057 the number of subscriptions
1061 sub CountSubscriptionFromBiblionumber
{
1062 my ($biblionumber) = @_;
1064 return unless ($biblionumber);
1066 my $dbh = C4
::Context
->dbh;
1067 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1068 my $sth = $dbh->prepare($query);
1069 $sth->execute($biblionumber);
1070 my $subscriptionsnumber = $sth->fetchrow;
1071 return $subscriptionsnumber;
1074 =head2 ModSubscriptionHistory
1076 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1078 this function modifies the history of a subscription. Put your new values on input arg.
1079 returns the number of rows affected
1083 sub ModSubscriptionHistory
{
1084 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1086 return unless ($subscriptionid);
1088 my $dbh = C4
::Context
->dbh;
1089 my $query = "UPDATE subscriptionhistory
1090 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1091 WHERE subscriptionid=?
1093 my $sth = $dbh->prepare($query);
1094 $receivedlist =~ s/^; // if $receivedlist;
1095 $missinglist =~ s/^; // if $missinglist;
1096 $opacnote =~ s/^; // if $opacnote;
1097 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1101 =head2 ModSerialStatus
1103 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1104 $publisheddatetext, $status, $notes);
1106 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1107 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1111 sub ModSerialStatus
{
1112 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1113 $status, $notes) = @_;
1115 return unless ($serialid);
1117 #It is a usual serial
1118 # 1st, get previous status :
1119 my $dbh = C4
::Context
->dbh;
1120 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1121 FROM serial, subscription
1122 WHERE serial.subscriptionid=subscription.subscriptionid
1124 my $sth = $dbh->prepare($query);
1125 $sth->execute($serialid);
1126 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1127 my $frequency = GetSubscriptionFrequency
($periodicity);
1129 # change status & update subscriptionhistory
1131 if ( $status == DELETED
) {
1132 DelIssue
( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1137 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1138 planneddate = ?, status = ?, notes = ?
1141 $sth = $dbh->prepare($query);
1142 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1143 $planneddate, $status, $notes, $serialid );
1144 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1145 $sth = $dbh->prepare($query);
1146 $sth->execute($subscriptionid);
1147 my $val = $sth->fetchrow_hashref;
1148 unless ( $val->{manualhistory
} ) {
1149 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1150 $sth = $dbh->prepare($query);
1151 $sth->execute($subscriptionid);
1152 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1154 if ( $status == ARRIVED
|| ($oldstatus == ARRIVED
&& $status != ARRIVED
) ) {
1155 $recievedlist .= "; $serialseq"
1156 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1159 # in case serial has been previously marked as missing
1160 if (grep /$status/, (EXPECTED
, ARRIVED
, LATE
, CLAIMED
)) {
1161 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1164 $missinglist .= "; $serialseq"
1165 if ( ( grep { $_ == $status } ( MISSING_STATUSES
) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1166 $missinglist .= "; not issued $serialseq"
1167 if ( $status == NOT_ISSUED
&& $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1169 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1170 $sth = $dbh->prepare($query);
1171 $recievedlist =~ s/^; //;
1172 $missinglist =~ s/^; //;
1173 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1177 # create new expected entry if needed (ie : was "expected" and has changed)
1178 my $otherIssueExpected = scalar findSerialsByStatus
(EXPECTED
, $subscriptionid);
1179 if ( !$otherIssueExpected && $oldstatus == EXPECTED
&& $status != EXPECTED
) {
1180 my $subscription = GetSubscription
($subscriptionid);
1181 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1185 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1186 $newinnerloop1, $newinnerloop2, $newinnerloop3
1188 = GetNextSeq
( $subscription, $pattern, $publisheddate );
1190 # next date (calculated from actual date & frequency parameters)
1191 my $nextpublisheddate = GetNextDate
($subscription, $publisheddate, 1);
1192 my $nextpubdate = $nextpublisheddate;
1193 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1194 WHERE subscriptionid = ?";
1195 $sth = $dbh->prepare($query);
1196 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1198 NewIssue
( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1200 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1201 if ( $subscription->{letter
} && $status == ARRIVED
&& $oldstatus != ARRIVED
) {
1202 require C4
::Letters
;
1203 C4
::Letters
::SendAlerts
( 'issue', $serialid, $subscription->{letter
} );
1210 =head2 GetNextExpected
1212 $nextexpected = GetNextExpected($subscriptionid)
1214 Get the planneddate for the current expected issue of the subscription.
1220 planneddate => ISO date
1225 sub GetNextExpected
{
1226 my ($subscriptionid) = @_;
1228 my $dbh = C4
::Context
->dbh;
1232 WHERE subscriptionid
= ?
1236 my $sth = $dbh->prepare($query);
1238 # Each subscription has only one 'expected' issue.
1239 $sth->execute( $subscriptionid, EXPECTED
);
1240 my $nextissue = $sth->fetchrow_hashref;
1241 if ( !$nextissue ) {
1245 WHERE subscriptionid
= ?
1246 ORDER BY publisheddate DESC
1249 $sth = $dbh->prepare($query);
1250 $sth->execute($subscriptionid);
1251 $nextissue = $sth->fetchrow_hashref;
1253 foreach(qw
/planneddate publisheddate/) {
1254 if ( !defined $nextissue->{$_} ) {
1255 # or should this default to 1st Jan ???
1256 $nextissue->{$_} = strftime
( '%Y-%m-%d', localtime );
1258 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1266 =head2 ModNextExpected
1268 ModNextExpected($subscriptionid,$date)
1270 Update the planneddate for the current expected issue of the subscription.
1271 This will modify all future prediction results.
1273 C<$date> is an ISO date.
1279 sub ModNextExpected
{
1280 my ( $subscriptionid, $date ) = @_;
1281 my $dbh = C4
::Context
->dbh;
1283 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1284 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1286 # Each subscription has only one 'expected' issue.
1287 $sth->execute( $date, $date, $subscriptionid, EXPECTED
);
1292 =head2 GetSubscriptionIrregularities
1296 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1297 get the list of irregularities for a subscription
1303 sub GetSubscriptionIrregularities
{
1304 my $subscriptionid = shift;
1306 return unless $subscriptionid;
1308 my $dbh = C4
::Context
->dbh;
1312 WHERE subscriptionid
= ?
1314 my $sth = $dbh->prepare($query);
1315 $sth->execute($subscriptionid);
1317 my ($result) = $sth->fetchrow_array;
1318 my @irreg = split /;/, $result;
1323 =head2 ModSubscription
1325 this function modifies a subscription. Put all new values on input args.
1326 returns the number of rows affected
1330 sub ModSubscription
{
1332 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1333 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1334 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1335 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1336 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1337 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1338 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1341 my $dbh = C4
::Context
->dbh;
1342 my $query = "UPDATE subscription
1343 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1344 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1345 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1346 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1347 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1348 callnumber=?, notes=?, letter=?, manualhistory=?,
1349 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1350 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1352 WHERE subscriptionid = ?";
1354 my $sth = $dbh->prepare($query);
1356 $auser, $branchcode, $aqbooksellerid, $cost,
1357 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1358 $irregularity, $numberpattern, $locale, $numberlength,
1359 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1360 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1361 $status, $biblionumber, $callnumber, $notes,
1362 $letter, ($manualhistory ?
$manualhistory : 0),
1363 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1364 $graceperiod, $location, $enddate, $skip_serialseq,
1367 my $rows = $sth->rows;
1369 logaction
( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1373 =head2 NewSubscription
1375 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1376 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1377 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1378 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1379 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1380 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1382 Create a new subscription with value given on input args.
1385 the id of this new subscription
1389 sub NewSubscription
{
1391 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1392 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1393 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1394 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1395 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1396 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1397 $location, $enddate, $skip_serialseq
1399 my $dbh = C4
::Context
->dbh;
1401 #save subscription (insert into database)
1403 INSERT INTO subscription
1404 (librarian
, branchcode
, aqbooksellerid
, cost
, aqbudgetid
,
1405 biblionumber
, startdate
, periodicity
, numberlength
, weeklength
,
1406 monthlength
, lastvalue1
, innerloop1
, lastvalue2
, innerloop2
,
1407 lastvalue3
, innerloop3
, status
, notes
, letter
, firstacquidate
,
1408 irregularity
, numberpattern
, locale
, callnumber
,
1409 manualhistory
, internalnotes
, serialsadditems
, staffdisplaycount
,
1410 opacdisplaycount
, graceperiod
, location
, enddate
, skip_serialseq
)
1411 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
)
1413 my $sth = $dbh->prepare($query);
1415 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1416 $startdate, $periodicity, $numberlength, $weeklength,
1417 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1418 $lastvalue3, $innerloop3, $status, $notes, $letter,
1419 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1420 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1421 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1424 my $subscriptionid = $dbh->{'mysql_insertid'};
1426 $enddate = GetExpirationDate
( $subscriptionid, $startdate );
1430 WHERE subscriptionid
=?
1432 $sth = $dbh->prepare($query);
1433 $sth->execute( $enddate, $subscriptionid );
1436 # then create the 1st expected number
1438 INSERT INTO subscriptionhistory
1439 (biblionumber
, subscriptionid
, histstartdate
)
1442 $sth = $dbh->prepare($query);
1443 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1445 # reread subscription to get a hash (for calculation of the 1st issue number)
1446 my $subscription = GetSubscription
($subscriptionid);
1447 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1449 # calculate issue number
1450 my $serialseq = GetSeq
($subscription, $pattern) || q{};
1454 serialseq
=> $serialseq,
1455 serialseq_x
=> $subscription->{'lastvalue1'},
1456 serialseq_y
=> $subscription->{'lastvalue2'},
1457 serialseq_z
=> $subscription->{'lastvalue3'},
1458 subscriptionid
=> $subscriptionid,
1459 biblionumber
=> $biblionumber,
1461 planneddate
=> $firstacquidate,
1462 publisheddate
=> $firstacquidate,
1466 logaction
( "SERIAL", "ADD", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1468 #set serial flag on biblio if not already set.
1469 my $bib = GetBiblio
($biblionumber);
1470 if ( $bib and !$bib->{'serial'} ) {
1471 my $record = GetMarcBiblio
($biblionumber);
1472 my ( $tag, $subf ) = GetMarcFromKohaField
( 'biblio.serial', $bib->{'frameworkcode'} );
1474 eval { $record->field($tag)->update( $subf => 1 ); };
1476 ModBiblio
( $record, $biblionumber, $bib->{'frameworkcode'} );
1478 return $subscriptionid;
1481 =head2 ReNewSubscription
1483 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1485 this function renew a subscription with values given on input args.
1489 sub ReNewSubscription
{
1490 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1491 my $dbh = C4
::Context
->dbh;
1492 my $subscription = GetSubscription
($subscriptionid);
1496 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1497 WHERE biblio
.biblionumber
=?
1499 my $sth = $dbh->prepare($query);
1500 $sth->execute( $subscription->{biblionumber
} );
1501 my $biblio = $sth->fetchrow_hashref;
1503 if ( C4
::Context
->preference("RenewSerialAddsSuggestion") ) {
1504 require C4
::Suggestions
;
1505 C4
::Suggestions
::NewSuggestion
(
1506 { 'suggestedby' => $user,
1507 'title' => $subscription->{bibliotitle
},
1508 'author' => $biblio->{author
},
1509 'publishercode' => $biblio->{publishercode
},
1510 'note' => $biblio->{note
},
1511 'biblionumber' => $subscription->{biblionumber
}
1516 # renew subscription
1519 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
,reneweddate
=NOW
()
1520 WHERE subscriptionid
=?
1522 $sth = $dbh->prepare($query);
1523 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1524 my $enddate = GetExpirationDate
($subscriptionid);
1525 $debug && warn "enddate :$enddate";
1529 WHERE subscriptionid
=?
1531 $sth = $dbh->prepare($query);
1532 $sth->execute( $enddate, $subscriptionid );
1534 UPDATE subscriptionhistory
1536 WHERE subscriptionid
=?
1538 $sth = $dbh->prepare($query);
1539 $sth->execute( $enddate, $subscriptionid );
1541 logaction
( "SERIAL", "RENEW", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1547 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1549 Create a new issue stored on the database.
1550 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1551 returns the serial id
1556 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1557 $publisheddate, $publisheddatetext, $notes ) = @_;
1558 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1560 return unless ($subscriptionid);
1562 my $schema = Koha
::Database
->new()->schema();
1564 my $subscription = Koha
::Subscriptions
->find( $subscriptionid );
1566 my $serial = Koha
::Serial
->new(
1568 serialseq
=> $serialseq,
1569 serialseq_x
=> $subscription->lastvalue1(),
1570 serialseq_y
=> $subscription->lastvalue2(),
1571 serialseq_z
=> $subscription->lastvalue3(),
1572 subscriptionid
=> $subscriptionid,
1573 biblionumber
=> $biblionumber,
1575 planneddate
=> $planneddate,
1576 publisheddate
=> $publisheddate,
1577 publisheddatetext
=> $publisheddatetext,
1582 my $serialid = $serial->id();
1584 my $subscription_history = Koha
::Subscription
::Histories
->find($subscriptionid);
1585 my $missinglist = $subscription_history->missinglist();
1586 my $recievedlist = $subscription_history->recievedlist();
1588 if ( $status == ARRIVED
) {
1589 ### TODO Add a feature that improves recognition and description.
1590 ### As such count (serialseq) i.e. : N18,2(N19),N20
1591 ### Would use substr and index But be careful to previous presence of ()
1592 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1594 if ( grep { /^$status$/ } (MISSING_STATUSES
) ) {
1595 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1598 $recievedlist =~ s/^; //;
1599 $missinglist =~ s/^; //;
1601 $subscription_history->recievedlist($recievedlist);
1602 $subscription_history->missinglist($missinglist);
1603 $subscription_history->store();
1608 =head2 HasSubscriptionStrictlyExpired
1610 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1612 the subscription has stricly expired when today > the end subscription date
1615 1 if true, 0 if false, -1 if the expiration date is not set.
1619 sub HasSubscriptionStrictlyExpired
{
1621 # Getting end of subscription date
1622 my ($subscriptionid) = @_;
1624 return unless ($subscriptionid);
1626 my $dbh = C4
::Context
->dbh;
1627 my $subscription = GetSubscription
($subscriptionid);
1628 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1630 # If the expiration date is set
1631 if ( $expirationdate != 0 ) {
1632 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1634 # Getting today's date
1635 my ( $nowyear, $nowmonth, $nowday ) = Today
();
1637 # if today's date > expiration date, then the subscription has stricly expired
1638 if ( Delta_Days
( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1645 # There are some cases where the expiration date is not set
1646 # As we can't determine if the subscription has expired on a date-basis,
1652 =head2 HasSubscriptionExpired
1654 $has_expired = HasSubscriptionExpired($subscriptionid)
1656 the subscription has expired when the next issue to arrive is out of subscription limit.
1659 0 if the subscription has not expired
1660 1 if the subscription has expired
1661 2 if has subscription does not have a valid expiration date set
1665 sub HasSubscriptionExpired
{
1666 my ($subscriptionid) = @_;
1668 return unless ($subscriptionid);
1670 my $dbh = C4
::Context
->dbh;
1671 my $subscription = GetSubscription
($subscriptionid);
1672 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1673 if ( $frequency and $frequency->{unit
} ) {
1674 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1675 if (!defined $expirationdate) {
1676 $expirationdate = q{};
1679 SELECT max
(planneddate
)
1681 WHERE subscriptionid
=?
1683 my $sth = $dbh->prepare($query);
1684 $sth->execute($subscriptionid);
1685 my ($res) = $sth->fetchrow;
1686 if (!$res || $res=~m/^0000/) {
1689 my @res = split( /-/, $res );
1690 my @endofsubscriptiondate = split( /-/, $expirationdate );
1691 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date
(@res) || not check_date
(@endofsubscriptiondate) );
1693 if ( ( @endofsubscriptiondate && Delta_Days
( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1698 if ( $subscription->{'numberlength'} ) {
1699 my $countreceived = countissuesfrom
( $subscriptionid, $subscription->{'startdate'} );
1700 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1706 return 0; # Notice that you'll never get here.
1709 =head2 SetDistributedto
1711 SetDistributedto($distributedto,$subscriptionid);
1712 This function update the value of distributedto for a subscription given on input arg.
1716 sub SetDistributedto
{
1717 my ( $distributedto, $subscriptionid ) = @_;
1718 my $dbh = C4
::Context
->dbh;
1722 WHERE subscriptionid
=?
1724 my $sth = $dbh->prepare($query);
1725 $sth->execute( $distributedto, $subscriptionid );
1729 =head2 DelSubscription
1731 DelSubscription($subscriptionid)
1732 this function deletes subscription which has $subscriptionid as id.
1736 sub DelSubscription
{
1737 my ($subscriptionid) = @_;
1738 my $dbh = C4
::Context
->dbh;
1739 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1740 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1741 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1743 my $afs = Koha
::AdditionalField
->all({tablename
=> 'subscription'});
1744 foreach my $af (@
$afs) {
1745 $af->delete_values({record_id
=> $subscriptionid});
1748 logaction
( "SERIAL", "DELETE", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1753 DelIssue($serialseq,$subscriptionid)
1754 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1756 returns the number of rows affected
1761 my ($dataissue) = @_;
1762 my $dbh = C4
::Context
->dbh;
1763 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1768 AND subscriptionid
= ?
1770 my $mainsth = $dbh->prepare($query);
1771 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1773 #Delete element from subscription history
1774 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1775 my $sth = $dbh->prepare($query);
1776 $sth->execute( $dataissue->{'subscriptionid'} );
1777 my $val = $sth->fetchrow_hashref;
1778 unless ( $val->{manualhistory
} ) {
1780 SELECT
* FROM subscriptionhistory
1781 WHERE subscriptionid
= ?
1783 my $sth = $dbh->prepare($query);
1784 $sth->execute( $dataissue->{'subscriptionid'} );
1785 my $data = $sth->fetchrow_hashref;
1786 my $serialseq = $dataissue->{'serialseq'};
1787 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1788 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1789 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1790 $sth = $dbh->prepare($strsth);
1791 $sth->execute( $dataissue->{'subscriptionid'} );
1794 return $mainsth->rows;
1797 =head2 GetLateOrMissingIssues
1799 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1801 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1804 the issuelist as an array of hash refs. Each element of this array contains
1805 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1809 sub GetLateOrMissingIssues
{
1810 my ( $supplierid, $serialid, $order ) = @_;
1812 return unless ( $supplierid or $serialid );
1814 my $dbh = C4
::Context
->dbh;
1819 $byserial = "and serialid = " . $serialid;
1822 $order .= ", title";
1826 my $missing_statuses_string = join ',', (MISSING_STATUSES
);
1828 $sth = $dbh->prepare(
1830 serialid, aqbooksellerid, name,
1831 biblio.title, biblioitems.issn, planneddate, serialseq,
1832 serial.status, serial.subscriptionid, claimdate, claims_count,
1833 subscription.branchcode
1835 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1836 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1837 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1838 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1839 WHERE subscription.subscriptionid = serial.subscriptionid
1840 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1841 AND subscription.aqbooksellerid=$supplierid
1846 $sth = $dbh->prepare(
1848 serialid, aqbooksellerid, name,
1849 biblio.title, planneddate, serialseq,
1850 serial.status, serial.subscriptionid, claimdate, claims_count,
1851 subscription.branchcode
1853 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1854 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1855 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1856 WHERE subscription.subscriptionid = serial.subscriptionid
1857 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1862 $sth->execute( EXPECTED
, LATE
, CLAIMED
);
1864 while ( my $line = $sth->fetchrow_hashref ) {
1866 if ($line->{planneddate
} && $line->{planneddate
} !~/^0+\-/) {
1867 $line->{planneddateISO
} = $line->{planneddate
};
1868 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{"planneddate"} ), dateonly
=> 1 } );
1870 if ($line->{claimdate
} && $line->{claimdate
} !~/^0+\-/) {
1871 $line->{claimdateISO
} = $line->{claimdate
};
1872 $line->{claimdate
} = output_pref
( { dt
=> dt_from_string
( $line->{"claimdate"} ), dateonly
=> 1 } );
1874 $line->{"status".$line->{status
}} = 1;
1876 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
1877 record_id
=> $line->{subscriptionid
},
1878 tablename
=> 'subscription'
1880 %$line = ( %$line, additional_fields
=> $additional_field_values->{$line->{subscriptionid
}} );
1882 push @issuelist, $line;
1889 &updateClaim($serialid)
1891 this function updates the time when a claim is issued for late/missing items
1893 called from claims.pl file
1898 my ($serialid) = @_;
1899 my $dbh = C4
::Context
->dbh;
1902 SET claimdate
= NOW
(),
1903 claims_count
= claims_count
+ 1
1909 =head2 getsupplierbyserialid
1911 $result = getsupplierbyserialid($serialid)
1913 this function is used to find the supplier id given a serial id
1916 hashref containing serialid, subscriptionid, and aqbooksellerid
1920 sub getsupplierbyserialid
{
1921 my ($serialid) = @_;
1922 my $dbh = C4
::Context
->dbh;
1923 my $sth = $dbh->prepare(
1924 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1926 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1930 $sth->execute($serialid);
1931 my $line = $sth->fetchrow_hashref;
1932 my $result = $line->{'aqbooksellerid'};
1936 =head2 check_routing
1938 $result = &check_routing($subscriptionid)
1940 this function checks to see if a serial has a routing list and returns the count of routingid
1941 used to show either an 'add' or 'edit' link
1946 my ($subscriptionid) = @_;
1948 return unless ($subscriptionid);
1950 my $dbh = C4
::Context
->dbh;
1951 my $sth = $dbh->prepare(
1952 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1953 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1954 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1957 $sth->execute($subscriptionid);
1958 my $line = $sth->fetchrow_hashref;
1959 my $result = $line->{'routingids'};
1963 =head2 addroutingmember
1965 addroutingmember($borrowernumber,$subscriptionid)
1967 this function takes a borrowernumber and subscriptionid and adds the member to the
1968 routing list for that serial subscription and gives them a rank on the list
1969 of either 1 or highest current rank + 1
1973 sub addroutingmember
{
1974 my ( $borrowernumber, $subscriptionid ) = @_;
1976 return unless ($borrowernumber and $subscriptionid);
1979 my $dbh = C4
::Context
->dbh;
1980 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1981 $sth->execute($subscriptionid);
1982 while ( my $line = $sth->fetchrow_hashref ) {
1983 if ( $line->{'rank'} > 0 ) {
1984 $rank = $line->{'rank'} + 1;
1989 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1990 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1993 =head2 reorder_members
1995 reorder_members($subscriptionid,$routingid,$rank)
1997 this function is used to reorder the routing list
1999 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2000 - it gets all members on list puts their routingid's into an array
2001 - removes the one in the array that is $routingid
2002 - then reinjects $routingid at point indicated by $rank
2003 - then update the database with the routingids in the new order
2007 sub reorder_members
{
2008 my ( $subscriptionid, $routingid, $rank ) = @_;
2009 my $dbh = C4
::Context
->dbh;
2010 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2011 $sth->execute($subscriptionid);
2013 while ( my $line = $sth->fetchrow_hashref ) {
2014 push( @result, $line->{'routingid'} );
2017 # To find the matching index
2019 my $key = -1; # to allow for 0 being a valid response
2020 for ( $i = 0 ; $i < @result ; $i++ ) {
2021 if ( $routingid == $result[$i] ) {
2022 $key = $i; # save the index
2027 # if index exists in array then move it to new position
2028 if ( $key > -1 && $rank > 0 ) {
2029 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2030 my $moving_item = splice( @result, $key, 1 );
2031 splice( @result, $new_rank, 0, $moving_item );
2033 for ( my $j = 0 ; $j < @result ; $j++ ) {
2034 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2040 =head2 delroutingmember
2042 delroutingmember($routingid,$subscriptionid)
2044 this function either deletes one member from routing list if $routingid exists otherwise
2045 deletes all members from the routing list
2049 sub delroutingmember
{
2051 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2052 my ( $routingid, $subscriptionid ) = @_;
2053 my $dbh = C4
::Context
->dbh;
2055 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2056 $sth->execute($routingid);
2057 reorder_members
( $subscriptionid, $routingid );
2059 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2060 $sth->execute($subscriptionid);
2065 =head2 getroutinglist
2067 @routinglist = getroutinglist($subscriptionid)
2069 this gets the info from the subscriptionroutinglist for $subscriptionid
2072 the routinglist as an array. Each element of the array contains a hash_ref containing
2073 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2077 sub getroutinglist
{
2078 my ($subscriptionid) = @_;
2079 my $dbh = C4
::Context
->dbh;
2080 my $sth = $dbh->prepare(
2081 'SELECT routingid, borrowernumber, ranking, biblionumber
2083 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2084 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2086 $sth->execute($subscriptionid);
2087 my $routinglist = $sth->fetchall_arrayref({});
2088 return @
{$routinglist};
2091 =head2 countissuesfrom
2093 $result = countissuesfrom($subscriptionid,$startdate)
2095 Returns a count of serial rows matching the given subsctiptionid
2096 with published date greater than startdate
2100 sub countissuesfrom
{
2101 my ( $subscriptionid, $startdate ) = @_;
2102 my $dbh = C4
::Context
->dbh;
2106 WHERE subscriptionid
=?
2107 AND serial
.publisheddate
>?
2109 my $sth = $dbh->prepare($query);
2110 $sth->execute( $subscriptionid, $startdate );
2111 my ($countreceived) = $sth->fetchrow;
2112 return $countreceived;
2117 $result = CountIssues($subscriptionid)
2119 Returns a count of serial rows matching the given subsctiptionid
2124 my ($subscriptionid) = @_;
2125 my $dbh = C4
::Context
->dbh;
2129 WHERE subscriptionid
=?
2131 my $sth = $dbh->prepare($query);
2132 $sth->execute($subscriptionid);
2133 my ($countreceived) = $sth->fetchrow;
2134 return $countreceived;
2139 $result = HasItems($subscriptionid)
2141 returns a count of items from serial matching the subscriptionid
2146 my ($subscriptionid) = @_;
2147 my $dbh = C4
::Context
->dbh;
2149 SELECT COUNT
(serialitems
.itemnumber
)
2151 LEFT JOIN serialitems USING
(serialid
)
2152 WHERE subscriptionid
=? AND serialitems
.serialid IS NOT NULL
2154 my $sth=$dbh->prepare($query);
2155 $sth->execute($subscriptionid);
2156 my ($countitems)=$sth->fetchrow_array();
2160 =head2 abouttoexpire
2162 $result = abouttoexpire($subscriptionid)
2164 this function alerts you to the penultimate issue for a serial subscription
2166 returns 1 - if this is the penultimate issue
2172 my ($subscriptionid) = @_;
2173 my $dbh = C4
::Context
->dbh;
2174 my $subscription = GetSubscription
($subscriptionid);
2175 my $per = $subscription->{'periodicity'};
2176 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($per);
2177 if ($frequency and $frequency->{unit
}){
2179 my $expirationdate = GetExpirationDate
($subscriptionid);
2181 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2182 my $nextdate = GetNextDate
($subscription, $res);
2184 # only compare dates if both dates exist.
2185 if ($nextdate and $expirationdate) {
2186 if(Date
::Calc
::Delta_Days
(
2187 split( /-/, $nextdate ),
2188 split( /-/, $expirationdate )
2194 } elsif ($subscription->{numberlength
}>0) {
2195 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2201 sub in_array
{ # used in next sub down
2202 my ( $val, @elements ) = @_;
2203 foreach my $elem (@elements) {
2204 if ( $val == $elem ) {
2211 =head2 GetSubscriptionsFromBorrower
2213 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2215 this gets the info from subscriptionroutinglist for each $subscriptionid
2218 a count of the serial subscription routing lists to which a patron belongs,
2219 with the titles of those serial subscriptions as an array. Each element of the array
2220 contains a hash_ref with subscriptionID and title of subscription.
2224 sub GetSubscriptionsFromBorrower
{
2225 my ($borrowernumber) = @_;
2226 my $dbh = C4
::Context
->dbh;
2227 my $sth = $dbh->prepare(
2228 "SELECT subscription.subscriptionid, biblio.title
2230 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2231 JOIN subscriptionroutinglist USING (subscriptionid)
2232 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2235 $sth->execute($borrowernumber);
2238 while ( my $line = $sth->fetchrow_hashref ) {
2240 push( @routinglist, $line );
2242 return ( $count, @routinglist );
2246 =head2 GetFictiveIssueNumber
2248 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2250 Get the position of the issue published at $publisheddate, considering the
2251 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2252 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2253 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2254 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2255 depending on how many rows are in serial table.
2256 The issue number calculation is based on subscription frequency, first acquisition
2257 date, and $publisheddate.
2261 sub GetFictiveIssueNumber
{
2262 my ($subscription, $publisheddate) = @_;
2264 my $frequency = GetSubscriptionFrequency
($subscription->{'periodicity'});
2265 my $unit = $frequency->{unit
} ?
lc $frequency->{'unit'} : undef;
2269 my ($year, $month, $day) = split /-/, $publisheddate;
2270 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2274 if($unit eq 'day') {
2275 $delta = Delta_Days
($fa_year, $fa_month, $fa_day, $year, $month, $day);
2276 } elsif($unit eq 'week') {
2277 ($wkno, $year) = Week_of_Year
($year, $month, $day);
2278 my ($fa_wkno, $fa_yr) = Week_of_Year
($fa_year, $fa_month, $fa_day);
2279 $delta = ($fa_yr == $year) ?
($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2280 } elsif($unit eq 'month') {
2281 $delta = ($fa_year == $year)
2282 ?
($month - $fa_month)
2283 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2284 } elsif($unit eq 'year') {
2285 $delta = $year - $fa_year;
2287 if($frequency->{'unitsperissue'} == 1) {
2288 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2290 # Assuming issuesperunit == 1
2291 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2297 sub _get_next_date_day
{
2298 my ($subscription, $freqdata, $year, $month, $day) = @_;
2300 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2301 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , $freqdata->{unitsperissue
} );
2302 $subscription->{countissuesperunit
} = 1;
2304 $subscription->{countissuesperunit
}++;
2307 return ($year, $month, $day);
2310 sub _get_next_date_week
{
2311 my ($subscription, $freqdata, $year, $month, $day) = @_;
2313 my ($wkno, $yr) = Week_of_Year
($year, $month, $day);
2314 my $fa_dow = Day_of_Week
(split /-/, $subscription->{firstacquidate
});
2316 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2317 $subscription->{countissuesperunit
} = 1;
2318 $wkno += $freqdata->{unitsperissue
};
2323 ($year,$month,$day) = Monday_of_Week
($wkno, $yr);
2324 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $fa_dow - 1);
2326 # Try to guess the next day of week
2327 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit
});
2328 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2329 $subscription->{countissuesperunit
}++;
2332 return ($year, $month, $day);
2335 sub _get_next_date_month
{
2336 my ($subscription, $freqdata, $year, $month, $day) = @_;
2339 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate
};
2341 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2342 $subscription->{countissuesperunit
} = 1;
2343 ($year,$month,$day) = Add_Delta_YM
($year,$month,$day, 0,
2344 $freqdata->{unitsperissue
});
2345 my $days_in_month = Days_in_Month
($year, $month);
2346 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2348 # Try to guess the next day in month
2349 my $days_in_month = Days_in_Month
($year, $month);
2350 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2351 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2352 $subscription->{countissuesperunit
}++;
2355 return ($year, $month, $day);
2358 sub _get_next_date_year
{
2359 my ($subscription, $freqdata, $year, $month, $day) = @_;
2361 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate
};
2363 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2364 $subscription->{countissuesperunit
} = 1;
2365 ($year) = Add_Delta_YM
($year,$month,$day, $freqdata->{"unitsperissue"},0);
2367 my $days_in_month = Days_in_Month
($year, $month);
2368 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2370 # Try to guess the next day in year
2371 my $days_in_year = Days_in_Year
($year,12); #Sum the days of all the months of this year
2372 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2373 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2374 $subscription->{countissuesperunit
}++;
2377 return ($year, $month, $day);
2382 $resultdate = GetNextDate($publisheddate,$subscription)
2384 this function it takes the publisheddate and will return the next issue's date
2385 and will skip dates if there exists an irregularity.
2386 $publisheddate has to be an ISO date
2387 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2388 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2389 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2390 skipped then the returned date will be 2007-05-10
2393 $resultdate - then next date in the sequence (ISO date)
2395 Return undef if subscription is irregular
2400 my ( $subscription, $publisheddate, $updatecount ) = @_;
2402 return unless $subscription and $publisheddate;
2404 my $freqdata = GetSubscriptionFrequency
($subscription->{'periodicity'});
2406 if ($freqdata->{'unit'}) {
2407 my ( $year, $month, $day ) = split /-/, $publisheddate;
2409 # Process an irregularity Hash
2410 # Suppose that irregularities are stored in a string with this structure
2411 # irreg1;irreg2;irreg3
2412 # where irregX is the number of issue which will not be received
2413 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2415 if ( $subscription->{irregularity
} ) {
2416 my @irreg = split /;/, $subscription->{'irregularity'} ;
2417 foreach my $irregularity (@irreg) {
2418 $irregularities{$irregularity} = 1;
2422 # Get the 'fictive' next issue number
2423 # It is used to check if next issue is an irregular issue.
2424 my $issueno = GetFictiveIssueNumber
($subscription, $publisheddate) + 1;
2426 # Then get the next date
2427 my $unit = lc $freqdata->{'unit'};
2428 if ($unit eq 'day') {
2429 while ($irregularities{$issueno}) {
2430 ($year, $month, $day) = _get_next_date_day
($subscription,
2431 $freqdata, $year, $month, $day);
2434 ($year, $month, $day) = _get_next_date_day
($subscription, $freqdata,
2435 $year, $month, $day);
2437 elsif ($unit eq 'week') {
2438 while ($irregularities{$issueno}) {
2439 ($year, $month, $day) = _get_next_date_week
($subscription,
2440 $freqdata, $year, $month, $day);
2443 ($year, $month, $day) = _get_next_date_week
($subscription,
2444 $freqdata, $year, $month, $day);
2446 elsif ($unit eq 'month') {
2447 while ($irregularities{$issueno}) {
2448 ($year, $month, $day) = _get_next_date_month
($subscription,
2449 $freqdata, $year, $month, $day);
2452 ($year, $month, $day) = _get_next_date_month
($subscription,
2453 $freqdata, $year, $month, $day);
2455 elsif ($unit eq 'year') {
2456 while ($irregularities{$issueno}) {
2457 ($year, $month, $day) = _get_next_date_year
($subscription,
2458 $freqdata, $year, $month, $day);
2461 ($year, $month, $day) = _get_next_date_year
($subscription,
2462 $freqdata, $year, $month, $day);
2466 my $dbh = C4
::Context
->dbh;
2469 SET countissuesperunit
= ?
2470 WHERE subscriptionid
= ?
2472 my $sth = $dbh->prepare($query);
2473 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2476 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2482 $string = &_numeration($value,$num_type,$locale);
2484 _numeration returns the string corresponding to $value in the num_type
2494 my ($value, $num_type, $locale) = @_;
2499 if ( $num_type =~ /^dayname$/ ) {
2500 # 1970-11-01 was a Sunday
2501 $value = $value % 7;
2502 my $dt = DateTime
->new(
2508 $string = $dt->strftime("%A");
2509 } elsif ( $num_type =~ /^monthname$/ ) {
2510 $value = $value % 12;
2511 my $dt = DateTime
->new(
2513 month
=> $value + 1,
2516 $string = $dt->strftime("%B");
2517 } elsif ( $num_type =~ /^season$/ ) {
2518 my @seasons= qw( Spring Summer Fall Winter );
2519 $value = $value % 4;
2520 $string = $seasons[$value];
2528 =head2 is_barcode_in_use
2530 Returns number of occurrences of the barcode in the items table
2531 Can be used as a boolean test of whether the barcode has
2532 been deployed as yet
2536 sub is_barcode_in_use
{
2537 my $barcode = shift;
2538 my $dbh = C4
::Context
->dbh;
2539 my $occurrences = $dbh->selectall_arrayref(
2540 'SELECT itemnumber from items where barcode = ?',
2545 return @
{$occurrences};
2548 =head2 CloseSubscription
2549 Close a subscription given a subscriptionid
2551 sub CloseSubscription
{
2552 my ( $subscriptionid ) = @_;
2553 return unless $subscriptionid;
2554 my $dbh = C4
::Context
->dbh;
2555 my $sth = $dbh->prepare( q{
2558 WHERE subscriptionid = ?
2560 $sth->execute( $subscriptionid );
2562 # Set status = missing when status = stopped
2563 $sth = $dbh->prepare( q{
2566 WHERE subscriptionid = ?
2569 $sth->execute( STOPPED
, $subscriptionid, EXPECTED
);
2572 =head2 ReopenSubscription
2573 Reopen a subscription given a subscriptionid
2575 sub ReopenSubscription
{
2576 my ( $subscriptionid ) = @_;
2577 return unless $subscriptionid;
2578 my $dbh = C4
::Context
->dbh;
2579 my $sth = $dbh->prepare( q{
2582 WHERE subscriptionid = ?
2584 $sth->execute( $subscriptionid );
2586 # Set status = expected when status = stopped
2587 $sth = $dbh->prepare( q{
2590 WHERE subscriptionid = ?
2593 $sth->execute( EXPECTED
, $subscriptionid, STOPPED
);
2596 =head2 subscriptionCurrentlyOnOrder
2598 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2600 Return 1 if subscription is currently on order else 0.
2604 sub subscriptionCurrentlyOnOrder
{
2605 my ( $subscriptionid ) = @_;
2606 my $dbh = C4
::Context
->dbh;
2608 SELECT COUNT
(*) FROM aqorders
2609 WHERE subscriptionid
= ?
2610 AND datereceived IS NULL
2611 AND datecancellationprinted IS NULL
2613 my $sth = $dbh->prepare( $query );
2614 $sth->execute($subscriptionid);
2615 return $sth->fetchrow_array;
2618 =head2 can_claim_subscription
2620 $can = can_claim_subscription( $subscriptionid[, $userid] );
2622 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2626 sub can_claim_subscription
{
2627 my ( $subscription, $userid ) = @_;
2628 return _can_do_on_subscription
( $subscription, $userid, 'claim_serials' );
2631 =head2 can_edit_subscription
2633 $can = can_edit_subscription( $subscriptionid[, $userid] );
2635 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2639 sub can_edit_subscription
{
2640 my ( $subscription, $userid ) = @_;
2641 return _can_do_on_subscription
( $subscription, $userid, 'edit_subscription' );
2644 =head2 can_show_subscription
2646 $can = can_show_subscription( $subscriptionid[, $userid] );
2648 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2652 sub can_show_subscription
{
2653 my ( $subscription, $userid ) = @_;
2654 return _can_do_on_subscription
( $subscription, $userid, '*' );
2657 sub _can_do_on_subscription
{
2658 my ( $subscription, $userid, $permission ) = @_;
2659 return 0 unless C4
::Context
->userenv;
2660 my $flags = C4
::Context
->userenv->{flags
};
2661 $userid ||= C4
::Context
->userenv->{'id'};
2663 if ( C4
::Context
->preference('IndependentBranches') ) {
2665 if C4
::Context
->IsSuperLibrarian()
2667 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2669 C4
::Auth
::haspermission
( $userid,
2670 { serials
=> $permission } )
2671 and ( not defined $subscription->{branchcode
}
2672 or $subscription->{branchcode
} eq ''
2673 or $subscription->{branchcode
} eq
2674 C4
::Context
->userenv->{'branch'} )
2679 if C4
::Context
->IsSuperLibrarian()
2681 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2682 or C4
::Auth
::haspermission
(
2683 $userid, { serials
=> $permission }
2690 =head2 findSerialsByStatus
2692 @serials = findSerialsByStatus($status, $subscriptionid);
2694 Returns an array of serials matching a given status and subscription id.
2698 sub findSerialsByStatus
{
2699 my ( $status, $subscriptionid ) = @_;
2700 my $dbh = C4
::Context
->dbh;
2701 my $query = q
| SELECT
* from serial
2703 AND subscriptionid
= ?
2705 my $serials = $dbh->selectall_arrayref( $query, { Slice
=> {} }, $status, $subscriptionid );
2714 Koha Development Team <http://koha-community.org/>