--- trunk/lib/Frey/CouchAPI.pm	2009/04/22 23:38:10	1047
+++ trunk/lib/Frey/CouchAPI.pm	2009/04/23 17:26:04	1049
@@ -1,11 +1,19 @@
 package Frey::CouchAPI;
 
+use warnings;
+use strict;
+
 use JSON;
 use Data::Dump qw/dump/;
 use URI::Escape;
 use File::Path qw(make_path remove_tree);
 use Storable;
 
+our $VERSION = '0.1';
+$VERSION .= '-Frey-' . $Frey::VERSION;
+
+our $debug = $Frey::debug || 0;
+
 sub rewrite_urls {
 	my ( $self, $tx ) = @_;
 	if ( $tx->req->url->path =~ m{/_utils/} ) {
@@ -20,7 +28,7 @@
 	}
 }
 
-my $path = '/data/webpac2/var/row';
+my $path = '/data/webpac2/var/ds';
 my @all_dbs = map {
 	s{^\Q$path\E/*}{};
 	$_;
@@ -29,7 +37,7 @@
 my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
 
 our $json = {};
-our $stauts = 500;
+our $status = 500;
 
 sub ok {
 	$json = { ok => JSON::true };
@@ -43,16 +51,22 @@
 	$url = uri_unescape( $url );
 	my $method = $tx->req->method;
 
-	warn "INFO: using Apache CouchDB emulation API\n";
-
 	if ( $url eq '/' ) {
 		$json = {
 			couchdb => "Welcome",
-			version => "0-Frey",
+			version => $VERSION,
 		}
 	} elsif ( $url eq '/_all_dbs' ) {
 		$json = [ @all_dbs ];
 		$status = 200;
+	} elsif ( $url =~ m{^/_config} ) {
+		$json = {
+			couchdb => {
+				version => $VERSION,
+				path => $path,
+			}
+		};
+		$status = 200;
 	} elsif ( $url =~ m{($regex_dbs)/$} ) {
 
 		my $database = $1;
@@ -74,32 +88,66 @@
 			}
 		}
 
-	} elsif ( $url =~ m{($regex_dbs)/(.+)$} ) {
-		my ($database,$id) = ($1,$2);
+	} elsif ( $url =~ m{($regex_dbs)/([^?]+)\??(.+)?$} ) {
+		my ($database,$id,$args) = ($1,$2,$3);
+
+		my $arg;
+		if ( $args ) {
+			foreach my $a ( split(/[&;]/,$args) ) {
+				my ($n,$v) = split(/=/,$a);
+				$v =~ s{(["'])(.+)\1}{$2};
+				$arg->{$n} = $v;
+			}
+		}
 	
 		my $p = "$path/$database/$id";
-		warn "## database: $database id: $id -> $p ";
+		warn "## database: $database id: $id -> $p [$args]\n";
 
-		if ( $id eq '_all_docs' ) {
 
-			my @docs = map {
+		if ( $id =~ m{_all_docs(\w+)?$} ) {
+
+			my $by = $1;
+			my $offset = 0;
+			my $startkey = delete $arg->{startkey};
+warn "STARTKEY: $startkey\n";
+			my $total_rows = 0;
+
+			my @docs = grep { length $_ } map {
 				s{^$path/$database/}{};
-				$_;
+				if ( $startkey ) {
+					if ( $_ >= $startkey ) {
+						$total_rows++;
+						$_;
+					} else {
+						$offset++;
+					}
+				} else {
+					$total_rows++;
+					$_;
+				}
 			} glob( "$path/$database/*" );
 
 			warn "## docs ", dump( @docs );
 
 			$json = {
-				total_rows =>  $#docs + 1,
-				offset => 0,
+				total_rows =>  $total_rows,
+				offset => $offset,
 				rows => [],
 			};
 
+			my $rows;
+			my @ids;
+
 			foreach my $id ( @docs ) {
-				warn "++ $id\n";
+				warn "++ $id\n" if $debug;
 				my $p = "$path/$database/$id";
-				my $data = Storable::retrieve( $p );
-				push @{ $json->{rows} }, {
+				my $data = eval { Storable::retrieve( $p ) };
+				if ( $@ ) {
+					warn "ERROR: $p | $@\n";
+					next;
+				}
+				push @ids, $id;
+				$rows->{$id} = {
 					id => $id,
 					key => $id,
 					value => {
@@ -108,21 +156,41 @@
 				};
 			}
 
+			my $descending = delete $arg->{descending};
+			my @sorted = sort @ids;
+
+			foreach my $id ( $descending ? reverse @sorted : @sorted ) {
+				warn ">> $id ", $descending ? 'desc' : 'asc', "\n";
+				push @{ $json->{rows} }, $rows->{$id};
+			}
+
 		} elsif ( $method eq 'PUT' ) {
 	
-			warn "## ",dump( $tx->req );
+			warn "## ",dump( $tx->req ) if $debug;
 
 			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 );
+			if ( ! -e $p ) {
+				$status = 404;
+			} else {
+				warn "retrive $p ", -s $p, " bytes\n";
+				$json = Storable::retrieve( $p );
+			}
+		} elsif ( $method eq 'DELETE' ) {
+			if ( -e $p ) {
+				unlink $p || { $status = 501 };
+			} else {
+				$status = 404;
+			}
 		} else {
 			$status = 501;
 		}
 
+		warn "WARNING: arg left from $url = ",dump( $arg ),$/ if keys %$arg;
+
 	}
 
 	if ( $status >= 400 && $status < 500 && ! defined $json) {
@@ -155,7 +223,7 @@
 	};
 
 	warn "## calculating disk_size\n";
-	$json->{disk_size} += -s "$path/$1/$_" foreach $docs;
+	$json->{disk_size} += -s $_ foreach @docs;
 	$status = 200;
 	return $json;
 }