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
47 Optional arryaref of FS::svc_* service objects.
51 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
52 jobs will have a dependancy on the supplied job (they will not run until the
53 specific job completes). This can be used to defer provisioning until some
54 action completes (such as running the customer's credit card successfully).
58 Optional subject for a ticket created and attached to this customer
62 Optional queue name for ticket additions
70 my $opt = ref($_[0]) ? shift : { @_ };
72 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
74 warn "$me order_pkg called with options ".
75 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
78 my $cust_pkg = $opt->{'cust_pkg'};
79 my $svcs = $opt->{'svcs'} || [];
82 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
83 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
85 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
86 qw( ticket_subject ticket_queue );
88 local $SIG{HUP} = 'IGNORE';
89 local $SIG{INT} = 'IGNORE';
90 local $SIG{QUIT} = 'IGNORE';
91 local $SIG{TERM} = 'IGNORE';
92 local $SIG{TSTP} = 'IGNORE';
93 local $SIG{PIPE} = 'IGNORE';
95 my $oldAutoCommit = $FS::UID::AutoCommit;
96 local $FS::UID::AutoCommit = 0;
99 if ( $opt->{'cust_location'} &&
100 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
101 my $error = $opt->{'cust_location'}->insert;
103 $dbh->rollback if $oldAutoCommit;
104 return "inserting cust_location (transaction rolled back): $error";
106 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
109 $cust_pkg->custnum( $self->custnum );
111 my $error = $cust_pkg->insert( %insert_params );
113 $dbh->rollback if $oldAutoCommit;
114 return "inserting cust_pkg (transaction rolled back): $error";
117 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
118 if ( $svc_something->svcnum ) {
119 my $old_cust_svc = $svc_something->cust_svc;
120 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
121 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
122 $error = $new_cust_svc->replace($old_cust_svc);
124 $svc_something->pkgnum( $cust_pkg->pkgnum );
125 if ( $svc_something->isa('FS::svc_acct') ) {
126 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
127 qw( seconds upbytes downbytes totalbytes ) ) {
128 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
129 ${ $opt->{$_.'_ref'} } = 0;
132 $error = $svc_something->insert(%svc_options);
135 $dbh->rollback if $oldAutoCommit;
136 return "inserting svc_ (transaction rolled back): $error";
140 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
145 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
147 Like the insert method on an existing record, this method orders multiple
148 packages and included services atomicaly. Pass a Tie::RefHash data structure
149 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
150 There should be a better explanation of this, but until then, here's an
154 tie %hash, 'Tie::RefHash'; #this part is important
156 $cust_pkg => [ $svc_acct ],
159 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
161 Services can be new, in which case they are inserted, or existing unaudited
162 services, in which case they are linked to the newly-created package.
164 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
165 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
167 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
168 on the supplied jobnum (they will not run until the specific job completes).
169 This can be used to defer provisioning until some action completes (such
170 as running the customer's credit card successfully).
172 The I<noexport> option is deprecated. If I<noexport> is set true, no
173 provisioning jobs (exports) are scheduled. (You can schedule them later with
174 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
175 on the cust_main object is not recommended, as existing services will also be
178 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
179 provided, the scalars (provided by references) will be incremented by the
180 values of the prepaid card.`
186 my $cust_pkgs = shift;
189 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
191 warn "$me order_pkgs called with options ".
192 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
195 local $SIG{HUP} = 'IGNORE';
196 local $SIG{INT} = 'IGNORE';
197 local $SIG{QUIT} = 'IGNORE';
198 local $SIG{TERM} = 'IGNORE';
199 local $SIG{TSTP} = 'IGNORE';
200 local $SIG{PIPE} = 'IGNORE';
202 my $oldAutoCommit = $FS::UID::AutoCommit;
203 local $FS::UID::AutoCommit = 0;
206 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
208 foreach my $cust_pkg ( keys %$cust_pkgs ) {
210 my $error = $self->order_pkg(
211 'cust_pkg' => $cust_pkg,
212 'svcs' => $cust_pkgs->{$cust_pkg},
213 map { $_ => $options{$_} }
214 qw( seconds_ref upbytes_ref downbytes_ref totalbytes_ref depend_jobnum )
217 $dbh->rollback if $oldAutoCommit;
223 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
227 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
229 Returns all packages (see L<FS::cust_pkg>) for this customer.
235 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
237 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
240 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
241 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
243 @cust_pkg = $self->_cust_pkg($extra_qsearch);
246 map { $_ } sort sort_packages @cust_pkg;
251 Synonym for B<all_pkgs>.
259 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
261 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
265 sub ncancelled_pkgs {
267 my $extra_qsearch = ref($_[0]) ? shift : {};
269 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
271 return $self->num_ncancelled_pkgs unless wantarray;
274 if ( $self->{'_pkgnum'} ) {
276 warn "$me ncancelled_pkgs: returning cached objects"
279 @cust_pkg = grep { ! $_->getfield('cancel') }
280 values %{ $self->{'_pkgnum'}->cache };
284 warn "$me ncancelled_pkgs: searching for packages with custnum ".
288 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
290 @cust_pkg = $self->_cust_pkg($extra_qsearch);
294 sort sort_packages @cust_pkg;
300 my $extra_qsearch = ref($_[0]) ? shift : {};
302 $extra_qsearch->{'select'} ||= '*';
303 $extra_qsearch->{'select'} .=
304 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
308 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
313 'table' => 'cust_pkg',
314 'hashref' => { 'custnum' => $self->custnum },
319 # This should be generalized to use config options to determine order.
322 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
323 return $locationsort if $locationsort;
325 if ( $a->get('cancel') xor $b->get('cancel') ) {
326 return -1 if $b->get('cancel');
327 return 1 if $a->get('cancel');
328 #shouldn't get here...
331 my $a_num_cust_svc = $a->num_cust_svc;
332 my $b_num_cust_svc = $b->num_cust_svc;
333 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
334 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
335 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
336 my @a_cust_svc = $a->cust_svc;
337 my @b_cust_svc = $b->cust_svc;
338 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
339 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
340 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
341 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
348 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
354 grep { $_->susp } $self->ncancelled_pkgs;
357 =item unflagged_suspended_pkgs
359 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
360 customer (thouse packages without the `manual_flag' set).
364 sub unflagged_suspended_pkgs {
366 return $self->suspended_pkgs
367 unless dbdef->table('cust_pkg')->column('manual_flag');
368 grep { ! $_->manual_flag } $self->suspended_pkgs;
371 =item unsuspended_pkgs
373 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
378 sub unsuspended_pkgs {
380 grep { ! $_->susp } $self->ncancelled_pkgs;
385 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
386 this customer that are active (recurring).
392 grep { my $part_pkg = $_->part_pkg;
393 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
395 $self->unsuspended_pkgs;
400 Returns active packages, and also any suspended packages which are set to
401 continue billing while suspended.
407 grep { my $part_pkg = $_->part_pkg;
408 $part_pkg->freq ne '' && $part_pkg->freq ne '0'
409 && ( ! $_->susp || $part_pkg->option('suspend_bill', 1) );
411 $self->ncancelled_pkgs;
416 Returns the next date this customer will be billed, as a UNIX timestamp, or
417 undef if no billing package has a next bill date.
423 min( map $_->get('bill'), grep $_->get('bill'), $self->billing_pkgs );
426 =item num_cancelled_pkgs
428 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
433 sub num_cancelled_pkgs {
434 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
437 sub num_ncancelled_pkgs {
438 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
443 my $sql = scalar(@_) ? shift : '';
444 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
445 my $sth = dbh->prepare(
446 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
447 ) or die dbh->errstr;
448 $sth->execute($self->custnum) or die $sth->errstr;
449 $sth->fetchrow_arrayref->[0];
458 L<FS::cust_main>, L<FS::cust_pkg>