4 use vars qw(@ISA $disable_agentcheck);
5 use FS::UID qw( getotaker dbh );
6 use FS::Record qw( qsearch qsearchs );
12 use FS::cust_bill_pkg;
14 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
16 # because they load configuraion by setting FS::UID::callback (see TODO)
22 @ISA = qw( FS::Record );
24 $disable_agentcheck = 0;
28 my ( $hashref, $cache ) = @_;
29 #if ( $hashref->{'pkgpart'} ) {
30 if ( $hashref->{'pkg'} ) {
31 # #@{ $self->{'_pkgnum'} } = ();
32 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
33 # $self->{'_pkgpart'} = $subcache;
34 # #push @{ $self->{'_pkgnum'} },
35 # FS::part_pkg->new_or_cached($hashref, $subcache);
36 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
38 if ( exists $hashref->{'svcnum'} ) {
39 #@{ $self->{'_pkgnum'} } = ();
40 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
41 $self->{'_svcnum'} = $subcache;
42 #push @{ $self->{'_pkgnum'} },
43 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
49 FS::cust_pkg - Object methods for cust_pkg objects
55 $record = new FS::cust_pkg \%hash;
56 $record = new FS::cust_pkg { 'column' => 'value' };
58 $error = $record->insert;
60 $error = $new_record->replace($old_record);
62 $error = $record->delete;
64 $error = $record->check;
66 $error = $record->cancel;
68 $error = $record->suspend;
70 $error = $record->unsuspend;
72 $part_pkg = $record->part_pkg;
74 @labels = $record->labels;
76 $seconds = $record->seconds_since($timestamp);
78 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
79 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
83 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
84 inherits from FS::Record. The following fields are currently supported:
88 =item pkgnum - primary key (assigned automatically for new billing items)
90 =item custnum - Customer (see L<FS::cust_main>)
92 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
96 =item bill - date (next bill date)
104 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
106 =item manual_flag - If this field is set to 1, disables the automatic
107 unsuspension of this package when using the B<unsuspendauto> config file.
111 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
112 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
113 conversion functions.
121 Create a new billing item. To add the item to the database, see L<"insert">.
125 sub table { 'cust_pkg'; }
129 Adds this billing item to the database ("Orders" the item). If there is an
130 error, returns the error, otherwise returns false.
137 # custnum might not have have been defined in sub check (for one-shot new
138 # customers), so check it here instead
139 # (is this still necessary with transactions?)
141 my $error = $self->ut_number('custnum');
142 return $error if $error;
144 my $cust_main = $self->cust_main;
145 return "Unknown customer ". $self->custnum unless $cust_main;
147 unless ( $disable_agentcheck ) {
148 my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
149 my $pkgpart_href = $agent->pkgpart_hashref;
150 return "agent ". $agent->agentnum.
151 " can't purchase pkgpart ". $self->pkgpart
152 unless $pkgpart_href->{ $self->pkgpart };
155 $self->SUPER::insert;
161 This method now works but you probably shouldn't use it.
163 You don't want to delete billing items, because there would then be no record
164 the customer ever purchased the item. Instead, see the cancel method.
169 # return "Can't delete cust_pkg records!";
172 =item replace OLD_RECORD
174 Replaces the OLD_RECORD with this one in the database. If there is an error,
175 returns the error, otherwise returns false.
177 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
179 Changing pkgpart may have disasterous effects. See the order subroutine.
181 setup and bill are normally updated by calling the bill method of a customer
182 object (see L<FS::cust_main>).
184 suspend is normally updated by the suspend and unsuspend methods.
186 cancel is normally updated by the cancel method (and also the order subroutine
192 my( $new, $old ) = ( shift, shift );
194 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
195 return "Can't change otaker!" if $old->otaker ne $new->otaker;
198 #return "Can't change setup once it exists!"
199 # if $old->getfield('setup') &&
200 # $old->getfield('setup') != $new->getfield('setup');
202 #some logic for bill, susp, cancel?
204 $new->SUPER::replace($old);
209 Checks all fields to make sure this is a valid billing item. If there is an
210 error, returns the error, otherwise returns false. Called by the insert and
219 $self->ut_numbern('pkgnum')
220 || $self->ut_numbern('custnum')
221 || $self->ut_number('pkgpart')
222 || $self->ut_numbern('setup')
223 || $self->ut_numbern('bill')
224 || $self->ut_numbern('susp')
225 || $self->ut_numbern('cancel')
227 return $error if $error;
229 if ( $self->custnum ) {
230 return "Unknown customer ". $self->custnum unless $self->cust_main;
233 return "Unknown pkgpart: ". $self->pkgpart
234 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
236 $self->otaker(getotaker) unless $self->otaker;
237 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
240 if ( $self->dbdef_table->column('manual_flag') ) {
241 $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
242 $self->manual_flag($1);
250 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
251 in this package, then cancels the package itself (sets the cancel field to
254 If there is an error, returns the error, otherwise returns false.
262 local $SIG{HUP} = 'IGNORE';
263 local $SIG{INT} = 'IGNORE';
264 local $SIG{QUIT} = 'IGNORE';
265 local $SIG{TERM} = 'IGNORE';
266 local $SIG{TSTP} = 'IGNORE';
267 local $SIG{PIPE} = 'IGNORE';
269 my $oldAutoCommit = $FS::UID::AutoCommit;
270 local $FS::UID::AutoCommit = 0;
273 foreach my $cust_svc (
274 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
276 my $error = $cust_svc->cancel;
279 $dbh->rollback if $oldAutoCommit;
280 return "Error cancelling cust_svc: $error";
285 unless ( $self->getfield('cancel') ) {
286 my %hash = $self->hash;
287 $hash{'cancel'} = time;
288 my $new = new FS::cust_pkg ( \%hash );
289 $error = $new->replace($self);
291 $dbh->rollback if $oldAutoCommit;
296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
303 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
304 package, then suspends the package itself (sets the susp field to now).
306 If there is an error, returns the error, otherwise returns false.
314 local $SIG{HUP} = 'IGNORE';
315 local $SIG{INT} = 'IGNORE';
316 local $SIG{QUIT} = 'IGNORE';
317 local $SIG{TERM} = 'IGNORE';
318 local $SIG{TSTP} = 'IGNORE';
319 local $SIG{PIPE} = 'IGNORE';
321 my $oldAutoCommit = $FS::UID::AutoCommit;
322 local $FS::UID::AutoCommit = 0;
325 foreach my $cust_svc (
326 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
328 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
330 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
331 $dbh->rollback if $oldAutoCommit;
332 return "Illegal svcdb value in part_svc!";
335 require "FS/$svcdb.pm";
337 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
339 $error = $svc->suspend;
341 $dbh->rollback if $oldAutoCommit;
348 unless ( $self->getfield('susp') ) {
349 my %hash = $self->hash;
350 $hash{'susp'} = time;
351 my $new = new FS::cust_pkg ( \%hash );
352 $error = $new->replace($self);
354 $dbh->rollback if $oldAutoCommit;
359 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
366 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
367 package, then unsuspends the package itself (clears the susp field).
369 If there is an error, returns the error, otherwise returns false.
377 local $SIG{HUP} = 'IGNORE';
378 local $SIG{INT} = 'IGNORE';
379 local $SIG{QUIT} = 'IGNORE';
380 local $SIG{TERM} = 'IGNORE';
381 local $SIG{TSTP} = 'IGNORE';
382 local $SIG{PIPE} = 'IGNORE';
384 my $oldAutoCommit = $FS::UID::AutoCommit;
385 local $FS::UID::AutoCommit = 0;
388 foreach my $cust_svc (
389 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
391 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
393 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
394 $dbh->rollback if $oldAutoCommit;
395 return "Illegal svcdb value in part_svc!";
398 require "FS/$svcdb.pm";
400 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
402 $error = $svc->unsuspend;
404 $dbh->rollback if $oldAutoCommit;
411 unless ( ! $self->getfield('susp') ) {
412 my %hash = $self->hash;
414 my $new = new FS::cust_pkg ( \%hash );
415 $error = $new->replace($self);
417 $dbh->rollback if $oldAutoCommit;
422 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
429 Returns the last bill date, or if there is no last bill date, the setup date.
430 Useful for billing metered services.
436 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
437 'edate' => $self->bill, } );
438 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
443 Returns the definition for this billing item, as an FS::part_pkg object (see
450 #exists( $self->{'_pkgpart'} )
452 ? $self->{'_pkgpart'}
453 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
458 Returns the services for this package, as FS::cust_svc objects (see
465 if ( $self->{'_svcnum'} ) {
466 values %{ $self->{'_svcnum'}->cache };
468 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
474 Returns a list of lists, calling the label method for all services
475 (see L<FS::cust_svc>) of this billing item.
481 map { [ $_->label ] } $self->cust_svc;
486 Returns the parent customer object (see L<FS::cust_main>).
492 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
495 =item seconds_since TIMESTAMP
497 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
498 package have been online since TIMESTAMP, according to the session monitor.
500 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
501 L<Time::Local> and L<Date::Parse> for conversion functions.
506 my($self, $since) = @_;
509 foreach my $cust_svc (
510 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
512 $seconds += $cust_svc->seconds_since($since);
519 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
521 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
522 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
525 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
526 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
532 sub seconds_since_sqlradacct {
533 my($self, $start, $end) = @_;
537 foreach my $cust_svc (
539 my $part_svc = $_->part_svc;
540 $part_svc->svcdb eq 'svc_acct'
541 && scalar($part_svc->part_export('sqlradius'));
544 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
551 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
553 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
554 in this package for sessions ending between TIMESTAMP_START (inclusive) and
558 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
559 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
564 sub attribute_since_sqlradacct {
565 my($self, $start, $end, $attrib) = @_;
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 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
589 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
591 CUSTNUM is a customer (see L<FS::cust_main>)
593 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
594 L<FS::part_pkg>) to order for this customer. Duplicates are of course
597 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
598 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
599 new billing items. An error is returned if this is not possible (see
600 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
603 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
604 newly-created cust_pkg objects.
609 my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
610 $remove_pkgnums = [] unless defined($remove_pkgnums);
612 my $oldAutoCommit = $FS::UID::AutoCommit;
613 local $FS::UID::AutoCommit = 0;
617 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
619 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
620 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
621 my %part_pkg = %{ $agent->pkgpart_hashref };
625 # for those packages being removed:
626 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
628 foreach $pkgnum ( @{$remove_pkgnums} ) {
629 foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
630 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
636 # for those packages the customer is purchasing:
637 # @{$pkgparts} is a list of said packages, by pkgpart
638 # @cust_svc is a corresponding list of lists of FS::Record objects
639 foreach my $pkgpart ( @{$pkgparts} ) {
640 unless ( $part_pkg{$pkgpart} ) {
641 $dbh->rollback if $oldAutoCommit;
642 return "Customer not permitted to purchase pkgpart $pkgpart!";
646 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
647 } map { $_->svcpart }
648 qsearch('pkg_svc', { pkgpart => $pkgpart,
649 quantity => { op=>'>', value=>'0', } } )
653 #special-case until this can be handled better
654 # move services to new svcparts - even if the svcparts don't match (svcdb
656 # looks like they're moved in no particular order, ewwwwwwww
657 # and looks like just one of each svcpart can be moved... o well
659 #start with still-leftover services
660 #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
661 foreach my $svcpart ( keys %svcnum ) {
662 next unless @{ $svcnum{$svcpart} };
664 my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
666 #find an empty place to put one
668 foreach my $pkgpart ( @{$pkgparts} ) {
670 qsearch('pkg_svc', { pkgpart => $pkgpart,
671 quantity => { op=>'>', value=>'0', } } );
673 # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
674 if ( ! @{$cust_svc[$i]} #find an empty place to put them with
675 && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
679 ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
680 my $cust_svc = shift @{$svcnum{$svcpart}};
681 $cust_svc->svcpart($new_svcpart);
682 #warn "changing from $svcpart to $new_svcpart!!!\n";
683 $cust_svc[$i] = [ $cust_svc ];
690 #check for leftover services
691 foreach (keys %svcnum) {
692 next unless @{ $svcnum{$_} };
693 $dbh->rollback if $oldAutoCommit;
694 return "Leftover services, svcpart $_: svcnum ".
695 join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
698 #no leftover services, let's make changes.
700 local $SIG{HUP} = 'IGNORE';
701 local $SIG{INT} = 'IGNORE';
702 local $SIG{QUIT} = 'IGNORE';
703 local $SIG{TERM} = 'IGNORE';
704 local $SIG{TSTP} = 'IGNORE';
705 local $SIG{PIPE} = 'IGNORE';
707 #first cancel old packages
708 foreach my $pkgnum ( @{$remove_pkgnums} ) {
709 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
711 $dbh->rollback if $oldAutoCommit;
712 return "Package $pkgnum not found to remove!";
714 my(%hash) = $old->hash;
715 $hash{'cancel'}=time;
716 my($new) = new FS::cust_pkg ( \%hash );
717 my($error)=$new->replace($old);
719 $dbh->rollback if $oldAutoCommit;
720 return "Couldn't update package $pkgnum: $error";
724 #now add new packages, changing cust_svc records if necessary
726 while ($pkgpart=shift @{$pkgparts} ) {
728 my $new = new FS::cust_pkg {
729 'custnum' => $custnum,
730 'pkgpart' => $pkgpart,
732 my $error = $new->insert;
734 $dbh->rollback if $oldAutoCommit;
735 return "Couldn't insert new cust_pkg record: $error";
737 push @{$return_cust_pkg}, $new if $return_cust_pkg;
738 my $pkgnum = $new->pkgnum;
740 foreach my $cust_svc ( @{ shift @cust_svc } ) {
741 my(%hash) = $cust_svc->hash;
742 $hash{'pkgnum'}=$pkgnum;
743 my $new = new FS::cust_svc ( \%hash );
745 #avoid Record diffing missing changed svcpart field from above.
746 my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
748 my $error = $new->replace($old);
750 $dbh->rollback if $oldAutoCommit;
751 return "Couldn't link old service to new package: $error";
756 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
765 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
767 In sub order, the @pkgparts array (passed by reference) is clobbered.
769 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
770 method to pass dates to the recur_prog expression, it should do so.
772 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
773 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
774 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
775 configuration values. Probably need a subroutine which decides what to do
776 based on whether or not we've fetched the user yet, rather than a hash. See
777 FS::UID and the TODO.
779 Now that things are transactional should the check in the insert method be
784 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
785 L<FS::pkg_svc>, schema.html from the base documentation