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 warn "$me order_pkg called with options ".
73 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
76 my $cust_pkg = $opt->{'cust_pkg'};
77 my $svcs = $opt->{'svcs'} || [];
80 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
81 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
83 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
84 qw( ticket_subject ticket_queue );
86 local $SIG{HUP} = 'IGNORE';
87 local $SIG{INT} = 'IGNORE';
88 local $SIG{QUIT} = 'IGNORE';
89 local $SIG{TERM} = 'IGNORE';
90 local $SIG{TSTP} = 'IGNORE';
91 local $SIG{PIPE} = 'IGNORE';
93 my $oldAutoCommit = $FS::UID::AutoCommit;
94 local $FS::UID::AutoCommit = 0;
97 if ( $opt->{'cust_location'} &&
98 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
99 my $error = $opt->{'cust_location'}->insert;
101 $dbh->rollback if $oldAutoCommit;
102 return "inserting cust_location (transaction rolled back): $error";
104 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
107 $cust_pkg->custnum( $self->custnum );
109 my $error = $cust_pkg->insert( %insert_params );
111 $dbh->rollback if $oldAutoCommit;
112 return "inserting cust_pkg (transaction rolled back): $error";
115 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
116 if ( $svc_something->svcnum ) {
117 my $old_cust_svc = $svc_something->cust_svc;
118 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
119 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
120 $error = $new_cust_svc->replace($old_cust_svc);
122 $svc_something->pkgnum( $cust_pkg->pkgnum );
123 if ( $svc_something->isa('FS::svc_acct') ) {
124 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
125 qw( seconds upbytes downbytes totalbytes ) ) {
126 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
127 ${ $opt->{$_.'_ref'} } = 0;
130 $error = $svc_something->insert(%svc_options);
133 $dbh->rollback if $oldAutoCommit;
134 return "inserting svc_ (transaction rolled back): $error";
138 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
143 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
144 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
146 Like the insert method on an existing record, this method orders multiple
147 packages and included services atomicaly. Pass a Tie::RefHash data structure
148 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
149 There should be a better explanation of this, but until then, here's an
153 tie %hash, 'Tie::RefHash'; #this part is important
155 $cust_pkg => [ $svc_acct ],
158 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
160 Services can be new, in which case they are inserted, or existing unaudited
161 services, in which case they are linked to the newly-created package.
163 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
164 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
166 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
167 on the supplied jobnum (they will not run until the specific job completes).
168 This can be used to defer provisioning until some action completes (such
169 as running the customer's credit card successfully).
171 The I<noexport> option is deprecated. If I<noexport> is set true, no
172 provisioning jobs (exports) are scheduled. (You can schedule them later with
173 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
174 on the cust_main object is not recommended, as existing services will also be
177 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
178 provided, the scalars (provided by references) will be incremented by the
179 values of the prepaid card.`
185 my $cust_pkgs = shift;
186 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
188 $seconds_ref ||= $options{'seconds_ref'};
190 warn "$me order_pkgs called with options ".
191 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
194 local $SIG{HUP} = 'IGNORE';
195 local $SIG{INT} = 'IGNORE';
196 local $SIG{QUIT} = 'IGNORE';
197 local $SIG{TERM} = 'IGNORE';
198 local $SIG{TSTP} = 'IGNORE';
199 local $SIG{PIPE} = 'IGNORE';
201 my $oldAutoCommit = $FS::UID::AutoCommit;
202 local $FS::UID::AutoCommit = 0;
205 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
207 foreach my $cust_pkg ( keys %$cust_pkgs ) {
209 my $error = $self->order_pkg(
210 'cust_pkg' => $cust_pkg,
211 'svcs' => $cust_pkgs->{$cust_pkg},
212 'seconds_ref' => $seconds_ref,
213 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
218 $dbh->rollback if $oldAutoCommit;
224 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
228 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
230 Returns all packages (see L<FS::cust_pkg>) for this customer.
236 my $extra_qsearch = ref($_[0]) ? shift : { @_ };
238 return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
241 if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
242 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
244 @cust_pkg = $self->_cust_pkg($extra_qsearch);
247 map { $_ } sort sort_packages @cust_pkg;
252 Synonym for B<all_pkgs>.
260 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
262 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
266 sub ncancelled_pkgs {
268 my $extra_qsearch = ref($_[0]) ? shift : {};
270 return $self->num_ncancelled_pkgs unless wantarray;
273 if ( $self->{'_pkgnum'} ) {
275 warn "$me ncancelled_pkgs: returning cached objects"
278 @cust_pkg = grep { ! $_->getfield('cancel') }
279 values %{ $self->{'_pkgnum'}->cache };
283 warn "$me ncancelled_pkgs: searching for packages with custnum ".
287 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
289 @cust_pkg = $self->_cust_pkg($extra_qsearch);
293 sort sort_packages @cust_pkg;
299 my $extra_qsearch = ref($_[0]) ? shift : {};
301 $extra_qsearch->{'select'} ||= '*';
302 $extra_qsearch->{'select'} .=
303 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
307 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
312 'table' => 'cust_pkg',
313 'hashref' => { 'custnum' => $self->custnum },
318 # This should be generalized to use config options to determine order.
321 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
322 return $locationsort if $locationsort;
324 if ( $a->get('cancel') xor $b->get('cancel') ) {
325 return -1 if $b->get('cancel');
326 return 1 if $a->get('cancel');
327 #shouldn't get here...
330 my $a_num_cust_svc = $a->num_cust_svc;
331 my $b_num_cust_svc = $b->num_cust_svc;
332 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
333 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
334 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
335 my @a_cust_svc = $a->cust_svc;
336 my @b_cust_svc = $b->cust_svc;
337 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
338 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
339 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
340 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
347 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
353 grep { $_->susp } $self->ncancelled_pkgs;
356 =item unflagged_suspended_pkgs
358 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
359 customer (thouse packages without the `manual_flag' set).
363 sub unflagged_suspended_pkgs {
365 return $self->suspended_pkgs
366 unless dbdef->table('cust_pkg')->column('manual_flag');
367 grep { ! $_->manual_flag } $self->suspended_pkgs;
370 =item unsuspended_pkgs
372 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
377 sub unsuspended_pkgs {
379 grep { ! $_->susp } $self->ncancelled_pkgs;
384 Returns the next date this customer will be billed, as a UNIX timestamp, or
385 undef if no active package has a next bill date.
391 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
394 =item num_cancelled_pkgs
396 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
401 sub num_cancelled_pkgs {
402 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
405 sub num_ncancelled_pkgs {
406 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
411 my $sql = scalar(@_) ? shift : '';
412 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
413 my $sth = dbh->prepare(
414 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
415 ) or die dbh->errstr;
416 $sth->execute($self->custnum) or die $sth->errstr;
417 $sth->fetchrow_arrayref->[0];
426 L<FS::cust_main>, L<FS::cust_pkg>