3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalField;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
39 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
80 &GetSuppliersWithLateIssues &getsupplierbyserialid
81 &GetDistributedTo &SetDistributedTo
82 &getroutinglist &delroutingmember &addroutingmember
84 &check_routing &updateClaim
87 &GetSubscriptionsFromBorrower
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 my $dbh = C4::Context->dbh;
182 return $dbh->prepare($query);
185 =head2 GetSerialInformation
188 $data = GetSerialInformation($serialid);
189 returns a hash_ref containing :
190 items : items marcrecord (can be an array)
192 subscription table field
193 + information about subscription expiration
197 sub GetSerialInformation {
199 my $dbh = C4::Context->dbh;
201 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
202 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
205 my $rq = $dbh->prepare($query);
206 $rq->execute($serialid);
207 my $data = $rq->fetchrow_hashref;
209 # create item information if we have serialsadditems for this subscription
210 if ( $data->{'serialsadditems'} ) {
211 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
212 $queryitem->execute($serialid);
213 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
215 if ( scalar(@$itemnumbers) > 0 ) {
216 foreach my $itemnum (@$itemnumbers) {
218 #It is ASSUMED that GetMarcItem ALWAYS WORK...
219 #Maybe GetMarcItem should return values on failure
220 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
221 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
222 $itemprocessed->{'itemnumber'} = $itemnum->[0];
223 $itemprocessed->{'itemid'} = $itemnum->[0];
224 $itemprocessed->{'serialid'} = $serialid;
225 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
226 push @{ $data->{'items'} }, $itemprocessed;
229 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
230 $itemprocessed->{'itemid'} = "N$serialid";
231 $itemprocessed->{'serialid'} = $serialid;
232 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
233 $itemprocessed->{'countitems'} = 0;
234 push @{ $data->{'items'} }, $itemprocessed;
237 $data->{ "status" . $data->{'serstatus'} } = 1;
238 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
239 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
240 $data->{cannotedit} = not can_edit_subscription( $data );
244 =head2 AddItem2Serial
246 $rows = AddItem2Serial($serialid,$itemnumber);
247 Adds an itemnumber to Serial record
248 returns the number of rows affected
253 my ( $serialid, $itemnumber ) = @_;
255 return unless ($serialid and $itemnumber);
257 my $dbh = C4::Context->dbh;
258 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
259 $rq->execute( $serialid, $itemnumber );
263 =head2 GetSubscription
265 $subs = GetSubscription($subscriptionid)
266 this function returns the subscription which has $subscriptionid as id.
268 a hashref. This hash containts
269 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
273 sub GetSubscription {
274 my ($subscriptionid) = @_;
275 my $dbh = C4::Context->dbh;
277 SELECT subscription.*,
278 subscriptionhistory.*,
279 aqbooksellers.name AS aqbooksellername,
280 biblio.title AS bibliotitle,
281 subscription.biblionumber as bibnum
283 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
284 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
285 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
286 WHERE subscription.subscriptionid = ?
289 $debug and warn "query : $query\nsubsid :$subscriptionid";
290 my $sth = $dbh->prepare($query);
291 $sth->execute($subscriptionid);
292 my $subscription = $sth->fetchrow_hashref;
294 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
296 # Add additional fields to the subscription into a new key "additional_fields"
297 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
298 tablename => 'subscription',
299 record_id => $subscriptionid,
301 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
303 return $subscription;
306 =head2 GetFullSubscription
308 $array_ref = GetFullSubscription($subscriptionid)
309 this function reads the serial table.
313 sub GetFullSubscription {
314 my ($subscriptionid) = @_;
316 return unless ($subscriptionid);
318 my $dbh = C4::Context->dbh;
320 SELECT serial.serialid,
323 serial.publisheddate,
324 serial.publisheddatetext,
326 serial.notes as notes,
327 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
328 aqbooksellers.name as aqbooksellername,
329 biblio.title as bibliotitle,
330 subscription.branchcode AS branchcode,
331 subscription.subscriptionid AS subscriptionid
333 LEFT JOIN subscription ON
334 (serial.subscriptionid=subscription.subscriptionid )
335 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
336 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
337 WHERE serial.subscriptionid = ?
339 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
340 serial.subscriptionid
342 $debug and warn "GetFullSubscription query: $query";
343 my $sth = $dbh->prepare($query);
344 $sth->execute($subscriptionid);
345 my $subscriptions = $sth->fetchall_arrayref( {} );
346 for my $subscription ( @$subscriptions ) {
347 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
349 return $subscriptions;
352 =head2 PrepareSerialsData
354 $array_ref = PrepareSerialsData($serialinfomation)
355 where serialinformation is a hashref array
359 sub PrepareSerialsData {
362 return unless ($lines);
368 my $aqbooksellername;
372 my $previousnote = "";
374 foreach my $subs (@{$lines}) {
375 for my $datefield ( qw(publisheddate planneddate) ) {
376 # handle 0000-00-00 dates
377 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
378 $subs->{$datefield} = undef;
381 $subs->{ "status" . $subs->{'status'} } = 1;
382 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
383 $subs->{"checked"} = 1;
386 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
387 $year = $subs->{'year'};
391 if ( $tmpresults{$year} ) {
392 push @{ $tmpresults{$year}->{'serials'} }, $subs;
394 $tmpresults{$year} = {
396 'aqbooksellername' => $subs->{'aqbooksellername'},
397 'bibliotitle' => $subs->{'bibliotitle'},
398 'serials' => [$subs],
403 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
404 push @res, $tmpresults{$key};
409 =head2 GetSubscriptionsFromBiblionumber
411 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
412 this function get the subscription list. it reads the subscription table.
414 reference to an array of subscriptions which have the biblionumber given on input arg.
415 each element of this array is a hashref containing
416 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
420 sub GetSubscriptionsFromBiblionumber {
421 my ($biblionumber) = @_;
423 return unless ($biblionumber);
425 my $dbh = C4::Context->dbh;
427 SELECT subscription.*,
429 subscriptionhistory.*,
430 aqbooksellers.name AS aqbooksellername,
431 biblio.title AS bibliotitle
433 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
434 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
435 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
436 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
437 WHERE subscription.biblionumber = ?
439 my $sth = $dbh->prepare($query);
440 $sth->execute($biblionumber);
442 while ( my $subs = $sth->fetchrow_hashref ) {
443 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
444 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
445 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
446 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
447 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
448 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
449 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
450 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
451 $subs->{ "status" . $subs->{'status'} } = 1;
453 if ( $subs->{enddate} eq '0000-00-00' ) {
454 $subs->{enddate} = '';
456 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
458 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
459 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
460 $subs->{cannotedit} = not can_edit_subscription( $subs );
466 =head2 GetFullSubscriptionsFromBiblionumber
468 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
469 this function reads the serial table.
473 sub GetFullSubscriptionsFromBiblionumber {
474 my ($biblionumber) = @_;
475 my $dbh = C4::Context->dbh;
477 SELECT serial.serialid,
480 serial.publisheddate,
481 serial.publisheddatetext,
483 serial.notes as notes,
484 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
485 biblio.title as bibliotitle,
486 subscription.branchcode AS branchcode,
487 subscription.subscriptionid AS subscriptionid
489 LEFT JOIN subscription ON
490 (serial.subscriptionid=subscription.subscriptionid)
491 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
492 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
493 WHERE subscription.biblionumber = ?
495 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
496 serial.subscriptionid
498 my $sth = $dbh->prepare($query);
499 $sth->execute($biblionumber);
500 my $subscriptions = $sth->fetchall_arrayref( {} );
501 for my $subscription ( @$subscriptions ) {
502 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
504 return $subscriptions;
507 =head2 SearchSubscriptions
509 @results = SearchSubscriptions($args);
511 This function returns a list of hashrefs, one for each subscription
512 that meets the conditions specified by the $args hashref.
514 The valid search fields are:
528 The expiration_date search field is special; it specifies the maximum
529 subscription expiration date.
533 sub SearchSubscriptions {
536 my $additional_fields = $args->{additional_fields} // [];
537 my $matching_record_ids_for_additional_fields = [];
538 if ( @$additional_fields ) {
539 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
540 fields => $additional_fields,
541 tablename => 'subscription',
544 return () unless @$matching_record_ids_for_additional_fields;
549 subscription.notes AS publicnotes,
550 subscriptionhistory.*,
552 biblio.notes AS biblionotes,
558 LEFT JOIN subscriptionhistory USING(subscriptionid)
559 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
560 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
561 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
563 $query .= q| WHERE 1|;
566 if( $args->{biblionumber} ) {
567 push @where_strs, "biblio.biblionumber = ?";
568 push @where_args, $args->{biblionumber};
571 if( $args->{title} ){
572 my @words = split / /, $args->{title};
574 foreach my $word (@words) {
575 push @strs, "biblio.title LIKE ?";
576 push @args, "%$word%";
579 push @where_strs, '(' . join (' AND ', @strs) . ')';
580 push @where_args, @args;
584 push @where_strs, "biblioitems.issn LIKE ?";
585 push @where_args, "%$args->{issn}%";
588 push @where_strs, "biblioitems.ean LIKE ?";
589 push @where_args, "%$args->{ean}%";
591 if ( $args->{callnumber} ) {
592 push @where_strs, "subscription.callnumber LIKE ?";
593 push @where_args, "%$args->{callnumber}%";
595 if( $args->{publisher} ){
596 push @where_strs, "biblioitems.publishercode LIKE ?";
597 push @where_args, "%$args->{publisher}%";
599 if( $args->{bookseller} ){
600 push @where_strs, "aqbooksellers.name LIKE ?";
601 push @where_args, "%$args->{bookseller}%";
603 if( $args->{branch} ){
604 push @where_strs, "subscription.branchcode = ?";
605 push @where_args, "$args->{branch}";
607 if ( $args->{location} ) {
608 push @where_strs, "subscription.location = ?";
609 push @where_args, "$args->{location}";
611 if ( $args->{expiration_date} ) {
612 push @where_strs, "subscription.enddate <= ?";
613 push @where_args, "$args->{expiration_date}";
615 if( defined $args->{closed} ){
616 push @where_strs, "subscription.closed = ?";
617 push @where_args, "$args->{closed}";
621 $query .= ' AND ' . join(' AND ', @where_strs);
623 if ( @$additional_fields ) {
624 $query .= ' AND subscriptionid IN ('
625 . join( ', ', @$matching_record_ids_for_additional_fields )
629 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
631 my $dbh = C4::Context->dbh;
632 my $sth = $dbh->prepare($query);
633 $sth->execute(@where_args);
634 my $results = $sth->fetchall_arrayref( {} );
636 for my $subscription ( @$results ) {
637 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
638 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
640 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
641 record_id => $subscription->{subscriptionid},
642 tablename => 'subscription'
644 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
653 ($totalissues,@serials) = GetSerials($subscriptionid);
654 this function gets every serial not arrived for a given subscription
655 as well as the number of issues registered in the database (all types)
656 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
658 FIXME: We should return \@serials.
663 my ( $subscriptionid, $count ) = @_;
665 return unless $subscriptionid;
667 my $dbh = C4::Context->dbh;
669 # status = 2 is "arrived"
671 $count = 5 unless ($count);
673 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
674 my $query = "SELECT serialid,serialseq, status, publisheddate,
675 publisheddatetext, planneddate,notes, routingnotes
677 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
678 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
679 my $sth = $dbh->prepare($query);
680 $sth->execute($subscriptionid);
682 while ( my $line = $sth->fetchrow_hashref ) {
683 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
684 for my $datefield ( qw( planneddate publisheddate) ) {
685 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
686 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
688 $line->{$datefield} = q{};
691 push @serials, $line;
694 # OK, now add the last 5 issues arrives/missing
695 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
696 publisheddatetext, notes, routingnotes
698 WHERE subscriptionid = ?
699 AND status IN ( $statuses )
700 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
702 $sth = $dbh->prepare($query);
703 $sth->execute($subscriptionid);
704 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
706 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
707 for my $datefield ( qw( planneddate publisheddate) ) {
708 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
709 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
711 $line->{$datefield} = q{};
715 push @serials, $line;
718 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
719 $sth = $dbh->prepare($query);
720 $sth->execute($subscriptionid);
721 my ($totalissues) = $sth->fetchrow;
722 return ( $totalissues, @serials );
727 @serials = GetSerials2($subscriptionid,$statuses);
728 this function returns every serial waited for a given subscription
729 as well as the number of issues registered in the database (all types)
730 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
732 $statuses is an arrayref of statuses and is mandatory.
737 my ( $subscription, $statuses ) = @_;
739 return unless ($subscription and @$statuses);
741 my $statuses_string = join ',', @$statuses;
743 my $dbh = C4::Context->dbh;
745 SELECT serialid,serialseq, status, planneddate, publisheddate,
746 publisheddatetext, notes, routingnotes
748 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
749 ORDER BY publisheddate,serialid DESC
751 $debug and warn "GetSerials2 query: $query";
752 my $sth = $dbh->prepare($query);
756 while ( my $line = $sth->fetchrow_hashref ) {
757 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
758 # Format dates for display
759 for my $datefield ( qw( planneddate publisheddate ) ) {
760 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
761 $line->{$datefield} = q{};
764 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
767 push @serials, $line;
772 =head2 GetLatestSerials
774 \@serials = GetLatestSerials($subscriptionid,$limit)
775 get the $limit's latest serials arrived or missing for a given subscription
777 a ref to an array which contains all of the latest serials stored into a hash.
781 sub GetLatestSerials {
782 my ( $subscriptionid, $limit ) = @_;
784 return unless ($subscriptionid and $limit);
786 my $dbh = C4::Context->dbh;
788 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
789 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
791 WHERE subscriptionid = ?
792 AND status IN ($statuses)
793 ORDER BY publisheddate DESC LIMIT 0,$limit
795 my $sth = $dbh->prepare($strsth);
796 $sth->execute($subscriptionid);
798 while ( my $line = $sth->fetchrow_hashref ) {
799 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
800 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
801 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
802 push @serials, $line;
808 =head2 GetDistributedTo
810 $distributedto=GetDistributedTo($subscriptionid)
811 This function returns the field distributedto for the subscription matching subscriptionid
815 sub GetDistributedTo {
816 my $dbh = C4::Context->dbh;
818 my ($subscriptionid) = @_;
820 return unless ($subscriptionid);
822 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
823 my $sth = $dbh->prepare($query);
824 $sth->execute($subscriptionid);
825 return ($distributedto) = $sth->fetchrow;
831 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
832 $newinnerloop1, $newinnerloop2, $newinnerloop3
833 ) = GetNextSeq( $subscription, $pattern, $planneddate );
835 $subscription is a hashref containing all the attributes of the table
837 $pattern is a hashref containing all the attributes of the table
838 'subscription_numberpatterns'.
839 $planneddate is a date string in iso format.
840 This function get the next issue for the subscription given on input arg
845 my ($subscription, $pattern, $planneddate) = @_;
847 return unless ($subscription and $pattern);
849 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
850 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
853 if ($subscription->{'skip_serialseq'}) {
854 my @irreg = split /;/, $subscription->{'irregularity'};
856 my $irregularities = {};
857 $irregularities->{$_} = 1 foreach(@irreg);
858 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
859 while($irregularities->{$issueno}) {
866 my $numberingmethod = $pattern->{numberingmethod};
868 if ($numberingmethod) {
869 $calculated = $numberingmethod;
870 my $locale = $subscription->{locale};
871 $newlastvalue1 = $subscription->{lastvalue1} || 0;
872 $newlastvalue2 = $subscription->{lastvalue2} || 0;
873 $newlastvalue3 = $subscription->{lastvalue3} || 0;
874 $newinnerloop1 = $subscription->{innerloop1} || 0;
875 $newinnerloop2 = $subscription->{innerloop2} || 0;
876 $newinnerloop3 = $subscription->{innerloop3} || 0;
879 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
882 for(my $i = 0; $i < $count; $i++) {
884 # check if we have to increase the new value.
886 if ($newinnerloop1 >= $pattern->{every1}) {
888 $newlastvalue1 += $pattern->{add1};
890 # reset counter if needed.
891 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
894 # check if we have to increase the new value.
896 if ($newinnerloop2 >= $pattern->{every2}) {
898 $newlastvalue2 += $pattern->{add2};
900 # reset counter if needed.
901 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
904 # check if we have to increase the new value.
906 if ($newinnerloop3 >= $pattern->{every3}) {
908 $newlastvalue3 += $pattern->{add3};
910 # reset counter if needed.
911 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
915 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
916 $calculated =~ s/\{X\}/$newlastvalue1string/g;
919 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
920 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
923 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
924 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
929 $newlastvalue1, $newlastvalue2, $newlastvalue3,
930 $newinnerloop1, $newinnerloop2, $newinnerloop3);
935 $calculated = GetSeq($subscription, $pattern)
936 $subscription is a hashref containing all the attributes of the table 'subscription'
937 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
938 this function transforms {X},{Y},{Z} to 150,0,0 for example.
940 the sequence in string format
945 my ($subscription, $pattern) = @_;
947 return unless ($subscription and $pattern);
949 my $locale = $subscription->{locale};
951 my $calculated = $pattern->{numberingmethod};
953 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
954 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
955 $calculated =~ s/\{X\}/$newlastvalue1/g;
957 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
958 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
959 $calculated =~ s/\{Y\}/$newlastvalue2/g;
961 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
962 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
963 $calculated =~ s/\{Z\}/$newlastvalue3/g;
967 =head2 GetExpirationDate
969 $enddate = GetExpirationDate($subscriptionid, [$startdate])
971 this function return the next expiration date for a subscription given on input args.
978 sub GetExpirationDate {
979 my ( $subscriptionid, $startdate ) = @_;
981 return unless ($subscriptionid);
983 my $dbh = C4::Context->dbh;
984 my $subscription = GetSubscription($subscriptionid);
987 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
988 $enddate = $startdate || $subscription->{startdate};
989 my @date = split( /-/, $enddate );
991 return if ( scalar(@date) != 3 || not check_date(@date) );
993 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
994 if ( $frequency and $frequency->{unit} ) {
997 if ( my $length = $subscription->{numberlength} ) {
999 #calculate the date of the last issue.
1000 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1001 $enddate = GetNextDate( $subscription, $enddate );
1003 } elsif ( $subscription->{monthlength} ) {
1004 if ( $$subscription{startdate} ) {
1005 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1006 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1008 } elsif ( $subscription->{weeklength} ) {
1009 if ( $$subscription{startdate} ) {
1010 my @date = split( /-/, $subscription->{startdate} );
1011 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1012 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1015 $enddate = $subscription->{enddate};
1019 return $subscription->{enddate};
1023 =head2 CountSubscriptionFromBiblionumber
1025 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1026 this returns a count of the subscriptions for a given biblionumber
1028 the number of subscriptions
1032 sub CountSubscriptionFromBiblionumber {
1033 my ($biblionumber) = @_;
1035 return unless ($biblionumber);
1037 my $dbh = C4::Context->dbh;
1038 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1039 my $sth = $dbh->prepare($query);
1040 $sth->execute($biblionumber);
1041 my $subscriptionsnumber = $sth->fetchrow;
1042 return $subscriptionsnumber;
1045 =head2 ModSubscriptionHistory
1047 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1049 this function modifies the history of a subscription. Put your new values on input arg.
1050 returns the number of rows affected
1054 sub ModSubscriptionHistory {
1055 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1057 return unless ($subscriptionid);
1059 my $dbh = C4::Context->dbh;
1060 my $query = "UPDATE subscriptionhistory
1061 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1062 WHERE subscriptionid=?
1064 my $sth = $dbh->prepare($query);
1065 $receivedlist =~ s/^; // if $receivedlist;
1066 $missinglist =~ s/^; // if $missinglist;
1067 $opacnote =~ s/^; // if $opacnote;
1068 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1072 =head2 ModSerialStatus
1074 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1075 $publisheddatetext, $status, $notes);
1077 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1078 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1082 sub ModSerialStatus {
1083 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1084 $status, $notes) = @_;
1086 return unless ($serialid);
1088 #It is a usual serial
1089 # 1st, get previous status :
1090 my $dbh = C4::Context->dbh;
1091 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1092 FROM serial, subscription
1093 WHERE serial.subscriptionid=subscription.subscriptionid
1095 my $sth = $dbh->prepare($query);
1096 $sth->execute($serialid);
1097 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1098 my $frequency = GetSubscriptionFrequency($periodicity);
1100 # change status & update subscriptionhistory
1102 if ( $status == DELETED ) {
1103 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1108 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1109 planneddate = ?, status = ?, notes = ?
1112 $sth = $dbh->prepare($query);
1113 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1114 $planneddate, $status, $notes, $serialid );
1115 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1116 $sth = $dbh->prepare($query);
1117 $sth->execute($subscriptionid);
1118 my $val = $sth->fetchrow_hashref;
1119 unless ( $val->{manualhistory} ) {
1120 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1121 $sth = $dbh->prepare($query);
1122 $sth->execute($subscriptionid);
1123 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1125 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1126 $recievedlist .= "; $serialseq"
1127 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1130 # in case serial has been previously marked as missing
1131 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1132 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1135 $missinglist .= "; $serialseq"
1136 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1137 $missinglist .= "; not issued $serialseq"
1138 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1140 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1141 $sth = $dbh->prepare($query);
1142 $recievedlist =~ s/^; //;
1143 $missinglist =~ s/^; //;
1144 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1148 # create new expected entry if needed (ie : was "expected" and has changed)
1149 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1150 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1151 my $subscription = GetSubscription($subscriptionid);
1152 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1156 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1157 $newinnerloop1, $newinnerloop2, $newinnerloop3
1159 = GetNextSeq( $subscription, $pattern, $publisheddate );
1161 # next date (calculated from actual date & frequency parameters)
1162 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1163 my $nextpubdate = $nextpublisheddate;
1164 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1165 WHERE subscriptionid = ?";
1166 $sth = $dbh->prepare($query);
1167 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1169 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1171 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1172 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1173 require C4::Letters;
1174 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1181 =head2 GetNextExpected
1183 $nextexpected = GetNextExpected($subscriptionid)
1185 Get the planneddate for the current expected issue of the subscription.
1191 planneddate => ISO date
1196 sub GetNextExpected {
1197 my ($subscriptionid) = @_;
1199 my $dbh = C4::Context->dbh;
1203 WHERE subscriptionid = ?
1207 my $sth = $dbh->prepare($query);
1209 # Each subscription has only one 'expected' issue.
1210 $sth->execute( $subscriptionid, EXPECTED );
1211 my $nextissue = $sth->fetchrow_hashref;
1212 if ( !$nextissue ) {
1216 WHERE subscriptionid = ?
1217 ORDER BY publisheddate DESC
1220 $sth = $dbh->prepare($query);
1221 $sth->execute($subscriptionid);
1222 $nextissue = $sth->fetchrow_hashref;
1224 foreach(qw/planneddate publisheddate/) {
1225 if ( !defined $nextissue->{$_} ) {
1226 # or should this default to 1st Jan ???
1227 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1229 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1237 =head2 ModNextExpected
1239 ModNextExpected($subscriptionid,$date)
1241 Update the planneddate for the current expected issue of the subscription.
1242 This will modify all future prediction results.
1244 C<$date> is an ISO date.
1250 sub ModNextExpected {
1251 my ( $subscriptionid, $date ) = @_;
1252 my $dbh = C4::Context->dbh;
1254 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1255 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1257 # Each subscription has only one 'expected' issue.
1258 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1263 =head2 GetSubscriptionIrregularities
1267 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1268 get the list of irregularities for a subscription
1274 sub GetSubscriptionIrregularities {
1275 my $subscriptionid = shift;
1277 return unless $subscriptionid;
1279 my $dbh = C4::Context->dbh;
1283 WHERE subscriptionid = ?
1285 my $sth = $dbh->prepare($query);
1286 $sth->execute($subscriptionid);
1288 my ($result) = $sth->fetchrow_array;
1289 my @irreg = split /;/, $result;
1294 =head2 ModSubscription
1296 this function modifies a subscription. Put all new values on input args.
1297 returns the number of rows affected
1301 sub ModSubscription {
1303 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1304 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1305 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1306 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1307 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1308 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1309 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1312 my $dbh = C4::Context->dbh;
1313 my $query = "UPDATE subscription
1314 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1315 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1316 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1317 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1318 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1319 callnumber=?, notes=?, letter=?, manualhistory=?,
1320 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1321 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1323 WHERE subscriptionid = ?";
1325 my $sth = $dbh->prepare($query);
1327 $auser, $branchcode, $aqbooksellerid, $cost,
1328 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1329 $irregularity, $numberpattern, $locale, $numberlength,
1330 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1331 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1332 $status, $biblionumber, $callnumber, $notes,
1333 $letter, ($manualhistory ? $manualhistory : 0),
1334 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1335 $graceperiod, $location, $enddate, $skip_serialseq,
1338 my $rows = $sth->rows;
1340 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1344 =head2 NewSubscription
1346 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1347 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1348 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1349 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1350 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1351 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1353 Create a new subscription with value given on input args.
1356 the id of this new subscription
1360 sub NewSubscription {
1362 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1363 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1364 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1365 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1366 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1367 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1368 $location, $enddate, $skip_serialseq
1370 my $dbh = C4::Context->dbh;
1372 #save subscription (insert into database)
1374 INSERT INTO subscription
1375 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1376 biblionumber, startdate, periodicity, numberlength, weeklength,
1377 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1378 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1379 irregularity, numberpattern, locale, callnumber,
1380 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1381 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1382 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1384 my $sth = $dbh->prepare($query);
1386 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1387 $startdate, $periodicity, $numberlength, $weeklength,
1388 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1389 $lastvalue3, $innerloop3, $status, $notes, $letter,
1390 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1391 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1392 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1395 my $subscriptionid = $dbh->{'mysql_insertid'};
1397 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1401 WHERE subscriptionid=?
1403 $sth = $dbh->prepare($query);
1404 $sth->execute( $enddate, $subscriptionid );
1407 # then create the 1st expected number
1409 INSERT INTO subscriptionhistory
1410 (biblionumber, subscriptionid, histstartdate)
1413 $sth = $dbh->prepare($query);
1414 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1416 # reread subscription to get a hash (for calculation of the 1st issue number)
1417 my $subscription = GetSubscription($subscriptionid);
1418 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1420 # calculate issue number
1421 my $serialseq = GetSeq($subscription, $pattern) || q{};
1425 serialseq => $serialseq,
1426 serialseq_x => $subscription->{'lastvalue1'},
1427 serialseq_y => $subscription->{'lastvalue2'},
1428 serialseq_z => $subscription->{'lastvalue3'},
1429 subscriptionid => $subscriptionid,
1430 biblionumber => $biblionumber,
1432 planneddate => $firstacquidate,
1433 publisheddate => $firstacquidate,
1437 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1439 #set serial flag on biblio if not already set.
1440 my $bib = GetBiblio($biblionumber);
1441 if ( $bib and !$bib->{'serial'} ) {
1442 my $record = GetMarcBiblio($biblionumber);
1443 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1445 eval { $record->field($tag)->update( $subf => 1 ); };
1447 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1449 return $subscriptionid;
1452 =head2 ReNewSubscription
1454 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1456 this function renew a subscription with values given on input args.
1460 sub ReNewSubscription {
1461 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1462 my $dbh = C4::Context->dbh;
1463 my $subscription = GetSubscription($subscriptionid);
1467 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1468 WHERE biblio.biblionumber=?
1470 my $sth = $dbh->prepare($query);
1471 $sth->execute( $subscription->{biblionumber} );
1472 my $biblio = $sth->fetchrow_hashref;
1474 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1475 require C4::Suggestions;
1476 C4::Suggestions::NewSuggestion(
1477 { 'suggestedby' => $user,
1478 'title' => $subscription->{bibliotitle},
1479 'author' => $biblio->{author},
1480 'publishercode' => $biblio->{publishercode},
1481 'note' => $biblio->{note},
1482 'biblionumber' => $subscription->{biblionumber}
1487 # renew subscription
1490 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1491 WHERE subscriptionid=?
1493 $sth = $dbh->prepare($query);
1494 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1495 my $enddate = GetExpirationDate($subscriptionid);
1496 $debug && warn "enddate :$enddate";
1500 WHERE subscriptionid=?
1502 $sth = $dbh->prepare($query);
1503 $sth->execute( $enddate, $subscriptionid );
1505 UPDATE subscriptionhistory
1507 WHERE subscriptionid=?
1509 $sth = $dbh->prepare($query);
1510 $sth->execute( $enddate, $subscriptionid );
1512 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1518 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1520 Create a new issue stored on the database.
1521 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1522 returns the serial id
1527 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1528 $publisheddate, $publisheddatetext, $notes ) = @_;
1529 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1531 return unless ($subscriptionid);
1533 my $schema = Koha::Database->new()->schema();
1535 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1537 my $serial = Koha::Serial->new(
1539 serialseq => $serialseq,
1540 serialseq_x => $subscription->lastvalue1(),
1541 serialseq_y => $subscription->lastvalue2(),
1542 serialseq_z => $subscription->lastvalue3(),
1543 subscriptionid => $subscriptionid,
1544 biblionumber => $biblionumber,
1546 planneddate => $planneddate,
1547 publisheddate => $publisheddate,
1548 publisheddatetext => $publisheddatetext,
1553 my $serialid = $serial->id();
1555 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1556 my $missinglist = $subscription_history->missinglist();
1557 my $recievedlist = $subscription_history->recievedlist();
1559 if ( $status == ARRIVED ) {
1560 ### TODO Add a feature that improves recognition and description.
1561 ### As such count (serialseq) i.e. : N18,2(N19),N20
1562 ### Would use substr and index But be careful to previous presence of ()
1563 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1565 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1566 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1569 $recievedlist =~ s/^; //;
1570 $missinglist =~ s/^; //;
1572 $subscription_history->recievedlist($recievedlist);
1573 $subscription_history->missinglist($missinglist);
1574 $subscription_history->store();
1579 =head2 HasSubscriptionStrictlyExpired
1581 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1583 the subscription has stricly expired when today > the end subscription date
1586 1 if true, 0 if false, -1 if the expiration date is not set.
1590 sub HasSubscriptionStrictlyExpired {
1592 # Getting end of subscription date
1593 my ($subscriptionid) = @_;
1595 return unless ($subscriptionid);
1597 my $dbh = C4::Context->dbh;
1598 my $subscription = GetSubscription($subscriptionid);
1599 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1601 # If the expiration date is set
1602 if ( $expirationdate != 0 ) {
1603 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1605 # Getting today's date
1606 my ( $nowyear, $nowmonth, $nowday ) = Today();
1608 # if today's date > expiration date, then the subscription has stricly expired
1609 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1616 # There are some cases where the expiration date is not set
1617 # As we can't determine if the subscription has expired on a date-basis,
1623 =head2 HasSubscriptionExpired
1625 $has_expired = HasSubscriptionExpired($subscriptionid)
1627 the subscription has expired when the next issue to arrive is out of subscription limit.
1630 0 if the subscription has not expired
1631 1 if the subscription has expired
1632 2 if has subscription does not have a valid expiration date set
1636 sub HasSubscriptionExpired {
1637 my ($subscriptionid) = @_;
1639 return unless ($subscriptionid);
1641 my $dbh = C4::Context->dbh;
1642 my $subscription = GetSubscription($subscriptionid);
1643 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1644 if ( $frequency and $frequency->{unit} ) {
1645 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1646 if (!defined $expirationdate) {
1647 $expirationdate = q{};
1650 SELECT max(planneddate)
1652 WHERE subscriptionid=?
1654 my $sth = $dbh->prepare($query);
1655 $sth->execute($subscriptionid);
1656 my ($res) = $sth->fetchrow;
1657 if (!$res || $res=~m/^0000/) {
1660 my @res = split( /-/, $res );
1661 my @endofsubscriptiondate = split( /-/, $expirationdate );
1662 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1664 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1669 if ( $subscription->{'numberlength'} ) {
1670 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1671 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1677 return 0; # Notice that you'll never get here.
1680 =head2 SetDistributedto
1682 SetDistributedto($distributedto,$subscriptionid);
1683 This function update the value of distributedto for a subscription given on input arg.
1687 sub SetDistributedto {
1688 my ( $distributedto, $subscriptionid ) = @_;
1689 my $dbh = C4::Context->dbh;
1693 WHERE subscriptionid=?
1695 my $sth = $dbh->prepare($query);
1696 $sth->execute( $distributedto, $subscriptionid );
1700 =head2 DelSubscription
1702 DelSubscription($subscriptionid)
1703 this function deletes subscription which has $subscriptionid as id.
1707 sub DelSubscription {
1708 my ($subscriptionid) = @_;
1709 my $dbh = C4::Context->dbh;
1710 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1711 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1712 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1714 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1715 foreach my $af (@$afs) {
1716 $af->delete_values({record_id => $subscriptionid});
1719 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1724 DelIssue($serialseq,$subscriptionid)
1725 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1727 returns the number of rows affected
1732 my ($dataissue) = @_;
1733 my $dbh = C4::Context->dbh;
1734 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1739 AND subscriptionid= ?
1741 my $mainsth = $dbh->prepare($query);
1742 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1744 #Delete element from subscription history
1745 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1746 my $sth = $dbh->prepare($query);
1747 $sth->execute( $dataissue->{'subscriptionid'} );
1748 my $val = $sth->fetchrow_hashref;
1749 unless ( $val->{manualhistory} ) {
1751 SELECT * FROM subscriptionhistory
1752 WHERE subscriptionid= ?
1754 my $sth = $dbh->prepare($query);
1755 $sth->execute( $dataissue->{'subscriptionid'} );
1756 my $data = $sth->fetchrow_hashref;
1757 my $serialseq = $dataissue->{'serialseq'};
1758 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1759 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1760 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1761 $sth = $dbh->prepare($strsth);
1762 $sth->execute( $dataissue->{'subscriptionid'} );
1765 return $mainsth->rows;
1768 =head2 GetLateOrMissingIssues
1770 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1772 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1775 the issuelist as an array of hash refs. Each element of this array contains
1776 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1780 sub GetLateOrMissingIssues {
1781 my ( $supplierid, $serialid, $order ) = @_;
1783 return unless ( $supplierid or $serialid );
1785 my $dbh = C4::Context->dbh;
1790 $byserial = "and serialid = " . $serialid;
1793 $order .= ", title";
1797 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1799 $sth = $dbh->prepare(
1801 serialid, aqbooksellerid, name,
1802 biblio.title, biblioitems.issn, planneddate, serialseq,
1803 serial.status, serial.subscriptionid, claimdate, claims_count,
1804 subscription.branchcode
1806 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1807 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1808 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1809 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1810 WHERE subscription.subscriptionid = serial.subscriptionid
1811 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1812 AND subscription.aqbooksellerid=$supplierid
1817 $sth = $dbh->prepare(
1819 serialid, aqbooksellerid, name,
1820 biblio.title, planneddate, serialseq,
1821 serial.status, serial.subscriptionid, claimdate, claims_count,
1822 subscription.branchcode
1824 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1825 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1826 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1827 WHERE subscription.subscriptionid = serial.subscriptionid
1828 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1833 $sth->execute( EXPECTED, LATE, CLAIMED );
1835 while ( my $line = $sth->fetchrow_hashref ) {
1837 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1838 $line->{planneddateISO} = $line->{planneddate};
1839 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1841 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1842 $line->{claimdateISO} = $line->{claimdate};
1843 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1845 $line->{"status".$line->{status}} = 1;
1847 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1848 record_id => $line->{subscriptionid},
1849 tablename => 'subscription'
1851 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1853 push @issuelist, $line;
1860 &updateClaim($serialid)
1862 this function updates the time when a claim is issued for late/missing items
1864 called from claims.pl file
1869 my ($serialids) = @_;
1870 return unless $serialids;
1871 unless ( ref $serialids ) {
1872 $serialids = [ $serialids ];
1874 my $dbh = C4::Context->dbh;
1877 SET claimdate = NOW(),
1878 claims_count = claims_count + 1,
1880 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1881 {}, CLAIMED, @$serialids );
1884 =head2 getsupplierbyserialid
1886 $result = getsupplierbyserialid($serialid)
1888 this function is used to find the supplier id given a serial id
1891 hashref containing serialid, subscriptionid, and aqbooksellerid
1895 sub getsupplierbyserialid {
1896 my ($serialid) = @_;
1897 my $dbh = C4::Context->dbh;
1898 my $sth = $dbh->prepare(
1899 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1901 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1905 $sth->execute($serialid);
1906 my $line = $sth->fetchrow_hashref;
1907 my $result = $line->{'aqbooksellerid'};
1911 =head2 check_routing
1913 $result = &check_routing($subscriptionid)
1915 this function checks to see if a serial has a routing list and returns the count of routingid
1916 used to show either an 'add' or 'edit' link
1921 my ($subscriptionid) = @_;
1923 return unless ($subscriptionid);
1925 my $dbh = C4::Context->dbh;
1926 my $sth = $dbh->prepare(
1927 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1928 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1929 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1932 $sth->execute($subscriptionid);
1933 my $line = $sth->fetchrow_hashref;
1934 my $result = $line->{'routingids'};
1938 =head2 addroutingmember
1940 addroutingmember($borrowernumber,$subscriptionid)
1942 this function takes a borrowernumber and subscriptionid and adds the member to the
1943 routing list for that serial subscription and gives them a rank on the list
1944 of either 1 or highest current rank + 1
1948 sub addroutingmember {
1949 my ( $borrowernumber, $subscriptionid ) = @_;
1951 return unless ($borrowernumber and $subscriptionid);
1954 my $dbh = C4::Context->dbh;
1955 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1956 $sth->execute($subscriptionid);
1957 while ( my $line = $sth->fetchrow_hashref ) {
1958 if ( $line->{'rank'} > 0 ) {
1959 $rank = $line->{'rank'} + 1;
1964 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1965 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1968 =head2 reorder_members
1970 reorder_members($subscriptionid,$routingid,$rank)
1972 this function is used to reorder the routing list
1974 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1975 - it gets all members on list puts their routingid's into an array
1976 - removes the one in the array that is $routingid
1977 - then reinjects $routingid at point indicated by $rank
1978 - then update the database with the routingids in the new order
1982 sub reorder_members {
1983 my ( $subscriptionid, $routingid, $rank ) = @_;
1984 my $dbh = C4::Context->dbh;
1985 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1986 $sth->execute($subscriptionid);
1988 while ( my $line = $sth->fetchrow_hashref ) {
1989 push( @result, $line->{'routingid'} );
1992 # To find the matching index
1994 my $key = -1; # to allow for 0 being a valid response
1995 for ( $i = 0 ; $i < @result ; $i++ ) {
1996 if ( $routingid == $result[$i] ) {
1997 $key = $i; # save the index
2002 # if index exists in array then move it to new position
2003 if ( $key > -1 && $rank > 0 ) {
2004 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2005 my $moving_item = splice( @result, $key, 1 );
2006 splice( @result, $new_rank, 0, $moving_item );
2008 for ( my $j = 0 ; $j < @result ; $j++ ) {
2009 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2015 =head2 delroutingmember
2017 delroutingmember($routingid,$subscriptionid)
2019 this function either deletes one member from routing list if $routingid exists otherwise
2020 deletes all members from the routing list
2024 sub delroutingmember {
2026 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2027 my ( $routingid, $subscriptionid ) = @_;
2028 my $dbh = C4::Context->dbh;
2030 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2031 $sth->execute($routingid);
2032 reorder_members( $subscriptionid, $routingid );
2034 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2035 $sth->execute($subscriptionid);
2040 =head2 getroutinglist
2042 @routinglist = getroutinglist($subscriptionid)
2044 this gets the info from the subscriptionroutinglist for $subscriptionid
2047 the routinglist as an array. Each element of the array contains a hash_ref containing
2048 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2052 sub getroutinglist {
2053 my ($subscriptionid) = @_;
2054 my $dbh = C4::Context->dbh;
2055 my $sth = $dbh->prepare(
2056 'SELECT routingid, borrowernumber, ranking, biblionumber
2058 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2059 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2061 $sth->execute($subscriptionid);
2062 my $routinglist = $sth->fetchall_arrayref({});
2063 return @{$routinglist};
2066 =head2 countissuesfrom
2068 $result = countissuesfrom($subscriptionid,$startdate)
2070 Returns a count of serial rows matching the given subsctiptionid
2071 with published date greater than startdate
2075 sub countissuesfrom {
2076 my ( $subscriptionid, $startdate ) = @_;
2077 my $dbh = C4::Context->dbh;
2081 WHERE subscriptionid=?
2082 AND serial.publisheddate>?
2084 my $sth = $dbh->prepare($query);
2085 $sth->execute( $subscriptionid, $startdate );
2086 my ($countreceived) = $sth->fetchrow;
2087 return $countreceived;
2092 $result = CountIssues($subscriptionid)
2094 Returns a count of serial rows matching the given subsctiptionid
2099 my ($subscriptionid) = @_;
2100 my $dbh = C4::Context->dbh;
2104 WHERE subscriptionid=?
2106 my $sth = $dbh->prepare($query);
2107 $sth->execute($subscriptionid);
2108 my ($countreceived) = $sth->fetchrow;
2109 return $countreceived;
2114 $result = HasItems($subscriptionid)
2116 returns a count of items from serial matching the subscriptionid
2121 my ($subscriptionid) = @_;
2122 my $dbh = C4::Context->dbh;
2124 SELECT COUNT(serialitems.itemnumber)
2126 LEFT JOIN serialitems USING(serialid)
2127 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2129 my $sth=$dbh->prepare($query);
2130 $sth->execute($subscriptionid);
2131 my ($countitems)=$sth->fetchrow_array();
2135 =head2 abouttoexpire
2137 $result = abouttoexpire($subscriptionid)
2139 this function alerts you to the penultimate issue for a serial subscription
2141 returns 1 - if this is the penultimate issue
2147 my ($subscriptionid) = @_;
2148 my $dbh = C4::Context->dbh;
2149 my $subscription = GetSubscription($subscriptionid);
2150 my $per = $subscription->{'periodicity'};
2151 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2152 if ($frequency and $frequency->{unit}){
2154 my $expirationdate = GetExpirationDate($subscriptionid);
2156 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2157 my $nextdate = GetNextDate($subscription, $res);
2159 # only compare dates if both dates exist.
2160 if ($nextdate and $expirationdate) {
2161 if(Date::Calc::Delta_Days(
2162 split( /-/, $nextdate ),
2163 split( /-/, $expirationdate )
2169 } elsif ($subscription->{numberlength}>0) {
2170 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2176 sub in_array { # used in next sub down
2177 my ( $val, @elements ) = @_;
2178 foreach my $elem (@elements) {
2179 if ( $val == $elem ) {
2186 =head2 GetSubscriptionsFromBorrower
2188 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2190 this gets the info from subscriptionroutinglist for each $subscriptionid
2193 a count of the serial subscription routing lists to which a patron belongs,
2194 with the titles of those serial subscriptions as an array. Each element of the array
2195 contains a hash_ref with subscriptionID and title of subscription.
2199 sub GetSubscriptionsFromBorrower {
2200 my ($borrowernumber) = @_;
2201 my $dbh = C4::Context->dbh;
2202 my $sth = $dbh->prepare(
2203 "SELECT subscription.subscriptionid, biblio.title
2205 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2206 JOIN subscriptionroutinglist USING (subscriptionid)
2207 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2210 $sth->execute($borrowernumber);
2213 while ( my $line = $sth->fetchrow_hashref ) {
2215 push( @routinglist, $line );
2217 return ( $count, @routinglist );
2221 =head2 GetFictiveIssueNumber
2223 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2225 Get the position of the issue published at $publisheddate, considering the
2226 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2227 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2228 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2229 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2230 depending on how many rows are in serial table.
2231 The issue number calculation is based on subscription frequency, first acquisition
2232 date, and $publisheddate.
2236 sub GetFictiveIssueNumber {
2237 my ($subscription, $publisheddate) = @_;
2239 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2240 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2244 my ($year, $month, $day) = split /-/, $publisheddate;
2245 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2249 if($unit eq 'day') {
2250 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2251 } elsif($unit eq 'week') {
2252 ($wkno, $year) = Week_of_Year($year, $month, $day);
2253 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2254 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2255 } elsif($unit eq 'month') {
2256 $delta = ($fa_year == $year)
2257 ? ($month - $fa_month)
2258 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2259 } elsif($unit eq 'year') {
2260 $delta = $year - $fa_year;
2262 if($frequency->{'unitsperissue'} == 1) {
2263 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2265 # Assuming issuesperunit == 1
2266 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2272 sub _get_next_date_day {
2273 my ($subscription, $freqdata, $year, $month, $day) = @_;
2275 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2276 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2277 $subscription->{countissuesperunit} = 1;
2279 $subscription->{countissuesperunit}++;
2282 return ($year, $month, $day);
2285 sub _get_next_date_week {
2286 my ($subscription, $freqdata, $year, $month, $day) = @_;
2288 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2289 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2291 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2292 $subscription->{countissuesperunit} = 1;
2293 $wkno += $freqdata->{unitsperissue};
2298 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2299 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2301 # Try to guess the next day of week
2302 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2303 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2304 $subscription->{countissuesperunit}++;
2307 return ($year, $month, $day);
2310 sub _get_next_date_month {
2311 my ($subscription, $freqdata, $year, $month, $day) = @_;
2314 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2316 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2317 $subscription->{countissuesperunit} = 1;
2318 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2319 $freqdata->{unitsperissue});
2320 my $days_in_month = Days_in_Month($year, $month);
2321 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2323 # Try to guess the next day in month
2324 my $days_in_month = Days_in_Month($year, $month);
2325 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2326 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2327 $subscription->{countissuesperunit}++;
2330 return ($year, $month, $day);
2333 sub _get_next_date_year {
2334 my ($subscription, $freqdata, $year, $month, $day) = @_;
2336 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2338 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2339 $subscription->{countissuesperunit} = 1;
2340 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2342 my $days_in_month = Days_in_Month($year, $month);
2343 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2345 # Try to guess the next day in year
2346 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2347 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2348 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2349 $subscription->{countissuesperunit}++;
2352 return ($year, $month, $day);
2357 $resultdate = GetNextDate($publisheddate,$subscription)
2359 this function it takes the publisheddate and will return the next issue's date
2360 and will skip dates if there exists an irregularity.
2361 $publisheddate has to be an ISO date
2362 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2363 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2364 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2365 skipped then the returned date will be 2007-05-10
2368 $resultdate - then next date in the sequence (ISO date)
2370 Return undef if subscription is irregular
2375 my ( $subscription, $publisheddate, $updatecount ) = @_;
2377 return unless $subscription and $publisheddate;
2379 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2381 if ($freqdata->{'unit'}) {
2382 my ( $year, $month, $day ) = split /-/, $publisheddate;
2384 # Process an irregularity Hash
2385 # Suppose that irregularities are stored in a string with this structure
2386 # irreg1;irreg2;irreg3
2387 # where irregX is the number of issue which will not be received
2388 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2390 if ( $subscription->{irregularity} ) {
2391 my @irreg = split /;/, $subscription->{'irregularity'} ;
2392 foreach my $irregularity (@irreg) {
2393 $irregularities{$irregularity} = 1;
2397 # Get the 'fictive' next issue number
2398 # It is used to check if next issue is an irregular issue.
2399 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2401 # Then get the next date
2402 my $unit = lc $freqdata->{'unit'};
2403 if ($unit eq 'day') {
2404 while ($irregularities{$issueno}) {
2405 ($year, $month, $day) = _get_next_date_day($subscription,
2406 $freqdata, $year, $month, $day);
2409 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2410 $year, $month, $day);
2412 elsif ($unit eq 'week') {
2413 while ($irregularities{$issueno}) {
2414 ($year, $month, $day) = _get_next_date_week($subscription,
2415 $freqdata, $year, $month, $day);
2418 ($year, $month, $day) = _get_next_date_week($subscription,
2419 $freqdata, $year, $month, $day);
2421 elsif ($unit eq 'month') {
2422 while ($irregularities{$issueno}) {
2423 ($year, $month, $day) = _get_next_date_month($subscription,
2424 $freqdata, $year, $month, $day);
2427 ($year, $month, $day) = _get_next_date_month($subscription,
2428 $freqdata, $year, $month, $day);
2430 elsif ($unit eq 'year') {
2431 while ($irregularities{$issueno}) {
2432 ($year, $month, $day) = _get_next_date_year($subscription,
2433 $freqdata, $year, $month, $day);
2436 ($year, $month, $day) = _get_next_date_year($subscription,
2437 $freqdata, $year, $month, $day);
2441 my $dbh = C4::Context->dbh;
2444 SET countissuesperunit = ?
2445 WHERE subscriptionid = ?
2447 my $sth = $dbh->prepare($query);
2448 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2451 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2457 $string = &_numeration($value,$num_type,$locale);
2459 _numeration returns the string corresponding to $value in the num_type
2472 my ($value, $num_type, $locale) = @_;
2477 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2478 # 1970-11-01 was a Sunday
2479 $value = $value % 7;
2480 my $dt = DateTime->new(
2486 $string = $num_type =~ /^dayname$/
2487 ? $dt->strftime("%A")
2488 : $dt->strftime("%a");
2489 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2490 $value = $value % 12;
2491 my $dt = DateTime->new(
2493 month => $value + 1,
2496 $string = $num_type =~ /^monthname$/
2497 ? $dt->strftime("%B")
2498 : $dt->strftime("%b");
2499 } elsif ( $num_type =~ /^season$/ ) {
2500 my @seasons= qw( Spring Summer Fall Winter );
2501 $value = $value % 4;
2502 $string = $seasons[$value];
2503 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2504 my @seasonsabrv= qw( Spr Sum Fal Win );
2505 $value = $value % 4;
2506 $string = $seasonsabrv[$value];
2514 =head2 is_barcode_in_use
2516 Returns number of occurrences of the barcode in the items table
2517 Can be used as a boolean test of whether the barcode has
2518 been deployed as yet
2522 sub is_barcode_in_use {
2523 my $barcode = shift;
2524 my $dbh = C4::Context->dbh;
2525 my $occurrences = $dbh->selectall_arrayref(
2526 'SELECT itemnumber from items where barcode = ?',
2531 return @{$occurrences};
2534 =head2 CloseSubscription
2535 Close a subscription given a subscriptionid
2537 sub CloseSubscription {
2538 my ( $subscriptionid ) = @_;
2539 return unless $subscriptionid;
2540 my $dbh = C4::Context->dbh;
2541 my $sth = $dbh->prepare( q{
2544 WHERE subscriptionid = ?
2546 $sth->execute( $subscriptionid );
2548 # Set status = missing when status = stopped
2549 $sth = $dbh->prepare( q{
2552 WHERE subscriptionid = ?
2555 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2558 =head2 ReopenSubscription
2559 Reopen a subscription given a subscriptionid
2561 sub ReopenSubscription {
2562 my ( $subscriptionid ) = @_;
2563 return unless $subscriptionid;
2564 my $dbh = C4::Context->dbh;
2565 my $sth = $dbh->prepare( q{
2568 WHERE subscriptionid = ?
2570 $sth->execute( $subscriptionid );
2572 # Set status = expected when status = stopped
2573 $sth = $dbh->prepare( q{
2576 WHERE subscriptionid = ?
2579 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2582 =head2 subscriptionCurrentlyOnOrder
2584 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2586 Return 1 if subscription is currently on order else 0.
2590 sub subscriptionCurrentlyOnOrder {
2591 my ( $subscriptionid ) = @_;
2592 my $dbh = C4::Context->dbh;
2594 SELECT COUNT(*) FROM aqorders
2595 WHERE subscriptionid = ?
2596 AND datereceived IS NULL
2597 AND datecancellationprinted IS NULL
2599 my $sth = $dbh->prepare( $query );
2600 $sth->execute($subscriptionid);
2601 return $sth->fetchrow_array;
2604 =head2 can_claim_subscription
2606 $can = can_claim_subscription( $subscriptionid[, $userid] );
2608 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2612 sub can_claim_subscription {
2613 my ( $subscription, $userid ) = @_;
2614 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2617 =head2 can_edit_subscription
2619 $can = can_edit_subscription( $subscriptionid[, $userid] );
2621 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2625 sub can_edit_subscription {
2626 my ( $subscription, $userid ) = @_;
2627 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2630 =head2 can_show_subscription
2632 $can = can_show_subscription( $subscriptionid[, $userid] );
2634 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2638 sub can_show_subscription {
2639 my ( $subscription, $userid ) = @_;
2640 return _can_do_on_subscription( $subscription, $userid, '*' );
2643 sub _can_do_on_subscription {
2644 my ( $subscription, $userid, $permission ) = @_;
2645 return 0 unless C4::Context->userenv;
2646 my $flags = C4::Context->userenv->{flags};
2647 $userid ||= C4::Context->userenv->{'id'};
2649 if ( C4::Context->preference('IndependentBranches') ) {
2651 if C4::Context->IsSuperLibrarian()
2653 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2655 C4::Auth::haspermission( $userid,
2656 { serials => $permission } )
2657 and ( not defined $subscription->{branchcode}
2658 or $subscription->{branchcode} eq ''
2659 or $subscription->{branchcode} eq
2660 C4::Context->userenv->{'branch'} )
2665 if C4::Context->IsSuperLibrarian()
2667 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2668 or C4::Auth::haspermission(
2669 $userid, { serials => $permission }
2676 =head2 findSerialsByStatus
2678 @serials = findSerialsByStatus($status, $subscriptionid);
2680 Returns an array of serials matching a given status and subscription id.
2684 sub findSerialsByStatus {
2685 my ( $status, $subscriptionid ) = @_;
2686 my $dbh = C4::Context->dbh;
2687 my $query = q| SELECT * from serial
2689 AND subscriptionid = ?
2691 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2700 Koha Development Team <http://koha-community.org/>