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 );
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->{'cust_location'} &&
104 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
105 my $error = $opt->{'cust_location'}->insert;
107 $dbh->rollback if $oldAutoCommit;
108 return "inserting cust_location (transaction rolled back): $error";
110 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
113 $cust_pkg->locationnum($self->ship_locationnum);
116 $cust_pkg->custnum( $self->custnum );
118 my $error = $cust_pkg->insert( %insert_params );
120 $dbh->rollback if $oldAutoCommit;
121 return "inserting cust_pkg (transaction rolled back): $error";
124 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
125 if ( $svc_something->svcnum ) {
126 my $old_cust_svc = $svc_something->cust_svc;
127 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
128 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
129 $error = $new_cust_svc->replace($old_cust_svc);
131 $svc_something->pkgnum( $cust_pkg->pkgnum );
132 if ( $svc_something->isa('FS::svc_acct') ) {
133 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
134 qw( seconds upbytes downbytes totalbytes ) ) {
135 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
136 ${ $opt->{$_.'_ref'} } = 0;
139 $error = $svc_something->insert(%svc_options);
142 $dbh->rollback if $oldAutoCommit;
143 return "inserting svc_ (transaction rolled back): $error";
147 # add supplemental packages, if any are needed
148 my $part_pkg = FS::part_pkg->by_key($cust_pkg->pkgpart);
149 foreach my $link ($part_pkg->supp_part_pkg_link) {
150 #warn "inserting supplemental package ".$link->dst_pkgpart;
151 my $pkg = FS::cust_pkg->new({
152 'pkgpart' => $link->dst_pkgpart,
153 'pkglinknum' => $link->pkglinknum,
154 'custnum' => $self->custnum,
155 'main_pkgnum' => $cust_pkg->pkgnum,
156 'locationnum' => $cust_pkg->locationnum,
157 # try to prevent as many surprises as possible
158 'pkgbatch' => $cust_pkg->pkgbatch,
159 'start_date' => $cust_pkg->start_date,
160 'order_date' => $cust_pkg->order_date,
161 'expire' => $cust_pkg->expire,
162 'adjourn' => $cust_pkg->adjourn,
163 'contract_end' => $cust_pkg->contract_end,
164 'refnum' => $cust_pkg->refnum,
165 'discountnum' => $cust_pkg->discountnum,
166 'waive_setup' => $cust_pkg->waive_setup,
168 $error = $self->order_pkg('cust_pkg' => $pkg);
170 $dbh->rollback if $oldAutoCommit;
171 return "inserting supplemental package: $error";
175 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
180 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
182 Like the insert method on an existing record, this method orders multiple
183 packages and included services atomicaly. Pass a Tie::RefHash data structure
184 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
185 There should be a better explanation of this, but until then, here's an
189 tie %hash, 'Tie::RefHash'; #this part is important
191 $cust_pkg => [ $svc_acct ],
194 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
196 Services can be new, in which case they are inserted, or existing unaudited
197 services, in which case they are linked to the newly-created package.
199 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
200 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
202 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
203 on the supplied jobnum (they will not run until the specific job completes).
204 This can be used to defer provisioning until some action completes (such
205 as running the customer's credit card successfully).
207 The I<noexport> option is deprecated. If I<noexport> is set true, no
208 provisioning jobs (exports) are scheduled. (You can schedule them later with
209 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
210 on the cust_main object is not recommended, as existing services will also be
213 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
214 provided, the scalars (provided by references) will be incremented by the
215 values of the prepaid card.`
221 my $cust_pkgs = shift;
224 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
226 warn "$me order_pkgs called with options ".
227 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
230 local $SIG{HUP} = 'IGNORE';
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
241 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
243 foreach my $cust_pkg ( keys %$cust_pkgs ) {
245 my $error = $self->order_pkg(
246 'cust_pkg' => $cust_pkg,
247 'svcs' => $cust_pkgs->{$cust_pkg},
248 map { $_ => $options{$_} }
249 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
252 $dbh->rollback if $oldAutoCommit;
258 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
262 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
264 Returns all packages (see L<FS::cust_pkg>) for this customer.
270 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
272 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
275 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
276 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
278 @cust_pkg = $self->_cust_pkg($extra_qsearch);
281 map { $_ } sort sort_packages @cust_pkg;
286 Synonym for B<all_pkgs>.
294 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
296 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
300 sub ncancelled_pkgs {
302 my $extra_qsearch = ref($_[0]) ? shift : {};
304 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
306 return $self->num_ncancelled_pkgs unless wantarray;
309 if ( $self->{'_pkgnum'} ) {
311 warn "$me ncancelled_pkgs: returning cached objects"
314 @cust_pkg = grep { ! $_->getfield('cancel') }
315 values %{ $self->{'_pkgnum'}->cache };
319 warn "$me ncancelled_pkgs: searching for packages with custnum ".
323 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
325 @cust_pkg = $self->_cust_pkg($extra_qsearch);
329 sort sort_packages @cust_pkg;
335 my $extra_qsearch = ref($_[0]) ? shift : {};
337 $extra_qsearch->{'select'} ||= '*';
338 $extra_qsearch->{'select'} .=
339 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
343 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
348 'table' => 'cust_pkg',
349 'hashref' => { 'custnum' => $self->custnum },
354 # This should be generalized to use config options to determine order.
357 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
358 return $locationsort if $locationsort;
360 if ( $a->get('cancel') xor $b->get('cancel') ) {
361 return -1 if $b->get('cancel');
362 return 1 if $a->get('cancel');
363 #shouldn't get here...
366 my $a_num_cust_svc = $a->num_cust_svc;
367 my $b_num_cust_svc = $b->num_cust_svc;
368 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
369 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
370 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
371 my @a_cust_svc = $a->cust_svc;
372 my @b_cust_svc = $b->cust_svc;
373 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
374 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
375 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
376 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
383 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
389 return $self->num_suspended_pkgs unless wantarray;
390 grep { $_->susp } $self->ncancelled_pkgs;
393 =item unflagged_suspended_pkgs
395 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
396 customer (thouse packages without the `manual_flag' set).
400 sub unflagged_suspended_pkgs {
402 return $self->suspended_pkgs
403 unless dbdef->table('cust_pkg')->column('manual_flag');
404 grep { ! $_->manual_flag } $self->suspended_pkgs;
407 =item unsuspended_pkgs
409 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
414 sub unsuspended_pkgs {
416 return $self->num_unsuspended_pkgs unless wantarray;
417 grep { ! $_->susp } $self->ncancelled_pkgs;
422 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
423 this customer that are active (recurring).
429 grep { my $part_pkg = $_->part_pkg;
430 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
432 $self->unsuspended_pkgs;
437 Returns active packages, and also any suspended packages which are set to
438 continue billing while suspended.
444 grep { my $part_pkg = $_->part_pkg;
445 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
446 && ( ! $_->susp || $_->option('suspend_bill',1)
447 || ( $part_pkg->option('suspend_bill', 1)
448 && ! $_->option('no_suspend_bill',1)
452 $self->ncancelled_pkgs;
457 Returns the next date this customer will be billed, as a UNIX timestamp, or
458 undef if no billing package has a next bill date.
464 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
467 =item num_cancelled_pkgs
469 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
474 sub num_cancelled_pkgs {
475 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
478 sub num_ncancelled_pkgs {
479 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
482 sub num_suspended_pkgs {
483 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
484 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
487 sub num_unsuspended_pkgs {
488 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
489 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
494 my $sql = scalar(@_) ? shift : '';
495 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
496 my $sth = dbh->prepare(
497 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
498 ) or die dbh->errstr;
499 $sth->execute($self->custnum) or die $sth->errstr;
500 $sth->fetchrow_arrayref->[0];
509 L<FS::cust_main>, L<FS::cust_pkg>