3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4
::Auth
qw(haspermission);
26 use Date
::Calc
qw(:all);
27 use POSIX
qw(strftime);
29 use C4
::Log
; # logaction
31 use C4
::Serials
::Frequency
;
32 use C4
::Serials
::Numberpattern
;
33 use Koha
::AdditionalField
;
36 use Koha
::Subscriptions
;
37 use Koha
::Subscription
::Histories
;
39 use vars
qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
81 &GetSuppliersWithLateIssues &getsupplierbyserialid
82 &GetDistributedTo &SetDistributedTo
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &GetSubscriptionsFromBorrower
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues
{
122 my $dbh = C4
::Context
->dbh;
123 my $statuses = join(',', ( LATE
, MISSING_STATUSES
, CLAIMED
) );
125 SELECT DISTINCT id
, name
127 LEFT JOIN serial ON serial
.subscriptionid
=subscription
.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
131 (planneddate
< now
() AND serial
.status
=1)
132 OR serial
.STATUS IN
( $statuses )
134 AND subscription
.closed
= 0
136 return $dbh->selectall_arrayref($query, { Slice
=> {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId
{
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4
::Context
->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid
= ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialStatusFromSerialId
168 $sth = GetSerialStatusFromSerialId();
169 this function returns a statement handle
170 After this function, don't forget to execute it by using $sth->execute($serialid)
172 $sth = $dbh->prepare($query).
176 sub GetSerialStatusFromSerialId
{
177 my $dbh = C4
::Context
->dbh;
183 return $dbh->prepare($query);
186 =head2 GetSerialInformation
188 $data = GetSerialInformation($serialid);
189 returns a hash_ref containing :
190 items : items marcrecord (can be an array)
192 subscription table field
193 + information about subscription expiration
197 sub GetSerialInformation
{
199 my $dbh = C4
::Context
->dbh;
201 SELECT serial
.*, serial
.notes as sernotes
, serial
.status as serstatus
,subscription
.*,subscription
.subscriptionid as subsid
202 FROM serial LEFT JOIN subscription ON subscription
.subscriptionid
=serial
.subscriptionid
205 my $rq = $dbh->prepare($query);
206 $rq->execute($serialid);
207 my $data = $rq->fetchrow_hashref;
209 # create item information if we have serialsadditems for this subscription
210 if ( $data->{'serialsadditems'} ) {
211 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
212 $queryitem->execute($serialid);
213 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
215 if ( scalar(@
$itemnumbers) > 0 ) {
216 foreach my $itemnum (@
$itemnumbers) {
218 #It is ASSUMED that GetMarcItem ALWAYS WORK...
219 #Maybe GetMarcItem should return values on failure
220 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
221 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, $itemnum->[0], $data );
222 $itemprocessed->{'itemnumber'} = $itemnum->[0];
223 $itemprocessed->{'itemid'} = $itemnum->[0];
224 $itemprocessed->{'serialid'} = $serialid;
225 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
226 push @
{ $data->{'items'} }, $itemprocessed;
229 my $itemprocessed = C4
::Items
::PrepareItemrecordDisplay
( $data->{'biblionumber'}, '', $data );
230 $itemprocessed->{'itemid'} = "N$serialid";
231 $itemprocessed->{'serialid'} = $serialid;
232 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
233 $itemprocessed->{'countitems'} = 0;
234 push @
{ $data->{'items'} }, $itemprocessed;
237 $data->{ "status" . $data->{'serstatus'} } = 1;
238 $data->{'subscriptionexpired'} = HasSubscriptionExpired
( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
239 $data->{'abouttoexpire'} = abouttoexpire
( $data->{'subscriptionid'} );
240 $data->{cannotedit
} = not can_edit_subscription
( $data );
244 =head2 AddItem2Serial
246 $rows = AddItem2Serial($serialid,$itemnumber);
247 Adds an itemnumber to Serial record
248 returns the number of rows affected
253 my ( $serialid, $itemnumber ) = @_;
255 return unless ($serialid and $itemnumber);
257 my $dbh = C4
::Context
->dbh;
258 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
259 $rq->execute( $serialid, $itemnumber );
263 =head2 GetSubscription
265 $subs = GetSubscription($subscriptionid)
266 this function returns the subscription which has $subscriptionid as id.
268 a hashref. This hash containts
269 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
273 sub GetSubscription
{
274 my ($subscriptionid) = @_;
275 my $dbh = C4
::Context
->dbh;
277 SELECT subscription
.*,
278 subscriptionhistory
.*,
279 aqbooksellers
.name AS aqbooksellername
,
280 biblio
.title AS bibliotitle
,
281 subscription
.biblionumber as bibnum
283 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
284 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
285 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
286 WHERE subscription
.subscriptionid
= ?
289 $debug and warn "query : $query\nsubsid :$subscriptionid";
290 my $sth = $dbh->prepare($query);
291 $sth->execute($subscriptionid);
292 my $subscription = $sth->fetchrow_hashref;
294 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
296 # Add additional fields to the subscription into a new key "additional_fields"
297 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
298 tablename
=> 'subscription',
299 record_id
=> $subscriptionid,
301 $subscription->{additional_fields
} = $additional_field_values->{$subscriptionid};
303 return $subscription;
306 =head2 GetFullSubscription
308 $array_ref = GetFullSubscription($subscriptionid)
309 this function reads the serial table.
313 sub GetFullSubscription
{
314 my ($subscriptionid) = @_;
316 return unless ($subscriptionid);
318 my $dbh = C4
::Context
->dbh;
320 SELECT serial
.serialid
,
323 serial
.publisheddate
,
324 serial
.publisheddatetext
,
326 serial
.notes as notes
,
327 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
328 aqbooksellers
.name as aqbooksellername
,
329 biblio
.title as bibliotitle
,
330 subscription
.branchcode AS branchcode
,
331 subscription
.subscriptionid AS subscriptionid
333 LEFT JOIN subscription ON
334 (serial
.subscriptionid
=subscription
.subscriptionid
)
335 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
336 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
337 WHERE serial
.subscriptionid
= ?
339 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
340 serial
.subscriptionid
342 $debug and warn "GetFullSubscription query: $query";
343 my $sth = $dbh->prepare($query);
344 $sth->execute($subscriptionid);
345 my $subscriptions = $sth->fetchall_arrayref( {} );
346 for my $subscription ( @
$subscriptions ) {
347 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
349 return $subscriptions;
352 =head2 PrepareSerialsData
354 $array_ref = PrepareSerialsData($serialinfomation)
355 where serialinformation is a hashref array
359 sub PrepareSerialsData
{
362 return unless ($lines);
368 my $aqbooksellername;
372 my $previousnote = "";
374 foreach my $subs (@
{$lines}) {
375 for my $datefield ( qw(publisheddate planneddate) ) {
376 # handle 0000-00-00 dates
377 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
378 $subs->{$datefield} = undef;
381 $subs->{ "status" . $subs->{'status'} } = 1;
382 if ( grep { $_ == $subs->{status
} } ( EXPECTED
, LATE
, MISSING_STATUSES
, CLAIMED
) ) {
383 $subs->{"checked"} = 1;
386 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
387 $year = $subs->{'year'};
391 if ( $tmpresults{$year} ) {
392 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
394 $tmpresults{$year} = {
396 'aqbooksellername' => $subs->{'aqbooksellername'},
397 'bibliotitle' => $subs->{'bibliotitle'},
398 'serials' => [$subs],
403 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
404 push @res, $tmpresults{$key};
409 =head2 GetSubscriptionsFromBiblionumber
411 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
412 this function get the subscription list. it reads the subscription table.
414 reference to an array of subscriptions which have the biblionumber given on input arg.
415 each element of this array is a hashref containing
416 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
420 sub GetSubscriptionsFromBiblionumber
{
421 my ($biblionumber) = @_;
423 return unless ($biblionumber);
425 my $dbh = C4
::Context
->dbh;
427 SELECT subscription
.*,
429 subscriptionhistory
.*,
430 aqbooksellers
.name AS aqbooksellername
,
431 biblio
.title AS bibliotitle
433 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
434 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
435 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
436 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
437 WHERE subscription
.biblionumber
= ?
439 my $sth = $dbh->prepare($query);
440 $sth->execute($biblionumber);
442 while ( my $subs = $sth->fetchrow_hashref ) {
443 $subs->{startdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{startdate
} ), dateonly
=> 1 } );
444 $subs->{histstartdate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histstartdate
} ), dateonly
=> 1 } );
445 if ( defined $subs->{histenddate
} ) {
446 $subs->{histenddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{histenddate
} ), dateonly
=> 1 } );
448 $subs->{histenddate
} = "";
450 $subs->{opacnote
} =~ s/\n/\<br\/\
>/g
;
451 $subs->{missinglist
} =~ s/\n/\<br\/\
>/g
;
452 $subs->{recievedlist
} =~ s/\n/\<br\/\
>/g
;
453 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
454 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
455 $subs->{ "status" . $subs->{'status'} } = 1;
457 if (not defined $subs->{enddate
} ) {
458 $subs->{enddate
} = '';
460 $subs->{enddate
} = output_pref
( { dt
=> dt_from_string
( $subs->{enddate
}), dateonly
=> 1 } );
462 $subs->{'abouttoexpire'} = abouttoexpire
( $subs->{'subscriptionid'} );
463 $subs->{'subscriptionexpired'} = HasSubscriptionExpired
( $subs->{'subscriptionid'} );
464 $subs->{cannotedit
} = not can_edit_subscription
( $subs );
470 =head2 GetFullSubscriptionsFromBiblionumber
472 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
473 this function reads the serial table.
477 sub GetFullSubscriptionsFromBiblionumber
{
478 my ($biblionumber) = @_;
479 my $dbh = C4
::Context
->dbh;
481 SELECT serial
.serialid
,
484 serial
.publisheddate
,
485 serial
.publisheddatetext
,
487 serial
.notes as notes
,
488 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
489 biblio
.title as bibliotitle
,
490 subscription
.branchcode AS branchcode
,
491 subscription
.subscriptionid AS subscriptionid
493 LEFT JOIN subscription ON
494 (serial
.subscriptionid
=subscription
.subscriptionid
)
495 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
496 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
497 WHERE subscription
.biblionumber
= ?
499 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
500 serial
.subscriptionid
502 my $sth = $dbh->prepare($query);
503 $sth->execute($biblionumber);
504 my $subscriptions = $sth->fetchall_arrayref( {} );
505 for my $subscription ( @
$subscriptions ) {
506 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
508 return $subscriptions;
511 =head2 SearchSubscriptions
513 @results = SearchSubscriptions($args);
515 This function returns a list of hashrefs, one for each subscription
516 that meets the conditions specified by the $args hashref.
518 The valid search fields are:
532 The expiration_date search field is special; it specifies the maximum
533 subscription expiration date.
537 sub SearchSubscriptions
{
540 my $additional_fields = $args->{additional_fields
} // [];
541 my $matching_record_ids_for_additional_fields = [];
542 if ( @
$additional_fields ) {
543 $matching_record_ids_for_additional_fields = Koha
::AdditionalField
->get_matching_record_ids({
544 fields
=> $additional_fields,
545 tablename
=> 'subscription',
548 return () unless @
$matching_record_ids_for_additional_fields;
553 subscription
.notes AS publicnotes
,
554 subscriptionhistory
.*,
556 biblio
.notes AS biblionotes
,
560 aqbooksellers
.name AS vendorname
,
563 LEFT JOIN subscriptionhistory USING
(subscriptionid
)
564 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
565 LEFT JOIN biblioitems ON biblioitems
.biblionumber
= subscription
.biblionumber
566 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
568 $query .= q
| WHERE
1|;
571 if( $args->{biblionumber
} ) {
572 push @where_strs, "biblio.biblionumber = ?";
573 push @where_args, $args->{biblionumber
};
576 if( $args->{title
} ){
577 my @words = split / /, $args->{title
};
579 foreach my $word (@words) {
580 push @strs, "biblio.title LIKE ?";
581 push @args, "%$word%";
584 push @where_strs, '(' . join (' AND ', @strs) . ')';
585 push @where_args, @args;
589 push @where_strs, "biblioitems.issn LIKE ?";
590 push @where_args, "%$args->{issn}%";
593 push @where_strs, "biblioitems.ean LIKE ?";
594 push @where_args, "%$args->{ean}%";
596 if ( $args->{callnumber
} ) {
597 push @where_strs, "subscription.callnumber LIKE ?";
598 push @where_args, "%$args->{callnumber}%";
600 if( $args->{publisher
} ){
601 push @where_strs, "biblioitems.publishercode LIKE ?";
602 push @where_args, "%$args->{publisher}%";
604 if( $args->{bookseller
} ){
605 push @where_strs, "aqbooksellers.name LIKE ?";
606 push @where_args, "%$args->{bookseller}%";
608 if( $args->{branch
} ){
609 push @where_strs, "subscription.branchcode = ?";
610 push @where_args, "$args->{branch}";
612 if ( $args->{location
} ) {
613 push @where_strs, "subscription.location = ?";
614 push @where_args, "$args->{location}";
616 if ( $args->{expiration_date
} ) {
617 push @where_strs, "subscription.enddate <= ?";
618 push @where_args, "$args->{expiration_date}";
620 if( defined $args->{closed
} ){
621 push @where_strs, "subscription.closed = ?";
622 push @where_args, "$args->{closed}";
626 $query .= ' AND ' . join(' AND ', @where_strs);
628 if ( @
$additional_fields ) {
629 $query .= ' AND subscriptionid IN ('
630 . join( ', ', @
$matching_record_ids_for_additional_fields )
634 $query .= " ORDER BY " . $args->{orderby
} if $args->{orderby
};
636 my $dbh = C4
::Context
->dbh;
637 my $sth = $dbh->prepare($query);
638 $sth->execute(@where_args);
639 my $results = $sth->fetchall_arrayref( {} );
641 for my $subscription ( @
$results ) {
642 $subscription->{cannotedit
} = not can_edit_subscription
( $subscription );
643 $subscription->{cannotdisplay
} = not can_show_subscription
( $subscription );
645 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
646 record_id
=> $subscription->{subscriptionid
},
647 tablename
=> 'subscription'
649 $subscription->{additional_fields
} = $additional_field_values->{$subscription->{subscriptionid
}};
658 ($totalissues,@serials) = GetSerials($subscriptionid);
659 this function gets every serial not arrived for a given subscription
660 as well as the number of issues registered in the database (all types)
661 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
663 FIXME: We should return \@serials.
668 my ( $subscriptionid, $count ) = @_;
670 return unless $subscriptionid;
672 my $dbh = C4
::Context
->dbh;
674 # status = 2 is "arrived"
676 $count = 5 unless ($count);
678 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
, NOT_ISSUED
) );
679 my $query = "SELECT serialid,serialseq, status, publisheddate,
680 publisheddatetext, planneddate,notes, routingnotes
682 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
683 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
684 my $sth = $dbh->prepare($query);
685 $sth->execute($subscriptionid);
687 while ( my $line = $sth->fetchrow_hashref ) {
688 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
689 for my $datefield ( qw( planneddate publisheddate) ) {
690 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
691 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
693 $line->{$datefield} = q{};
696 push @serials, $line;
699 # OK, now add the last 5 issues arrives/missing
700 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
701 publisheddatetext, notes, routingnotes
703 WHERE subscriptionid = ?
704 AND status IN ( $statuses )
705 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
707 $sth = $dbh->prepare($query);
708 $sth->execute($subscriptionid);
709 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
711 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
712 for my $datefield ( qw( planneddate publisheddate) ) {
713 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
714 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
716 $line->{$datefield} = q{};
720 push @serials, $line;
723 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
724 $sth = $dbh->prepare($query);
725 $sth->execute($subscriptionid);
726 my ($totalissues) = $sth->fetchrow;
727 return ( $totalissues, @serials );
732 @serials = GetSerials2($subscriptionid,$statuses);
733 this function returns every serial waited for a given subscription
734 as well as the number of issues registered in the database (all types)
735 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
737 $statuses is an arrayref of statuses and is mandatory.
742 my ( $subscription, $statuses ) = @_;
744 return unless ($subscription and @
$statuses);
746 my $dbh = C4
::Context
->dbh;
748 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,
749 publisheddatetext
, notes
, routingnotes
751 WHERE subscriptionid
=?
753 . q
| AND status IN
(| . join( ",", ('?') x @
$statuses ) . q
|)|
755 ORDER BY publisheddate
,serialid DESC
757 $debug and warn "GetSerials2 query: $query";
758 my $sth = $dbh->prepare($query);
759 $sth->execute( $subscription, @
$statuses );
762 while ( my $line = $sth->fetchrow_hashref ) {
763 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
764 # Format dates for display
765 for my $datefield ( qw( planneddate publisheddate ) ) {
766 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
767 $line->{$datefield} = q{};
770 $line->{$datefield} = output_pref
( { dt
=> dt_from_string
( $line->{$datefield} ), dateonly
=> 1 } );
773 push @serials, $line;
778 =head2 GetLatestSerials
780 \@serials = GetLatestSerials($subscriptionid,$limit)
781 get the $limit's latest serials arrived or missing for a given subscription
783 a ref to an array which contains all of the latest serials stored into a hash.
787 sub GetLatestSerials
{
788 my ( $subscriptionid, $limit ) = @_;
790 return unless ($subscriptionid and $limit);
792 my $dbh = C4
::Context
->dbh;
794 my $statuses = join( ',', ( ARRIVED
, MISSING_STATUSES
) );
795 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
797 WHERE subscriptionid = ?
798 AND status IN ($statuses)
799 ORDER BY publisheddate DESC LIMIT 0,$limit
801 my $sth = $dbh->prepare($strsth);
802 $sth->execute($subscriptionid);
804 while ( my $line = $sth->fetchrow_hashref ) {
805 $line->{ "status" . $line->{status
} } = 1; # fills a "statusX" value, used for template status select list
806 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{planneddate
} ), dateonly
=> 1 } );
807 $line->{publisheddate
} = output_pref
( { dt
=> dt_from_string
( $line->{publisheddate
} ), dateonly
=> 1 } );
808 push @serials, $line;
814 =head2 GetPreviousSerialid
816 $serialid = GetPreviousSerialid($subscriptionid, $nth)
817 get the $nth's previous serial for the given subscriptionid
823 sub GetPreviousSerialid
{
824 my ( $subscriptionid, $nth ) = @_;
826 my $dbh = C4
::Context
->dbh;
830 my $strsth = "SELECT serialid
832 WHERE subscriptionid = ?
834 ORDER BY serialid DESC LIMIT $nth,1
836 my $sth = $dbh->prepare($strsth);
837 $sth->execute($subscriptionid);
839 my $line = $sth->fetchrow_hashref;
840 $return = $line->{'serialid'} if ($line);
847 =head2 GetDistributedTo
849 $distributedto=GetDistributedTo($subscriptionid)
850 This function returns the field distributedto for the subscription matching subscriptionid
854 sub GetDistributedTo
{
855 my $dbh = C4
::Context
->dbh;
857 my ($subscriptionid) = @_;
859 return unless ($subscriptionid);
861 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
862 my $sth = $dbh->prepare($query);
863 $sth->execute($subscriptionid);
864 return ($distributedto) = $sth->fetchrow;
870 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
871 $newinnerloop1, $newinnerloop2, $newinnerloop3
872 ) = GetNextSeq( $subscription, $pattern, $planneddate );
874 $subscription is a hashref containing all the attributes of the table
876 $pattern is a hashref containing all the attributes of the table
877 'subscription_numberpatterns'.
878 $planneddate is a date string in iso format.
879 This function get the next issue for the subscription given on input arg
884 my ($subscription, $pattern, $planneddate) = @_;
886 return unless ($subscription and $pattern);
888 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
889 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
892 if ($subscription->{'skip_serialseq'}) {
893 my @irreg = split /;/, $subscription->{'irregularity'};
895 my $irregularities = {};
896 $irregularities->{$_} = 1 foreach(@irreg);
897 my $issueno = GetFictiveIssueNumber
($subscription, $planneddate) + 1;
898 while($irregularities->{$issueno}) {
905 my $numberingmethod = $pattern->{numberingmethod
};
907 if ($numberingmethod) {
908 $calculated = $numberingmethod;
909 my $locale = $subscription->{locale
};
910 $newlastvalue1 = $subscription->{lastvalue1
} || 0;
911 $newlastvalue2 = $subscription->{lastvalue2
} || 0;
912 $newlastvalue3 = $subscription->{lastvalue3
} || 0;
913 $newinnerloop1 = $subscription->{innerloop1
} || 0;
914 $newinnerloop2 = $subscription->{innerloop2
} || 0;
915 $newinnerloop3 = $subscription->{innerloop3
} || 0;
918 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
921 for(my $i = 0; $i < $count; $i++) {
923 # check if we have to increase the new value.
925 if ($newinnerloop1 >= $pattern->{every1
}) {
927 $newlastvalue1 += $pattern->{add1
};
929 # reset counter if needed.
930 $newlastvalue1 = $pattern->{setto1
} if ($newlastvalue1 > $pattern->{whenmorethan1
});
933 # check if we have to increase the new value.
935 if ($newinnerloop2 >= $pattern->{every2
}) {
937 $newlastvalue2 += $pattern->{add2
};
939 # reset counter if needed.
940 $newlastvalue2 = $pattern->{setto2
} if ($newlastvalue2 > $pattern->{whenmorethan2
});
943 # check if we have to increase the new value.
945 if ($newinnerloop3 >= $pattern->{every3
}) {
947 $newlastvalue3 += $pattern->{add3
};
949 # reset counter if needed.
950 $newlastvalue3 = $pattern->{setto3
} if ($newlastvalue3 > $pattern->{whenmorethan3
});
954 my $newlastvalue1string = _numeration
( $newlastvalue1, $pattern->{numbering1
}, $locale );
955 $calculated =~ s/\{X\}/$newlastvalue1string/g;
958 my $newlastvalue2string = _numeration
( $newlastvalue2, $pattern->{numbering2
}, $locale );
959 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
962 my $newlastvalue3string = _numeration
( $newlastvalue3, $pattern->{numbering3
}, $locale );
963 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
968 $newlastvalue1, $newlastvalue2, $newlastvalue3,
969 $newinnerloop1, $newinnerloop2, $newinnerloop3);
974 $calculated = GetSeq($subscription, $pattern)
975 $subscription is a hashref containing all the attributes of the table 'subscription'
976 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
977 this function transforms {X},{Y},{Z} to 150,0,0 for example.
979 the sequence in string format
984 my ($subscription, $pattern) = @_;
986 return unless ($subscription and $pattern);
988 my $locale = $subscription->{locale
};
990 my $calculated = $pattern->{numberingmethod
};
992 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
993 $newlastvalue1 = _numeration
($newlastvalue1, $pattern->{numbering1
}, $locale) if ($pattern->{numbering1
}); # reset counter if needed.
994 $calculated =~ s/\{X\}/$newlastvalue1/g;
996 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
997 $newlastvalue2 = _numeration
($newlastvalue2, $pattern->{numbering2
}, $locale) if ($pattern->{numbering2
}); # reset counter if needed.
998 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1000 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1001 $newlastvalue3 = _numeration
($newlastvalue3, $pattern->{numbering3
}, $locale) if ($pattern->{numbering3
}); # reset counter if needed.
1002 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1006 =head2 GetExpirationDate
1008 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1010 this function return the next expiration date for a subscription given on input args.
1013 the enddate or undef
1017 sub GetExpirationDate
{
1018 my ( $subscriptionid, $startdate ) = @_;
1020 return unless ($subscriptionid);
1022 my $dbh = C4
::Context
->dbh;
1023 my $subscription = GetSubscription
($subscriptionid);
1026 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1027 $enddate = $startdate || $subscription->{startdate
};
1028 my @date = split( /-/, $enddate );
1030 return if ( scalar(@date) != 3 || not check_date
(@date) );
1032 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1033 if ( $frequency and $frequency->{unit
} ) {
1036 if ( my $length = $subscription->{numberlength
} ) {
1038 #calculate the date of the last issue.
1039 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1040 $enddate = GetNextDate
( $subscription, $enddate );
1042 } elsif ( $subscription->{monthlength
} ) {
1043 if ( $$subscription{startdate
} ) {
1044 my @enddate = Add_Delta_YM
( $date[0], $date[1], $date[2], 0, $subscription->{monthlength
} );
1045 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1047 } elsif ( $subscription->{weeklength
} ) {
1048 if ( $$subscription{startdate
} ) {
1049 my @date = split( /-/, $subscription->{startdate
} );
1050 my @enddate = Add_Delta_Days
( $date[0], $date[1], $date[2], $subscription->{weeklength
} * 7 );
1051 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1054 $enddate = $subscription->{enddate
};
1058 return $subscription->{enddate
};
1062 =head2 CountSubscriptionFromBiblionumber
1064 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1065 this returns a count of the subscriptions for a given biblionumber
1067 the number of subscriptions
1071 sub CountSubscriptionFromBiblionumber
{
1072 my ($biblionumber) = @_;
1074 return unless ($biblionumber);
1076 my $dbh = C4
::Context
->dbh;
1077 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1078 my $sth = $dbh->prepare($query);
1079 $sth->execute($biblionumber);
1080 my $subscriptionsnumber = $sth->fetchrow;
1081 return $subscriptionsnumber;
1084 =head2 ModSubscriptionHistory
1086 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1088 this function modifies the history of a subscription. Put your new values on input arg.
1089 returns the number of rows affected
1093 sub ModSubscriptionHistory
{
1094 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1096 return unless ($subscriptionid);
1098 my $dbh = C4
::Context
->dbh;
1099 my $query = "UPDATE subscriptionhistory
1100 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1101 WHERE subscriptionid=?
1103 my $sth = $dbh->prepare($query);
1104 $receivedlist =~ s/^; // if $receivedlist;
1105 $missinglist =~ s/^; // if $missinglist;
1106 $opacnote =~ s/^; // if $opacnote;
1107 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1111 =head2 ModSerialStatus
1113 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1114 $publisheddatetext, $status, $notes);
1116 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1117 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1121 sub ModSerialStatus
{
1122 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1123 $status, $notes) = @_;
1125 return unless ($serialid);
1127 #It is a usual serial
1128 # 1st, get previous status :
1129 my $dbh = C4
::Context
->dbh;
1130 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1131 FROM serial, subscription
1132 WHERE serial.subscriptionid=subscription.subscriptionid
1134 my $sth = $dbh->prepare($query);
1135 $sth->execute($serialid);
1136 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1137 my $frequency = GetSubscriptionFrequency
($periodicity);
1139 # change status & update subscriptionhistory
1141 if ( $status == DELETED
) {
1142 DelIssue
( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1147 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1148 planneddate = ?, status = ?, notes = ?
1151 $sth = $dbh->prepare($query);
1152 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1153 $planneddate, $status, $notes, $serialid );
1154 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1155 $sth = $dbh->prepare($query);
1156 $sth->execute($subscriptionid);
1157 my $val = $sth->fetchrow_hashref;
1158 unless ( $val->{manualhistory
} ) {
1159 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1160 $sth = $dbh->prepare($query);
1161 $sth->execute($subscriptionid);
1162 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1164 if ( $status == ARRIVED
|| ($oldstatus == ARRIVED
&& $status != ARRIVED
) ) {
1165 $recievedlist .= "; $serialseq"
1166 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1169 # in case serial has been previously marked as missing
1170 if (grep /$status/, (EXPECTED
, ARRIVED
, LATE
, CLAIMED
)) {
1171 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1174 $missinglist .= "; $serialseq"
1175 if ( ( grep { $_ == $status } ( MISSING_STATUSES
) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1176 $missinglist .= "; not issued $serialseq"
1177 if ( $status == NOT_ISSUED
&& $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1179 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1180 $sth = $dbh->prepare($query);
1181 $recievedlist =~ s/^; //;
1182 $missinglist =~ s/^; //;
1183 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1187 # create new expected entry if needed (ie : was "expected" and has changed)
1188 my $otherIssueExpected = scalar findSerialsByStatus
(EXPECTED
, $subscriptionid);
1189 if ( !$otherIssueExpected && $oldstatus == EXPECTED
&& $status != EXPECTED
) {
1190 my $subscription = GetSubscription
($subscriptionid);
1191 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1195 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1196 $newinnerloop1, $newinnerloop2, $newinnerloop3
1198 = GetNextSeq
( $subscription, $pattern, $publisheddate );
1200 # next date (calculated from actual date & frequency parameters)
1201 my $nextpublisheddate = GetNextDate
($subscription, $publisheddate, 1);
1202 my $nextpubdate = $nextpublisheddate;
1203 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1204 WHERE subscriptionid = ?";
1205 $sth = $dbh->prepare($query);
1206 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1208 NewIssue
( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1210 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1211 if ( $subscription->{letter
} && $status == ARRIVED
&& $oldstatus != ARRIVED
) {
1212 require C4
::Letters
;
1213 C4
::Letters
::SendAlerts
( 'issue', $serialid, $subscription->{letter
} );
1220 =head2 GetNextExpected
1222 $nextexpected = GetNextExpected($subscriptionid)
1224 Get the planneddate for the current expected issue of the subscription.
1230 planneddate => ISO date
1235 sub GetNextExpected
{
1236 my ($subscriptionid) = @_;
1238 my $dbh = C4
::Context
->dbh;
1242 WHERE subscriptionid
= ?
1246 my $sth = $dbh->prepare($query);
1248 # Each subscription has only one 'expected' issue.
1249 $sth->execute( $subscriptionid, EXPECTED
);
1250 my $nextissue = $sth->fetchrow_hashref;
1251 if ( !$nextissue ) {
1255 WHERE subscriptionid
= ?
1256 ORDER BY publisheddate DESC
1259 $sth = $dbh->prepare($query);
1260 $sth->execute($subscriptionid);
1261 $nextissue = $sth->fetchrow_hashref;
1263 foreach(qw
/planneddate publisheddate/) {
1264 if ( !defined $nextissue->{$_} ) {
1265 # or should this default to 1st Jan ???
1266 $nextissue->{$_} = strftime
( '%Y-%m-%d', localtime );
1268 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1276 =head2 ModNextExpected
1278 ModNextExpected($subscriptionid,$date)
1280 Update the planneddate for the current expected issue of the subscription.
1281 This will modify all future prediction results.
1283 C<$date> is an ISO date.
1289 sub ModNextExpected
{
1290 my ( $subscriptionid, $date ) = @_;
1291 my $dbh = C4
::Context
->dbh;
1293 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1294 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1296 # Each subscription has only one 'expected' issue.
1297 $sth->execute( $date, $date, $subscriptionid, EXPECTED
);
1302 =head2 GetSubscriptionIrregularities
1306 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1307 get the list of irregularities for a subscription
1313 sub GetSubscriptionIrregularities
{
1314 my $subscriptionid = shift;
1316 return unless $subscriptionid;
1318 my $dbh = C4
::Context
->dbh;
1322 WHERE subscriptionid
= ?
1324 my $sth = $dbh->prepare($query);
1325 $sth->execute($subscriptionid);
1327 my ($result) = $sth->fetchrow_array;
1328 my @irreg = split /;/, $result;
1333 =head2 ModSubscription
1335 this function modifies a subscription. Put all new values on input args.
1336 returns the number of rows affected
1340 sub ModSubscription
{
1342 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1343 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1344 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1345 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1346 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1347 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1348 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1349 $itemtype, $previousitemtype
1352 my $dbh = C4
::Context
->dbh;
1353 my $query = "UPDATE subscription
1354 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1355 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1356 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1357 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1358 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1359 callnumber=?, notes=?, letter=?, manualhistory=?,
1360 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1361 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1362 skip_serialseq=?, itemtype=?, previousitemtype=?
1363 WHERE subscriptionid = ?";
1365 my $sth = $dbh->prepare($query);
1367 $auser, $branchcode, $aqbooksellerid, $cost,
1368 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1369 $irregularity, $numberpattern, $locale, $numberlength,
1370 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1371 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1372 $status, $biblionumber, $callnumber, $notes,
1373 $letter, ($manualhistory ?
$manualhistory : 0),
1374 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1375 $graceperiod, $location, $enddate, $skip_serialseq,
1376 $itemtype, $previousitemtype,
1379 my $rows = $sth->rows;
1381 logaction
( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1385 =head2 NewSubscription
1387 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1388 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1389 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1390 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1391 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1392 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1393 $skip_serialseq, $itemtype, $previousitemtype);
1395 Create a new subscription with value given on input args.
1398 the id of this new subscription
1402 sub NewSubscription
{
1404 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1405 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1406 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1407 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1408 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1409 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1410 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1412 my $dbh = C4
::Context
->dbh;
1414 #save subscription (insert into database)
1416 INSERT INTO subscription
1417 (librarian
, branchcode
, aqbooksellerid
, cost
, aqbudgetid
,
1418 biblionumber
, startdate
, periodicity
, numberlength
, weeklength
,
1419 monthlength
, lastvalue1
, innerloop1
, lastvalue2
, innerloop2
,
1420 lastvalue3
, innerloop3
, status
, notes
, letter
, firstacquidate
,
1421 irregularity
, numberpattern
, locale
, callnumber
,
1422 manualhistory
, internalnotes
, serialsadditems
, staffdisplaycount
,
1423 opacdisplaycount
, graceperiod
, location
, enddate
, skip_serialseq
,
1424 itemtype
, previousitemtype
)
1425 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
)
1427 my $sth = $dbh->prepare($query);
1429 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1430 $startdate, $periodicity, $numberlength, $weeklength,
1431 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1432 $lastvalue3, $innerloop3, $status, $notes, $letter,
1433 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1434 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1435 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1436 $itemtype, $previousitemtype
1439 my $subscriptionid = $dbh->{'mysql_insertid'};
1441 $enddate = GetExpirationDate
( $subscriptionid, $startdate );
1445 WHERE subscriptionid
=?
1447 $sth = $dbh->prepare($query);
1448 $sth->execute( $enddate, $subscriptionid );
1451 # then create the 1st expected number
1453 INSERT INTO subscriptionhistory
1454 (biblionumber
, subscriptionid
, histstartdate
)
1457 $sth = $dbh->prepare($query);
1458 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1460 # reread subscription to get a hash (for calculation of the 1st issue number)
1461 my $subscription = GetSubscription
($subscriptionid);
1462 my $pattern = C4
::Serials
::Numberpattern
::GetSubscriptionNumberpattern
($subscription->{numberpattern
});
1464 # calculate issue number
1465 my $serialseq = GetSeq
($subscription, $pattern) || q{};
1469 serialseq
=> $serialseq,
1470 serialseq_x
=> $subscription->{'lastvalue1'},
1471 serialseq_y
=> $subscription->{'lastvalue2'},
1472 serialseq_z
=> $subscription->{'lastvalue3'},
1473 subscriptionid
=> $subscriptionid,
1474 biblionumber
=> $biblionumber,
1476 planneddate
=> $firstacquidate,
1477 publisheddate
=> $firstacquidate,
1481 logaction
( "SERIAL", "ADD", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1483 #set serial flag on biblio if not already set.
1484 my $bib = GetBiblio
($biblionumber);
1485 if ( $bib and !$bib->{'serial'} ) {
1486 my $record = GetMarcBiblio
($biblionumber);
1487 my ( $tag, $subf ) = GetMarcFromKohaField
( 'biblio.serial', $bib->{'frameworkcode'} );
1489 eval { $record->field($tag)->update( $subf => 1 ); };
1491 ModBiblio
( $record, $biblionumber, $bib->{'frameworkcode'} );
1493 return $subscriptionid;
1496 =head2 ReNewSubscription
1498 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1500 this function renew a subscription with values given on input args.
1504 sub ReNewSubscription
{
1505 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1506 my $dbh = C4
::Context
->dbh;
1507 my $subscription = GetSubscription
($subscriptionid);
1511 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1512 WHERE biblio
.biblionumber
=?
1514 my $sth = $dbh->prepare($query);
1515 $sth->execute( $subscription->{biblionumber
} );
1516 my $biblio = $sth->fetchrow_hashref;
1518 if ( C4
::Context
->preference("RenewSerialAddsSuggestion") ) {
1519 require C4
::Suggestions
;
1520 C4
::Suggestions
::NewSuggestion
(
1521 { 'suggestedby' => $user,
1522 'title' => $subscription->{bibliotitle
},
1523 'author' => $biblio->{author
},
1524 'publishercode' => $biblio->{publishercode
},
1525 'note' => $biblio->{note
},
1526 'biblionumber' => $subscription->{biblionumber
}
1531 # renew subscription
1534 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
,reneweddate
=NOW
()
1535 WHERE subscriptionid
=?
1537 $sth = $dbh->prepare($query);
1538 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1539 my $enddate = GetExpirationDate
($subscriptionid);
1540 $debug && warn "enddate :$enddate";
1544 WHERE subscriptionid
=?
1546 $sth = $dbh->prepare($query);
1547 $sth->execute( $enddate, $subscriptionid );
1549 UPDATE subscriptionhistory
1551 WHERE subscriptionid
=?
1553 $sth = $dbh->prepare($query);
1554 $sth->execute( $enddate, $subscriptionid );
1556 logaction
( "SERIAL", "RENEW", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1562 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1564 Create a new issue stored on the database.
1565 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1566 returns the serial id
1571 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1572 $publisheddate, $publisheddatetext, $notes ) = @_;
1573 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1575 return unless ($subscriptionid);
1577 my $schema = Koha
::Database
->new()->schema();
1579 my $subscription = Koha
::Subscriptions
->find( $subscriptionid );
1581 my $serial = Koha
::Serial
->new(
1583 serialseq
=> $serialseq,
1584 serialseq_x
=> $subscription->lastvalue1(),
1585 serialseq_y
=> $subscription->lastvalue2(),
1586 serialseq_z
=> $subscription->lastvalue3(),
1587 subscriptionid
=> $subscriptionid,
1588 biblionumber
=> $biblionumber,
1590 planneddate
=> $planneddate,
1591 publisheddate
=> $publisheddate,
1592 publisheddatetext
=> $publisheddatetext,
1597 my $serialid = $serial->id();
1599 my $subscription_history = Koha
::Subscription
::Histories
->find($subscriptionid);
1600 my $missinglist = $subscription_history->missinglist();
1601 my $recievedlist = $subscription_history->recievedlist();
1603 if ( $status == ARRIVED
) {
1604 ### TODO Add a feature that improves recognition and description.
1605 ### As such count (serialseq) i.e. : N18,2(N19),N20
1606 ### Would use substr and index But be careful to previous presence of ()
1607 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1609 if ( grep { /^$status$/ } (MISSING_STATUSES
) ) {
1610 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1613 $recievedlist =~ s/^; //;
1614 $missinglist =~ s/^; //;
1616 $subscription_history->recievedlist($recievedlist);
1617 $subscription_history->missinglist($missinglist);
1618 $subscription_history->store();
1623 =head2 HasSubscriptionStrictlyExpired
1625 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1627 the subscription has stricly expired when today > the end subscription date
1630 1 if true, 0 if false, -1 if the expiration date is not set.
1634 sub HasSubscriptionStrictlyExpired
{
1636 # Getting end of subscription date
1637 my ($subscriptionid) = @_;
1639 return unless ($subscriptionid);
1641 my $dbh = C4
::Context
->dbh;
1642 my $subscription = GetSubscription
($subscriptionid);
1643 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1645 # If the expiration date is set
1646 if ( $expirationdate != 0 ) {
1647 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1649 # Getting today's date
1650 my ( $nowyear, $nowmonth, $nowday ) = Today
();
1652 # if today's date > expiration date, then the subscription has stricly expired
1653 if ( Delta_Days
( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1660 # There are some cases where the expiration date is not set
1661 # As we can't determine if the subscription has expired on a date-basis,
1667 =head2 HasSubscriptionExpired
1669 $has_expired = HasSubscriptionExpired($subscriptionid)
1671 the subscription has expired when the next issue to arrive is out of subscription limit.
1674 0 if the subscription has not expired
1675 1 if the subscription has expired
1676 2 if has subscription does not have a valid expiration date set
1680 sub HasSubscriptionExpired
{
1681 my ($subscriptionid) = @_;
1683 return unless ($subscriptionid);
1685 my $dbh = C4
::Context
->dbh;
1686 my $subscription = GetSubscription
($subscriptionid);
1687 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($subscription->{periodicity
});
1688 if ( $frequency and $frequency->{unit
} ) {
1689 my $expirationdate = $subscription->{enddate
} || GetExpirationDate
($subscriptionid);
1690 if (!defined $expirationdate) {
1691 $expirationdate = q{};
1694 SELECT max
(planneddate
)
1696 WHERE subscriptionid
=?
1698 my $sth = $dbh->prepare($query);
1699 $sth->execute($subscriptionid);
1700 my ($res) = $sth->fetchrow;
1701 if (!$res || $res=~m/^0000/) {
1704 my @res = split( /-/, $res );
1705 my @endofsubscriptiondate = split( /-/, $expirationdate );
1706 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date
(@res) || not check_date
(@endofsubscriptiondate) );
1708 if ( ( @endofsubscriptiondate && Delta_Days
( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1713 if ( $subscription->{'numberlength'} ) {
1714 my $countreceived = countissuesfrom
( $subscriptionid, $subscription->{'startdate'} );
1715 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1721 return 0; # Notice that you'll never get here.
1724 =head2 SetDistributedto
1726 SetDistributedto($distributedto,$subscriptionid);
1727 This function update the value of distributedto for a subscription given on input arg.
1731 sub SetDistributedto
{
1732 my ( $distributedto, $subscriptionid ) = @_;
1733 my $dbh = C4
::Context
->dbh;
1737 WHERE subscriptionid
=?
1739 my $sth = $dbh->prepare($query);
1740 $sth->execute( $distributedto, $subscriptionid );
1744 =head2 DelSubscription
1746 DelSubscription($subscriptionid)
1747 this function deletes subscription which has $subscriptionid as id.
1751 sub DelSubscription
{
1752 my ($subscriptionid) = @_;
1753 my $dbh = C4
::Context
->dbh;
1754 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1755 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1756 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1758 my $afs = Koha
::AdditionalField
->all({tablename
=> 'subscription'});
1759 foreach my $af (@
$afs) {
1760 $af->delete_values({record_id
=> $subscriptionid});
1763 logaction
( "SERIAL", "DELETE", $subscriptionid, "" ) if C4
::Context
->preference("SubscriptionLog");
1768 DelIssue($serialseq,$subscriptionid)
1769 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1771 returns the number of rows affected
1776 my ($dataissue) = @_;
1777 my $dbh = C4
::Context
->dbh;
1778 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1783 AND subscriptionid
= ?
1785 my $mainsth = $dbh->prepare($query);
1786 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1788 #Delete element from subscription history
1789 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1790 my $sth = $dbh->prepare($query);
1791 $sth->execute( $dataissue->{'subscriptionid'} );
1792 my $val = $sth->fetchrow_hashref;
1793 unless ( $val->{manualhistory
} ) {
1795 SELECT
* FROM subscriptionhistory
1796 WHERE subscriptionid
= ?
1798 my $sth = $dbh->prepare($query);
1799 $sth->execute( $dataissue->{'subscriptionid'} );
1800 my $data = $sth->fetchrow_hashref;
1801 my $serialseq = $dataissue->{'serialseq'};
1802 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1803 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1804 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1805 $sth = $dbh->prepare($strsth);
1806 $sth->execute( $dataissue->{'subscriptionid'} );
1809 return $mainsth->rows;
1812 =head2 GetLateOrMissingIssues
1814 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1816 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1819 the issuelist as an array of hash refs. Each element of this array contains
1820 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1824 sub GetLateOrMissingIssues
{
1825 my ( $supplierid, $serialid, $order ) = @_;
1827 return unless ( $supplierid or $serialid );
1829 my $dbh = C4
::Context
->dbh;
1834 $byserial = "and serialid = " . $serialid;
1837 $order .= ", title";
1841 my $missing_statuses_string = join ',', (MISSING_STATUSES
);
1843 $sth = $dbh->prepare(
1845 serialid, aqbooksellerid, name,
1846 biblio.title, biblioitems.issn, planneddate, serialseq,
1847 serial.status, serial.subscriptionid, claimdate, claims_count,
1848 subscription.branchcode
1850 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1851 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1852 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1853 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1854 WHERE subscription.subscriptionid = serial.subscriptionid
1855 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1856 AND subscription.aqbooksellerid=$supplierid
1861 $sth = $dbh->prepare(
1863 serialid, aqbooksellerid, name,
1864 biblio.title, planneddate, serialseq,
1865 serial.status, serial.subscriptionid, claimdate, claims_count,
1866 subscription.branchcode
1868 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1869 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1870 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1871 WHERE subscription.subscriptionid = serial.subscriptionid
1872 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1877 $sth->execute( EXPECTED
, LATE
, CLAIMED
);
1879 while ( my $line = $sth->fetchrow_hashref ) {
1881 if ($line->{planneddate
} && $line->{planneddate
} !~/^0+\-/) {
1882 $line->{planneddateISO
} = $line->{planneddate
};
1883 $line->{planneddate
} = output_pref
( { dt
=> dt_from_string
( $line->{"planneddate"} ), dateonly
=> 1 } );
1885 if ($line->{claimdate
} && $line->{claimdate
} !~/^0+\-/) {
1886 $line->{claimdateISO
} = $line->{claimdate
};
1887 $line->{claimdate
} = output_pref
( { dt
=> dt_from_string
( $line->{"claimdate"} ), dateonly
=> 1 } );
1889 $line->{"status".$line->{status
}} = 1;
1891 my $additional_field_values = Koha
::AdditionalField
->fetch_all_values({
1892 record_id
=> $line->{subscriptionid
},
1893 tablename
=> 'subscription'
1895 %$line = ( %$line, additional_fields
=> $additional_field_values->{$line->{subscriptionid
}} );
1897 push @issuelist, $line;
1904 &updateClaim($serialid)
1906 this function updates the time when a claim is issued for late/missing items
1908 called from claims.pl file
1913 my ($serialids) = @_;
1914 return unless $serialids;
1915 unless ( ref $serialids ) {
1916 $serialids = [ $serialids ];
1918 my $dbh = C4
::Context
->dbh;
1921 SET claimdate
= NOW
(),
1922 claims_count
= claims_count
+ 1,
1924 WHERE serialid
in (| . join( q
|,|, (q
|?
|) x @
$serialids ) . q
|)|,
1925 {}, CLAIMED
, @
$serialids );
1928 =head2 getsupplierbyserialid
1930 $result = getsupplierbyserialid($serialid)
1932 this function is used to find the supplier id given a serial id
1935 hashref containing serialid, subscriptionid, and aqbooksellerid
1939 sub getsupplierbyserialid
{
1940 my ($serialid) = @_;
1941 my $dbh = C4
::Context
->dbh;
1942 my $sth = $dbh->prepare(
1943 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1945 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1949 $sth->execute($serialid);
1950 my $line = $sth->fetchrow_hashref;
1951 my $result = $line->{'aqbooksellerid'};
1955 =head2 check_routing
1957 $result = &check_routing($subscriptionid)
1959 this function checks to see if a serial has a routing list and returns the count of routingid
1960 used to show either an 'add' or 'edit' link
1965 my ($subscriptionid) = @_;
1967 return unless ($subscriptionid);
1969 my $dbh = C4
::Context
->dbh;
1970 my $sth = $dbh->prepare(
1971 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1972 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1973 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1976 $sth->execute($subscriptionid);
1977 my $line = $sth->fetchrow_hashref;
1978 my $result = $line->{'routingids'};
1982 =head2 addroutingmember
1984 addroutingmember($borrowernumber,$subscriptionid)
1986 this function takes a borrowernumber and subscriptionid and adds the member to the
1987 routing list for that serial subscription and gives them a rank on the list
1988 of either 1 or highest current rank + 1
1992 sub addroutingmember
{
1993 my ( $borrowernumber, $subscriptionid ) = @_;
1995 return unless ($borrowernumber and $subscriptionid);
1998 my $dbh = C4
::Context
->dbh;
1999 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2000 $sth->execute($subscriptionid);
2001 while ( my $line = $sth->fetchrow_hashref ) {
2002 if ( $line->{'rank'} > 0 ) {
2003 $rank = $line->{'rank'} + 1;
2008 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2009 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2012 =head2 reorder_members
2014 reorder_members($subscriptionid,$routingid,$rank)
2016 this function is used to reorder the routing list
2018 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2019 - it gets all members on list puts their routingid's into an array
2020 - removes the one in the array that is $routingid
2021 - then reinjects $routingid at point indicated by $rank
2022 - then update the database with the routingids in the new order
2026 sub reorder_members
{
2027 my ( $subscriptionid, $routingid, $rank ) = @_;
2028 my $dbh = C4
::Context
->dbh;
2029 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2030 $sth->execute($subscriptionid);
2032 while ( my $line = $sth->fetchrow_hashref ) {
2033 push( @result, $line->{'routingid'} );
2036 # To find the matching index
2038 my $key = -1; # to allow for 0 being a valid response
2039 for ( $i = 0 ; $i < @result ; $i++ ) {
2040 if ( $routingid == $result[$i] ) {
2041 $key = $i; # save the index
2046 # if index exists in array then move it to new position
2047 if ( $key > -1 && $rank > 0 ) {
2048 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2049 my $moving_item = splice( @result, $key, 1 );
2050 splice( @result, $new_rank, 0, $moving_item );
2052 for ( my $j = 0 ; $j < @result ; $j++ ) {
2053 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2059 =head2 delroutingmember
2061 delroutingmember($routingid,$subscriptionid)
2063 this function either deletes one member from routing list if $routingid exists otherwise
2064 deletes all members from the routing list
2068 sub delroutingmember
{
2070 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2071 my ( $routingid, $subscriptionid ) = @_;
2072 my $dbh = C4
::Context
->dbh;
2074 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2075 $sth->execute($routingid);
2076 reorder_members
( $subscriptionid, $routingid );
2078 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2079 $sth->execute($subscriptionid);
2084 =head2 getroutinglist
2086 @routinglist = getroutinglist($subscriptionid)
2088 this gets the info from the subscriptionroutinglist for $subscriptionid
2091 the routinglist as an array. Each element of the array contains a hash_ref containing
2092 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2096 sub getroutinglist
{
2097 my ($subscriptionid) = @_;
2098 my $dbh = C4
::Context
->dbh;
2099 my $sth = $dbh->prepare(
2100 'SELECT routingid, borrowernumber, ranking, biblionumber
2102 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2103 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2105 $sth->execute($subscriptionid);
2106 my $routinglist = $sth->fetchall_arrayref({});
2107 return @
{$routinglist};
2110 =head2 countissuesfrom
2112 $result = countissuesfrom($subscriptionid,$startdate)
2114 Returns a count of serial rows matching the given subsctiptionid
2115 with published date greater than startdate
2119 sub countissuesfrom
{
2120 my ( $subscriptionid, $startdate ) = @_;
2121 my $dbh = C4
::Context
->dbh;
2125 WHERE subscriptionid
=?
2126 AND serial
.publisheddate
>?
2128 my $sth = $dbh->prepare($query);
2129 $sth->execute( $subscriptionid, $startdate );
2130 my ($countreceived) = $sth->fetchrow;
2131 return $countreceived;
2136 $result = CountIssues($subscriptionid)
2138 Returns a count of serial rows matching the given subsctiptionid
2143 my ($subscriptionid) = @_;
2144 my $dbh = C4
::Context
->dbh;
2148 WHERE subscriptionid
=?
2150 my $sth = $dbh->prepare($query);
2151 $sth->execute($subscriptionid);
2152 my ($countreceived) = $sth->fetchrow;
2153 return $countreceived;
2158 $result = HasItems($subscriptionid)
2160 returns a count of items from serial matching the subscriptionid
2165 my ($subscriptionid) = @_;
2166 my $dbh = C4
::Context
->dbh;
2168 SELECT COUNT
(serialitems
.itemnumber
)
2170 LEFT JOIN serialitems USING
(serialid
)
2171 WHERE subscriptionid
=? AND serialitems
.serialid IS NOT NULL
2173 my $sth=$dbh->prepare($query);
2174 $sth->execute($subscriptionid);
2175 my ($countitems)=$sth->fetchrow_array();
2179 =head2 abouttoexpire
2181 $result = abouttoexpire($subscriptionid)
2183 this function alerts you to the penultimate issue for a serial subscription
2185 returns 1 - if this is the penultimate issue
2191 my ($subscriptionid) = @_;
2192 my $dbh = C4
::Context
->dbh;
2193 my $subscription = GetSubscription
($subscriptionid);
2194 my $per = $subscription->{'periodicity'};
2195 my $frequency = C4
::Serials
::Frequency
::GetSubscriptionFrequency
($per);
2196 if ($frequency and $frequency->{unit
}){
2198 my $expirationdate = GetExpirationDate
($subscriptionid);
2200 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2201 my $nextdate = GetNextDate
($subscription, $res);
2203 # only compare dates if both dates exist.
2204 if ($nextdate and $expirationdate) {
2205 if(Date
::Calc
::Delta_Days
(
2206 split( /-/, $nextdate ),
2207 split( /-/, $expirationdate )
2213 } elsif ($subscription->{numberlength
}>0) {
2214 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2220 sub in_array
{ # used in next sub down
2221 my ( $val, @elements ) = @_;
2222 foreach my $elem (@elements) {
2223 if ( $val == $elem ) {
2230 =head2 GetSubscriptionsFromBorrower
2232 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2234 this gets the info from subscriptionroutinglist for each $subscriptionid
2237 a count of the serial subscription routing lists to which a patron belongs,
2238 with the titles of those serial subscriptions as an array. Each element of the array
2239 contains a hash_ref with subscriptionID and title of subscription.
2243 sub GetSubscriptionsFromBorrower
{
2244 my ($borrowernumber) = @_;
2245 my $dbh = C4
::Context
->dbh;
2246 my $sth = $dbh->prepare(
2247 "SELECT subscription.subscriptionid, biblio.title
2249 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2250 JOIN subscriptionroutinglist USING (subscriptionid)
2251 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2254 $sth->execute($borrowernumber);
2257 while ( my $line = $sth->fetchrow_hashref ) {
2259 push( @routinglist, $line );
2261 return ( $count, @routinglist );
2265 =head2 GetFictiveIssueNumber
2267 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2269 Get the position of the issue published at $publisheddate, considering the
2270 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2271 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2272 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2273 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2274 depending on how many rows are in serial table.
2275 The issue number calculation is based on subscription frequency, first acquisition
2276 date, and $publisheddate.
2280 sub GetFictiveIssueNumber
{
2281 my ($subscription, $publisheddate) = @_;
2283 my $frequency = GetSubscriptionFrequency
($subscription->{'periodicity'});
2284 my $unit = $frequency->{unit
} ?
lc $frequency->{'unit'} : undef;
2288 my ($year, $month, $day) = split /-/, $publisheddate;
2289 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2293 if($unit eq 'day') {
2294 $delta = Delta_Days
($fa_year, $fa_month, $fa_day, $year, $month, $day);
2295 } elsif($unit eq 'week') {
2296 ($wkno, $year) = Week_of_Year
($year, $month, $day);
2297 my ($fa_wkno, $fa_yr) = Week_of_Year
($fa_year, $fa_month, $fa_day);
2298 $delta = ($fa_yr == $year) ?
($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2299 } elsif($unit eq 'month') {
2300 $delta = ($fa_year == $year)
2301 ?
($month - $fa_month)
2302 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2303 } elsif($unit eq 'year') {
2304 $delta = $year - $fa_year;
2306 if($frequency->{'unitsperissue'} == 1) {
2307 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2309 # Assuming issuesperunit == 1
2310 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2316 sub _get_next_date_day
{
2317 my ($subscription, $freqdata, $year, $month, $day) = @_;
2319 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2320 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , $freqdata->{unitsperissue
} );
2321 $subscription->{countissuesperunit
} = 1;
2323 $subscription->{countissuesperunit
}++;
2326 return ($year, $month, $day);
2329 sub _get_next_date_week
{
2330 my ($subscription, $freqdata, $year, $month, $day) = @_;
2332 my ($wkno, $yr) = Week_of_Year
($year, $month, $day);
2333 my $fa_dow = Day_of_Week
(split /-/, $subscription->{firstacquidate
});
2335 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2336 $subscription->{countissuesperunit
} = 1;
2337 $wkno += $freqdata->{unitsperissue
};
2342 ($year,$month,$day) = Monday_of_Week
($wkno, $yr);
2343 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $fa_dow - 1);
2345 # Try to guess the next day of week
2346 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit
});
2347 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2348 $subscription->{countissuesperunit
}++;
2351 return ($year, $month, $day);
2354 sub _get_next_date_month
{
2355 my ($subscription, $freqdata, $year, $month, $day) = @_;
2358 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate
};
2360 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2361 $subscription->{countissuesperunit
} = 1;
2362 ($year,$month,$day) = Add_Delta_YM
($year,$month,$day, 0,
2363 $freqdata->{unitsperissue
});
2364 my $days_in_month = Days_in_Month
($year, $month);
2365 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2367 # Try to guess the next day in month
2368 my $days_in_month = Days_in_Month
($year, $month);
2369 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2370 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2371 $subscription->{countissuesperunit
}++;
2374 return ($year, $month, $day);
2377 sub _get_next_date_year
{
2378 my ($subscription, $freqdata, $year, $month, $day) = @_;
2380 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate
};
2382 if ($subscription->{countissuesperunit
} + 1 > $freqdata->{issuesperunit
}){
2383 $subscription->{countissuesperunit
} = 1;
2384 ($year) = Add_Delta_YM
($year,$month,$day, $freqdata->{"unitsperissue"},0);
2386 my $days_in_month = Days_in_Month
($year, $month);
2387 $day = $fa_day <= $days_in_month ?
$fa_day : $days_in_month;
2389 # Try to guess the next day in year
2390 my $days_in_year = Days_in_Year
($year,12); #Sum the days of all the months of this year
2391 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit
});
2392 ($year,$month,$day) = Add_Delta_Days
($year, $month, $day, $delta_days);
2393 $subscription->{countissuesperunit
}++;
2396 return ($year, $month, $day);
2401 $resultdate = GetNextDate($publisheddate,$subscription)
2403 this function it takes the publisheddate and will return the next issue's date
2404 and will skip dates if there exists an irregularity.
2405 $publisheddate has to be an ISO date
2406 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2407 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2408 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2409 skipped then the returned date will be 2007-05-10
2412 $resultdate - then next date in the sequence (ISO date)
2414 Return undef if subscription is irregular
2419 my ( $subscription, $publisheddate, $updatecount ) = @_;
2421 return unless $subscription and $publisheddate;
2423 my $freqdata = GetSubscriptionFrequency
($subscription->{'periodicity'});
2425 if ($freqdata->{'unit'}) {
2426 my ( $year, $month, $day ) = split /-/, $publisheddate;
2428 # Process an irregularity Hash
2429 # Suppose that irregularities are stored in a string with this structure
2430 # irreg1;irreg2;irreg3
2431 # where irregX is the number of issue which will not be received
2432 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2434 if ( $subscription->{irregularity
} ) {
2435 my @irreg = split /;/, $subscription->{'irregularity'} ;
2436 foreach my $irregularity (@irreg) {
2437 $irregularities{$irregularity} = 1;
2441 # Get the 'fictive' next issue number
2442 # It is used to check if next issue is an irregular issue.
2443 my $issueno = GetFictiveIssueNumber
($subscription, $publisheddate) + 1;
2445 # Then get the next date
2446 my $unit = lc $freqdata->{'unit'};
2447 if ($unit eq 'day') {
2448 while ($irregularities{$issueno}) {
2449 ($year, $month, $day) = _get_next_date_day
($subscription,
2450 $freqdata, $year, $month, $day);
2453 ($year, $month, $day) = _get_next_date_day
($subscription, $freqdata,
2454 $year, $month, $day);
2456 elsif ($unit eq 'week') {
2457 while ($irregularities{$issueno}) {
2458 ($year, $month, $day) = _get_next_date_week
($subscription,
2459 $freqdata, $year, $month, $day);
2462 ($year, $month, $day) = _get_next_date_week
($subscription,
2463 $freqdata, $year, $month, $day);
2465 elsif ($unit eq 'month') {
2466 while ($irregularities{$issueno}) {
2467 ($year, $month, $day) = _get_next_date_month
($subscription,
2468 $freqdata, $year, $month, $day);
2471 ($year, $month, $day) = _get_next_date_month
($subscription,
2472 $freqdata, $year, $month, $day);
2474 elsif ($unit eq 'year') {
2475 while ($irregularities{$issueno}) {
2476 ($year, $month, $day) = _get_next_date_year
($subscription,
2477 $freqdata, $year, $month, $day);
2480 ($year, $month, $day) = _get_next_date_year
($subscription,
2481 $freqdata, $year, $month, $day);
2485 my $dbh = C4
::Context
->dbh;
2488 SET countissuesperunit
= ?
2489 WHERE subscriptionid
= ?
2491 my $sth = $dbh->prepare($query);
2492 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2495 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2501 $string = &_numeration($value,$num_type,$locale);
2503 _numeration returns the string corresponding to $value in the num_type
2516 my ($value, $num_type, $locale) = @_;
2521 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2522 # 1970-11-01 was a Sunday
2523 $value = $value % 7;
2524 my $dt = DateTime
->new(
2530 $string = $num_type =~ /^dayname$/
2531 ?
$dt->strftime("%A")
2532 : $dt->strftime("%a");
2533 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2534 $value = $value % 12;
2535 my $dt = DateTime
->new(
2537 month
=> $value + 1,
2540 $string = $num_type =~ /^monthname$/
2541 ?
$dt->strftime("%B")
2542 : $dt->strftime("%b");
2543 } elsif ( $num_type =~ /^season$/ ) {
2544 my @seasons= qw( Spring Summer Fall Winter );
2545 $value = $value % 4;
2546 $string = $seasons[$value];
2547 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2548 my @seasonsabrv= qw( Spr Sum Fal Win );
2549 $value = $value % 4;
2550 $string = $seasonsabrv[$value];
2558 =head2 is_barcode_in_use
2560 Returns number of occurrences of the barcode in the items table
2561 Can be used as a boolean test of whether the barcode has
2562 been deployed as yet
2566 sub is_barcode_in_use
{
2567 my $barcode = shift;
2568 my $dbh = C4
::Context
->dbh;
2569 my $occurrences = $dbh->selectall_arrayref(
2570 'SELECT itemnumber from items where barcode = ?',
2575 return @
{$occurrences};
2578 =head2 CloseSubscription
2579 Close a subscription given a subscriptionid
2581 sub CloseSubscription
{
2582 my ( $subscriptionid ) = @_;
2583 return unless $subscriptionid;
2584 my $dbh = C4
::Context
->dbh;
2585 my $sth = $dbh->prepare( q{
2588 WHERE subscriptionid = ?
2590 $sth->execute( $subscriptionid );
2592 # Set status = missing when status = stopped
2593 $sth = $dbh->prepare( q{
2596 WHERE subscriptionid = ?
2599 $sth->execute( STOPPED
, $subscriptionid, EXPECTED
);
2602 =head2 ReopenSubscription
2603 Reopen a subscription given a subscriptionid
2605 sub ReopenSubscription
{
2606 my ( $subscriptionid ) = @_;
2607 return unless $subscriptionid;
2608 my $dbh = C4
::Context
->dbh;
2609 my $sth = $dbh->prepare( q{
2612 WHERE subscriptionid = ?
2614 $sth->execute( $subscriptionid );
2616 # Set status = expected when status = stopped
2617 $sth = $dbh->prepare( q{
2620 WHERE subscriptionid = ?
2623 $sth->execute( EXPECTED
, $subscriptionid, STOPPED
);
2626 =head2 subscriptionCurrentlyOnOrder
2628 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2630 Return 1 if subscription is currently on order else 0.
2634 sub subscriptionCurrentlyOnOrder
{
2635 my ( $subscriptionid ) = @_;
2636 my $dbh = C4
::Context
->dbh;
2638 SELECT COUNT
(*) FROM aqorders
2639 WHERE subscriptionid
= ?
2640 AND datereceived IS NULL
2641 AND datecancellationprinted IS NULL
2643 my $sth = $dbh->prepare( $query );
2644 $sth->execute($subscriptionid);
2645 return $sth->fetchrow_array;
2648 =head2 can_claim_subscription
2650 $can = can_claim_subscription( $subscriptionid[, $userid] );
2652 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2656 sub can_claim_subscription
{
2657 my ( $subscription, $userid ) = @_;
2658 return _can_do_on_subscription
( $subscription, $userid, 'claim_serials' );
2661 =head2 can_edit_subscription
2663 $can = can_edit_subscription( $subscriptionid[, $userid] );
2665 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2669 sub can_edit_subscription
{
2670 my ( $subscription, $userid ) = @_;
2671 return _can_do_on_subscription
( $subscription, $userid, 'edit_subscription' );
2674 =head2 can_show_subscription
2676 $can = can_show_subscription( $subscriptionid[, $userid] );
2678 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2682 sub can_show_subscription
{
2683 my ( $subscription, $userid ) = @_;
2684 return _can_do_on_subscription
( $subscription, $userid, '*' );
2687 sub _can_do_on_subscription
{
2688 my ( $subscription, $userid, $permission ) = @_;
2689 return 0 unless C4
::Context
->userenv;
2690 my $flags = C4
::Context
->userenv->{flags
};
2691 $userid ||= C4
::Context
->userenv->{'id'};
2693 if ( C4
::Context
->preference('IndependentBranches') ) {
2695 if C4
::Context
->IsSuperLibrarian()
2697 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2699 C4
::Auth
::haspermission
( $userid,
2700 { serials
=> $permission } )
2701 and ( not defined $subscription->{branchcode
}
2702 or $subscription->{branchcode
} eq ''
2703 or $subscription->{branchcode
} eq
2704 C4
::Context
->userenv->{'branch'} )
2709 if C4
::Context
->IsSuperLibrarian()
2711 C4
::Auth
::haspermission
( $userid, { serials
=> 'superserials' } )
2712 or C4
::Auth
::haspermission
(
2713 $userid, { serials
=> $permission }
2720 =head2 findSerialsByStatus
2722 @serials = findSerialsByStatus($status, $subscriptionid);
2724 Returns an array of serials matching a given status and subscription id.
2728 sub findSerialsByStatus
{
2729 my ( $status, $subscriptionid ) = @_;
2730 my $dbh = C4
::Context
->dbh;
2731 my $query = q
| SELECT
* from serial
2733 AND subscriptionid
= ?
2735 my $serials = $dbh->selectall_arrayref( $query, { Slice
=> {} }, $status, $subscriptionid );
2744 Koha Development Team <http://koha-community.org/>