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
69 &SearchSubscriptions &GetItemnumberFromSerialId
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 GetItemnumberFromSerialId
188 $itemnumber = GetSerialInformation($serialid);
189 this function returns the itemnumber, given a serialid in parameter
194 sub GetItemnumberFromSerialId {
196 my $dbh = C4::Context->dbh;
202 my $sth = $dbh->prepare($query);
203 $sth->execute($serialid);
204 my ($result) = $sth->fetchrow;
210 =head2 GetSerialInformation
213 $data = GetSerialInformation($serialid);
214 returns a hash_ref containing :
215 items : items marcrecord (can be an array)
217 subscription table field
218 + information about subscription expiration
222 sub GetSerialInformation {
224 my $dbh = C4::Context->dbh;
226 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
227 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
230 my $rq = $dbh->prepare($query);
231 $rq->execute($serialid);
232 my $data = $rq->fetchrow_hashref;
234 # create item information if we have serialsadditems for this subscription
235 if ( $data->{'serialsadditems'} ) {
236 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
237 $queryitem->execute($serialid);
238 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
240 if ( scalar(@$itemnumbers) > 0 ) {
241 foreach my $itemnum (@$itemnumbers) {
243 #It is ASSUMED that GetMarcItem ALWAYS WORK...
244 #Maybe GetMarcItem should return values on failure
245 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
246 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
247 $itemprocessed->{'itemnumber'} = $itemnum->[0];
248 $itemprocessed->{'itemid'} = $itemnum->[0];
249 $itemprocessed->{'serialid'} = $serialid;
250 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
251 push @{ $data->{'items'} }, $itemprocessed;
254 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
255 $itemprocessed->{'itemid'} = "N$serialid";
256 $itemprocessed->{'serialid'} = $serialid;
257 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
258 $itemprocessed->{'countitems'} = 0;
259 push @{ $data->{'items'} }, $itemprocessed;
262 $data->{ "status" . $data->{'serstatus'} } = 1;
263 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
264 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
265 $data->{cannotedit} = not can_edit_subscription( $data );
269 =head2 AddItem2Serial
271 $rows = AddItem2Serial($serialid,$itemnumber);
272 Adds an itemnumber to Serial record
273 returns the number of rows affected
278 my ( $serialid, $itemnumber ) = @_;
280 return unless ($serialid and $itemnumber);
282 my $dbh = C4::Context->dbh;
283 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
284 $rq->execute( $serialid, $itemnumber );
288 =head2 GetSubscription
290 $subs = GetSubscription($subscriptionid)
291 this function returns the subscription which has $subscriptionid as id.
293 a hashref. This hash containts
294 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
298 sub GetSubscription {
299 my ($subscriptionid) = @_;
300 my $dbh = C4::Context->dbh;
302 SELECT subscription.*,
303 subscriptionhistory.*,
304 aqbooksellers.name AS aqbooksellername,
305 biblio.title AS bibliotitle,
306 subscription.biblionumber as bibnum
308 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
309 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
310 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
311 WHERE subscription.subscriptionid = ?
314 $debug and warn "query : $query\nsubsid :$subscriptionid";
315 my $sth = $dbh->prepare($query);
316 $sth->execute($subscriptionid);
317 my $subscription = $sth->fetchrow_hashref;
319 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
321 # Add additional fields to the subscription into a new key "additional_fields"
322 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
323 tablename => 'subscription',
324 record_id => $subscriptionid,
326 $subscription->{additional_fields} = $additional_field_values->{$subscriptionid};
328 return $subscription;
331 =head2 GetFullSubscription
333 $array_ref = GetFullSubscription($subscriptionid)
334 this function reads the serial table.
338 sub GetFullSubscription {
339 my ($subscriptionid) = @_;
341 return unless ($subscriptionid);
343 my $dbh = C4::Context->dbh;
345 SELECT serial.serialid,
348 serial.publisheddate,
349 serial.publisheddatetext,
351 serial.notes as notes,
352 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
353 aqbooksellers.name as aqbooksellername,
354 biblio.title as bibliotitle,
355 subscription.branchcode AS branchcode,
356 subscription.subscriptionid AS subscriptionid
358 LEFT JOIN subscription ON
359 (serial.subscriptionid=subscription.subscriptionid )
360 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
361 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
362 WHERE serial.subscriptionid = ?
364 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
365 serial.subscriptionid
367 $debug and warn "GetFullSubscription query: $query";
368 my $sth = $dbh->prepare($query);
369 $sth->execute($subscriptionid);
370 my $subscriptions = $sth->fetchall_arrayref( {} );
371 for my $subscription ( @$subscriptions ) {
372 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
374 return $subscriptions;
377 =head2 PrepareSerialsData
379 $array_ref = PrepareSerialsData($serialinfomation)
380 where serialinformation is a hashref array
384 sub PrepareSerialsData {
387 return unless ($lines);
393 my $aqbooksellername;
397 my $previousnote = "";
399 foreach my $subs (@{$lines}) {
400 for my $datefield ( qw(publisheddate planneddate) ) {
401 # handle 0000-00-00 dates
402 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
403 $subs->{$datefield} = undef;
406 $subs->{ "status" . $subs->{'status'} } = 1;
407 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
408 $subs->{"checked"} = 1;
411 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
412 $year = $subs->{'year'};
416 if ( $tmpresults{$year} ) {
417 push @{ $tmpresults{$year}->{'serials'} }, $subs;
419 $tmpresults{$year} = {
421 'aqbooksellername' => $subs->{'aqbooksellername'},
422 'bibliotitle' => $subs->{'bibliotitle'},
423 'serials' => [$subs],
428 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
429 push @res, $tmpresults{$key};
434 =head2 GetSubscriptionsFromBiblionumber
436 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
437 this function get the subscription list. it reads the subscription table.
439 reference to an array of subscriptions which have the biblionumber given on input arg.
440 each element of this array is a hashref containing
441 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
445 sub GetSubscriptionsFromBiblionumber {
446 my ($biblionumber) = @_;
448 return unless ($biblionumber);
450 my $dbh = C4::Context->dbh;
452 SELECT subscription.*,
454 subscriptionhistory.*,
455 aqbooksellers.name AS aqbooksellername,
456 biblio.title AS bibliotitle
458 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
459 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
460 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
461 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
462 WHERE subscription.biblionumber = ?
464 my $sth = $dbh->prepare($query);
465 $sth->execute($biblionumber);
467 while ( my $subs = $sth->fetchrow_hashref ) {
468 $subs->{startdate} = output_pref( { dt => dt_from_string( $subs->{startdate} ), dateonly => 1 } );
469 $subs->{histstartdate} = output_pref( { dt => dt_from_string( $subs->{histstartdate} ), dateonly => 1 } );
470 $subs->{histenddate} = output_pref( { dt => dt_from_string( $subs->{histenddate} ), dateonly => 1 } );
471 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
472 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
473 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
474 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
475 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
476 $subs->{ "status" . $subs->{'status'} } = 1;
478 if ( $subs->{enddate} eq '0000-00-00' ) {
479 $subs->{enddate} = '';
481 $subs->{enddate} = output_pref( { dt => dt_from_string( $subs->{enddate}), dateonly => 1 } );
483 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
484 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
485 $subs->{cannotedit} = not can_edit_subscription( $subs );
491 =head2 GetFullSubscriptionsFromBiblionumber
493 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
494 this function reads the serial table.
498 sub GetFullSubscriptionsFromBiblionumber {
499 my ($biblionumber) = @_;
500 my $dbh = C4::Context->dbh;
502 SELECT serial.serialid,
505 serial.publisheddate,
506 serial.publisheddatetext,
508 serial.notes as notes,
509 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
510 biblio.title as bibliotitle,
511 subscription.branchcode AS branchcode,
512 subscription.subscriptionid AS subscriptionid
514 LEFT JOIN subscription ON
515 (serial.subscriptionid=subscription.subscriptionid)
516 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
517 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
518 WHERE subscription.biblionumber = ?
520 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
521 serial.subscriptionid
523 my $sth = $dbh->prepare($query);
524 $sth->execute($biblionumber);
525 my $subscriptions = $sth->fetchall_arrayref( {} );
526 for my $subscription ( @$subscriptions ) {
527 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
529 return $subscriptions;
532 =head2 SearchSubscriptions
534 @results = SearchSubscriptions($args);
536 This function returns a list of hashrefs, one for each subscription
537 that meets the conditions specified by the $args hashref.
539 The valid search fields are:
553 The expiration_date search field is special; it specifies the maximum
554 subscription expiration date.
558 sub SearchSubscriptions {
561 my $additional_fields = $args->{additional_fields} // [];
562 my $matching_record_ids_for_additional_fields = [];
563 if ( @$additional_fields ) {
564 $matching_record_ids_for_additional_fields = Koha::AdditionalField->get_matching_record_ids({
565 fields => $additional_fields,
566 tablename => 'subscription',
569 return () unless @$matching_record_ids_for_additional_fields;
574 subscription.notes AS publicnotes,
575 subscriptionhistory.*,
577 biblio.notes AS biblionotes,
583 LEFT JOIN subscriptionhistory USING(subscriptionid)
584 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
585 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
586 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
588 $query .= q| WHERE 1|;
591 if( $args->{biblionumber} ) {
592 push @where_strs, "biblio.biblionumber = ?";
593 push @where_args, $args->{biblionumber};
596 if( $args->{title} ){
597 my @words = split / /, $args->{title};
599 foreach my $word (@words) {
600 push @strs, "biblio.title LIKE ?";
601 push @args, "%$word%";
604 push @where_strs, '(' . join (' AND ', @strs) . ')';
605 push @where_args, @args;
609 push @where_strs, "biblioitems.issn LIKE ?";
610 push @where_args, "%$args->{issn}%";
613 push @where_strs, "biblioitems.ean LIKE ?";
614 push @where_args, "%$args->{ean}%";
616 if ( $args->{callnumber} ) {
617 push @where_strs, "subscription.callnumber LIKE ?";
618 push @where_args, "%$args->{callnumber}%";
620 if( $args->{publisher} ){
621 push @where_strs, "biblioitems.publishercode LIKE ?";
622 push @where_args, "%$args->{publisher}%";
624 if( $args->{bookseller} ){
625 push @where_strs, "aqbooksellers.name LIKE ?";
626 push @where_args, "%$args->{bookseller}%";
628 if( $args->{branch} ){
629 push @where_strs, "subscription.branchcode = ?";
630 push @where_args, "$args->{branch}";
632 if ( $args->{location} ) {
633 push @where_strs, "subscription.location = ?";
634 push @where_args, "$args->{location}";
636 if ( $args->{expiration_date} ) {
637 push @where_strs, "subscription.enddate <= ?";
638 push @where_args, "$args->{expiration_date}";
640 if( defined $args->{closed} ){
641 push @where_strs, "subscription.closed = ?";
642 push @where_args, "$args->{closed}";
646 $query .= ' AND ' . join(' AND ', @where_strs);
648 if ( @$additional_fields ) {
649 $query .= ' AND subscriptionid IN ('
650 . join( ', ', @$matching_record_ids_for_additional_fields )
654 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
656 my $dbh = C4::Context->dbh;
657 my $sth = $dbh->prepare($query);
658 $sth->execute(@where_args);
659 my $results = $sth->fetchall_arrayref( {} );
661 for my $subscription ( @$results ) {
662 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
663 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
665 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
666 record_id => $subscription->{subscriptionid},
667 tablename => 'subscription'
669 $subscription->{additional_fields} = $additional_field_values->{$subscription->{subscriptionid}};
678 ($totalissues,@serials) = GetSerials($subscriptionid);
679 this function gets every serial not arrived for a given subscription
680 as well as the number of issues registered in the database (all types)
681 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
683 FIXME: We should return \@serials.
688 my ( $subscriptionid, $count ) = @_;
690 return unless $subscriptionid;
692 my $dbh = C4::Context->dbh;
694 # status = 2 is "arrived"
696 $count = 5 unless ($count);
698 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
699 my $query = "SELECT serialid,serialseq, status, publisheddate,
700 publisheddatetext, planneddate,notes, routingnotes
702 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
703 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
704 my $sth = $dbh->prepare($query);
705 $sth->execute($subscriptionid);
707 while ( my $line = $sth->fetchrow_hashref ) {
708 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
709 for my $datefield ( qw( planneddate publisheddate) ) {
710 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
711 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
713 $line->{$datefield} = q{};
716 push @serials, $line;
719 # OK, now add the last 5 issues arrives/missing
720 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,
721 publisheddatetext, notes, routingnotes
723 WHERE subscriptionid = ?
724 AND status IN ( $statuses )
725 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
727 $sth = $dbh->prepare($query);
728 $sth->execute($subscriptionid);
729 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
731 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
732 for my $datefield ( qw( planneddate publisheddate) ) {
733 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
734 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
736 $line->{$datefield} = q{};
740 push @serials, $line;
743 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
744 $sth = $dbh->prepare($query);
745 $sth->execute($subscriptionid);
746 my ($totalissues) = $sth->fetchrow;
747 return ( $totalissues, @serials );
752 @serials = GetSerials2($subscriptionid,$statuses);
753 this function returns every serial waited for a given subscription
754 as well as the number of issues registered in the database (all types)
755 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
757 $statuses is an arrayref of statuses and is mandatory.
762 my ( $subscription, $statuses ) = @_;
764 return unless ($subscription and @$statuses);
766 my $statuses_string = join ',', @$statuses;
768 my $dbh = C4::Context->dbh;
770 SELECT serialid,serialseq, status, planneddate, publisheddate,
771 publisheddatetext, notes, routingnotes
773 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
774 ORDER BY publisheddate,serialid DESC
776 $debug and warn "GetSerials2 query: $query";
777 my $sth = $dbh->prepare($query);
781 while ( my $line = $sth->fetchrow_hashref ) {
782 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
783 # Format dates for display
784 for my $datefield ( qw( planneddate publisheddate ) ) {
785 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
786 $line->{$datefield} = q{};
789 $line->{$datefield} = output_pref( { dt => dt_from_string( $line->{$datefield} ), dateonly => 1 } );
792 push @serials, $line;
797 =head2 GetLatestSerials
799 \@serials = GetLatestSerials($subscriptionid,$limit)
800 get the $limit's latest serials arrived or missing for a given subscription
802 a ref to an array which contains all of the latest serials stored into a hash.
806 sub GetLatestSerials {
807 my ( $subscriptionid, $limit ) = @_;
809 return unless ($subscriptionid and $limit);
811 my $dbh = C4::Context->dbh;
813 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
814 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
816 WHERE subscriptionid = ?
817 AND status IN ($statuses)
818 ORDER BY publisheddate DESC LIMIT 0,$limit
820 my $sth = $dbh->prepare($strsth);
821 $sth->execute($subscriptionid);
823 while ( my $line = $sth->fetchrow_hashref ) {
824 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
825 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{planneddate} ), dateonly => 1 } );
826 $line->{publisheddate} = output_pref( { dt => dt_from_string( $line->{publisheddate} ), dateonly => 1 } );
827 push @serials, $line;
833 =head2 GetPreviousSerialid
835 $serialid = GetPreviousSerialid($subscriptionid, $nth)
836 get the $nth's previous serial for the given subscriptionid
842 sub GetPreviousSerialid {
843 my ( $subscriptionid, $nth ) = @_;
845 my $dbh = C4::Context->dbh;
849 my $strsth = "SELECT serialid
851 WHERE subscriptionid = ?
853 ORDER BY serialid DESC LIMIT $nth,1
855 my $sth = $dbh->prepare($strsth);
856 $sth->execute($subscriptionid);
858 my $line = $sth->fetchrow_hashref;
859 $return = $line->{'serialid'} if ($line);
866 =head2 GetDistributedTo
868 $distributedto=GetDistributedTo($subscriptionid)
869 This function returns the field distributedto for the subscription matching subscriptionid
873 sub GetDistributedTo {
874 my $dbh = C4::Context->dbh;
876 my ($subscriptionid) = @_;
878 return unless ($subscriptionid);
880 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
881 my $sth = $dbh->prepare($query);
882 $sth->execute($subscriptionid);
883 return ($distributedto) = $sth->fetchrow;
889 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
890 $newinnerloop1, $newinnerloop2, $newinnerloop3
891 ) = GetNextSeq( $subscription, $pattern, $planneddate );
893 $subscription is a hashref containing all the attributes of the table
895 $pattern is a hashref containing all the attributes of the table
896 'subscription_numberpatterns'.
897 $planneddate is a date string in iso format.
898 This function get the next issue for the subscription given on input arg
903 my ($subscription, $pattern, $planneddate) = @_;
905 return unless ($subscription and $pattern);
907 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
908 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
911 if ($subscription->{'skip_serialseq'}) {
912 my @irreg = split /;/, $subscription->{'irregularity'};
914 my $irregularities = {};
915 $irregularities->{$_} = 1 foreach(@irreg);
916 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
917 while($irregularities->{$issueno}) {
924 my $numberingmethod = $pattern->{numberingmethod};
926 if ($numberingmethod) {
927 $calculated = $numberingmethod;
928 my $locale = $subscription->{locale};
929 $newlastvalue1 = $subscription->{lastvalue1} || 0;
930 $newlastvalue2 = $subscription->{lastvalue2} || 0;
931 $newlastvalue3 = $subscription->{lastvalue3} || 0;
932 $newinnerloop1 = $subscription->{innerloop1} || 0;
933 $newinnerloop2 = $subscription->{innerloop2} || 0;
934 $newinnerloop3 = $subscription->{innerloop3} || 0;
937 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
940 for(my $i = 0; $i < $count; $i++) {
942 # check if we have to increase the new value.
944 if ($newinnerloop1 >= $pattern->{every1}) {
946 $newlastvalue1 += $pattern->{add1};
948 # reset counter if needed.
949 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
952 # check if we have to increase the new value.
954 if ($newinnerloop2 >= $pattern->{every2}) {
956 $newlastvalue2 += $pattern->{add2};
958 # reset counter if needed.
959 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
962 # check if we have to increase the new value.
964 if ($newinnerloop3 >= $pattern->{every3}) {
966 $newlastvalue3 += $pattern->{add3};
968 # reset counter if needed.
969 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
973 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
974 $calculated =~ s/\{X\}/$newlastvalue1string/g;
977 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
978 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
981 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
982 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
987 $newlastvalue1, $newlastvalue2, $newlastvalue3,
988 $newinnerloop1, $newinnerloop2, $newinnerloop3);
993 $calculated = GetSeq($subscription, $pattern)
994 $subscription is a hashref containing all the attributes of the table 'subscription'
995 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
996 this function transforms {X},{Y},{Z} to 150,0,0 for example.
998 the sequence in string format
1003 my ($subscription, $pattern) = @_;
1005 return unless ($subscription and $pattern);
1007 my $locale = $subscription->{locale};
1009 my $calculated = $pattern->{numberingmethod};
1011 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1012 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1013 $calculated =~ s/\{X\}/$newlastvalue1/g;
1015 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1016 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1017 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1019 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1020 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1021 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1025 =head2 GetExpirationDate
1027 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1029 this function return the next expiration date for a subscription given on input args.
1032 the enddate or undef
1036 sub GetExpirationDate {
1037 my ( $subscriptionid, $startdate ) = @_;
1039 return unless ($subscriptionid);
1041 my $dbh = C4::Context->dbh;
1042 my $subscription = GetSubscription($subscriptionid);
1045 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1046 $enddate = $startdate || $subscription->{startdate};
1047 my @date = split( /-/, $enddate );
1049 return if ( scalar(@date) != 3 || not check_date(@date) );
1051 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1052 if ( $frequency and $frequency->{unit} ) {
1055 if ( my $length = $subscription->{numberlength} ) {
1057 #calculate the date of the last issue.
1058 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1059 $enddate = GetNextDate( $subscription, $enddate );
1061 } elsif ( $subscription->{monthlength} ) {
1062 if ( $$subscription{startdate} ) {
1063 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1064 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1066 } elsif ( $subscription->{weeklength} ) {
1067 if ( $$subscription{startdate} ) {
1068 my @date = split( /-/, $subscription->{startdate} );
1069 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1070 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1073 $enddate = $subscription->{enddate};
1077 return $subscription->{enddate};
1081 =head2 CountSubscriptionFromBiblionumber
1083 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1084 this returns a count of the subscriptions for a given biblionumber
1086 the number of subscriptions
1090 sub CountSubscriptionFromBiblionumber {
1091 my ($biblionumber) = @_;
1093 return unless ($biblionumber);
1095 my $dbh = C4::Context->dbh;
1096 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1097 my $sth = $dbh->prepare($query);
1098 $sth->execute($biblionumber);
1099 my $subscriptionsnumber = $sth->fetchrow;
1100 return $subscriptionsnumber;
1103 =head2 ModSubscriptionHistory
1105 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1107 this function modifies the history of a subscription. Put your new values on input arg.
1108 returns the number of rows affected
1112 sub ModSubscriptionHistory {
1113 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1115 return unless ($subscriptionid);
1117 my $dbh = C4::Context->dbh;
1118 my $query = "UPDATE subscriptionhistory
1119 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1120 WHERE subscriptionid=?
1122 my $sth = $dbh->prepare($query);
1123 $receivedlist =~ s/^; // if $receivedlist;
1124 $missinglist =~ s/^; // if $missinglist;
1125 $opacnote =~ s/^; // if $opacnote;
1126 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1130 =head2 ModSerialStatus
1132 ModSerialStatus($serialid, $serialseq, $planneddate, $publisheddate,
1133 $publisheddatetext, $status, $notes);
1135 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1136 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1140 sub ModSerialStatus {
1141 my ($serialid, $serialseq, $planneddate, $publisheddate, $publisheddatetext,
1142 $status, $notes) = @_;
1144 return unless ($serialid);
1146 #It is a usual serial
1147 # 1st, get previous status :
1148 my $dbh = C4::Context->dbh;
1149 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1150 FROM serial, subscription
1151 WHERE serial.subscriptionid=subscription.subscriptionid
1153 my $sth = $dbh->prepare($query);
1154 $sth->execute($serialid);
1155 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1156 my $frequency = GetSubscriptionFrequency($periodicity);
1158 # change status & update subscriptionhistory
1160 if ( $status == DELETED ) {
1161 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1166 SET serialseq = ?, publisheddate = ?, publisheddatetext = ?,
1167 planneddate = ?, status = ?, notes = ?
1170 $sth = $dbh->prepare($query);
1171 $sth->execute( $serialseq, $publisheddate, $publisheddatetext,
1172 $planneddate, $status, $notes, $serialid );
1173 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1174 $sth = $dbh->prepare($query);
1175 $sth->execute($subscriptionid);
1176 my $val = $sth->fetchrow_hashref;
1177 unless ( $val->{manualhistory} ) {
1178 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1179 $sth = $dbh->prepare($query);
1180 $sth->execute($subscriptionid);
1181 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1183 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1184 $recievedlist .= "; $serialseq"
1185 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1188 # in case serial has been previously marked as missing
1189 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1190 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1193 $missinglist .= "; $serialseq"
1194 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1195 $missinglist .= "; not issued $serialseq"
1196 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1198 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1199 $sth = $dbh->prepare($query);
1200 $recievedlist =~ s/^; //;
1201 $missinglist =~ s/^; //;
1202 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1206 # create new expected entry if needed (ie : was "expected" and has changed)
1207 my $otherIssueExpected = scalar findSerialsByStatus(EXPECTED, $subscriptionid);
1208 if ( !$otherIssueExpected && $oldstatus == EXPECTED && $status != EXPECTED ) {
1209 my $subscription = GetSubscription($subscriptionid);
1210 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1214 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1215 $newinnerloop1, $newinnerloop2, $newinnerloop3
1217 = GetNextSeq( $subscription, $pattern, $publisheddate );
1219 # next date (calculated from actual date & frequency parameters)
1220 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1221 my $nextpubdate = $nextpublisheddate;
1222 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1223 WHERE subscriptionid = ?";
1224 $sth = $dbh->prepare($query);
1225 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1227 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1229 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1230 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1231 require C4::Letters;
1232 C4::Letters::SendAlerts( 'issue', $serialid, $subscription->{letter} );
1239 =head2 GetNextExpected
1241 $nextexpected = GetNextExpected($subscriptionid)
1243 Get the planneddate for the current expected issue of the subscription.
1249 planneddate => ISO date
1254 sub GetNextExpected {
1255 my ($subscriptionid) = @_;
1257 my $dbh = C4::Context->dbh;
1261 WHERE subscriptionid = ?
1265 my $sth = $dbh->prepare($query);
1267 # Each subscription has only one 'expected' issue.
1268 $sth->execute( $subscriptionid, EXPECTED );
1269 my $nextissue = $sth->fetchrow_hashref;
1270 if ( !$nextissue ) {
1274 WHERE subscriptionid = ?
1275 ORDER BY publisheddate DESC
1278 $sth = $dbh->prepare($query);
1279 $sth->execute($subscriptionid);
1280 $nextissue = $sth->fetchrow_hashref;
1282 foreach(qw/planneddate publisheddate/) {
1283 if ( !defined $nextissue->{$_} ) {
1284 # or should this default to 1st Jan ???
1285 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1287 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1295 =head2 ModNextExpected
1297 ModNextExpected($subscriptionid,$date)
1299 Update the planneddate for the current expected issue of the subscription.
1300 This will modify all future prediction results.
1302 C<$date> is an ISO date.
1308 sub ModNextExpected {
1309 my ( $subscriptionid, $date ) = @_;
1310 my $dbh = C4::Context->dbh;
1312 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1313 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1315 # Each subscription has only one 'expected' issue.
1316 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1321 =head2 GetSubscriptionIrregularities
1325 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1326 get the list of irregularities for a subscription
1332 sub GetSubscriptionIrregularities {
1333 my $subscriptionid = shift;
1335 return unless $subscriptionid;
1337 my $dbh = C4::Context->dbh;
1341 WHERE subscriptionid = ?
1343 my $sth = $dbh->prepare($query);
1344 $sth->execute($subscriptionid);
1346 my ($result) = $sth->fetchrow_array;
1347 my @irreg = split /;/, $result;
1352 =head2 ModSubscription
1354 this function modifies a subscription. Put all new values on input args.
1355 returns the number of rows affected
1359 sub ModSubscription {
1361 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1362 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1363 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1364 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1365 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1366 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1367 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq,
1368 $itemtype, $previousitemtype
1371 my $dbh = C4::Context->dbh;
1372 my $query = "UPDATE subscription
1373 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1374 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1375 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1376 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1377 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1378 callnumber=?, notes=?, letter=?, manualhistory=?,
1379 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1380 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1381 skip_serialseq=?, itemtype=?, previousitemtype=?
1382 WHERE subscriptionid = ?";
1384 my $sth = $dbh->prepare($query);
1386 $auser, $branchcode, $aqbooksellerid, $cost,
1387 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1388 $irregularity, $numberpattern, $locale, $numberlength,
1389 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1390 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1391 $status, $biblionumber, $callnumber, $notes,
1392 $letter, ($manualhistory ? $manualhistory : 0),
1393 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1394 $graceperiod, $location, $enddate, $skip_serialseq,
1395 $itemtype, $previousitemtype,
1398 my $rows = $sth->rows;
1400 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1404 =head2 NewSubscription
1406 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1407 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1408 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1409 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1410 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1411 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate,
1412 $skip_serialseq, $itemtype, $previousitemtype);
1414 Create a new subscription with value given on input args.
1417 the id of this new subscription
1421 sub NewSubscription {
1423 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1424 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1425 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1426 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1427 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1428 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1429 $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype
1431 my $dbh = C4::Context->dbh;
1433 #save subscription (insert into database)
1435 INSERT INTO subscription
1436 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1437 biblionumber, startdate, periodicity, numberlength, weeklength,
1438 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1439 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1440 irregularity, numberpattern, locale, callnumber,
1441 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1442 opacdisplaycount, graceperiod, location, enddate, skip_serialseq,
1443 itemtype, previousitemtype)
1444 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1446 my $sth = $dbh->prepare($query);
1448 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1449 $startdate, $periodicity, $numberlength, $weeklength,
1450 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1451 $lastvalue3, $innerloop3, $status, $notes, $letter,
1452 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1453 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1454 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq,
1455 $itemtype, $previousitemtype
1458 my $subscriptionid = $dbh->{'mysql_insertid'};
1460 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1464 WHERE subscriptionid=?
1466 $sth = $dbh->prepare($query);
1467 $sth->execute( $enddate, $subscriptionid );
1470 # then create the 1st expected number
1472 INSERT INTO subscriptionhistory
1473 (biblionumber, subscriptionid, histstartdate)
1476 $sth = $dbh->prepare($query);
1477 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1479 # reread subscription to get a hash (for calculation of the 1st issue number)
1480 my $subscription = GetSubscription($subscriptionid);
1481 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1483 # calculate issue number
1484 my $serialseq = GetSeq($subscription, $pattern) || q{};
1488 serialseq => $serialseq,
1489 serialseq_x => $subscription->{'lastvalue1'},
1490 serialseq_y => $subscription->{'lastvalue2'},
1491 serialseq_z => $subscription->{'lastvalue3'},
1492 subscriptionid => $subscriptionid,
1493 biblionumber => $biblionumber,
1495 planneddate => $firstacquidate,
1496 publisheddate => $firstacquidate,
1500 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1502 #set serial flag on biblio if not already set.
1503 my $bib = GetBiblio($biblionumber);
1504 if ( $bib and !$bib->{'serial'} ) {
1505 my $record = GetMarcBiblio($biblionumber);
1506 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1508 eval { $record->field($tag)->update( $subf => 1 ); };
1510 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1512 return $subscriptionid;
1515 =head2 ReNewSubscription
1517 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1519 this function renew a subscription with values given on input args.
1523 sub ReNewSubscription {
1524 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1525 my $dbh = C4::Context->dbh;
1526 my $subscription = GetSubscription($subscriptionid);
1530 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1531 WHERE biblio.biblionumber=?
1533 my $sth = $dbh->prepare($query);
1534 $sth->execute( $subscription->{biblionumber} );
1535 my $biblio = $sth->fetchrow_hashref;
1537 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1538 require C4::Suggestions;
1539 C4::Suggestions::NewSuggestion(
1540 { 'suggestedby' => $user,
1541 'title' => $subscription->{bibliotitle},
1542 'author' => $biblio->{author},
1543 'publishercode' => $biblio->{publishercode},
1544 'note' => $biblio->{note},
1545 'biblionumber' => $subscription->{biblionumber}
1550 # renew subscription
1553 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1554 WHERE subscriptionid=?
1556 $sth = $dbh->prepare($query);
1557 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1558 my $enddate = GetExpirationDate($subscriptionid);
1559 $debug && warn "enddate :$enddate";
1563 WHERE subscriptionid=?
1565 $sth = $dbh->prepare($query);
1566 $sth->execute( $enddate, $subscriptionid );
1568 UPDATE subscriptionhistory
1570 WHERE subscriptionid=?
1572 $sth = $dbh->prepare($query);
1573 $sth->execute( $enddate, $subscriptionid );
1575 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1581 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1583 Create a new issue stored on the database.
1584 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1585 returns the serial id
1590 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate,
1591 $publisheddate, $publisheddatetext, $notes ) = @_;
1592 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1594 return unless ($subscriptionid);
1596 my $schema = Koha::Database->new()->schema();
1598 my $subscription = Koha::Subscriptions->find( $subscriptionid );
1600 my $serial = Koha::Serial->new(
1602 serialseq => $serialseq,
1603 serialseq_x => $subscription->lastvalue1(),
1604 serialseq_y => $subscription->lastvalue2(),
1605 serialseq_z => $subscription->lastvalue3(),
1606 subscriptionid => $subscriptionid,
1607 biblionumber => $biblionumber,
1609 planneddate => $planneddate,
1610 publisheddate => $publisheddate,
1611 publisheddatetext => $publisheddatetext,
1616 my $serialid = $serial->id();
1618 my $subscription_history = Koha::Subscription::Histories->find($subscriptionid);
1619 my $missinglist = $subscription_history->missinglist();
1620 my $recievedlist = $subscription_history->recievedlist();
1622 if ( $status == ARRIVED ) {
1623 ### TODO Add a feature that improves recognition and description.
1624 ### As such count (serialseq) i.e. : N18,2(N19),N20
1625 ### Would use substr and index But be careful to previous presence of ()
1626 $recievedlist .= "; $serialseq" unless ( index( $recievedlist, $serialseq ) > 0 );
1628 if ( grep { /^$status$/ } (MISSING_STATUSES) ) {
1629 $missinglist .= "; $serialseq" unless ( index( $missinglist, $serialseq ) > 0 );
1632 $recievedlist =~ s/^; //;
1633 $missinglist =~ s/^; //;
1635 $subscription_history->recievedlist($recievedlist);
1636 $subscription_history->missinglist($missinglist);
1637 $subscription_history->store();
1642 =head2 HasSubscriptionStrictlyExpired
1644 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1646 the subscription has stricly expired when today > the end subscription date
1649 1 if true, 0 if false, -1 if the expiration date is not set.
1653 sub HasSubscriptionStrictlyExpired {
1655 # Getting end of subscription date
1656 my ($subscriptionid) = @_;
1658 return unless ($subscriptionid);
1660 my $dbh = C4::Context->dbh;
1661 my $subscription = GetSubscription($subscriptionid);
1662 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1664 # If the expiration date is set
1665 if ( $expirationdate != 0 ) {
1666 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1668 # Getting today's date
1669 my ( $nowyear, $nowmonth, $nowday ) = Today();
1671 # if today's date > expiration date, then the subscription has stricly expired
1672 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1679 # There are some cases where the expiration date is not set
1680 # As we can't determine if the subscription has expired on a date-basis,
1686 =head2 HasSubscriptionExpired
1688 $has_expired = HasSubscriptionExpired($subscriptionid)
1690 the subscription has expired when the next issue to arrive is out of subscription limit.
1693 0 if the subscription has not expired
1694 1 if the subscription has expired
1695 2 if has subscription does not have a valid expiration date set
1699 sub HasSubscriptionExpired {
1700 my ($subscriptionid) = @_;
1702 return unless ($subscriptionid);
1704 my $dbh = C4::Context->dbh;
1705 my $subscription = GetSubscription($subscriptionid);
1706 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1707 if ( $frequency and $frequency->{unit} ) {
1708 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1709 if (!defined $expirationdate) {
1710 $expirationdate = q{};
1713 SELECT max(planneddate)
1715 WHERE subscriptionid=?
1717 my $sth = $dbh->prepare($query);
1718 $sth->execute($subscriptionid);
1719 my ($res) = $sth->fetchrow;
1720 if (!$res || $res=~m/^0000/) {
1723 my @res = split( /-/, $res );
1724 my @endofsubscriptiondate = split( /-/, $expirationdate );
1725 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1727 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1732 if ( $subscription->{'numberlength'} ) {
1733 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1734 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1740 return 0; # Notice that you'll never get here.
1743 =head2 SetDistributedto
1745 SetDistributedto($distributedto,$subscriptionid);
1746 This function update the value of distributedto for a subscription given on input arg.
1750 sub SetDistributedto {
1751 my ( $distributedto, $subscriptionid ) = @_;
1752 my $dbh = C4::Context->dbh;
1756 WHERE subscriptionid=?
1758 my $sth = $dbh->prepare($query);
1759 $sth->execute( $distributedto, $subscriptionid );
1763 =head2 DelSubscription
1765 DelSubscription($subscriptionid)
1766 this function deletes subscription which has $subscriptionid as id.
1770 sub DelSubscription {
1771 my ($subscriptionid) = @_;
1772 my $dbh = C4::Context->dbh;
1773 $dbh->do("DELETE FROM subscription WHERE subscriptionid=?", undef, $subscriptionid);
1774 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=?", undef, $subscriptionid);
1775 $dbh->do("DELETE FROM serial WHERE subscriptionid=?", undef, $subscriptionid);
1777 my $afs = Koha::AdditionalField->all({tablename => 'subscription'});
1778 foreach my $af (@$afs) {
1779 $af->delete_values({record_id => $subscriptionid});
1782 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1787 DelIssue($serialseq,$subscriptionid)
1788 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1790 returns the number of rows affected
1795 my ($dataissue) = @_;
1796 my $dbh = C4::Context->dbh;
1797 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1802 AND subscriptionid= ?
1804 my $mainsth = $dbh->prepare($query);
1805 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1807 #Delete element from subscription history
1808 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1809 my $sth = $dbh->prepare($query);
1810 $sth->execute( $dataissue->{'subscriptionid'} );
1811 my $val = $sth->fetchrow_hashref;
1812 unless ( $val->{manualhistory} ) {
1814 SELECT * FROM subscriptionhistory
1815 WHERE subscriptionid= ?
1817 my $sth = $dbh->prepare($query);
1818 $sth->execute( $dataissue->{'subscriptionid'} );
1819 my $data = $sth->fetchrow_hashref;
1820 my $serialseq = $dataissue->{'serialseq'};
1821 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1822 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1823 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1824 $sth = $dbh->prepare($strsth);
1825 $sth->execute( $dataissue->{'subscriptionid'} );
1828 return $mainsth->rows;
1831 =head2 GetLateOrMissingIssues
1833 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1835 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1838 the issuelist as an array of hash refs. Each element of this array contains
1839 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1843 sub GetLateOrMissingIssues {
1844 my ( $supplierid, $serialid, $order ) = @_;
1846 return unless ( $supplierid or $serialid );
1848 my $dbh = C4::Context->dbh;
1853 $byserial = "and serialid = " . $serialid;
1856 $order .= ", title";
1860 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1862 $sth = $dbh->prepare(
1864 serialid, aqbooksellerid, name,
1865 biblio.title, biblioitems.issn, planneddate, serialseq,
1866 serial.status, serial.subscriptionid, claimdate, claims_count,
1867 subscription.branchcode
1869 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1870 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1871 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1872 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1873 WHERE subscription.subscriptionid = serial.subscriptionid
1874 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1875 AND subscription.aqbooksellerid=$supplierid
1880 $sth = $dbh->prepare(
1882 serialid, aqbooksellerid, name,
1883 biblio.title, planneddate, serialseq,
1884 serial.status, serial.subscriptionid, claimdate, claims_count,
1885 subscription.branchcode
1887 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1888 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1889 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1890 WHERE subscription.subscriptionid = serial.subscriptionid
1891 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1896 $sth->execute( EXPECTED, LATE, CLAIMED );
1898 while ( my $line = $sth->fetchrow_hashref ) {
1900 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1901 $line->{planneddateISO} = $line->{planneddate};
1902 $line->{planneddate} = output_pref( { dt => dt_from_string( $line->{"planneddate"} ), dateonly => 1 } );
1904 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1905 $line->{claimdateISO} = $line->{claimdate};
1906 $line->{claimdate} = output_pref( { dt => dt_from_string( $line->{"claimdate"} ), dateonly => 1 } );
1908 $line->{"status".$line->{status}} = 1;
1910 my $additional_field_values = Koha::AdditionalField->fetch_all_values({
1911 record_id => $line->{subscriptionid},
1912 tablename => 'subscription'
1914 %$line = ( %$line, additional_fields => $additional_field_values->{$line->{subscriptionid}} );
1916 push @issuelist, $line;
1923 &updateClaim($serialid)
1925 this function updates the time when a claim is issued for late/missing items
1927 called from claims.pl file
1932 my ($serialids) = @_;
1933 return unless $serialids;
1934 unless ( ref $serialids ) {
1935 $serialids = [ $serialids ];
1937 my $dbh = C4::Context->dbh;
1940 SET claimdate = NOW(),
1941 claims_count = claims_count + 1,
1943 WHERE serialid in (| . join( q|,|, (q|?|) x @$serialids ) . q|)|,
1944 {}, CLAIMED, @$serialids );
1947 =head2 getsupplierbyserialid
1949 $result = getsupplierbyserialid($serialid)
1951 this function is used to find the supplier id given a serial id
1954 hashref containing serialid, subscriptionid, and aqbooksellerid
1958 sub getsupplierbyserialid {
1959 my ($serialid) = @_;
1960 my $dbh = C4::Context->dbh;
1961 my $sth = $dbh->prepare(
1962 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1964 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1968 $sth->execute($serialid);
1969 my $line = $sth->fetchrow_hashref;
1970 my $result = $line->{'aqbooksellerid'};
1974 =head2 check_routing
1976 $result = &check_routing($subscriptionid)
1978 this function checks to see if a serial has a routing list and returns the count of routingid
1979 used to show either an 'add' or 'edit' link
1984 my ($subscriptionid) = @_;
1986 return unless ($subscriptionid);
1988 my $dbh = C4::Context->dbh;
1989 my $sth = $dbh->prepare(
1990 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1991 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1992 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1995 $sth->execute($subscriptionid);
1996 my $line = $sth->fetchrow_hashref;
1997 my $result = $line->{'routingids'};
2001 =head2 addroutingmember
2003 addroutingmember($borrowernumber,$subscriptionid)
2005 this function takes a borrowernumber and subscriptionid and adds the member to the
2006 routing list for that serial subscription and gives them a rank on the list
2007 of either 1 or highest current rank + 1
2011 sub addroutingmember {
2012 my ( $borrowernumber, $subscriptionid ) = @_;
2014 return unless ($borrowernumber and $subscriptionid);
2017 my $dbh = C4::Context->dbh;
2018 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2019 $sth->execute($subscriptionid);
2020 while ( my $line = $sth->fetchrow_hashref ) {
2021 if ( $line->{'rank'} > 0 ) {
2022 $rank = $line->{'rank'} + 1;
2027 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2028 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2031 =head2 reorder_members
2033 reorder_members($subscriptionid,$routingid,$rank)
2035 this function is used to reorder the routing list
2037 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2038 - it gets all members on list puts their routingid's into an array
2039 - removes the one in the array that is $routingid
2040 - then reinjects $routingid at point indicated by $rank
2041 - then update the database with the routingids in the new order
2045 sub reorder_members {
2046 my ( $subscriptionid, $routingid, $rank ) = @_;
2047 my $dbh = C4::Context->dbh;
2048 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2049 $sth->execute($subscriptionid);
2051 while ( my $line = $sth->fetchrow_hashref ) {
2052 push( @result, $line->{'routingid'} );
2055 # To find the matching index
2057 my $key = -1; # to allow for 0 being a valid response
2058 for ( $i = 0 ; $i < @result ; $i++ ) {
2059 if ( $routingid == $result[$i] ) {
2060 $key = $i; # save the index
2065 # if index exists in array then move it to new position
2066 if ( $key > -1 && $rank > 0 ) {
2067 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2068 my $moving_item = splice( @result, $key, 1 );
2069 splice( @result, $new_rank, 0, $moving_item );
2071 for ( my $j = 0 ; $j < @result ; $j++ ) {
2072 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2078 =head2 delroutingmember
2080 delroutingmember($routingid,$subscriptionid)
2082 this function either deletes one member from routing list if $routingid exists otherwise
2083 deletes all members from the routing list
2087 sub delroutingmember {
2089 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2090 my ( $routingid, $subscriptionid ) = @_;
2091 my $dbh = C4::Context->dbh;
2093 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2094 $sth->execute($routingid);
2095 reorder_members( $subscriptionid, $routingid );
2097 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2098 $sth->execute($subscriptionid);
2103 =head2 getroutinglist
2105 @routinglist = getroutinglist($subscriptionid)
2107 this gets the info from the subscriptionroutinglist for $subscriptionid
2110 the routinglist as an array. Each element of the array contains a hash_ref containing
2111 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2115 sub getroutinglist {
2116 my ($subscriptionid) = @_;
2117 my $dbh = C4::Context->dbh;
2118 my $sth = $dbh->prepare(
2119 'SELECT routingid, borrowernumber, ranking, biblionumber
2121 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2122 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2124 $sth->execute($subscriptionid);
2125 my $routinglist = $sth->fetchall_arrayref({});
2126 return @{$routinglist};
2129 =head2 countissuesfrom
2131 $result = countissuesfrom($subscriptionid,$startdate)
2133 Returns a count of serial rows matching the given subsctiptionid
2134 with published date greater than startdate
2138 sub countissuesfrom {
2139 my ( $subscriptionid, $startdate ) = @_;
2140 my $dbh = C4::Context->dbh;
2144 WHERE subscriptionid=?
2145 AND serial.publisheddate>?
2147 my $sth = $dbh->prepare($query);
2148 $sth->execute( $subscriptionid, $startdate );
2149 my ($countreceived) = $sth->fetchrow;
2150 return $countreceived;
2155 $result = CountIssues($subscriptionid)
2157 Returns a count of serial rows matching the given subsctiptionid
2162 my ($subscriptionid) = @_;
2163 my $dbh = C4::Context->dbh;
2167 WHERE subscriptionid=?
2169 my $sth = $dbh->prepare($query);
2170 $sth->execute($subscriptionid);
2171 my ($countreceived) = $sth->fetchrow;
2172 return $countreceived;
2177 $result = HasItems($subscriptionid)
2179 returns a count of items from serial matching the subscriptionid
2184 my ($subscriptionid) = @_;
2185 my $dbh = C4::Context->dbh;
2187 SELECT COUNT(serialitems.itemnumber)
2189 LEFT JOIN serialitems USING(serialid)
2190 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2192 my $sth=$dbh->prepare($query);
2193 $sth->execute($subscriptionid);
2194 my ($countitems)=$sth->fetchrow_array();
2198 =head2 abouttoexpire
2200 $result = abouttoexpire($subscriptionid)
2202 this function alerts you to the penultimate issue for a serial subscription
2204 returns 1 - if this is the penultimate issue
2210 my ($subscriptionid) = @_;
2211 my $dbh = C4::Context->dbh;
2212 my $subscription = GetSubscription($subscriptionid);
2213 my $per = $subscription->{'periodicity'};
2214 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2215 if ($frequency and $frequency->{unit}){
2217 my $expirationdate = GetExpirationDate($subscriptionid);
2219 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2220 my $nextdate = GetNextDate($subscription, $res);
2222 # only compare dates if both dates exist.
2223 if ($nextdate and $expirationdate) {
2224 if(Date::Calc::Delta_Days(
2225 split( /-/, $nextdate ),
2226 split( /-/, $expirationdate )
2232 } elsif ($subscription->{numberlength}>0) {
2233 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2239 sub in_array { # used in next sub down
2240 my ( $val, @elements ) = @_;
2241 foreach my $elem (@elements) {
2242 if ( $val == $elem ) {
2249 =head2 GetSubscriptionsFromBorrower
2251 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2253 this gets the info from subscriptionroutinglist for each $subscriptionid
2256 a count of the serial subscription routing lists to which a patron belongs,
2257 with the titles of those serial subscriptions as an array. Each element of the array
2258 contains a hash_ref with subscriptionID and title of subscription.
2262 sub GetSubscriptionsFromBorrower {
2263 my ($borrowernumber) = @_;
2264 my $dbh = C4::Context->dbh;
2265 my $sth = $dbh->prepare(
2266 "SELECT subscription.subscriptionid, biblio.title
2268 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2269 JOIN subscriptionroutinglist USING (subscriptionid)
2270 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2273 $sth->execute($borrowernumber);
2276 while ( my $line = $sth->fetchrow_hashref ) {
2278 push( @routinglist, $line );
2280 return ( $count, @routinglist );
2284 =head2 GetFictiveIssueNumber
2286 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2288 Get the position of the issue published at $publisheddate, considering the
2289 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2290 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2291 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2292 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2293 depending on how many rows are in serial table.
2294 The issue number calculation is based on subscription frequency, first acquisition
2295 date, and $publisheddate.
2299 sub GetFictiveIssueNumber {
2300 my ($subscription, $publisheddate) = @_;
2302 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2303 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2307 my ($year, $month, $day) = split /-/, $publisheddate;
2308 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2312 if($unit eq 'day') {
2313 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2314 } elsif($unit eq 'week') {
2315 ($wkno, $year) = Week_of_Year($year, $month, $day);
2316 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2317 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2318 } elsif($unit eq 'month') {
2319 $delta = ($fa_year == $year)
2320 ? ($month - $fa_month)
2321 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2322 } elsif($unit eq 'year') {
2323 $delta = $year - $fa_year;
2325 if($frequency->{'unitsperissue'} == 1) {
2326 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2328 # Assuming issuesperunit == 1
2329 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2335 sub _get_next_date_day {
2336 my ($subscription, $freqdata, $year, $month, $day) = @_;
2338 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2339 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2340 $subscription->{countissuesperunit} = 1;
2342 $subscription->{countissuesperunit}++;
2345 return ($year, $month, $day);
2348 sub _get_next_date_week {
2349 my ($subscription, $freqdata, $year, $month, $day) = @_;
2351 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2352 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2354 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2355 $subscription->{countissuesperunit} = 1;
2356 $wkno += $freqdata->{unitsperissue};
2361 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2362 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2364 # Try to guess the next day of week
2365 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2366 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2367 $subscription->{countissuesperunit}++;
2370 return ($year, $month, $day);
2373 sub _get_next_date_month {
2374 my ($subscription, $freqdata, $year, $month, $day) = @_;
2377 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2379 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2380 $subscription->{countissuesperunit} = 1;
2381 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2382 $freqdata->{unitsperissue});
2383 my $days_in_month = Days_in_Month($year, $month);
2384 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2386 # Try to guess the next day in month
2387 my $days_in_month = Days_in_Month($year, $month);
2388 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2389 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2390 $subscription->{countissuesperunit}++;
2393 return ($year, $month, $day);
2396 sub _get_next_date_year {
2397 my ($subscription, $freqdata, $year, $month, $day) = @_;
2399 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2401 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2402 $subscription->{countissuesperunit} = 1;
2403 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2405 my $days_in_month = Days_in_Month($year, $month);
2406 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2408 # Try to guess the next day in year
2409 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2410 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2411 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2412 $subscription->{countissuesperunit}++;
2415 return ($year, $month, $day);
2420 $resultdate = GetNextDate($publisheddate,$subscription)
2422 this function it takes the publisheddate and will return the next issue's date
2423 and will skip dates if there exists an irregularity.
2424 $publisheddate has to be an ISO date
2425 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2426 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2427 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2428 skipped then the returned date will be 2007-05-10
2431 $resultdate - then next date in the sequence (ISO date)
2433 Return undef if subscription is irregular
2438 my ( $subscription, $publisheddate, $updatecount ) = @_;
2440 return unless $subscription and $publisheddate;
2442 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2444 if ($freqdata->{'unit'}) {
2445 my ( $year, $month, $day ) = split /-/, $publisheddate;
2447 # Process an irregularity Hash
2448 # Suppose that irregularities are stored in a string with this structure
2449 # irreg1;irreg2;irreg3
2450 # where irregX is the number of issue which will not be received
2451 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2453 if ( $subscription->{irregularity} ) {
2454 my @irreg = split /;/, $subscription->{'irregularity'} ;
2455 foreach my $irregularity (@irreg) {
2456 $irregularities{$irregularity} = 1;
2460 # Get the 'fictive' next issue number
2461 # It is used to check if next issue is an irregular issue.
2462 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2464 # Then get the next date
2465 my $unit = lc $freqdata->{'unit'};
2466 if ($unit eq 'day') {
2467 while ($irregularities{$issueno}) {
2468 ($year, $month, $day) = _get_next_date_day($subscription,
2469 $freqdata, $year, $month, $day);
2472 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2473 $year, $month, $day);
2475 elsif ($unit eq 'week') {
2476 while ($irregularities{$issueno}) {
2477 ($year, $month, $day) = _get_next_date_week($subscription,
2478 $freqdata, $year, $month, $day);
2481 ($year, $month, $day) = _get_next_date_week($subscription,
2482 $freqdata, $year, $month, $day);
2484 elsif ($unit eq 'month') {
2485 while ($irregularities{$issueno}) {
2486 ($year, $month, $day) = _get_next_date_month($subscription,
2487 $freqdata, $year, $month, $day);
2490 ($year, $month, $day) = _get_next_date_month($subscription,
2491 $freqdata, $year, $month, $day);
2493 elsif ($unit eq 'year') {
2494 while ($irregularities{$issueno}) {
2495 ($year, $month, $day) = _get_next_date_year($subscription,
2496 $freqdata, $year, $month, $day);
2499 ($year, $month, $day) = _get_next_date_year($subscription,
2500 $freqdata, $year, $month, $day);
2504 my $dbh = C4::Context->dbh;
2507 SET countissuesperunit = ?
2508 WHERE subscriptionid = ?
2510 my $sth = $dbh->prepare($query);
2511 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2514 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2520 $string = &_numeration($value,$num_type,$locale);
2522 _numeration returns the string corresponding to $value in the num_type
2535 my ($value, $num_type, $locale) = @_;
2540 if ( $num_type =~ /^dayname$/ or $num_type =~ /^dayabrv$/ ) {
2541 # 1970-11-01 was a Sunday
2542 $value = $value % 7;
2543 my $dt = DateTime->new(
2549 $string = $num_type =~ /^dayname$/
2550 ? $dt->strftime("%A")
2551 : $dt->strftime("%a");
2552 } elsif ( $num_type =~ /^monthname$/ or $num_type =~ /^monthabrv$/ ) {
2553 $value = $value % 12;
2554 my $dt = DateTime->new(
2556 month => $value + 1,
2559 $string = $num_type =~ /^monthname$/
2560 ? $dt->strftime("%B")
2561 : $dt->strftime("%b");
2562 } elsif ( $num_type =~ /^season$/ ) {
2563 my @seasons= qw( Spring Summer Fall Winter );
2564 $value = $value % 4;
2565 $string = $seasons[$value];
2566 } elsif ( $num_type =~ /^seasonabrv$/ ) {
2567 my @seasonsabrv= qw( Spr Sum Fal Win );
2568 $value = $value % 4;
2569 $string = $seasonsabrv[$value];
2577 =head2 is_barcode_in_use
2579 Returns number of occurrences of the barcode in the items table
2580 Can be used as a boolean test of whether the barcode has
2581 been deployed as yet
2585 sub is_barcode_in_use {
2586 my $barcode = shift;
2587 my $dbh = C4::Context->dbh;
2588 my $occurrences = $dbh->selectall_arrayref(
2589 'SELECT itemnumber from items where barcode = ?',
2594 return @{$occurrences};
2597 =head2 CloseSubscription
2598 Close a subscription given a subscriptionid
2600 sub CloseSubscription {
2601 my ( $subscriptionid ) = @_;
2602 return unless $subscriptionid;
2603 my $dbh = C4::Context->dbh;
2604 my $sth = $dbh->prepare( q{
2607 WHERE subscriptionid = ?
2609 $sth->execute( $subscriptionid );
2611 # Set status = missing when status = stopped
2612 $sth = $dbh->prepare( q{
2615 WHERE subscriptionid = ?
2618 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2621 =head2 ReopenSubscription
2622 Reopen a subscription given a subscriptionid
2624 sub ReopenSubscription {
2625 my ( $subscriptionid ) = @_;
2626 return unless $subscriptionid;
2627 my $dbh = C4::Context->dbh;
2628 my $sth = $dbh->prepare( q{
2631 WHERE subscriptionid = ?
2633 $sth->execute( $subscriptionid );
2635 # Set status = expected when status = stopped
2636 $sth = $dbh->prepare( q{
2639 WHERE subscriptionid = ?
2642 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2645 =head2 subscriptionCurrentlyOnOrder
2647 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2649 Return 1 if subscription is currently on order else 0.
2653 sub subscriptionCurrentlyOnOrder {
2654 my ( $subscriptionid ) = @_;
2655 my $dbh = C4::Context->dbh;
2657 SELECT COUNT(*) FROM aqorders
2658 WHERE subscriptionid = ?
2659 AND datereceived IS NULL
2660 AND datecancellationprinted IS NULL
2662 my $sth = $dbh->prepare( $query );
2663 $sth->execute($subscriptionid);
2664 return $sth->fetchrow_array;
2667 =head2 can_claim_subscription
2669 $can = can_claim_subscription( $subscriptionid[, $userid] );
2671 Return 1 if the subscription can be claimed by the current logged user (or a given $userid), else 0.
2675 sub can_claim_subscription {
2676 my ( $subscription, $userid ) = @_;
2677 return _can_do_on_subscription( $subscription, $userid, 'claim_serials' );
2680 =head2 can_edit_subscription
2682 $can = can_edit_subscription( $subscriptionid[, $userid] );
2684 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2688 sub can_edit_subscription {
2689 my ( $subscription, $userid ) = @_;
2690 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2693 =head2 can_show_subscription
2695 $can = can_show_subscription( $subscriptionid[, $userid] );
2697 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2701 sub can_show_subscription {
2702 my ( $subscription, $userid ) = @_;
2703 return _can_do_on_subscription( $subscription, $userid, '*' );
2706 sub _can_do_on_subscription {
2707 my ( $subscription, $userid, $permission ) = @_;
2708 return 0 unless C4::Context->userenv;
2709 my $flags = C4::Context->userenv->{flags};
2710 $userid ||= C4::Context->userenv->{'id'};
2712 if ( C4::Context->preference('IndependentBranches') ) {
2714 if C4::Context->IsSuperLibrarian()
2716 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2718 C4::Auth::haspermission( $userid,
2719 { serials => $permission } )
2720 and ( not defined $subscription->{branchcode}
2721 or $subscription->{branchcode} eq ''
2722 or $subscription->{branchcode} eq
2723 C4::Context->userenv->{'branch'} )
2728 if C4::Context->IsSuperLibrarian()
2730 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2731 or C4::Auth::haspermission(
2732 $userid, { serials => $permission }
2739 =head2 findSerialsByStatus
2741 @serials = findSerialsByStatus($status, $subscriptionid);
2743 Returns an array of serials matching a given status and subscription id.
2747 sub findSerialsByStatus {
2748 my ( $status, $subscriptionid ) = @_;
2749 my $dbh = C4::Context->dbh;
2750 my $query = q| SELECT * from serial
2752 AND subscriptionid = ?
2754 my $serials = $dbh->selectall_arrayref( $query, { Slice => {} }, $status, $subscriptionid );
2763 Koha Development Team <http://koha-community.org/>