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]');
16 FS::cust_main::Packages - Packages mixin for cust_main
22 These methods are available on FS::cust_main objects;
28 =item order_pkg HASHREF | OPTION => VALUE ...
30 Orders a single package.
32 Note that if the package definition has supplemental packages, those will
35 Options may be passed as a list of key/value pairs or as a hash reference.
46 Optional FS::cust_location object. If not specified, the customer's
47 ship_location will be used.
51 Optional arryaref of FS::svc_* service objects.
55 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
56 jobs will have a dependancy on the supplied job (they will not run until the
57 specific job completes). This can be used to defer provisioning until some
58 action completes (such as running the customer's credit card successfully).
62 This option is option is deprecated but still works for now (use
63 I<depend_jobnum> instead for new code). If I<noexport> is set true, no
64 provisioning jobs (exports) are scheduled. (You can schedule them later with
65 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
66 on the cust_main object is not recommended, as existing services will also be
71 Optional subject for a ticket created and attached to this customer
75 Optional queue name for ticket additions
79 Optional arrayref of invoice detail strings to add (creates cust_pkg_detail detailtype 'I')
81 =item package_comments
83 Optional arrayref of package comment strings to add (creates cust_pkg_detail detailtype 'C')
91 my $opt = ref($_[0]) ? shift : { @_ };
93 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
95 warn "$me order_pkg called with options ".
96 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
99 local $FS::svc_Common::noexport_hack = 1 if $opt->{'noexport'};
101 my $cust_pkg = $opt->{'cust_pkg'};
102 my $svcs = $opt->{'svcs'} || [];
104 my %svc_options = ();
105 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
106 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
108 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
109 qw( ticket_subject ticket_queue allow_pkgpart );
111 local $SIG{HUP} = 'IGNORE';
112 local $SIG{INT} = 'IGNORE';
113 local $SIG{QUIT} = 'IGNORE';
114 local $SIG{TERM} = 'IGNORE';
115 local $SIG{TSTP} = 'IGNORE';
116 local $SIG{PIPE} = 'IGNORE';
118 my $oldAutoCommit = $FS::UID::AutoCommit;
119 local $FS::UID::AutoCommit = 0;
122 if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
124 $cust_pkg->contactnum($opt->{'contactnum'});
126 } elsif ( $opt->{'contact'} ) {
128 if ( ! $opt->{'contact'}->contactnum ) {
130 my $error = $opt->{'contact'}->insert;
132 $dbh->rollback if $oldAutoCommit;
133 return "inserting contact (transaction rolled back): $error";
136 $cust_pkg->contactnum($opt->{'contact'}->contactnum);
140 # $cust_pkg->contactnum();
144 if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
146 $cust_pkg->locationnum($opt->{'locationnum'});
148 } elsif ( $opt->{'cust_location'} ) {
150 my $error = $opt->{'cust_location'}->find_or_insert;
152 $dbh->rollback if $oldAutoCommit;
153 return "inserting cust_location (transaction rolled back): $error";
155 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
159 $cust_pkg->locationnum($self->ship_locationnum);
163 $cust_pkg->custnum( $self->custnum );
165 my $error = $cust_pkg->insert( %insert_params );
167 $dbh->rollback if $oldAutoCommit;
168 return "inserting cust_pkg (transaction rolled back): $error";
171 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
172 if ( $svc_something->svcnum ) {
173 my $old_cust_svc = $svc_something->cust_svc;
174 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
175 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
176 $error = $new_cust_svc->replace($old_cust_svc);
178 $svc_something->pkgnum( $cust_pkg->pkgnum );
179 if ( $svc_something->isa('FS::svc_acct') ) {
180 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
181 qw( seconds upbytes downbytes totalbytes ) ) {
182 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
183 ${ $opt->{$_.'_ref'} } = 0;
186 $error = $svc_something->insert(%svc_options);
189 $dbh->rollback if $oldAutoCommit;
190 return "inserting svc_ (transaction rolled back): $error";
194 # add supplemental packages, if any are needed
195 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
196 foreach my $link ($part_pkg->supp_part_pkg_link) {
197 #warn "inserting supplemental package ".$link->dst_pkgpart;
198 my $pkg = FS::cust_pkg->new({
199 'pkgpart' => $link->dst_pkgpart,
200 'pkglinknum' => $link->pkglinknum,
201 'custnum' => $self->custnum,
202 'main_pkgnum' => $cust_pkg->pkgnum,
203 # try to prevent as many surprises as possible
204 'allow_pkgpart' => $opt->{'allow_pkgpart'},
205 map { $_ => $cust_pkg->$_() }
207 start_date order_date expire adjourn contract_end
208 refnum setup_discountnum recur_discountnum waive_setup
211 $error = $self->order_pkg('cust_pkg' => $pkg,
212 'locationnum' => $cust_pkg->locationnum);
214 $dbh->rollback if $oldAutoCommit;
215 return "inserting supplemental package: $error";
219 # add details/comments
220 if ($opt->{'invoice_details'}) {
221 $error = $cust_pkg->set_cust_pkg_detail('I', @{$opt->{'invoice_details'}});
224 $dbh->rollback if $oldAutoCommit;
225 return "setting invoice details: $error";
227 if ($opt->{'package_comments'}) {
228 $error = $cust_pkg->set_cust_pkg_detail('C', @{$opt->{'package_comments'}});
231 $dbh->rollback if $oldAutoCommit;
232 return "setting package comments: $error";
235 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
240 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
242 Like the insert method on an existing record, this method orders multiple
243 packages and included services atomicaly. Pass a Tie::RefHash data structure
244 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
245 There should be a better explanation of this, but until then, here's an
249 tie %hash, 'Tie::RefHash'; #this part is important
251 $cust_pkg => [ $svc_acct ],
254 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
256 Services can be new, in which case they are inserted, or existing unaudited
257 services, in which case they are linked to the newly-created package.
259 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
260 I<upbytes_ref>, I<downbytes_ref>, I<totalbytes_ref>, and I<allow_pkgpart>.
262 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
263 on the supplied jobnum (they will not run until the specific job completes).
264 This can be used to defer provisioning until some action completes (such
265 as running the customer's credit card successfully).
267 The I<noexport> option is deprecated but still works for now (use
268 I<depend_jobnum> instead for new code). If I<noexport> is set true, no
269 provisioning jobs (exports) are scheduled. (You can schedule them later with
270 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
271 on the cust_main object is not recommended, as existing services will also be
274 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
275 provided, the scalars (provided by references) will be incremented by the
276 values of the prepaid card.`
278 I<allow_pkgpart> is passed to L<FS::cust_pkg>->insert.
284 my $cust_pkgs = shift;
287 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
289 warn "$me order_pkgs called with options ".
290 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
293 local $SIG{HUP} = 'IGNORE';
294 local $SIG{INT} = 'IGNORE';
295 local $SIG{QUIT} = 'IGNORE';
296 local $SIG{TERM} = 'IGNORE';
297 local $SIG{TSTP} = 'IGNORE';
298 local $SIG{PIPE} = 'IGNORE';
300 my $oldAutoCommit = $FS::UID::AutoCommit;
301 local $FS::UID::AutoCommit = 0;
304 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
306 foreach my $cust_pkg ( keys %$cust_pkgs ) {
308 my $error = $self->order_pkg(
309 'cust_pkg' => $cust_pkg,
310 'svcs' => $cust_pkgs->{$cust_pkg},
311 map { $_ => $options{$_} }
312 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum allow_pkgpart )
315 $dbh->rollback if $oldAutoCommit;
321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
327 Merges this customer's package's into the target customer and then cancels them.
332 my( $self, $new_custnum ) = @_;
334 #mostly false laziness w/ merge
336 return "Can't attach packages to self" if $self->custnum == $new_custnum;
338 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
339 or return "Invalid new customer number: $new_custnum";
341 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
342 if $self->agentnum != $new_cust_main->agentnum
343 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
345 local $SIG{HUP} = 'IGNORE';
346 local $SIG{INT} = 'IGNORE';
347 local $SIG{QUIT} = 'IGNORE';
348 local $SIG{TERM} = 'IGNORE';
349 local $SIG{TSTP} = 'IGNORE';
350 local $SIG{PIPE} = 'IGNORE';
352 my $oldAutoCommit = $FS::UID::AutoCommit;
353 local $FS::UID::AutoCommit = 0;
356 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
357 $dbh->rollback if $oldAutoCommit;
358 return "Can't merge a master agent customer";
362 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
363 $dbh->rollback if $oldAutoCommit;
364 return "Can't merge a master employee customer";
367 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
368 'status' => { op=>'!=', value=>'done' },
372 $dbh->rollback if $oldAutoCommit;
373 return "Can't merge a customer with pending payments";
376 #end of false laziness
380 my %contact_hash = ( 'first' => $self->first,
381 'last' => $self->get('last'),
382 'custnum' => $new_custnum,
386 my $contact = qsearchs( 'contact', \%contact_hash)
387 || new FS::contact \%contact_hash;
388 unless ( $contact->contactnum ) {
389 my $error = $contact->insert;
391 $dbh->rollback if $oldAutoCommit;
396 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
398 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
399 my %loc_hash = $cust_location->hash;
400 $loc_hash{'locationnum'} = '';
401 $loc_hash{'custnum'} = $new_custnum;
402 $loc_hash{'disabled'} = '';
403 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
404 || new FS::cust_location \%loc_hash;
406 my $pkg_or_error = $cust_pkg->change( {
408 'cust_main' => $new_cust_main,
409 'contactnum' => $contact->contactnum,
410 'cust_location' => $new_cust_location,
413 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
416 $dbh->rollback if $oldAutoCommit;
422 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
427 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
429 Returns all packages (see L<FS::cust_pkg>) for this customer.
435 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
437 return $self->num_pkgs($extra_qsearch) unless wantarray;
440 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
441 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
443 @cust_pkg = $self->_cust_pkg($extra_qsearch);
446 map { $_ } sort sort_packages @cust_pkg;
451 Synonym for B<all_pkgs>.
459 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
461 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
465 sub ncancelled_pkgs {
467 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
469 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
471 return $self->num_ncancelled_pkgs($extra_qsearch) unless wantarray;
474 if ( $self->{'_pkgnum'} ) {
476 warn "$me ncancelled_pkgs: returning cached objects"
479 @cust_pkg = grep { ! $_->getfield('cancel') }
480 values %{ $self->{'_pkgnum'}->cache };
484 warn "$me ncancelled_pkgs: searching for packages with custnum ".
488 $extra_qsearch->{'extra_sql'} .=
489 ' AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ';
491 @cust_pkg = $self->_cust_pkg($extra_qsearch);
495 sort sort_packages @cust_pkg;
501 my $extra_qsearch = ref($_[0]) ? shift : {};
503 $extra_qsearch->{'select'} ||= '*';
504 $extra_qsearch->{'select'} .=
505 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
509 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
514 'table' => 'cust_pkg',
515 'hashref' => { 'custnum' => $self->custnum },
520 # This should be generalized to use config options to determine order.
523 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
524 return $locationsort if $locationsort;
526 if ( $a->get('cancel') xor $b->get('cancel') ) {
527 return -1 if $b->get('cancel');
528 return 1 if $a->get('cancel');
529 #shouldn't get here...
532 my $a_num_cust_svc = $a->num_cust_svc;
533 my $b_num_cust_svc = $b->num_cust_svc;
534 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
535 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
536 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
537 return 0 if $a_num_cust_svc + $b_num_cust_svc > 20; #for perf, just give up
538 my @a_cust_svc = $a->cust_svc_unsorted;
539 my @b_cust_svc = $b->cust_svc_unsorted;
540 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
541 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
542 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
543 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
550 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
556 return $self->num_suspended_pkgs unless wantarray;
557 grep { $_->susp } $self->ncancelled_pkgs;
560 =item unsuspended_pkgs
562 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
567 sub unsuspended_pkgs {
569 return $self->num_unsuspended_pkgs unless wantarray;
570 grep { ! $_->susp } $self->ncancelled_pkgs;
575 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
576 this customer that are active (recurring).
582 grep { my $part_pkg = $_->part_pkg;
583 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
585 $self->unsuspended_pkgs;
588 =item ncancelled_active_pkgs
590 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
591 are active (recurring).
595 sub ncancelled_active_pkgs {
597 grep { my $part_pkg = $_->part_pkg;
598 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
600 $self->ncancelled_pkgs;
605 Returns active packages, and also any suspended packages which are set to
606 continue billing while suspended.
612 grep { my $part_pkg = $_->part_pkg;
613 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
614 && ( ! $_->susp || $_->option('suspend_bill',1)
615 || ( $part_pkg->option('suspend_bill', 1)
616 && ! $_->option('no_suspend_bill',1)
620 $self->ncancelled_pkgs;
625 Returns the next date this customer will be billed, as a UNIX timestamp, or
626 undef if no billing package has a next bill date.
633 # super inefficient with lots of packages
634 # min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
636 my $custnum = $self->custnum;
639 SELECT MIN(bill) FROM cust_pkg
640 LEFT JOIN cust_pkg_option AS cust_suspend_bill_option
641 ON ( cust_pkg.pkgnum = cust_suspend_bill_option.pkgnum
642 AND cust_suspend_bill_option.optionname = 'suspend_bill' )
643 LEFT JOIN cust_pkg_option AS cust_no_suspend_bill_option
644 ON ( cust_pkg.pkgnum = cust_no_suspend_bill_option.pkgnum
645 AND cust_no_suspend_bill_option.optionname = 'no_suspend_bill' )
646 LEFT JOIN part_pkg USING (pkgpart)
647 LEFT JOIN part_pkg_option AS part_suspend_bill_option
648 ON ( part_pkg.pkgpart = part_suspend_bill_option.pkgpart
649 AND part_suspend_bill_option.optionname = 'suspend_bill' )
650 WHERE custnum = $custnum
651 AND bill IS NOT NULL AND bill != 0
652 AND ( cancel IS NULL OR cancel = 0 )
653 AND part_pkg.freq != '' AND part_pkg.freq != '0'
654 AND ( ( susp IS NULL OR susp = 0 )
655 OR COALESCE(cust_suspend_bill_option.optionvalue,'0') = '1'
656 OR ( COALESCE(part_suspend_bill_option.optionvalue,'0') = '1'
657 AND COALESCE(cust_no_suspend_bill_option.optionvalue,'0') = '0'
664 =item num_cancelled_pkgs
666 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
671 sub num_cancelled_pkgs {
673 my $opt = shift || {};
674 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
675 $opt->{extra_sql} .= "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
676 $self->num_pkgs($opt);
679 sub num_ncancelled_pkgs {
681 my $opt = shift || {};
682 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
683 $opt->{extra_sql} .= "( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )";
684 $self->num_pkgs($opt);
687 sub num_suspended_pkgs {
689 my $opt = shift || {};
690 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
691 $opt->{extra_sql} .= " ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
692 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ";
693 $self->num_pkgs($opt);
696 sub num_unsuspended_pkgs {
698 my $opt = shift || {};
699 $opt->{extra_sql} .= ' AND ' if $opt->{extra_sql};
700 $opt->{extra_sql} .= " ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
701 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )";
702 $self->num_pkgs($opt);
712 $sql = $opt->{extra_sql} if exists($opt->{extra_sql});
713 $addl_from = $opt->{addl_from} if exists($opt->{addl_from});
718 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
719 my $sth = dbh->prepare(
720 "SELECT COUNT(*) FROM cust_pkg $addl_from WHERE cust_pkg.custnum = ? $sql"
721 ) or die dbh->errstr;
722 $sth->execute($self->custnum) or die $sth->errstr;
723 $sth->fetchrow_arrayref->[0];
732 L<FS::cust_main>, L<FS::cust_pkg>