1 |
package store; |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
use POSIX; |
7 |
use Time::HiRes qw/time/; |
8 |
use Data::Dump qw(dump); |
9 |
|
10 |
use MongoDB; |
11 |
|
12 |
our $audit; |
13 |
|
14 |
eval { |
15 |
my $conn = MongoDB::Connection->new; |
16 |
my $db = $conn->get_database( 'pxelator' ); |
17 |
$audit = $db->get_collection( 'audit' ); |
18 |
}; |
19 |
warn "ERROR: no store for audit: $@" if $@; |
20 |
|
21 |
|
22 |
sub audit { |
23 |
my $data = pop @_; |
24 |
|
25 |
my $url = join(' ', @_); |
26 |
$url =~ s/\s+-\S+//g; # remove command line options |
27 |
$url =~ s/\W+/-/g; |
28 |
|
29 |
my $time = time(); |
30 |
|
31 |
my @caller = caller(0); |
32 |
$caller[3] = (caller(1))[3]; |
33 |
$caller[3] =~ s{^.+::}{}; # stip package name from sub |
34 |
$data->{package} = { |
35 |
time => $time, |
36 |
name => $caller[0], |
37 |
line => $caller[2], |
38 |
caller => $caller[3], |
39 |
}; |
40 |
|
41 |
if ( $ENV{DEBUG} ) { |
42 |
|
43 |
my $caller; |
44 |
my $depth = 0; |
45 |
while ( my @c = caller($depth) ) { |
46 |
push @$caller, [ @c ]; |
47 |
$depth++; |
48 |
} |
49 |
|
50 |
$data->{caller} = $caller; |
51 |
|
52 |
} |
53 |
|
54 |
# carp 'audit ', dump($data); |
55 |
|
56 |
# $time = int($time); # reduce granularity for url |
57 |
$time = strftime("%Y-%m-%d.%H:%M:%S", localtime $time); |
58 |
my $package = $caller[0]; |
59 |
|
60 |
# CouchDB::_store_audit( "$time.$package.$url" => $data ); |
61 |
|
62 |
# $data->{_id} = "$time.$package.$url"; |
63 |
# |
64 |
if ( $audit ) { |
65 |
$audit->insert( $data ); |
66 |
} else { |
67 |
warn "AUDIT ",dump($data); |
68 |
} |
69 |
} |
70 |
|
71 |
|
72 |
sub query { |
73 |
my ( $q, $callback ) = @_; |
74 |
warn "# query ", dump($q); |
75 |
$audit->ensure_index({ $_ => 1 }) foreach keys %$q; |
76 |
my $cursor = $audit->query($q)->sort({ 'package.time' => -1 })->limit( 100 ); |
77 |
while( my $o = $cursor->next ) { |
78 |
$callback->( $o ); |
79 |
} |
80 |
} |
81 |
|
82 |
1; |