13 |
use Scalar::Util qw/blessed/; |
use Scalar::Util qw/blessed/; |
14 |
use Storable qw/dclone/; |
use Storable qw/dclone/; |
15 |
use Carp qw/carp/; |
use Carp qw/carp/; |
16 |
|
use POSIX; |
17 |
|
|
18 |
sub new { |
sub new { |
19 |
my ($class, $host, $port, $options) = @_; |
my ($class, $host, $port, $options) = @_; |
122 |
$url =~ s/\s+-\S+//g; # remove command line options |
$url =~ s/\s+-\S+//g; # remove command line options |
123 |
$url =~ s/\W+/-/g; |
$url =~ s/\W+/-/g; |
124 |
|
|
125 |
my $time = $data->{time} = time(); |
my $time = time(); |
126 |
|
|
|
my @caller_name = ( qw/package file line sub/ ); |
|
127 |
my @caller = caller(0); |
my @caller = caller(0); |
128 |
|
$caller[3] = (caller(1))[3]; |
129 |
$caller[3] =~ s{^.+::}{}; # stip package name from sub |
$caller[3] =~ s{^.+::}{}; # stip package name from sub |
130 |
$data->{ $caller_name[$_] } = $caller[$_] foreach ( 0 .. $#caller_name ); |
$data->{package} = { |
131 |
|
time => $time, |
132 |
|
name => $caller[0], |
133 |
|
line => $caller[2], |
134 |
|
caller => $caller[3], |
135 |
|
}; |
136 |
|
|
137 |
|
if ( $ENV{DEBUG} ) { |
138 |
|
|
139 |
|
my $caller; |
140 |
|
my $depth = 0; |
141 |
|
while ( my @c = caller($depth) ) { |
142 |
|
push @$caller, [ @c ]; |
143 |
|
$depth++; |
144 |
|
} |
145 |
|
|
146 |
my $caller; |
$data->{caller} = $caller; |
|
my $depth = 0; |
|
|
while ( my @c = caller($depth) ) { |
|
|
push @$caller, [ @c ]; |
|
|
$depth++; |
|
|
} |
|
147 |
|
|
148 |
$data->{caller} = $caller; |
} |
149 |
|
|
150 |
# carp 'audit ', dump($data); |
# carp 'audit ', dump($data); |
151 |
|
|
152 |
$time = int($time); # reduce granularity for url |
# $time = int($time); # reduce granularity for url |
153 |
|
$time = strftime("%Y-%m-%d.%H:%M:%S", localtime $time); |
154 |
my $package = $caller[0]; |
my $package = $caller[0]; |
155 |
$audit->put( "pxelator/$time.$package.$url", $data ); |
$audit->put( "pxelator/$time.$package.$url", $data ); |
156 |
|
|