src/modules/rlm_counter/rad_counter.pl

   1 #!/usr/bin/perl
   2 #
   3 #       $Id$
   4 #
   5 use warnings ;
   6 use GDBM_File ;
   7 use Fcntl ;
   8 use Getopt::Long;
   9
  10 my $user = '';
  11 my $divisor = 1;
  12 my $match = '.*';
  13
  14 #
  15 #  This should be fixed...
  16 #
  17 $filename = '';
  18
  19 #
  20 #  Print out only one user,
  21 #
  22 #  Or specifiy printing in hours, minutes, or seconds (default)
  23 #
  24 GetOptions ('user=s'  => \$user,
  25             'match=s' => \$match,
  26             'file=s'  => \$filename,
  27             'hours'   => sub { $divisor = 3600 },
  28             'minutes' => sub { $divisor = 60 },
  29             'seconds' => sub { $divisor = 1 } );
  30
  31 #
  32 #  For now, this must be specified by hand.
  33 #
  34 if ($filename eq '') {
  35     die "You MUST specify the DB filename via: --file = <filename>\n";
  36 }
  37
  38 #
  39 #  Open the file.
  40 #
  41 my $db = tie(%hash, 'GDBM_File', $filename, O_RDONLY, 0666) or die "Cannot open$filename: $!\n";
  42
  43 #
  44 #  If given one name, give the seconds
  45 #
  46 if ($user ne '') {
  47     print $user, "\t\t", int ( unpack('L',$hash{$user}) / $divisor), "\n";
  48
  49     undef $db;
  50     untie %hash;
  51     exit 0;
  52 }
  53
  54 #
  55 #  This may be faster, but unordered.
  56 #while (($key,$val) = each %hash) {
  57 #
  58 foreach $key (sort keys %hash) {
  59     #
  60     #  These are special.
  61     next if ($key eq "DEFAULT1");
  62     next if ($key eq "DEFAULT2");
  63
  64     #
  65     #  Allow user names matching a regex.
  66     #
  67     next if ($key !~ /$match/);
  68
  69     #
  70     #  Print out the names...
  71     print $key, "\t\t", int ( unpack('L',$hash{$key}) / $divisor), "\n";
  72 }
  73 undef $db;
  74 untie %hash;