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 my $error = $opt->{'cust_location'}->find_or_insert;
135 $dbh->rollback if $oldAutoCommit;
136 return "inserting cust_location (transaction rolled back): $error";
138 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
142 $cust_pkg->locationnum($self->ship_locationnum);
146 $cust_pkg->custnum( $self->custnum );
148 my $error = $cust_pkg->insert( %insert_params );
150 $dbh->rollback if $oldAutoCommit;
151 return "inserting cust_pkg (transaction rolled back): $error";
154 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
155 if ( $svc_something->svcnum ) {
156 my $old_cust_svc = $svc_something->cust_svc;
157 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
158 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
159 $error = $new_cust_svc->replace($old_cust_svc);
161 $svc_something->pkgnum( $cust_pkg->pkgnum );
162 if ( $svc_something->isa('FS::svc_acct') ) {
163 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
164 qw( seconds upbytes downbytes totalbytes ) ) {
165 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
166 ${ $opt->{$_.'_ref'} } = 0;
169 $error = $svc_something->insert(%svc_options);
172 $dbh->rollback if $oldAutoCommit;
173 return "inserting svc_ (transaction rolled back): $error";
177 # add supplemental packages, if any are needed
178 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
179 foreach my $link ($part_pkg->supp_part_pkg_link) {
180 #warn "inserting supplemental package ".$link->dst_pkgpart;
181 my $pkg = FS::cust_pkg->new({
182 'pkgpart' => $link->dst_pkgpart,
183 'pkglinknum' => $link->pkglinknum,
184 'custnum' => $self->custnum,
185 'main_pkgnum' => $cust_pkg->pkgnum,
186 'locationnum' => $cust_pkg->locationnum,
187 # try to prevent as many surprises as possible
188 'pkgbatch' => $cust_pkg->pkgbatch,
189 'start_date' => $cust_pkg->start_date,
190 'order_date' => $cust_pkg->order_date,
191 'expire' => $cust_pkg->expire,
192 'adjourn' => $cust_pkg->adjourn,
193 'contract_end' => $cust_pkg->contract_end,
194 'refnum' => $cust_pkg->refnum,
195 'discountnum' => $cust_pkg->discountnum,
196 'waive_setup' => $cust_pkg->waive_setup,
197 'allow_pkgpart' => $opt->{'allow_pkgpart'},
199 $error = $self->order_pkg('cust_pkg' => $pkg);
201 $dbh->rollback if $oldAutoCommit;
202 return "inserting supplemental package: $error";
206 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
211 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
213 Like the insert method on an existing record, this method orders multiple
214 packages and included services atomicaly. Pass a Tie::RefHash data structure
215 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
216 There should be a better explanation of this, but until then, here's an
220 tie %hash, 'Tie::RefHash'; #this part is important
222 $cust_pkg => [ $svc_acct ],
225 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
227 Services can be new, in which case they are inserted, or existing unaudited
228 services, in which case they are linked to the newly-created package.
230 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
231 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
233 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
234 on the supplied jobnum (they will not run until the specific job completes).
235 This can be used to defer provisioning until some action completes (such
236 as running the customer's credit card successfully).
238 The I<noexport> option is deprecated. If I<noexport> is set true, no
239 provisioning jobs (exports) are scheduled. (You can schedule them later with
240 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
241 on the cust_main object is not recommended, as existing services will also be
244 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
245 provided, the scalars (provided by references) will be incremented by the
246 values of the prepaid card.`
252 my $cust_pkgs = shift;
255 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
257 warn "$me order_pkgs called with options ".
258 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
261 local $SIG{HUP} = 'IGNORE';
262 local $SIG{INT} = 'IGNORE';
263 local $SIG{QUIT} = 'IGNORE';
264 local $SIG{TERM} = 'IGNORE';
265 local $SIG{TSTP} = 'IGNORE';
266 local $SIG{PIPE} = 'IGNORE';
268 my $oldAutoCommit = $FS::UID::AutoCommit;
269 local $FS::UID::AutoCommit = 0;
272 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
274 foreach my $cust_pkg ( keys %$cust_pkgs ) {
276 my $error = $self->order_pkg(
277 'cust_pkg' => $cust_pkg,
278 'svcs' => $cust_pkgs->{$cust_pkg},
279 map { $_ => $options{$_} }
280 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
283 $dbh->rollback if $oldAutoCommit;
289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
295 Merges this customer's package's into the target customer and then cancels them.
300 my( $self, $new_custnum ) = @_;
302 #mostly false laziness w/ merge
304 return "Can't attach packages to self" if $self->custnum == $new_custnum;
306 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
307 or return "Invalid new customer number: $new_custnum";
309 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
310 if $self->agentnum != $new_cust_main->agentnum
311 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
313 local $SIG{HUP} = 'IGNORE';
314 local $SIG{INT} = 'IGNORE';
315 local $SIG{QUIT} = 'IGNORE';
316 local $SIG{TERM} = 'IGNORE';
317 local $SIG{TSTP} = 'IGNORE';
318 local $SIG{PIPE} = 'IGNORE';
320 my $oldAutoCommit = $FS::UID::AutoCommit;
321 local $FS::UID::AutoCommit = 0;
324 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
325 $dbh->rollback if $oldAutoCommit;
326 return "Can't merge a master agent customer";
330 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
331 $dbh->rollback if $oldAutoCommit;
332 return "Can't merge a master employee customer";
335 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
336 'status' => { op=>'!=', value=>'done' },
340 $dbh->rollback if $oldAutoCommit;
341 return "Can't merge a customer with pending payments";
344 #end of false laziness
348 my %contact_hash = ( 'first' => $self->first,
349 'last' => $self->get('last'),
350 'custnum' => $new_custnum,
354 my $contact = qsearchs( 'contact', \%contact_hash)
355 || new FS::contact \%contact_hash;
356 unless ( $contact->contactnum ) {
357 my $error = $contact->insert;
359 $dbh->rollback if $oldAutoCommit;
364 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
366 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
367 my %loc_hash = $cust_location->hash;
368 $loc_hash{'locationnum'} = '';
369 $loc_hash{'custnum'} = $new_custnum;
370 $loc_hash{'disabled'} = '';
371 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
372 || new FS::cust_location \%loc_hash;
374 my $pkg_or_error = $cust_pkg->change( {
376 'cust_main' => $new_cust_main,
377 'contactnum' => $contact->contactnum,
378 'cust_location' => $new_cust_location,
381 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
384 $dbh->rollback if $oldAutoCommit;
390 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
395 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
397 Returns all packages (see L<FS::cust_pkg>) for this customer.
403 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
405 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
408 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
409 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
411 @cust_pkg = $self->_cust_pkg($extra_qsearch);
414 map { $_ } sort sort_packages @cust_pkg;
419 Synonym for B<all_pkgs>.
427 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
429 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
433 sub ncancelled_pkgs {
435 my $extra_qsearch = ref($_[0]) ? shift : {};
437 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
439 return $self->num_ncancelled_pkgs unless wantarray;
442 if ( $self->{'_pkgnum'} ) {
444 warn "$me ncancelled_pkgs: returning cached objects"
447 @cust_pkg = grep { ! $_->getfield('cancel') }
448 values %{ $self->{'_pkgnum'}->cache };
452 warn "$me ncancelled_pkgs: searching for packages with custnum ".
456 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
458 @cust_pkg = $self->_cust_pkg($extra_qsearch);
462 sort sort_packages @cust_pkg;
468 my $extra_qsearch = ref($_[0]) ? shift : {};
470 $extra_qsearch->{'select'} ||= '*';
471 $extra_qsearch->{'select'} .=
472 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
476 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
481 'table' => 'cust_pkg',
482 'hashref' => { 'custnum' => $self->custnum },
487 # This should be generalized to use config options to determine order.
490 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
491 return $locationsort if $locationsort;
493 if ( $a->get('cancel') xor $b->get('cancel') ) {
494 return -1 if $b->get('cancel');
495 return 1 if $a->get('cancel');
496 #shouldn't get here...
499 my $a_num_cust_svc = $a->num_cust_svc;
500 my $b_num_cust_svc = $b->num_cust_svc;
501 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
502 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
503 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
504 my @a_cust_svc = $a->cust_svc;
505 my @b_cust_svc = $b->cust_svc;
506 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
507 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
508 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
509 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
516 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
522 return $self->num_suspended_pkgs unless wantarray;
523 grep { $_->susp } $self->ncancelled_pkgs;
526 =item unflagged_suspended_pkgs
528 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
529 customer (thouse packages without the `manual_flag' set).
533 sub unflagged_suspended_pkgs {
535 return $self->suspended_pkgs
536 unless dbdef->table('cust_pkg')->column('manual_flag');
537 grep { ! $_->manual_flag } $self->suspended_pkgs;
540 =item unsuspended_pkgs
542 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
547 sub unsuspended_pkgs {
549 return $self->num_unsuspended_pkgs unless wantarray;
550 grep { ! $_->susp } $self->ncancelled_pkgs;
555 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
556 this customer that are active (recurring).
562 grep { my $part_pkg = $_->part_pkg;
563 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
565 $self->unsuspended_pkgs;
570 Returns active packages, and also any suspended packages which are set to
571 continue billing while suspended.
577 grep { my $part_pkg = $_->part_pkg;
578 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
579 && ( ! $_->susp || $_->option('suspend_bill',1)
580 || ( $part_pkg->option('suspend_bill', 1)
581 && ! $_->option('no_suspend_bill',1)
585 $self->ncancelled_pkgs;
590 Returns the next date this customer will be billed, as a UNIX timestamp, or
591 undef if no billing package has a next bill date.
597 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
600 =item num_cancelled_pkgs
602 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
607 sub num_cancelled_pkgs {
608 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
611 sub num_ncancelled_pkgs {
612 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
615 sub num_suspended_pkgs {
616 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
617 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
620 sub num_unsuspended_pkgs {
621 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
622 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
627 my $sql = scalar(@_) ? shift : '';
628 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
629 my $sth = dbh->prepare(
630 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
631 ) or die dbh->errstr;
632 $sth->execute($self->custnum) or die $sth->errstr;
633 $sth->fetchrow_arrayref->[0];
642 L<FS::cust_main>, L<FS::cust_pkg>