3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
33 use Koha::AdditionalField;
36 use Koha::Subscriptions;
37 use Koha::Subscription::Histories;
39 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
47 MISSING_NEVER_RECIEVED => 41,
48 MISSING_SOLD_OUT => 42,
49 MISSING_DAMAGED => 43,
57 use constant MISSING_STATUSES => (
58 MISSING, MISSING_NEVER_RECIEVED,
59 MISSING_SOLD_OUT, MISSING_DAMAGED,
67 &NewSubscription &ModSubscription &DelSubscription
68 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
70 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
71 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
72 &GetSubscriptionHistoryFromSubscriptionId
74 &GetNextSeq &GetSeq &NewIssue &GetSerials
75 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
76 &ReNewSubscription &GetLateOrMissingIssues
77 &GetSerialInformation &AddItem2Serial
78 &PrepareSerialsData &GetNextExpected &ModNextExpected
81 &GetSuppliersWithLateIssues &getsupplierbyserialid
82 &GetDistributedTo &SetDistributedTo
83 &getroutinglist &delroutingmember &addroutingmember
85 &check_routing &updateClaim
88 &GetSubscriptionsFromBorrower
89 &subscriptionCurrentlyOnOrder
96 C4::Serials - Serials Module Functions
104 Functions for handling subscriptions, claims routing etc.
109 =head2 GetSuppliersWithLateIssues
111 $supplierlist = GetSuppliersWithLateIssues()
113 this function get all suppliers with late issues.
116 an array_ref of suppliers each entry is a hash_ref containing id and name
117 the array is in name order
121 sub GetSuppliersWithLateIssues {
122 my $dbh = C4::Context->dbh;
123 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
125 SELECT DISTINCT id, name
127 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
128 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
131 (planneddate < now() AND serial.status=1)
132 OR serial.STATUS IN ( $statuses )
134 AND subscription.closed = 0
136 return $dbh->selectall_arrayref($query, { Slice => {} });
139 =head2 GetSubscriptionHistoryFromSubscriptionId
141 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
143 This function returns the subscription history as a hashref
147 sub GetSubscriptionHistoryFromSubscriptionId {
148 my ($subscriptionid) = @_;
150 return unless $subscriptionid;
152 my $dbh = C4::Context->dbh;
155 FROM subscriptionhistory
156 WHERE subscriptionid = ?
158 my $sth = $dbh->prepare($query);
159 $sth->execute($subscriptionid);
160 my $results = $sth->fetchrow_hashref;
166 =head2 GetSerialStatusFromSerialId
168 $sth = GetSerialStatusFromSerialId();
169 this function returns a statement handle
170 After this function, don't forget to execute it by using $sth->execute($serialid)
172 $sth = $dbh->prepare($query).
176 sub GetSerialStatusFromSerialId {
177 my $dbh = C4::Context->dbh;
183 return $dbh->prepare($query);
186 =head2 GetSerialInformation
188 $data = GetSerialInformation($serialid);
189 returns a hash_ref containing :
190 items : items marcrecord (can be an array)
192 subscription table field
193 + information about subscription expiration
197 sub GetSerialInformation {
199 my $dbh = C4::Context->dbh;
201 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
202 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
205 my $rq = $dbh->prepare($query);
206 $rq->execute($serialid);
207 my $data = $rq->fetchrow_hashref;
209 # create item information if we have serialsadditems for this subscription
210 if ( $data->{'serialsadditems'} ) {
211 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
212 $queryitem->execute($serialid);
213 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
215 if ( scalar(@$itemnumbers) > 0 ) {
216 foreach my $itemnum (@$itemnumbers) {
218 #It is ASSUMED that GetMarcItem ALWAYS WORK...
219 #Maybe GetMarcItem should return values on failure
220 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
221 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
222 $itemprocessed->{'itemnumber'} = $itemnum->[0];
223 $itemprocessed->{'itemid'} = $itemnum->[0];
224 $itemprocessed->{'serialid'} = $serialid;
225 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
226 push @{ $data->{'items'} }, $itemprocessed;
229 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
230 $itemprocessed->{'itemid'} = "N$serialid";
231 $itemprocessed->{'serialid'} = $serialid;
232 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
233 $itemprocessed->{'countitems'} = 0;
234 push @{ $data->{'items'} }, $itemprocessed;
237 $data->{ "status" . $data->{'serstatus'} } = 1;
238 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
239 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
240 $data->{cannotedit} = not can_edit_subscription( $data );
244 =head2 AddItem2Serial
246 $rows = AddItem2Serial($serialid,$itemnumber);
247 Adds an itemnumber to Serial record
248 returns the number of rows affected
253 my ( $serialid, $itemnumber ) = @_;
255 return unless ($serialid and $itemnumber);
257 my $dbh = C4::Context->dbh;
258 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
259 $rq->execute( $serialid, $itemnumber );
263 =head2 GetSubscription
265 $subs = GetSubscription($subscriptionid)
266 this function returns the subscription which has $subscriptionid as id.
268 a hashref. This hash containts
269 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
273 sub GetSubscription {
274 my ($subscriptionid) = @_;
275 my $dbh = C4::Context->dbh;
277 SELECT subscription.*,
278 subscriptionhistory.*,
279 aqbooksellers.name AS aqbooksellername,
280 biblio.title AS bibliotitle,
281 subscription.biblionumber as bibnum
283 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
284 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
285 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
286 WHERE subscription.subscriptionid = ?
289 $debug and warn "query : $query\nsubsid :$subscriptionid";
290 my $sth = $dbh->prepare($query);
291 $sth->execute($subscriptionid);
292 my $subscription = $sth->fetchrow_hashref;
294 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
296 # Add additional fields to the subscription into a new key "additional_fields"
297 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
298 tablename => 'subscription',
299 record_id => $subscriptionid,
301 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
303 return $subscription;
306 =head2 GetFullSubscription
308 $array_ref = GetFullSubscription($subscriptionid)
309 this function reads the serial table.
313 sub GetFullSubscription {
314 my ($subscriptionid) = @_;
316 return unless ($subscriptionid);
318 my $dbh = C4::Context->dbh;
320 SELECT serial.serialid,
323 serial.publisheddate,
324 serial.publisheddatetext,
326 serial.notes as notes,
327 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
328 aqbooksellers.name as aqbooksellername,
329 biblio.title as bibliotitle,
330 subscription.branchcode AS branchcode,
331 subscription.subscriptionid AS subscriptionid
333 LEFT JOIN subscription ON
334 (serial.subscriptionid=subscription.subscriptionid )
335 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
336 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
337 WHERE serial.subscriptionid = ?
339 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
340 serial.subscriptionid
342 $debug and warn "GetFullSubscription query: $query";
343 my $sth = $dbh->prepare($query);
344 $sth->execute($subscriptionid);
345 my $subscriptions = $sth->fetchall_arrayref( {} );
346 for my $subscription ( @$subscriptions ) {
347 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
349 return $subscriptions;
352 =head2 PrepareSerialsData
354 $array_ref = PrepareSerialsData($serialinfomation)
355 where serialinformation is a hashref array
359 sub PrepareSerialsData {
362 return unless ($lines);
368 my $aqbooksellername;
372 my $previousnote = "";
374 foreach my $subs (@{$lines}) {
375 for my $datefield ( qw(publisheddate planneddate) ) {
376 # handle 0000-00-00 dates
377 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
378 $subs->{$datefield} = undef;
381 $subs->{ "status" . $subs->{'status'} } = 1;
382 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
383 $subs->{"checked"} = 1;
386 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
387 $year = $subs->{'year'};
391 if ( $tmpresults{$year} ) {
392 push @{ $tmpresults{$year}->{'serials'} }, $subs;
394 $tmpresults{$year} = {
396 'aqbooksellername' => $subs->{'aqbooksellername'},
397 'bibliotitle' => $subs->{'bibliotitle'},
398 'serials' => [$subs],
403 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
404 push @res, $tmpresults{$key};
409 =head2 GetSubscriptionsFromBiblionumber
411 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
412 this function get the subscription list. it reads the subscription table.
414 reference to an array of subscriptions which have the biblionumber given on input arg.
415 each element of this array is a hashref containing
416 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
420 sub GetSubscriptionsFromBiblionumber {
421 my ($biblionumber) = @_;
423 return unless ($biblionumber);
425 my $dbh = C4::Context->dbh;
427 SELECT subscription.*,
429 subscriptionhistory.*,
430 aqbooksellers.name AS aqbooksellername,
431 biblio.title AS bibliotitle
433 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
434 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
435 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
436 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
437 WHERE subscription.biblionumber = ?
439 my $sth = $dbh->prepare($query);
440 $sth->execute($biblionumber);
442 while ( my $subs = $sth->fetchrow_hashref ) {
443 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
444 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
445 $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 GetPreviousSerialid
810 $serialid = GetPreviousSerialid($subscriptionid, $nth)
811 get the $nth's previous serial for the given subscriptionid
817 sub GetPreviousSerialid {
818 my ( $subscriptionid, $nth ) = @_;
820 my $dbh = C4::Context->dbh;
824 my $strsth = "SELECT serialid
826 WHERE subscriptionid = ?
828 ORDER BY serialid DESC LIMIT $nth,1
830 my $sth = $dbh->prepare($strsth);
831 $sth->execute($subscriptionid);
833 my $line = $sth->fetchrow_hashref;
834 $return = $line->{'serialid'} if ($line);
841 =head2 GetDistributedTo
843 $distributedto=GetDistributedTo($subscriptionid)
844 This function returns the field distributedto for the subscription matching subscriptionid
848 sub GetDistributedTo {
849 my $dbh = C4::Context->dbh;
851 my ($subscriptionid) = @_;
853 return unless ($subscriptionid);
855 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
856 my $sth = $dbh->prepare($query);
857 $sth->execute($subscriptionid);
858 return ($distributedto) = $sth->fetchrow;
864 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
865 $newinnerloop1, $newinnerloop2, $newinnerloop3
866 ) = GetNextSeq( $subscription, $pattern, $planneddate );
868 $subscription is a hashref containing all the attributes of the table
870 $pattern is a hashref containing all the attributes of the table
871 'subscription_numberpatterns'.
872 $planneddate is a date string in iso format.
873 This function get the next issue for the subscription given on input arg
878 my ($subscription, $pattern, $planneddate) = @_;
880 return unless ($subscription and $pattern);
882 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
883 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
886 if ($subscription->{'skip_serialseq'}) {
887 my @irreg = split /;/, $subscription->{'irregularity'};
889 my $irregularities = {};
890 $irregularities->{$_} = 1 foreach(@irreg);
891 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
892 while($irregularities->{$issueno}) {
899 my $numberingmethod = $pattern->{numberingmethod};
901 if ($numberingmethod) {
902 $calculated = $numberingmethod;
903 my $locale = $subscription->{locale};
904 $newlastvalue1 = $subscription->{lastvalue1} || 0;
905 $newlastvalue2 = $subscription->{lastvalue2} || 0;
906 $newlastvalue3 = $subscription->{lastvalue3} || 0;
907 $newinnerloop1 = $subscription->{innerloop1} || 0;
908 $newinnerloop2 = $subscription->{innerloop2} || 0;
909 $newinnerloop3 = $subscription->{innerloop3} || 0;
912 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
915 for(my $i = 0; $i < $count; $i++) {
917 # check if we have to increase the new value.
919 if ($newinnerloop1 >= $pattern->{every1}) {
921 $newlastvalue1 += $pattern->{add1};
923 # reset counter if needed.
924 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
927 # check if we have to increase the new value.
929 if ($newinnerloop2 >= $pattern->{every2}) {
931 $newlastvalue2 += $pattern->{add2};
933 # reset counter if needed.
934 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
937 # check if we have to increase the new value.
939 if ($newinnerloop3 >= $pattern->{every3}) {
941 $newlastvalue3 += $pattern->{add3};
943 # reset counter if needed.
944 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
948 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
949 $calculated =~ s/\{X\}/$newlastvalue1string/g;
952 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
953 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
956 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
957 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
962 $newlastvalue1, $newlastvalue2, $newlastvalue3,
963 $newinnerloop1, $newinnerloop2, $newinnerloop3);
968 $calculated = GetSeq($subscription, $pattern)
969 $subscription is a hashref containing all the attributes of the table 'subscription'
970 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
971 this function transforms {X},{Y},{Z} to 150,0,0 for example.
973 the sequence in string format
978 my ($subscription, $pattern) = @_;
980 return unless ($subscription and $pattern);
982 my $locale = $subscription->{locale};
984 my $calculated = $pattern->{numberingmethod};
986 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
987 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
988 $calculated =~ s/\{X\}/$newlastvalue1/g;
990 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
991 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
992 $calculated =~ s/\{Y\}/$newlastvalue2/g;
994 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
995 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
996 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1000 =head2 GetExpirationDate
1002 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1004 this function return the next expiration date for a subscription given on input args.
1007 the enddate or undef
1011 sub GetExpirationDate {
1012 my ( $subscriptionid, $startdate ) = @_;
1014 return unless ($subscriptionid);
1016 my $dbh = C4::Context->dbh;
1017 my $subscription = GetSubscription($subscriptionid);
1020 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1021 $enddate = $startdate || $subscription->{startdate};
1022 my @date = split( /-/, $enddate );
1024 return if ( scalar(@date) != 3 || not check_date(@date) );
1026 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1027 if ( $frequency and $frequency->{unit} ) {
1030 if ( my $length = $subscription->{numberlength} ) {
1032 #calculate the date of the last issue.
1033 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1034 $enddate = GetNextDate( $subscription, $enddate );
1036 } elsif ( $subscription->{monthlength} ) {
1037 if ( $$subscription{startdate} ) {
1038 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1039 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1041 } elsif ( $subscription->{weeklength} ) {
1042 if ( $$subscription{startdate} ) {
1043 my @date = split( /-/, $subscription->{startdate} );
1044 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1045 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1048 $enddate = $subscription->{enddate};
1052 return $subscription->{enddate};
1056 =head2 CountSubscriptionFromBiblionumber
1058 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1059 this returns a count of the subscriptions for a given biblionumber
1061 the number of subscriptions
1065 sub CountSubscriptionFromBiblionumber {
1066 my ($biblionumber) = @_;
1068 return unless ($biblionumber);
1070 my $dbh = C4::Context->dbh;
1071 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1072 my $sth = $dbh->prepare($query);
1073 $sth->execute($biblionumber);
1074 my $subscriptionsnumber = $sth->fetchrow;
1075 return $subscriptionsnumber;
1078 =head2 ModSubscriptionHistory
1080 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1082 this function modifies the history of a subscription. Put your new values on input arg.
1083 returns the number of rows affected
1087 sub ModSubscriptionHistory {
1088 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1090 return unless ($subscriptionid);
1092 my $dbh = C4::Context->dbh;
1093 my $query = "UPDATE subscriptionhistory
1094 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1095 WHERE subscriptionid=?
1097 my $sth = $dbh->prepare($query);
1098 $receivedlist =~ s/^; // if $receivedlist;
1099 $missinglist =~ s/^; // if $missinglist;
1100 $opacnote =~ s/^; // if $opacnote;
1101 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1105 =head2 ModSerialStatus
1107 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1108 $publisheddatetext, $status, $notes);
1110 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1111 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1115 sub ModSerialStatus {
1116 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1117 $status, $notes) = @_;
1119 return unless ($serialid);
1121 #It is a usual serial
1122 # 1st, get previous status :
1123 my $dbh = C4::Context->dbh;
1124 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1125 FROM serial, subscription
1126 WHERE serial.subscriptionid=subscription.subscriptionid
1128 my $sth = $dbh->prepare($query);
1129 $sth->execute($serialid);
1130 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1131 my $frequency = GetSubscriptionFrequency($periodicity);
1133 # change status & update subscriptionhistory
1135 if ( $status == DELETED ) {
1136 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1141 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1142 planneddate = ?, status = ?, notes = ?
1145 $sth = $dbh->prepare($query);
1146 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1147 $planneddate, $status, $notes, $serialid );
1148 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1149 $sth = $dbh->prepare($query);
1150 $sth->execute($subscriptionid);
1151 my $val = $sth->fetchrow_hashref;
1152 unless ( $val->{manualhistory} ) {
1153 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1154 $sth = $dbh->prepare($query);
1155 $sth->execute($subscriptionid);
1156 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1158 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1159 $recievedlist .= "; $serialseq"
1160 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1163 # in case serial has been previously marked as missing
1164 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1165 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1168 $missinglist .= "; $serialseq"
1169 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1170 $missinglist .= "; not issued $serialseq"
1171 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1173 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1174 $sth = $dbh->prepare($query);
1175 $recievedlist =~ s/^; //;
1176 $missinglist =~ s/^; //;
1177 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1181 # create new expected entry if needed (ie : was "expected" and has changed)
1182 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1183 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1184 my $subscription = GetSubscription($subscriptionid);
1185 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1189 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1190 $newinnerloop1, $newinnerloop2, $newinnerloop3
1192 = GetNextSeq( $subscription, $pattern, $publisheddate );
1194 # next date (calculated from actual date & frequency parameters)
1195 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1196 my $nextpubdate = $nextpublisheddate;
1197 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1198 WHERE subscriptionid = ?";
1199 $sth = $dbh->prepare($query);
1200 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1202 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1204 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1205 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1206 require C4::Letters;
1207 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1214 =head2 GetNextExpected
1216 $nextexpected = GetNextExpected($subscriptionid)
1218 Get the planneddate for the current expected issue of the subscription.
1224 planneddate => ISO date
1229 sub GetNextExpected {
1230 my ($subscriptionid) = @_;
1232 my $dbh = C4::Context->dbh;
1236 WHERE subscriptionid = ?
1240 my $sth = $dbh->prepare($query);
1242 # Each subscription has only one 'expected' issue.
1243 $sth->execute( $subscriptionid, EXPECTED );
1244 my $nextissue = $sth->fetchrow_hashref;
1245 if ( !$nextissue ) {
1249 WHERE subscriptionid = ?
1250 ORDER BY publisheddate DESC
1253 $sth = $dbh->prepare($query);
1254 $sth->execute($subscriptionid);
1255 $nextissue = $sth->fetchrow_hashref;
1257 foreach(qw/planneddate publisheddate/) {
1258 if ( !defined $nextissue->{$_} ) {
1259 # or should this default to 1st Jan ???
1260 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1262 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1270 =head2 ModNextExpected
1272 ModNextExpected($subscriptionid,$date)
1274 Update the planneddate for the current expected issue of the subscription.
1275 This will modify all future prediction results.
1277 C<$date> is an ISO date.
1283 sub ModNextExpected {
1284 my ( $subscriptionid, $date ) = @_;
1285 my $dbh = C4::Context->dbh;
1287 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1288 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1290 # Each subscription has only one 'expected' issue.
1291 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1296 =head2 GetSubscriptionIrregularities
1300 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1301 get the list of irregularities for a subscription
1307 sub GetSubscriptionIrregularities {
1308 my $subscriptionid = shift;
1310 return unless $subscriptionid;
1312 my $dbh = C4::Context->dbh;
1316 WHERE subscriptionid = ?
1318 my $sth = $dbh->prepare($query);
1319 $sth->execute($subscriptionid);
1321 my ($result) = $sth->fetchrow_array;
1322 my @irreg = split /;/, $result;
1327 =head2 ModSubscription
1329 this function modifies a subscription. Put all new values on input args.
1330 returns the number of rows affected
1334 sub ModSubscription {
1336 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1337 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1338 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1339 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1340 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1341 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1342 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1343 $itemtype, $previousitemtype
1346 my $dbh = C4::Context->dbh;
1347 my $query = "UPDATE subscription
1348 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1349 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1350 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1351 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1352 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1353 callnumber=?, notes=?, letter=?, manualhistory=?,
1354 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1355 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1356 skip_serialseq=?, itemtype=?, previousitemtype=?
1357 WHERE subscriptionid = ?";
1359 my $sth = $dbh->prepare($query);
1361 $auser, $branchcode, $aqbooksellerid, $cost,
1362 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1363 $irregularity, $numberpattern, $locale, $numberlength,
1364 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1365 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1366 $status, $biblionumber, $callnumber, $notes,
1367 $letter, ($manualhistory ? $manualhistory : 0),
1368 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1369 $graceperiod, $location, $enddate, $skip_serialseq,
1370 $itemtype, $previousitemtype,
1373 my $rows = $sth->rows;
1375 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1379 =head2 NewSubscription
1381 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1382 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1383 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1384 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1385 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1386 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1387 $skip_serialseq, $itemtype, $previousitemtype);
1389 Create a new subscription with value given on input args.
1392 the id of this new subscription
1396 sub NewSubscription {
1398 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1399 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1400 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1401 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1402 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1403 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1404 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1406 my $dbh = C4::Context->dbh;
1408 #save subscription (insert into database)
1410 INSERT INTO subscription
1411 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1412 biblionumber, startdate, periodicity, numberlength, weeklength,
1413 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1414 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1415 irregularity, numberpattern, locale, callnumber,
1416 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1417 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1418 itemtype, previousitemtype)
1419 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1421 my $sth = $dbh->prepare($query);
1423 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1424 $startdate, $periodicity, $numberlength, $weeklength,
1425 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1426 $lastvalue3, $innerloop3, $status, $notes, $letter,
1427 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1428 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1429 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1430 $itemtype, $previousitemtype
1433 my $subscriptionid = $dbh->{'mysql_insertid'};
1435 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1439 WHERE subscriptionid=?
1441 $sth = $dbh->prepare($query);
1442 $sth->execute( $enddate, $subscriptionid );
1445 # then create the 1st expected number
1447 INSERT INTO subscriptionhistory
1448 (biblionumber, subscriptionid, histstartdate)
1451 $sth = $dbh->prepare($query);
1452 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1454 # reread subscription to get a hash (for calculation of the 1st issue number)
1455 my $subscription = GetSubscription($subscriptionid);
1456 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1458 # calculate issue number
1459 my $serialseq = GetSeq($subscription, $pattern) || q{};
1463 serialseq => $serialseq,
1464 serialseq_x => $subscription->{'lastvalue1'},
1465 serialseq_y => $subscription->{'lastvalue2'},
1466 serialseq_z => $subscription->{'lastvalue3'},
1467 subscriptionid => $subscriptionid,
1468 biblionumber => $biblionumber,
1470 planneddate => $firstacquidate,
1471 publisheddate => $firstacquidate,
1475 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1477 #set serial flag on biblio if not already set.
1478 my $bib = GetBiblio($biblionumber);
1479 if ( $bib and !$bib->{'serial'} ) {
1480 my $record = GetMarcBiblio($biblionumber);
1481 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1483 eval { $record->field($tag)->update( $subf => 1 ); };
1485 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1487 return $subscriptionid;
1490 =head2 ReNewSubscription
1492 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1494 this function renew a subscription with values given on input args.
1498 sub ReNewSubscription {
1499 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1500 my $dbh = C4::Context->dbh;
1501 my $subscription = GetSubscription($subscriptionid);
1505 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1506 WHERE biblio.biblionumber=?
1508 my $sth = $dbh->prepare($query);
1509 $sth->execute( $subscription->{biblionumber} );
1510 my $biblio = $sth->fetchrow_hashref;
1512 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1513 require C4::Suggestions;
1514 C4::Suggestions::NewSuggestion(
1515 { 'suggestedby' => $user,
1516 'title' => $subscription->{bibliotitle},
1517 'author' => $biblio->{author},
1518 'publishercode' => $biblio->{publishercode},
1519 'note' => $biblio->{note},
1520 'biblionumber' => $subscription->{biblionumber}
1525 # renew subscription
1528 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1529 WHERE subscriptionid=?
1531 $sth = $dbh->prepare($query);
1532 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1533 my $enddate = GetExpirationDate($subscriptionid);
1534 $debug && warn "enddate :$enddate";
1538 WHERE subscriptionid=?
1540 $sth = $dbh->prepare($query);
1541 $sth->execute( $enddate, $subscriptionid );
1543 UPDATE subscriptionhistory
1545 WHERE subscriptionid=?
1547 $sth = $dbh->prepare($query);
1548 $sth->execute( $enddate, $subscriptionid );
1550 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1556 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1558 Create a new issue stored on the database.
1559 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1560 returns the serial id
1565 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1566 $publisheddate, $publisheddatetext, $notes ) = @_;
1567 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1569 return unless ($subscriptionid);
1571 my $schema = Koha::Database->new()->schema();
1573 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1575 my $serial = Koha::Serial->new(
1577 serialseq => $serialseq,
1578 serialseq_x => $subscription->lastvalue1(),
1579 serialseq_y => $subscription->lastvalue2(),
1580 serialseq_z => $subscription->lastvalue3(),
1581 subscriptionid => $subscriptionid,
1582 biblionumber => $biblionumber,
1584 planneddate => $planneddate,
1585 publisheddate => $publisheddate,
1586 publisheddatetext => $publisheddatetext,
1591 my $serialid = $serial->id();
1593 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1594 my $missinglist = $subscription_history->missinglist();
1595 my $recievedlist = $subscription_history->recievedlist();
1597 if ( $status == ARRIVED ) {
1598 ### TODO Add a feature that improves recognition and description.
1599 ### As such count (serialseq) i.e. : N18,2(N19),N20
1600 ### Would use substr and index But be careful to previous presence of ()
1601 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1603 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1604 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1607 $recievedlist =~ s/^; //;
1608 $missinglist =~ s/^; //;
1610 $subscription_history->recievedlist($recievedlist);
1611 $subscription_history->missinglist($missinglist);
1612 $subscription_history->store();
1617 =head2 HasSubscriptionStrictlyExpired
1619 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1621 the subscription has stricly expired when today > the end subscription date
1624 1 if true, 0 if false, -1 if the expiration date is not set.
1628 sub HasSubscriptionStrictlyExpired {
1630 # Getting end of subscription date
1631 my ($subscriptionid) = @_;
1633 return unless ($subscriptionid);
1635 my $dbh = C4::Context->dbh;
1636 my $subscription = GetSubscription($subscriptionid);
1637 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1639 # If the expiration date is set
1640 if ( $expirationdate != 0 ) {
1641 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1643 # Getting today's date
1644 my ( $nowyear, $nowmonth, $nowday ) = Today();
1646 # if today's date > expiration date, then the subscription has stricly expired
1647 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1654 # There are some cases where the expiration date is not set
1655 # As we can't determine if the subscription has expired on a date-basis,
1661 =head2 HasSubscriptionExpired
1663 $has_expired = HasSubscriptionExpired($subscriptionid)
1665 the subscription has expired when the next issue to arrive is out of subscription limit.
1668 0 if the subscription has not expired
1669 1 if the subscription has expired
1670 2 if has subscription does not have a valid expiration date set
1674 sub HasSubscriptionExpired {
1675 my ($subscriptionid) = @_;
1677 return unless ($subscriptionid);
1679 my $dbh = C4::Context->dbh;
1680 my $subscription = GetSubscription($subscriptionid);
1681 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1682 if ( $frequency and $frequency->{unit} ) {
1683 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1684 if (!defined $expirationdate) {
1685 $expirationdate = q{};
1688 SELECT max(planneddate)
1690 WHERE subscriptionid=?
1692 my $sth = $dbh->prepare($query);
1693 $sth->execute($subscriptionid);
1694 my ($res) = $sth->fetchrow;
1695 if (!$res || $res=~m/^0000/) {
1698 my @res = split( /-/, $res );
1699 my @endofsubscriptiondate = split( /-/, $expirationdate );
1700 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1702 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1707 if ( $subscription->{'numberlength'} ) {
1708 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1709 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1715 return 0; # Notice that you'll never get here.
1718 =head2 SetDistributedto
1720 SetDistributedto($distributedto,$subscriptionid);
1721 This function update the value of distributedto for a subscription given on input arg.
1725 sub SetDistributedto {
1726 my ( $distributedto, $subscriptionid ) = @_;
1727 my $dbh = C4::Context->dbh;
1731 WHERE subscriptionid=?
1733 my $sth = $dbh->prepare($query);
1734 $sth->execute( $distributedto, $subscriptionid );
1738 =head2 DelSubscription
1740 DelSubscription($subscriptionid)
1741 this function deletes subscription which has $subscriptionid as id.
1745 sub DelSubscription {
1746 my ($subscriptionid) = @_;
1747 my $dbh = C4::Context->dbh;
1748 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1749 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1750 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1752 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1753 foreach my $af (@$afs) {
1754 $af->delete_values({record_id => $subscriptionid});
1757 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1762 DelIssue($serialseq,$subscriptionid)
1763 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1765 returns the number of rows affected
1770 my ($dataissue) = @_;
1771 my $dbh = C4::Context->dbh;
1772 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1777 AND subscriptionid= ?
1779 my $mainsth = $dbh->prepare($query);
1780 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1782 #Delete element from subscription history
1783 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1784 my $sth = $dbh->prepare($query);
1785 $sth->execute( $dataissue->{'subscriptionid'} );
1786 my $val = $sth->fetchrow_hashref;
1787 unless ( $val->{manualhistory} ) {
1789 SELECT * FROM subscriptionhistory
1790 WHERE subscriptionid= ?
1792 my $sth = $dbh->prepare($query);
1793 $sth->execute( $dataissue->{'subscriptionid'} );
1794 my $data = $sth->fetchrow_hashref;
1795 my $serialseq = $dataissue->{'serialseq'};
1796 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1797 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1798 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1799 $sth = $dbh->prepare($strsth);
1800 $sth->execute( $dataissue->{'subscriptionid'} );
1803 return $mainsth->rows;
1806 =head2 GetLateOrMissingIssues
1808 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1810 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1813 the issuelist as an array of hash refs. Each element of this array contains
1814 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1818 sub GetLateOrMissingIssues {
1819 my ( $supplierid, $serialid, $order ) = @_;
1821 return unless ( $supplierid or $serialid );
1823 my $dbh = C4::Context->dbh;
1828 $byserial = "and serialid = " . $serialid;
1831 $order .= ", title";
1835 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1837 $sth = $dbh->prepare(
1839 serialid, aqbooksellerid, name,
1840 biblio.title, biblioitems.issn, planneddate, serialseq,
1841 serial.status, serial.subscriptionid, claimdate, claims_count,
1842 subscription.branchcode
1844 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1845 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1846 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1847 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1848 WHERE subscription.subscriptionid = serial.subscriptionid
1849 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1850 AND subscription.aqbooksellerid=$supplierid
1855 $sth = $dbh->prepare(
1857 serialid, aqbooksellerid, name,
1858 biblio.title, planneddate, serialseq,
1859 serial.status, serial.subscriptionid, claimdate, claims_count,
1860 subscription.branchcode
1862 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1863 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1864 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1865 WHERE subscription.subscriptionid = serial.subscriptionid
1866 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1871 $sth->execute( EXPECTED, LATE, CLAIMED );
1873 while ( my $line = $sth->fetchrow_hashref ) {
1875 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1876 $line->{planneddateISO} = $line->{planneddate};
1877 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1879 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1880 $line->{claimdateISO} = $line->{claimdate};
1881 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1883 $line->{"status".$line->{status}} = 1;
1885 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1886 record_id => $line->{subscriptionid},
1887 tablename => 'subscription'
1889 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1891 push @issuelist, $line;
1898 &updateClaim($serialid)
1900 this function updates the time when a claim is issued for late/missing items
1902 called from claims.pl file
1907 my ($serialids) = @_;
1908 return unless $serialids;
1909 unless ( ref $serialids ) {
1910 $serialids = [ $serialids ];
1912 my $dbh = C4::Context->dbh;
1915 SET claimdate = NOW(),
1916 claims_count = claims_count + 1,
1918 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1919 {}, CLAIMED, @$serialids );
1922 =head2 getsupplierbyserialid
1924 $result = getsupplierbyserialid($serialid)
1926 this function is used to find the supplier id given a serial id
1929 hashref containing serialid, subscriptionid, and aqbooksellerid
1933 sub getsupplierbyserialid {
1934 my ($serialid) = @_;
1935 my $dbh = C4::Context->dbh;
1936 my $sth = $dbh->prepare(
1937 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1939 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1943 $sth->execute($serialid);
1944 my $line = $sth->fetchrow_hashref;
1945 my $result = $line->{'aqbooksellerid'};
1949 =head2 check_routing
1951 $result = &check_routing($subscriptionid)
1953 this function checks to see if a serial has a routing list and returns the count of routingid
1954 used to show either an 'add' or 'edit' link
1959 my ($subscriptionid) = @_;
1961 return unless ($subscriptionid);
1963 my $dbh = C4::Context->dbh;
1964 my $sth = $dbh->prepare(
1965 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1966 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1967 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1970 $sth->execute($subscriptionid);
1971 my $line = $sth->fetchrow_hashref;
1972 my $result = $line->{'routingids'};
1976 =head2 addroutingmember
1978 addroutingmember($borrowernumber,$subscriptionid)
1980 this function takes a borrowernumber and subscriptionid and adds the member to the
1981 routing list for that serial subscription and gives them a rank on the list
1982 of either 1 or highest current rank + 1
1986 sub addroutingmember {
1987 my ( $borrowernumber, $subscriptionid ) = @_;
1989 return unless ($borrowernumber and $subscriptionid);
1992 my $dbh = C4::Context->dbh;
1993 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1994 $sth->execute($subscriptionid);
1995 while ( my $line = $sth->fetchrow_hashref ) {
1996 if ( $line->{'rank'} > 0 ) {
1997 $rank = $line->{'rank'} + 1;
2002 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2003 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2006 =head2 reorder_members
2008 reorder_members($subscriptionid,$routingid,$rank)
2010 this function is used to reorder the routing list
2012 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2013 - it gets all members on list puts their routingid's into an array
2014 - removes the one in the array that is $routingid
2015 - then reinjects $routingid at point indicated by $rank
2016 - then update the database with the routingids in the new order
2020 sub reorder_members {
2021 my ( $subscriptionid, $routingid, $rank ) = @_;
2022 my $dbh = C4::Context->dbh;
2023 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2024 $sth->execute($subscriptionid);
2026 while ( my $line = $sth->fetchrow_hashref ) {
2027 push( @result, $line->{'routingid'} );
2030 # To find the matching index
2032 my $key = -1; # to allow for 0 being a valid response
2033 for ( $i = 0 ; $i < @result ; $i++ ) {
2034 if ( $routingid == $result[$i] ) {
2035 $key = $i; # save the index
2040 # if index exists in array then move it to new position
2041 if ( $key > -1 && $rank > 0 ) {
2042 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2043 my $moving_item = splice( @result, $key, 1 );
2044 splice( @result, $new_rank, 0, $moving_item );
2046 for ( my $j = 0 ; $j < @result ; $j++ ) {
2047 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2053 =head2 delroutingmember
2055 delroutingmember($routingid,$subscriptionid)
2057 this function either deletes one member from routing list if $routingid exists otherwise
2058 deletes all members from the routing list
2062 sub delroutingmember {
2064 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2065 my ( $routingid, $subscriptionid ) = @_;
2066 my $dbh = C4::Context->dbh;
2068 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2069 $sth->execute($routingid);
2070 reorder_members( $subscriptionid, $routingid );
2072 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2073 $sth->execute($subscriptionid);
2078 =head2 getroutinglist
2080 @routinglist = getroutinglist($subscriptionid)
2082 this gets the info from the subscriptionroutinglist for $subscriptionid
2085 the routinglist as an array. Each element of the array contains a hash_ref containing
2086 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2090 sub getroutinglist {
2091 my ($subscriptionid) = @_;
2092 my $dbh = C4::Context->dbh;
2093 my $sth = $dbh->prepare(
2094 'SELECT routingid, borrowernumber, ranking, biblionumber
2096 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2097 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2099 $sth->execute($subscriptionid);
2100 my $routinglist = $sth->fetchall_arrayref({});
2101 return @{$routinglist};
2104 =head2 countissuesfrom
2106 $result = countissuesfrom($subscriptionid,$startdate)
2108 Returns a count of serial rows matching the given subsctiptionid
2109 with published date greater than startdate
2113 sub countissuesfrom {
2114 my ( $subscriptionid, $startdate ) = @_;
2115 my $dbh = C4::Context->dbh;
2119 WHERE subscriptionid=?
2120 AND serial.publisheddate>?
2122 my $sth = $dbh->prepare($query);
2123 $sth->execute( $subscriptionid, $startdate );
2124 my ($countreceived) = $sth->fetchrow;
2125 return $countreceived;
2130 $result = CountIssues($subscriptionid)
2132 Returns a count of serial rows matching the given subsctiptionid
2137 my ($subscriptionid) = @_;
2138 my $dbh = C4::Context->dbh;
2142 WHERE subscriptionid=?
2144 my $sth = $dbh->prepare($query);
2145 $sth->execute($subscriptionid);
2146 my ($countreceived) = $sth->fetchrow;
2147 return $countreceived;
2152 $result = HasItems($subscriptionid)
2154 returns a count of items from serial matching the subscriptionid
2159 my ($subscriptionid) = @_;
2160 my $dbh = C4::Context->dbh;
2162 SELECT COUNT(serialitems.itemnumber)
2164 LEFT JOIN serialitems USING(serialid)
2165 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2167 my $sth=$dbh->prepare($query);
2168 $sth->execute($subscriptionid);
2169 my ($countitems)=$sth->fetchrow_array();
2173 =head2 abouttoexpire
2175 $result = abouttoexpire($subscriptionid)
2177 this function alerts you to the penultimate issue for a serial subscription
2179 returns 1 - if this is the penultimate issue
2185 my ($subscriptionid) = @_;
2186 my $dbh = C4::Context->dbh;
2187 my $subscription = GetSubscription($subscriptionid);
2188 my $per = $subscription->{'periodicity'};
2189 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2190 if ($frequency and $frequency->{unit}){
2192 my $expirationdate = GetExpirationDate($subscriptionid);
2194 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2195 my $nextdate = GetNextDate($subscription, $res);
2197 # only compare dates if both dates exist.
2198 if ($nextdate and $expirationdate) {
2199 if(Date::Calc::Delta_Days(
2200 split( /-/, $nextdate ),
2201 split( /-/, $expirationdate )
2207 } elsif ($subscription->{numberlength}>0) {
2208 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2214 sub in_array { # used in next sub down
2215 my ( $val, @elements ) = @_;
2216 foreach my $elem (@elements) {
2217 if ( $val == $elem ) {
2224 =head2 GetSubscriptionsFromBorrower
2226 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2228 this gets the info from subscriptionroutinglist for each $subscriptionid
2231 a count of the serial subscription routing lists to which a patron belongs,
2232 with the titles of those serial subscriptions as an array. Each element of the array
2233 contains a hash_ref with subscriptionID and title of subscription.
2237 sub GetSubscriptionsFromBorrower {
2238 my ($borrowernumber) = @_;
2239 my $dbh = C4::Context->dbh;
2240 my $sth = $dbh->prepare(
2241 "SELECT subscription.subscriptionid, biblio.title
2243 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2244 JOIN subscriptionroutinglist USING (subscriptionid)
2245 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2248 $sth->execute($borrowernumber);
2251 while ( my $line = $sth->fetchrow_hashref ) {
2253 push( @routinglist, $line );
2255 return ( $count, @routinglist );
2259 =head2 GetFictiveIssueNumber
2261 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2263 Get the position of the issue published at $publisheddate, considering the
2264 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2265 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2266 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2267 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2268 depending on how many rows are in serial table.
2269 The issue number calculation is based on subscription frequency, first acquisition
2270 date, and $publisheddate.
2274 sub GetFictiveIssueNumber {
2275 my ($subscription, $publisheddate) = @_;
2277 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2278 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2282 my ($year, $month, $day) = split /-/, $publisheddate;
2283 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2287 if($unit eq 'day') {
2288 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2289 } elsif($unit eq 'week') {
2290 ($wkno, $year) = Week_of_Year($year, $month, $day);
2291 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2292 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2293 } elsif($unit eq 'month') {
2294 $delta = ($fa_year == $year)
2295 ? ($month - $fa_month)
2296 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2297 } elsif($unit eq 'year') {
2298 $delta = $year - $fa_year;
2300 if($frequency->{'unitsperissue'} == 1) {
2301 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2303 # Assuming issuesperunit == 1
2304 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2310 sub _get_next_date_day {
2311 my ($subscription, $freqdata, $year, $month, $day) = @_;
2313 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2314 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2315 $subscription->{countissuesperunit} = 1;
2317 $subscription->{countissuesperunit}++;
2320 return ($year, $month, $day);
2323 sub _get_next_date_week {
2324 my ($subscription, $freqdata, $year, $month, $day) = @_;
2326 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2327 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2329 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2330 $subscription->{countissuesperunit} = 1;
2331 $wkno += $freqdata->{unitsperissue};
2336 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2337 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2339 # Try to guess the next day of week
2340 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2341 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2342 $subscription->{countissuesperunit}++;
2345 return ($year, $month, $day);
2348 sub _get_next_date_month {
2349 my ($subscription, $freqdata, $year, $month, $day) = @_;
2352 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2354 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2355 $subscription->{countissuesperunit} = 1;
2356 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2357 $freqdata->{unitsperissue});
2358 my $days_in_month = Days_in_Month($year, $month);
2359 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2361 # Try to guess the next day in month
2362 my $days_in_month = Days_in_Month($year, $month);
2363 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2364 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2365 $subscription->{countissuesperunit}++;
2368 return ($year, $month, $day);
2371 sub _get_next_date_year {
2372 my ($subscription, $freqdata, $year, $month, $day) = @_;
2374 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2376 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2377 $subscription->{countissuesperunit} = 1;
2378 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2380 my $days_in_month = Days_in_Month($year, $month);
2381 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2383 # Try to guess the next day in year
2384 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2385 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2386 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2387 $subscription->{countissuesperunit}++;
2390 return ($year, $month, $day);
2395 $resultdate = GetNextDate($publisheddate,$subscription)
2397 this function it takes the publisheddate and will return the next issue's date
2398 and will skip dates if there exists an irregularity.
2399 $publisheddate has to be an ISO date
2400 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2401 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2402 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2403 skipped then the returned date will be 2007-05-10
2406 $resultdate - then next date in the sequence (ISO date)
2408 Return undef if subscription is irregular
2413 my ( $subscription, $publisheddate, $updatecount ) = @_;
2415 return unless $subscription and $publisheddate;
2417 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2419 if ($freqdata->{'unit'}) {
2420 my ( $year, $month, $day ) = split /-/, $publisheddate;
2422 # Process an irregularity Hash
2423 # Suppose that irregularities are stored in a string with this structure
2424 # irreg1;irreg2;irreg3
2425 # where irregX is the number of issue which will not be received
2426 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2428 if ( $subscription->{irregularity} ) {
2429 my @irreg = split /;/, $subscription->{'irregularity'} ;
2430 foreach my $irregularity (@irreg) {
2431 $irregularities{$irregularity} = 1;
2435 # Get the 'fictive' next issue number
2436 # It is used to check if next issue is an irregular issue.
2437 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2439 # Then get the next date
2440 my $unit = lc $freqdata->{'unit'};
2441 if ($unit eq 'day') {
2442 while ($irregularities{$issueno}) {
2443 ($year, $month, $day) = _get_next_date_day($subscription,
2444 $freqdata, $year, $month, $day);
2447 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2448 $year, $month, $day);
2450 elsif ($unit eq 'week') {
2451 while ($irregularities{$issueno}) {
2452 ($year, $month, $day) = _get_next_date_week($subscription,
2453 $freqdata, $year, $month, $day);
2456 ($year, $month, $day) = _get_next_date_week($subscription,
2457 $freqdata, $year, $month, $day);
2459 elsif ($unit eq 'month') {
2460 while ($irregularities{$issueno}) {
2461 ($year, $month, $day) = _get_next_date_month($subscription,
2462 $freqdata, $year, $month, $day);
2465 ($year, $month, $day) = _get_next_date_month($subscription,
2466 $freqdata, $year, $month, $day);
2468 elsif ($unit eq 'year') {
2469 while ($irregularities{$issueno}) {
2470 ($year, $month, $day) = _get_next_date_year($subscription,
2471 $freqdata, $year, $month, $day);
2474 ($year, $month, $day) = _get_next_date_year($subscription,
2475 $freqdata, $year, $month, $day);
2479 my $dbh = C4::Context->dbh;
2482 SET countissuesperunit = ?
2483 WHERE subscriptionid = ?
2485 my $sth = $dbh->prepare($query);
2486 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2489 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2495 $string = &_numeration($value,$num_type,$locale);
2497 _numeration returns the string corresponding to $value in the num_type
2510 my ($value, $num_type, $locale) = @_;
2515 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2516 # 1970-11-01 was a Sunday
2517 $value = $value % 7;
2518 my $dt = DateTime->new(
2524 $string = $num_type =~ /^dayname$/
2525 ? $dt->strftime("%A")
2526 : $dt->strftime("%a");
2527 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2528 $value = $value % 12;
2529 my $dt = DateTime->new(
2531 month => $value + 1,
2534 $string = $num_type =~ /^monthname$/
2535 ? $dt->strftime("%B")
2536 : $dt->strftime("%b");
2537 } elsif ( $num_type =~ /^season$/ ) {
2538 my @seasons= qw( Spring Summer Fall Winter );
2539 $value = $value % 4;
2540 $string = $seasons[$value];
2541 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2542 my @seasonsabrv= qw( Spr Sum Fal Win );
2543 $value = $value % 4;
2544 $string = $seasonsabrv[$value];
2552 =head2 is_barcode_in_use
2554 Returns number of occurrences of the barcode in the items table
2555 Can be used as a boolean test of whether the barcode has
2556 been deployed as yet
2560 sub is_barcode_in_use {
2561 my $barcode = shift;
2562 my $dbh = C4::Context->dbh;
2563 my $occurrences = $dbh->selectall_arrayref(
2564 'SELECT itemnumber from items where barcode = ?',
2569 return @{$occurrences};
2572 =head2 CloseSubscription
2573 Close a subscription given a subscriptionid
2575 sub CloseSubscription {
2576 my ( $subscriptionid ) = @_;
2577 return unless $subscriptionid;
2578 my $dbh = C4::Context->dbh;
2579 my $sth = $dbh->prepare( q{
2582 WHERE subscriptionid = ?
2584 $sth->execute( $subscriptionid );
2586 # Set status = missing when status = stopped
2587 $sth = $dbh->prepare( q{
2590 WHERE subscriptionid = ?
2593 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2596 =head2 ReopenSubscription
2597 Reopen a subscription given a subscriptionid
2599 sub ReopenSubscription {
2600 my ( $subscriptionid ) = @_;
2601 return unless $subscriptionid;
2602 my $dbh = C4::Context->dbh;
2603 my $sth = $dbh->prepare( q{
2606 WHERE subscriptionid = ?
2608 $sth->execute( $subscriptionid );
2610 # Set status = expected when status = stopped
2611 $sth = $dbh->prepare( q{
2614 WHERE subscriptionid = ?
2617 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2620 =head2 subscriptionCurrentlyOnOrder
2622 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2624 Return 1 if subscription is currently on order else 0.
2628 sub subscriptionCurrentlyOnOrder {
2629 my ( $subscriptionid ) = @_;
2630 my $dbh = C4::Context->dbh;
2632 SELECT COUNT(*) FROM aqorders
2633 WHERE subscriptionid = ?
2634 AND datereceived IS NULL
2635 AND datecancellationprinted IS NULL
2637 my $sth = $dbh->prepare( $query );
2638 $sth->execute($subscriptionid);
2639 return $sth->fetchrow_array;
2642 =head2 can_claim_subscription
2644 $can = can_claim_subscription( $subscriptionid[, $userid] );
2646 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2650 sub can_claim_subscription {
2651 my ( $subscription, $userid ) = @_;
2652 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2655 =head2 can_edit_subscription
2657 $can = can_edit_subscription( $subscriptionid[, $userid] );
2659 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2663 sub can_edit_subscription {
2664 my ( $subscription, $userid ) = @_;
2665 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2668 =head2 can_show_subscription
2670 $can = can_show_subscription( $subscriptionid[, $userid] );
2672 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2676 sub can_show_subscription {
2677 my ( $subscription, $userid ) = @_;
2678 return _can_do_on_subscription( $subscription, $userid, '*' );
2681 sub _can_do_on_subscription {
2682 my ( $subscription, $userid, $permission ) = @_;
2683 return 0 unless C4::Context->userenv;
2684 my $flags = C4::Context->userenv->{flags};
2685 $userid ||= C4::Context->userenv->{'id'};
2687 if ( C4::Context->preference('IndependentBranches') ) {
2689 if C4::Context->IsSuperLibrarian()
2691 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2693 C4::Auth::haspermission( $userid,
2694 { serials => $permission } )
2695 and ( not defined $subscription->{branchcode}
2696 or $subscription->{branchcode} eq ''
2697 or $subscription->{branchcode} eq
2698 C4::Context->userenv->{'branch'} )
2703 if C4::Context->IsSuperLibrarian()
2705 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2706 or C4::Auth::haspermission(
2707 $userid, { serials => $permission }
2714 =head2 findSerialsByStatus
2716 @serials = findSerialsByStatus($status, $subscriptionid);
2718 Returns an array of serials matching a given status and subscription id.
2722 sub findSerialsByStatus {
2723 my ( $status, $subscriptionid ) = @_;
2724 my $dbh = C4::Context->dbh;
2725 my $query = q| SELECT * from serial
2727 AND subscriptionid = ?
2729 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2738 Koha Development Team <http://koha-community.org/>