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
82 &GetDistributedTo &SetDistributedTo
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &subscriptionCurrentlyOnOrder
95 C4::Serials - Serials Module Functions
103 Functions for handling subscriptions, claims routing etc.
108 =head2 GetSuppliersWithLateIssues
110 $supplierlist = GetSuppliersWithLateIssues()
112 this function get all suppliers with late issues.
115 an array_ref of suppliers each entry is a hash_ref containing id and name
116 the array is in name order
120 sub GetSuppliersWithLateIssues {
121 my $dbh = C4::Context->dbh;
122 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
124 SELECT DISTINCT id, name
126 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
127 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 (planneddate < now() AND serial.status=1)
131 OR serial.STATUS IN ( $statuses )
133 AND subscription.closed = 0
135 return $dbh->selectall_arrayref($query, { Slice => {} });
138 =head2 GetSubscriptionHistoryFromSubscriptionId
140 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
142 This function returns the subscription history as a hashref
146 sub GetSubscriptionHistoryFromSubscriptionId {
147 my ($subscriptionid) = @_;
149 return unless $subscriptionid;
151 my $dbh = C4::Context->dbh;
154 FROM subscriptionhistory
155 WHERE subscriptionid = ?
157 my $sth = $dbh->prepare($query);
158 $sth->execute($subscriptionid);
159 my $results = $sth->fetchrow_hashref;
165 =head2 GetSerialStatusFromSerialId
167 $sth = GetSerialStatusFromSerialId();
168 this function returns a statement handle
169 After this function, don't forget to execute it by using $sth->execute($serialid)
171 $sth = $dbh->prepare($query).
175 sub GetSerialStatusFromSerialId {
176 warn "C4::Serials::GetSerialStatusFromSerialId will be deprecated as of 18.11.0\n";
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 contains
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 return unless $subscription;
296 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
298 # Add additional fields to the subscription into a new key "additional_fields"
299 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
300 tablename => 'subscription',
301 record_id => $subscriptionid,
303 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
305 return $subscription;
308 =head2 GetFullSubscription
310 $array_ref = GetFullSubscription($subscriptionid)
311 this function reads the serial table.
315 sub GetFullSubscription {
316 my ($subscriptionid) = @_;
318 return unless ($subscriptionid);
320 my $dbh = C4::Context->dbh;
322 SELECT serial.serialid,
325 serial.publisheddate,
326 serial.publisheddatetext,
328 serial.notes as notes,
329 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
330 aqbooksellers.name as aqbooksellername,
331 biblio.title as bibliotitle,
332 subscription.branchcode AS branchcode,
333 subscription.subscriptionid AS subscriptionid
335 LEFT JOIN subscription ON
336 (serial.subscriptionid=subscription.subscriptionid )
337 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
338 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
339 WHERE serial.subscriptionid = ?
341 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
342 serial.subscriptionid
344 $debug and warn "GetFullSubscription query: $query";
345 my $sth = $dbh->prepare($query);
346 $sth->execute($subscriptionid);
347 my $subscriptions = $sth->fetchall_arrayref( {} );
348 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
349 for my $subscription ( @$subscriptions ) {
350 $subscription->{cannotedit} = $cannotedit;
352 return $subscriptions;
355 =head2 PrepareSerialsData
357 $array_ref = PrepareSerialsData($serialinfomation)
358 where serialinformation is a hashref array
362 sub PrepareSerialsData {
365 return unless ($lines);
371 my $aqbooksellername;
375 my $previousnote = "";
377 foreach my $subs (@{$lines}) {
378 for my $datefield ( qw(publisheddate planneddate) ) {
379 # handle 0000-00-00 dates
380 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
381 $subs->{$datefield} = undef;
384 $subs->{ "status" . $subs->{'status'} } = 1;
385 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
386 $subs->{"checked"} = 1;
389 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
390 $year = $subs->{'year'};
394 if ( $tmpresults{$year} ) {
395 push @{ $tmpresults{$year}->{'serials'} }, $subs;
397 $tmpresults{$year} = {
399 'aqbooksellername' => $subs->{'aqbooksellername'},
400 'bibliotitle' => $subs->{'bibliotitle'},
401 'serials' => [$subs],
406 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
407 push @res, $tmpresults{$key};
412 =head2 GetSubscriptionsFromBiblionumber
414 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
415 this function get the subscription list. it reads the subscription table.
417 reference to an array of subscriptions which have the biblionumber given on input arg.
418 each element of this array is a hashref containing
419 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
423 sub GetSubscriptionsFromBiblionumber {
424 my ($biblionumber) = @_;
426 return unless ($biblionumber);
428 my $dbh = C4::Context->dbh;
430 SELECT subscription.*,
432 subscriptionhistory.*,
433 aqbooksellers.name AS aqbooksellername,
434 biblio.title AS bibliotitle
436 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
437 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
438 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
439 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
440 WHERE subscription.biblionumber = ?
442 my $sth = $dbh->prepare($query);
443 $sth->execute($biblionumber);
445 while ( my $subs = $sth->fetchrow_hashref ) {
446 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
447 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
448 if ( defined $subs->{histenddate} ) {
449 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
451 $subs->{histenddate} = "";
453 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
454 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
455 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
456 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
457 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
458 $subs->{ "status" . $subs->{'status'} } = 1;
460 if (not defined $subs->{enddate} ) {
461 $subs->{enddate} = '';
463 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
465 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
466 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
467 $subs->{cannotedit} = not can_edit_subscription( $subs );
473 =head2 GetFullSubscriptionsFromBiblionumber
475 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
476 this function reads the serial table.
480 sub GetFullSubscriptionsFromBiblionumber {
481 my ($biblionumber) = @_;
482 my $dbh = C4::Context->dbh;
484 SELECT serial.serialid,
487 serial.publisheddate,
488 serial.publisheddatetext,
490 serial.notes as notes,
491 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
492 biblio.title as bibliotitle,
493 subscription.branchcode AS branchcode,
494 subscription.subscriptionid AS subscriptionid
496 LEFT JOIN subscription ON
497 (serial.subscriptionid=subscription.subscriptionid)
498 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
499 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
500 WHERE subscription.biblionumber = ?
502 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
503 serial.subscriptionid
505 my $sth = $dbh->prepare($query);
506 $sth->execute($biblionumber);
507 my $subscriptions = $sth->fetchall_arrayref( {} );
508 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
509 for my $subscription ( @$subscriptions ) {
510 $subscription->{cannotedit} = $cannotedit;
512 return $subscriptions;
515 =head2 SearchSubscriptions
517 @results = SearchSubscriptions($args);
519 This function returns a list of hashrefs, one for each subscription
520 that meets the conditions specified by the $args hashref.
522 The valid search fields are:
536 The expiration_date search field is special; it specifies the maximum
537 subscription expiration date.
541 sub SearchSubscriptions {
544 my $additional_fields = $args->{additional_fields} // [];
545 my $matching_record_ids_for_additional_fields = [];
546 if ( @$additional_fields ) {
547 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
548 fields => $additional_fields,
549 tablename => 'subscription',
552 return () unless @$matching_record_ids_for_additional_fields;
557 subscription.notes AS publicnotes,
558 subscriptionhistory.*,
560 biblio.notes AS biblionotes,
564 aqbooksellers.name AS vendorname,
567 LEFT JOIN subscriptionhistory USING(subscriptionid)
568 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
569 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
570 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
572 $query .= q| WHERE 1|;
575 if( $args->{biblionumber} ) {
576 push @where_strs, "biblio.biblionumber = ?";
577 push @where_args, $args->{biblionumber};
580 if( $args->{title} ){
581 my @words = split / /, $args->{title};
583 foreach my $word (@words) {
584 push @strs, "biblio.title LIKE ?";
585 push @args, "%$word%";
588 push @where_strs, '(' . join (' AND ', @strs) . ')';
589 push @where_args, @args;
593 push @where_strs, "biblioitems.issn LIKE ?";
594 push @where_args, "%$args->{issn}%";
597 push @where_strs, "biblioitems.ean LIKE ?";
598 push @where_args, "%$args->{ean}%";
600 if ( $args->{callnumber} ) {
601 push @where_strs, "subscription.callnumber LIKE ?";
602 push @where_args, "%$args->{callnumber}%";
604 if( $args->{publisher} ){
605 push @where_strs, "biblioitems.publishercode LIKE ?";
606 push @where_args, "%$args->{publisher}%";
608 if( $args->{bookseller} ){
609 push @where_strs, "aqbooksellers.name LIKE ?";
610 push @where_args, "%$args->{bookseller}%";
612 if( $args->{branch} ){
613 push @where_strs, "subscription.branchcode = ?";
614 push @where_args, "$args->{branch}";
616 if ( $args->{location} ) {
617 push @where_strs, "subscription.location = ?";
618 push @where_args, "$args->{location}";
620 if ( $args->{expiration_date} ) {
621 push @where_strs, "subscription.enddate <= ?";
622 push @where_args, "$args->{expiration_date}";
624 if( defined $args->{closed} ){
625 push @where_strs, "subscription.closed = ?";
626 push @where_args, "$args->{closed}";
630 $query .= ' AND ' . join(' AND ', @where_strs);
632 if ( @$additional_fields ) {
633 $query .= ' AND subscriptionid IN ('
634 . join( ', ', @$matching_record_ids_for_additional_fields )
638 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
640 my $dbh = C4::Context->dbh;
641 my $sth = $dbh->prepare($query);
642 $sth->execute(@where_args);
643 my $results = $sth->fetchall_arrayref( {} );
645 for my $subscription ( @$results ) {
646 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
647 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
649 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
650 record_id => $subscription->{subscriptionid},
651 tablename => 'subscription'
653 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
662 ($totalissues,@serials) = GetSerials($subscriptionid);
663 this function gets every serial not arrived for a given subscription
664 as well as the number of issues registered in the database (all types)
665 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
667 FIXME: We should return \@serials.
672 my ( $subscriptionid, $count ) = @_;
674 return unless $subscriptionid;
676 my $dbh = C4::Context->dbh;
678 # status = 2 is "arrived"
680 $count = 5 unless ($count);
682 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
683 my $query = "SELECT serialid,serialseq, status, publisheddate,
684 publisheddatetext, planneddate,notes, routingnotes
686 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
687 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
688 my $sth = $dbh->prepare($query);
689 $sth->execute($subscriptionid);
691 while ( my $line = $sth->fetchrow_hashref ) {
692 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
693 for my $datefield ( qw( planneddate publisheddate) ) {
694 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
695 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
697 $line->{$datefield} = q{};
700 push @serials, $line;
703 # OK, now add the last 5 issues arrives/missing
704 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
705 publisheddatetext, notes, routingnotes
707 WHERE subscriptionid = ?
708 AND status IN ( $statuses )
709 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
711 $sth = $dbh->prepare($query);
712 $sth->execute($subscriptionid);
713 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
715 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
716 for my $datefield ( qw( planneddate publisheddate) ) {
717 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
718 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
720 $line->{$datefield} = q{};
724 push @serials, $line;
727 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
728 $sth = $dbh->prepare($query);
729 $sth->execute($subscriptionid);
730 my ($totalissues) = $sth->fetchrow;
731 return ( $totalissues, @serials );
736 @serials = GetSerials2($subscriptionid,$statuses);
737 this function returns every serial waited for a given subscription
738 as well as the number of issues registered in the database (all types)
739 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
741 $statuses is an arrayref of statuses and is mandatory.
746 my ( $subscription, $statuses ) = @_;
748 return unless ($subscription and @$statuses);
750 my $dbh = C4::Context->dbh;
752 SELECT serialid,serialseq, status, planneddate, publisheddate,
753 publisheddatetext, notes, routingnotes
755 WHERE subscriptionid=?
757 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
759 ORDER BY publisheddate,serialid DESC
761 $debug and warn "GetSerials2 query: $query";
762 my $sth = $dbh->prepare($query);
763 $sth->execute( $subscription, @$statuses );
766 while ( my $line = $sth->fetchrow_hashref ) {
767 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
768 # Format dates for display
769 for my $datefield ( qw( planneddate publisheddate ) ) {
770 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
771 $line->{$datefield} = q{};
774 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
777 push @serials, $line;
782 =head2 GetLatestSerials
784 \@serials = GetLatestSerials($subscriptionid,$limit)
785 get the $limit's latest serials arrived or missing for a given subscription
787 a ref to an array which contains all of the latest serials stored into a hash.
791 sub GetLatestSerials {
792 my ( $subscriptionid, $limit ) = @_;
794 return unless ($subscriptionid and $limit);
796 my $dbh = C4::Context->dbh;
798 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
799 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
801 WHERE subscriptionid = ?
802 AND status IN ($statuses)
803 ORDER BY publisheddate DESC LIMIT 0,$limit
805 my $sth = $dbh->prepare($strsth);
806 $sth->execute($subscriptionid);
808 while ( my $line = $sth->fetchrow_hashref ) {
809 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
810 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
811 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
812 push @serials, $line;
818 =head2 GetPreviousSerialid
820 $serialid = GetPreviousSerialid($subscriptionid, $nth)
821 get the $nth's previous serial for the given subscriptionid
827 sub GetPreviousSerialid {
828 my ( $subscriptionid, $nth ) = @_;
830 my $dbh = C4::Context->dbh;
834 my $strsth = "SELECT serialid
836 WHERE subscriptionid = ?
838 ORDER BY serialid DESC LIMIT $nth,1
840 my $sth = $dbh->prepare($strsth);
841 $sth->execute($subscriptionid);
843 my $line = $sth->fetchrow_hashref;
844 $return = $line->{'serialid'} if ($line);
851 =head2 GetDistributedTo
853 $distributedto=GetDistributedTo($subscriptionid)
854 This function returns the field distributedto for the subscription matching subscriptionid
858 sub GetDistributedTo {
859 warn "C4::Serials::GetDistributedTo will be deprecated as of 18.11.0\n";
860 my $dbh = C4::Context->dbh;
862 my ($subscriptionid) = @_;
864 return unless ($subscriptionid);
866 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
867 my $sth = $dbh->prepare($query);
868 $sth->execute($subscriptionid);
869 return ($distributedto) = $sth->fetchrow;
875 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
876 $newinnerloop1, $newinnerloop2, $newinnerloop3
877 ) = GetNextSeq( $subscription, $pattern, $planneddate );
879 $subscription is a hashref containing all the attributes of the table
881 $pattern is a hashref containing all the attributes of the table
882 'subscription_numberpatterns'.
883 $planneddate is a date string in iso format.
884 This function get the next issue for the subscription given on input arg
889 my ($subscription, $pattern, $planneddate) = @_;
891 return unless ($subscription and $pattern);
893 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
894 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
897 if ($subscription->{'skip_serialseq'}) {
898 my @irreg = split /;/, $subscription->{'irregularity'};
900 my $irregularities = {};
901 $irregularities->{$_} = 1 foreach(@irreg);
902 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
903 while($irregularities->{$issueno}) {
910 my $numberingmethod = $pattern->{numberingmethod};
912 if ($numberingmethod) {
913 $calculated = $numberingmethod;
914 my $locale = $subscription->{locale};
915 $newlastvalue1 = $subscription->{lastvalue1} || 0;
916 $newlastvalue2 = $subscription->{lastvalue2} || 0;
917 $newlastvalue3 = $subscription->{lastvalue3} || 0;
918 $newinnerloop1 = $subscription->{innerloop1} || 0;
919 $newinnerloop2 = $subscription->{innerloop2} || 0;
920 $newinnerloop3 = $subscription->{innerloop3} || 0;
923 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
926 for(my $i = 0; $i < $count; $i++) {
928 # check if we have to increase the new value.
930 if ($newinnerloop1 >= $pattern->{every1}) {
932 $newlastvalue1 += $pattern->{add1};
934 # reset counter if needed.
935 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
938 # check if we have to increase the new value.
940 if ($newinnerloop2 >= $pattern->{every2}) {
942 $newlastvalue2 += $pattern->{add2};
944 # reset counter if needed.
945 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
948 # check if we have to increase the new value.
950 if ($newinnerloop3 >= $pattern->{every3}) {
952 $newlastvalue3 += $pattern->{add3};
954 # reset counter if needed.
955 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
959 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
960 $calculated =~ s/\{X\}/$newlastvalue1string/g;
963 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
964 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
967 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
968 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
973 $newlastvalue1, $newlastvalue2, $newlastvalue3,
974 $newinnerloop1, $newinnerloop2, $newinnerloop3);
979 $calculated = GetSeq($subscription, $pattern)
980 $subscription is a hashref containing all the attributes of the table 'subscription'
981 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
982 this function transforms {X},{Y},{Z} to 150,0,0 for example.
984 the sequence in string format
989 my ($subscription, $pattern) = @_;
991 return unless ($subscription and $pattern);
993 my $locale = $subscription->{locale};
995 my $calculated = $pattern->{numberingmethod};
997 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
998 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
999 $calculated =~ s/\{X\}/$newlastvalue1/g;
1001 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1002 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1003 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1005 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1006 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1007 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1011 =head2 GetExpirationDate
1013 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1015 this function return the next expiration date for a subscription given on input args.
1018 the enddate or undef
1022 sub GetExpirationDate {
1023 my ( $subscriptionid, $startdate ) = @_;
1025 return unless ($subscriptionid);
1027 my $dbh = C4::Context->dbh;
1028 my $subscription = GetSubscription($subscriptionid);
1031 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1032 $enddate = $startdate || $subscription->{startdate};
1033 my @date = split( /-/, $enddate );
1035 return if ( scalar(@date) != 3 || not check_date(@date) );
1037 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1038 if ( $frequency and $frequency->{unit} ) {
1041 if ( my $length = $subscription->{numberlength} ) {
1043 #calculate the date of the last issue.
1044 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1045 $enddate = GetNextDate( $subscription, $enddate );
1047 } elsif ( $subscription->{monthlength} ) {
1048 if ( $$subscription{startdate} ) {
1049 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1050 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1052 } elsif ( $subscription->{weeklength} ) {
1053 if ( $$subscription{startdate} ) {
1054 my @date = split( /-/, $subscription->{startdate} );
1055 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1056 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1059 $enddate = $subscription->{enddate};
1063 return $subscription->{enddate};
1067 =head2 CountSubscriptionFromBiblionumber
1069 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1070 this returns a count of the subscriptions for a given biblionumber
1072 the number of subscriptions
1076 sub CountSubscriptionFromBiblionumber {
1077 my ($biblionumber) = @_;
1079 return unless ($biblionumber);
1081 my $dbh = C4::Context->dbh;
1082 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1083 my $sth = $dbh->prepare($query);
1084 $sth->execute($biblionumber);
1085 my $subscriptionsnumber = $sth->fetchrow;
1086 return $subscriptionsnumber;
1089 =head2 ModSubscriptionHistory
1091 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1093 this function modifies the history of a subscription. Put your new values on input arg.
1094 returns the number of rows affected
1098 sub ModSubscriptionHistory {
1099 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1101 return unless ($subscriptionid);
1103 my $dbh = C4::Context->dbh;
1104 my $query = "UPDATE subscriptionhistory
1105 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1106 WHERE subscriptionid=?
1108 my $sth = $dbh->prepare($query);
1109 $receivedlist =~ s/^; // if $receivedlist;
1110 $missinglist =~ s/^; // if $missinglist;
1111 $opacnote =~ s/^; // if $opacnote;
1112 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1116 =head2 ModSerialStatus
1118 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1119 $publisheddatetext, $status, $notes);
1121 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1122 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1126 sub ModSerialStatus {
1127 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1128 $status, $notes) = @_;
1130 return unless ($serialid);
1132 #It is a usual serial
1133 # 1st, get previous status :
1134 my $dbh = C4::Context->dbh;
1135 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1136 FROM serial, subscription
1137 WHERE serial.subscriptionid=subscription.subscriptionid
1139 my $sth = $dbh->prepare($query);
1140 $sth->execute($serialid);
1141 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1142 my $frequency = GetSubscriptionFrequency($periodicity);
1144 # change status & update subscriptionhistory
1146 if ( $status == DELETED ) {
1147 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1152 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1153 planneddate = ?, status = ?, notes = ?
1156 $sth = $dbh->prepare($query);
1157 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1158 $planneddate, $status, $notes, $serialid );
1159 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1160 $sth = $dbh->prepare($query);
1161 $sth->execute($subscriptionid);
1162 my $val = $sth->fetchrow_hashref;
1163 unless ( $val->{manualhistory} ) {
1164 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1165 $sth = $dbh->prepare($query);
1166 $sth->execute($subscriptionid);
1167 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1169 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1170 $recievedlist .= "; $serialseq"
1171 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1174 # in case serial has been previously marked as missing
1175 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1176 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1179 $missinglist .= "; $serialseq"
1180 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1181 $missinglist .= "; not issued $serialseq"
1182 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1184 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1185 $sth = $dbh->prepare($query);
1186 $recievedlist =~ s/^; //;
1187 $missinglist =~ s/^; //;
1188 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1192 # create new expected entry if needed (ie : was "expected" and has changed)
1193 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1194 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1195 my $subscription = GetSubscription($subscriptionid);
1196 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1200 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1201 $newinnerloop1, $newinnerloop2, $newinnerloop3
1203 = GetNextSeq( $subscription, $pattern, $publisheddate );
1205 # next date (calculated from actual date & frequency parameters)
1206 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1207 my $nextpubdate = $nextpublisheddate;
1208 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1209 WHERE subscriptionid = ?";
1210 $sth = $dbh->prepare($query);
1211 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1213 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1215 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1216 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1217 require C4::Letters;
1218 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1225 =head2 GetNextExpected
1227 $nextexpected = GetNextExpected($subscriptionid)
1229 Get the planneddate for the current expected issue of the subscription.
1235 planneddate => ISO date
1240 sub GetNextExpected {
1241 my ($subscriptionid) = @_;
1243 my $dbh = C4::Context->dbh;
1247 WHERE subscriptionid = ?
1251 my $sth = $dbh->prepare($query);
1253 # Each subscription has only one 'expected' issue.
1254 $sth->execute( $subscriptionid, EXPECTED );
1255 my $nextissue = $sth->fetchrow_hashref;
1256 if ( !$nextissue ) {
1260 WHERE subscriptionid = ?
1261 ORDER BY publisheddate DESC
1264 $sth = $dbh->prepare($query);
1265 $sth->execute($subscriptionid);
1266 $nextissue = $sth->fetchrow_hashref;
1268 foreach(qw/planneddate publisheddate/) {
1269 if ( !defined $nextissue->{$_} ) {
1270 # or should this default to 1st Jan ???
1271 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1273 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1281 =head2 ModNextExpected
1283 ModNextExpected($subscriptionid,$date)
1285 Update the planneddate for the current expected issue of the subscription.
1286 This will modify all future prediction results.
1288 C<$date> is an ISO date.
1294 sub ModNextExpected {
1295 my ( $subscriptionid, $date ) = @_;
1296 my $dbh = C4::Context->dbh;
1298 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1299 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1301 # Each subscription has only one 'expected' issue.
1302 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1307 =head2 GetSubscriptionIrregularities
1311 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1312 get the list of irregularities for a subscription
1318 sub GetSubscriptionIrregularities {
1319 my $subscriptionid = shift;
1321 return unless $subscriptionid;
1323 my $dbh = C4::Context->dbh;
1327 WHERE subscriptionid = ?
1329 my $sth = $dbh->prepare($query);
1330 $sth->execute($subscriptionid);
1332 my ($result) = $sth->fetchrow_array;
1333 my @irreg = split /;/, $result;
1338 =head2 ModSubscription
1340 this function modifies a subscription. Put all new values on input args.
1341 returns the number of rows affected
1345 sub ModSubscription {
1347 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1348 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1349 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1350 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1351 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1352 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1353 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1354 $itemtype, $previousitemtype
1357 my $dbh = C4::Context->dbh;
1358 my $query = "UPDATE subscription
1359 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1360 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1361 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1362 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1363 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1364 callnumber=?, notes=?, letter=?, manualhistory=?,
1365 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1366 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1367 skip_serialseq=?, itemtype=?, previousitemtype=?
1368 WHERE subscriptionid = ?";
1370 my $sth = $dbh->prepare($query);
1372 $auser, $branchcode, $aqbooksellerid, $cost,
1373 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1374 $irregularity, $numberpattern, $locale, $numberlength,
1375 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1376 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1377 $status, $biblionumber, $callnumber, $notes,
1378 $letter, ($manualhistory ? $manualhistory : 0),
1379 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1380 $graceperiod, $location, $enddate, $skip_serialseq,
1381 $itemtype, $previousitemtype,
1384 my $rows = $sth->rows;
1386 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1390 =head2 NewSubscription
1392 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1393 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1394 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1395 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1396 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1397 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1398 $skip_serialseq, $itemtype, $previousitemtype);
1400 Create a new subscription with value given on input args.
1403 the id of this new subscription
1407 sub NewSubscription {
1409 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1410 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1411 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1412 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1413 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1414 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1415 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1417 my $dbh = C4::Context->dbh;
1419 #save subscription (insert into database)
1421 INSERT INTO subscription
1422 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1423 biblionumber, startdate, periodicity, numberlength, weeklength,
1424 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1425 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1426 irregularity, numberpattern, locale, callnumber,
1427 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1428 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1429 itemtype, previousitemtype)
1430 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1432 my $sth = $dbh->prepare($query);
1434 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1435 $startdate, $periodicity, $numberlength, $weeklength,
1436 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1437 $lastvalue3, $innerloop3, $status, $notes, $letter,
1438 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1439 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1440 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1441 $itemtype, $previousitemtype
1444 my $subscriptionid = $dbh->{'mysql_insertid'};
1446 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1450 WHERE subscriptionid=?
1452 $sth = $dbh->prepare($query);
1453 $sth->execute( $enddate, $subscriptionid );
1456 # then create the 1st expected number
1458 INSERT INTO subscriptionhistory
1459 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1460 VALUES (?,?,?, '', '')
1462 $sth = $dbh->prepare($query);
1463 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1465 # reread subscription to get a hash (for calculation of the 1st issue number)
1466 my $subscription = GetSubscription($subscriptionid);
1467 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1469 # calculate issue number
1470 my $serialseq = GetSeq($subscription, $pattern) || q{};
1474 serialseq => $serialseq,
1475 serialseq_x => $subscription->{'lastvalue1'},
1476 serialseq_y => $subscription->{'lastvalue2'},
1477 serialseq_z => $subscription->{'lastvalue3'},
1478 subscriptionid => $subscriptionid,
1479 biblionumber => $biblionumber,
1481 planneddate => $firstacquidate,
1482 publisheddate => $firstacquidate,
1486 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1488 #set serial flag on biblio if not already set.
1489 my $biblio = Koha::Biblios->find( $biblionumber );
1490 if ( $biblio and !$biblio->serial ) {
1491 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1492 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1494 eval { $record->field($tag)->update( $subf => 1 ); };
1496 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1498 return $subscriptionid;
1501 =head2 ReNewSubscription
1503 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1505 this function renew a subscription with values given on input args.
1509 sub ReNewSubscription {
1510 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1511 my $dbh = C4::Context->dbh;
1512 my $subscription = GetSubscription($subscriptionid);
1516 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1517 WHERE biblio.biblionumber=?
1519 my $sth = $dbh->prepare($query);
1520 $sth->execute( $subscription->{biblionumber} );
1521 my $biblio = $sth->fetchrow_hashref;
1523 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1524 require C4::Suggestions;
1525 C4::Suggestions::NewSuggestion(
1526 { 'suggestedby' => $user,
1527 'title' => $subscription->{bibliotitle},
1528 'author' => $biblio->{author},
1529 'publishercode' => $biblio->{publishercode},
1530 'note' => $biblio->{note},
1531 'biblionumber' => $subscription->{biblionumber}
1536 $numberlength ||= 0; # Should not we raise an exception instead?
1539 # renew subscription
1542 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1543 WHERE subscriptionid=?
1545 $sth = $dbh->prepare($query);
1546 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1547 my $enddate = GetExpirationDate($subscriptionid);
1548 $debug && warn "enddate :$enddate";
1552 WHERE subscriptionid=?
1554 $sth = $dbh->prepare($query);
1555 $sth->execute( $enddate, $subscriptionid );
1557 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1563 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1565 Create a new issue stored on the database.
1566 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1567 returns the serial id
1572 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1573 $publisheddate, $publisheddatetext, $notes ) = @_;
1574 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1576 return unless ($subscriptionid);
1578 my $schema = Koha::Database->new()->schema();
1580 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1582 my $serial = Koha::Serial->new(
1584 serialseq => $serialseq,
1585 serialseq_x => $subscription->lastvalue1(),
1586 serialseq_y => $subscription->lastvalue2(),
1587 serialseq_z => $subscription->lastvalue3(),
1588 subscriptionid => $subscriptionid,
1589 biblionumber => $biblionumber,
1591 planneddate => $planneddate,
1592 publisheddate => $publisheddate,
1593 publisheddatetext => $publisheddatetext,
1598 my $serialid = $serial->id();
1600 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1601 my $missinglist = $subscription_history->missinglist();
1602 my $recievedlist = $subscription_history->recievedlist();
1604 if ( $status == ARRIVED ) {
1605 ### TODO Add a feature that improves recognition and description.
1606 ### As such count (serialseq) i.e. : N18,2(N19),N20
1607 ### Would use substr and index But be careful to previous presence of ()
1608 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1610 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1611 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1614 $recievedlist =~ s/^; //;
1615 $missinglist =~ s/^; //;
1617 $subscription_history->recievedlist($recievedlist);
1618 $subscription_history->missinglist($missinglist);
1619 $subscription_history->store();
1624 =head2 HasSubscriptionStrictlyExpired
1626 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1628 the subscription has stricly expired when today > the end subscription date
1631 1 if true, 0 if false, -1 if the expiration date is not set.
1635 sub HasSubscriptionStrictlyExpired {
1637 # Getting end of subscription date
1638 my ($subscriptionid) = @_;
1640 return unless ($subscriptionid);
1642 my $dbh = C4::Context->dbh;
1643 my $subscription = GetSubscription($subscriptionid);
1644 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1646 # If the expiration date is set
1647 if ( $expirationdate != 0 ) {
1648 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1650 # Getting today's date
1651 my ( $nowyear, $nowmonth, $nowday ) = Today();
1653 # if today's date > expiration date, then the subscription has stricly expired
1654 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1661 # There are some cases where the expiration date is not set
1662 # As we can't determine if the subscription has expired on a date-basis,
1668 =head2 HasSubscriptionExpired
1670 $has_expired = HasSubscriptionExpired($subscriptionid)
1672 the subscription has expired when the next issue to arrive is out of subscription limit.
1675 0 if the subscription has not expired
1676 1 if the subscription has expired
1677 2 if has subscription does not have a valid expiration date set
1681 sub HasSubscriptionExpired {
1682 my ($subscriptionid) = @_;
1684 return unless ($subscriptionid);
1686 my $dbh = C4::Context->dbh;
1687 my $subscription = GetSubscription($subscriptionid);
1688 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1689 if ( $frequency and $frequency->{unit} ) {
1690 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1691 if (!defined $expirationdate) {
1692 $expirationdate = q{};
1695 SELECT max(planneddate)
1697 WHERE subscriptionid=?
1699 my $sth = $dbh->prepare($query);
1700 $sth->execute($subscriptionid);
1701 my ($res) = $sth->fetchrow;
1702 if (!$res || $res=~m/^0000/) {
1705 my @res = split( /-/, $res );
1706 my @endofsubscriptiondate = split( /-/, $expirationdate );
1707 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1709 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1714 if ( $subscription->{'numberlength'} ) {
1715 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1716 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1722 return 0; # Notice that you'll never get here.
1725 =head2 SetDistributedto
1727 SetDistributedto($distributedto,$subscriptionid);
1728 This function update the value of distributedto for a subscription given on input arg.
1732 sub SetDistributedto {
1733 warn "C4::Serials::SetDistributedto will be deprecated as of 18.11.0\n";
1734 my ( $distributedto, $subscriptionid ) = @_;
1735 my $dbh = C4::Context->dbh;
1739 WHERE subscriptionid=?
1741 my $sth = $dbh->prepare($query);
1742 $sth->execute( $distributedto, $subscriptionid );
1746 =head2 DelSubscription
1748 DelSubscription($subscriptionid)
1749 this function deletes subscription which has $subscriptionid as id.
1753 sub DelSubscription {
1754 my ($subscriptionid) = @_;
1755 my $dbh = C4::Context->dbh;
1756 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1757 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1758 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1760 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1761 foreach my $af (@$afs) {
1762 $af->delete_values({record_id => $subscriptionid});
1765 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1770 DelIssue($serialseq,$subscriptionid)
1771 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1773 returns the number of rows affected
1778 my ($dataissue) = @_;
1779 my $dbh = C4::Context->dbh;
1780 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1785 AND subscriptionid= ?
1787 my $mainsth = $dbh->prepare($query);
1788 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1790 #Delete element from subscription history
1791 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1792 my $sth = $dbh->prepare($query);
1793 $sth->execute( $dataissue->{'subscriptionid'} );
1794 my $val = $sth->fetchrow_hashref;
1795 unless ( $val->{manualhistory} ) {
1797 SELECT * FROM subscriptionhistory
1798 WHERE subscriptionid= ?
1800 my $sth = $dbh->prepare($query);
1801 $sth->execute( $dataissue->{'subscriptionid'} );
1802 my $data = $sth->fetchrow_hashref;
1803 my $serialseq = $dataissue->{'serialseq'};
1804 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1805 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1806 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1807 $sth = $dbh->prepare($strsth);
1808 $sth->execute( $dataissue->{'subscriptionid'} );
1811 return $mainsth->rows;
1814 =head2 GetLateOrMissingIssues
1816 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1818 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1821 the issuelist as an array of hash refs. Each element of this array contains
1822 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1826 sub GetLateOrMissingIssues {
1827 my ( $supplierid, $serialid, $order ) = @_;
1829 return unless ( $supplierid or $serialid );
1831 my $dbh = C4::Context->dbh;
1836 $byserial = "and serialid = " . $serialid;
1839 $order .= ", title";
1843 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1845 $sth = $dbh->prepare(
1847 serialid, aqbooksellerid, name,
1848 biblio.title, biblioitems.issn, planneddate, serialseq,
1849 serial.status, serial.subscriptionid, claimdate, claims_count,
1850 subscription.branchcode
1852 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1853 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1854 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.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 AND subscription.aqbooksellerid=$supplierid
1863 $sth = $dbh->prepare(
1865 serialid, aqbooksellerid, name,
1866 biblio.title, planneddate, serialseq,
1867 serial.status, serial.subscriptionid, claimdate, claims_count,
1868 subscription.branchcode
1870 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1871 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1872 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1873 WHERE subscription.subscriptionid = serial.subscriptionid
1874 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1879 $sth->execute( EXPECTED, LATE, CLAIMED );
1881 while ( my $line = $sth->fetchrow_hashref ) {
1883 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1884 $line->{planneddateISO} = $line->{planneddate};
1885 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1887 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1888 $line->{claimdateISO} = $line->{claimdate};
1889 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1891 $line->{"status".$line->{status}} = 1;
1893 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1894 record_id => $line->{subscriptionid},
1895 tablename => 'subscription'
1897 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1899 push @issuelist, $line;
1906 &updateClaim($serialid)
1908 this function updates the time when a claim is issued for late/missing items
1910 called from claims.pl file
1915 my ($serialids) = @_;
1916 return unless $serialids;
1917 unless ( ref $serialids ) {
1918 $serialids = [ $serialids ];
1920 my $dbh = C4::Context->dbh;
1923 SET claimdate = NOW(),
1924 claims_count = claims_count + 1,
1926 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1927 {}, CLAIMED, @$serialids );
1930 =head2 check_routing
1932 $result = &check_routing($subscriptionid)
1934 this function checks to see if a serial has a routing list and returns the count of routingid
1935 used to show either an 'add' or 'edit' link
1940 my ($subscriptionid) = @_;
1942 return unless ($subscriptionid);
1944 my $dbh = C4::Context->dbh;
1945 my $sth = $dbh->prepare(
1946 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1947 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1948 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1951 $sth->execute($subscriptionid);
1952 my $line = $sth->fetchrow_hashref;
1953 my $result = $line->{'routingids'};
1957 =head2 addroutingmember
1959 addroutingmember($borrowernumber,$subscriptionid)
1961 this function takes a borrowernumber and subscriptionid and adds the member to the
1962 routing list for that serial subscription and gives them a rank on the list
1963 of either 1 or highest current rank + 1
1967 sub addroutingmember {
1968 my ( $borrowernumber, $subscriptionid ) = @_;
1970 return unless ($borrowernumber and $subscriptionid);
1973 my $dbh = C4::Context->dbh;
1974 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1975 $sth->execute($subscriptionid);
1976 while ( my $line = $sth->fetchrow_hashref ) {
1977 if ( $line->{'rank'} > 0 ) {
1978 $rank = $line->{'rank'} + 1;
1983 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1984 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1987 =head2 reorder_members
1989 reorder_members($subscriptionid,$routingid,$rank)
1991 this function is used to reorder the routing list
1993 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1994 - it gets all members on list puts their routingid's into an array
1995 - removes the one in the array that is $routingid
1996 - then reinjects $routingid at point indicated by $rank
1997 - then update the database with the routingids in the new order
2001 sub reorder_members {
2002 my ( $subscriptionid, $routingid, $rank ) = @_;
2003 my $dbh = C4::Context->dbh;
2004 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2005 $sth->execute($subscriptionid);
2007 while ( my $line = $sth->fetchrow_hashref ) {
2008 push( @result, $line->{'routingid'} );
2011 # To find the matching index
2013 my $key = -1; # to allow for 0 being a valid response
2014 for ( $i = 0 ; $i < @result ; $i++ ) {
2015 if ( $routingid == $result[$i] ) {
2016 $key = $i; # save the index
2021 # if index exists in array then move it to new position
2022 if ( $key > -1 && $rank > 0 ) {
2023 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2024 my $moving_item = splice( @result, $key, 1 );
2025 splice( @result, $new_rank, 0, $moving_item );
2027 for ( my $j = 0 ; $j < @result ; $j++ ) {
2028 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2034 =head2 delroutingmember
2036 delroutingmember($routingid,$subscriptionid)
2038 this function either deletes one member from routing list if $routingid exists otherwise
2039 deletes all members from the routing list
2043 sub delroutingmember {
2045 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2046 my ( $routingid, $subscriptionid ) = @_;
2047 my $dbh = C4::Context->dbh;
2049 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2050 $sth->execute($routingid);
2051 reorder_members( $subscriptionid, $routingid );
2053 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2054 $sth->execute($subscriptionid);
2059 =head2 getroutinglist
2061 @routinglist = getroutinglist($subscriptionid)
2063 this gets the info from the subscriptionroutinglist for $subscriptionid
2066 the routinglist as an array. Each element of the array contains a hash_ref containing
2067 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2071 sub getroutinglist {
2072 my ($subscriptionid) = @_;
2073 my $dbh = C4::Context->dbh;
2074 my $sth = $dbh->prepare(
2075 'SELECT routingid, borrowernumber, ranking, biblionumber
2077 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2078 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2080 $sth->execute($subscriptionid);
2081 my $routinglist = $sth->fetchall_arrayref({});
2082 return @{$routinglist};
2085 =head2 countissuesfrom
2087 $result = countissuesfrom($subscriptionid,$startdate)
2089 Returns a count of serial rows matching the given subsctiptionid
2090 with published date greater than startdate
2094 sub countissuesfrom {
2095 my ( $subscriptionid, $startdate ) = @_;
2096 my $dbh = C4::Context->dbh;
2100 WHERE subscriptionid=?
2101 AND serial.publisheddate>?
2103 my $sth = $dbh->prepare($query);
2104 $sth->execute( $subscriptionid, $startdate );
2105 my ($countreceived) = $sth->fetchrow;
2106 return $countreceived;
2111 $result = CountIssues($subscriptionid)
2113 Returns a count of serial rows matching the given subsctiptionid
2118 my ($subscriptionid) = @_;
2119 my $dbh = C4::Context->dbh;
2123 WHERE subscriptionid=?
2125 my $sth = $dbh->prepare($query);
2126 $sth->execute($subscriptionid);
2127 my ($countreceived) = $sth->fetchrow;
2128 return $countreceived;
2133 $result = HasItems($subscriptionid)
2135 returns a count of items from serial matching the subscriptionid
2140 my ($subscriptionid) = @_;
2141 my $dbh = C4::Context->dbh;
2143 SELECT COUNT(serialitems.itemnumber)
2145 LEFT JOIN serialitems USING(serialid)
2146 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2148 my $sth=$dbh->prepare($query);
2149 $sth->execute($subscriptionid);
2150 my ($countitems)=$sth->fetchrow_array();
2154 =head2 abouttoexpire
2156 $result = abouttoexpire($subscriptionid)
2158 this function alerts you to the penultimate issue for a serial subscription
2160 returns 1 - if this is the penultimate issue
2166 my ($subscriptionid) = @_;
2167 my $dbh = C4::Context->dbh;
2168 my $subscription = GetSubscription($subscriptionid);
2169 my $per = $subscription->{'periodicity'};
2170 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2171 if ($frequency and $frequency->{unit}){
2173 my $expirationdate = GetExpirationDate($subscriptionid);
2175 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2176 my $nextdate = GetNextDate($subscription, $res);
2178 # only compare dates if both dates exist.
2179 if ($nextdate and $expirationdate) {
2180 if(Date::Calc::Delta_Days(
2181 split( /-/, $nextdate ),
2182 split( /-/, $expirationdate )
2188 } elsif ($subscription->{numberlength}>0) {
2189 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2195 sub in_array { # used in next sub down
2196 my ( $val, @elements ) = @_;
2197 foreach my $elem (@elements) {
2198 if ( $val == $elem ) {
2205 =head2 GetFictiveIssueNumber
2207 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2209 Get the position of the issue published at $publisheddate, considering the
2210 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2211 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2212 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2213 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2214 depending on how many rows are in serial table.
2215 The issue number calculation is based on subscription frequency, first acquisition
2216 date, and $publisheddate.
2218 Returns undef when called for irregular frequencies.
2220 The routine is used to skip irregularities when calculating the next issue
2221 date (in GetNextDate) or the next issue number (in GetNextSeq).
2225 sub GetFictiveIssueNumber {
2226 my ($subscription, $publisheddate) = @_;
2228 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2229 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2233 my ( $year, $month, $day ) = split /-/, $publisheddate;
2234 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2235 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2237 if( $frequency->{'unitsperissue'} == 1 ) {
2238 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2239 } else { # issuesperunit == 1
2240 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2246 my ( $date1, $date2, $unit ) = @_;
2247 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2249 if( $unit eq 'day' ) {
2250 return Delta_Days( @$date1, @$date2 );
2251 } elsif( $unit eq 'week' ) {
2252 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2255 # In case of months or years, this is a wrapper around N_Delta_YMD.
2256 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2257 # while we expect 1 month.
2258 my @delta = N_Delta_YMD( @$date1, @$date2 );
2259 if( $delta[2] > 27 ) {
2260 # Check if we could add a month
2261 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2262 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2266 if( $delta[1] >= 12 ) {
2270 # if unit is year, we only return full years
2271 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2274 sub _get_next_date_day {
2275 my ($subscription, $freqdata, $year, $month, $day) = @_;
2277 my @newissue; # ( yy, mm, dd )
2278 # We do not need $delta_days here, since it would be zero where used
2280 if( $freqdata->{issuesperunit} == 1 ) {
2282 @newissue = Add_Delta_Days(
2283 $year, $month, $day, $freqdata->{"unitsperissue"} );
2284 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2286 @newissue = ( $year, $month, $day );
2287 $subscription->{countissuesperunit}++;
2289 # We finished a cycle of issues within a unit.
2290 # No subtraction of zero needed, just add one day
2291 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2292 $subscription->{countissuesperunit} = 1;
2297 sub _get_next_date_week {
2298 my ($subscription, $freqdata, $year, $month, $day) = @_;
2300 my @newissue; # ( yy, mm, dd )
2301 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2303 if( $freqdata->{issuesperunit} == 1 ) {
2304 # Add full weeks (of 7 days)
2305 @newissue = Add_Delta_Days(
2306 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2307 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2308 # Add rounded number of days based on frequency.
2309 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2310 $subscription->{countissuesperunit}++;
2312 # We finished a cycle of issues within a unit.
2313 # Subtract delta * (issues - 1), add 1 week
2314 @newissue = Add_Delta_Days( $year, $month, $day,
2315 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2316 @newissue = Add_Delta_Days( @newissue, 7 );
2317 $subscription->{countissuesperunit} = 1;
2322 sub _get_next_date_month {
2323 my ($subscription, $freqdata, $year, $month, $day) = @_;
2325 my @newissue; # ( yy, mm, dd )
2326 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2328 if( $freqdata->{issuesperunit} == 1 ) {
2330 @newissue = Add_Delta_YM(
2331 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2332 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2333 # Add rounded number of days based on frequency.
2334 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2335 $subscription->{countissuesperunit}++;
2337 # We finished a cycle of issues within a unit.
2338 # Subtract delta * (issues - 1), add 1 month
2339 @newissue = Add_Delta_Days( $year, $month, $day,
2340 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2341 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2342 $subscription->{countissuesperunit} = 1;
2347 sub _get_next_date_year {
2348 my ($subscription, $freqdata, $year, $month, $day) = @_;
2350 my @newissue; # ( yy, mm, dd )
2351 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2353 if( $freqdata->{issuesperunit} == 1 ) {
2355 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2356 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2357 # Add rounded number of days based on frequency.
2358 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2359 $subscription->{countissuesperunit}++;
2361 # We finished a cycle of issues within a unit.
2362 # Subtract delta * (issues - 1), add 1 year
2363 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2364 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2365 $subscription->{countissuesperunit} = 1;
2372 $resultdate = GetNextDate($publisheddate,$subscription)
2374 this function it takes the publisheddate and will return the next issue's date
2375 and will skip dates if there exists an irregularity.
2376 $publisheddate has to be an ISO date
2377 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2378 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2379 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2380 skipped then the returned date will be 2007-05-10
2383 $resultdate - then next date in the sequence (ISO date)
2385 Return undef if subscription is irregular
2390 my ( $subscription, $publisheddate, $updatecount ) = @_;
2392 return unless $subscription and $publisheddate;
2394 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2396 if ($freqdata->{'unit'}) {
2397 my ( $year, $month, $day ) = split /-/, $publisheddate;
2399 # Process an irregularity Hash
2400 # Suppose that irregularities are stored in a string with this structure
2401 # irreg1;irreg2;irreg3
2402 # where irregX is the number of issue which will not be received
2403 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2405 if ( $subscription->{irregularity} ) {
2406 my @irreg = split /;/, $subscription->{'irregularity'} ;
2407 foreach my $irregularity (@irreg) {
2408 $irregularities{$irregularity} = 1;
2412 # Get the 'fictive' next issue number
2413 # It is used to check if next issue is an irregular issue.
2414 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2416 # Then get the next date
2417 my $unit = lc $freqdata->{'unit'};
2418 if ($unit eq 'day') {
2419 while ($irregularities{$issueno}) {
2420 ($year, $month, $day) = _get_next_date_day($subscription,
2421 $freqdata, $year, $month, $day);
2424 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2425 $year, $month, $day);
2427 elsif ($unit eq 'week') {
2428 while ($irregularities{$issueno}) {
2429 ($year, $month, $day) = _get_next_date_week($subscription,
2430 $freqdata, $year, $month, $day);
2433 ($year, $month, $day) = _get_next_date_week($subscription,
2434 $freqdata, $year, $month, $day);
2436 elsif ($unit eq 'month') {
2437 while ($irregularities{$issueno}) {
2438 ($year, $month, $day) = _get_next_date_month($subscription,
2439 $freqdata, $year, $month, $day);
2442 ($year, $month, $day) = _get_next_date_month($subscription,
2443 $freqdata, $year, $month, $day);
2445 elsif ($unit eq 'year') {
2446 while ($irregularities{$issueno}) {
2447 ($year, $month, $day) = _get_next_date_year($subscription,
2448 $freqdata, $year, $month, $day);
2451 ($year, $month, $day) = _get_next_date_year($subscription,
2452 $freqdata, $year, $month, $day);
2456 my $dbh = C4::Context->dbh;
2459 SET countissuesperunit = ?
2460 WHERE subscriptionid = ?
2462 my $sth = $dbh->prepare($query);
2463 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2466 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2472 $string = &_numeration($value,$num_type,$locale);
2474 _numeration returns the string corresponding to $value in the num_type
2486 my ($value, $num_type, $locale) = @_;
2491 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2492 # 1970-11-01 was a Sunday
2493 $value = $value % 7;
2494 my $dt = DateTime->new(
2500 $string = $num_type =~ /^dayname$/
2501 ? $dt->strftime("%A")
2502 : $dt->strftime("%a");
2503 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2504 $value = $value % 12;
2505 my $dt = DateTime->new(
2507 month => $value + 1,
2510 $string = $num_type =~ /^monthname$/
2511 ? $dt->strftime("%B")
2512 : $dt->strftime("%b");
2513 } elsif ( $num_type =~ /^season$/ ) {
2514 my @seasons= qw( Spring Summer Fall Winter );
2515 $value = $value % 4;
2516 $string = $seasons[$value];
2517 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2518 my @seasonsabrv= qw( Spr Sum Fal Win );
2519 $value = $value % 4;
2520 $string = $seasonsabrv[$value];
2528 =head2 is_barcode_in_use
2530 Returns number of occurrences of the barcode in the items table
2531 Can be used as a boolean test of whether the barcode has
2532 been deployed as yet
2536 sub is_barcode_in_use {
2537 my $barcode = shift;
2538 my $dbh = C4::Context->dbh;
2539 my $occurrences = $dbh->selectall_arrayref(
2540 'SELECT itemnumber from items where barcode = ?',
2545 return @{$occurrences};
2548 =head2 CloseSubscription
2550 Close a subscription given a subscriptionid
2554 sub CloseSubscription {
2555 my ( $subscriptionid ) = @_;
2556 return unless $subscriptionid;
2557 my $dbh = C4::Context->dbh;
2558 my $sth = $dbh->prepare( q{
2561 WHERE subscriptionid = ?
2563 $sth->execute( $subscriptionid );
2565 # Set status = missing when status = stopped
2566 $sth = $dbh->prepare( q{
2569 WHERE subscriptionid = ?
2572 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2575 =head2 ReopenSubscription
2577 Reopen a subscription given a subscriptionid
2581 sub ReopenSubscription {
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 = expected when status = stopped
2593 $sth = $dbh->prepare( q{
2596 WHERE subscriptionid = ?
2599 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2602 =head2 subscriptionCurrentlyOnOrder
2604 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2606 Return 1 if subscription is currently on order else 0.
2610 sub subscriptionCurrentlyOnOrder {
2611 my ( $subscriptionid ) = @_;
2612 my $dbh = C4::Context->dbh;
2614 SELECT COUNT(*) FROM aqorders
2615 WHERE subscriptionid = ?
2616 AND datereceived IS NULL
2617 AND datecancellationprinted IS NULL
2619 my $sth = $dbh->prepare( $query );
2620 $sth->execute($subscriptionid);
2621 return $sth->fetchrow_array;
2624 =head2 can_claim_subscription
2626 $can = can_claim_subscription( $subscriptionid[, $userid] );
2628 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2632 sub can_claim_subscription {
2633 my ( $subscription, $userid ) = @_;
2634 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2637 =head2 can_edit_subscription
2639 $can = can_edit_subscription( $subscriptionid[, $userid] );
2641 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2645 sub can_edit_subscription {
2646 my ( $subscription, $userid ) = @_;
2647 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2650 =head2 can_show_subscription
2652 $can = can_show_subscription( $subscriptionid[, $userid] );
2654 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2658 sub can_show_subscription {
2659 my ( $subscription, $userid ) = @_;
2660 return _can_do_on_subscription( $subscription, $userid, '*' );
2663 sub _can_do_on_subscription {
2664 my ( $subscription, $userid, $permission ) = @_;
2665 return 0 unless C4::Context->userenv;
2666 my $flags = C4::Context->userenv->{flags};
2667 $userid ||= C4::Context->userenv->{'id'};
2669 if ( C4::Context->preference('IndependentBranches') ) {
2671 if C4::Context->IsSuperLibrarian()
2673 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2675 C4::Auth::haspermission( $userid,
2676 { serials => $permission } )
2677 and ( not defined $subscription->{branchcode}
2678 or $subscription->{branchcode} eq ''
2679 or $subscription->{branchcode} eq
2680 C4::Context->userenv->{'branch'} )
2685 if C4::Context->IsSuperLibrarian()
2687 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2688 or C4::Auth::haspermission(
2689 $userid, { serials => $permission }
2696 =head2 findSerialsByStatus
2698 @serials = findSerialsByStatus($status, $subscriptionid);
2700 Returns an array of serials matching a given status and subscription id.
2704 sub findSerialsByStatus {
2705 my ( $status, $subscriptionid ) = @_;
2706 my $dbh = C4::Context->dbh;
2707 my $query = q| SELECT * from serial
2709 AND subscriptionid = ?
2711 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2720 Koha Development Team <http://koha-community.org/>