package FS::cust_svc; use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); use strict; use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system ); use Carp qw(cluck); #use Scalar::Util qw( blessed ); use List::Util qw( max ); use FS::Conf; use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing ); use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; use FS::part_svc_link; use FS::domain_record; use FS::part_export; use FS::cdr; use FS::UI::Web; use FS::export_cust_svc; #most FS::svc_ classes are autoloaded in svc_x emthod use FS::svc_acct; #this one is used in the cache stuff $DEBUG = 0; $me = '[cust_svc]'; $ignore_quantity = 0; #ask FS::UID to run this stuff for us later FS::UID->install_callback( sub { $conf = new FS::Conf; $ticket_system = $conf->config('ticket_system') }); our $cache_enabled = 0; sub _simplecache { my( $self, $hashref ) = @_; if ( $cache_enabled && $hashref->{'svc'} ) { $self->{'_svcpart'} = FS::part_svc->new($hashref); } } 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 agent_svcid - Optional legacy service ID =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. =cut sub insert { 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 $error = $self->SUPER::insert; #check if this releases a hold (see FS::pkg_svc provision_hold) $error ||= $self->_check_provision_hold; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } =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. =cut my $rt_session; sub delete { my $self = shift; my $cust_pkg = $self->cust_pkg; my $custnum = $cust_pkg->custnum if $cust_pkg; 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; # delete associated export_cust_svc foreach my $export_cust_svc ( qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum }) ) { my $error = $export_cust_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } foreach my $part_svc_link ( $self->part_svc_link( link_type => 'cust_svc_unprovision_cascade', ) ) { foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => $part_svc_link->dst_svcpart, }) ) { my $error = $cust_svc->svc_x->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; if ( $ticket_system eq 'RT_Internal' ) { unless ( $rt_session ) { FS::TicketSystem->init; $rt_session = FS::TicketSystem->session; } my $links = RT::Links->new($rt_session->{CurrentUser}); my $svcnum = $self->svcnum; $links->Limit(FIELD => 'Target', VALUE => 'freeside://freeside/cust_svc/'.$svcnum); while ( my $l = $links->Next ) { my ($val, $msg); if ( $custnum ) { # re-link to point to the customer instead ($val, $msg) = $l->SetTarget('freeside://freeside/cust_main/'.$custnum); } else { # unlinked service ($val, $msg) = $l->Delete; } # can't do anything useful on error warn "error unlinking ticket $svcnum: $msg\n" if !$val; } } ''; } =item suspend Suspends 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). If there is an error, returns the error, otherwise returns false. =cut sub suspend { my( $self, %opt ) = @_; $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb'; my $svcdb = $1; require "FS/$svcdb.pm"; my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ) or return ''; my $error = $svc->suspend; return $error if $error; if ( $opt{labels_arryref} ) { my( $label, $value ) = $self->label; push @{ $opt{labels_arrayref} }, "$label: $value"; } ''; } =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,%opt) = @_; 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) { if ( %opt && $opt{'date'} ) { my $error = $svc->expire($opt{'date'}); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "Error expiring service: $error"; } } else { 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"; } } } elsif ( !%opt ) { #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; # } # } #trigger a pkg_change export on pkgnum changes if ( $new->pkgnum != $old->pkgnum ) { my $error = $new->svc_x->export('pkg_change', $new->cust_pkg, $old->cust_pkg, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; } } # if pkgnum is changing #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); #trigger a relocate export on location changes if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) { my $svc_x = $new->svc_x; if ( $svc_x->locationnum ) { if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) { # in this case, set the service location to be the same as the new # package location $svc_x->set('locationnum', $new->cust_pkg->locationnum); # and replace it, which triggers a relocate export so we don't # need to $error ||= $svc_x->replace; } else { # the service already has a different location from its package # so don't change it } } else { # the service doesn't have a locationnum (either isn't of a type # that has the locationnum field, or the locationnum is null and # defaults to cust_pkg->locationnum) # so just trigger the export here $error ||= $new->svc_x->export('relocate', $new->cust_pkg->cust_location, $old->cust_pkg->cust_location, ); } # if ($svc_x->locationnum) } # if this is a location change #check if this releases a hold (see FS::pkg_svc provision_hold) $error ||= $new->_check_provision_hold; 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('agent_svcid') || $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 && ! $ignore_quantity ) { #slightly inefficient since ->pkg_svc will also look it up, but fixing # a much larger perf problem and have bigger fish to fry my $cust_pkg = $self->cust_pkg; my $pkg_svc = $self->pkg_svc || new FS::pkg_svc { 'svcpart' => $self->svcpart, 'pkgpart' => $cust_pkg->pkgpart, 'quantity' => 0, }; #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) { my $addon_pkg_svc = qsearchs('pkg_svc', { pkgpart => $part_pkg_link->dst_pkgpart, svcpart => $self->svcpart, }); $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity ) if $addon_pkg_svc; } #better error message? UI shouldn't get here return "No svcpart ". $self->svcpart. " services in pkgpart ". $cust_pkg->pkgpart unless $pkg_svc->quantity > 0; my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart ); #false laziness w/cust_pkg->part_svc my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity - $num_cust_svc ); #better error message? again, UI shouldn't get here return "Already $num_cust_svc ". $pkg_svc->part_svc->svc. " services for pkgnum ". $self->pkgnum if $num_avail <= 0; #part_svc_link rules (only make sense in pkgpart context, and # skipping this when ignore_quantity is set DTRT when we're "forcing" # an implicit change here (location change triggered pkgpart change, # ->overlimit, bulk customer service changes) foreach my $part_svc_link ( $self->part_svc_link( link_type => 'cust_svc_provision_restrict', ) ) { return $part_svc_link->dst_svc. ' must be provisioned before '. $part_svc_link->src_svc unless qsearchs({ 'table' => 'cust_svc', 'hashref' => { 'pkgnum' => $self->pkgnum, 'svcpart' => $part_svc_link->dst_svcpart, }, 'order_by' => 'LIMIT 1', }); } } $self->SUPER::check; } =item check_part_svc_link_unprovision Checks service dependency unprovision rules for this service. If there is an error, returns the error, otherwise returns false. =cut sub check_part_svc_link_unprovision { my $self = shift; foreach my $part_svc_link ( $self->part_svc_link( link_type => 'cust_svc_unprovision_restrict', ) ) { return $part_svc_link->dst_svc. ' must be unprovisioned before '. $part_svc_link->src_svc if qsearchs({ 'table' => 'cust_svc', 'hashref' => { 'pkgnum' => $self->pkgnum, 'svcpart' => $part_svc_link->dst_svcpart, }, 'order_by' => 'LIMIT 1', }); } ''; } =item part_svc_link Returns the service dependencies (see L) for the given search options, taking into account this service definition as source and this customer's agent. Available options are any field in part_svc_link. Typically used options are link_type. =cut sub part_svc_link { my $self = shift; my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : ''; FS::part_svc_link->by_agentnum($agentnum, src_svcpart=>$self->svcpart, disabled => '', @_ ); } =item display_svcnum Returns the displayed service number for this service: agent_svcid if it has a value, svcnum otherwise =cut sub display_svcnum { my $self = shift; $self->agent_svcid || $self->svcnum; } =item part_svc Returns the definition for this service, as a FS::part_svc object (see L). =cut sub part_svc { my $self = shift; return $self->{_svcpart} if $self->{_svcpart}; cluck 'cust_svc->part_svc called' if $DEBUG; qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); } =item cust_pkg Returns the package this service belongs to, as a FS::cust_pkg object (see L). =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 pkg_cancel_date Returns the date this service's package was canceled. This normally only exists for a service that's been preserved through cancellation with the part_pkg.preserve flag. =cut sub pkg_cancel_date { my $self = shift; my $cust_pkg = $self->cust_pkg or return; return $cust_pkg->getfield('cancel') || ''; } =item label [ LOCALE ] Returns a list consisting of: - The name of this service (from part_svc), optionally localized - 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 [ LOCALE ] Like the B