4 use vars qw(@ISA $disable_agentcheck $DEBUG);
5 use FS::UID qw( getotaker dbh );
6 use FS::Record qw( qsearch qsearchs );
7 use FS::Misc qw( send_email );
13 use FS::cust_bill_pkg;
15 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
17 # because they load configuraion by setting FS::UID::callback (see TODO)
23 # for sending cancel emails in sub cancel
26 @ISA = qw( FS::Record );
30 $disable_agentcheck = 0;
34 my ( $hashref, $cache ) = @_;
35 #if ( $hashref->{'pkgpart'} ) {
36 if ( $hashref->{'pkg'} ) {
37 # #@{ $self->{'_pkgnum'} } = ();
38 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
39 # $self->{'_pkgpart'} = $subcache;
40 # #push @{ $self->{'_pkgnum'} },
41 # FS::part_pkg->new_or_cached($hashref, $subcache);
42 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
44 if ( exists $hashref->{'svcnum'} ) {
45 #@{ $self->{'_pkgnum'} } = ();
46 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
47 $self->{'_svcnum'} = $subcache;
48 #push @{ $self->{'_pkgnum'} },
49 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
55 FS::cust_pkg - Object methods for cust_pkg objects
61 $record = new FS::cust_pkg \%hash;
62 $record = new FS::cust_pkg { 'column' => 'value' };
64 $error = $record->insert;
66 $error = $new_record->replace($old_record);
68 $error = $record->delete;
70 $error = $record->check;
72 $error = $record->cancel;
74 $error = $record->suspend;
76 $error = $record->unsuspend;
78 $part_pkg = $record->part_pkg;
80 @labels = $record->labels;
82 $seconds = $record->seconds_since($timestamp);
84 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
85 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
89 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
90 inherits from FS::Record. The following fields are currently supported:
94 =item pkgnum - primary key (assigned automatically for new billing items)
96 =item custnum - Customer (see L<FS::cust_main>)
98 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
102 =item bill - date (next bill date)
104 =item last_bill - last bill date
112 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
114 =item manual_flag - If this field is set to 1, disables the automatic
115 unsuspension of this package when using the B<unsuspendauto> config file.
119 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
120 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
121 conversion functions.
129 Create a new billing item. To add the item to the database, see L<"insert">.
133 sub table { 'cust_pkg'; }
137 Adds this billing item to the database ("Orders" the item). If there is an
138 error, returns the error, otherwise returns false.
145 # custnum might not have have been defined in sub check (for one-shot new
146 # customers), so check it here instead
147 # (is this still necessary with transactions?)
149 my $error = $self->ut_number('custnum');
150 return $error if $error;
152 my $cust_main = $self->cust_main;
153 return "Unknown custnum: ". $self->custnum unless $cust_main;
155 unless ( $disable_agentcheck ) {
156 my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
157 my $pkgpart_href = $agent->pkgpart_hashref;
158 return "agent ". $agent->agentnum.
159 " can't purchase pkgpart ". $self->pkgpart
160 unless $pkgpart_href->{ $self->pkgpart };
163 $self->SUPER::insert;
169 This method now works but you probably shouldn't use it.
171 You don't want to delete billing items, because there would then be no record
172 the customer ever purchased the item. Instead, see the cancel method.
177 # return "Can't delete cust_pkg records!";
180 =item replace OLD_RECORD
182 Replaces the OLD_RECORD with this one in the database. If there is an error,
183 returns the error, otherwise returns false.
185 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
187 Changing pkgpart may have disasterous effects. See the order subroutine.
189 setup and bill are normally updated by calling the bill method of a customer
190 object (see L<FS::cust_main>).
192 suspend is normally updated by the suspend and unsuspend methods.
194 cancel is normally updated by the cancel method (and also the order subroutine
200 my( $new, $old ) = ( shift, shift );
202 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
203 return "Can't change otaker!" if $old->otaker ne $new->otaker;
206 #return "Can't change setup once it exists!"
207 # if $old->getfield('setup') &&
208 # $old->getfield('setup') != $new->getfield('setup');
210 #some logic for bill, susp, cancel?
212 $new->SUPER::replace($old);
217 Checks all fields to make sure this is a valid billing item. If there is an
218 error, returns the error, otherwise returns false. Called by the insert and
227 $self->ut_numbern('pkgnum')
228 || $self->ut_numbern('custnum')
229 || $self->ut_number('pkgpart')
230 || $self->ut_numbern('setup')
231 || $self->ut_numbern('bill')
232 || $self->ut_numbern('susp')
233 || $self->ut_numbern('cancel')
235 return $error if $error;
237 if ( $self->custnum ) {
238 return "Unknown customer ". $self->custnum unless $self->cust_main;
241 return "Unknown pkgpart: ". $self->pkgpart
242 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
244 $self->otaker(getotaker) unless $self->otaker;
245 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
248 if ( $self->dbdef_table->column('manual_flag') ) {
249 $self->manual_flag('') if $self->manual_flag eq ' ';
250 $self->manual_flag =~ /^([01]?)$/
251 or return "Illegal manual_flag ". $self->manual_flag;
252 $self->manual_flag($1);
258 =item cancel [ OPTION => VALUE ... ]
260 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
261 in this package, then cancels the package itself (sets the cancel field to
264 Available options are: I<quiet>
266 I<quiet> can be set true to supress email cancellation notices.
268 If there is an error, returns the error, otherwise returns false.
273 my( $self, %options ) = @_;
276 local $SIG{HUP} = 'IGNORE';
277 local $SIG{INT} = 'IGNORE';
278 local $SIG{QUIT} = 'IGNORE';
279 local $SIG{TERM} = 'IGNORE';
280 local $SIG{TSTP} = 'IGNORE';
281 local $SIG{PIPE} = 'IGNORE';
283 my $oldAutoCommit = $FS::UID::AutoCommit;
284 local $FS::UID::AutoCommit = 0;
287 foreach my $cust_svc (
288 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
290 my $error = $cust_svc->cancel;
293 $dbh->rollback if $oldAutoCommit;
294 return "Error cancelling cust_svc: $error";
299 unless ( $self->getfield('cancel') ) {
300 my %hash = $self->hash;
301 $hash{'cancel'} = time;
302 my $new = new FS::cust_pkg ( \%hash );
303 $error = $new->replace($self);
305 $dbh->rollback if $oldAutoCommit;
310 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
312 my $conf = new FS::Conf;
313 my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
314 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
315 my $conf = new FS::Conf;
316 my $error = send_email(
317 'from' => $conf->config('invoice_from'),
318 'to' => \@invoicing_list,
319 'subject' => $conf->config('cancelsubject'),
320 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
322 #should this do something on errors?
331 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
332 package, then suspends the package itself (sets the susp field to now).
334 If there is an error, returns the error, otherwise returns false.
342 local $SIG{HUP} = 'IGNORE';
343 local $SIG{INT} = 'IGNORE';
344 local $SIG{QUIT} = 'IGNORE';
345 local $SIG{TERM} = 'IGNORE';
346 local $SIG{TSTP} = 'IGNORE';
347 local $SIG{PIPE} = 'IGNORE';
349 my $oldAutoCommit = $FS::UID::AutoCommit;
350 local $FS::UID::AutoCommit = 0;
353 foreach my $cust_svc (
354 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
356 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
358 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
359 $dbh->rollback if $oldAutoCommit;
360 return "Illegal svcdb value in part_svc!";
363 require "FS/$svcdb.pm";
365 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
367 $error = $svc->suspend;
369 $dbh->rollback if $oldAutoCommit;
376 unless ( $self->getfield('susp') ) {
377 my %hash = $self->hash;
378 $hash{'susp'} = time;
379 my $new = new FS::cust_pkg ( \%hash );
380 $error = $new->replace($self);
382 $dbh->rollback if $oldAutoCommit;
387 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
394 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
395 package, then unsuspends the package itself (clears the susp field).
397 If there is an error, returns the error, otherwise returns false.
405 local $SIG{HUP} = 'IGNORE';
406 local $SIG{INT} = 'IGNORE';
407 local $SIG{QUIT} = 'IGNORE';
408 local $SIG{TERM} = 'IGNORE';
409 local $SIG{TSTP} = 'IGNORE';
410 local $SIG{PIPE} = 'IGNORE';
412 my $oldAutoCommit = $FS::UID::AutoCommit;
413 local $FS::UID::AutoCommit = 0;
416 foreach my $cust_svc (
417 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
419 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
421 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
422 $dbh->rollback if $oldAutoCommit;
423 return "Illegal svcdb value in part_svc!";
426 require "FS/$svcdb.pm";
428 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
430 $error = $svc->unsuspend;
432 $dbh->rollback if $oldAutoCommit;
439 unless ( ! $self->getfield('susp') ) {
440 my %hash = $self->hash;
442 my $new = new FS::cust_pkg ( \%hash );
443 $error = $new->replace($self);
445 $dbh->rollback if $oldAutoCommit;
450 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
457 Returns the last bill date, or if there is no last bill date, the setup date.
458 Useful for billing metered services.
464 if ( $self->dbdef_table->column('last_bill') ) {
465 return $self->setfield('last_bill', $_[0]) if @_;
466 return $self->getfield('last_bill') if $self->getfield('last_bill');
468 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
469 'edate' => $self->bill, } );
470 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
475 Returns the definition for this billing item, as an FS::part_pkg object (see
482 #exists( $self->{'_pkgpart'} )
484 ? $self->{'_pkgpart'}
485 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
490 Returns the services for this package, as FS::cust_svc objects (see
497 if ( $self->{'_svcnum'} ) {
498 values %{ $self->{'_svcnum'}->cache };
500 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
506 Returns a list of lists, calling the label method for all services
507 (see L<FS::cust_svc>) of this billing item.
513 map { [ $_->label ] } $self->cust_svc;
518 Returns the parent customer object (see L<FS::cust_main>).
524 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
527 =item seconds_since TIMESTAMP
529 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
530 package have been online since TIMESTAMP, according to the session monitor.
532 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
533 L<Time::Local> and L<Date::Parse> for conversion functions.
538 my($self, $since) = @_;
541 foreach my $cust_svc (
542 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
544 $seconds += $cust_svc->seconds_since($since);
551 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
553 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
554 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
557 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
558 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
564 sub seconds_since_sqlradacct {
565 my($self, $start, $end) = @_;
569 foreach my $cust_svc (
571 my $part_svc = $_->part_svc;
572 $part_svc->svcdb eq 'svc_acct'
573 && scalar($part_svc->part_export('sqlradius'));
576 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
583 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
585 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
586 in this package for sessions ending between TIMESTAMP_START (inclusive) and
590 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
591 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
596 sub attribute_since_sqlradacct {
597 my($self, $start, $end, $attrib) = @_;
601 foreach my $cust_svc (
603 my $part_svc = $_->part_svc;
604 $part_svc->svcdb eq 'svc_acct'
605 && scalar($part_svc->part_export('sqlradius'));
608 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
615 =item transfer DEST_PKGNUM
617 Transfers as many services as possible from this package to another package.
618 The destination package must already exist. Services are moved only if
619 the destination allows services with the correct I<svcpart> (not svcdb).
620 Any services that can't be moved remain in the original package.
622 Returns an error, if there is one; otherwise, returns the number of services
623 that couldn't be moved.
628 my ($self, $dest_pkgnum) = @_;
635 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
636 $dest = $dest_pkgnum;
637 $dest_pkgnum = $dest->pkgnum;
639 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
642 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
644 foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
645 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
650 foreach $cust_svc ($dest->cust_svc) {
651 $target{$cust_svc->svcpart}--;
654 foreach $cust_svc ($self->cust_svc) {
655 if($target{$cust_svc->svcpart} > 0) {
656 $target{$cust_svc->svcpart}--;
657 my $new = new FS::cust_svc {
658 svcnum => $cust_svc->svcnum,
659 svcpart => $cust_svc->svcpart,
660 pkgnum => $dest_pkgnum };
661 my $error = $new->replace($cust_svc);
662 return $error if $error;
672 This method is deprecated. See the I<depend_jobnum> option to the insert and
673 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
680 local $SIG{HUP} = 'IGNORE';
681 local $SIG{INT} = 'IGNORE';
682 local $SIG{QUIT} = 'IGNORE';
683 local $SIG{TERM} = 'IGNORE';
684 local $SIG{TSTP} = 'IGNORE';
685 local $SIG{PIPE} = 'IGNORE';
687 my $oldAutoCommit = $FS::UID::AutoCommit;
688 local $FS::UID::AutoCommit = 0;
691 foreach my $cust_svc ( $self->cust_svc ) {
692 #false laziness w/svc_Common::insert
693 my $svc_x = $cust_svc->svc_x;
694 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
695 my $error = $part_export->export_insert($svc_x);
697 $dbh->rollback if $oldAutoCommit;
703 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
714 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
716 CUSTNUM is a customer (see L<FS::cust_main>)
718 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
719 L<FS::part_pkg>) to order for this customer. Duplicates are of course
722 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
723 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
724 new billing items. An error is returned if this is not possible (see
725 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
728 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
729 newly-created cust_pkg objects.
734 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
736 # Transactionize this whole mess
737 local $SIG{HUP} = 'IGNORE';
738 local $SIG{INT} = 'IGNORE';
739 local $SIG{QUIT} = 'IGNORE';
740 local $SIG{TERM} = 'IGNORE';
741 local $SIG{TSTP} = 'IGNORE';
742 local $SIG{PIPE} = 'IGNORE';
744 my $oldAutoCommit = $FS::UID::AutoCommit;
745 local $FS::UID::AutoCommit = 0;
749 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
750 return "Customer not found: $custnum" unless $cust_main;
752 # Create the new packages.
754 foreach (@$pkgparts) {
755 $cust_pkg = new FS::cust_pkg { custnum => $custnum,
757 $error = $cust_pkg->insert;
759 $dbh->rollback if $oldAutoCommit;
762 push @$return_cust_pkg, $cust_pkg;
764 # $return_cust_pkg now contains refs to all of the newly
767 # Transfer services and cancel old packages.
768 foreach my $old_pkgnum (@$remove_pkgnum) {
769 my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
770 foreach my $new_pkg (@$return_cust_pkg) {
771 $error = $old_pkg->transfer($new_pkg);
772 if ($error and $error == 0) {
773 # $old_pkg->transfer failed.
774 $dbh->rollback if $oldAutoCommit;
779 # Transfers were successful, but we went through all of the
780 # new packages and still had services left on the old package.
781 # We can't cancel the package under the circumstances, so abort.
782 $dbh->rollback if $oldAutoCommit;
783 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
785 $error = $old_pkg->cancel;
791 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
799 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
801 In sub order, the @pkgparts array (passed by reference) is clobbered.
803 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
804 method to pass dates to the recur_prog expression, it should do so.
806 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
807 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
808 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
809 configuration values. Probably need a subroutine which decides what to do
810 based on whether or not we've fetched the user yet, rather than a hash. See
811 FS::UID and the TODO.
813 Now that things are transactional should the check in the insert method be
818 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
819 L<FS::pkg_svc>, schema.html from the base documentation