X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_svc.pm;h=30b23908c942024f688a29ce22804c0fe9a9d88f;hb=7d154154ef1f5f2225ebf7802974f6d0bdcddc06;hp=65f8d58b61fa116b00da563785e5a73c60c842a6;hpb=2041a9143fac20b79ead4a1ae01224dedf5b27c2;p=freeside.git diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 65f8d58b6..30b23908c 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,23 +1,26 @@ package FS::cust_svc; use strict; -use vars qw( @ISA $ignore_quantity ); -use Carp qw( cluck ); +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 ); +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::svc_acct; -use FS::svc_domain; -use FS::svc_forward; -use FS::svc_broadband; -use FS::svc_external; use FS::domain_record; use FS::part_export; +use FS::cdr; -@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 + +@ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record ); + +$DEBUG = 0; +$me = '[cust_svc]'; $ignore_quantity = 0; @@ -66,6 +69,8 @@ The following fields are currently supported: =item svcpart - Service definition (see L) +=item overlimit - date the service exceeded its usage limit + =back =head1 METHODS @@ -128,22 +133,78 @@ sub cancel { 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; + $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"; + } + } - my $error = $self->delete; + $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 deleting cust_svc: $error"; + return "Error setting overlimit: $error"; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -160,7 +221,13 @@ 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'; @@ -176,6 +243,7 @@ sub replace { 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; @@ -183,6 +251,7 @@ sub replace { } } + #my $error = $new->SUPER::replace($old, @_); my $error = $new->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -197,7 +266,7 @@ sub replace { =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 @@ -209,6 +278,7 @@ sub check { $self->ut_numbern('svcnum') || $self->ut_numbern('pkgnum') || $self->ut_number('svcpart') + || $self->ut_numbern('overlimit') ; return $error if $error; @@ -255,8 +325,8 @@ sub part_svc { =item cust_pkg -Returns the definition for this service, as a FS::part_svc object (see -L). +Returns the package this service belongs to, as a FS::cust_pkg object (see +L). =cut @@ -265,56 +335,81 @@ sub cust_pkg { 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; =cut sub label { my $self = shift; - my $svcdb = $self->part_svc->svcdb; + carp "FS::cust_svc::label called on $self" if $DEBUG; my $svc_x = $self->svc_x - or die "can't find $svcdb.svcnum ". $self->svcnum; - my $tag; - if ( $svcdb eq 'svc_acct' ) { - $tag = $svc_x->email; - } elsif ( $svcdb eq 'svc_forward' ) { - if ( $svc_x->srcsvc ) { - my $svc_acct = $svc_x->srcsvc_acct; - $tag = $svc_acct->email; - } else { - $tag = $svc_x->src; - } - $tag .= '->'; - if ( $svc_x->dstsvc ) { - my $svc_acct = $svc_x->dstsvc_acct; - $tag .= $svc_acct->email; - } else { - $tag .= $svc_x->dst; - } - } elsif ( $svcdb eq 'svc_domain' ) { - $tag = $svc_x->getfield('domain'); - } elsif ( $svcdb eq 'svc_www' ) { - my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); - $tag = $domain->zone; - } elsif ( $svcdb eq 'svc_broadband' ) { - $tag = $svc_x->ip_addr; - } elsif ( $svcdb eq 'svc_external' ) { - my $conf = new FS::Conf; - if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) { - $tag = sprintf('%010d', $svc_x->id). '-'. $svc_x->title; - } else { - $tag = $svc_x->id. ': '. $svc_x->title; - } - } else { - cluck "warning: asked for label of unsupported svcdb; using svcnum"; - $tag = $svc_x->getfield('svcnum'); - } - $self->part_svc->svc, $tag, $svcdb; + or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + + $self->_svc_label($svc_x); +} + +sub _svc_label { + my( $self, $svc_x ) = ( shift, shift ); + + ( + $self->part_svc->svc, + $svc_x->label(@_), + $self->part_svc->svcdb, + $self->svcnum + ); + +} + +=item export_links + +Returns a list of html elements associated with this services exports. + +=cut + +sub export_links { + my $self = shift; + my $svc_x = $self->svc_x + or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + + $svc_x->export_links; } =item svc_x @@ -330,7 +425,10 @@ sub svc_x { if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { $self->{'_svc_acct'}; } else { - #require "FS/$svcdb.pm"; + require "FS/$svcdb.pm"; + warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart. + ", so searching for $svcdb.svcnum ". $self->svcnum. "\n" + if $DEBUG; qsearchs( $svcdb, { 'svcnum' => $self->svcnum } ); } } @@ -368,12 +466,13 @@ for records where B is not "svc_acct". sub seconds_since_sqlradacct { my($self, $start, $end) = @_; + my $mes = "$me seconds_since_sqlradacct:"; + my $svc_x = $self->svc_x; - my @part_export = $self->part_svc->part_export('sqlradius'); - push @part_export, $self->part_svc->part_export('sqlradius_withdomain'); - die "no sqlradius or sqlradius_withdomain export configured for this". - "service type" + my @part_export = $self->part_svc->part_export_usage; + die "no accounting-capable exports are enabled for ". $self->part_svc->svc. + " service definition" unless @part_export; #or return undef; @@ -382,34 +481,26 @@ sub seconds_since_sqlradacct { next if $part_export->option('ignore_accounting'); + warn "$mes connecting to sqlradius database\n" + if $DEBUG; + my $dbh = DBI->connect( map { $part_export->option($_) } qw(datasrc username password) ) or die "can't connect to sqlradius database: ". $DBI::errstr; - #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } + warn "$mes connected to sqlradius database\n" + if $DEBUG; - my $username; - if ( $part_export->exporttype eq 'sqlradius' ) { - $username = $svc_x->username; - } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) { - $username = $svc_x->email; - } else { - die 'unknown exporttype '. $part_export->exporttype; - } + #select a unix time conversion function based on database type + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + + my $username = $part_export->export_username($svc_x); my $query; + + warn "$mes finding closed sessions completely within the given range\n" + if $DEBUG; - #find closed sessions completely within the given range my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) FROM radacct WHERE UserName = ? @@ -421,7 +512,10 @@ sub seconds_since_sqlradacct { $sth->execute($username, $start, $end) or die $sth->errstr; my $regular = $sth->fetchrow_arrayref->[0]; - #find open sessions which start in the range, count session start->range end + warn "$mes finding open sessions which start in the range\n" + if $DEBUG; + + # count session start->range end $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) FROM radacct WHERE UserName = ? @@ -435,7 +529,9 @@ sub seconds_since_sqlradacct { or die $sth->errstr. " executing query $query"; my $start_during = $sth->fetchrow_arrayref->[0]; - #find closed sessions which start before the range but stop during, + warn "$mes finding closed sessions which start before the range but stop during\n" + if $DEBUG; + #count range start->session end $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) FROM radacct @@ -449,9 +545,11 @@ sub seconds_since_sqlradacct { $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr; my $end_during = $sth->fetchrow_arrayref->[0]; - #find closed (not anymore - or open) sessions which start before the range - # but stop after, or are still open, count range start->range end - # don't count open sessions (probably missing stop record) + warn "$mes finding closed sessions which start before the range but stop after\n" + if $DEBUG; + + # count range start->range end + # don't count open sessions anymore (probably missing stop record) $sth = $dbh->prepare("SELECT COUNT(*) FROM radacct WHERE UserName = ? @@ -466,6 +564,9 @@ sub seconds_since_sqlradacct { $seconds += $regular + $end_during + $start_during + $entire_range; + warn "$mes done finding sessions\n" + if $DEBUG; + } $seconds; @@ -485,12 +586,13 @@ for records where B is not "svc_acct". sub attribute_since_sqlradacct { my($self, $start, $end, $attrib) = @_; + my $mes = "$me attribute_since_sqlradacct:"; + my $svc_x = $self->svc_x; - my @part_export = $self->part_svc->part_export('sqlradius'); - push @part_export, $self->part_svc->part_export('sqlradius_withdomain'); - die "no sqlradius or sqlradius_withdomain export configured for this". - "service type" + my @part_export = $self->part_svc->part_export_usage; + die "no accounting-capable exports are enabled for ". $self->part_svc->svc. + " service definition" unless @part_export; #or return undef; @@ -500,30 +602,23 @@ sub attribute_since_sqlradacct { next if $part_export->option('ignore_accounting'); + warn "$mes connecting to sqlradius database\n" + if $DEBUG; + my $dbh = DBI->connect( map { $part_export->option($_) } qw(datasrc username password) ) or die "can't connect to sqlradius database: ". $DBI::errstr; + warn "$mes connected to sqlradius database\n" + if $DEBUG; + #select a unix time conversion function based on database type - my $str2time; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); - my $username; - if ( $part_export->exporttype eq 'sqlradius' ) { - $username = $svc_x->username; - } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) { - $username = $svc_x->email; - } else { - die 'unknown exporttype '. $part_export->exporttype; - } + my $username = $part_export->export_username($svc_x); + + warn "$mes SUMing $attrib sessions\n" + if $DEBUG; my $sth = $dbh->prepare("SELECT SUM($attrib) FROM radacct @@ -536,17 +631,20 @@ sub attribute_since_sqlradacct { $sum += $sth->fetchrow_arrayref->[0]; + warn "$mes done SUMing sessions\n" + if $DEBUG; + } $sum; } -=item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END +=item get_session_history TIMESTAMP_START TIMESTAMP_END -See L. Equivalent to -$cust_svc->svc_x->get_session_history_sqlradacct, but more efficient. -Meaningless for records where B is not "svc_acct". +See L. Equivalent to +$cust_svc->svc_x->get_session_history, but more efficient. Meaningless for +records where B is not "svc_acct". =cut @@ -555,38 +653,62 @@ sub get_session_history { #$attrib ??? - my @part_export = $self->part_svc->part_export('sqlradius'); - push @part_export, $self->part_svc->part_export('sqlradius_withdomain'); - die "no sqlradius or sqlradius_withdomain export configured for this". - "service type" + my @part_export = $self->part_svc->part_export_usage; + die "no accounting-capable exports are enabled for ". $self->part_svc->svc. + " service definition" unless @part_export; #or return undef; my @sessions = (); foreach my $part_export ( @part_export ) { - push @sessions, $part_export->usage_sessions( $self->svc_x, $start, $end ); + push @sessions, + @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) }; } - \@sessions; + @sessions; } -=item pkg_svc +=item get_cdrs_for_update -Returns the pkg_svc record for for this service, if applicable. +Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR +objects (see L) associated with this service. + +CDRs are associated with svc_phone services via svc_phone.phonenum =cut -sub pkg_svc { - my $self = shift; - my $cust_pkg = $self->cust_pkg; - return undef unless $cust_pkg; +sub get_cdrs_for_update { + my($self, %options) = @_; - qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart, - 'pkgpart' => $cust_pkg->pkgpart, - } - ); + my @fields = ( 'charged_party' ); + push @fields, 'src' unless $options{'disable_src'}; + + #CDRs are now associated with svc_phone services via svc_phone.phonenum + #return () unless $self->svc_x->isa('FS::svc_phone'); + return () unless $self->part_svc->svcdb eq 'svc_phone'; + my $number = $self->svc_x->phonenum; + + my $prefix = $options{'default_prefix'}; + + my @where = map " $_ = '$number' ", @fields; + push @where, map " $_ = '$prefix$number' ", @fields + if length($prefix); + if ( $prefix =~ /^\+(\d+)$/ ) { + push @where, map " $_ = '$1$number' ", @fields + } + + my $extra_sql = ' AND ( '. join(' OR ', @where ). ' ) '; + + my @cdrs = + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', }, + 'extra_sql' => "$extra_sql FOR UPDATE", + } ); + + @cdrs; } =back