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 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
146 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
148 Like the insert method on an existing record, this method orders multiple
149 packages and included services atomicaly. Pass a Tie::RefHash data structure
150 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
151 There should be a better explanation of this, but until then, here's an
155 tie %hash, 'Tie::RefHash'; #this part is important
157 $cust_pkg => [ $svc_acct ],
160 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
162 Services can be new, in which case they are inserted, or existing unaudited
163 services, in which case they are linked to the newly-created package.
165 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
166 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
168 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
169 on the supplied jobnum (they will not run until the specific job completes).
170 This can be used to defer provisioning until some action completes (such
171 as running the customer's credit card successfully).
173 The I<noexport> option is deprecated. If I<noexport> is set true, no
174 provisioning jobs (exports) are scheduled. (You can schedule them later with
175 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
176 on the cust_main object is not recommended, as existing services will also be
179 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
180 provided, the scalars (provided by references) will be incremented by the
181 values of the prepaid card.`
187 my $cust_pkgs = shift;
188 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
190 $seconds_ref ||= $options{'seconds_ref'};
192 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
194 warn "$me order_pkgs called with options ".
195 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
198 local $SIG{HUP} = 'IGNORE';
199 local $SIG{INT} = 'IGNORE';
200 local $SIG{QUIT} = 'IGNORE';
201 local $SIG{TERM} = 'IGNORE';
202 local $SIG{TSTP} = 'IGNORE';
203 local $SIG{PIPE} = 'IGNORE';
205 my $oldAutoCommit = $FS::UID::AutoCommit;
206 local $FS::UID::AutoCommit = 0;
209 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
211 foreach my $cust_pkg ( keys %$cust_pkgs ) {
213 my $error = $self->order_pkg(
214 'cust_pkg' => $cust_pkg,
215 'svcs' => $cust_pkgs->{$cust_pkg},
216 'seconds_ref' => $seconds_ref,
217 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
222 $dbh->rollback if $oldAutoCommit;
228 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
232 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
234 Returns all packages (see L<FS::cust_pkg>) for this customer.
240 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
242 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
245 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
246 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
248 @cust_pkg = $self->_cust_pkg($extra_qsearch);
251 map { $_ } sort sort_packages @cust_pkg;
256 Synonym for B<all_pkgs>.
264 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
266 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
270 sub ncancelled_pkgs {
272 my $extra_qsearch = ref($_[0]) ? shift : {};
274 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
276 return $self->num_ncancelled_pkgs unless wantarray;
279 if ( $self->{'_pkgnum'} ) {
281 warn "$me ncancelled_pkgs: returning cached objects"
284 @cust_pkg = grep { ! $_->getfield('cancel') }
285 values %{ $self->{'_pkgnum'}->cache };
289 warn "$me ncancelled_pkgs: searching for packages with custnum ".
293 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
295 @cust_pkg = $self->_cust_pkg($extra_qsearch);
299 sort sort_packages @cust_pkg;
305 my $extra_qsearch = ref($_[0]) ? shift : {};
307 $extra_qsearch->{'select'} ||= '*';
308 $extra_qsearch->{'select'} .=
309 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
313 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
318 'table' => 'cust_pkg',
319 'hashref' => { 'custnum' => $self->custnum },
324 # This should be generalized to use config options to determine order.
327 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
328 return $locationsort if $locationsort;
330 if ( $a->get('cancel') xor $b->get('cancel') ) {
331 return -1 if $b->get('cancel');
332 return 1 if $a->get('cancel');
333 #shouldn't get here...
336 my $a_num_cust_svc = $a->num_cust_svc;
337 my $b_num_cust_svc = $b->num_cust_svc;
338 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
339 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
340 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
341 my @a_cust_svc = $a->cust_svc;
342 my @b_cust_svc = $b->cust_svc;
343 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
344 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
345 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
346 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
353 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
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 grep { ! $_->susp } $self->ncancelled_pkgs;
390 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
391 this customer that are active (recurring).
397 grep { my $part_pkg = $_->part_pkg;
398 $part_pkg->freq ne '' && $part_pkg->freq ne '0';
400 $self->unsuspended_pkgs;
405 Returns the next date this customer will be billed, as a UNIX timestamp, or
406 undef if no active package has a next bill date.
412 min( map $_->get('bill'), grep $_->get('bill'), $self->active_pkgs );
415 =item num_cancelled_pkgs
417 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
422 sub num_cancelled_pkgs {
423 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
426 sub num_ncancelled_pkgs {
427 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
432 my $sql = scalar(@_) ? shift : '';
433 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
434 my $sth = dbh->prepare(
435 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
436 ) or die dbh->errstr;
437 $sth->execute($self->custnum) or die $sth->errstr;
438 $sth->fetchrow_arrayref->[0];
447 L<FS::cust_main>, L<FS::cust_pkg>