package FS::cust_svc; use strict; use vars qw( @ISA $DEBUG $me $ignore_quantity ); use Carp; #use Scalar::Util qw( blessed ); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh str2time_sql ); use FS::cust_pkg; use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; use FS::domain_record; use FS::part_export; use FS::cdr; #most FS::svc_ classes are autoloaded in svc_x emthod use FS::svc_acct; #this one is used in the cache stuff @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); $DEBUG = 0; $me = '[cust_svc]'; $ignore_quantity = 0; sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( $hashref->{'username'} ) { $self->{'_svc_acct'} = FS::svc_acct->new($hashref, ''); } if ( $hashref->{'svc'} ) { $self->{'_svcpart'} = FS::part_svc->new($hashref); } } =head1 NAME FS::cust_svc - Object method for cust_svc objects =head1 SYNOPSIS use FS::cust_svc; $record = new FS::cust_svc \%hash $record = new FS::cust_svc { 'column' => 'value' }; $error = $record->insert; $error = $new_record->replace($old_record); $error = $record->delete; $error = $record->check; ($label, $value) = $record->label; =head1 DESCRIPTION An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record. The following fields are currently supported: =over 4 =item svcnum - primary key (assigned automatically for new services) =item pkgnum - Package (see L) =item svcpart - Service definition (see L) =item overlimit - date the service exceeded its usage limit =back =head1 METHODS =over 4 =item new HASHREF Creates a new service. To add the refund to the database, see L<"insert">. Services are normally created by creating FS::svc_ objects (see L, L, and L, among others). =cut sub table { 'cust_svc'; } =item insert Adds this service to the database. If there is an error, returns the error, otherwise returns false. =item delete Deletes this service from the database. If there is an error, returns the error, otherwise returns false. Note that this only removes the cust_svc record - you should probably use the B method instead. =item cancel Cancels the relevant service by calling the B method of the associated FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object), deleting the FS::svc_XXX record and then deleting this record. If there is an error, returns the error, otherwise returns false. =cut sub cancel { my $self = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $part_svc = $self->part_svc; $part_svc->svcdb =~ /^([\w\-]+)$/ or do { $dbh->rollback if $oldAutoCommit; return "Illegal svcdb value in part_svc!"; }; my $svcdb = $1; require "FS/$svcdb.pm"; my $svc = $self->svc_x; if ($svc) { my $error = $svc->cancel; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error canceling service: $error"; } $error = $svc->delete; #this deletes this cust_svc record as well if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error deleting service: $error"; } } else { #huh? warn "WARNING: no svc_ record found for svcnum ". $self->svcnum. "; deleting cust_svc only\n"; my $error = $self->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error deleting cust_svc: $error"; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors } =item overlimit [ ACTION ] Retrieves or sets the overlimit date. If ACTION is absent, return the present value of overlimit. If ACTION is present, it can have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit is set to the current time if it is not already set. The 'unsuspend' value causes the time to be cleared. If there is an error on setting, returns the error, otherwise returns false. =cut sub overlimit { my $self = shift; my $action = shift or return $self->getfield('overlimit'); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; if ( $action eq 'suspend' ) { $self->setfield('overlimit', time) unless $self->getfield('overlimit'); }elsif ( $action eq 'unsuspend' ) { $self->setfield('overlimit', ''); }else{ die "unexpected action value: $action"; } local $ignore_quantity = 1; my $error = $self->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error setting overlimit: $error"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no errors } =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. =cut sub replace { # my $new = shift; # # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) # ? shift # : $new->replace_old; my ( $new, $old ) = ( shift, shift ); $old = $new->replace_old unless defined($old); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; if ( $new->svcpart != $old->svcpart ) { my $svc_x = $new->svc_x; my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart }); local($FS::Record::nowarn_identical) = 1; my $error = $new_svc_x->replace($svc_x); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; } } # #trigger a re-export on pkgnum changes? # # (of prepaid packages), for Expiration RADIUS attribute # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) { # my $svc_x = $new->svc_x; # local($FS::Record::nowarn_identical) = 1; # my $error = $svc_x->export('replace'); # if ( $error ) { # $dbh->rollback if $oldAutoCommit; # return $error if $error; # } # } #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } =item check Checks all fields to make sure this is a valid service. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. =cut sub check { my $self = shift; my $error = $self->ut_numbern('svcnum') || $self->ut_numbern('pkgnum') || $self->ut_number('svcpart') || $self->ut_numbern('overlimit') ; return $error if $error; my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; if ( $self->pkgnum ) { my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); return "Unknown pkgnum" unless $cust_pkg; my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $cust_pkg->pkgpart, 'svcpart' => $self->svcpart, }); # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart, # 'svcpart' => $self->svcpart, # 'quantity' => 0 } ); my $quantity = $pkg_svc ? $pkg_svc->quantity : 0; my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => $self->svcpart, }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum if scalar(@cust_svc) >= $quantity && !$ignore_quantity; } $self->SUPER::check; } =item part_svc Returns the definition for this service, as a FS::part_svc object (see L). =cut sub part_svc { my $self = shift; $self->{'_svcpart'} ? $self->{'_svcpart'} : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); } =item cust_pkg Returns the package this service belongs to, as a FS::cust_pkg object (see L). =cut sub cust_pkg { my $self = shift; qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); } =item pkg_svc Returns the pkg_svc record for for this service, if applicable. =cut sub pkg_svc { my $self = shift; my $cust_pkg = $self->cust_pkg; return undef unless $cust_pkg; qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart, 'pkgpart' => $cust_pkg->pkgpart, } ); } =item date_inserted Returns the date this service was inserted. =cut sub date_inserted { my $self = shift; $self->h_date('insert'); } =item label Returns a list consisting of: - The name of this service (from part_svc) - A meaningful identifier (username, domain, or mail alias) - The table name (i.e. svc_domain) for this service - svcnum Usage example: my($label, $value, $svcdb) = $cust_svc->label; =item label_long Like the B