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 Options may be passed as a list of key/value pairs or as a hash reference.
43 Optional FS::cust_location object. If not specified, the customer's
44 ship_location will be used.
48 Optional arryaref of FS::svc_* service objects.
52 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
53 jobs will have a dependancy on the supplied job (they will not run until the
54 specific job completes). This can be used to defer provisioning until some
55 action completes (such as running the customer's credit card successfully).
59 Optional subject for a ticket created and attached to this customer
63 Optional queue name for ticket additions
71 my $opt = ref($_[0]) ? shift : { @_ };
73 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
75 warn "$me order_pkg called with options ".
76 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
79 my $cust_pkg = $opt->{'cust_pkg'};
80 my $svcs = $opt->{'svcs'} || [];
83 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
84 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
86 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
87 qw( ticket_subject ticket_queue );
89 local $SIG{HUP} = 'IGNORE';
90 local $SIG{INT} = 'IGNORE';
91 local $SIG{QUIT} = 'IGNORE';
92 local $SIG{TERM} = 'IGNORE';
93 local $SIG{TSTP} = 'IGNORE';
94 local $SIG{PIPE} = 'IGNORE';
96 my $oldAutoCommit = $FS::UID::AutoCommit;
97 local $FS::UID::AutoCommit = 0;
100 if ( $opt->{'cust_location'} &&
101 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
102 my $error = $opt->{'cust_location'}->insert;
104 $dbh->rollback if $oldAutoCommit;
105 return "inserting cust_location (transaction rolled back): $error";
107 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
110 $cust_pkg->locationnum($self->ship_locationnum);
113 $cust_pkg->custnum( $self->custnum );
115 my $error = $cust_pkg->insert( %insert_params );
117 $dbh->rollback if $oldAutoCommit;
118 return "inserting cust_pkg (transaction rolled back): $error";
121 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
122 if ( $svc_something->svcnum ) {
123 my $old_cust_svc = $svc_something->cust_svc;
124 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
125 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
126 $error = $new_cust_svc->replace($old_cust_svc);
128 $svc_something->pkgnum( $cust_pkg->pkgnum );
129 if ( $svc_something->isa('FS::svc_acct') ) {
130 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
131 qw( seconds upbytes downbytes totalbytes ) ) {
132 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
133 ${ $opt->{$_.'_ref'} } = 0;
136 $error = $svc_something->insert(%svc_options);
139 $dbh->rollback if $oldAutoCommit;
140 return "inserting svc_ (transaction rolled back): $error";
144 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
149 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
151 Like the insert method on an existing record, this method orders multiple
152 packages and included services atomicaly. Pass a Tie::RefHash data structure
153 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
154 There should be a better explanation of this, but until then, here's an
158 tie %hash, 'Tie::RefHash'; #this part is important
160 $cust_pkg => [ $svc_acct ],
163 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
165 Services can be new, in which case they are inserted, or existing unaudited
166 services, in which case they are linked to the newly-created package.
168 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
169 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
171 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
172 on the supplied jobnum (they will not run until the specific job completes).
173 This can be used to defer provisioning until some action completes (such
174 as running the customer's credit card successfully).
176 The I<noexport> option is deprecated. If I<noexport> is set true, no
177 provisioning jobs (exports) are scheduled. (You can schedule them later with
178 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
179 on the cust_main object is not recommended, as existing services will also be
182 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
183 provided, the scalars (provided by references) will be incremented by the
184 values of the prepaid card.`
190 my $cust_pkgs = shift;
193 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
195 warn "$me order_pkgs called with options ".
196 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
199 local $SIG{HUP} = 'IGNORE';
200 local $SIG{INT} = 'IGNORE';
201 local $SIG{QUIT} = 'IGNORE';
202 local $SIG{TERM} = 'IGNORE';
203 local $SIG{TSTP} = 'IGNORE';
204 local $SIG{PIPE} = 'IGNORE';
206 my $oldAutoCommit = $FS::UID::AutoCommit;
207 local $FS::UID::AutoCommit = 0;
210 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
212 foreach my $cust_pkg ( keys %$cust_pkgs ) {
214 my $error = $self->order_pkg(
215 'cust_pkg' => $cust_pkg,
216 'svcs' => $cust_pkgs->{$cust_pkg},
217 map { $_ => $options{$_} }
218 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
221 $dbh->rollback if $oldAutoCommit;
227 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
231 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
233 Returns all packages (see L<FS::cust_pkg>) for this customer.
239 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
241 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
244 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
245 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
247 @cust_pkg = $self->_cust_pkg($extra_qsearch);
250 map { $_ } sort sort_packages @cust_pkg;
255 Synonym for B<all_pkgs>.
263 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
265 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
269 sub ncancelled_pkgs {
271 my $extra_qsearch = ref($_[0]) ? shift : {};
273 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
275 return $self->num_ncancelled_pkgs unless wantarray;
278 if ( $self->{'_pkgnum'} ) {
280 warn "$me ncancelled_pkgs: returning cached objects"
283 @cust_pkg = grep { ! $_->getfield('cancel') }
284 values %{ $self->{'_pkgnum'}->cache };
288 warn "$me ncancelled_pkgs: searching for packages with custnum ".
292 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
294 @cust_pkg = $self->_cust_pkg($extra_qsearch);
298 sort sort_packages @cust_pkg;
304 my $extra_qsearch = ref($_[0]) ? shift : {};
306 $extra_qsearch->{'select'} ||= '*';
307 $extra_qsearch->{'select'} .=
308 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
312 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
317 'table' => 'cust_pkg',
318 'hashref' => { 'custnum' => $self->custnum },
323 # This should be generalized to use config options to determine order.
326 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
327 return $locationsort if $locationsort;
329 if ( $a->get('cancel') xor $b->get('cancel') ) {
330 return -1 if $b->get('cancel');
331 return 1 if $a->get('cancel');
332 #shouldn't get here...
335 my $a_num_cust_svc = $a->num_cust_svc;
336 my $b_num_cust_svc = $b->num_cust_svc;
337 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
338 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
339 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
340 my @a_cust_svc = $a->cust_svc;
341 my @b_cust_svc = $b->cust_svc;
342 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
343 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
344 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
345 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
352 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
358 return $self->num_suspended_pkgs unless wantarray;
359 grep { $_->susp } $self->ncancelled_pkgs;
362 =item unflagged_suspended_pkgs
364 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
365 customer (thouse packages without the `manual_flag' set).
369 sub unflagged_suspended_pkgs {
371 return $self->suspended_pkgs
372 unless dbdef->table('cust_pkg')->column('manual_flag');
373 grep { ! $_->manual_flag } $self->suspended_pkgs;
376 =item unsuspended_pkgs
378 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
383 sub unsuspended_pkgs {
385 return $self->num_unsuspended_pkgs unless wantarray;
386 grep { ! $_->susp } $self->ncancelled_pkgs;
391 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
392 this customer that are active (recurring).
398 grep { my $part_pkg = $_->part_pkg;
399 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
401 $self->unsuspended_pkgs;
406 Returns active packages, and also any suspended packages which are set to
407 continue billing while suspended.
413 grep { my $part_pkg = $_->part_pkg;
414 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
415 && ( ! $_->susp || $_->option('suspend_bill',1)
416 || ( $part_pkg->option('suspend_bill', 1)
417 && ! $_->option('no_suspend_bill',1)
421 $self->ncancelled_pkgs;
426 Returns the next date this customer will be billed, as a UNIX timestamp, or
427 undef if no billing package has a next bill date.
433 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
436 =item num_cancelled_pkgs
438 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
443 sub num_cancelled_pkgs {
444 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
447 sub num_ncancelled_pkgs {
448 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
451 sub num_suspended_pkgs {
452 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
453 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 ");
456 sub num_unsuspended_pkgs {
457 shift->num_pkgs(" ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
458 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ");
463 my $sql = scalar(@_) ? shift : '';
464 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
465 my $sth = dbh->prepare(
466 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
467 ) or die dbh->errstr;
468 $sth->execute($self->custnum) or die $sth->errstr;
469 $sth->fetchrow_arrayref->[0];
478 L<FS::cust_main>, L<FS::cust_pkg>