5 use FS::UID qw( getotaker dbh );
6 use FS::Record qw( qsearch qsearchs );
13 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
15 # because they load configuraion by setting FS::UID::callback (see TODO)
21 @ISA = qw( FS::Record );
25 my ( $hashref, $cache ) = @_;
26 #if ( $hashref->{'pkgpart'} ) {
27 if ( $hashref->{'pkg'} ) {
28 # #@{ $self->{'_pkgnum'} } = ();
29 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
30 # $self->{'_pkgpart'} = $subcache;
31 # #push @{ $self->{'_pkgnum'} },
32 # FS::part_pkg->new_or_cached($hashref, $subcache);
33 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
35 if ( exists $hashref->{'svcnum'} ) {
36 #@{ $self->{'_pkgnum'} } = ();
37 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
38 $self->{'_svcnum'} = $subcache;
39 #push @{ $self->{'_pkgnum'} },
40 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
46 FS::cust_pkg - Object methods for cust_pkg objects
52 $record = new FS::cust_pkg \%hash;
53 $record = new FS::cust_pkg { 'column' => 'value' };
55 $error = $record->insert;
57 $error = $new_record->replace($old_record);
59 $error = $record->delete;
61 $error = $record->check;
63 $error = $record->cancel;
65 $error = $record->suspend;
67 $error = $record->unsuspend;
69 $part_pkg = $record->part_pkg;
71 @labels = $record->labels;
73 $seconds = $record->seconds_since($timestamp);
75 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
76 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
80 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
81 inherits from FS::Record. The following fields are currently supported:
85 =item pkgnum - primary key (assigned automatically for new billing items)
87 =item custnum - Customer (see L<FS::cust_main>)
89 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
101 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
103 =item manual_flag - If this field is set to 1, disables the automatic
104 unsuspension of this package when using the B<unsuspendauto> config file.
108 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
109 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
110 conversion functions.
118 Create a new billing item. To add the item to the database, see L<"insert">.
122 sub table { 'cust_pkg'; }
126 Adds this billing item to the database ("Orders" the item). If there is an
127 error, returns the error, otherwise returns false.
134 # custnum might not have have been defined in sub check (for one-shot new
135 # customers), so check it here instead
136 # (is this still necessary with transactions?)
138 my $error = $self->ut_number('custnum');
139 return $error if $error;
141 my $cust_main = $self->cust_main;
142 return "Unknown customer ". $self->custnum unless $cust_main;
144 my $agent = qsearchs( 'agent', { 'agentnum' => $cust_main->agentnum } );
145 my $pkgpart_href = $agent->pkgpart_hashref;
146 return "agent ". $agent->agentnum. " can't purchase pkgpart ". $self->pkgpart
147 unless $pkgpart_href->{ $self->pkgpart };
149 $self->SUPER::insert;
155 This method now works but you probably shouldn't use it.
157 You don't want to delete billing items, because there would then be no record
158 the customer ever purchased the item. Instead, see the cancel method.
163 # return "Can't delete cust_pkg records!";
166 =item replace OLD_RECORD
168 Replaces the OLD_RECORD with this one in the database. If there is an error,
169 returns the error, otherwise returns false.
171 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
173 Changing pkgpart may have disasterous effects. See the order subroutine.
175 setup and bill are normally updated by calling the bill method of a customer
176 object (see L<FS::cust_main>).
178 suspend is normally updated by the suspend and unsuspend methods.
180 cancel is normally updated by the cancel method (and also the order subroutine
186 my( $new, $old ) = ( shift, shift );
188 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
189 return "Can't change otaker!" if $old->otaker ne $new->otaker;
192 #return "Can't change setup once it exists!"
193 # if $old->getfield('setup') &&
194 # $old->getfield('setup') != $new->getfield('setup');
196 #some logic for bill, susp, cancel?
198 $new->SUPER::replace($old);
203 Checks all fields to make sure this is a valid billing item. If there is an
204 error, returns the error, otherwise returns false. Called by the insert and
213 $self->ut_numbern('pkgnum')
214 || $self->ut_numbern('custnum')
215 || $self->ut_number('pkgpart')
216 || $self->ut_numbern('setup')
217 || $self->ut_numbern('bill')
218 || $self->ut_numbern('susp')
219 || $self->ut_numbern('cancel')
221 return $error if $error;
223 if ( $self->custnum ) {
224 return "Unknown customer ". $self->custnum unless $self->cust_main;
227 return "Unknown pkgpart: ". $self->pkgpart
228 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
230 $self->otaker(getotaker) unless $self->otaker;
231 $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
234 if ( $self->dbdef_table->column('manual_flag') ) {
235 $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
236 $self->manual_flag($1);
244 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
245 in this package, then cancels the package itself (sets the cancel field to
248 If there is an error, returns the error, otherwise returns false.
256 local $SIG{HUP} = 'IGNORE';
257 local $SIG{INT} = 'IGNORE';
258 local $SIG{QUIT} = 'IGNORE';
259 local $SIG{TERM} = 'IGNORE';
260 local $SIG{TSTP} = 'IGNORE';
261 local $SIG{PIPE} = 'IGNORE';
263 my $oldAutoCommit = $FS::UID::AutoCommit;
264 local $FS::UID::AutoCommit = 0;
267 foreach my $cust_svc (
268 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
270 my $error = $cust_svc->cancel;
273 $dbh->rollback if $oldAutoCommit;
274 return "Error cancelling cust_svc: $error";
279 unless ( $self->getfield('cancel') ) {
280 my %hash = $self->hash;
281 $hash{'cancel'} = time;
282 my $new = new FS::cust_pkg ( \%hash );
283 $error = $new->replace($self);
285 $dbh->rollback if $oldAutoCommit;
290 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
297 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
298 package, then suspends the package itself (sets the susp field to now).
300 If there is an error, returns the error, otherwise returns false.
308 local $SIG{HUP} = 'IGNORE';
309 local $SIG{INT} = 'IGNORE';
310 local $SIG{QUIT} = 'IGNORE';
311 local $SIG{TERM} = 'IGNORE';
312 local $SIG{TSTP} = 'IGNORE';
313 local $SIG{PIPE} = 'IGNORE';
315 my $oldAutoCommit = $FS::UID::AutoCommit;
316 local $FS::UID::AutoCommit = 0;
319 foreach my $cust_svc (
320 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
322 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
324 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
325 $dbh->rollback if $oldAutoCommit;
326 return "Illegal svcdb value in part_svc!";
329 require "FS/$svcdb.pm";
331 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
333 $error = $svc->suspend;
335 $dbh->rollback if $oldAutoCommit;
342 unless ( $self->getfield('susp') ) {
343 my %hash = $self->hash;
344 $hash{'susp'} = time;
345 my $new = new FS::cust_pkg ( \%hash );
346 $error = $new->replace($self);
348 $dbh->rollback if $oldAutoCommit;
353 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
360 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
361 package, then unsuspends the package itself (clears the susp field).
363 If there is an error, returns the error, otherwise returns false.
371 local $SIG{HUP} = 'IGNORE';
372 local $SIG{INT} = 'IGNORE';
373 local $SIG{QUIT} = 'IGNORE';
374 local $SIG{TERM} = 'IGNORE';
375 local $SIG{TSTP} = 'IGNORE';
376 local $SIG{PIPE} = 'IGNORE';
378 my $oldAutoCommit = $FS::UID::AutoCommit;
379 local $FS::UID::AutoCommit = 0;
382 foreach my $cust_svc (
383 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
385 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
387 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
388 $dbh->rollback if $oldAutoCommit;
389 return "Illegal svcdb value in part_svc!";
392 require "FS/$svcdb.pm";
394 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
396 $error = $svc->unsuspend;
398 $dbh->rollback if $oldAutoCommit;
405 unless ( ! $self->getfield('susp') ) {
406 my %hash = $self->hash;
408 my $new = new FS::cust_pkg ( \%hash );
409 $error = $new->replace($self);
411 $dbh->rollback if $oldAutoCommit;
416 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
423 Returns the definition for this billing item, as an FS::part_pkg object (see
430 #exists( $self->{'_pkgpart'} )
432 ? $self->{'_pkgpart'}
433 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
438 Returns the services for this package, as FS::cust_svc objects (see
445 if ( $self->{'_svcnum'} ) {
446 values %{ $self->{'_svcnum'}->cache };
448 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
454 Returns a list of lists, calling the label method for all services
455 (see L<FS::cust_svc>) of this billing item.
461 map { [ $_->label ] } $self->cust_svc;
466 Returns the parent customer object (see L<FS::cust_main>).
472 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
475 =item seconds_since TIMESTAMP
477 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
478 package have been online since TIMESTAMP, according to the session monitor.
480 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
481 L<Time::Local> and L<Date::Parse> for conversion functions.
486 my($self, $since) = @_;
489 foreach my $cust_svc (
490 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
492 $seconds += $cust_svc->seconds_since($since);
499 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END DATASRC DB_USERNAME DB_PASSWORD
501 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
502 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
503 (exclusive), according to an external SQL radacct table, such as those
504 generated by ICRADIUS or FreeRADIUS. Sessions which started in the specified
505 range but are still open are counted from session start to the end of the
506 range. Also, sessions which end in the range but started earlier are counted
507 from the start of the range to session end. Finally, sessions which start
508 before the range but end after (or are still open) are counted for the entire
511 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
512 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
518 sub seconds_since_sqlradacct {
519 my($self, $start, $end, $datasrc, $db_user, $db_pass) = @_;
521 my $dbh = DBI->connect($datasrc, $db_user, $db_pass)
522 or die "can't connect to $datasrc: ". $DBI::errstr;
526 foreach my $cust_svc (
527 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
529 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end, $dbh);
542 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
544 CUSTNUM is a customer (see L<FS::cust_main>)
546 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
547 L<FS::part_pkg>) to order for this customer. Duplicates are of course
550 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
551 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
552 new billing items. An error is returned if this is not possible (see
553 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
556 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
557 newly-created cust_pkg objects.
562 my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
563 $remove_pkgnums = [] unless defined($remove_pkgnums);
565 my $oldAutoCommit = $FS::UID::AutoCommit;
566 local $FS::UID::AutoCommit = 0;
570 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
572 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
573 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
574 my %part_pkg = %{ $agent->pkgpart_hashref };
578 # for those packages being removed:
579 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
581 foreach $pkgnum ( @{$remove_pkgnums} ) {
582 foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
583 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
589 # for those packages the customer is purchasing:
590 # @{$pkgparts} is a list of said packages, by pkgpart
591 # @cust_svc is a corresponding list of lists of FS::Record objects
592 foreach my $pkgpart ( @{$pkgparts} ) {
593 unless ( $part_pkg{$pkgpart} ) {
594 $dbh->rollback if $oldAutoCommit;
595 return "Customer not permitted to purchase pkgpart $pkgpart!";
599 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
600 } map { $_->svcpart }
601 qsearch('pkg_svc', { pkgpart => $pkgpart,
602 quantity => { op=>'>', value=>'0', } } )
606 #special-case until this can be handled better
607 # move services to new svcparts - even if the svcparts don't match (svcdb
609 # looks like they're moved in no particular order, ewwwwwwww
610 # and looks like just one of each svcpart can be moved... o well
612 #start with still-leftover services
613 #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
614 foreach my $svcpart ( keys %svcnum ) {
615 next unless @{ $svcnum{$svcpart} };
617 my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
619 #find an empty place to put one
621 foreach my $pkgpart ( @{$pkgparts} ) {
623 qsearch('pkg_svc', { pkgpart => $pkgpart,
624 quantity => { op=>'>', value=>'0', } } );
626 # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
627 if ( ! @{$cust_svc[$i]} #find an empty place to put them with
628 && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
632 ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
633 my $cust_svc = shift @{$svcnum{$svcpart}};
634 $cust_svc->svcpart($new_svcpart);
635 #warn "changing from $svcpart to $new_svcpart!!!\n";
636 $cust_svc[$i] = [ $cust_svc ];
643 #check for leftover services
644 foreach (keys %svcnum) {
645 next unless @{ $svcnum{$_} };
646 $dbh->rollback if $oldAutoCommit;
647 return "Leftover services, svcpart $_: svcnum ".
648 join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
651 #no leftover services, let's make changes.
653 local $SIG{HUP} = 'IGNORE';
654 local $SIG{INT} = 'IGNORE';
655 local $SIG{QUIT} = 'IGNORE';
656 local $SIG{TERM} = 'IGNORE';
657 local $SIG{TSTP} = 'IGNORE';
658 local $SIG{PIPE} = 'IGNORE';
660 #first cancel old packages
661 foreach my $pkgnum ( @{$remove_pkgnums} ) {
662 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
664 $dbh->rollback if $oldAutoCommit;
665 return "Package $pkgnum not found to remove!";
667 my(%hash) = $old->hash;
668 $hash{'cancel'}=time;
669 my($new) = new FS::cust_pkg ( \%hash );
670 my($error)=$new->replace($old);
672 $dbh->rollback if $oldAutoCommit;
673 return "Couldn't update package $pkgnum: $error";
677 #now add new packages, changing cust_svc records if necessary
679 while ($pkgpart=shift @{$pkgparts} ) {
681 my $new = new FS::cust_pkg {
682 'custnum' => $custnum,
683 'pkgpart' => $pkgpart,
685 my $error = $new->insert;
687 $dbh->rollback if $oldAutoCommit;
688 return "Couldn't insert new cust_pkg record: $error";
690 push @{$return_cust_pkg}, $new if $return_cust_pkg;
691 my $pkgnum = $new->pkgnum;
693 foreach my $cust_svc ( @{ shift @cust_svc } ) {
694 my(%hash) = $cust_svc->hash;
695 $hash{'pkgnum'}=$pkgnum;
696 my $new = new FS::cust_svc ( \%hash );
698 #avoid Record diffing missing changed svcpart field from above.
699 my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
701 my $error = $new->replace($old);
703 $dbh->rollback if $oldAutoCommit;
704 return "Couldn't link old service to new package: $error";
709 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
718 $Id: cust_pkg.pm,v 1.25 2002-10-12 13:26:45 ivan Exp $
722 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
724 In sub order, the @pkgparts array (passed by reference) is clobbered.
726 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
727 method to pass dates to the recur_prog expression, it should do so.
729 FS::svc_acct, FS::svc_domain, FS::svc_www and FS::svc_forward are loaded via
730 'use' at compile time, rather than via 'require' in sub
731 { setup, suspend, unsuspend, cancel } because they use %FS::UID::callback to
732 load configuration values. Probably need a subroutine which decides what to
733 do based on whether or not we've fetched the user yet, rather than a hash.
734 See FS::UID and the TODO.
736 Now that things are transactional should the check in the insert method be
741 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
742 L<FS::pkg_svc>, schema.html from the base documentation