package CouchDB;

use strict;
use warnings;

use LWP::UserAgent;
use JSON;
use Digest::MD5 qw(md5_hex);
use Data::Dump qw(dump);
use Encode;
use Carp;
use Clone qw(clone);

sub new {
  my ($class, $host, $port, $options) = @_;

  my $ua = LWP::UserAgent->new;
  $ua->timeout(10);
  $ua->env_proxy;

  if ( $ENV{DEBUG} ) {
	$ua->add_handler("request_send",  sub { shift->dump; return });
	$ua->add_handler("response_done", sub { shift->dump; return });
  }

  return bless {
                ua       => $ua,
                host     => $host,
                port     => $port,
                base_uri => "http://$host:$port/",
               }, $class;
}

sub ua { shift->{ua} }
sub base { shift->{base_uri} }

sub request {
  my ($self, $method, $uri, $content, $content_type) = @_;
  $content_type ||= 'application/json';

  my $full_uri = $self->base . $uri;
  my $req;

  warn "# request $method $full_uri ", $content ? length($content) : '-' , " $content_type\n";

  if (defined $content) {
    $req = HTTP::Request->new( $method, $full_uri, undef );
    $req->header( 'Content-Type' => $content_type );
    my $bytes = ref($content) ? encode_json($content) : $content;
    $req->content( $bytes ); # convert to bytes
    warn "### ",dump($bytes);
  } else {
    $req = HTTP::Request->new( $method, $full_uri );
  }

  my $response = $self->ua->request($req);

  if ($response->is_success) {
    return decode_json $response->content;
  } else {
    die($response->status_line . ":" . $response->content);
  }
}

sub delete {
  my ($self, $url) = @_;

  $self->request(DELETE => $url);
}

sub get {
  my ($self, $url) = @_;

  $self->request(GET => $url);
}

sub put {
  my ($self, $url, $json) = @_;

  $self->request(PUT => $url, $json);
}

sub post {
  my ($self, $url, $json) = @_;

  $self->request(POST => $url, $json);
}

sub x_sync {
	my ($json,$old) = @_;
	$json->{$_} = $old->{$_} foreach keys %{ $old->{x_meta} }; # special persistent x_meta fields
	my $json_md5 = md5_hex encode_json $json;
	$json->{x_sync}->{json_md5} = $json_md5;
	my $o =  $old->{x_sync}->{json_md5};
	my $n = $json->{x_sync}->{json_md5};
	warn "## x_sync $o ", $o eq $n ? '==' : '!=', " $n\n";
	return $json;
}


sub modify {
	my ($self, $url, $json) = @_;

	carp "# modify $url ", ref $json;

	my $ret;

	if ( my $old = eval { $self->get( $url ) } ) {
		warn "# old ", $old->{_rev}, dump($old);

		if ( ref $json eq 'CODE' ) {
			$json = $json->( clone $old );
			warn "# json CODE ",dump($json);
		} else {
			warn "# overwrite old";
			$json->{_rev} = $old->{_rev};
		}

		$json = x_sync($json, $old);

		if ( $json->{x_sync}->{json_md5} ne $old->{x_sync}->{json_md5} ) {
			warn "# modify $url";
			$ret = $self->put( $url => $json );
		} else {
			warn "# unchanged $url";
			$ret->{rev} = $old->{_rev};
			$ret->{id}  = $old->{_id};
		}
	} else {
		$json = $json->({}) if ref $json eq 'CODE';

		$json = x_sync($json);

		warn "# insert $url ", dump($json);
		$ret = $self->put( $url => $json );
	}

	return $ret;
}

1;
