--- branches/zimbardo/lib/Frey/CouchAPI.pm	2009/07/05 21:40:16	1172
+++ branches/zimbardo/lib/Frey/CouchAPI.pm	2009/09/28 20:25:07	1191
@@ -47,11 +47,38 @@
 our $config = {
 	database => {
 		path => '/data/webpac2/var/row',
-		name_glob => '/*/*',
+		database_glob => '*/*',
+		data_glob => '*',
 	}
 };
 
-my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
+$config = {
+	data => {
+		base_path => '/home/dpavlin/x/Frey/var/svn/home/dpavlin/private/svn',
+		database => '*',
+		files => '*.storable',
+	},
+};
+
+sub _glob_databases {
+	my $path = $config->{data}->{base_path};
+	map {
+		my $p = $_;
+		$p =~ s{^$path/+}{};
+		$p;
+	} glob "$path/$config->{data}->{database}"
+}
+
+sub _glob_files {
+	my $path = $config->{data}->{base_path} . '/' . shift;
+	map {
+		my $p = $_;
+		$p =~ s{^$path/+}{};
+		$p;
+	} glob "$path/$config->{data}->{files}"
+};
+
+my $regex_dbs = '[a-zA-Z][a-zA-Z0-9_\$\(\)\+\-/]+';
 
 our $json = {};
 our $status;
@@ -80,8 +107,10 @@
 	my $url = $tx->req->url->to_string;
 	$url = uri_unescape( $url );
 	my $method = $tx->req->method;
-	my $path = $config->{database}->{path};
-	
+	my $path = $config->{data}->{base_path};
+
+	die "base_path $path doesn't exist" unless -e $path;
+
 	if ( $url eq '/' ) {
 		$json = {
 			couchdb => "Welcome",
@@ -94,7 +123,7 @@
 				my $db = $_;
 				$db =~ s{^\Q$path\E/*}{};
 				$db;
-			} glob $path . $config->{database}->{name_glob}
+			} _glob_databases
 		];
 		$status = 200;
 	} elsif ( $url =~ m{^/_config/?(.+)} ) {
@@ -217,8 +246,6 @@
 					'';
 				} else {
 
-					$id = s{^$path/$database/}{};
-
 					if ( defined $endkey && $id gt $endkey ) {
 						'';
 					} elsif ( $startkey ) {
@@ -235,7 +262,7 @@
 					}
 				}
 
-			} glob( "$path/$database/*" );
+			} _glob_files( $database );
 
 			$offset += $skip if $skip;
 
@@ -343,15 +370,15 @@
 	$json = { error => 'not_found', reason => 'Missing' } if $status == 404;
 
 	if ( $method =~ m{(DELETE|PUT)} ) {
-		$tx->res->headers->add_line( 'Location' => $tx->req->url->to_abs );
+#		$tx->res->headers->add_line( 'Location' => $tx->req->url->to_abs );
 	}
 
 	$tx->res->code( $status );
 	$tx->res->headers->content_type( 'text/plain;charset=utf-8' );
 	my $body = to_json $json;
 	$tx->res->body( $body );
-	$tx->res->headers->add_line( 'Cache-Control' => 'must-revalidate' );
-	$tx->res->headers->add_line( 'Server' => "Frey::CouchAPI/$VERSION" );
+#	$tx->res->headers->add_line( 'Cache-Control' => 'must-revalidate' );
+#	$tx->res->headers->add_line( 'Server' => "Frey::CouchAPI/$VERSION" );
 
 	print "$method $url $status\n$body\n";
 
@@ -363,9 +390,9 @@
 
 sub database_get {
 	my ($db_name) = @_;
-	my $path = $config->{database}->{path} || die;
-	warn "# collecting docs from $path/$db_name/*\n";
-	my @docs = glob "$path/$db_name/*";
+	warn "# collecting docs for $db_name\n";
+	my @docs = _glob_files( $db_name );
+	warn dump @docs;
 	my $json = {
 		db_name => $db_name,
 		doc_count => $#docs + 1,