diff options
Diffstat (limited to 'FS/FS/cust_svc.pm')
| -rw-r--r-- | FS/FS/cust_svc.pm | 281 |
1 files changed, 265 insertions, 16 deletions
diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index c7cc4b3..0d8a121 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -1,7 +1,7 @@ package FS::cust_svc; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $ignore_quantity ); use Carp qw( cluck ); use FS::Record qw( qsearch qsearchs dbh ); use FS::cust_pkg; @@ -9,13 +9,16 @@ use FS::part_pkg; use FS::part_svc; use FS::pkg_svc; use FS::svc_acct; -use FS::svc_acct_sm; use FS::svc_domain; use FS::svc_forward; +use FS::svc_broadband; use FS::domain_record; +use FS::part_export; @ISA = qw( FS::Record ); +$ignore_quantity = 0; + sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -220,6 +223,7 @@ sub check { # 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, @@ -227,10 +231,10 @@ sub check { }); return "Already ". scalar(@cust_svc). " ". $part_svc->svc. " services for pkgnum ". $self->pkgnum - if scalar(@cust_svc) >= $pkg_svc->quantity; + if scalar(@cust_svc) >= $quantity && !$ignore_quantity; } - ''; #no error + $self->SUPER::check; } =item part_svc @@ -276,16 +280,16 @@ sub label { my $tag; if ( $svcdb eq 'svc_acct' ) { $tag = $svc_x->email; - } elsif ( $svcdb eq 'svc_acct_sm' ) { - my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser; - my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } ); - my $domain = $svc_domain->domain; - $tag = "$domuser\@$domain"; } 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 } ); + my $svc_acct = $svc_x->dstsvc_acct; $tag .= $svc_acct->email; } else { $tag .= $svc_x->dst; @@ -294,7 +298,11 @@ sub label { $tag = $svc_x->getfield('domain'); } elsif ( $svcdb eq 'svc_www' ) { my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } ); - $tag = $domain->reczone; + $tag = $domain->zone; + } elsif ( $svcdb eq 'svc_broadband' ) { + $tag = $svc_x->ip_addr; + } elsif ( $svcdb eq 'svc_external' ) { + $tag = $svc_x->id. ': '. $svc_x->title; } else { cluck "warning: asked for label of unsupported svcdb; using svcnum"; $tag = $svc_x->getfield('svcnum'); @@ -340,11 +348,249 @@ sub seconds_since { $sth->fetchrow_arrayref->[0]; } -=back +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END + +See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to +$cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless +for records where B<svcdb> is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +sub seconds_since_sqlradacct { + my($self, $start, $end) = @_; + + 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" + 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' ) { + $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 $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 $query; + + #find closed sessions completely within the given range + my $sth = $dbh->prepare("SELECT SUM(acctsessiontime) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime) >= ? + AND $str2time AcctStopTime ) < ? + AND $str2time AcctStopTime ) > 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $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 + $query = "SELECT SUM( ? - $str2time AcctStartTime ) ) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) >= ? + AND $str2time AcctStartTime ) < ? + AND ( ? - $str2time AcctStartTime ) ) < 86400 + AND ( $str2time AcctStopTime ) = 0 + OR AcctStopTime IS NULL )"; + $sth = $dbh->prepare($query) or die $dbh->errstr; + $sth->execute($end, $username, $start, $end, $end) + 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, + #count range start->session end + $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? ) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) < ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) < ? + AND $str2time AcctStopTime ) > 0 + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $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) + $sth = $dbh->prepare("SELECT COUNT(*) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStartTime ) < ? + AND ( $str2time AcctStopTime ) >= ? + )" + # OR AcctStopTime = 0 + # OR AcctStopTime IS NULL )" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end ) or die $sth->errstr; + my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0]; + + $seconds += $regular + $end_during + $start_during + $entire_range; + + } + + $seconds; + +} + +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to +$cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless +for records where B<svcdb> is not "svc_acct". + +=cut + +#note: implementation here, POD in FS::svc_acct +#(false laziness w/seconds_since_sqlradacct above) +sub attribute_since_sqlradacct { + my($self, $start, $end, $attrib) = @_; -=head1 VERSION + my $svc_x = $self->svc_x; -$Id: cust_svc.pm,v 1.15 2002-05-22 12:17:06 ivan Exp $ + 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" + 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' ) { + $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 $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 $sth = $dbh->prepare("SELECT SUM($attrib) + FROM radacct + WHERE UserName = ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) < ? + AND AcctStopTime IS NOT NULL" + ) or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + + $sum += $sth->fetchrow_arrayref->[0]; + + } + + $sum; + +} + +=item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END + +See L<FS::svc_acct/get_session_history_sqlradacct>. Equivalent to +$cust_svc->svc_x->get_session_history_sqlradacct, but more efficient. +Meaningless for records where B<svcdb> is not "svc_acct". + +=cut + +sub get_session_history { + my($self, $start, $end, $attrib) = @_; + + my $username = $self->svc_x->username; + + my @part_export = $self->part_svc->part_export('sqlradius') + or die "no sqlradius export configured for this service type"; + #or return undef; + + my @sessions = (); + + foreach my $part_export ( @part_export ) { + + 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' ) { + $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 @fields = qw( acctstarttime acctstoptime acctsessiontime + acctinputoctets acctoutputoctets framedipaddress ); + + my $sth = $dbh->prepare('SELECT '. join(', ', @fields). + " FROM radacct + WHERE UserName = ? + AND $str2time AcctStopTime ) >= ? + AND $str2time AcctStopTime ) <= ? + ORDER BY AcctStartTime DESC + ") or die $dbh->errstr; + $sth->execute($username, $start, $end) or die $sth->errstr; + + push @sessions, map { { %$_ } } @{ $sth->fetchall_arrayref({}) }; + + } + \@sessions + +} + +=back =head1 BUGS @@ -356,6 +602,9 @@ pkg_svc records are not checked in general (here). Deleting this record doesn't check or delete the svc_* record associated with this record. +In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of +a DBI database handle is not yet implemented. + =head1 SEE ALSO L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>, |