X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_svc.pm;h=a7607618559e8dfac1524c900f0b3cf053464adb;hb=7422aa77086326ba1e6032150ce5704d1003ea6f;hp=5117eff45d9d6a34d983b27a9ba29ab4043fb97b;hpb=c89aa83639038cc1946fec07a2dda252f64e5144;p=freeside.git diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 5117eff45..a76076185 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,8 +1,9 @@ package FS::cust_svc; use strict; -use vars qw( @ISA ); -use Carp qw( cluck ); +use vars qw( @ISA $DEBUG $me $ignore_quantity ); +use Carp qw( carp cluck ); +use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; use FS::part_pkg; @@ -11,11 +12,20 @@ use FS::pkg_svc; use FS::svc_acct; use FS::svc_domain; use FS::svc_forward; +use FS::svc_broadband; +use FS::svc_phone; +use FS::svc_external; use FS::domain_record; use FS::part_export; +use FS::cdr; @ISA = qw( FS::Record ); +$DEBUG = 0; +$me = '[cust_svc]'; + +$ignore_quantity = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -168,15 +178,10 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - if ( $new->svcpart != $old->svcpart ) { my $svc_x = $new->svc_x; - my $new_svc_x = ref($svc_x)->new({$svc_x->hash}); + 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; @@ -184,6 +189,12 @@ sub replace { } } + 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 @@ -192,7 +203,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 @@ -228,10 +239,10 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $quantity; + if scalar(@cust_svc) >= $quantity && !$ignore_quantity; } - ''; #no error + $self->SUPER::check; } =item part_svc @@ -250,8 +261,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 @@ -266,38 +277,67 @@ 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; + or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum; + $self->_svc_label($svc_x); +} + +sub _svc_label { + my( $self, $svc_x ) = ( shift, shift ); + my $svcdb = $self->part_svc->svcdb; + my $tag; if ( $svcdb eq 'svc_acct' ) { - $tag = $svc_x->email; + $tag = $svc_x->email(@_); } elsif ( $svcdb eq 'svc_forward' ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } ); - $tag = $svc_acct->email. '->'; + 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 ) { - $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } ); - $tag .= $svc_acct->email; + 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->reczone; + my $domain_record = $svc_x->domain_record(@_); + $tag = $domain_record->zone; } elsif ( $svcdb eq 'svc_broadband' ) { $tag = $svc_x->ip_addr; + } elsif ( $svcdb eq 'svc_phone' ) { + $tag = $svc_x->phonenum; #XXX format it better + } 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). '-'. + substr('0000000000'.uc($svc_x->title), -10); + } 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; + + $self->part_svc->svc, $tag, $svcdb, $self->svcnum; + } =item svc_x @@ -313,6 +353,10 @@ sub svc_x { if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) { $self->{'_svc_acct'}; } else { + #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 } ); } } @@ -350,22 +394,26 @@ for records where B is not "svc_acct". sub seconds_since_sqlradacct { my($self, $start, $end) = @_; - my $username = $self->svc_x->username; + my $svc_x = $self->svc_x; - my @part_export = $self->part_svc->part_export('sqlradius') - or die "no sqlradius 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 $seconds = 0; foreach my $part_export ( @part_export ) { + next if $part_export->option('ignore_accounting'); + 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} eq 'mysql' ) { + if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { $str2time = 'UNIX_TIMESTAMP('; } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { $str2time = 'EXTRACT( EPOCH FROM '; @@ -375,6 +423,8 @@ sub seconds_since_sqlradacct { $str2time = 'extract(epoch from '; } + my $username = $part_export->export_username($svc_x); + my $query; #find closed sessions completely within the given range @@ -453,23 +503,27 @@ for records where B is not "svc_acct". sub attribute_since_sqlradacct { my($self, $start, $end, $attrib) = @_; - my $username = $self->svc_x->username; + my $svc_x = $self->svc_x; - my @part_export = $self->part_svc->part_export('sqlradius') - or die "no sqlradius 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 $sum = 0; foreach my $part_export ( @part_export ) { + next if $part_export->option('ignore_accounting'); + 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} eq 'mysql' ) { + if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { $str2time = 'UNIX_TIMESTAMP('; } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { $str2time = 'EXTRACT( EPOCH FROM '; @@ -479,6 +533,8 @@ sub attribute_since_sqlradacct { $str2time = 'extract(epoch from '; } + my $username = $part_export->export_username($svc_x); + my $sth = $dbh->prepare("SELECT SUM($attrib) FROM radacct WHERE UserName = ? @@ -496,6 +552,96 @@ sub attribute_since_sqlradacct { } +=item get_session_history TIMESTAMP_START TIMESTAMP_END + +See L. Equivalent to +$cust_svc->svc_x->get_session_history, but more efficient. Meaningless for +records where B is not "svc_acct". + +=cut + +sub get_session_history { + my($self, $start, $end, $attrib) = @_; + + #$attrib ??? + + 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( $start, $end, $self->svc_x ) }; + } + + @sessions; + +} + +=item get_cdrs_for_update + +Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR +objects (see L) associated with this service. + +Currently CDRs are associated with svc_acct services via a DID in the +username. This part is rather tenative and still subject to change... + +=cut + +sub get_cdrs_for_update { + my($self, %options) = @_; + + my $default_prefix = $options{'default_prefix'}; + + #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 @cdrs = + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => $number + }, + 'extra_sql' => 'FOR UPDATE', + } ); + + if ( length($default_prefix) ) { + push @cdrs, + qsearch( { + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => "$default_prefix$number", + }, + 'extra_sql' => 'FOR UPDATE', + } ); + } + + @cdrs; +} + +=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, + } + ); +} + =back =head1 BUGS