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.
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);
505 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
507 CUSTNUM is a customer (see L<FS::cust_main>)
509 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
510 L<FS::part_pkg>) to order for this customer. Duplicates are of course
513 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
514 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
515 new billing items. An error is returned if this is not possible (see
516 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
519 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
520 newly-created cust_pkg objects.
525 my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
526 $remove_pkgnums = [] unless defined($remove_pkgnums);
528 my $oldAutoCommit = $FS::UID::AutoCommit;
529 local $FS::UID::AutoCommit = 0;
533 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
535 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
536 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
537 my %part_pkg = %{ $agent->pkgpart_hashref };
541 # for those packages being removed:
542 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::cust_svc objects
544 foreach $pkgnum ( @{$remove_pkgnums} ) {
545 foreach my $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
546 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
552 # for those packages the customer is purchasing:
553 # @{$pkgparts} is a list of said packages, by pkgpart
554 # @cust_svc is a corresponding list of lists of FS::Record objects
555 foreach my $pkgpart ( @{$pkgparts} ) {
556 unless ( $part_pkg{$pkgpart} ) {
557 $dbh->rollback if $oldAutoCommit;
558 return "Customer not permitted to purchase pkgpart $pkgpart!";
562 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
563 } map { $_->svcpart }
564 qsearch('pkg_svc', { pkgpart => $pkgpart,
565 quantity => { op=>'>', value=>'0', } } )
569 #special-case until this can be handled better
570 # move services to new svcparts - even if the svcparts don't match (svcdb
572 # looks like they're moved in no particular order, ewwwwwwww
573 # and looks like just one of each svcpart can be moved... o well
575 #start with still-leftover services
576 #foreach my $svcpart ( grep { scalar(@{ $svcnum{$_} }) } keys %svcnum ) {
577 foreach my $svcpart ( keys %svcnum ) {
578 next unless @{ $svcnum{$svcpart} };
580 my $svcdb = $svcnum{$svcpart}->[0]->part_svc->svcdb;
582 #find an empty place to put one
584 foreach my $pkgpart ( @{$pkgparts} ) {
586 qsearch('pkg_svc', { pkgpart => $pkgpart,
587 quantity => { op=>'>', value=>'0', } } );
589 # grep { $_->quantity > 0 } qsearch('pkg_svc', { pkgpart=>$pkgpart } );
590 if ( ! @{$cust_svc[$i]} #find an empty place to put them with
591 && grep { $svcdb eq $_->part_svc->svcdb } #with appropriate svcdb
595 ( grep { $svcdb eq $_->part_svc->svcdb } @pkg_svc )[0]->svcpart;
596 my $cust_svc = shift @{$svcnum{$svcpart}};
597 $cust_svc->svcpart($new_svcpart);
598 #warn "changing from $svcpart to $new_svcpart!!!\n";
599 $cust_svc[$i] = [ $cust_svc ];
606 #check for leftover services
607 foreach (keys %svcnum) {
608 next unless @{ $svcnum{$_} };
609 $dbh->rollback if $oldAutoCommit;
610 return "Leftover services, svcpart $_: svcnum ".
611 join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
614 #no leftover services, let's make changes.
616 local $SIG{HUP} = 'IGNORE';
617 local $SIG{INT} = 'IGNORE';
618 local $SIG{QUIT} = 'IGNORE';
619 local $SIG{TERM} = 'IGNORE';
620 local $SIG{TSTP} = 'IGNORE';
621 local $SIG{PIPE} = 'IGNORE';
623 #first cancel old packages
624 foreach my $pkgnum ( @{$remove_pkgnums} ) {
625 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
627 $dbh->rollback if $oldAutoCommit;
628 return "Package $pkgnum not found to remove!";
630 my(%hash) = $old->hash;
631 $hash{'cancel'}=time;
632 my($new) = new FS::cust_pkg ( \%hash );
633 my($error)=$new->replace($old);
635 $dbh->rollback if $oldAutoCommit;
636 return "Couldn't update package $pkgnum: $error";
640 #now add new packages, changing cust_svc records if necessary
642 while ($pkgpart=shift @{$pkgparts} ) {
644 my $new = new FS::cust_pkg {
645 'custnum' => $custnum,
646 'pkgpart' => $pkgpart,
648 my $error = $new->insert;
650 $dbh->rollback if $oldAutoCommit;
651 return "Couldn't insert new cust_pkg record: $error";
653 push @{$return_cust_pkg}, $new if $return_cust_pkg;
654 my $pkgnum = $new->pkgnum;
656 foreach my $cust_svc ( @{ shift @cust_svc } ) {
657 my(%hash) = $cust_svc->hash;
658 $hash{'pkgnum'}=$pkgnum;
659 my $new = new FS::cust_svc ( \%hash );
661 #avoid Record diffing missing changed svcpart field from above.
662 my $old = qsearchs('cust_svc', { 'svcnum' => $cust_svc->svcnum } );
664 my $error = $new->replace($old);
666 $dbh->rollback if $oldAutoCommit;
667 return "Couldn't link old service to new package: $error";
672 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
681 $Id: cust_pkg.pm,v 1.24 2002-09-17 09:19:06 ivan Exp $
685 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
687 In sub order, the @pkgparts array (passed by reference) is clobbered.
689 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
690 method to pass dates to the recur_prog expression, it should do so.
692 FS::svc_acct, FS::svc_domain, FS::svc_www and FS::svc_forward are loaded via
693 'use' at compile time, rather than via 'require' in sub
694 { setup, suspend, unsuspend, cancel } because they use %FS::UID::callback to
695 load configuration values. Probably need a subroutine which decides what to
696 do based on whether or not we've fetched the user yet, rather than a hash.
697 See FS::UID and the TODO.
699 Now that things are transactional should the check in the insert method be
704 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
705 L<FS::pkg_svc>, schema.html from the base documentation