--- lib/PXElator/CouchDB.pm 2009/08/13 12:00:38 210 +++ lib/PXElator/CouchDB.pm 2009/08/26 15:59:19 299 @@ -12,6 +12,8 @@ use Data::Structure::Util qw(unbless); use Scalar::Util qw/blessed/; use Storable qw/dclone/; +use Carp qw/carp/; +use POSIX; sub new { my ($class, $host, $port, $options) = @_; @@ -60,10 +62,18 @@ our $rev; +sub rev { + my ($self,$url) = @_; + my $rev = $rev->{$url}; + $rev ||= eval { $self->get( $url )->{_rev} }; +# warn "# rev $url $rev"; + return $rev; +} + sub delete { my ($self, $url) = @_; - $self->request(DELETE => $url); + $self->request(DELETE => $url . '?rev=' . $self->rev($url) ); } sub get { @@ -75,23 +85,25 @@ sub put { my ($self, $url, $json) = @_; - if ( ! defined $json->{_rev} ) { - my $old = eval { $self->get( $url )->{_rev} }; - $rev->{$url} = $json->{_rev} = $old if defined $old; - } + $json->{_rev} = $rev->{$url} if defined $rev->{$url}; my $data = dclone $json; $data = unbless $data if blessed $data; - warn dump( $data ); +# warn "# put ",dump( $data ); $json = JSON->new->utf8->encode( $data ); - warn $json; + carp "# put ",$json; do { - eval { $self->request(PUT => $url, $json) }; - $rev->{$url} = $self->get( $url )->{_rev} if $@; + my $json = eval { $self->request(PUT => $url, $json) }; + if ( $@ ) { + $rev->{$url} = $self->rev( $url ); + warn "refresh rev $url = ", $rev->{$url}; + } else { + $rev->{$url} = JSON->new->decode( $json )->{rev}; + } } until ! $@; } @@ -110,16 +122,32 @@ $url =~ s/\s+-\S+//g; # remove command line options $url =~ s/\W+/-/g; - my ( $package, $file, $line, $sub ) = caller(1); -# ( $package, undef, $line ) = caller(0) if $package eq 'main'; + my $time = $data->{time} = time(); - my $time = time(); + my @caller_name = ( qw/package file line sub/ ); + my @caller = caller(0); + $caller[3] = (caller(1))[3]; + $caller[3] =~ s{^.+::}{}; # stip package name from sub + $data->{ $caller_name[$_] } = $caller[$_] foreach ( 0 .. $#caller_name ); + + if ( $ENV{DEBUG} ) { + + my $caller; + my $depth = 0; + while ( my @c = caller($depth) ) { + push @$caller, [ @c ]; + $depth++; + } - $data->{$_} = eval '$' . $_ foreach ( qw/time package line sub/ ); + $data->{caller} = $caller; + + } - warn 'audit ', dump($data), "at $file +$line\n"; +# carp 'audit ', dump($data); - $time = int($time); # reduce granularity +# $time = int($time); # reduce granularity for url + $time = strftime("%Y-%m-%d.%H:%M:%S", localtime $time); + my $package = $caller[0]; $audit->put( "pxelator/$time.$package.$url", $data ); }