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 Optional subject for a ticket created and attached to this customer
66 Optional queue name for ticket additions
74 my $opt = ref($_[0]) ? shift : { @_ };
76 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
78 warn "$me order_pkg called with options ".
79 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
82 my $cust_pkg = $opt->{'cust_pkg'};
83 my $svcs = $opt->{'svcs'} || [];
86 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
87 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
89 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
90 qw( ticket_subject ticket_queue allow_pkgpart import );
92 local $SIG{HUP} = 'IGNORE';
93 local $SIG{INT} = 'IGNORE';
94 local $SIG{QUIT} = 'IGNORE';
95 local $SIG{TERM} = 'IGNORE';
96 local $SIG{TSTP} = 'IGNORE';
97 local $SIG{PIPE} = 'IGNORE';
99 my $oldAutoCommit = $FS::UID::AutoCommit;
100 local $FS::UID::AutoCommit = 0;
103 if ( $opt->{'contactnum'} and $opt->{'contactnum'} != -1 ) {
105 $cust_pkg->contactnum($opt->{'contactnum'});
107 } elsif ( $opt->{'contact'} ) {
109 if ( ! $opt->{'contact'}->contactnum ) {
111 my $error = $opt->{'contact'}->insert;
113 $dbh->rollback if $oldAutoCommit;
114 return "inserting contact (transaction rolled back): $error";
117 $cust_pkg->contactnum($opt->{'contact'}->contactnum);
121 # $cust_pkg->contactnum();
125 if ( $opt->{'locationnum'} and $opt->{'locationnum'} != -1 ) {
127 $cust_pkg->locationnum($opt->{'locationnum'});
129 } elsif ( $opt->{'cust_location'} ) {
131 my $error = $opt->{'cust_location'}->find_or_insert;
133 $dbh->rollback if $oldAutoCommit;
134 return "inserting cust_location (transaction rolled back): $error";
136 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
140 $cust_pkg->locationnum($self->ship_locationnum);
144 $cust_pkg->custnum( $self->custnum );
146 my $error = $cust_pkg->insert( %insert_params );
148 $dbh->rollback if $oldAutoCommit;
149 return "inserting cust_pkg (transaction rolled back): $error";
152 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
153 if ( $svc_something->svcnum ) {
154 my $old_cust_svc = $svc_something->cust_svc;
155 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
156 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
157 $error = $new_cust_svc->replace($old_cust_svc);
159 $svc_something->pkgnum( $cust_pkg->pkgnum );
160 if ( $svc_something->isa('FS::svc_acct') ) {
161 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
162 qw( seconds upbytes downbytes totalbytes ) ) {
163 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
164 ${ $opt->{$_.'_ref'} } = 0;
167 $error = $svc_something->insert(%svc_options);
170 $dbh->rollback if $oldAutoCommit;
171 return "inserting svc_ (transaction rolled back): $error";
175 # add supplemental packages, if any are needed
176 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
177 foreach my $link ($part_pkg->supp_part_pkg_link) {
178 #warn "inserting supplemental package ".$link->dst_pkgpart;
179 my $pkg = FS::cust_pkg->new({
180 'pkgpart' => $link->dst_pkgpart,
181 'pkglinknum' => $link->pkglinknum,
182 'custnum' => $self->custnum,
183 'main_pkgnum' => $cust_pkg->pkgnum,
184 # try to prevent as many surprises as possible
185 'pkgbatch' => $cust_pkg->pkgbatch,
186 'start_date' => $cust_pkg->start_date,
187 'order_date' => $cust_pkg->order_date,
188 'expire' => $cust_pkg->expire,
189 'adjourn' => $cust_pkg->adjourn,
190 'contract_end' => $cust_pkg->contract_end,
191 'refnum' => $cust_pkg->refnum,
192 'discountnum' => $cust_pkg->discountnum,
193 'waive_setup' => $cust_pkg->waive_setup,
194 'allow_pkgpart' => $opt->{'allow_pkgpart'},
196 $error = $self->order_pkg('cust_pkg' => $pkg,
197 'locationnum' => $cust_pkg->locationnum);
199 $dbh->rollback if $oldAutoCommit;
200 return "inserting supplemental package: $error";
204 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
209 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
211 Like the insert method on an existing record, this method orders multiple
212 packages and included services atomicaly. Pass a Tie::RefHash data structure
213 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
214 There should be a better explanation of this, but until then, here's an
218 tie %hash, 'Tie::RefHash'; #this part is important
220 $cust_pkg => [ $svc_acct ],
223 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
225 Services can be new, in which case they are inserted, or existing unaudited
226 services, in which case they are linked to the newly-created package.
228 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
229 I<upbytes_ref>, I<downbytes_ref>, I<totalbytes_ref>, I<allow_pkgpart>, and
232 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
233 on the supplied jobnum (they will not run until the specific job completes).
234 This can be used to defer provisioning until some action completes (such
235 as running the customer's credit card successfully).
237 The I<noexport> option is deprecated. If I<noexport> is set true, no
238 provisioning jobs (exports) are scheduled. (You can schedule them later with
239 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
240 on the cust_main object is not recommended, as existing services will also be
243 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
244 provided, the scalars (provided by references) will be incremented by the
245 values of the prepaid card.`
247 I<allow_pkgpart> and I<import> are flags passed to L<FS::cust_pkg>->insert.
253 my $cust_pkgs = shift;
256 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
258 warn "$me order_pkgs called with options ".
259 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
262 local $SIG{HUP} = 'IGNORE';
263 local $SIG{INT} = 'IGNORE';
264 local $SIG{QUIT} = 'IGNORE';
265 local $SIG{TERM} = 'IGNORE';
266 local $SIG{TSTP} = 'IGNORE';
267 local $SIG{PIPE} = 'IGNORE';
269 my $oldAutoCommit = $FS::UID::AutoCommit;
270 local $FS::UID::AutoCommit = 0;
273 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
275 foreach my $cust_pkg ( keys %$cust_pkgs ) {
277 my $error = $self->order_pkg(
278 'cust_pkg' => $cust_pkg,
279 'svcs' => $cust_pkgs->{$cust_pkg},
280 map { $_ => $options{$_} }
281 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum allow_pkgpart import )
284 $dbh->rollback if $oldAutoCommit;
290 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
296 Merges this customer's package's into the target customer and then cancels them.
301 my( $self, $new_custnum ) = @_;
303 #mostly false laziness w/ merge
305 return "Can't attach packages to self" if $self->custnum == $new_custnum;
307 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
308 or return "Invalid new customer number: $new_custnum";
310 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
311 if $self->agentnum != $new_cust_main->agentnum
312 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
314 local $SIG{HUP} = 'IGNORE';
315 local $SIG{INT} = 'IGNORE';
316 local $SIG{QUIT} = 'IGNORE';
317 local $SIG{TERM} = 'IGNORE';
318 local $SIG{TSTP} = 'IGNORE';
319 local $SIG{PIPE} = 'IGNORE';
321 my $oldAutoCommit = $FS::UID::AutoCommit;
322 local $FS::UID::AutoCommit = 0;
325 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
326 $dbh->rollback if $oldAutoCommit;
327 return "Can't merge a master agent customer";
331 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
332 $dbh->rollback if $oldAutoCommit;
333 return "Can't merge a master employee customer";
336 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
337 'status' => { op=>'!=', value=>'done' },
341 $dbh->rollback if $oldAutoCommit;
342 return "Can't merge a customer with pending payments";
345 #end of false laziness
349 my %contact_hash = ( 'first' => $self->first,
350 'last' => $self->get('last'),
351 'custnum' => $new_custnum,
355 my $contact = qsearchs( 'contact', \%contact_hash)
356 || new FS::contact \%contact_hash;
357 unless ( $contact->contactnum ) {
358 my $error = $contact->insert;
360 $dbh->rollback if $oldAutoCommit;
365 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
367 my $cust_location = $cust_pkg->cust_location || $self->ship_location;
368 my %loc_hash = $cust_location->hash;
369 $loc_hash{'locationnum'} = '';
370 $loc_hash{'custnum'} = $new_custnum;
371 $loc_hash{'disabled'} = '';
372 my $new_cust_location = qsearchs( 'cust_location', \%loc_hash)
373 || new FS::cust_location \%loc_hash;
375 my $pkg_or_error = $cust_pkg->change( {
377 'cust_main' => $new_cust_main,
378 'contactnum' => $contact->contactnum,
379 'cust_location' => $new_cust_location,
382 my $error = ref($pkg_or_error) ? '' : $pkg_or_error;
385 $dbh->rollback if $oldAutoCommit;
391 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
396 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
398 Returns all packages (see L<FS::cust_pkg>) for this customer.
404 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
406 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
409 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
410 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
412 @cust_pkg = $self->_cust_pkg($extra_qsearch);
415 map { $_ } sort sort_packages @cust_pkg;
420 Synonym for B<all_pkgs>.
428 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
430 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
434 sub ncancelled_pkgs {
436 my $extra_qsearch = ref($_[0]) ? shift : {};
438 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
440 return $self->num_ncancelled_pkgs unless wantarray;
443 if ( $self->{'_pkgnum'} ) {
445 warn "$me ncancelled_pkgs: returning cached objects"
448 @cust_pkg = grep { ! $_->getfield('cancel') }
449 values %{ $self->{'_pkgnum'}->cache };
453 warn "$me ncancelled_pkgs: searching for packages with custnum ".
457 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
459 @cust_pkg = $self->_cust_pkg($extra_qsearch);
463 sort sort_packages @cust_pkg;
469 my $extra_qsearch = ref($_[0]) ? shift : {};
471 $extra_qsearch->{'select'} ||= '*';
472 $extra_qsearch->{'select'} .=
473 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
477 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
482 'table' => 'cust_pkg',
483 'hashref' => { 'custnum' => $self->custnum },
488 # This should be generalized to use config options to determine order.
491 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
492 return $locationsort if $locationsort;
494 if ( $a->get('cancel') xor $b->get('cancel') ) {
495 return -1 if $b->get('cancel');
496 return 1 if $a->get('cancel');
497 #shouldn't get here...
500 my $a_num_cust_svc = $a->num_cust_svc;
501 my $b_num_cust_svc = $b->num_cust_svc;
502 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
503 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
504 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
505 my @a_cust_svc = $a->cust_svc;
506 my @b_cust_svc = $b->cust_svc;
507 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
508 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
509 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
510 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
517 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
523 return $self->num_suspended_pkgs unless wantarray;
524 grep { $_->susp } $self->ncancelled_pkgs;
527 =item unflagged_suspended_pkgs
529 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
530 customer (thouse packages without the `manual_flag' set).
534 sub unflagged_suspended_pkgs {
536 return $self->suspended_pkgs
537 unless dbdef->table('cust_pkg')->column('manual_flag');
538 grep { ! $_->manual_flag } $self->suspended_pkgs;
541 =item unsuspended_pkgs
543 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
548 sub unsuspended_pkgs {
550 return $self->num_unsuspended_pkgs unless wantarray;
551 grep { ! $_->susp } $self->ncancelled_pkgs;
556 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
557 this customer that are active (recurring).
563 grep { my $part_pkg = $_->part_pkg;
564 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
566 $self->unsuspended_pkgs;
571 Returns active packages, and also any suspended packages which are set to
572 continue billing while suspended.
578 grep { my $part_pkg = $_->part_pkg;
579 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
580 && ( ! $_->susp || $_->option('suspend_bill',1)
581 || ( $part_pkg->option('suspend_bill', 1)
582 && ! $_->option('no_suspend_bill',1)
586 $self->ncancelled_pkgs;
591 Returns the next date this customer will be billed, as a UNIX timestamp, or
592 undef if no billing package has a next bill date.
598 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
601 =item num_cancelled_pkgs
603 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
608 sub num_cancelled_pkgs {
609 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
612 sub num_ncancelled_pkgs {
613 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
616 sub num_suspended_pkgs {
617 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
618 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
621 sub num_unsuspended_pkgs {
622 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
623 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
628 my $sql = scalar(@_) ? shift : '';
629 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
630 my $sth = dbh->prepare(
631 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
632 ) or die dbh->errstr;
633 $sth->execute($self->custnum) or die $sth->errstr;
634 $sth->fetchrow_arrayref->[0];
643 L<FS::cust_main>, L<FS::cust_pkg>