1 package FS::cust_main::Packages;
4 use vars qw( $DEBUG $me );
5 use List::Util qw( min );
7 use FS::Record qw( qsearch qsearchs );
10 use FS::contact; # for attach_pkgs
11 use FS::cust_location; #
14 $me = '[FS::cust_main::Packages]';
18 FS::cust_main::Packages - Packages mixin for cust_main
24 These methods are available on FS::cust_main objects;
30 =item order_pkg HASHREF | OPTION => VALUE ...
32 Orders a single package.
34 Note that if the package definition has supplemental packages, those will
37 Options may be passed as a list of key/value pairs or as a hash reference.
48 Optional FS::cust_location object. If not specified, the customer's
49 ship_location will be used.
53 Optional arryaref of FS::svc_* service objects.
57 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
58 jobs will have a dependancy on the supplied job (they will not run until the
59 specific job completes). This can be used to defer provisioning until some
60 action completes (such as running the customer's credit card successfully).
64 Optional subject for a ticket created and attached to this customer
68 Optional queue name for ticket additions
76 my $opt = ref($_[0]) ? shift : { @_ };
78 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
80 warn "$me order_pkg called with options ".
81 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
84 my $cust_pkg = $opt->{'cust_pkg'};
85 my $svcs = $opt->{'svcs'} || [];
88 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
89 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
91 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
92 qw( ticket_subject ticket_queue allow_pkgpart );
94 local $SIG{HUP} = 'IGNORE';
95 local $SIG{INT} = 'IGNORE';
96 local $SIG{QUIT} = 'IGNORE';
97 local $SIG{TERM} = 'IGNORE';
98 local $SIG{TSTP} = 'IGNORE';
99 local $SIG{PIPE} = 'IGNORE';
101 my $oldAutoCommit = $FS::UID::AutoCommit;
102 local $FS::UID::AutoCommit = 0;
105 if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
107 $cust_pkg->contactnum($opt->{'contactnum'});
109 } elsif ( $opt->{'contact'} ) {
111 if ( ! $opt->{'contact'}->contactnum ) {
113 my $error = $opt->{'contact'}->insert;
115 $dbh->rollback if $oldAutoCommit;
116 return "inserting contact (transaction rolled back): $error";
119 $cust_pkg->contactnum($opt->{'contact'}->contactnum);
123 # $cust_pkg->contactnum();
127 if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
129 $cust_pkg->locationnum($opt->{'locationnum'});
131 } elsif ( $opt->{'cust_location'} ) {
133 if ( ! $opt->{'cust_location'}->locationnum ) {
135 my $error = $opt->{'cust_location'}->insert;
137 $dbh->rollback if $oldAutoCommit;
138 return "inserting cust_location (transaction rolled back): $error";
141 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
145 $cust_pkg->locationnum($self->ship_locationnum);
149 $cust_pkg->custnum( $self->custnum );
151 my $error = $cust_pkg->insert( %insert_params );
153 $dbh->rollback if $oldAutoCommit;
154 return "inserting cust_pkg (transaction rolled back): $error";
157 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
158 if ( $svc_something->svcnum ) {
159 my $old_cust_svc = $svc_something->cust_svc;
160 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
161 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
162 $error = $new_cust_svc->replace($old_cust_svc);
164 $svc_something->pkgnum( $cust_pkg->pkgnum );
165 if ( $svc_something->isa('FS::svc_acct') ) {
166 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
167 qw( seconds upbytes downbytes totalbytes ) ) {
168 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
169 ${ $opt->{$_.'_ref'} } = 0;
172 $error = $svc_something->insert(%svc_options);
175 $dbh->rollback if $oldAutoCommit;
176 return "inserting svc_ (transaction rolled back): $error";
180 # add supplemental packages, if any are needed
181 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
182 foreach my $link ($part_pkg->supp_part_pkg_link) {
183 #warn "inserting supplemental package ".$link->dst_pkgpart;
184 my $pkg = FS::cust_pkg->new({
185 'pkgpart' => $link->dst_pkgpart,
186 'pkglinknum' => $link->pkglinknum,
187 'custnum' => $self->custnum,
188 'main_pkgnum' => $cust_pkg->pkgnum,
189 'locationnum' => $cust_pkg->locationnum,
190 # try to prevent as many surprises as possible
191 'pkgbatch' => $cust_pkg->pkgbatch,
192 'start_date' => $cust_pkg->start_date,
193 'order_date' => $cust_pkg->order_date,
194 'expire' => $cust_pkg->expire,
195 'adjourn' => $cust_pkg->adjourn,
196 'contract_end' => $cust_pkg->contract_end,
197 'refnum' => $cust_pkg->refnum,
198 'discountnum' => $cust_pkg->discountnum,
199 'waive_setup' => $cust_pkg->waive_setup,
200 'allow_pkgpart' => $opt->{'allow_pkgpart'},
202 $error = $self->order_pkg('cust_pkg' => $pkg);
204 $dbh->rollback if $oldAutoCommit;
205 return "inserting supplemental package: $error";
209 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
214 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
216 Like the insert method on an existing record, this method orders multiple
217 packages and included services atomicaly. Pass a Tie::RefHash data structure
218 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
219 There should be a better explanation of this, but until then, here's an
223 tie %hash, 'Tie::RefHash'; #this part is important
225 $cust_pkg => [ $svc_acct ],
228 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
230 Services can be new, in which case they are inserted, or existing unaudited
231 services, in which case they are linked to the newly-created package.
233 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
234 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
236 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
237 on the supplied jobnum (they will not run until the specific job completes).
238 This can be used to defer provisioning until some action completes (such
239 as running the customer's credit card successfully).
241 The I<noexport> option is deprecated. If I<noexport> is set true, no
242 provisioning jobs (exports) are scheduled. (You can schedule them later with
243 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
244 on the cust_main object is not recommended, as existing services will also be
247 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
248 provided, the scalars (provided by references) will be incremented by the
249 values of the prepaid card.`
255 my $cust_pkgs = shift;
258 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
260 warn "$me order_pkgs called with options ".
261 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
264 local $SIG{HUP} = 'IGNORE';
265 local $SIG{INT} = 'IGNORE';
266 local $SIG{QUIT} = 'IGNORE';
267 local $SIG{TERM} = 'IGNORE';
268 local $SIG{TSTP} = 'IGNORE';
269 local $SIG{PIPE} = 'IGNORE';
271 my $oldAutoCommit = $FS::UID::AutoCommit;
272 local $FS::UID::AutoCommit = 0;
275 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
277 foreach my $cust_pkg ( keys %$cust_pkgs ) {
279 my $error = $self->order_pkg(
280 'cust_pkg' => $cust_pkg,
281 'svcs' => $cust_pkgs->{$cust_pkg},
282 map { $_ => $options{$_} }
283 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
286 $dbh->rollback if $oldAutoCommit;
292 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
298 Merges this customer's package's into the target customer and then cancels them.
303 my( $self, $new_custnum ) = @_;
305 #mostly false laziness w/ merge
307 return "Can't attach packages to self" if $self->custnum == $new_custnum;
309 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
310 or return "Invalid new customer number: $new_custnum";
312 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
313 if $self->agentnum != $new_cust_main->agentnum
314 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
316 local $SIG{HUP} = 'IGNORE';
317 local $SIG{INT} = 'IGNORE';
318 local $SIG{QUIT} = 'IGNORE';
319 local $SIG{TERM} = 'IGNORE';
320 local $SIG{TSTP} = 'IGNORE';
321 local $SIG{PIPE} = 'IGNORE';
323 my $oldAutoCommit = $FS::UID::AutoCommit;
324 local $FS::UID::AutoCommit = 0;
327 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
328 $dbh->rollback if $oldAutoCommit;
329 return "Can't merge a master agent customer";
333 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
334 $dbh->rollback if $oldAutoCommit;
335 return "Can't merge a master employee customer";
338 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
339 'status' => { op=>'!=', value=>'done' },
343 $dbh->rollback if $oldAutoCommit;
344 return "Can't merge a customer with pending payments";
347 #end of false laziness
351 my %contact_hash = ( 'first' => $self->first,
352 'last' => $self->get('last'),
353 'custnum' => $new_custnum,
357 my $contact = qsearchs( 'contact', \%contact_hash)
358 || new FS::contact \%contact_hash;
359 unless ( $contact->contactnum ) {
360 my $error = $contact->insert;
362 $dbh->rollback if $oldAutoCommit;
367 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
369 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
370 my %loc_hash = $cust_location->hash;
371 $loc_hash{'locationnum'} = '';
372 $loc_hash{'custnum'} = $new_custnum;
373 $loc_hash{'disabled'} = '';
374 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
375 || new FS::cust_location \%loc_hash;
377 my $pkg_or_error = $cust_pkg->change( {
379 'cust_main' => $new_cust_main,
380 'contactnum' => $contact->contactnum,
381 'cust_location' => $new_cust_location,
384 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
387 $dbh->rollback if $oldAutoCommit;
393 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
398 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
400 Returns all packages (see L<FS::cust_pkg>) for this customer.
406 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
408 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
411 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
412 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
414 @cust_pkg = $self->_cust_pkg($extra_qsearch);
417 map { $_ } sort sort_packages @cust_pkg;
422 Synonym for B<all_pkgs>.
430 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
432 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
436 sub ncancelled_pkgs {
438 my $extra_qsearch = ref($_[0]) ? shift : {};
440 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
442 return $self->num_ncancelled_pkgs unless wantarray;
445 if ( $self->{'_pkgnum'} ) {
447 warn "$me ncancelled_pkgs: returning cached objects"
450 @cust_pkg = grep { ! $_->getfield('cancel') }
451 values %{ $self->{'_pkgnum'}->cache };
455 warn "$me ncancelled_pkgs: searching for packages with custnum ".
459 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
461 @cust_pkg = $self->_cust_pkg($extra_qsearch);
465 sort sort_packages @cust_pkg;
471 my $extra_qsearch = ref($_[0]) ? shift : {};
473 $extra_qsearch->{'select'} ||= '*';
474 $extra_qsearch->{'select'} .=
475 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
479 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
484 'table' => 'cust_pkg',
485 'hashref' => { 'custnum' => $self->custnum },
490 # This should be generalized to use config options to determine order.
493 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
494 return $locationsort if $locationsort;
496 if ( $a->get('cancel') xor $b->get('cancel') ) {
497 return -1 if $b->get('cancel');
498 return 1 if $a->get('cancel');
499 #shouldn't get here...
502 my $a_num_cust_svc = $a->num_cust_svc;
503 my $b_num_cust_svc = $b->num_cust_svc;
504 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
505 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
506 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
507 my @a_cust_svc = $a->cust_svc;
508 my @b_cust_svc = $b->cust_svc;
509 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
510 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
511 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
512 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
519 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
525 return $self->num_suspended_pkgs unless wantarray;
526 grep { $_->susp } $self->ncancelled_pkgs;
529 =item unflagged_suspended_pkgs
531 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
532 customer (thouse packages without the `manual_flag' set).
536 sub unflagged_suspended_pkgs {
538 return $self->suspended_pkgs
539 unless dbdef->table('cust_pkg')->column('manual_flag');
540 grep { ! $_->manual_flag } $self->suspended_pkgs;
543 =item unsuspended_pkgs
545 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
550 sub unsuspended_pkgs {
552 return $self->num_unsuspended_pkgs unless wantarray;
553 grep { ! $_->susp } $self->ncancelled_pkgs;
558 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
559 this customer that are active (recurring).
565 grep { my $part_pkg = $_->part_pkg;
566 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
568 $self->unsuspended_pkgs;
573 Returns active packages, and also any suspended packages which are set to
574 continue billing while suspended.
580 grep { my $part_pkg = $_->part_pkg;
581 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
582 && ( ! $_->susp || $_->option('suspend_bill',1)
583 || ( $part_pkg->option('suspend_bill', 1)
584 && ! $_->option('no_suspend_bill',1)
588 $self->ncancelled_pkgs;
593 Returns the next date this customer will be billed, as a UNIX timestamp, or
594 undef if no billing package has a next bill date.
600 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
603 =item num_cancelled_pkgs
605 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
610 sub num_cancelled_pkgs {
611 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
614 sub num_ncancelled_pkgs {
615 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
618 sub num_suspended_pkgs {
619 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
620 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
623 sub num_unsuspended_pkgs {
624 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
625 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
630 my $sql = scalar(@_) ? shift : '';
631 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
632 my $sth = dbh->prepare(
633 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
634 ) or die dbh->errstr;
635 $sth->execute($self->custnum) or die $sth->errstr;
636 $sth->fetchrow_arrayref->[0];
645 L<FS::cust_main>, L<FS::cust_pkg>