1 package FS::cust_main::Packages;
4 use List::Util qw( min );
6 use FS::Record qw( qsearch qsearchs );
9 use FS::contact; # for attach_pkgs
10 use FS::cust_location; #
12 our ($DEBUG, $me) = (0, '[FS::cust_main::Packages]');
13 our $skip_label_sort = 0;
17 FS::cust_main::Packages - Packages mixin for cust_main
23 These methods are available on FS::cust_main objects;
29 =item order_pkg HASHREF | OPTION => VALUE ...
31 Orders a single package.
33 Note that if the package definition has supplemental packages, those will
36 Options may be passed as a list of key/value pairs or as a hash reference.
47 Optional FS::cust_location object. If not specified, the customer's
48 ship_location will be used.
52 Optional arryaref of FS::svc_* service objects.
56 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
57 jobs will have a dependancy on the supplied job (they will not run until the
58 specific job completes). This can be used to defer provisioning until some
59 action completes (such as running the customer's credit card successfully).
63 This option is option is deprecated but still works for now (use
64 I<depend_jobnum> instead for new code). If I<noexport> is set true, no
65 provisioning jobs (exports) are scheduled. (You can schedule them later with
66 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
67 on the cust_main object is not recommended, as existing services will also be
72 Optional subject for a ticket created and attached to this customer
76 Optional queue name for ticket additions
80 Optional arrayref of invoice detail strings to add (creates cust_pkg_detail detailtype 'I')
82 =item package_comments
84 Optional arrayref of package comment strings to add (creates cust_pkg_detail detailtype 'C')
92 my $opt = ref($_[0]) ? shift : { @_ };
94 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
96 warn "$me order_pkg called with options ".
97 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
100 local $FS::svc_Common::noexport_hack = 1 if $opt->{'noexport'};
102 my $cust_pkg = $opt->{'cust_pkg'};
103 my $svcs = $opt->{'svcs'} || [];
105 my %svc_options = ();
106 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
107 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
109 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
110 qw( ticket_subject ticket_queue allow_pkgpart );
112 local $SIG{HUP} = 'IGNORE';
113 local $SIG{INT} = 'IGNORE';
114 local $SIG{QUIT} = 'IGNORE';
115 local $SIG{TERM} = 'IGNORE';
116 local $SIG{TSTP} = 'IGNORE';
117 local $SIG{PIPE} = 'IGNORE';
119 my $oldAutoCommit = $FS::UID::AutoCommit;
120 local $FS::UID::AutoCommit = 0;
123 if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
125 $cust_pkg->contactnum($opt->{'contactnum'});
127 } elsif ( $opt->{'contact'} ) {
129 if ( ! $opt->{'contact'}->contactnum ) {
131 my $error = $opt->{'contact'}->insert;
133 $dbh->rollback if $oldAutoCommit;
134 return "inserting contact (transaction rolled back): $error";
137 $cust_pkg->contactnum($opt->{'contact'}->contactnum);
141 # $cust_pkg->contactnum();
145 if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
147 $cust_pkg->locationnum($opt->{'locationnum'});
149 } elsif ( $opt->{'cust_location'} ) {
151 my $error = $opt->{'cust_location'}->find_or_insert;
153 $dbh->rollback if $oldAutoCommit;
154 return "inserting cust_location (transaction rolled back): $error";
156 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
158 } elsif ( ! $cust_pkg->locationnum ) {
160 $cust_pkg->locationnum($self->ship_locationnum);
164 $cust_pkg->custnum( $self->custnum );
166 my $error = $cust_pkg->insert( %insert_params );
168 $dbh->rollback if $oldAutoCommit;
169 return "inserting cust_pkg (transaction rolled back): $error";
172 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
173 if ( $svc_something->svcnum ) {
174 my $old_cust_svc = $svc_something->cust_svc;
175 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
176 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
177 $error = $new_cust_svc->replace($old_cust_svc);
179 $svc_something->pkgnum( $cust_pkg->pkgnum );
180 if ( $svc_something->isa('FS::svc_acct') ) {
181 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
182 qw( seconds upbytes downbytes totalbytes ) ) {
183 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
184 ${ $opt->{$_.'_ref'} } = 0;
187 $error = $svc_something->insert(%svc_options);
190 $dbh->rollback if $oldAutoCommit;
191 return "inserting svc_ (transaction rolled back): $error";
195 # add supplemental packages, if any are needed
196 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
197 foreach my $link ($part_pkg->supp_part_pkg_link) {
198 #warn "inserting supplemental package ".$link->dst_pkgpart;
199 my $pkg = FS::cust_pkg->new({
200 'pkgpart' => $link->dst_pkgpart,
201 'pkglinknum' => $link->pkglinknum,
202 'custnum' => $self->custnum,
203 'main_pkgnum' => $cust_pkg->pkgnum,
204 # try to prevent as many surprises as possible
205 'allow_pkgpart' => $opt->{'allow_pkgpart'},
206 map { $_ => $cust_pkg->$_() }
208 start_date order_date expire adjourn contract_end
209 refnum setup_discountnum recur_discountnum waive_setup
212 $error = $self->order_pkg('cust_pkg' => $pkg,
213 'locationnum' => $cust_pkg->locationnum);
215 $dbh->rollback if $oldAutoCommit;
216 return "inserting supplemental package: $error";
220 # add details/comments
221 if ($opt->{'invoice_details'}) {
222 $error = $cust_pkg->set_cust_pkg_detail('I', @{$opt->{'invoice_details'}});
225 $dbh->rollback if $oldAutoCommit;
226 return "setting invoice details: $error";
228 if ($opt->{'package_comments'}) {
229 $error = $cust_pkg->set_cust_pkg_detail('C', @{$opt->{'package_comments'}});
232 $dbh->rollback if $oldAutoCommit;
233 return "setting package comments: $error";
236 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
241 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
243 Like the insert method on an existing record, this method orders multiple
244 packages and included services atomicaly. Pass a Tie::RefHash data structure
245 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
246 There should be a better explanation of this, but until then, here's an
250 tie %hash, 'Tie::RefHash'; #this part is important
252 $cust_pkg => [ $svc_acct ],
255 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
257 Services can be new, in which case they are inserted, or existing unaudited
258 services, in which case they are linked to the newly-created package.
260 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
261 I<upbytes_ref>, I<downbytes_ref>, I<totalbytes_ref>, and I<allow_pkgpart>.
263 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
264 on the supplied jobnum (they will not run until the specific job completes).
265 This can be used to defer provisioning until some action completes (such
266 as running the customer's credit card successfully).
268 The I<noexport> option is deprecated but still works for now (use
269 I<depend_jobnum> instead for new code). If I<noexport> is set true, no
270 provisioning jobs (exports) are scheduled. (You can schedule them later with
271 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
272 on the cust_main object is not recommended, as existing services will also be
275 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
276 provided, the scalars (provided by references) will be incremented by the
277 values of the prepaid card.`
279 I<allow_pkgpart> is passed to L<FS::cust_pkg>->insert.
285 my $cust_pkgs = shift;
288 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
290 warn "$me order_pkgs called with options ".
291 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
294 local $SIG{HUP} = 'IGNORE';
295 local $SIG{INT} = 'IGNORE';
296 local $SIG{QUIT} = 'IGNORE';
297 local $SIG{TERM} = 'IGNORE';
298 local $SIG{TSTP} = 'IGNORE';
299 local $SIG{PIPE} = 'IGNORE';
301 my $oldAutoCommit = $FS::UID::AutoCommit;
302 local $FS::UID::AutoCommit = 0;
305 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
307 foreach my $cust_pkg ( keys %$cust_pkgs ) {
309 my $error = $self->order_pkg(
310 'cust_pkg' => $cust_pkg,
311 'svcs' => $cust_pkgs->{$cust_pkg},
312 map { $_ => $options{$_} }
313 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum allow_pkgpart )
316 $dbh->rollback if $oldAutoCommit;
322 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
328 Merges this customer's package's into the target customer and then cancels them.
333 my( $self, $new_custnum ) = @_;
335 #mostly false laziness w/ merge
337 return "Can't attach packages to self" if $self->custnum == $new_custnum;
339 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
340 or return "Invalid new customer number: $new_custnum";
342 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
343 if $self->agentnum != $new_cust_main->agentnum
344 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
346 local $SIG{HUP} = 'IGNORE';
347 local $SIG{INT} = 'IGNORE';
348 local $SIG{QUIT} = 'IGNORE';
349 local $SIG{TERM} = 'IGNORE';
350 local $SIG{TSTP} = 'IGNORE';
351 local $SIG{PIPE} = 'IGNORE';
353 my $oldAutoCommit = $FS::UID::AutoCommit;
354 local $FS::UID::AutoCommit = 0;
357 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
358 $dbh->rollback if $oldAutoCommit;
359 return "Can't merge a master agent customer";
363 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
364 $dbh->rollback if $oldAutoCommit;
365 return "Can't merge a master employee customer";
368 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
369 'status' => { op=>'!=', value=>'done' },
373 $dbh->rollback if $oldAutoCommit;
374 return "Can't merge a customer with pending payments";
377 #end of false laziness
381 my %contact_hash = ( 'first' => $self->first,
382 'last' => $self->get('last'),
383 'custnum' => $new_custnum,
387 my $contact = qsearchs( 'contact', \%contact_hash)
388 || new FS::contact \%contact_hash;
389 unless ( $contact->contactnum ) {
390 my $error = $contact->insert;
392 $dbh->rollback if $oldAutoCommit;
397 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
399 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
400 my %loc_hash = $cust_location->hash;
401 $loc_hash{'locationnum'} = '';
402 $loc_hash{'custnum'} = $new_custnum;
403 $loc_hash{'disabled'} = '';
404 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
405 || new FS::cust_location \%loc_hash;
407 my $pkg_or_error = $cust_pkg->change( {
409 'cust_main' => $new_cust_main,
410 'contactnum' => $contact->contactnum,
411 'cust_location' => $new_cust_location,
414 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
417 $dbh->rollback if $oldAutoCommit;
423 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
428 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
430 Returns all packages (see L<FS::cust_pkg>) for this customer.
436 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
438 return $self->num_pkgs($extra_qsearch) unless wantarray;
441 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
442 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
444 @cust_pkg = $self->_cust_pkg($extra_qsearch);
447 local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
448 map { $_ } sort sort_packages @cust_pkg;
454 Synonym for B<all_pkgs>.
462 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
464 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
468 sub ncancelled_pkgs {
470 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
472 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
474 return $self->num_ncancelled_pkgs($extra_qsearch) unless wantarray;
477 if ( $self->{'_pkgnum'} ) {
479 warn "$me ncancelled_pkgs: returning cached objects"
482 @cust_pkg = grep { ! $_->getfield('cancel') }
483 values %{ $self->{'_pkgnum'}->cache };
487 warn "$me ncancelled_pkgs: searching for packages with custnum ".
491 $extra_qsearch->{'extra_sql'} .=
492 ' AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ';
494 @cust_pkg = $self->_cust_pkg($extra_qsearch);
498 local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
499 sort sort_packages @cust_pkg;
503 =item cancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
505 Returns all cancelled packages (see L<FS::cust_pkg>) for this customer.
511 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
513 return $self->num_cancelled_pkgs($extra_qsearch) unless wantarray;
515 $extra_qsearch->{'extra_sql'} .=
516 ' AND cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel > 0 ';
518 local($skip_label_sort) = 1 if $extra_qsearch->{skip_label_sort};
520 sort sort_packages $self->_cust_pkg($extra_qsearch);
525 my $extra_qsearch = ref($_[0]) ? shift : {};
527 $extra_qsearch->{'select'} ||= '*';
528 $extra_qsearch->{'select'} .=
529 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
533 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
538 'table' => 'cust_pkg',
539 'hashref' => { 'custnum' => $self->custnum },
544 # This should be generalized to use config options to determine order.
547 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
548 return $locationsort if $locationsort;
550 if ( $a->get('cancel') xor $b->get('cancel') ) {
551 return -1 if $b->get('cancel');
552 return 1 if $a->get('cancel');
553 #shouldn't get here...
556 my $a_num_cust_svc = $a->num_cust_svc;
557 my $b_num_cust_svc = $b->num_cust_svc;
558 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
559 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
560 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
561 return 0 if $skip_label_sort
562 || $a_num_cust_svc + $b_num_cust_svc > 20; #for perf, just give up
563 my @a_cust_svc = $a->cust_svc_unsorted;
564 my @b_cust_svc = $b->cust_svc_unsorted;
565 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
566 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
567 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
568 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
573 =item suspended_pkgs OPTION => VALUE ...
575 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
577 Currently supports one option, I<reason_type>, which if set to a typenum,
578 limits the results to packages which were suspended for reasons of this type.
579 (Does not currently work in scalar context; i.e. when just asking for a count.)
587 return $self->num_suspended_pkgs unless wantarray; #XXX opt in scalar context
589 my @pkgs = grep { $_->susp } $self->ncancelled_pkgs;
591 if ( $opt{reason_type} ) {
592 @pkgs = grep { my $r = $_->last_reason('susp');
593 $r && $r->reason_type == $opt{reason_type};
601 ### This appears to be unused, will be going away
603 #=item unflagged_suspended_pkgs
605 #Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
606 #customer (thouse packages without the `manual_flag' set).
610 sub unflagged_suspended_pkgs {
612 return $self->suspended_pkgs
613 unless dbdef->table('cust_pkg')->column('manual_flag');
614 grep { ! $_->manual_flag } $self->suspended_pkgs;
617 =item unsuspended_pkgs
619 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
624 sub unsuspended_pkgs {
626 return $self->num_unsuspended_pkgs unless wantarray;
627 grep { ! $_->susp } $self->ncancelled_pkgs;
632 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
633 this customer that are active (recurring).
637 #recurring_pkgs? different from cust_pkg idea of "active" which has
638 # a setup vs not_yet_billed which doesn't
641 grep { my $part_pkg = $_->part_pkg;
642 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
644 $self->unsuspended_pkgs;
647 =item ncancelled_active_pkgs
649 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
650 are active (recurring).
654 #ncancelled_recurring_pkgs? different from cust_pkg idea of "active" which has
655 # a setup vs not_yet_billed which doesn't
656 sub ncancelled_active_pkgs {
658 grep { my $part_pkg = $_->part_pkg;
659 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
661 $self->ncancelled_pkgs;
666 Returns active packages, and also any suspended packages which are set to
667 continue billing while suspended.
673 grep { my $part_pkg = $_->part_pkg;
674 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
675 && ( ! $_->susp || $_->option('suspend_bill',1)
676 || ( $part_pkg->option('suspend_bill', 1)
677 && ! $_->option('no_suspend_bill',1)
681 $self->ncancelled_pkgs;
686 Returns the next date this customer will be billed, as a UNIX timestamp, or
687 undef if no billing package has a next bill date.
694 # super inefficient with lots of packages
695 # min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
697 my $custnum = $self->custnum;
700 SELECT MIN(bill) FROM cust_pkg
701 LEFT JOIN cust_pkg_option AS cust_suspend_bill_option
702 ON ( cust_pkg.pkgnum = cust_suspend_bill_option.pkgnum
703 AND cust_suspend_bill_option.optionname = 'suspend_bill' )
704 LEFT JOIN cust_pkg_option AS cust_no_suspend_bill_option
705 ON ( cust_pkg.pkgnum = cust_no_suspend_bill_option.pkgnum
706 AND cust_no_suspend_bill_option.optionname = 'no_suspend_bill' )
707 LEFT JOIN part_pkg USING (pkgpart)
708 LEFT JOIN part_pkg_option AS part_suspend_bill_option
709 ON ( part_pkg.pkgpart = part_suspend_bill_option.pkgpart
710 AND part_suspend_bill_option.optionname = 'suspend_bill' )
711 WHERE custnum = $custnum
712 AND bill IS NOT NULL AND bill != 0
713 AND ( cancel IS NULL OR cancel = 0 )
714 AND part_pkg.freq != '' AND part_pkg.freq != '0'
715 AND ( ( susp IS NULL OR susp = 0 )
716 OR COALESCE(cust_suspend_bill_option.optionvalue,'0') = '1'
717 OR ( COALESCE(part_suspend_bill_option.optionvalue,'0') = '1'
718 AND COALESCE(cust_no_suspend_bill_option.optionvalue,'0') = '0'
725 =item num_cancelled_pkgs
727 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
732 sub num_cancelled_pkgs {
734 my $opt = shift || {};
735 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
736 $opt->{extra_sql} .= "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
737 $self->num_pkgs($opt);
740 =item num_ncancelled_pkgs
742 Returns the number of packages that have not been cancelled (see L<FS::cust_pkg>) for this
747 sub num_ncancelled_pkgs {
749 my $opt = shift || {};
750 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
751 $opt->{extra_sql} .= "( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )";
752 $self->num_pkgs($opt);
755 =item num_billing_pkgs
757 Returns the number of packages that have not been cancelled
758 and have a non-zero billing frequency (see L<FS::cust_pkg>)
763 sub num_billing_pkgs {
765 my $opt = shift || {};
766 $opt->{addl_from} .= ' LEFT JOIN part_pkg USING (pkgpart)';
767 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
768 $opt->{extra_sql} .= "freq IS NOT NULL AND freq != '0'";
769 $self->num_ncancelled_pkgs($opt);
772 sub num_suspended_pkgs {
774 my $opt = shift || {};
775 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
776 $opt->{extra_sql} .= " ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
777 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ";
778 $self->num_pkgs($opt);
781 sub num_unsuspended_pkgs {
783 my $opt = shift || {};
784 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
785 $opt->{extra_sql} .= " ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
786 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )";
787 $self->num_pkgs($opt);
797 $sql = $opt->{extra_sql} if exists($opt->{extra_sql});
798 $addl_from = $opt->{addl_from} if exists($opt->{addl_from});
803 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
804 my $sth = dbh->prepare(
805 "SELECT COUNT(*) FROM cust_pkg $addl_from WHERE cust_pkg.custnum = ? $sql"
806 ) or die dbh->errstr;
807 $sth->execute($self->custnum) or die $sth->errstr;
808 $sth->fetchrow_arrayref->[0];
813 Returns the number of packages for this customer that have services that
814 can have RADIUS usage statistics.
820 # have to enumerate exportnums but it's not bad
821 my @exportnums = map { $_->exportnum }
822 grep { $_->can('usage_sessions') }
823 qsearch('part_export');
824 return 0 if !@exportnums;
825 my $in_exportnums = join(',', @exportnums);
826 my $sql = "SELECT COUNT(DISTINCT pkgnum) FROM cust_pkg
827 JOIN cust_svc USING (pkgnum)
828 JOIN export_svc USING (svcpart)
829 WHERE exportnum IN( $in_exportnums ) AND custnum = ?";
830 FS::Record->scalar_sql($sql, $self->custnum);
833 =item display_recurring
835 Returns an array of hash references, one for each recurring freq
836 on billable customer packages, with keys of freq, freq_pretty and amount
837 (the amount that this customer will next be charged at the given frequency.)
839 Results will be numerically sorted by freq.
841 Only intended for display purposes, not used for actual billing.
845 sub display_recurring {
846 my $cust_main = shift;
848 my $sth = dbh->prepare("
849 SELECT DISTINCT freq FROM cust_pkg LEFT JOIN part_pkg USING (pkgpart)
850 WHERE freq IS NOT NULL AND freq != '0'
851 AND ( cancel IS NULL OR cancel = 0 )
853 ") or die $DBI::errstr;
855 $sth->execute($cust_main->custnum) or die $sth->errstr;
857 #not really a numeric sort because freqs can actually be all sorts of things
858 # but good enough for the 99% cases of ordering monthly quarterly annually
859 my @freqs = sort { $a <=> $b } map { $_->[0] } @{ $sth->fetchall_arrayref };
865 foreach my $freq (@freqs) {
867 my @cust_pkg = qsearch({
868 'table' => 'cust_pkg',
869 'addl_from' => 'LEFT JOIN part_pkg USING (pkgpart)',
870 'hashref' => { 'custnum' => $cust_main->custnum, },
871 'extra_sql' => 'AND ( cancel IS NULL OR cancel = 0 )
872 AND freq = '. dbh->quote($freq),
873 'order_by' => 'ORDER BY COALESCE(start_date,0), pkgnum', # to ensure old pkgs come before change_to_pkg
876 my $freq_pretty = $cust_pkg[0]->part_pkg->freq_pretty;
880 foreach my $cust_pkg (@cust_pkg) {
881 my $part_pkg = $cust_pkg->part_pkg;
882 next if $cust_pkg->susp
883 && ! $cust_pkg->option('suspend_bill')
884 && ( ! $part_pkg->option('suspend_bill')
885 || $cust_pkg->option('no_suspend_bill')
889 next if $skip_pkg->{$cust_pkg->pkgnum};
890 if ($cust_pkg->change_to_pkgnum) {
891 #if change is on or before next bill date, use new pkg
892 next if $cust_pkg->expire <= $cust_pkg->bill;
893 #if change is after next bill date, use old (this) pkg
894 $skip_pkg->{$cust_pkg->change_to_pkgnum} = 1;
899 #add recurring amounts for this package and its billing add-ons
900 foreach my $l_part_pkg ( $part_pkg->self_and_bill_linked ) {
901 $pkg_amount += $l_part_pkg->base_recur($cust_pkg);
904 #subtract amounts for any active discounts
905 #(there should only be one at the moment, otherwise this makes no sense)
906 foreach my $cust_pkg_discount ( $cust_pkg->cust_pkg_discount_active ) {
907 my $discount = $cust_pkg_discount->discount;
908 #and only one of these for each
909 $pkg_amount -= $discount->amount;
910 $pkg_amount -= $pkg_amount * $discount->percent/100;
913 $pkg_amount *= ( $cust_pkg->quantity || 1 );
915 $amount += $pkg_amount;
922 'freq_pretty' => $freq_pretty,
937 L<FS::cust_main>, L<FS::cust_pkg>