1 package FS::cust_main::Packages;
4 use vars qw( $DEBUG $me );
5 use List::Util qw( min );
7 use FS::Record qw( qsearch );
12 $me = '[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 );
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 if ( ! $opt->{'cust_location'}->locationnum ) {
133 my $error = $opt->{'cust_location'}->insert;
135 $dbh->rollback if $oldAutoCommit;
136 return "inserting cust_location (transaction rolled back): $error";
139 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
143 $cust_pkg->locationnum($self->ship_locationnum);
147 $cust_pkg->custnum( $self->custnum );
149 my $error = $cust_pkg->insert( %insert_params );
151 $dbh->rollback if $oldAutoCommit;
152 return "inserting cust_pkg (transaction rolled back): $error";
155 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
156 if ( $svc_something->svcnum ) {
157 my $old_cust_svc = $svc_something->cust_svc;
158 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
159 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
160 $error = $new_cust_svc->replace($old_cust_svc);
162 $svc_something->pkgnum( $cust_pkg->pkgnum );
163 if ( $svc_something->isa('FS::svc_acct') ) {
164 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
165 qw( seconds upbytes downbytes totalbytes ) ) {
166 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
167 ${ $opt->{$_.'_ref'} } = 0;
170 $error = $svc_something->insert(%svc_options);
173 $dbh->rollback if $oldAutoCommit;
174 return "inserting svc_ (transaction rolled back): $error";
178 # add supplemental packages, if any are needed
179 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
180 foreach my $link ($part_pkg->supp_part_pkg_link) {
181 #warn "inserting supplemental package ".$link->dst_pkgpart;
182 my $pkg = FS::cust_pkg->new({
183 'pkgpart' => $link->dst_pkgpart,
184 'pkglinknum' => $link->pkglinknum,
185 'custnum' => $self->custnum,
186 'main_pkgnum' => $cust_pkg->pkgnum,
187 'locationnum' => $cust_pkg->locationnum,
188 # try to prevent as many surprises as possible
189 'pkgbatch' => $cust_pkg->pkgbatch,
190 'start_date' => $cust_pkg->start_date,
191 'order_date' => $cust_pkg->order_date,
192 'expire' => $cust_pkg->expire,
193 'adjourn' => $cust_pkg->adjourn,
194 'contract_end' => $cust_pkg->contract_end,
195 'refnum' => $cust_pkg->refnum,
196 'discountnum' => $cust_pkg->discountnum,
197 'waive_setup' => $cust_pkg->waive_setup,
198 'allow_pkgpart' => $opt->{'allow_pkgpart'},
200 $error = $self->order_pkg('cust_pkg' => $pkg);
202 $dbh->rollback if $oldAutoCommit;
203 return "inserting supplemental package: $error";
207 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
212 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
214 Like the insert method on an existing record, this method orders multiple
215 packages and included services atomicaly. Pass a Tie::RefHash data structure
216 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
217 There should be a better explanation of this, but until then, here's an
221 tie %hash, 'Tie::RefHash'; #this part is important
223 $cust_pkg => [ $svc_acct ],
226 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
228 Services can be new, in which case they are inserted, or existing unaudited
229 services, in which case they are linked to the newly-created package.
231 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
232 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
234 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
235 on the supplied jobnum (they will not run until the specific job completes).
236 This can be used to defer provisioning until some action completes (such
237 as running the customer's credit card successfully).
239 The I<noexport> option is deprecated. If I<noexport> is set true, no
240 provisioning jobs (exports) are scheduled. (You can schedule them later with
241 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
242 on the cust_main object is not recommended, as existing services will also be
245 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
246 provided, the scalars (provided by references) will be incremented by the
247 values of the prepaid card.`
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 )
284 $dbh->rollback if $oldAutoCommit;
290 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
294 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
296 Returns all packages (see L<FS::cust_pkg>) for this customer.
302 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
304 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
307 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
308 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
310 @cust_pkg = $self->_cust_pkg($extra_qsearch);
313 map { $_ } sort sort_packages @cust_pkg;
318 Synonym for B<all_pkgs>.
326 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
328 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
332 sub ncancelled_pkgs {
334 my $extra_qsearch = ref($_[0]) ? shift : {};
336 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
338 return $self->num_ncancelled_pkgs unless wantarray;
341 if ( $self->{'_pkgnum'} ) {
343 warn "$me ncancelled_pkgs: returning cached objects"
346 @cust_pkg = grep { ! $_->getfield('cancel') }
347 values %{ $self->{'_pkgnum'}->cache };
351 warn "$me ncancelled_pkgs: searching for packages with custnum ".
355 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
357 @cust_pkg = $self->_cust_pkg($extra_qsearch);
361 sort sort_packages @cust_pkg;
367 my $extra_qsearch = ref($_[0]) ? shift : {};
369 $extra_qsearch->{'select'} ||= '*';
370 $extra_qsearch->{'select'} .=
371 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
375 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
380 'table' => 'cust_pkg',
381 'hashref' => { 'custnum' => $self->custnum },
386 # This should be generalized to use config options to determine order.
389 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
390 return $locationsort if $locationsort;
392 if ( $a->get('cancel') xor $b->get('cancel') ) {
393 return -1 if $b->get('cancel');
394 return 1 if $a->get('cancel');
395 #shouldn't get here...
398 my $a_num_cust_svc = $a->num_cust_svc;
399 my $b_num_cust_svc = $b->num_cust_svc;
400 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
401 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
402 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
403 my @a_cust_svc = $a->cust_svc;
404 my @b_cust_svc = $b->cust_svc;
405 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
406 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
407 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
408 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
415 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
421 return $self->num_suspended_pkgs unless wantarray;
422 grep { $_->susp } $self->ncancelled_pkgs;
425 =item unflagged_suspended_pkgs
427 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
428 customer (thouse packages without the `manual_flag' set).
432 sub unflagged_suspended_pkgs {
434 return $self->suspended_pkgs
435 unless dbdef->table('cust_pkg')->column('manual_flag');
436 grep { ! $_->manual_flag } $self->suspended_pkgs;
439 =item unsuspended_pkgs
441 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
446 sub unsuspended_pkgs {
448 return $self->num_unsuspended_pkgs unless wantarray;
449 grep { ! $_->susp } $self->ncancelled_pkgs;
454 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
455 this customer that are active (recurring).
461 grep { my $part_pkg = $_->part_pkg;
462 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
464 $self->unsuspended_pkgs;
469 Returns active packages, and also any suspended packages which are set to
470 continue billing while suspended.
476 grep { my $part_pkg = $_->part_pkg;
477 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
478 && ( ! $_->susp || $_->option('suspend_bill',1)
479 || ( $part_pkg->option('suspend_bill', 1)
480 && ! $_->option('no_suspend_bill',1)
484 $self->ncancelled_pkgs;
489 Returns the next date this customer will be billed, as a UNIX timestamp, or
490 undef if no billing package has a next bill date.
496 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
499 =item num_cancelled_pkgs
501 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
506 sub num_cancelled_pkgs {
507 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
510 sub num_ncancelled_pkgs {
511 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
514 sub num_suspended_pkgs {
515 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
516 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
519 sub num_unsuspended_pkgs {
520 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
521 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
526 my $sql = scalar(@_) ? shift : '';
527 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
528 my $sth = dbh->prepare(
529 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
530 ) or die dbh->errstr;
531 $sth->execute($self->custnum) or die $sth->errstr;
532 $sth->fetchrow_arrayref->[0];
541 L<FS::cust_main>, L<FS::cust_pkg>