X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_svc.pm;h=65f8d58b61fa116b00da563785e5a73c60c842a6;hb=a8e98b0506e1fb15bc2ca721f6c3c6a8e431bd24;hp=c398e5ecd36da9e1c3cdb6e8f688aafc86b7ccf1;hpb=fd72d2af8120195f96826eb044e217dbfcaee1c7;p=freeside.git diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index c398e5ecd..b01ed8459 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,18 +1,35 @@ package FS::cust_svc; +use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); use strict; -use vars qw( @ISA ); -use Carp qw( cluck ); -use FS::Record qw( qsearchs ); -use FS::cust_pkg; +use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system ); +use Carp; +#use Scalar::Util qw( blessed ); +use List::Util qw( max ); +use FS::Conf; +use FS::Record qw( qsearch qsearchs dbh str2time_sql ); use FS::part_pkg; use FS::part_svc; -use FS::svc_acct; -use FS::svc_acct_sm; -use FS::svc_domain; -use FS::svc_forward; +use FS::pkg_svc; +use FS::domain_record; +use FS::part_export; +use FS::cdr; +use FS::UI::Web; -@ISA = qw( FS::Record ); +#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') +}); sub _cache { my $self = shift; @@ -59,6 +76,10 @@ The following fields are currently supported: =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 @@ -83,19 +104,246 @@ otherwise returns false. =item delete Deletes this service from the database. If there is an error, returns the -error, otherwise returns false. +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; + + my $error = $self->SUPER::delete; + return $error if $error; + + 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 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"; -Called by the cancel method of the package (see L). + 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; + } + } + + #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, otehrwise returns false. Called by the insert and +returns the error, otherwise returns false. Called by the insert and replace methods. =cut @@ -107,17 +355,68 @@ sub check { $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; - return "Unknown pkgnum" - unless ! $self->pkgnum - || qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + return "Unknown svcpart" unless $part_svc; - return "Unknown svcpart" unless - qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); + if ( $self->pkgnum && ! $ignore_quantity ) { - ''; #no error + #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; + + } + + $self->SUPER::check; +} + +=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 @@ -134,56 +433,578 @@ sub part_svc { : 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 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