fix the gridding colors
[freeside.git] / httemplate / search / sqlradius.cgi
1 <% include( '/elements/header.html', 'RADIUS Sessions',
2              include('/elements/menubar.html',
3                        'Main menu' => $p, # popurl(2),
4                     ),
5
6     )
7 %>
8
9 % ###
10 % # and finally, display the thing
11 % ### 
12 %
13 % foreach my $part_export (
14 %   #grep $_->can('usage_sessions'), qsearch( 'part_export' )
15 %   qsearch( 'part_export', { 'exporttype' => 'sqlradius' } ),
16 %   qsearch( 'part_export', { 'exporttype' => 'sqlradius_withdomain' } )
17 % ) {
18 %   %user2svc_acct = ();
19 %
20 %   my $efields = tie my %efields, 'Tie::IxHash', %fields;
21 %   delete $efields{'framedipaddress'} if $part_export->option('hide_ip');
22 %   if ( $part_export->option('hide_data') ) {
23 %     delete $efields{$_} foreach qw(acctinputoctets acctoutputoctets);
24 %   }
25 %   if ( $part_export->option('show_called_station') ) {
26 %     $efields->Splice(1, 0,
27 %       'calledstationid' => {
28 %                              'name'   => 'Destination',
29 %                              'attrib' => 'Called-Station-ID',
30 %                              'fmt'    =>
31 %                                sub { length($_[0]) ? shift : '&nbsp'; },
32 %                              'align'  => 'left',
33 %                            },
34 %     );
35 %   }
36 %
37 %
38
39     <% $part_export->exporttype %> to <% $part_export->machine %><BR>
40     <% include( '/elements/table-grid.html' ) %>
41 %   my $bgcolor1 = '#eeeeee';
42 %   my $bgcolor2 = '#ffffff';
43 %   my $bgcolor;
44
45     <TR>
46 %   foreach my $field ( keys %efields ) { 
47
48       <TH CLASS="grid" BGCOLOR="#cccccc">
49         <% $efields{$field}->{name} %><BR>
50         <FONT SIZE=-2><% $efields{$field}->{attrib} %></FONT>
51       </TH>
52
53 %   } 
54   </TR>
55
56 %   foreach my $session (
57 %       @{ $part_export->usage_sessions(
58 %            $beginning, $ending, $cgi_svc_acct, $ip, $prefix, ) }
59 %   ) {
60 %     if ( $bgcolor eq $bgcolor1 ) {
61 %       $bgcolor = $bgcolor2;
62 %     } else {
63 %       $bgcolor = $bgcolor1;
64 %     }
65
66       <TR>
67 %     foreach my $field ( keys %efields ) { 
68
69         <TD CLASS="grid" BGCOLOR="<% $bgcolor %>" ALIGN="<% $efields{$field}->{align} %>">
70           <% &{ $efields{$field}->{fmt} }( $session->{$field},
71                                            $session,
72                                            $part_export,
73                                          )
74           %>
75         </TD>
76 %     } 
77   </TR>
78
79 %   } 
80
81 </TABLE>
82 <BR><BR>
83
84 % } 
85
86
87 <%init>
88 ###
89 # parse cgi params
90 ###
91
92 #sort of false laziness w/cust_pay.cgi
93 my $beginning = '';
94 my $ending = '';
95 if ( $cgi->param('beginning')
96      && $cgi->param('beginning') =~ /^([ 0-9\-\/]{0,10})$/ ) {
97   $beginning = str2time($1);
98 }
99 if ( $cgi->param('ending')
100      && $cgi->param('ending') =~ /^([ 0-9\-\/]{0,10})$/ ) {
101   $ending = str2time($1) + 86399;
102 }
103 if ( $cgi->param('begin') && $cgi->param('begin') =~ /^(\d+)$/ ) {
104   $beginning = $1;
105 }
106 if ( $cgi->param('end') && $cgi->param('end') =~ /^(\d+)$/ ) {
107   $ending = $1;
108 }
109
110 my $cgi_svc_acct = '';
111 if ( $cgi->param('svcnum') =~ /^(\d+)$/ ) {
112   $cgi_svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $1 } );
113 } elsif ( $cgi->param('username') =~ /^([^@]+)\@([^@]+)$/ ) {
114   my %search = { 'username' => $1 };
115   my $svc_domain = qsearchs('svc_domain', { 'domain' => $2 } );
116   if ( $svc_domain ) {
117     $search{'domsvc'} = $svc_domain->svcnum;
118   } else {
119     delete $search{'username'};
120   }
121   $cgi_svc_acct = qsearchs( 'svc_acct', \%search )
122     if keys %search;
123 } elsif ( $cgi->param('username') =~ /^(.+)$/ ) {
124   $cgi_svc_acct = qsearchs( 'svc_acct', { 'username' => $1 } );
125 }
126
127 my $ip = '';
128 if ( $cgi->param('ip') =~ /^((\d+\.){3}\d+)$/ ) {
129   $ip = $1;
130 }
131
132 my $prefix = $cgi->param('prefix');
133 $prefix =~ s/\D//g;
134 if ( $prefix =~ /^(\d+)$/ ) {
135   $prefix = $1;
136   $prefix = "011$prefix" unless $prefix =~ /^1/;
137 } else {
138   $prefix = '';
139 }
140
141 ###
142 # field formatting subroutines
143 ###
144
145 my %user2svc_acct = ();
146 my $user_format = sub {
147   my ( $user, $session, $part_export ) = @_;
148
149   my $svc_acct = '';
150   if ( exists $user2svc_acct{$user} ) {
151     $svc_acct = $user2svc_acct{$user};
152   } else {
153     my %search = ();
154     if ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
155       my $domain;
156       if ( $user =~ /^([^@]+)\@([^@]+)$/ ) {
157        $search{'username'} = $1;
158        $domain = $2;
159      } else {
160        $search{'username'} = $user;
161        $domain = $session->{'realm'};
162      }
163      my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } );
164      if ( $svc_domain ) {
165        $search{'domsvc'} = $svc_domain->svcnum;
166      } else {
167        delete $search{'username'};
168      }
169     } elsif ( $part_export->exporttype eq 'sqlradius' ) {
170       $search{'username'} = $user;
171     } else {
172       die 'unknown export type '. $part_export->exporttype.
173           " for $part_export\n";
174     }
175     if ( keys %search ) {
176       my @svc_acct =
177         grep { qsearchs( 'export_svc', {
178                  'exportnum' => $part_export->exportnum,
179                  'svcpart'   => $_->cust_svc->svcpart,
180                } )
181              } qsearch( 'svc_acct', \%search );
182       if ( @svc_acct ) {
183         warn 'multiple svc_acct records for user $user found; '.
184              'using first arbitrarily'
185           if scalar(@svc_acct) > 1;
186         $user2svc_acct{$user} = $svc_acct = shift @svc_acct;
187       }
188     } 
189   }
190
191   if ( $svc_acct ) { 
192     my $svcnum = $svc_acct->svcnum;
193     qq(<A HREF="${p}view/svc_acct.cgi?$svcnum"><B>$user</B></A>);
194   } else {
195     "<B>$user</B>";
196   }
197
198 };
199
200 my $customer_format = sub {
201   my( $unused, $session ) = @_;
202   return '&nbsp;' unless exists $user2svc_acct{$session->{'username'}};
203   my $svc_acct = $user2svc_acct{$session->{'username'}};
204   my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
205   return '&nbsp;' unless $cust_pkg;
206   my $cust_main = $cust_pkg->cust_main;
207
208   qq!<A HREF="${p}view/cust_main.cgi?!. $cust_main->custnum. '">'.
209     $cust_pkg->cust_main->name. '</A>';
210 };
211
212 my $time_format = sub {
213   my $time = shift;
214   return '&nbsp;' if $time == 0;
215   my $pretty = time2str('%T%P %a&nbsp;%b&nbsp;%o&nbsp;%Y', $time );
216   $pretty =~ s/ (\d)(st|dn|rd|th)/$1$2/;
217   $pretty;
218 };
219
220 my $duration_format = sub {
221   my $seconds = shift;
222   my $hour = int($seconds/3600);
223   my $min = int( ($seconds%3600) / 60 );
224   my $sec = $seconds%60;
225   '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>'.
226   '<TR><TD ALIGN="right">'.
227      ( $hour ? "<B>$hour</B>h" : '&nbsp;' ).
228    '</TD><TD ALIGN="right">'.
229      ( ( $hour || $min ) ? "<B>$min</B>m" : '&nbsp;' ).
230    '</TD><TD ALIGN="right">'.
231      "<B>$sec</B>s".
232   '</TD></TR></TABLE>';
233 };
234
235 my $octets_format = sub {
236   my $octets = shift;
237   my $megs = $octets / 1048576;
238   sprintf('<B>%.3f</B>&nbsp;megs', $megs);
239   #my $gigs = $octets / 1073741824
240   #sprintf('<B>%.3f</B> gigabytes', $gigs);
241 };
242
243 ###
244 # the fields
245 ###
246
247 tie my %fields, 'Tie::IxHash', 
248   'username'          => {
249                            name    => 'User',
250                            attrib  => 'UserName',
251                            fmt     => $user_format,
252                            align   => 'left',
253                          },
254   'realm'             => {
255                            name    => 'Realm',
256                            attrib  => 'Realm',
257                            align   => 'left',
258                          },
259   'dummy'             => {
260                            name    => 'Customer',
261                            attrib  => '',
262                            fmt     => $customer_format,
263                            align   => 'left',
264                          },
265   'framedipaddress'   => {
266                            name    => 'IP&nbsp;Address',
267                            attrib  => 'Framed-IP-Address',
268                            fmt     => sub { my $ip = shift;
269                                             length($ip) ? $ip : '&nbsp';
270                                           },
271                            align   => 'right',
272                          },
273   'acctstarttime'     => {
274                            name    => 'Start&nbsp;time',
275                            attrib  => 'Acct-Start-Time',
276                            fmt     => $time_format,
277                            align   => 'left',
278                          },
279   'acctstoptime'      => {
280                            name    => 'End&nbsp;time',
281                            attrib  => 'Acct-Stop-Time',
282                            fmt     => $time_format,
283                            align   => 'left',
284                          },
285   'acctsessiontime'   => {
286                            name    => 'Duration',
287                            attrib  => 'Acct-Session-Time',
288                            fmt     => $duration_format,
289                            align   => 'right',
290                          },
291   'acctinputoctets'   => {
292                            name    => 'Upload', # (from user)',
293                            attrib  => 'Acct-Input-Octets',
294                            fmt     => $octets_format,
295                            align   => 'right',
296                          },
297   'acctoutputoctets'  => {
298                            name    => 'Download', # (to user)',
299                            attrib  => 'Acct-Output-Octets',
300                            fmt     => $octets_format,
301                            align   => 'right',
302                          },
303 ;
304 $fields{$_}->{fmt} ||= sub { length($_[0]) ? shift : '&nbsp'; }
305   foreach keys %fields;
306
307 </%init>