Bug 15358: Fix authorities merge
[koha.git] / C4 / Serials.pm
blobc09a1984b497f71843953f7aca144520a6fdad50
1 package C4::Serials;
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>.
21 use Modern::Perl;
23 use C4::Auth qw(haspermission);
24 use C4::Context;
25 use DateTime;
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
28 use C4::Biblio;
29 use C4::Log; # logaction
30 use C4::Debug;
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalField;
34 use Koha::DateUtils;
35 use Koha::Serial;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
39 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
41 # Define statuses
42 use constant {
43 EXPECTED => 1,
44 ARRIVED => 2,
45 LATE => 3,
46 MISSING => 4,
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
50 MISSING_LOST => 44,
51 NOT_ISSUED => 5,
52 DELETED => 6,
53 CLAIMED => 7,
54 STOPPED => 8,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
60 MISSING_LOST
63 BEGIN {
64 $VERSION = 3.07.00.049; # set version for version checking
65 require Exporter;
66 @ISA = qw(Exporter);
67 @EXPORT = qw(
68 &NewSubscription &ModSubscription &DelSubscription
69 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &SearchSubscriptions
71 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
72 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
73 &GetSubscriptionHistoryFromSubscriptionId
75 &GetNextSeq &GetSeq &NewIssue &GetSerials
76 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
77 &ReNewSubscription &GetLateOrMissingIssues
78 &GetSerialInformation &AddItem2Serial
79 &PrepareSerialsData &GetNextExpected &ModNextExpected
81 &UpdateClaimdateIssues
82 &GetSuppliersWithLateIssues &getsupplierbyserialid
83 &GetDistributedTo &SetDistributedTo
84 &getroutinglist &delroutingmember &addroutingmember
85 &reorder_members
86 &check_routing &updateClaim
87 &CountIssues
88 HasItems
89 &GetSubscriptionsFromBorrower
90 &subscriptionCurrentlyOnOrder
95 =head1 NAME
97 C4::Serials - Serials Module Functions
99 =head1 SYNOPSIS
101 use C4::Serials;
103 =head1 DESCRIPTION
105 Functions for handling subscriptions, claims routing etc.
108 =head1 SUBROUTINES
110 =head2 GetSuppliersWithLateIssues
112 $supplierlist = GetSuppliersWithLateIssues()
114 this function get all suppliers with late issues.
116 return :
117 an array_ref of suppliers each entry is a hash_ref containing id and name
118 the array is in name order
120 =cut
122 sub GetSuppliersWithLateIssues {
123 my $dbh = C4::Context->dbh;
124 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
125 my $query = qq|
126 SELECT DISTINCT id, name
127 FROM subscription
128 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
129 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 WHERE id > 0
131 AND (
132 (planneddate < now() AND serial.status=1)
133 OR serial.STATUS IN ( $statuses )
135 AND subscription.closed = 0
136 ORDER BY name|;
137 return $dbh->selectall_arrayref($query, { Slice => {} });
140 =head2 GetSubscriptionHistoryFromSubscriptionId
142 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
144 This function returns the subscription history as a hashref
146 =cut
148 sub GetSubscriptionHistoryFromSubscriptionId {
149 my ($subscriptionid) = @_;
151 return unless $subscriptionid;
153 my $dbh = C4::Context->dbh;
154 my $query = qq|
155 SELECT *
156 FROM subscriptionhistory
157 WHERE subscriptionid = ?
159 my $sth = $dbh->prepare($query);
160 $sth->execute($subscriptionid);
161 my $results = $sth->fetchrow_hashref;
162 $sth->finish;
164 return $results;
167 =head2 GetSerialStatusFromSerialId
169 $sth = GetSerialStatusFromSerialId();
170 this function returns a statement handle
171 After this function, don't forget to execute it by using $sth->execute($serialid)
172 return :
173 $sth = $dbh->prepare($query).
175 =cut
177 sub GetSerialStatusFromSerialId {
178 my $dbh = C4::Context->dbh;
179 my $query = qq|
180 SELECT status
181 FROM serial
182 WHERE serialid = ?
184 return $dbh->prepare($query);
187 =head2 GetSerialInformation
190 $data = GetSerialInformation($serialid);
191 returns a hash_ref containing :
192 items : items marcrecord (can be an array)
193 serial table field
194 subscription table field
195 + information about subscription expiration
197 =cut
199 sub GetSerialInformation {
200 my ($serialid) = @_;
201 my $dbh = C4::Context->dbh;
202 my $query = qq|
203 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
204 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
205 WHERE serialid = ?
207 my $rq = $dbh->prepare($query);
208 $rq->execute($serialid);
209 my $data = $rq->fetchrow_hashref;
211 # create item information if we have serialsadditems for this subscription
212 if ( $data->{'serialsadditems'} ) {
213 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
214 $queryitem->execute($serialid);
215 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
216 require C4::Items;
217 if ( scalar(@$itemnumbers) > 0 ) {
218 foreach my $itemnum (@$itemnumbers) {
220 #It is ASSUMED that GetMarcItem ALWAYS WORK...
221 #Maybe GetMarcItem should return values on failure
222 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
223 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
224 $itemprocessed->{'itemnumber'} = $itemnum->[0];
225 $itemprocessed->{'itemid'} = $itemnum->[0];
226 $itemprocessed->{'serialid'} = $serialid;
227 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
228 push @{ $data->{'items'} }, $itemprocessed;
230 } else {
231 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
232 $itemprocessed->{'itemid'} = "N$serialid";
233 $itemprocessed->{'serialid'} = $serialid;
234 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
235 $itemprocessed->{'countitems'} = 0;
236 push @{ $data->{'items'} }, $itemprocessed;
239 $data->{ "status" . $data->{'serstatus'} } = 1;
240 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
241 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
242 $data->{cannotedit} = not can_edit_subscription( $data );
243 return $data;
246 =head2 AddItem2Serial
248 $rows = AddItem2Serial($serialid,$itemnumber);
249 Adds an itemnumber to Serial record
250 returns the number of rows affected
252 =cut
254 sub AddItem2Serial {
255 my ( $serialid, $itemnumber ) = @_;
257 return unless ($serialid and $itemnumber);
259 my $dbh = C4::Context->dbh;
260 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
261 $rq->execute( $serialid, $itemnumber );
262 return $rq->rows;
265 =head2 UpdateClaimdateIssues
267 UpdateClaimdateIssues($serialids,[$date]);
269 Update Claimdate for issues in @$serialids list with date $date
270 (Take Today if none)
272 =cut
274 sub UpdateClaimdateIssues {
275 my ( $serialids, $date ) = @_;
277 return unless ($serialids);
279 my $dbh = C4::Context->dbh;
280 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
281 my $query = "
282 UPDATE serial
283 SET claimdate = ?,
284 status = ?,
285 claims_count = claims_count + 1
286 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
288 my $rq = $dbh->prepare($query);
289 $rq->execute($date, CLAIMED, @$serialids);
290 return $rq->rows;
293 =head2 GetSubscription
295 $subs = GetSubscription($subscriptionid)
296 this function returns the subscription which has $subscriptionid as id.
297 return :
298 a hashref. This hash containts
299 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
301 =cut
303 sub GetSubscription {
304 my ($subscriptionid) = @_;
305 my $dbh = C4::Context->dbh;
306 my $query = qq(
307 SELECT subscription.*,
308 subscriptionhistory.*,
309 aqbooksellers.name AS aqbooksellername,
310 biblio.title AS bibliotitle,
311 subscription.biblionumber as bibnum
312 FROM subscription
313 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
314 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
315 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
316 WHERE subscription.subscriptionid = ?
319 $debug and warn "query : $query\nsubsid :$subscriptionid";
320 my $sth = $dbh->prepare($query);
321 $sth->execute($subscriptionid);
322 my $subscription = $sth->fetchrow_hashref;
324 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
326 # Add additional fields to the subscription into a new key "additional_fields"
327 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
328 tablename => 'subscription',
329 record_id => $subscriptionid,
331 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
333 return $subscription;
336 =head2 GetFullSubscription
338 $array_ref = GetFullSubscription($subscriptionid)
339 this function reads the serial table.
341 =cut
343 sub GetFullSubscription {
344 my ($subscriptionid) = @_;
346 return unless ($subscriptionid);
348 my $dbh = C4::Context->dbh;
349 my $query = qq|
350 SELECT serial.serialid,
351 serial.serialseq,
352 serial.planneddate,
353 serial.publisheddate,
354 serial.publisheddatetext,
355 serial.status,
356 serial.notes as notes,
357 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
358 aqbooksellers.name as aqbooksellername,
359 biblio.title as bibliotitle,
360 subscription.branchcode AS branchcode,
361 subscription.subscriptionid AS subscriptionid
362 FROM serial
363 LEFT JOIN subscription ON
364 (serial.subscriptionid=subscription.subscriptionid )
365 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
366 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
367 WHERE serial.subscriptionid = ?
368 ORDER BY year DESC,
369 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
370 serial.subscriptionid
372 $debug and warn "GetFullSubscription query: $query";
373 my $sth = $dbh->prepare($query);
374 $sth->execute($subscriptionid);
375 my $subscriptions = $sth->fetchall_arrayref( {} );
376 for my $subscription ( @$subscriptions ) {
377 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
379 return $subscriptions;
382 =head2 PrepareSerialsData
384 $array_ref = PrepareSerialsData($serialinfomation)
385 where serialinformation is a hashref array
387 =cut
389 sub PrepareSerialsData {
390 my ($lines) = @_;
392 return unless ($lines);
394 my %tmpresults;
395 my $year;
396 my @res;
397 my $startdate;
398 my $aqbooksellername;
399 my $bibliotitle;
400 my @loopissues;
401 my $first;
402 my $previousnote = "";
404 foreach my $subs (@{$lines}) {
405 for my $datefield ( qw(publisheddate planneddate) ) {
406 # handle 0000-00-00 dates
407 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
408 $subs->{$datefield} = undef;
411 $subs->{ "status" . $subs->{'status'} } = 1;
412 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
413 $subs->{"checked"} = 1;
416 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
417 $year = $subs->{'year'};
418 } else {
419 $year = "manage";
421 if ( $tmpresults{$year} ) {
422 push @{ $tmpresults{$year}->{'serials'} }, $subs;
423 } else {
424 $tmpresults{$year} = {
425 'year' => $year,
426 'aqbooksellername' => $subs->{'aqbooksellername'},
427 'bibliotitle' => $subs->{'bibliotitle'},
428 'serials' => [$subs],
429 'first' => $first,
433 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
434 push @res, $tmpresults{$key};
436 return \@res;
439 =head2 GetSubscriptionsFromBiblionumber
441 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
442 this function get the subscription list. it reads the subscription table.
443 return :
444 reference to an array of subscriptions which have the biblionumber given on input arg.
445 each element of this array is a hashref containing
446 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
448 =cut
450 sub GetSubscriptionsFromBiblionumber {
451 my ($biblionumber) = @_;
453 return unless ($biblionumber);
455 my $dbh = C4::Context->dbh;
456 my $query = qq(
457 SELECT subscription.*,
458 branches.branchname,
459 subscriptionhistory.*,
460 aqbooksellers.name AS aqbooksellername,
461 biblio.title AS bibliotitle
462 FROM subscription
463 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
464 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
465 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
466 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
467 WHERE subscription.biblionumber = ?
469 my $sth = $dbh->prepare($query);
470 $sth->execute($biblionumber);
471 my @res;
472 while ( my $subs = $sth->fetchrow_hashref ) {
473 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
474 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
475 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
476 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
477 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
478 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
479 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
480 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
481 $subs->{ "status" . $subs->{'status'} } = 1;
483 if ( $subs->{enddate} eq '0000-00-00' ) {
484 $subs->{enddate} = '';
485 } else {
486 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
488 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
489 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
490 $subs->{cannotedit} = not can_edit_subscription( $subs );
491 push @res, $subs;
493 return \@res;
496 =head2 GetFullSubscriptionsFromBiblionumber
498 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
499 this function reads the serial table.
501 =cut
503 sub GetFullSubscriptionsFromBiblionumber {
504 my ($biblionumber) = @_;
505 my $dbh = C4::Context->dbh;
506 my $query = qq|
507 SELECT serial.serialid,
508 serial.serialseq,
509 serial.planneddate,
510 serial.publisheddate,
511 serial.publisheddatetext,
512 serial.status,
513 serial.notes as notes,
514 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
515 biblio.title as bibliotitle,
516 subscription.branchcode AS branchcode,
517 subscription.subscriptionid AS subscriptionid
518 FROM serial
519 LEFT JOIN subscription ON
520 (serial.subscriptionid=subscription.subscriptionid)
521 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
522 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
523 WHERE subscription.biblionumber = ?
524 ORDER BY year DESC,
525 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
526 serial.subscriptionid
528 my $sth = $dbh->prepare($query);
529 $sth->execute($biblionumber);
530 my $subscriptions = $sth->fetchall_arrayref( {} );
531 for my $subscription ( @$subscriptions ) {
532 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
534 return $subscriptions;
537 =head2 SearchSubscriptions
539 @results = SearchSubscriptions($args);
541 This function returns a list of hashrefs, one for each subscription
542 that meets the conditions specified by the $args hashref.
544 The valid search fields are:
546 biblionumber
547 title
548 issn
550 callnumber
551 location
552 publisher
553 bookseller
554 branch
555 expiration_date
556 closed
558 The expiration_date search field is special; it specifies the maximum
559 subscription expiration date.
561 =cut
563 sub SearchSubscriptions {
564 my ( $args ) = @_;
566 my $additional_fields = $args->{additional_fields} // [];
567 my $matching_record_ids_for_additional_fields = [];
568 if ( @$additional_fields ) {
569 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
570 fields => $additional_fields,
571 tablename => 'subscription',
572 exact_match => 0,
574 return () unless @$matching_record_ids_for_additional_fields;
577 my $query = q|
578 SELECT
579 subscription.notes AS publicnotes,
580 subscriptionhistory.*,
581 subscription.*,
582 biblio.notes AS biblionotes,
583 biblio.title,
584 biblio.author,
585 biblio.biblionumber,
586 biblioitems.issn
587 FROM subscription
588 LEFT JOIN subscriptionhistory USING(subscriptionid)
589 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
590 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
591 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
593 $query .= q| WHERE 1|;
594 my @where_strs;
595 my @where_args;
596 if( $args->{biblionumber} ) {
597 push @where_strs, "biblio.biblionumber = ?";
598 push @where_args, $args->{biblionumber};
601 if( $args->{title} ){
602 my @words = split / /, $args->{title};
603 my (@strs, @args);
604 foreach my $word (@words) {
605 push @strs, "biblio.title LIKE ?";
606 push @args, "%$word%";
608 if (@strs) {
609 push @where_strs, '(' . join (' AND ', @strs) . ')';
610 push @where_args, @args;
613 if( $args->{issn} ){
614 push @where_strs, "biblioitems.issn LIKE ?";
615 push @where_args, "%$args->{issn}%";
617 if( $args->{ean} ){
618 push @where_strs, "biblioitems.ean LIKE ?";
619 push @where_args, "%$args->{ean}%";
621 if ( $args->{callnumber} ) {
622 push @where_strs, "subscription.callnumber LIKE ?";
623 push @where_args, "%$args->{callnumber}%";
625 if( $args->{publisher} ){
626 push @where_strs, "biblioitems.publishercode LIKE ?";
627 push @where_args, "%$args->{publisher}%";
629 if( $args->{bookseller} ){
630 push @where_strs, "aqbooksellers.name LIKE ?";
631 push @where_args, "%$args->{bookseller}%";
633 if( $args->{branch} ){
634 push @where_strs, "subscription.branchcode = ?";
635 push @where_args, "$args->{branch}";
637 if ( $args->{location} ) {
638 push @where_strs, "subscription.location = ?";
639 push @where_args, "$args->{location}";
641 if ( $args->{expiration_date} ) {
642 push @where_strs, "subscription.enddate <= ?";
643 push @where_args, "$args->{expiration_date}";
645 if( defined $args->{closed} ){
646 push @where_strs, "subscription.closed = ?";
647 push @where_args, "$args->{closed}";
650 if(@where_strs){
651 $query .= ' AND ' . join(' AND ', @where_strs);
653 if ( @$additional_fields ) {
654 $query .= ' AND subscriptionid IN ('
655 . join( ', ', @$matching_record_ids_for_additional_fields )
656 . ')';
659 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
661 my $dbh = C4::Context->dbh;
662 my $sth = $dbh->prepare($query);
663 $sth->execute(@where_args);
664 my $results = $sth->fetchall_arrayref( {} );
666 for my $subscription ( @$results ) {
667 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
668 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
670 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
671 record_id => $subscription->{subscriptionid},
672 tablename => 'subscription'
674 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
677 return @$results;
681 =head2 GetSerials
683 ($totalissues,@serials) = GetSerials($subscriptionid);
684 this function gets every serial not arrived for a given subscription
685 as well as the number of issues registered in the database (all types)
686 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
688 FIXME: We should return \@serials.
690 =cut
692 sub GetSerials {
693 my ( $subscriptionid, $count ) = @_;
695 return unless $subscriptionid;
697 my $dbh = C4::Context->dbh;
699 # status = 2 is "arrived"
700 my $counter = 0;
701 $count = 5 unless ($count);
702 my @serials;
703 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
704 my $query = "SELECT serialid,serialseq, status, publisheddate,
705 publisheddatetext, planneddate,notes, routingnotes
706 FROM serial
707 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
708 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
709 my $sth = $dbh->prepare($query);
710 $sth->execute($subscriptionid);
712 while ( my $line = $sth->fetchrow_hashref ) {
713 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
714 for my $datefield ( qw( planneddate publisheddate) ) {
715 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
716 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
717 } else {
718 $line->{$datefield} = q{};
721 push @serials, $line;
724 # OK, now add the last 5 issues arrives/missing
725 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
726 publisheddatetext, notes, routingnotes
727 FROM serial
728 WHERE subscriptionid = ?
729 AND status IN ( $statuses )
730 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
732 $sth = $dbh->prepare($query);
733 $sth->execute($subscriptionid);
734 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
735 $counter++;
736 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
737 for my $datefield ( qw( planneddate publisheddate) ) {
738 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
739 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
740 } else {
741 $line->{$datefield} = q{};
745 push @serials, $line;
748 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
749 $sth = $dbh->prepare($query);
750 $sth->execute($subscriptionid);
751 my ($totalissues) = $sth->fetchrow;
752 return ( $totalissues, @serials );
755 =head2 GetSerials2
757 @serials = GetSerials2($subscriptionid,$statuses);
758 this function returns every serial waited for a given subscription
759 as well as the number of issues registered in the database (all types)
760 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
762 $statuses is an arrayref of statuses and is mandatory.
764 =cut
766 sub GetSerials2 {
767 my ( $subscription, $statuses ) = @_;
769 return unless ($subscription and @$statuses);
771 my $statuses_string = join ',', @$statuses;
773 my $dbh = C4::Context->dbh;
774 my $query = qq|
775 SELECT serialid,serialseq, status, planneddate, publisheddate,
776 publisheddatetext, notes, routingnotes
777 FROM serial
778 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
779 ORDER BY publisheddate,serialid DESC
781 $debug and warn "GetSerials2 query: $query";
782 my $sth = $dbh->prepare($query);
783 $sth->execute;
784 my @serials;
786 while ( my $line = $sth->fetchrow_hashref ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 # Format dates for display
789 for my $datefield ( qw( planneddate publisheddate ) ) {
790 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
791 $line->{$datefield} = q{};
793 else {
794 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
797 push @serials, $line;
799 return @serials;
802 =head2 GetLatestSerials
804 \@serials = GetLatestSerials($subscriptionid,$limit)
805 get the $limit's latest serials arrived or missing for a given subscription
806 return :
807 a ref to an array which contains all of the latest serials stored into a hash.
809 =cut
811 sub GetLatestSerials {
812 my ( $subscriptionid, $limit ) = @_;
814 return unless ($subscriptionid and $limit);
816 my $dbh = C4::Context->dbh;
818 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
819 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
820 FROM serial
821 WHERE subscriptionid = ?
822 AND status IN ($statuses)
823 ORDER BY publisheddate DESC LIMIT 0,$limit
825 my $sth = $dbh->prepare($strsth);
826 $sth->execute($subscriptionid);
827 my @serials;
828 while ( my $line = $sth->fetchrow_hashref ) {
829 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
830 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
831 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
832 push @serials, $line;
835 return \@serials;
838 =head2 GetDistributedTo
840 $distributedto=GetDistributedTo($subscriptionid)
841 This function returns the field distributedto for the subscription matching subscriptionid
843 =cut
845 sub GetDistributedTo {
846 my $dbh = C4::Context->dbh;
847 my $distributedto;
848 my ($subscriptionid) = @_;
850 return unless ($subscriptionid);
852 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
853 my $sth = $dbh->prepare($query);
854 $sth->execute($subscriptionid);
855 return ($distributedto) = $sth->fetchrow;
858 =head2 GetNextSeq
860 my (
861 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
862 $newinnerloop1, $newinnerloop2, $newinnerloop3
863 ) = GetNextSeq( $subscription, $pattern, $planneddate );
865 $subscription is a hashref containing all the attributes of the table
866 'subscription'.
867 $pattern is a hashref containing all the attributes of the table
868 'subscription_numberpatterns'.
869 $planneddate is a date string in iso format.
870 This function get the next issue for the subscription given on input arg
872 =cut
874 sub GetNextSeq {
875 my ($subscription, $pattern, $planneddate) = @_;
877 return unless ($subscription and $pattern);
879 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
880 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
881 my $count = 1;
883 if ($subscription->{'skip_serialseq'}) {
884 my @irreg = split /;/, $subscription->{'irregularity'};
885 if(@irreg > 0) {
886 my $irregularities = {};
887 $irregularities->{$_} = 1 foreach(@irreg);
888 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
889 while($irregularities->{$issueno}) {
890 $count++;
891 $issueno++;
896 my $numberingmethod = $pattern->{numberingmethod};
897 my $calculated = "";
898 if ($numberingmethod) {
899 $calculated = $numberingmethod;
900 my $locale = $subscription->{locale};
901 $newlastvalue1 = $subscription->{lastvalue1} || 0;
902 $newlastvalue2 = $subscription->{lastvalue2} || 0;
903 $newlastvalue3 = $subscription->{lastvalue3} || 0;
904 $newinnerloop1 = $subscription->{innerloop1} || 0;
905 $newinnerloop2 = $subscription->{innerloop2} || 0;
906 $newinnerloop3 = $subscription->{innerloop3} || 0;
907 my %calc;
908 foreach(qw/X Y Z/) {
909 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
912 for(my $i = 0; $i < $count; $i++) {
913 if($calc{'X'}) {
914 # check if we have to increase the new value.
915 $newinnerloop1 += 1;
916 if ($newinnerloop1 >= $pattern->{every1}) {
917 $newinnerloop1 = 0;
918 $newlastvalue1 += $pattern->{add1};
920 # reset counter if needed.
921 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
923 if($calc{'Y'}) {
924 # check if we have to increase the new value.
925 $newinnerloop2 += 1;
926 if ($newinnerloop2 >= $pattern->{every2}) {
927 $newinnerloop2 = 0;
928 $newlastvalue2 += $pattern->{add2};
930 # reset counter if needed.
931 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
933 if($calc{'Z'}) {
934 # check if we have to increase the new value.
935 $newinnerloop3 += 1;
936 if ($newinnerloop3 >= $pattern->{every3}) {
937 $newinnerloop3 = 0;
938 $newlastvalue3 += $pattern->{add3};
940 # reset counter if needed.
941 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
944 if($calc{'X'}) {
945 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
946 $calculated =~ s/\{X\}/$newlastvalue1string/g;
948 if($calc{'Y'}) {
949 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
950 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
952 if($calc{'Z'}) {
953 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
954 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
958 return ($calculated,
959 $newlastvalue1, $newlastvalue2, $newlastvalue3,
960 $newinnerloop1, $newinnerloop2, $newinnerloop3);
963 =head2 GetSeq
965 $calculated = GetSeq($subscription, $pattern)
966 $subscription is a hashref containing all the attributes of the table 'subscription'
967 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
968 this function transforms {X},{Y},{Z} to 150,0,0 for example.
969 return:
970 the sequence in string format
972 =cut
974 sub GetSeq {
975 my ($subscription, $pattern) = @_;
977 return unless ($subscription and $pattern);
979 my $locale = $subscription->{locale};
981 my $calculated = $pattern->{numberingmethod};
983 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
984 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
985 $calculated =~ s/\{X\}/$newlastvalue1/g;
987 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
988 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
989 $calculated =~ s/\{Y\}/$newlastvalue2/g;
991 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
992 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
993 $calculated =~ s/\{Z\}/$newlastvalue3/g;
994 return $calculated;
997 =head2 GetExpirationDate
999 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1001 this function return the next expiration date for a subscription given on input args.
1003 return
1004 the enddate or undef
1006 =cut
1008 sub GetExpirationDate {
1009 my ( $subscriptionid, $startdate ) = @_;
1011 return unless ($subscriptionid);
1013 my $dbh = C4::Context->dbh;
1014 my $subscription = GetSubscription($subscriptionid);
1015 my $enddate;
1017 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1018 $enddate = $startdate || $subscription->{startdate};
1019 my @date = split( /-/, $enddate );
1021 return if ( scalar(@date) != 3 || not check_date(@date) );
1023 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1024 if ( $frequency and $frequency->{unit} ) {
1026 # If Not Irregular
1027 if ( my $length = $subscription->{numberlength} ) {
1029 #calculate the date of the last issue.
1030 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1031 $enddate = GetNextDate( $subscription, $enddate );
1033 } elsif ( $subscription->{monthlength} ) {
1034 if ( $$subscription{startdate} ) {
1035 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1036 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1038 } elsif ( $subscription->{weeklength} ) {
1039 if ( $$subscription{startdate} ) {
1040 my @date = split( /-/, $subscription->{startdate} );
1041 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1042 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1044 } else {
1045 $enddate = $subscription->{enddate};
1047 return $enddate;
1048 } else {
1049 return $subscription->{enddate};
1053 =head2 CountSubscriptionFromBiblionumber
1055 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1056 this returns a count of the subscriptions for a given biblionumber
1057 return :
1058 the number of subscriptions
1060 =cut
1062 sub CountSubscriptionFromBiblionumber {
1063 my ($biblionumber) = @_;
1065 return unless ($biblionumber);
1067 my $dbh = C4::Context->dbh;
1068 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1069 my $sth = $dbh->prepare($query);
1070 $sth->execute($biblionumber);
1071 my $subscriptionsnumber = $sth->fetchrow;
1072 return $subscriptionsnumber;
1075 =head2 ModSubscriptionHistory
1077 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1079 this function modifies the history of a subscription. Put your new values on input arg.
1080 returns the number of rows affected
1082 =cut
1084 sub ModSubscriptionHistory {
1085 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1087 return unless ($subscriptionid);
1089 my $dbh = C4::Context->dbh;
1090 my $query = "UPDATE subscriptionhistory
1091 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1092 WHERE subscriptionid=?
1094 my $sth = $dbh->prepare($query);
1095 $receivedlist =~ s/^; // if $receivedlist;
1096 $missinglist =~ s/^; // if $missinglist;
1097 $opacnote =~ s/^; // if $opacnote;
1098 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1099 return $sth->rows;
1102 =head2 ModSerialStatus
1104 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1105 $publisheddatetext, $status, $notes);
1107 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1108 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1110 =cut
1112 sub ModSerialStatus {
1113 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1114 $status, $notes) = @_;
1116 return unless ($serialid);
1118 #It is a usual serial
1119 # 1st, get previous status :
1120 my $dbh = C4::Context->dbh;
1121 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1122 FROM serial, subscription
1123 WHERE serial.subscriptionid=subscription.subscriptionid
1124 AND serialid=?";
1125 my $sth = $dbh->prepare($query);
1126 $sth->execute($serialid);
1127 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1128 my $frequency = GetSubscriptionFrequency($periodicity);
1130 # change status & update subscriptionhistory
1131 my $val;
1132 if ( $status == DELETED ) {
1133 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1134 } else {
1136 my $query = '
1137 UPDATE serial
1138 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1139 planneddate = ?, status = ?, notes = ?
1140 WHERE serialid = ?
1142 $sth = $dbh->prepare($query);
1143 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1144 $planneddate, $status, $notes, $serialid );
1145 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1146 $sth = $dbh->prepare($query);
1147 $sth->execute($subscriptionid);
1148 my $val = $sth->fetchrow_hashref;
1149 unless ( $val->{manualhistory} ) {
1150 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1151 $sth = $dbh->prepare($query);
1152 $sth->execute($subscriptionid);
1153 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1155 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1156 $recievedlist .= "; $serialseq"
1157 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1160 # in case serial has been previously marked as missing
1161 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1162 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1165 $missinglist .= "; $serialseq"
1166 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1167 $missinglist .= "; not issued $serialseq"
1168 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1170 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1171 $sth = $dbh->prepare($query);
1172 $recievedlist =~ s/^; //;
1173 $missinglist =~ s/^; //;
1174 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1178 # create new waited entry if needed (ie : was a "waited" and has changed)
1179 if ( $oldstatus == EXPECTED && $status != EXPECTED ) {
1180 my $subscription = GetSubscription($subscriptionid);
1181 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1183 # next issue number
1184 my (
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} );
1207 return;
1210 =head2 GetNextExpected
1212 $nextexpected = GetNextExpected($subscriptionid)
1214 Get the planneddate for the current expected issue of the subscription.
1216 returns a hashref:
1218 $nextexepected = {
1219 serialid => int
1220 planneddate => ISO date
1223 =cut
1225 sub GetNextExpected {
1226 my ($subscriptionid) = @_;
1228 my $dbh = C4::Context->dbh;
1229 my $query = qq{
1230 SELECT *
1231 FROM serial
1232 WHERE subscriptionid = ?
1233 AND status = ?
1234 LIMIT 1
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 ) {
1242 $query = qq{
1243 SELECT *
1244 FROM serial
1245 WHERE subscriptionid = ?
1246 ORDER BY publisheddate DESC
1247 LIMIT 1
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')
1259 ? $nextissue->{$_}
1260 : undef;
1263 return $nextissue;
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.
1275 returns 0
1277 =cut
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 );
1288 return 0;
1292 =head2 GetSubscriptionIrregularities
1294 =over 4
1296 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1297 get the list of irregularities for a subscription
1299 =back
1301 =cut
1303 sub GetSubscriptionIrregularities {
1304 my $subscriptionid = shift;
1306 return unless $subscriptionid;
1308 my $dbh = C4::Context->dbh;
1309 my $query = qq{
1310 SELECT irregularity
1311 FROM subscription
1312 WHERE subscriptionid = ?
1314 my $sth = $dbh->prepare($query);
1315 $sth->execute($subscriptionid);
1317 my ($result) = $sth->fetchrow_array;
1318 my @irreg = split /;/, $result;
1320 return @irreg;
1323 =head2 ModSubscription
1325 this function modifies a subscription. Put all new values on input args.
1326 returns the number of rows affected
1328 =cut
1330 sub ModSubscription {
1331 my (
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
1339 ) = @_;
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=?,
1351 skip_serialseq=?
1352 WHERE subscriptionid = ?";
1354 my $sth = $dbh->prepare($query);
1355 $sth->execute(
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,
1365 $subscriptionid
1367 my $rows = $sth->rows;
1369 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1370 return $rows;
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.
1384 return :
1385 the id of this new subscription
1387 =cut
1389 sub NewSubscription {
1390 my (
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
1398 ) = @_;
1399 my $dbh = C4::Context->dbh;
1401 #save subscription (insert into database)
1402 my $query = qq|
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);
1414 $sth->execute(
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'};
1425 unless ($enddate) {
1426 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1427 $query = qq|
1428 UPDATE subscription
1429 SET enddate=?
1430 WHERE subscriptionid=?
1432 $sth = $dbh->prepare($query);
1433 $sth->execute( $enddate, $subscriptionid );
1436 # then create the 1st expected number
1437 $query = qq(
1438 INSERT INTO subscriptionhistory
1439 (biblionumber, subscriptionid, histstartdate)
1440 VALUES (?,?,?)
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{};
1452 Koha::Serial->new(
1454 serialseq => $serialseq,
1455 serialseq_x => $subscription->{'lastvalue1'},
1456 serialseq_y => $subscription->{'lastvalue2'},
1457 serialseq_z => $subscription->{'lastvalue3'},
1458 subscriptionid => $subscriptionid,
1459 biblionumber => $biblionumber,
1460 status => EXPECTED,
1461 planneddate => $firstacquidate,
1462 publisheddate => $firstacquidate,
1464 )->store();
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'} );
1473 if ($tag) {
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.
1487 =cut
1489 sub ReNewSubscription {
1490 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1491 my $dbh = C4::Context->dbh;
1492 my $subscription = GetSubscription($subscriptionid);
1493 my $query = qq|
1494 SELECT *
1495 FROM biblio
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
1517 $query = qq|
1518 UPDATE 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";
1526 $query = qq|
1527 UPDATE subscription
1528 SET enddate=?
1529 WHERE subscriptionid=?
1531 $sth = $dbh->prepare($query);
1532 $sth->execute( $enddate, $subscriptionid );
1533 $query = qq|
1534 UPDATE subscriptionhistory
1535 SET histenddate=?
1536 WHERE subscriptionid=?
1538 $sth = $dbh->prepare($query);
1539 $sth->execute( $enddate, $subscriptionid );
1541 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1542 return;
1545 =head2 NewIssue
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
1553 =cut
1555 sub NewIssue {
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,
1574 status => $status,
1575 planneddate => $planneddate,
1576 publisheddate => $publisheddate,
1577 publisheddatetext => $publisheddatetext,
1578 notes => $notes,
1580 )->store();
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->update();
1605 return $serialid;
1608 =head2 HasSubscriptionStrictlyExpired
1610 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1612 the subscription has stricly expired when today > the end subscription date
1614 return :
1615 1 if true, 0 if false, -1 if the expiration date is not set.
1617 =cut
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 ) {
1639 return 1;
1640 } else {
1641 return 0;
1643 } else {
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,
1647 # we return -1;
1648 return -1;
1652 =head2 HasSubscriptionExpired
1654 $has_expired = HasSubscriptionExpired($subscriptionid)
1656 the subscription has expired when the next issue to arrive is out of subscription limit.
1658 return :
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
1663 =cut
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{};
1678 my $query = qq|
1679 SELECT max(planneddate)
1680 FROM serial
1681 WHERE subscriptionid=?
1683 my $sth = $dbh->prepare($query);
1684 $sth->execute($subscriptionid);
1685 my ($res) = $sth->fetchrow;
1686 if (!$res || $res=~m/^0000/) {
1687 return 0;
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) );
1692 return 1
1693 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1694 || ( !$res ) );
1695 return 0;
1696 } else {
1697 # Irregular
1698 if ( $subscription->{'numberlength'} ) {
1699 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1700 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1701 return 0;
1702 } else {
1703 return 0;
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.
1714 =cut
1716 sub SetDistributedto {
1717 my ( $distributedto, $subscriptionid ) = @_;
1718 my $dbh = C4::Context->dbh;
1719 my $query = qq|
1720 UPDATE subscription
1721 SET distributedto=?
1722 WHERE subscriptionid=?
1724 my $sth = $dbh->prepare($query);
1725 $sth->execute( $distributedto, $subscriptionid );
1726 return;
1729 =head2 DelSubscription
1731 DelSubscription($subscriptionid)
1732 this function deletes subscription which has $subscriptionid as id.
1734 =cut
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");
1751 =head2 DelIssue
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
1758 =cut
1760 sub DelIssue {
1761 my ($dataissue) = @_;
1762 my $dbh = C4::Context->dbh;
1763 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1765 my $query = qq|
1766 DELETE FROM serial
1767 WHERE serialid= ?
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} ) {
1779 my $query = qq|
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
1803 return :
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
1807 =cut
1809 sub GetLateOrMissingIssues {
1810 my ( $supplierid, $serialid, $order ) = @_;
1812 return unless ( $supplierid or $serialid );
1814 my $dbh = C4::Context->dbh;
1816 my $sth;
1817 my $byserial = '';
1818 if ($serialid) {
1819 $byserial = "and serialid = " . $serialid;
1821 if ($order) {
1822 $order .= ", title";
1823 } else {
1824 $order = "title";
1826 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1827 if ($supplierid) {
1828 $sth = $dbh->prepare(
1829 "SELECT
1830 serialid, aqbooksellerid, name,
1831 biblio.title, biblioitems.issn, planneddate, serialseq,
1832 serial.status, serial.subscriptionid, claimdate, claims_count,
1833 subscription.branchcode
1834 FROM serial
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
1842 $byserial
1843 ORDER BY $order"
1845 } else {
1846 $sth = $dbh->prepare(
1847 "SELECT
1848 serialid, aqbooksellerid, name,
1849 biblio.title, planneddate, serialseq,
1850 serial.status, serial.subscriptionid, claimdate, claims_count,
1851 subscription.branchcode
1852 FROM serial
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 = ?))
1858 $byserial
1859 ORDER BY $order"
1862 $sth->execute( EXPECTED, LATE, CLAIMED );
1863 my @issuelist;
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;
1884 return @issuelist;
1887 =head2 updateClaim
1889 &updateClaim($serialid)
1891 this function updates the time when a claim is issued for late/missing items
1893 called from claims.pl file
1895 =cut
1897 sub updateClaim {
1898 my ($serialid) = @_;
1899 my $dbh = C4::Context->dbh;
1900 $dbh->do(q|
1901 UPDATE serial
1902 SET claimdate = NOW(),
1903 claims_count = claims_count + 1
1904 WHERE serialid = ?
1905 |, {}, $serialid );
1906 return;
1909 =head2 getsupplierbyserialid
1911 $result = getsupplierbyserialid($serialid)
1913 this function is used to find the supplier id given a serial id
1915 return :
1916 hashref containing serialid, subscriptionid, and aqbooksellerid
1918 =cut
1920 sub getsupplierbyserialid {
1921 my ($serialid) = @_;
1922 my $dbh = C4::Context->dbh;
1923 my $sth = $dbh->prepare(
1924 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1925 FROM serial
1926 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1927 WHERE serialid = ?
1930 $sth->execute($serialid);
1931 my $line = $sth->fetchrow_hashref;
1932 my $result = $line->{'aqbooksellerid'};
1933 return $result;
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
1943 =cut
1945 sub check_routing {
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'};
1960 return $result;
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
1971 =cut
1973 sub addroutingmember {
1974 my ( $borrowernumber, $subscriptionid ) = @_;
1976 return unless ($borrowernumber and $subscriptionid);
1978 my $rank;
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;
1985 } else {
1986 $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
2005 =cut
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);
2012 my @result;
2013 while ( my $line = $sth->fetchrow_hashref ) {
2014 push( @result, $line->{'routingid'} );
2017 # To find the matching index
2018 my $i;
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
2023 last;
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] . "'" );
2035 $sth->execute;
2037 return;
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
2047 =cut
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;
2054 if ($routingid) {
2055 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2056 $sth->execute($routingid);
2057 reorder_members( $subscriptionid, $routingid );
2058 } else {
2059 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2060 $sth->execute($subscriptionid);
2062 return;
2065 =head2 getroutinglist
2067 @routinglist = getroutinglist($subscriptionid)
2069 this gets the info from the subscriptionroutinglist for $subscriptionid
2071 return :
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
2075 =cut
2077 sub getroutinglist {
2078 my ($subscriptionid) = @_;
2079 my $dbh = C4::Context->dbh;
2080 my $sth = $dbh->prepare(
2081 'SELECT routingid, borrowernumber, ranking, biblionumber
2082 FROM subscription
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
2098 =cut
2100 sub countissuesfrom {
2101 my ( $subscriptionid, $startdate ) = @_;
2102 my $dbh = C4::Context->dbh;
2103 my $query = qq|
2104 SELECT count(*)
2105 FROM serial
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;
2115 =head2 CountIssues
2117 $result = CountIssues($subscriptionid)
2119 Returns a count of serial rows matching the given subsctiptionid
2121 =cut
2123 sub CountIssues {
2124 my ($subscriptionid) = @_;
2125 my $dbh = C4::Context->dbh;
2126 my $query = qq|
2127 SELECT count(*)
2128 FROM serial
2129 WHERE subscriptionid=?
2131 my $sth = $dbh->prepare($query);
2132 $sth->execute($subscriptionid);
2133 my ($countreceived) = $sth->fetchrow;
2134 return $countreceived;
2137 =head2 HasItems
2139 $result = HasItems($subscriptionid)
2141 returns a count of items from serial matching the subscriptionid
2143 =cut
2145 sub HasItems {
2146 my ($subscriptionid) = @_;
2147 my $dbh = C4::Context->dbh;
2148 my $query = q|
2149 SELECT COUNT(serialitems.itemnumber)
2150 FROM serial
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();
2157 return $countitems;
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
2167 returns 0 - if not
2169 =cut
2171 sub abouttoexpire {
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 )
2189 ) <= 0) {
2190 return 1;
2194 } elsif ($subscription->{numberlength}>0) {
2195 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2198 return 0;
2201 sub in_array { # used in next sub down
2202 my ( $val, @elements ) = @_;
2203 foreach my $elem (@elements) {
2204 if ( $val == $elem ) {
2205 return 1;
2208 return 0;
2211 =head2 GetSubscriptionsFromBorrower
2213 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2215 this gets the info from subscriptionroutinglist for each $subscriptionid
2217 return :
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.
2222 =cut
2224 sub GetSubscriptionsFromBorrower {
2225 my ($borrowernumber) = @_;
2226 my $dbh = C4::Context->dbh;
2227 my $sth = $dbh->prepare(
2228 "SELECT subscription.subscriptionid, biblio.title
2229 FROM subscription
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);
2236 my @routinglist;
2237 my $count = 0;
2238 while ( my $line = $sth->fetchrow_hashref ) {
2239 $count++;
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.
2259 =cut
2261 sub GetFictiveIssueNumber {
2262 my ($subscription, $publisheddate) = @_;
2264 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2265 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2266 my $issueno = 0;
2268 if($unit) {
2269 my ($year, $month, $day) = split /-/, $publisheddate;
2270 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2271 my $wkno;
2272 my $delta;
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'};
2289 } else {
2290 # Assuming issuesperunit == 1
2291 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2294 return $issueno;
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;
2303 } else {
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};
2319 if($wkno > 52){
2320 $wkno = $wkno % 52;
2321 $yr++;
2323 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2324 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2325 } else {
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) = @_;
2338 my $fa_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;
2347 } else {
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);
2366 $month = $fa_month;
2367 my $days_in_month = Days_in_Month($year, $month);
2368 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2369 } else {
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);
2380 =head2 GetNextDate
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
2392 return :
2393 $resultdate - then next date in the sequence (ISO date)
2395 Return undef if subscription is irregular
2397 =cut
2399 sub GetNextDate {
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)
2414 my %irregularities;
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);
2432 $issueno++;
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);
2441 $issueno++;
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);
2450 $issueno++;
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);
2459 $issueno++;
2461 ($year, $month, $day) = _get_next_date_year($subscription,
2462 $freqdata, $year, $month, $day);
2465 if ($updatecount){
2466 my $dbh = C4::Context->dbh;
2467 my $query = qq{
2468 UPDATE subscription
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);
2480 =head2 _numeration
2482 $string = &_numeration($value,$num_type,$locale);
2484 _numeration returns the string corresponding to $value in the num_type
2485 num_type can take :
2486 -dayname
2487 -monthname
2488 -season
2489 =cut
2493 sub _numeration {
2494 my ($value, $num_type, $locale) = @_;
2495 $value ||= 0;
2496 $num_type //= '';
2497 $locale ||= 'en';
2498 my $string;
2499 if ( $num_type =~ /^dayname$/ ) {
2500 # 1970-11-01 was a Sunday
2501 $value = $value % 7;
2502 my $dt = DateTime->new(
2503 year => 1970,
2504 month => 11,
2505 day => $value + 1,
2506 locale => $locale,
2508 $string = $dt->strftime("%A");
2509 } elsif ( $num_type =~ /^monthname$/ ) {
2510 $value = $value % 12;
2511 my $dt = DateTime->new(
2512 year => 1970,
2513 month => $value + 1,
2514 locale => $locale,
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];
2521 } else {
2522 $string = $value;
2525 return $string;
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
2534 =cut
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 = ?',
2541 {}, $barcode
2545 return @{$occurrences};
2548 =head2 CloseSubscription
2549 Close a subscription given a subscriptionid
2550 =cut
2551 sub CloseSubscription {
2552 my ( $subscriptionid ) = @_;
2553 return unless $subscriptionid;
2554 my $dbh = C4::Context->dbh;
2555 my $sth = $dbh->prepare( q{
2556 UPDATE subscription
2557 SET closed = 1
2558 WHERE subscriptionid = ?
2559 } );
2560 $sth->execute( $subscriptionid );
2562 # Set status = missing when status = stopped
2563 $sth = $dbh->prepare( q{
2564 UPDATE serial
2565 SET status = ?
2566 WHERE subscriptionid = ?
2567 AND status = ?
2568 } );
2569 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2572 =head2 ReopenSubscription
2573 Reopen a subscription given a subscriptionid
2574 =cut
2575 sub ReopenSubscription {
2576 my ( $subscriptionid ) = @_;
2577 return unless $subscriptionid;
2578 my $dbh = C4::Context->dbh;
2579 my $sth = $dbh->prepare( q{
2580 UPDATE subscription
2581 SET closed = 0
2582 WHERE subscriptionid = ?
2583 } );
2584 $sth->execute( $subscriptionid );
2586 # Set status = expected when status = stopped
2587 $sth = $dbh->prepare( q{
2588 UPDATE serial
2589 SET status = ?
2590 WHERE subscriptionid = ?
2591 AND status = ?
2592 } );
2593 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2596 =head2 subscriptionCurrentlyOnOrder
2598 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2600 Return 1 if subscription is currently on order else 0.
2602 =cut
2604 sub subscriptionCurrentlyOnOrder {
2605 my ( $subscriptionid ) = @_;
2606 my $dbh = C4::Context->dbh;
2607 my $query = qq|
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.
2624 =cut
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.
2637 =cut
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.
2650 =cut
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') ) {
2664 return 1
2665 if C4::Context->IsSuperLibrarian()
2667 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2668 or (
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'} )
2677 else {
2678 return 1
2679 if C4::Context->IsSuperLibrarian()
2681 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2682 or C4::Auth::haspermission(
2683 $userid, { serials => $permission }
2687 return 0;
2691 __END__
2693 =head1 AUTHOR
2695 Koha Development Team <http://koha-community.org/>
2697 =cut