4 use vars qw(@ISA $disable_agentcheck);
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 );
28 $disable_agentcheck = 0;
32 my ( $hashref, $cache ) = @_;
33 #if ( $hashref->{'pkgpart'} ) {
34 if ( $hashref->{'pkg'} ) {
35 # #@{ $self->{'_pkgnum'} } = ();
36 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
37 # $self->{'_pkgpart'} = $subcache;
38 # #push @{ $self->{'_pkgnum'} },
39 # FS::part_pkg->new_or_cached($hashref, $subcache);
40 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
42 if ( exists $hashref->{'svcnum'} ) {
43 #@{ $self->{'_pkgnum'} } = ();
44 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
45 $self->{'_svcnum'} = $subcache;
46 #push @{ $self->{'_pkgnum'} },
47 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
53 FS::cust_pkg - Object methods for cust_pkg objects
59 $record = new FS::cust_pkg \%hash;
60 $record = new FS::cust_pkg { 'column' => 'value' };
62 $error = $record->insert;
64 $error = $new_record->replace($old_record);
66 $error = $record->delete;
68 $error = $record->check;
70 $error = $record->cancel;
72 $error = $record->suspend;
74 $error = $record->unsuspend;
76 $part_pkg = $record->part_pkg;
78 @labels = $record->labels;
80 $seconds = $record->seconds_since($timestamp);
82 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
83 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
87 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
88 inherits from FS::Record. The following fields are currently supported:
92 =item pkgnum - primary key (assigned automatically for new billing items)
94 =item custnum - Customer (see L<FS::cust_main>)
96 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
100 =item bill - date (next bill date)
102 =item last_bill - last bill date
110 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
112 =item manual_flag - If this field is set to 1, disables the automatic
113 unsuspension of this package when using the B<unsuspendauto> config file.
117 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
118 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
119 conversion functions.
127 Create a new billing item. To add the item to the database, see L<"insert">.
131 sub table { 'cust_pkg'; }
135 Adds this billing item to the database ("Orders" the item). If there is an
136 error, returns the error, otherwise returns false.
143 # custnum might not have have been defined in sub check (for one-shot new
144 # customers), so check it here instead
145 # (is this still necessary with transactions?)
147 my $error = $self->ut_number('custnum');
148 return $error if $error;
150 my $cust_main = $self->cust_main;
151 return "Unknown customer ". $self->custnum unless $cust_main;
153 unless ( $disable_agentcheck ) {
154 my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
155 my $pkgpart_href = $agent->pkgpart_hashref;
156 return "agent ". $agent->agentnum.
157 " can't purchase pkgpart ". $self->pkgpart
158 unless $pkgpart_href->{ $self->pkgpart };
161 $self->SUPER::insert;
167 This method now works but you probably shouldn't use it.
169 You don't want to delete billing items, because there would then be no record
170 the customer ever purchased the item. Instead, see the cancel method.
175 # return "Can't delete cust_pkg records!";
178 =item replace OLD_RECORD
180 Replaces the OLD_RECORD with this one in the database. If there is an error,
181 returns the error, otherwise returns false.
183 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
185 Changing pkgpart may have disasterous effects. See the order subroutine.
187 setup and bill are normally updated by calling the bill method of a customer
188 object (see L<FS::cust_main>).
190 suspend is normally updated by the suspend and unsuspend methods.
192 cancel is normally updated by the cancel method (and also the order subroutine
198 my( $new, $old ) = ( shift, shift );
200 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
201 return "Can't change otaker!" if $old->otaker ne $new->otaker;
204 #return "Can't change setup once it exists!"
205 # if $old->getfield('setup') &&
206 # $old->getfield('setup') != $new->getfield('setup');
208 #some logic for bill, susp, cancel?
210 $new->SUPER::replace($old);
215 Checks all fields to make sure this is a valid billing item. If there is an
216 error, returns the error, otherwise returns false. Called by the insert and
225 $self->ut_numbern('pkgnum')
226 || $self->ut_numbern('custnum')
227 || $self->ut_number('pkgpart')
228 || $self->ut_numbern('setup')
229 || $self->ut_numbern('bill')
230 || $self->ut_numbern('susp')
231 || $self->ut_numbern('cancel')
233 return $error if $error;
235 if ( $self->custnum ) {
236 return "Unknown customer ". $self->custnum unless $self->cust_main;
239 return "Unknown pkgpart: ". $self->pkgpart
240 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
242 $self->otaker(getotaker) unless $self->otaker;
243 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
246 if ( $self->dbdef_table->column('manual_flag') ) {
247 $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
248 $self->manual_flag($1);
254 =item cancel [ OPTION => VALUE ... ]
256 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
257 in this package, then cancels the package itself (sets the cancel field to
260 Available options are: I<quiet>
262 I<quiet> can be set true to supress email cancellation notices.
264 If there is an error, returns the error, otherwise returns false.
269 my( $self, %options ) = @_;
272 local $SIG{HUP} = 'IGNORE';
273 local $SIG{INT} = 'IGNORE';
274 local $SIG{QUIT} = 'IGNORE';
275 local $SIG{TERM} = 'IGNORE';
276 local $SIG{TSTP} = 'IGNORE';
277 local $SIG{PIPE} = 'IGNORE';
279 my $oldAutoCommit = $FS::UID::AutoCommit;
280 local $FS::UID::AutoCommit = 0;
283 foreach my $cust_svc (
284 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
286 my $error = $cust_svc->cancel;
289 $dbh->rollback if $oldAutoCommit;
290 return "Error cancelling cust_svc: $error";
295 unless ( $self->getfield('cancel') ) {
296 my %hash = $self->hash;
297 $hash{'cancel'} = time;
298 my $new = new FS::cust_pkg ( \%hash );
299 $error = $new->replace($self);
301 $dbh->rollback if $oldAutoCommit;
306 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
308 my $conf = new FS::Conf;
309 my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
310 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
311 my $conf = new FS::Conf;
312 my $error = send_email(
313 'from' => $conf->config('invoice_from'),
314 'to' => \@invoicing_list,
315 'subject' => $conf->config('cancelsubject'),
316 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
318 #should this do something on errors?
327 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
328 package, then suspends the package itself (sets the susp field to now).
330 If there is an error, returns the error, otherwise returns false.
338 local $SIG{HUP} = 'IGNORE';
339 local $SIG{INT} = 'IGNORE';
340 local $SIG{QUIT} = 'IGNORE';
341 local $SIG{TERM} = 'IGNORE';
342 local $SIG{TSTP} = 'IGNORE';
343 local $SIG{PIPE} = 'IGNORE';
345 my $oldAutoCommit = $FS::UID::AutoCommit;
346 local $FS::UID::AutoCommit = 0;
349 foreach my $cust_svc (
350 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
352 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
354 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
355 $dbh->rollback if $oldAutoCommit;
356 return "Illegal svcdb value in part_svc!";
359 require "FS/$svcdb.pm";
361 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
363 $error = $svc->suspend;
365 $dbh->rollback if $oldAutoCommit;
372 unless ( $self->getfield('susp') ) {
373 my %hash = $self->hash;
374 $hash{'susp'} = time;
375 my $new = new FS::cust_pkg ( \%hash );
376 $error = $new->replace($self);
378 $dbh->rollback if $oldAutoCommit;
383 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
390 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
391 package, then unsuspends the package itself (clears the susp field).
393 If there is an error, returns the error, otherwise returns false.
401 local $SIG{HUP} = 'IGNORE';
402 local $SIG{INT} = 'IGNORE';
403 local $SIG{QUIT} = 'IGNORE';
404 local $SIG{TERM} = 'IGNORE';
405 local $SIG{TSTP} = 'IGNORE';
406 local $SIG{PIPE} = 'IGNORE';
408 my $oldAutoCommit = $FS::UID::AutoCommit;
409 local $FS::UID::AutoCommit = 0;
412 foreach my $cust_svc (
413 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
415 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
417 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
418 $dbh->rollback if $oldAutoCommit;
419 return "Illegal svcdb value in part_svc!";
422 require "FS/$svcdb.pm";
424 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
426 $error = $svc->unsuspend;
428 $dbh->rollback if $oldAutoCommit;
435 unless ( ! $self->getfield('susp') ) {
436 my %hash = $self->hash;
438 my $new = new FS::cust_pkg ( \%hash );
439 $error = $new->replace($self);
441 $dbh->rollback if $oldAutoCommit;
446 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
453 Returns the last bill date, or if there is no last bill date, the setup date.
454 Useful for billing metered services.
460 if ( $self->dbdef_table->column('last_bill') ) {
461 return $self->setfield('last_bill', $_[0]) if @_;
462 return $self->getfield('last_bill') if $self->getfield('last_bill');
464 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
465 'edate' => $self->bill, } );
466 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
471 Returns the definition for this billing item, as an FS::part_pkg object (see
478 #exists( $self->{'_pkgpart'} )
480 ? $self->{'_pkgpart'}
481 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
486 Returns the services for this package, as FS::cust_svc objects (see
493 if ( $self->{'_svcnum'} ) {
494 values %{ $self->{'_svcnum'}->cache };
496 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
502 Returns a list of lists, calling the label method for all services
503 (see L<FS::cust_svc>) of this billing item.
509 map { [ $_->label ] } $self->cust_svc;
514 Returns the parent customer object (see L<FS::cust_main>).
520 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
523 =item seconds_since TIMESTAMP
525 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
526 package have been online since TIMESTAMP, according to the session monitor.
528 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
529 L<Time::Local> and L<Date::Parse> for conversion functions.
534 my($self, $since) = @_;
537 foreach my $cust_svc (
538 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
540 $seconds += $cust_svc->seconds_since($since);
547 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
549 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
550 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
553 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
554 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
560 sub seconds_since_sqlradacct {
561 my($self, $start, $end) = @_;
565 foreach my $cust_svc (
567 my $part_svc = $_->part_svc;
568 $part_svc->svcdb eq 'svc_acct'
569 && scalar($part_svc->part_export('sqlradius'));
572 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
579 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
581 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
582 in this package for sessions ending between TIMESTAMP_START (inclusive) and
586 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
587 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
592 sub attribute_since_sqlradacct {
593 my($self, $start, $end, $attrib) = @_;
597 foreach my $cust_svc (
599 my $part_svc = $_->part_svc;
600 $part_svc->svcdb eq 'svc_acct'
601 && scalar($part_svc->part_export('sqlradius'));
604 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
611 =item transfer DEST_PKGNUM
613 Transfers as many services as possible from this package to another package.
614 The destination package must already exist. Services are moved only if
615 the destination allows services with the correct I<svcnum> (not svcdb).
616 Any services that can't be moved remain in the original package.
618 Returns an error, if there is one; otherwise, returns the number of services
619 that couldn't be moved.
624 my ($self, $dest_pkgnum) = @_;
631 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
632 $dest = $dest_pkgnum;
633 $dest_pkgnum = $dest->pkgnum;
635 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
638 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
640 foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
641 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
646 foreach $cust_svc ($dest->cust_svc) {
647 $target{$cust_svc->svcpart}--;
650 foreach $cust_svc ($self->cust_svc) {
651 if($target{$cust_svc->svcpart} > 0) {
652 $target{$cust_svc->svcpart}--;
653 my $new = new FS::cust_svc {
654 svcnum => $cust_svc->svcnum,
655 svcpart => $cust_svc->svcpart,
656 pkgnum => $dest_pkgnum };
657 my $error = $new->replace($cust_svc);
658 return $error if $error;
673 local $SIG{HUP} = 'IGNORE';
674 local $SIG{INT} = 'IGNORE';
675 local $SIG{QUIT} = 'IGNORE';
676 local $SIG{TERM} = 'IGNORE';
677 local $SIG{TSTP} = 'IGNORE';
678 local $SIG{PIPE} = 'IGNORE';
680 my $oldAutoCommit = $FS::UID::AutoCommit;
681 local $FS::UID::AutoCommit = 0;
684 foreach my $cust_svc ( $self->cust_svc ) {
685 #false laziness w/svc_Common::insert
686 my $svc_x = $cust_svc->svc_x;
687 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
688 my $error = $part_export->export_insert($svc_x);
690 $dbh->rollback if $oldAutoCommit;
696 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
707 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
709 CUSTNUM is a customer (see L<FS::cust_main>)
711 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
712 L<FS::part_pkg>) to order for this customer. Duplicates are of course
715 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
716 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
717 new billing items. An error is returned if this is not possible (see
718 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
721 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
722 newly-created cust_pkg objects.
728 # Rewritten to make use of the transfer() method, and in general
729 # to not suck so badly.
731 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
733 # Transactionize this whole mess
734 my $oldAutoCommit = $FS::UID::AutoCommit;
735 local $FS::UID::AutoCommit = 0;
739 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
740 return "Customer not found: $custnum" unless $cust_main;
742 # Create the new packages.
744 foreach (@$pkgparts) {
745 $cust_pkg = new FS::cust_pkg { custnum => $custnum,
747 $error = $cust_pkg->insert;
749 $dbh->rollback if $oldAutoCommit;
752 push @$return_cust_pkg, $cust_pkg;
754 # $return_cust_pkg now contains refs to all of the newly
757 # Transfer services and cancel old packages.
758 foreach my $old_pkgnum (@$remove_pkgnum) {
759 my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
760 foreach my $new_pkg (@$return_cust_pkg) {
761 $error = $old_pkg->transfer($new_pkg);
762 if ($error and $error == 0) {
763 # $old_pkg->transfer failed.
764 $dbh->rollback if $oldAutoCommit;
769 # Transfers were successful, but we went through all of the
770 # new packages and still had services left on the old package.
771 # We can't cancel the package under the circumstances, so abort.
772 $dbh->rollback if $oldAutoCommit;
773 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
775 $error = $old_pkg->cancel;
781 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
789 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
791 In sub order, the @pkgparts array (passed by reference) is clobbered.
793 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
794 method to pass dates to the recur_prog expression, it should do so.
796 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
797 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
798 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
799 configuration values. Probably need a subroutine which decides what to do
800 based on whether or not we've fetched the user yet, rather than a hash. See
801 FS::UID and the TODO.
803 Now that things are transactional should the check in the insert method be
808 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
809 L<FS::pkg_svc>, schema.html from the base documentation