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
83 my $opt = ref($_[0]) ? shift : { @_ };
85 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
87 warn "$me order_pkg called with options ".
88 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
91 local $FS::svc_Common::noexport_hack = 1 if $opt->{'noexport'};
93 my $cust_pkg = $opt->{'cust_pkg'};
94 my $svcs = $opt->{'svcs'} || [];
97 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
98 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
100 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
101 qw( ticket_subject ticket_queue allow_pkgpart );
103 local $SIG{HUP} = 'IGNORE';
104 local $SIG{INT} = 'IGNORE';
105 local $SIG{QUIT} = 'IGNORE';
106 local $SIG{TERM} = 'IGNORE';
107 local $SIG{TSTP} = 'IGNORE';
108 local $SIG{PIPE} = 'IGNORE';
110 my $oldAutoCommit = $FS::UID::AutoCommit;
111 local $FS::UID::AutoCommit = 0;
114 if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
116 $cust_pkg->contactnum($opt->{'contactnum'});
118 } elsif ( $opt->{'contact'} ) {
120 if ( ! $opt->{'contact'}->contactnum ) {
122 my $error = $opt->{'contact'}->insert;
124 $dbh->rollback if $oldAutoCommit;
125 return "inserting contact (transaction rolled back): $error";
128 $cust_pkg->contactnum($opt->{'contact'}->contactnum);
132 # $cust_pkg->contactnum();
136 if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
138 $cust_pkg->locationnum($opt->{'locationnum'});
140 } elsif ( $opt->{'cust_location'} ) {
142 my $error = $opt->{'cust_location'}->find_or_insert;
144 $dbh->rollback if $oldAutoCommit;
145 return "inserting cust_location (transaction rolled back): $error";
147 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
151 $cust_pkg->locationnum($self->ship_locationnum);
155 $cust_pkg->custnum( $self->custnum );
157 my $error = $cust_pkg->insert( %insert_params );
159 $dbh->rollback if $oldAutoCommit;
160 return "inserting cust_pkg (transaction rolled back): $error";
163 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
164 if ( $svc_something->svcnum ) {
165 my $old_cust_svc = $svc_something->cust_svc;
166 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
167 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
168 $error = $new_cust_svc->replace($old_cust_svc);
170 $svc_something->pkgnum( $cust_pkg->pkgnum );
171 if ( $svc_something->isa('FS::svc_acct') ) {
172 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
173 qw( seconds upbytes downbytes totalbytes ) ) {
174 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
175 ${ $opt->{$_.'_ref'} } = 0;
178 $error = $svc_something->insert(%svc_options);
181 $dbh->rollback if $oldAutoCommit;
182 return "inserting svc_ (transaction rolled back): $error";
186 # add supplemental packages, if any are needed
187 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
188 foreach my $link ($part_pkg->supp_part_pkg_link) {
189 #warn "inserting supplemental package ".$link->dst_pkgpart;
190 my $pkg = FS::cust_pkg->new({
191 'pkgpart' => $link->dst_pkgpart,
192 'pkglinknum' => $link->pkglinknum,
193 'custnum' => $self->custnum,
194 'main_pkgnum' => $cust_pkg->pkgnum,
195 # try to prevent as many surprises as possible
196 'allow_pkgpart' => $opt->{'allow_pkgpart'},
197 map { $_ => $cust_pkg->$_() }
199 start_date order_date expire adjourn contract_end
200 refnum discountnum waive_setup
203 $error = $self->order_pkg('cust_pkg' => $pkg,
204 'locationnum' => $cust_pkg->locationnum);
206 $dbh->rollback if $oldAutoCommit;
207 return "inserting supplemental package: $error";
211 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
216 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
218 Like the insert method on an existing record, this method orders multiple
219 packages and included services atomicaly. Pass a Tie::RefHash data structure
220 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
221 There should be a better explanation of this, but until then, here's an
225 tie %hash, 'Tie::RefHash'; #this part is important
227 $cust_pkg => [ $svc_acct ],
230 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
232 Services can be new, in which case they are inserted, or existing unaudited
233 services, in which case they are linked to the newly-created package.
235 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
236 I<upbytes_ref>, I<downbytes_ref>, I<totalbytes_ref>, and I<allow_pkgpart>.
238 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
239 on the supplied jobnum (they will not run until the specific job completes).
240 This can be used to defer provisioning until some action completes (such
241 as running the customer's credit card successfully).
243 The I<noexport> option is deprecated but still works for now (use
244 I<depend_jobnum> instead for new code). If I<noexport> is set true, no
245 provisioning jobs (exports) are scheduled. (You can schedule them later with
246 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
247 on the cust_main object is not recommended, as existing services will also be
250 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
251 provided, the scalars (provided by references) will be incremented by the
252 values of the prepaid card.`
254 I<allow_pkgpart> is passed to L<FS::cust_pkg>->insert.
260 my $cust_pkgs = shift;
263 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
265 warn "$me order_pkgs called with options ".
266 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
269 local $SIG{HUP} = 'IGNORE';
270 local $SIG{INT} = 'IGNORE';
271 local $SIG{QUIT} = 'IGNORE';
272 local $SIG{TERM} = 'IGNORE';
273 local $SIG{TSTP} = 'IGNORE';
274 local $SIG{PIPE} = 'IGNORE';
276 my $oldAutoCommit = $FS::UID::AutoCommit;
277 local $FS::UID::AutoCommit = 0;
280 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
282 foreach my $cust_pkg ( keys %$cust_pkgs ) {
284 my $error = $self->order_pkg(
285 'cust_pkg' => $cust_pkg,
286 'svcs' => $cust_pkgs->{$cust_pkg},
287 map { $_ => $options{$_} }
288 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum allow_pkgpart )
291 $dbh->rollback if $oldAutoCommit;
297 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
303 Merges this customer's package's into the target customer and then cancels them.
308 my( $self, $new_custnum ) = @_;
310 #mostly false laziness w/ merge
312 return "Can't attach packages to self" if $self->custnum == $new_custnum;
314 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
315 or return "Invalid new customer number: $new_custnum";
317 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
318 if $self->agentnum != $new_cust_main->agentnum
319 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
321 local $SIG{HUP} = 'IGNORE';
322 local $SIG{INT} = 'IGNORE';
323 local $SIG{QUIT} = 'IGNORE';
324 local $SIG{TERM} = 'IGNORE';
325 local $SIG{TSTP} = 'IGNORE';
326 local $SIG{PIPE} = 'IGNORE';
328 my $oldAutoCommit = $FS::UID::AutoCommit;
329 local $FS::UID::AutoCommit = 0;
332 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
333 $dbh->rollback if $oldAutoCommit;
334 return "Can't merge a master agent customer";
338 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
339 $dbh->rollback if $oldAutoCommit;
340 return "Can't merge a master employee customer";
343 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
344 'status' => { op=>'!=', value=>'done' },
348 $dbh->rollback if $oldAutoCommit;
349 return "Can't merge a customer with pending payments";
352 #end of false laziness
356 my %contact_hash = ( 'first' => $self->first,
357 'last' => $self->get('last'),
358 'custnum' => $new_custnum,
362 my $contact = qsearchs( 'contact', \%contact_hash)
363 || new FS::contact \%contact_hash;
364 unless ( $contact->contactnum ) {
365 my $error = $contact->insert;
367 $dbh->rollback if $oldAutoCommit;
372 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
374 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
375 my %loc_hash = $cust_location->hash;
376 $loc_hash{'locationnum'} = '';
377 $loc_hash{'custnum'} = $new_custnum;
378 $loc_hash{'disabled'} = '';
379 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
380 || new FS::cust_location \%loc_hash;
382 my $pkg_or_error = $cust_pkg->change( {
384 'cust_main' => $new_cust_main,
385 'contactnum' => $contact->contactnum,
386 'cust_location' => $new_cust_location,
389 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
392 $dbh->rollback if $oldAutoCommit;
398 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
403 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
405 Returns all packages (see L<FS::cust_pkg>) for this customer.
411 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
413 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
416 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
417 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
419 @cust_pkg = $self->_cust_pkg($extra_qsearch);
422 map { $_ } sort sort_packages @cust_pkg;
427 Synonym for B<all_pkgs>.
435 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
437 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
441 sub ncancelled_pkgs {
443 my $extra_qsearch = ref($_[0]) ? shift : {};
445 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
447 return $self->num_ncancelled_pkgs unless wantarray;
450 if ( $self->{'_pkgnum'} ) {
452 warn "$me ncancelled_pkgs: returning cached objects"
455 @cust_pkg = grep { ! $_->getfield('cancel') }
456 values %{ $self->{'_pkgnum'}->cache };
460 warn "$me ncancelled_pkgs: searching for packages with custnum ".
464 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
466 @cust_pkg = $self->_cust_pkg($extra_qsearch);
470 sort sort_packages @cust_pkg;
476 my $extra_qsearch = ref($_[0]) ? shift : {};
478 $extra_qsearch->{'select'} ||= '*';
479 $extra_qsearch->{'select'} .=
480 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
484 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
489 'table' => 'cust_pkg',
490 'hashref' => { 'custnum' => $self->custnum },
495 # This should be generalized to use config options to determine order.
498 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
499 return $locationsort if $locationsort;
501 if ( $a->get('cancel') xor $b->get('cancel') ) {
502 return -1 if $b->get('cancel');
503 return 1 if $a->get('cancel');
504 #shouldn't get here...
507 my $a_num_cust_svc = $a->num_cust_svc;
508 my $b_num_cust_svc = $b->num_cust_svc;
509 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
510 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
511 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
512 return 0 if $a_num_cust_svc + $b_num_cust_svc > 20; #for perf, just give up
513 my @a_cust_svc = $a->cust_svc_unsorted;
514 my @b_cust_svc = $b->cust_svc_unsorted;
515 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
516 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
517 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
518 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
525 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
531 return $self->num_suspended_pkgs unless wantarray;
532 grep { $_->susp } $self->ncancelled_pkgs;
535 =item unflagged_suspended_pkgs
537 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
538 customer (thouse packages without the `manual_flag' set).
542 sub unflagged_suspended_pkgs {
544 return $self->suspended_pkgs
545 unless dbdef->table('cust_pkg')->column('manual_flag');
546 grep { ! $_->manual_flag } $self->suspended_pkgs;
549 =item unsuspended_pkgs
551 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
556 sub unsuspended_pkgs {
558 return $self->num_unsuspended_pkgs unless wantarray;
559 grep { ! $_->susp } $self->ncancelled_pkgs;
564 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
565 this customer that are active (recurring).
571 grep { my $part_pkg = $_->part_pkg;
572 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
574 $self->unsuspended_pkgs;
577 =item ncancelled_active_pkgs
579 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer that
580 are active (recurring).
584 sub ncancelled_active_pkgs {
586 grep { my $part_pkg = $_->part_pkg;
587 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
589 $self->ncancelled_pkgs;
594 Returns active packages, and also any suspended packages which are set to
595 continue billing while suspended.
601 grep { my $part_pkg = $_->part_pkg;
602 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
603 && ( ! $_->susp || $_->option('suspend_bill',1)
604 || ( $part_pkg->option('suspend_bill', 1)
605 && ! $_->option('no_suspend_bill',1)
609 $self->ncancelled_pkgs;
614 Returns the next date this customer will be billed, as a UNIX timestamp, or
615 undef if no billing package has a next bill date.
621 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
624 =item num_cancelled_pkgs
626 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
631 sub num_cancelled_pkgs {
632 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
635 sub num_ncancelled_pkgs {
636 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
639 sub num_suspended_pkgs {
640 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
641 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
644 sub num_unsuspended_pkgs {
645 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
646 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
651 my $sql = scalar(@_) ? shift : '';
652 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
653 my $sth = dbh->prepare(
654 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
655 ) or die dbh->errstr;
656 $sth->execute($self->custnum) or die $sth->errstr;
657 $sth->fetchrow_arrayref->[0];
666 L<FS::cust_main>, L<FS::cust_pkg>