--- trunk/lib/Frey/CouchAPI.pm	2009/04/22 22:01:06	1046
+++ trunk/lib/Frey/CouchAPI.pm	2009/04/22 23:38:10	1047
@@ -3,6 +3,8 @@
 use JSON;
 use Data::Dump qw/dump/;
 use URI::Escape;
+use File::Path qw(make_path remove_tree);
+use Storable;
 
 sub rewrite_urls {
 	my ( $self, $tx ) = @_;
@@ -24,50 +26,138 @@
 	$_;
 } glob "$path/*/*";
 
-my $regex_dbs = join('|', @all_dbs);
+my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
+
+our $json = {};
+our $stauts = 500;
+
+sub ok {
+	$json = { ok => JSON::true };
+	$status = 200;
+}
 
 sub dispatch {
 	my ($self,$tx) = @_;
 
 	my $url = $tx->req->url->to_string;
 	$url = uri_unescape( $url );
+	my $method = $tx->req->method;
 
-	warn "INFO: using Apache CouchDB emulation API $url\n";
-
-	warn "## tx = ",dump( $tx );
-
-	my $json = {};
+	warn "INFO: using Apache CouchDB emulation API\n";
 
 	if ( $url eq '/' ) {
 		$json = {
-			couchdb => "Emulated on Frey",
-			version => 0,
+			couchdb => "Welcome",
+			version => "0-Frey",
 		}
 	} elsif ( $url eq '/_all_dbs' ) {
 		$json = [ @all_dbs ];
-	} elsif ( $url =~ m{($regex_dbs)} ) {
-		warn "# collecting docs from $path/$1/*\n";
-		my @docs = glob "$path/$1/*";
-		$json = {
-			db_name => $1,
-			doc_count => $#docs + 1,
-			doc_del_count => 0,
-			update_seq => 0,
-			purge_seq => 0,
-			capacity_running => JSON::false,
-			disk_size => 0,
-			instance_start_time => time(),
-		};
+		$status = 200;
+	} elsif ( $url =~ m{($regex_dbs)/$} ) {
+
+		my $database = $1;
+		my $dir = "$path/$database";
+
+		if ( $method eq 'GET' ) {
+			$json = database_get( $database );
+		} elsif ( $method eq 'DELETE' ) {
+			if ( ! -e $dir ) {
+				$status = 404;
+			} else {
+				remove_tree($dir) && ok || { $status = 501 };
+			}
+		} elsif ( $method eq 'PUT' ) {
+			if ( ! -e $dir ) {
+				make_path($dir) && ok && warn "created $dir" || { $status = 501 };
+			} else {
+				$status = 412;
+			}
+		}
+
+	} elsif ( $url =~ m{($regex_dbs)/(.+)$} ) {
+		my ($database,$id) = ($1,$2);
+	
+		my $p = "$path/$database/$id";
+		warn "## database: $database id: $id -> $p ";
+
+		if ( $id eq '_all_docs' ) {
+
+			my @docs = map {
+				s{^$path/$database/}{};
+				$_;
+			} glob( "$path/$database/*" );
+
+			warn "## docs ", dump( @docs );
+
+			$json = {
+				total_rows =>  $#docs + 1,
+				offset => 0,
+				rows => [],
+			};
+
+			foreach my $id ( @docs ) {
+				warn "++ $id\n";
+				my $p = "$path/$database/$id";
+				my $data = Storable::retrieve( $p );
+				push @{ $json->{rows} }, {
+					id => $id,
+					key => $id,
+					value => {
+						rev => (stat($p))[9], # mtime
+					}
+				};
+			}
+
+		} elsif ( $method eq 'PUT' ) {
+	
+			warn "## ",dump( $tx->req );
+
+			my $data = $tx->req->content->file->slurp;
+
+			Storable::store( from_json($data), $p );
+			warn "store $p ", -s $p, " bytes: $data\n";
+		} elsif ( $method eq 'GET' ) {
+			warn "retrive $p ", -s $p, " bytes\n";
+			$json = Storable::retrieve( $p );
+		} else {
+			$status = 501;
+		}
 
-		warn "## calculating disk_size\n";
-		$json->{disk_size} += -s "$path/$1/$_" foreach $docs;
 	}
 
-	$tx->res->code( 200 );
+	if ( $status >= 400 && $status < 500 && ! defined $json) {
+		$json = { error => 'not_found', reason => 'Missing' };
+		warn "fake $status";
+	}
+
+	$tx->res->code( $status );
 	$tx->res->headers->content_type( 'text/json' );
-	$tx->res->body( to_json $json );
+	my $body = to_json $json;
+	$tx->res->body( $body );
+	warn "CouchDB API: $method $url $status $body\n";
 	return $tx;
 
 }
 
+sub database_get {
+	my ($db_name) = @_;
+	warn "# collecting docs from $path/$db_name/*\n";
+	my @docs = glob "$path/$db_name/*";
+	my $json = {
+		db_name => $db_name,
+		doc_count => $#docs + 1,
+		doc_del_count => 0,
+		update_seq => 0,
+		purge_seq => 0,
+		capacity_running => JSON::false,
+		disk_size => 0,
+		instance_start_time => time(),
+	};
+
+	warn "## calculating disk_size\n";
+	$json->{disk_size} += -s "$path/$1/$_" foreach $docs;
+	$status = 200;
+	return $json;
+}
+
 1;