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 custnum: ". $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('') if $self->manual_flag eq ' ';
248 $self->manual_flag =~ /^([01]?)$/
249 or return "Illegal manual_flag ". $self->manual_flag;
250 $self->manual_flag($1);
256 =item cancel [ OPTION => VALUE ... ]
258 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
259 in this package, then cancels the package itself (sets the cancel field to
262 Available options are: I<quiet>
264 I<quiet> can be set true to supress email cancellation notices.
266 If there is an error, returns the error, otherwise returns false.
271 my( $self, %options ) = @_;
274 local $SIG{HUP} = 'IGNORE';
275 local $SIG{INT} = 'IGNORE';
276 local $SIG{QUIT} = 'IGNORE';
277 local $SIG{TERM} = 'IGNORE';
278 local $SIG{TSTP} = 'IGNORE';
279 local $SIG{PIPE} = 'IGNORE';
281 my $oldAutoCommit = $FS::UID::AutoCommit;
282 local $FS::UID::AutoCommit = 0;
285 foreach my $cust_svc (
286 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
288 my $error = $cust_svc->cancel;
291 $dbh->rollback if $oldAutoCommit;
292 return "Error cancelling cust_svc: $error";
297 unless ( $self->getfield('cancel') ) {
298 my %hash = $self->hash;
299 $hash{'cancel'} = time;
300 my $new = new FS::cust_pkg ( \%hash );
301 $error = $new->replace($self);
303 $dbh->rollback if $oldAutoCommit;
308 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
310 my $conf = new FS::Conf;
311 my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list;
312 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
313 my $conf = new FS::Conf;
314 my $error = send_email(
315 'from' => $conf->config('invoice_from'),
316 'to' => \@invoicing_list,
317 'subject' => $conf->config('cancelsubject'),
318 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
320 #should this do something on errors?
329 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
330 package, then suspends the package itself (sets the susp field to now).
332 If there is an error, returns the error, otherwise returns false.
340 local $SIG{HUP} = 'IGNORE';
341 local $SIG{INT} = 'IGNORE';
342 local $SIG{QUIT} = 'IGNORE';
343 local $SIG{TERM} = 'IGNORE';
344 local $SIG{TSTP} = 'IGNORE';
345 local $SIG{PIPE} = 'IGNORE';
347 my $oldAutoCommit = $FS::UID::AutoCommit;
348 local $FS::UID::AutoCommit = 0;
351 foreach my $cust_svc (
352 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
354 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
356 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
357 $dbh->rollback if $oldAutoCommit;
358 return "Illegal svcdb value in part_svc!";
361 require "FS/$svcdb.pm";
363 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
365 $error = $svc->suspend;
367 $dbh->rollback if $oldAutoCommit;
374 unless ( $self->getfield('susp') ) {
375 my %hash = $self->hash;
376 $hash{'susp'} = time;
377 my $new = new FS::cust_pkg ( \%hash );
378 $error = $new->replace($self);
380 $dbh->rollback if $oldAutoCommit;
385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
392 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
393 package, then unsuspends the package itself (clears the susp field).
395 If there is an error, returns the error, otherwise returns false.
403 local $SIG{HUP} = 'IGNORE';
404 local $SIG{INT} = 'IGNORE';
405 local $SIG{QUIT} = 'IGNORE';
406 local $SIG{TERM} = 'IGNORE';
407 local $SIG{TSTP} = 'IGNORE';
408 local $SIG{PIPE} = 'IGNORE';
410 my $oldAutoCommit = $FS::UID::AutoCommit;
411 local $FS::UID::AutoCommit = 0;
414 foreach my $cust_svc (
415 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
417 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
419 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
420 $dbh->rollback if $oldAutoCommit;
421 return "Illegal svcdb value in part_svc!";
424 require "FS/$svcdb.pm";
426 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
428 $error = $svc->unsuspend;
430 $dbh->rollback if $oldAutoCommit;
437 unless ( ! $self->getfield('susp') ) {
438 my %hash = $self->hash;
440 my $new = new FS::cust_pkg ( \%hash );
441 $error = $new->replace($self);
443 $dbh->rollback if $oldAutoCommit;
448 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
455 Returns the last bill date, or if there is no last bill date, the setup date.
456 Useful for billing metered services.
462 if ( $self->dbdef_table->column('last_bill') ) {
463 return $self->setfield('last_bill', $_[0]) if @_;
464 return $self->getfield('last_bill') if $self->getfield('last_bill');
466 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
467 'edate' => $self->bill, } );
468 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
473 Returns the definition for this billing item, as an FS::part_pkg object (see
480 #exists( $self->{'_pkgpart'} )
482 ? $self->{'_pkgpart'}
483 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
488 Returns the services for this package, as FS::cust_svc objects (see
495 if ( $self->{'_svcnum'} ) {
496 values %{ $self->{'_svcnum'}->cache };
498 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
504 Returns a list of lists, calling the label method for all services
505 (see L<FS::cust_svc>) of this billing item.
511 map { [ $_->label ] } $self->cust_svc;
516 Returns the parent customer object (see L<FS::cust_main>).
522 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
525 =item seconds_since TIMESTAMP
527 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
528 package have been online since TIMESTAMP, according to the session monitor.
530 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
531 L<Time::Local> and L<Date::Parse> for conversion functions.
536 my($self, $since) = @_;
539 foreach my $cust_svc (
540 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
542 $seconds += $cust_svc->seconds_since($since);
549 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
551 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
552 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
555 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
556 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
562 sub seconds_since_sqlradacct {
563 my($self, $start, $end) = @_;
567 foreach my $cust_svc (
569 my $part_svc = $_->part_svc;
570 $part_svc->svcdb eq 'svc_acct'
571 && scalar($part_svc->part_export('sqlradius'));
574 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
581 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
583 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
584 in this package for sessions ending between TIMESTAMP_START (inclusive) and
588 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
589 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
594 sub attribute_since_sqlradacct {
595 my($self, $start, $end, $attrib) = @_;
599 foreach my $cust_svc (
601 my $part_svc = $_->part_svc;
602 $part_svc->svcdb eq 'svc_acct'
603 && scalar($part_svc->part_export('sqlradius'));
606 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
613 =item transfer DEST_PKGNUM
615 Transfers as many services as possible from this package to another package.
616 The destination package must already exist. Services are moved only if
617 the destination allows services with the correct I<svcnum> (not svcdb).
618 Any services that can't be moved remain in the original package.
620 Returns an error, if there is one; otherwise, returns the number of services
621 that couldn't be moved.
626 my ($self, $dest_pkgnum) = @_;
633 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
634 $dest = $dest_pkgnum;
635 $dest_pkgnum = $dest->pkgnum;
637 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
640 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
642 foreach $pkg_svc (qsearch('pkg_svc', { pkgpart => $dest->pkgpart })) {
643 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
648 foreach $cust_svc ($dest->cust_svc) {
649 $target{$cust_svc->svcpart}--;
652 foreach $cust_svc ($self->cust_svc) {
653 if($target{$cust_svc->svcpart} > 0) {
654 $target{$cust_svc->svcpart}--;
655 my $new = new FS::cust_svc {
656 svcnum => $cust_svc->svcnum,
657 svcpart => $cust_svc->svcpart,
658 pkgnum => $dest_pkgnum };
659 my $error = $new->replace($cust_svc);
660 return $error if $error;
675 local $SIG{HUP} = 'IGNORE';
676 local $SIG{INT} = 'IGNORE';
677 local $SIG{QUIT} = 'IGNORE';
678 local $SIG{TERM} = 'IGNORE';
679 local $SIG{TSTP} = 'IGNORE';
680 local $SIG{PIPE} = 'IGNORE';
682 my $oldAutoCommit = $FS::UID::AutoCommit;
683 local $FS::UID::AutoCommit = 0;
686 foreach my $cust_svc ( $self->cust_svc ) {
687 #false laziness w/svc_Common::insert
688 my $svc_x = $cust_svc->svc_x;
689 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
690 my $error = $part_export->export_insert($svc_x);
692 $dbh->rollback if $oldAutoCommit;
698 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
709 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
711 CUSTNUM is a customer (see L<FS::cust_main>)
713 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
714 L<FS::part_pkg>) to order for this customer. Duplicates are of course
717 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
718 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
719 new billing items. An error is returned if this is not possible (see
720 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
723 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
724 newly-created cust_pkg objects.
730 # Rewritten to make use of the transfer() method, and in general
731 # to not suck so badly.
733 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
735 # Transactionize this whole mess
736 my $oldAutoCommit = $FS::UID::AutoCommit;
737 local $FS::UID::AutoCommit = 0;
741 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
742 return "Customer not found: $custnum" unless $cust_main;
744 # Create the new packages.
746 foreach (@$pkgparts) {
747 $cust_pkg = new FS::cust_pkg { custnum => $custnum,
749 $error = $cust_pkg->insert;
751 $dbh->rollback if $oldAutoCommit;
754 push @$return_cust_pkg, $cust_pkg;
756 # $return_cust_pkg now contains refs to all of the newly
759 # Transfer services and cancel old packages.
760 foreach my $old_pkgnum (@$remove_pkgnum) {
761 my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
762 foreach my $new_pkg (@$return_cust_pkg) {
763 $error = $old_pkg->transfer($new_pkg);
764 if ($error and $error == 0) {
765 # $old_pkg->transfer failed.
766 $dbh->rollback if $oldAutoCommit;
771 # Transfers were successful, but we went through all of the
772 # new packages and still had services left on the old package.
773 # We can't cancel the package under the circumstances, so abort.
774 $dbh->rollback if $oldAutoCommit;
775 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
777 $error = $old_pkg->cancel;
783 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
791 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
793 In sub order, the @pkgparts array (passed by reference) is clobbered.
795 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
796 method to pass dates to the recur_prog expression, it should do so.
798 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
799 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
800 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
801 configuration values. Probably need a subroutine which decides what to do
802 based on whether or not we've fetched the user yet, rather than a hash. See
803 FS::UID and the TODO.
805 Now that things are transactional should the check in the insert method be
810 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
811 L<FS::pkg_svc>, schema.html from the base documentation