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 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
296 # Add additional fields to the subscription into a new key "additional_fields"
297 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
298 tablename => 'subscription',
299 record_id => $subscriptionid,
301 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
303 return $subscription;
306 =head2 GetFullSubscription
308 $array_ref = GetFullSubscription($subscriptionid)
309 this function reads the serial table.
313 sub GetFullSubscription {
314 my ($subscriptionid) = @_;
316 return unless ($subscriptionid);
318 my $dbh = C4::Context->dbh;
320 SELECT serial.serialid,
323 serial.publisheddate,
324 serial.publisheddatetext,
326 serial.notes as notes,
327 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
328 aqbooksellers.name as aqbooksellername,
329 biblio.title as bibliotitle,
330 subscription.branchcode AS branchcode,
331 subscription.subscriptionid AS subscriptionid
333 LEFT JOIN subscription ON
334 (serial.subscriptionid=subscription.subscriptionid )
335 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
336 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
337 WHERE serial.subscriptionid = ?
339 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
340 serial.subscriptionid
342 $debug and warn "GetFullSubscription query: $query";
343 my $sth = $dbh->prepare($query);
344 $sth->execute($subscriptionid);
345 my $subscriptions = $sth->fetchall_arrayref( {} );
346 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
347 for my $subscription ( @$subscriptions ) {
348 $subscription->{cannotedit} = $cannotedit;
350 return $subscriptions;
353 =head2 PrepareSerialsData
355 $array_ref = PrepareSerialsData($serialinfomation)
356 where serialinformation is a hashref array
360 sub PrepareSerialsData {
363 return unless ($lines);
369 my $aqbooksellername;
373 my $previousnote = "";
375 foreach my $subs (@{$lines}) {
376 for my $datefield ( qw(publisheddate planneddate) ) {
377 # handle 0000-00-00 dates
378 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
379 $subs->{$datefield} = undef;
382 $subs->{ "status" . $subs->{'status'} } = 1;
383 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
384 $subs->{"checked"} = 1;
387 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
388 $year = $subs->{'year'};
392 if ( $tmpresults{$year} ) {
393 push @{ $tmpresults{$year}->{'serials'} }, $subs;
395 $tmpresults{$year} = {
397 'aqbooksellername' => $subs->{'aqbooksellername'},
398 'bibliotitle' => $subs->{'bibliotitle'},
399 'serials' => [$subs],
404 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
405 push @res, $tmpresults{$key};
410 =head2 GetSubscriptionsFromBiblionumber
412 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
413 this function get the subscription list. it reads the subscription table.
415 reference to an array of subscriptions which have the biblionumber given on input arg.
416 each element of this array is a hashref containing
417 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
421 sub GetSubscriptionsFromBiblionumber {
422 my ($biblionumber) = @_;
424 return unless ($biblionumber);
426 my $dbh = C4::Context->dbh;
428 SELECT subscription.*,
430 subscriptionhistory.*,
431 aqbooksellers.name AS aqbooksellername,
432 biblio.title AS bibliotitle
434 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
435 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
436 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
437 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
438 WHERE subscription.biblionumber = ?
440 my $sth = $dbh->prepare($query);
441 $sth->execute($biblionumber);
443 while ( my $subs = $sth->fetchrow_hashref ) {
444 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
445 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
446 if ( defined $subs->{histenddate} ) {
447 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
449 $subs->{histenddate} = "";
451 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
452 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
453 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
454 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
455 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
456 $subs->{ "status" . $subs->{'status'} } = 1;
458 if (not defined $subs->{enddate} ) {
459 $subs->{enddate} = '';
461 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
463 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
464 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
465 $subs->{cannotedit} = not can_edit_subscription( $subs );
471 =head2 GetFullSubscriptionsFromBiblionumber
473 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
474 this function reads the serial table.
478 sub GetFullSubscriptionsFromBiblionumber {
479 my ($biblionumber) = @_;
480 my $dbh = C4::Context->dbh;
482 SELECT serial.serialid,
485 serial.publisheddate,
486 serial.publisheddatetext,
488 serial.notes as notes,
489 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
490 biblio.title as bibliotitle,
491 subscription.branchcode AS branchcode,
492 subscription.subscriptionid AS subscriptionid
494 LEFT JOIN subscription ON
495 (serial.subscriptionid=subscription.subscriptionid)
496 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
497 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
498 WHERE subscription.biblionumber = ?
500 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
501 serial.subscriptionid
503 my $sth = $dbh->prepare($query);
504 $sth->execute($biblionumber);
505 my $subscriptions = $sth->fetchall_arrayref( {} );
506 my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions;
507 for my $subscription ( @$subscriptions ) {
508 $subscription->{cannotedit} = $cannotedit;
510 return $subscriptions;
513 =head2 SearchSubscriptions
515 @results = SearchSubscriptions($args);
517 This function returns a list of hashrefs, one for each subscription
518 that meets the conditions specified by the $args hashref.
520 The valid search fields are:
534 The expiration_date search field is special; it specifies the maximum
535 subscription expiration date.
539 sub SearchSubscriptions {
542 my $additional_fields = $args->{additional_fields} // [];
543 my $matching_record_ids_for_additional_fields = [];
544 if ( @$additional_fields ) {
545 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
546 fields => $additional_fields,
547 tablename => 'subscription',
550 return () unless @$matching_record_ids_for_additional_fields;
555 subscription.notes AS publicnotes,
556 subscriptionhistory.*,
558 biblio.notes AS biblionotes,
562 aqbooksellers.name AS vendorname,
565 LEFT JOIN subscriptionhistory USING(subscriptionid)
566 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
567 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
568 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
570 $query .= q| WHERE 1|;
573 if( $args->{biblionumber} ) {
574 push @where_strs, "biblio.biblionumber = ?";
575 push @where_args, $args->{biblionumber};
578 if( $args->{title} ){
579 my @words = split / /, $args->{title};
581 foreach my $word (@words) {
582 push @strs, "biblio.title LIKE ?";
583 push @args, "%$word%";
586 push @where_strs, '(' . join (' AND ', @strs) . ')';
587 push @where_args, @args;
591 push @where_strs, "biblioitems.issn LIKE ?";
592 push @where_args, "%$args->{issn}%";
595 push @where_strs, "biblioitems.ean LIKE ?";
596 push @where_args, "%$args->{ean}%";
598 if ( $args->{callnumber} ) {
599 push @where_strs, "subscription.callnumber LIKE ?";
600 push @where_args, "%$args->{callnumber}%";
602 if( $args->{publisher} ){
603 push @where_strs, "biblioitems.publishercode LIKE ?";
604 push @where_args, "%$args->{publisher}%";
606 if( $args->{bookseller} ){
607 push @where_strs, "aqbooksellers.name LIKE ?";
608 push @where_args, "%$args->{bookseller}%";
610 if( $args->{branch} ){
611 push @where_strs, "subscription.branchcode = ?";
612 push @where_args, "$args->{branch}";
614 if ( $args->{location} ) {
615 push @where_strs, "subscription.location = ?";
616 push @where_args, "$args->{location}";
618 if ( $args->{expiration_date} ) {
619 push @where_strs, "subscription.enddate <= ?";
620 push @where_args, "$args->{expiration_date}";
622 if( defined $args->{closed} ){
623 push @where_strs, "subscription.closed = ?";
624 push @where_args, "$args->{closed}";
628 $query .= ' AND ' . join(' AND ', @where_strs);
630 if ( @$additional_fields ) {
631 $query .= ' AND subscriptionid IN ('
632 . join( ', ', @$matching_record_ids_for_additional_fields )
636 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
638 my $dbh = C4::Context->dbh;
639 my $sth = $dbh->prepare($query);
640 $sth->execute(@where_args);
641 my $results = $sth->fetchall_arrayref( {} );
643 for my $subscription ( @$results ) {
644 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
645 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
647 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
648 record_id => $subscription->{subscriptionid},
649 tablename => 'subscription'
651 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
660 ($totalissues,@serials) = GetSerials($subscriptionid);
661 this function gets every serial not arrived for a given subscription
662 as well as the number of issues registered in the database (all types)
663 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
665 FIXME: We should return \@serials.
670 my ( $subscriptionid, $count ) = @_;
672 return unless $subscriptionid;
674 my $dbh = C4::Context->dbh;
676 # status = 2 is "arrived"
678 $count = 5 unless ($count);
680 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
681 my $query = "SELECT serialid,serialseq, status, publisheddate,
682 publisheddatetext, planneddate,notes, routingnotes
684 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
685 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
686 my $sth = $dbh->prepare($query);
687 $sth->execute($subscriptionid);
689 while ( my $line = $sth->fetchrow_hashref ) {
690 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
691 for my $datefield ( qw( planneddate publisheddate) ) {
692 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
693 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
695 $line->{$datefield} = q{};
698 push @serials, $line;
701 # OK, now add the last 5 issues arrives/missing
702 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
703 publisheddatetext, notes, routingnotes
705 WHERE subscriptionid = ?
706 AND status IN ( $statuses )
707 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
709 $sth = $dbh->prepare($query);
710 $sth->execute($subscriptionid);
711 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
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 } );
718 $line->{$datefield} = q{};
722 push @serials, $line;
725 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
726 $sth = $dbh->prepare($query);
727 $sth->execute($subscriptionid);
728 my ($totalissues) = $sth->fetchrow;
729 return ( $totalissues, @serials );
734 @serials = GetSerials2($subscriptionid,$statuses);
735 this function returns every serial waited for a given subscription
736 as well as the number of issues registered in the database (all types)
737 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
739 $statuses is an arrayref of statuses and is mandatory.
744 my ( $subscription, $statuses ) = @_;
746 return unless ($subscription and @$statuses);
748 my $dbh = C4::Context->dbh;
750 SELECT serialid,serialseq, status, planneddate, publisheddate,
751 publisheddatetext, notes, routingnotes
753 WHERE subscriptionid=?
755 . q| AND status IN (| . join( ",", ('?') x @$statuses ) . q|)|
757 ORDER BY publisheddate,serialid DESC
759 $debug and warn "GetSerials2 query: $query";
760 my $sth = $dbh->prepare($query);
761 $sth->execute( $subscription, @$statuses );
764 while ( my $line = $sth->fetchrow_hashref ) {
765 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
766 # Format dates for display
767 for my $datefield ( qw( planneddate publisheddate ) ) {
768 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
769 $line->{$datefield} = q{};
772 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
775 push @serials, $line;
780 =head2 GetLatestSerials
782 \@serials = GetLatestSerials($subscriptionid,$limit)
783 get the $limit's latest serials arrived or missing for a given subscription
785 a ref to an array which contains all of the latest serials stored into a hash.
789 sub GetLatestSerials {
790 my ( $subscriptionid, $limit ) = @_;
792 return unless ($subscriptionid and $limit);
794 my $dbh = C4::Context->dbh;
796 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
797 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
799 WHERE subscriptionid = ?
800 AND status IN ($statuses)
801 ORDER BY publisheddate DESC LIMIT 0,$limit
803 my $sth = $dbh->prepare($strsth);
804 $sth->execute($subscriptionid);
806 while ( my $line = $sth->fetchrow_hashref ) {
807 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
808 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
809 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
810 push @serials, $line;
816 =head2 GetPreviousSerialid
818 $serialid = GetPreviousSerialid($subscriptionid, $nth)
819 get the $nth's previous serial for the given subscriptionid
825 sub GetPreviousSerialid {
826 my ( $subscriptionid, $nth ) = @_;
828 my $dbh = C4::Context->dbh;
832 my $strsth = "SELECT serialid
834 WHERE subscriptionid = ?
836 ORDER BY serialid DESC LIMIT $nth,1
838 my $sth = $dbh->prepare($strsth);
839 $sth->execute($subscriptionid);
841 my $line = $sth->fetchrow_hashref;
842 $return = $line->{'serialid'} if ($line);
849 =head2 GetDistributedTo
851 $distributedto=GetDistributedTo($subscriptionid)
852 This function returns the field distributedto for the subscription matching subscriptionid
856 sub GetDistributedTo {
857 warn "C4::Serials::GetDistributedTo will be deprecated as of 18.11.0\n";
858 my $dbh = C4::Context->dbh;
860 my ($subscriptionid) = @_;
862 return unless ($subscriptionid);
864 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
865 my $sth = $dbh->prepare($query);
866 $sth->execute($subscriptionid);
867 return ($distributedto) = $sth->fetchrow;
873 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
874 $newinnerloop1, $newinnerloop2, $newinnerloop3
875 ) = GetNextSeq( $subscription, $pattern, $planneddate );
877 $subscription is a hashref containing all the attributes of the table
879 $pattern is a hashref containing all the attributes of the table
880 'subscription_numberpatterns'.
881 $planneddate is a date string in iso format.
882 This function get the next issue for the subscription given on input arg
887 my ($subscription, $pattern, $planneddate) = @_;
889 return unless ($subscription and $pattern);
891 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
892 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
895 if ($subscription->{'skip_serialseq'}) {
896 my @irreg = split /;/, $subscription->{'irregularity'};
898 my $irregularities = {};
899 $irregularities->{$_} = 1 foreach(@irreg);
900 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
901 while($irregularities->{$issueno}) {
908 my $numberingmethod = $pattern->{numberingmethod};
910 if ($numberingmethod) {
911 $calculated = $numberingmethod;
912 my $locale = $subscription->{locale};
913 $newlastvalue1 = $subscription->{lastvalue1} || 0;
914 $newlastvalue2 = $subscription->{lastvalue2} || 0;
915 $newlastvalue3 = $subscription->{lastvalue3} || 0;
916 $newinnerloop1 = $subscription->{innerloop1} || 0;
917 $newinnerloop2 = $subscription->{innerloop2} || 0;
918 $newinnerloop3 = $subscription->{innerloop3} || 0;
921 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
924 for(my $i = 0; $i < $count; $i++) {
926 # check if we have to increase the new value.
928 if ($newinnerloop1 >= $pattern->{every1}) {
930 $newlastvalue1 += $pattern->{add1};
932 # reset counter if needed.
933 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
936 # check if we have to increase the new value.
938 if ($newinnerloop2 >= $pattern->{every2}) {
940 $newlastvalue2 += $pattern->{add2};
942 # reset counter if needed.
943 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
946 # check if we have to increase the new value.
948 if ($newinnerloop3 >= $pattern->{every3}) {
950 $newlastvalue3 += $pattern->{add3};
952 # reset counter if needed.
953 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
957 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
958 $calculated =~ s/\{X\}/$newlastvalue1string/g;
961 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
962 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
965 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
966 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
971 $newlastvalue1, $newlastvalue2, $newlastvalue3,
972 $newinnerloop1, $newinnerloop2, $newinnerloop3);
977 $calculated = GetSeq($subscription, $pattern)
978 $subscription is a hashref containing all the attributes of the table 'subscription'
979 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
980 this function transforms {X},{Y},{Z} to 150,0,0 for example.
982 the sequence in string format
987 my ($subscription, $pattern) = @_;
989 return unless ($subscription and $pattern);
991 my $locale = $subscription->{locale};
993 my $calculated = $pattern->{numberingmethod};
995 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
996 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
997 $calculated =~ s/\{X\}/$newlastvalue1/g;
999 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1000 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1001 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1003 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1004 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1005 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1009 =head2 GetExpirationDate
1011 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1013 this function return the next expiration date for a subscription given on input args.
1016 the enddate or undef
1020 sub GetExpirationDate {
1021 my ( $subscriptionid, $startdate ) = @_;
1023 return unless ($subscriptionid);
1025 my $dbh = C4::Context->dbh;
1026 my $subscription = GetSubscription($subscriptionid);
1029 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1030 $enddate = $startdate || $subscription->{startdate};
1031 my @date = split( /-/, $enddate );
1033 return if ( scalar(@date) != 3 || not check_date(@date) );
1035 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1036 if ( $frequency and $frequency->{unit} ) {
1039 if ( my $length = $subscription->{numberlength} ) {
1041 #calculate the date of the last issue.
1042 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1043 $enddate = GetNextDate( $subscription, $enddate );
1045 } elsif ( $subscription->{monthlength} ) {
1046 if ( $$subscription{startdate} ) {
1047 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1048 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1050 } elsif ( $subscription->{weeklength} ) {
1051 if ( $$subscription{startdate} ) {
1052 my @date = split( /-/, $subscription->{startdate} );
1053 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1054 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1057 $enddate = $subscription->{enddate};
1061 return $subscription->{enddate};
1065 =head2 CountSubscriptionFromBiblionumber
1067 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1068 this returns a count of the subscriptions for a given biblionumber
1070 the number of subscriptions
1074 sub CountSubscriptionFromBiblionumber {
1075 my ($biblionumber) = @_;
1077 return unless ($biblionumber);
1079 my $dbh = C4::Context->dbh;
1080 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($biblionumber);
1083 my $subscriptionsnumber = $sth->fetchrow;
1084 return $subscriptionsnumber;
1087 =head2 ModSubscriptionHistory
1089 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1091 this function modifies the history of a subscription. Put your new values on input arg.
1092 returns the number of rows affected
1096 sub ModSubscriptionHistory {
1097 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1099 return unless ($subscriptionid);
1101 my $dbh = C4::Context->dbh;
1102 my $query = "UPDATE subscriptionhistory
1103 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1104 WHERE subscriptionid=?
1106 my $sth = $dbh->prepare($query);
1107 $receivedlist =~ s/^; // if $receivedlist;
1108 $missinglist =~ s/^; // if $missinglist;
1109 $opacnote =~ s/^; // if $opacnote;
1110 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1114 =head2 ModSerialStatus
1116 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1117 $publisheddatetext, $status, $notes);
1119 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1120 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1124 sub ModSerialStatus {
1125 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1126 $status, $notes) = @_;
1128 return unless ($serialid);
1130 #It is a usual serial
1131 # 1st, get previous status :
1132 my $dbh = C4::Context->dbh;
1133 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1134 FROM serial, subscription
1135 WHERE serial.subscriptionid=subscription.subscriptionid
1137 my $sth = $dbh->prepare($query);
1138 $sth->execute($serialid);
1139 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1140 my $frequency = GetSubscriptionFrequency($periodicity);
1142 # change status & update subscriptionhistory
1144 if ( $status == DELETED ) {
1145 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1150 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1151 planneddate = ?, status = ?, notes = ?
1154 $sth = $dbh->prepare($query);
1155 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1156 $planneddate, $status, $notes, $serialid );
1157 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1158 $sth = $dbh->prepare($query);
1159 $sth->execute($subscriptionid);
1160 my $val = $sth->fetchrow_hashref;
1161 unless ( $val->{manualhistory} ) {
1162 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1163 $sth = $dbh->prepare($query);
1164 $sth->execute($subscriptionid);
1165 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1167 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1168 $recievedlist .= "; $serialseq"
1169 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1172 # in case serial has been previously marked as missing
1173 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1174 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1177 $missinglist .= "; $serialseq"
1178 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1179 $missinglist .= "; not issued $serialseq"
1180 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1182 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1183 $sth = $dbh->prepare($query);
1184 $recievedlist =~ s/^; //;
1185 $missinglist =~ s/^; //;
1186 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1190 # create new expected entry if needed (ie : was "expected" and has changed)
1191 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1192 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1193 my $subscription = GetSubscription($subscriptionid);
1194 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1198 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1199 $newinnerloop1, $newinnerloop2, $newinnerloop3
1201 = GetNextSeq( $subscription, $pattern, $publisheddate );
1203 # next date (calculated from actual date & frequency parameters)
1204 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1205 my $nextpubdate = $nextpublisheddate;
1206 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1207 WHERE subscriptionid = ?";
1208 $sth = $dbh->prepare($query);
1209 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1211 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1213 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1214 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1215 require C4::Letters;
1216 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1223 =head2 GetNextExpected
1225 $nextexpected = GetNextExpected($subscriptionid)
1227 Get the planneddate for the current expected issue of the subscription.
1233 planneddate => ISO date
1238 sub GetNextExpected {
1239 my ($subscriptionid) = @_;
1241 my $dbh = C4::Context->dbh;
1245 WHERE subscriptionid = ?
1249 my $sth = $dbh->prepare($query);
1251 # Each subscription has only one 'expected' issue.
1252 $sth->execute( $subscriptionid, EXPECTED );
1253 my $nextissue = $sth->fetchrow_hashref;
1254 if ( !$nextissue ) {
1258 WHERE subscriptionid = ?
1259 ORDER BY publisheddate DESC
1262 $sth = $dbh->prepare($query);
1263 $sth->execute($subscriptionid);
1264 $nextissue = $sth->fetchrow_hashref;
1266 foreach(qw/planneddate publisheddate/) {
1267 if ( !defined $nextissue->{$_} ) {
1268 # or should this default to 1st Jan ???
1269 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1271 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1279 =head2 ModNextExpected
1281 ModNextExpected($subscriptionid,$date)
1283 Update the planneddate for the current expected issue of the subscription.
1284 This will modify all future prediction results.
1286 C<$date> is an ISO date.
1292 sub ModNextExpected {
1293 my ( $subscriptionid, $date ) = @_;
1294 my $dbh = C4::Context->dbh;
1296 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1297 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1299 # Each subscription has only one 'expected' issue.
1300 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1305 =head2 GetSubscriptionIrregularities
1309 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1310 get the list of irregularities for a subscription
1316 sub GetSubscriptionIrregularities {
1317 my $subscriptionid = shift;
1319 return unless $subscriptionid;
1321 my $dbh = C4::Context->dbh;
1325 WHERE subscriptionid = ?
1327 my $sth = $dbh->prepare($query);
1328 $sth->execute($subscriptionid);
1330 my ($result) = $sth->fetchrow_array;
1331 my @irreg = split /;/, $result;
1336 =head2 ModSubscription
1338 this function modifies a subscription. Put all new values on input args.
1339 returns the number of rows affected
1343 sub ModSubscription {
1345 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1346 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1347 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1348 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1349 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1350 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1351 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1352 $itemtype, $previousitemtype
1355 my $dbh = C4::Context->dbh;
1356 my $query = "UPDATE subscription
1357 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1358 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1359 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1360 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1361 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1362 callnumber=?, notes=?, letter=?, manualhistory=?,
1363 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1364 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1365 skip_serialseq=?, itemtype=?, previousitemtype=?
1366 WHERE subscriptionid = ?";
1368 my $sth = $dbh->prepare($query);
1370 $auser, $branchcode, $aqbooksellerid, $cost,
1371 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1372 $irregularity, $numberpattern, $locale, $numberlength,
1373 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1374 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1375 $status, $biblionumber, $callnumber, $notes,
1376 $letter, ($manualhistory ? $manualhistory : 0),
1377 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1378 $graceperiod, $location, $enddate, $skip_serialseq,
1379 $itemtype, $previousitemtype,
1382 my $rows = $sth->rows;
1384 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1388 =head2 NewSubscription
1390 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1391 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1392 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1393 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1394 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1395 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1396 $skip_serialseq, $itemtype, $previousitemtype);
1398 Create a new subscription with value given on input args.
1401 the id of this new subscription
1405 sub NewSubscription {
1407 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1408 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1409 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1410 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1411 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1412 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1413 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1415 my $dbh = C4::Context->dbh;
1417 #save subscription (insert into database)
1419 INSERT INTO subscription
1420 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1421 biblionumber, startdate, periodicity, numberlength, weeklength,
1422 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1423 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1424 irregularity, numberpattern, locale, callnumber,
1425 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1426 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1427 itemtype, previousitemtype)
1428 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1430 my $sth = $dbh->prepare($query);
1432 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1433 $startdate, $periodicity, $numberlength, $weeklength,
1434 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1435 $lastvalue3, $innerloop3, $status, $notes, $letter,
1436 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1437 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1438 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1439 $itemtype, $previousitemtype
1442 my $subscriptionid = $dbh->{'mysql_insertid'};
1444 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1448 WHERE subscriptionid=?
1450 $sth = $dbh->prepare($query);
1451 $sth->execute( $enddate, $subscriptionid );
1454 # then create the 1st expected number
1456 INSERT INTO subscriptionhistory
1457 (biblionumber, subscriptionid, histstartdate, missinglist, recievedlist)
1458 VALUES (?,?,?, '', '')
1460 $sth = $dbh->prepare($query);
1461 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1463 # reread subscription to get a hash (for calculation of the 1st issue number)
1464 my $subscription = GetSubscription($subscriptionid);
1465 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1467 # calculate issue number
1468 my $serialseq = GetSeq($subscription, $pattern) || q{};
1472 serialseq => $serialseq,
1473 serialseq_x => $subscription->{'lastvalue1'},
1474 serialseq_y => $subscription->{'lastvalue2'},
1475 serialseq_z => $subscription->{'lastvalue3'},
1476 subscriptionid => $subscriptionid,
1477 biblionumber => $biblionumber,
1479 planneddate => $firstacquidate,
1480 publisheddate => $firstacquidate,
1484 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1486 #set serial flag on biblio if not already set.
1487 my $biblio = Koha::Biblios->find( $biblionumber );
1488 if ( $biblio and !$biblio->serial ) {
1489 my $record = GetMarcBiblio({ biblionumber => $biblionumber });
1490 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $biblio->frameworkcode );
1492 eval { $record->field($tag)->update( $subf => 1 ); };
1494 ModBiblio( $record, $biblionumber, $biblio->frameworkcode );
1496 return $subscriptionid;
1499 =head2 ReNewSubscription
1501 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1503 this function renew a subscription with values given on input args.
1507 sub ReNewSubscription {
1508 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1509 my $dbh = C4::Context->dbh;
1510 my $subscription = GetSubscription($subscriptionid);
1514 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1515 WHERE biblio.biblionumber=?
1517 my $sth = $dbh->prepare($query);
1518 $sth->execute( $subscription->{biblionumber} );
1519 my $biblio = $sth->fetchrow_hashref;
1521 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1522 require C4::Suggestions;
1523 C4::Suggestions::NewSuggestion(
1524 { 'suggestedby' => $user,
1525 'title' => $subscription->{bibliotitle},
1526 'author' => $biblio->{author},
1527 'publishercode' => $biblio->{publishercode},
1528 'note' => $biblio->{note},
1529 'biblionumber' => $subscription->{biblionumber}
1534 $numberlength ||= 0; # Should not we raise an exception instead?
1537 # renew subscription
1540 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1541 WHERE subscriptionid=?
1543 $sth = $dbh->prepare($query);
1544 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1545 my $enddate = GetExpirationDate($subscriptionid);
1546 $debug && warn "enddate :$enddate";
1550 WHERE subscriptionid=?
1552 $sth = $dbh->prepare($query);
1553 $sth->execute( $enddate, $subscriptionid );
1555 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1561 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1563 Create a new issue stored on the database.
1564 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1565 returns the serial id
1570 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1571 $publisheddate, $publisheddatetext, $notes ) = @_;
1572 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1574 return unless ($subscriptionid);
1576 my $schema = Koha::Database->new()->schema();
1578 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1580 my $serial = Koha::Serial->new(
1582 serialseq => $serialseq,
1583 serialseq_x => $subscription->lastvalue1(),
1584 serialseq_y => $subscription->lastvalue2(),
1585 serialseq_z => $subscription->lastvalue3(),
1586 subscriptionid => $subscriptionid,
1587 biblionumber => $biblionumber,
1589 planneddate => $planneddate,
1590 publisheddate => $publisheddate,
1591 publisheddatetext => $publisheddatetext,
1596 my $serialid = $serial->id();
1598 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1599 my $missinglist = $subscription_history->missinglist();
1600 my $recievedlist = $subscription_history->recievedlist();
1602 if ( $status == ARRIVED ) {
1603 ### TODO Add a feature that improves recognition and description.
1604 ### As such count (serialseq) i.e. : N18,2(N19),N20
1605 ### Would use substr and index But be careful to previous presence of ()
1606 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1608 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1609 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1612 $recievedlist =~ s/^; //;
1613 $missinglist =~ s/^; //;
1615 $subscription_history->recievedlist($recievedlist);
1616 $subscription_history->missinglist($missinglist);
1617 $subscription_history->store();
1622 =head2 HasSubscriptionStrictlyExpired
1624 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1626 the subscription has stricly expired when today > the end subscription date
1629 1 if true, 0 if false, -1 if the expiration date is not set.
1633 sub HasSubscriptionStrictlyExpired {
1635 # Getting end of subscription date
1636 my ($subscriptionid) = @_;
1638 return unless ($subscriptionid);
1640 my $dbh = C4::Context->dbh;
1641 my $subscription = GetSubscription($subscriptionid);
1642 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1644 # If the expiration date is set
1645 if ( $expirationdate != 0 ) {
1646 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1648 # Getting today's date
1649 my ( $nowyear, $nowmonth, $nowday ) = Today();
1651 # if today's date > expiration date, then the subscription has stricly expired
1652 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1659 # There are some cases where the expiration date is not set
1660 # As we can't determine if the subscription has expired on a date-basis,
1666 =head2 HasSubscriptionExpired
1668 $has_expired = HasSubscriptionExpired($subscriptionid)
1670 the subscription has expired when the next issue to arrive is out of subscription limit.
1673 0 if the subscription has not expired
1674 1 if the subscription has expired
1675 2 if has subscription does not have a valid expiration date set
1679 sub HasSubscriptionExpired {
1680 my ($subscriptionid) = @_;
1682 return unless ($subscriptionid);
1684 my $dbh = C4::Context->dbh;
1685 my $subscription = GetSubscription($subscriptionid);
1686 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1687 if ( $frequency and $frequency->{unit} ) {
1688 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1689 if (!defined $expirationdate) {
1690 $expirationdate = q{};
1693 SELECT max(planneddate)
1695 WHERE subscriptionid=?
1697 my $sth = $dbh->prepare($query);
1698 $sth->execute($subscriptionid);
1699 my ($res) = $sth->fetchrow;
1700 if (!$res || $res=~m/^0000/) {
1703 my @res = split( /-/, $res );
1704 my @endofsubscriptiondate = split( /-/, $expirationdate );
1705 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1707 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1712 if ( $subscription->{'numberlength'} ) {
1713 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1714 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1720 return 0; # Notice that you'll never get here.
1723 =head2 SetDistributedto
1725 SetDistributedto($distributedto,$subscriptionid);
1726 This function update the value of distributedto for a subscription given on input arg.
1730 sub SetDistributedto {
1731 warn "C4::Serials::SetDistributedto will be deprecated as of 18.11.0\n";
1732 my ( $distributedto, $subscriptionid ) = @_;
1733 my $dbh = C4::Context->dbh;
1737 WHERE subscriptionid=?
1739 my $sth = $dbh->prepare($query);
1740 $sth->execute( $distributedto, $subscriptionid );
1744 =head2 DelSubscription
1746 DelSubscription($subscriptionid)
1747 this function deletes subscription which has $subscriptionid as id.
1751 sub DelSubscription {
1752 my ($subscriptionid) = @_;
1753 my $dbh = C4::Context->dbh;
1754 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1755 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1756 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1758 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1759 foreach my $af (@$afs) {
1760 $af->delete_values({record_id => $subscriptionid});
1763 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1768 DelIssue($serialseq,$subscriptionid)
1769 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1771 returns the number of rows affected
1776 my ($dataissue) = @_;
1777 my $dbh = C4::Context->dbh;
1778 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1783 AND subscriptionid= ?
1785 my $mainsth = $dbh->prepare($query);
1786 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1788 #Delete element from subscription history
1789 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1790 my $sth = $dbh->prepare($query);
1791 $sth->execute( $dataissue->{'subscriptionid'} );
1792 my $val = $sth->fetchrow_hashref;
1793 unless ( $val->{manualhistory} ) {
1795 SELECT * FROM subscriptionhistory
1796 WHERE subscriptionid= ?
1798 my $sth = $dbh->prepare($query);
1799 $sth->execute( $dataissue->{'subscriptionid'} );
1800 my $data = $sth->fetchrow_hashref;
1801 my $serialseq = $dataissue->{'serialseq'};
1802 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1803 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1804 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1805 $sth = $dbh->prepare($strsth);
1806 $sth->execute( $dataissue->{'subscriptionid'} );
1809 return $mainsth->rows;
1812 =head2 GetLateOrMissingIssues
1814 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1816 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1819 the issuelist as an array of hash refs. Each element of this array contains
1820 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1824 sub GetLateOrMissingIssues {
1825 my ( $supplierid, $serialid, $order ) = @_;
1827 return unless ( $supplierid or $serialid );
1829 my $dbh = C4::Context->dbh;
1834 $byserial = "and serialid = " . $serialid;
1837 $order .= ", title";
1841 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1843 $sth = $dbh->prepare(
1845 serialid, aqbooksellerid, name,
1846 biblio.title, biblioitems.issn, planneddate, serialseq,
1847 serial.status, serial.subscriptionid, claimdate, claims_count,
1848 subscription.branchcode
1850 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1851 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1852 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1853 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1854 WHERE subscription.subscriptionid = serial.subscriptionid
1855 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1856 AND subscription.aqbooksellerid=$supplierid
1861 $sth = $dbh->prepare(
1863 serialid, aqbooksellerid, name,
1864 biblio.title, planneddate, serialseq,
1865 serial.status, serial.subscriptionid, claimdate, claims_count,
1866 subscription.branchcode
1868 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1869 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1870 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1871 WHERE subscription.subscriptionid = serial.subscriptionid
1872 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1877 $sth->execute( EXPECTED, LATE, CLAIMED );
1879 while ( my $line = $sth->fetchrow_hashref ) {
1881 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1882 $line->{planneddateISO} = $line->{planneddate};
1883 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1885 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1886 $line->{claimdateISO} = $line->{claimdate};
1887 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1889 $line->{"status".$line->{status}} = 1;
1891 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1892 record_id => $line->{subscriptionid},
1893 tablename => 'subscription'
1895 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1897 push @issuelist, $line;
1904 &updateClaim($serialid)
1906 this function updates the time when a claim is issued for late/missing items
1908 called from claims.pl file
1913 my ($serialids) = @_;
1914 return unless $serialids;
1915 unless ( ref $serialids ) {
1916 $serialids = [ $serialids ];
1918 my $dbh = C4::Context->dbh;
1921 SET claimdate = NOW(),
1922 claims_count = claims_count + 1,
1924 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1925 {}, CLAIMED, @$serialids );
1928 =head2 check_routing
1930 $result = &check_routing($subscriptionid)
1932 this function checks to see if a serial has a routing list and returns the count of routingid
1933 used to show either an 'add' or 'edit' link
1938 my ($subscriptionid) = @_;
1940 return unless ($subscriptionid);
1942 my $dbh = C4::Context->dbh;
1943 my $sth = $dbh->prepare(
1944 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1945 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1946 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1949 $sth->execute($subscriptionid);
1950 my $line = $sth->fetchrow_hashref;
1951 my $result = $line->{'routingids'};
1955 =head2 addroutingmember
1957 addroutingmember($borrowernumber,$subscriptionid)
1959 this function takes a borrowernumber and subscriptionid and adds the member to the
1960 routing list for that serial subscription and gives them a rank on the list
1961 of either 1 or highest current rank + 1
1965 sub addroutingmember {
1966 my ( $borrowernumber, $subscriptionid ) = @_;
1968 return unless ($borrowernumber and $subscriptionid);
1971 my $dbh = C4::Context->dbh;
1972 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1973 $sth->execute($subscriptionid);
1974 while ( my $line = $sth->fetchrow_hashref ) {
1975 if ( $line->{'rank'} > 0 ) {
1976 $rank = $line->{'rank'} + 1;
1981 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1982 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1985 =head2 reorder_members
1987 reorder_members($subscriptionid,$routingid,$rank)
1989 this function is used to reorder the routing list
1991 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1992 - it gets all members on list puts their routingid's into an array
1993 - removes the one in the array that is $routingid
1994 - then reinjects $routingid at point indicated by $rank
1995 - then update the database with the routingids in the new order
1999 sub reorder_members {
2000 my ( $subscriptionid, $routingid, $rank ) = @_;
2001 my $dbh = C4::Context->dbh;
2002 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2003 $sth->execute($subscriptionid);
2005 while ( my $line = $sth->fetchrow_hashref ) {
2006 push( @result, $line->{'routingid'} );
2009 # To find the matching index
2011 my $key = -1; # to allow for 0 being a valid response
2012 for ( $i = 0 ; $i < @result ; $i++ ) {
2013 if ( $routingid == $result[$i] ) {
2014 $key = $i; # save the index
2019 # if index exists in array then move it to new position
2020 if ( $key > -1 && $rank > 0 ) {
2021 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2022 my $moving_item = splice( @result, $key, 1 );
2023 splice( @result, $new_rank, 0, $moving_item );
2025 for ( my $j = 0 ; $j < @result ; $j++ ) {
2026 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2032 =head2 delroutingmember
2034 delroutingmember($routingid,$subscriptionid)
2036 this function either deletes one member from routing list if $routingid exists otherwise
2037 deletes all members from the routing list
2041 sub delroutingmember {
2043 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2044 my ( $routingid, $subscriptionid ) = @_;
2045 my $dbh = C4::Context->dbh;
2047 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2048 $sth->execute($routingid);
2049 reorder_members( $subscriptionid, $routingid );
2051 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2052 $sth->execute($subscriptionid);
2057 =head2 getroutinglist
2059 @routinglist = getroutinglist($subscriptionid)
2061 this gets the info from the subscriptionroutinglist for $subscriptionid
2064 the routinglist as an array. Each element of the array contains a hash_ref containing
2065 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2069 sub getroutinglist {
2070 my ($subscriptionid) = @_;
2071 my $dbh = C4::Context->dbh;
2072 my $sth = $dbh->prepare(
2073 'SELECT routingid, borrowernumber, ranking, biblionumber
2075 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2076 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2078 $sth->execute($subscriptionid);
2079 my $routinglist = $sth->fetchall_arrayref({});
2080 return @{$routinglist};
2083 =head2 countissuesfrom
2085 $result = countissuesfrom($subscriptionid,$startdate)
2087 Returns a count of serial rows matching the given subsctiptionid
2088 with published date greater than startdate
2092 sub countissuesfrom {
2093 my ( $subscriptionid, $startdate ) = @_;
2094 my $dbh = C4::Context->dbh;
2098 WHERE subscriptionid=?
2099 AND serial.publisheddate>?
2101 my $sth = $dbh->prepare($query);
2102 $sth->execute( $subscriptionid, $startdate );
2103 my ($countreceived) = $sth->fetchrow;
2104 return $countreceived;
2109 $result = CountIssues($subscriptionid)
2111 Returns a count of serial rows matching the given subsctiptionid
2116 my ($subscriptionid) = @_;
2117 my $dbh = C4::Context->dbh;
2121 WHERE subscriptionid=?
2123 my $sth = $dbh->prepare($query);
2124 $sth->execute($subscriptionid);
2125 my ($countreceived) = $sth->fetchrow;
2126 return $countreceived;
2131 $result = HasItems($subscriptionid)
2133 returns a count of items from serial matching the subscriptionid
2138 my ($subscriptionid) = @_;
2139 my $dbh = C4::Context->dbh;
2141 SELECT COUNT(serialitems.itemnumber)
2143 LEFT JOIN serialitems USING(serialid)
2144 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2146 my $sth=$dbh->prepare($query);
2147 $sth->execute($subscriptionid);
2148 my ($countitems)=$sth->fetchrow_array();
2152 =head2 abouttoexpire
2154 $result = abouttoexpire($subscriptionid)
2156 this function alerts you to the penultimate issue for a serial subscription
2158 returns 1 - if this is the penultimate issue
2164 my ($subscriptionid) = @_;
2165 my $dbh = C4::Context->dbh;
2166 my $subscription = GetSubscription($subscriptionid);
2167 my $per = $subscription->{'periodicity'};
2168 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2169 if ($frequency and $frequency->{unit}){
2171 my $expirationdate = GetExpirationDate($subscriptionid);
2173 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2174 my $nextdate = GetNextDate($subscription, $res);
2176 # only compare dates if both dates exist.
2177 if ($nextdate and $expirationdate) {
2178 if(Date::Calc::Delta_Days(
2179 split( /-/, $nextdate ),
2180 split( /-/, $expirationdate )
2186 } elsif ($subscription->{numberlength}>0) {
2187 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2193 sub in_array { # used in next sub down
2194 my ( $val, @elements ) = @_;
2195 foreach my $elem (@elements) {
2196 if ( $val == $elem ) {
2203 =head2 GetFictiveIssueNumber
2205 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2207 Get the position of the issue published at $publisheddate, considering the
2208 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2209 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2210 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2211 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2212 depending on how many rows are in serial table.
2213 The issue number calculation is based on subscription frequency, first acquisition
2214 date, and $publisheddate.
2216 Returns undef when called for irregular frequencies.
2218 The routine is used to skip irregularities when calculating the next issue
2219 date (in GetNextDate) or the next issue number (in GetNextSeq).
2223 sub GetFictiveIssueNumber {
2224 my ($subscription, $publisheddate) = @_;
2226 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2227 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2231 my ( $year, $month, $day ) = split /-/, $publisheddate;
2232 my ( $fa_year, $fa_month, $fa_day ) = split /-/, $subscription->{'firstacquidate'};
2233 my $delta = _delta_units( [$fa_year, $fa_month, $fa_day], [$year, $month, $day], $unit );
2235 if( $frequency->{'unitsperissue'} == 1 ) {
2236 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2237 } else { # issuesperunit == 1
2238 $issueno = 1 + int( $delta / $frequency->{'unitsperissue'} );
2244 my ( $date1, $date2, $unit ) = @_;
2245 # date1 and date2 are array refs in the form [ yy, mm, dd ]
2247 if( $unit eq 'day' ) {
2248 return Delta_Days( @$date1, @$date2 );
2249 } elsif( $unit eq 'week' ) {
2250 return int( Delta_Days( @$date1, @$date2 ) / 7 );
2253 # In case of months or years, this is a wrapper around N_Delta_YMD.
2254 # Note that N_Delta_YMD returns 29 days between e.g. 22-2-72 and 22-3-72
2255 # while we expect 1 month.
2256 my @delta = N_Delta_YMD( @$date1, @$date2 );
2257 if( $delta[2] > 27 ) {
2258 # Check if we could add a month
2259 my @jump = Add_Delta_YM( @$date1, $delta[0], 1 + $delta[1] );
2260 if( Delta_Days( @jump, @$date2 ) >= 0 ) {
2264 if( $delta[1] >= 12 ) {
2268 # if unit is year, we only return full years
2269 return $unit eq 'month' ? $delta[0] * 12 + $delta[1] : $delta[0];
2272 sub _get_next_date_day {
2273 my ($subscription, $freqdata, $year, $month, $day) = @_;
2275 my @newissue; # ( yy, mm, dd )
2276 # We do not need $delta_days here, since it would be zero where used
2278 if( $freqdata->{issuesperunit} == 1 ) {
2280 @newissue = Add_Delta_Days(
2281 $year, $month, $day, $freqdata->{"unitsperissue"} );
2282 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2284 @newissue = ( $year, $month, $day );
2285 $subscription->{countissuesperunit}++;
2287 # We finished a cycle of issues within a unit.
2288 # No subtraction of zero needed, just add one day
2289 @newissue = Add_Delta_Days( $year, $month, $day, 1 );
2290 $subscription->{countissuesperunit} = 1;
2295 sub _get_next_date_week {
2296 my ($subscription, $freqdata, $year, $month, $day) = @_;
2298 my @newissue; # ( yy, mm, dd )
2299 my $delta_days = int( 7 / $freqdata->{issuesperunit} );
2301 if( $freqdata->{issuesperunit} == 1 ) {
2302 # Add full weeks (of 7 days)
2303 @newissue = Add_Delta_Days(
2304 $year, $month, $day, 7 * $freqdata->{"unitsperissue"} );
2305 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2306 # Add rounded number of days based on frequency.
2307 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2308 $subscription->{countissuesperunit}++;
2310 # We finished a cycle of issues within a unit.
2311 # Subtract delta * (issues - 1), add 1 week
2312 @newissue = Add_Delta_Days( $year, $month, $day,
2313 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2314 @newissue = Add_Delta_Days( @newissue, 7 );
2315 $subscription->{countissuesperunit} = 1;
2320 sub _get_next_date_month {
2321 my ($subscription, $freqdata, $year, $month, $day) = @_;
2323 my @newissue; # ( yy, mm, dd )
2324 my $delta_days = int( 30 / $freqdata->{issuesperunit} );
2326 if( $freqdata->{issuesperunit} == 1 ) {
2328 @newissue = Add_Delta_YM(
2329 $year, $month, $day, 0, $freqdata->{"unitsperissue"} );
2330 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2331 # Add rounded number of days based on frequency.
2332 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2333 $subscription->{countissuesperunit}++;
2335 # We finished a cycle of issues within a unit.
2336 # Subtract delta * (issues - 1), add 1 month
2337 @newissue = Add_Delta_Days( $year, $month, $day,
2338 -$delta_days * ($freqdata->{issuesperunit} - 1) );
2339 @newissue = Add_Delta_YM( @newissue, 0, 1 );
2340 $subscription->{countissuesperunit} = 1;
2345 sub _get_next_date_year {
2346 my ($subscription, $freqdata, $year, $month, $day) = @_;
2348 my @newissue; # ( yy, mm, dd )
2349 my $delta_days = int( 365 / $freqdata->{issuesperunit} );
2351 if( $freqdata->{issuesperunit} == 1 ) {
2353 @newissue = Add_Delta_YM( $year, $month, $day, $freqdata->{"unitsperissue"}, 0 );
2354 } elsif ( $subscription->{countissuesperunit} < $freqdata->{issuesperunit} ) {
2355 # Add rounded number of days based on frequency.
2356 @newissue = Add_Delta_Days( $year, $month, $day, $delta_days );
2357 $subscription->{countissuesperunit}++;
2359 # We finished a cycle of issues within a unit.
2360 # Subtract delta * (issues - 1), add 1 year
2361 @newissue = Add_Delta_Days( $year, $month, $day, -$delta_days * ($freqdata->{issuesperunit} - 1) );
2362 @newissue = Add_Delta_YM( @newissue, 1, 0 );
2363 $subscription->{countissuesperunit} = 1;
2370 $resultdate = GetNextDate($publisheddate,$subscription)
2372 this function it takes the publisheddate and will return the next issue's date
2373 and will skip dates if there exists an irregularity.
2374 $publisheddate has to be an ISO date
2375 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2376 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2377 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2378 skipped then the returned date will be 2007-05-10
2381 $resultdate - then next date in the sequence (ISO date)
2383 Return undef if subscription is irregular
2388 my ( $subscription, $publisheddate, $updatecount ) = @_;
2390 return unless $subscription and $publisheddate;
2392 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2394 if ($freqdata->{'unit'}) {
2395 my ( $year, $month, $day ) = split /-/, $publisheddate;
2397 # Process an irregularity Hash
2398 # Suppose that irregularities are stored in a string with this structure
2399 # irreg1;irreg2;irreg3
2400 # where irregX is the number of issue which will not be received
2401 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2403 if ( $subscription->{irregularity} ) {
2404 my @irreg = split /;/, $subscription->{'irregularity'} ;
2405 foreach my $irregularity (@irreg) {
2406 $irregularities{$irregularity} = 1;
2410 # Get the 'fictive' next issue number
2411 # It is used to check if next issue is an irregular issue.
2412 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2414 # Then get the next date
2415 my $unit = lc $freqdata->{'unit'};
2416 if ($unit eq 'day') {
2417 while ($irregularities{$issueno}) {
2418 ($year, $month, $day) = _get_next_date_day($subscription,
2419 $freqdata, $year, $month, $day);
2422 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2423 $year, $month, $day);
2425 elsif ($unit eq 'week') {
2426 while ($irregularities{$issueno}) {
2427 ($year, $month, $day) = _get_next_date_week($subscription,
2428 $freqdata, $year, $month, $day);
2431 ($year, $month, $day) = _get_next_date_week($subscription,
2432 $freqdata, $year, $month, $day);
2434 elsif ($unit eq 'month') {
2435 while ($irregularities{$issueno}) {
2436 ($year, $month, $day) = _get_next_date_month($subscription,
2437 $freqdata, $year, $month, $day);
2440 ($year, $month, $day) = _get_next_date_month($subscription,
2441 $freqdata, $year, $month, $day);
2443 elsif ($unit eq 'year') {
2444 while ($irregularities{$issueno}) {
2445 ($year, $month, $day) = _get_next_date_year($subscription,
2446 $freqdata, $year, $month, $day);
2449 ($year, $month, $day) = _get_next_date_year($subscription,
2450 $freqdata, $year, $month, $day);
2454 my $dbh = C4::Context->dbh;
2457 SET countissuesperunit = ?
2458 WHERE subscriptionid = ?
2460 my $sth = $dbh->prepare($query);
2461 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2464 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2470 $string = &_numeration($value,$num_type,$locale);
2472 _numeration returns the string corresponding to $value in the num_type
2484 my ($value, $num_type, $locale) = @_;
2489 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2490 # 1970-11-01 was a Sunday
2491 $value = $value % 7;
2492 my $dt = DateTime->new(
2498 $string = $num_type =~ /^dayname$/
2499 ? $dt->strftime("%A")
2500 : $dt->strftime("%a");
2501 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2502 $value = $value % 12;
2503 my $dt = DateTime->new(
2505 month => $value + 1,
2508 $string = $num_type =~ /^monthname$/
2509 ? $dt->strftime("%B")
2510 : $dt->strftime("%b");
2511 } elsif ( $num_type =~ /^season$/ ) {
2512 my @seasons= qw( Spring Summer Fall Winter );
2513 $value = $value % 4;
2514 $string = $seasons[$value];
2515 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2516 my @seasonsabrv= qw( Spr Sum Fal Win );
2517 $value = $value % 4;
2518 $string = $seasonsabrv[$value];
2526 =head2 is_barcode_in_use
2528 Returns number of occurrences of the barcode in the items table
2529 Can be used as a boolean test of whether the barcode has
2530 been deployed as yet
2534 sub is_barcode_in_use {
2535 my $barcode = shift;
2536 my $dbh = C4::Context->dbh;
2537 my $occurrences = $dbh->selectall_arrayref(
2538 'SELECT itemnumber from items where barcode = ?',
2543 return @{$occurrences};
2546 =head2 CloseSubscription
2548 Close a subscription given a subscriptionid
2552 sub CloseSubscription {
2553 my ( $subscriptionid ) = @_;
2554 return unless $subscriptionid;
2555 my $dbh = C4::Context->dbh;
2556 my $sth = $dbh->prepare( q{
2559 WHERE subscriptionid = ?
2561 $sth->execute( $subscriptionid );
2563 # Set status = missing when status = stopped
2564 $sth = $dbh->prepare( q{
2567 WHERE subscriptionid = ?
2570 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2573 =head2 ReopenSubscription
2575 Reopen a subscription given a subscriptionid
2579 sub ReopenSubscription {
2580 my ( $subscriptionid ) = @_;
2581 return unless $subscriptionid;
2582 my $dbh = C4::Context->dbh;
2583 my $sth = $dbh->prepare( q{
2586 WHERE subscriptionid = ?
2588 $sth->execute( $subscriptionid );
2590 # Set status = expected when status = stopped
2591 $sth = $dbh->prepare( q{
2594 WHERE subscriptionid = ?
2597 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2600 =head2 subscriptionCurrentlyOnOrder
2602 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2604 Return 1 if subscription is currently on order else 0.
2608 sub subscriptionCurrentlyOnOrder {
2609 my ( $subscriptionid ) = @_;
2610 my $dbh = C4::Context->dbh;
2612 SELECT COUNT(*) FROM aqorders
2613 WHERE subscriptionid = ?
2614 AND datereceived IS NULL
2615 AND datecancellationprinted IS NULL
2617 my $sth = $dbh->prepare( $query );
2618 $sth->execute($subscriptionid);
2619 return $sth->fetchrow_array;
2622 =head2 can_claim_subscription
2624 $can = can_claim_subscription( $subscriptionid[, $userid] );
2626 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2630 sub can_claim_subscription {
2631 my ( $subscription, $userid ) = @_;
2632 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2635 =head2 can_edit_subscription
2637 $can = can_edit_subscription( $subscriptionid[, $userid] );
2639 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2643 sub can_edit_subscription {
2644 my ( $subscription, $userid ) = @_;
2645 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2648 =head2 can_show_subscription
2650 $can = can_show_subscription( $subscriptionid[, $userid] );
2652 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2656 sub can_show_subscription {
2657 my ( $subscription, $userid ) = @_;
2658 return _can_do_on_subscription( $subscription, $userid, '*' );
2661 sub _can_do_on_subscription {
2662 my ( $subscription, $userid, $permission ) = @_;
2663 return 0 unless C4::Context->userenv;
2664 my $flags = C4::Context->userenv->{flags};
2665 $userid ||= C4::Context->userenv->{'id'};
2667 if ( C4::Context->preference('IndependentBranches') ) {
2669 if C4::Context->IsSuperLibrarian()
2671 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2673 C4::Auth::haspermission( $userid,
2674 { serials => $permission } )
2675 and ( not defined $subscription->{branchcode}
2676 or $subscription->{branchcode} eq ''
2677 or $subscription->{branchcode} eq
2678 C4::Context->userenv->{'branch'} )
2683 if C4::Context->IsSuperLibrarian()
2685 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2686 or C4::Auth::haspermission(
2687 $userid, { serials => $permission }
2694 =head2 findSerialsByStatus
2696 @serials = findSerialsByStatus($status, $subscriptionid);
2698 Returns an array of serials matching a given status and subscription id.
2702 sub findSerialsByStatus {
2703 my ( $status, $subscriptionid ) = @_;
2704 my $dbh = C4::Context->dbh;
2705 my $query = q| SELECT * from serial
2707 AND subscriptionid = ?
2709 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2718 Koha Development Team <http://koha-community.org/>