1 <% include( '/elements/header.html', 'RADIUS Sessions') %>
4 % # and finally, display the thing
7 % foreach my $part_export ( @part_export ) {
11 % my $efields = tie my %efields, 'Tie::IxHash', %fields;
12 % delete $efields{'framedipaddress'} if $part_export->option('hide_ip');
13 % if ( $part_export->option('hide_data') ) {
14 % delete $efields{$_} foreach qw(acctinputoctets acctoutputoctets);
16 % if ( $part_export->option('show_called_station') ) {
17 % $efields->Splice(1, 0,
18 % 'calledstationid' => {
19 % 'name' => 'Destination',
20 % 'attrib' => 'Called-Station-ID',
22 % sub { length($_[0]) ? shift : ' '; },
28 <FONT CLASS="fsinnerbox-title">
29 <% $part_export->exportname || $part_export->exporttype |h %>
30 <% $part_export->machine ? ' to '. $part_export->machine : '' |h %>
33 <% include( '/elements/table-grid.html' ) %>
34 % my $bgcolor1 = '#eeeeee';
35 % my $bgcolor2 = '#ffffff';
39 % foreach my $field ( keys %efields ) {
41 <TH CLASS="grid" BGCOLOR="#cccccc">
42 <% $efields{$field}->{name} %><BR>
43 <FONT SIZE=-2><% $efields{$field}->{attrib} %></FONT>
49 % foreach my $session (
50 % @{ $part_export->usage_sessions( {
51 % 'stoptime_start' => $beginning,
52 % 'stoptime_end' => $ending,
53 % 'session_status' => $status,
54 % 'starttime_start' => $starttime_beginning,
55 % 'starttime_end' => $starttime_ending,
58 % 'prefix' => $prefix,
59 % 'summarize' => $summarize,
63 % if ( $bgcolor eq $bgcolor1 ) {
64 % $bgcolor = $bgcolor2;
66 % $bgcolor = $bgcolor1;
70 % foreach my $field ( keys %efields ) {
71 % my $html = &{ $efields{$field}->{fmt} }( $session->{$field},
75 % my $class = ( $html =~ /<TABLE/ ? 'inv' : 'grid' );
77 <TD CLASS="<%$class%>" BGCOLOR="<% $bgcolor %>" ALIGN="<% $efields{$field}->{align} %>">
93 unless $FS::CurrentUser::CurrentUser->access_right('List rating data');
100 $summarize = 1 if $cgi->param('summarize') eq 'Y';
102 #sort of false laziness w/cust_pay.cgi
103 my( $beginning, $ending ) = ( '', '' );
104 if ( $cgi->param('stoptime_beginning')
105 && $cgi->param('stoptime_beginning') =~ /^([ 0-9\-\/\:\w]{0,54})$/ ) {
106 $beginning = parse_datetime($1);
108 if ( $cgi->param('stoptime_ending')
109 && $cgi->param('stoptime_ending') =~ /^([ 0-9\-\/\:\w]{0,54})$/ ) {
110 $ending = parse_datetime($1); # + 86399;
112 if ( $cgi->param('begin') && $cgi->param('begin') =~ /^(\d+)$/ ) {
115 if ( $cgi->param('end') && $cgi->param('end') =~ /^(\d+)$/ ) {
120 if ( $cgi->param('session_status') =~ /^(closed|open)$/ ) {
124 my( $starttime_beginning, $starttime_ending ) = ( '', '' );
125 if ( $cgi->param('starttime_beginning')
126 && $cgi->param('starttime_beginning') =~ /^([ 0-9\-\/\:\w]{0,54})$/ ) {
127 $starttime_beginning = parse_datetime($1);
129 if ( $cgi->param('starttime_ending')
130 && $cgi->param('starttime_ending') =~ /^([ 0-9\-\/\:\w]{0,54})$/ ) {
131 $starttime_ending = parse_datetime($1); # + 86399;
135 if ( $cgi->param('svcnum') =~ /^(\d+)$/ ) {
136 $cgi_svc = qsearchs( 'svc_acct', { 'svcnum' => $1 } )
137 || qsearchs( 'svc_broadband', { 'svcnum' => $1 } );
138 } elsif ( $cgi->param('username') =~ /^([^@]+)\@([^@]+)$/ ) {
139 my %search = { 'username' => $1 };
140 my $svc_domain = qsearchs('svc_domain', { 'domain' => $2 } );
142 $search{'domsvc'} = $svc_domain->svcnum;
144 delete $search{'username'};
146 $cgi_svc = qsearchs( 'svc_acct', \%search )
148 } elsif ( $cgi->param('username') =~ /^(.+)$/ ) {
149 $cgi_svc = qsearchs( 'svc_acct', { 'username' => $1 } );
152 my @part_export = ();
154 my $part_svc = $cgi_svc->cust_svc->part_svc;
156 $part_svc->part_export('sqlradius'),
157 $part_svc->part_export('sqlradius_withdomain'),
158 $part_svc->part_export('broadband_sqlradius'),
162 #grep $_->can('usage_sessions'), qsearch( 'part_export' )
163 qsearch( 'part_export', { 'exporttype' => 'sqlradius' } ),
164 qsearch( 'part_export', { 'exporttype' => 'sqlradius_withdomain' } ),
165 qsearch( 'part_export', { 'exporttype' => 'broadband_sqlradius' } ),
170 if ( $cgi->param('ip') =~ /^((\d+\.){3}\d+)$/ ) {
174 my $prefix = $cgi->param('prefix');
176 if ( $prefix =~ /^(\d+)$/ ) {
178 $prefix = "011$prefix" unless $prefix =~ /^1/;
184 # field formatting subroutines
188 my $user_format = sub {
189 my ( $user, $session, $part_export ) = @_;
192 if ( exists $user2svc{$user} ) {
193 $svc = $user2svc{$user};
196 if ( $part_export->exporttype eq 'broadband_sqlradius' ) {
198 ( my $mac = $user ) =~ s/[^0-9a-f]//ig;
201 grep { qsearchs( 'export_svc', {
202 'exportnum' => $part_export->exportnum,
203 'svcpart' => $_->cust_svc->svcpart,
205 } qsearch( 'svc_broadband', {
206 mac_addr => { op=>'ILIKE', value=>$mac }
209 if ( @svc_broadband ) {
210 warn 'multiple svc_broadband records for user $user found; '.
211 'using first arbitrarily'
212 if scalar(@svc_broadband) > 1;
213 $user2svc{$user} = $svc = shift @svc_broadband;
219 if ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
221 if ( $user =~ /^([^@]+)\@([^@]+)$/ ) {
222 $search{'username'} = $1;
225 $search{'username'} = $user;
226 $domain = $session->{'realm'};
228 my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
230 $search{'domsvc'} = $svc_domain->svcnum;
232 delete $search{'username'};
234 } elsif ( $part_export->exporttype eq 'sqlradius' ) {
235 $search{'username'} = $user;
237 die 'unknown export type '. $part_export->exporttype.
238 " for $part_export\n";
240 if ( keys %search ) {
242 grep { qsearchs( 'export_svc', {
243 'exportnum' => $part_export->exportnum,
244 'svcpart' => $_->cust_svc->svcpart,
246 } qsearch( 'svc_acct', \%search );
248 warn 'multiple svc_acct records for user $user found; '.
249 'using first arbitrarily'
250 if scalar(@svc_acct) > 1;
251 $user2svc{$user} = $svc = shift @svc_acct;
261 #i should use svc_link, but that's expensive per-user
262 my $svcnum = $svc->svcnum;
263 my $table = $svc->table;
264 qq(<A HREF="${p}view/$table.cgi?$svcnum"><B>$user</B></A>);
272 my $customer_format = sub {
273 my( $unused, $session ) = @_;
274 return ' ' unless exists $user2svc{$session->{'username'}};
275 my $svc = $user2svc{$session->{'username'}};
276 my $cust_pkg = $svc->cust_svc->cust_pkg;
277 return ' ' unless $cust_pkg;
278 my $cust_main = $cust_pkg->cust_main;
280 qq!<A HREF="${p}view/cust_main.cgi?!. $cust_main->custnum. '">'.
281 $cust_pkg->cust_main->name. '</A>';
284 my $time_format = sub {
286 return ' ' if $time == 0;
287 my $pretty = time2str('%T%P %a %b %o %Y', $time );
288 $pretty =~ s/ (\d)(st|dn|rd|th)/$1$2/;
292 my $time_format_or_open = sub {
294 return '<CENTER>OPEN</CENTER>' if $time == 0;
295 &{$time_format}($time);
298 my $duration_format = sub {
300 return '' if $seconds eq ''; # open session
301 my $hour = int($seconds/3600);
302 my $min = int( ($seconds%3600) / 60 );
303 my $sec = $seconds%60;
304 '<TABLE CLASS="inv" BORDER=0 CELLSPACING=0 CELLPADDING=0>'.
305 '<TR><TD CLASS="inv" ALIGN="right">'.
306 ( $hour ? "<B>$hour</B>h" : ' ' ).
307 '</TD><TD CLASS="inv" ALIGN="right">'.
308 ( ( $hour || $min ) ? "<B>$min</B>m" : ' ' ).
309 '</TD><TD CLASS="inv" ALIGN="right">'.
311 '</TD></TR></TABLE>';
314 my $octets_format = sub {
316 my $megs = $octets / 1048576;
317 sprintf('<B>%.3f</B> megs', $megs);
318 #my $gigs = $octets / 1073741824
319 #sprintf('<B>%.3f</B> gigabytes', $gigs);
328 tie %fields, 'Tie::IxHash',
331 attrib => 'UserName',
338 fmt => $customer_format,
341 'acctsessiontime' => {
343 attrib => 'Acct-Session-Time',
344 fmt => $duration_format,
347 'acctinputoctets' => {
348 name => 'Upload', # (from user)',
349 attrib => 'Acct-Input-Octets',
350 fmt => $octets_format,
353 'acctoutputoctets' => {
354 name => 'Download', # (to user)',
355 attrib => 'Acct-Output-Octets',
356 fmt => $octets_format,
361 tie %fields, 'Tie::IxHash',
364 attrib => 'UserName',
376 fmt => $customer_format,
379 'framedipaddress' => {
380 name => 'IP Address',
381 attrib => 'Framed-IP-Address',
382 fmt => sub { my $ip = shift;
383 length($ip) ? $ip : ' ';
388 name => 'Start time',
389 attrib => 'Acct-Start-Time',
394 name => 'End time',
395 attrib => 'Acct-Stop-Time',
396 fmt => $time_format_or_open,
399 'acctsessiontime' => {
401 attrib => 'Acct-Session-Time',
402 fmt => $duration_format,
405 'acctinputoctets' => {
406 name => 'Upload', # (from user)',
407 attrib => 'Acct-Input-Octets',
408 fmt => $octets_format,
411 'acctoutputoctets' => {
412 name => 'Download', # (to user)',
413 attrib => 'Acct-Output-Octets',
414 fmt => $octets_format,
419 $fields{$_}->{fmt} ||= sub { length($_[0]) ? shift : ' '; }
420 foreach keys %fields;