--- couchdb/design-couch.pl	2009/08/30 13:24:51	373
+++ couchdb/design-couch.pl	2009/08/30 13:33:09	374
@@ -11,6 +11,7 @@
 use File::Find;
 use HTTP::Request::Common;
 use MIME::Base64;
+use autodie;
 
 use lib qw(lib ../lib);
 use Media::Type::Simple;
@@ -20,19 +21,14 @@
 #
 # 04/26/09 21:12:28 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
 
-my ( $command, $database, $design ) = @ARGV;
-die "usage: $0 [push|pull] database design\n" unless $database && $design;
+our $couchdb = $ENV{COUCHDB} || 'http://localhost:5984/';
 
-if ( ! -e $design && $command eq 'pull') {
-	warn "# create new design $design\n";
-	mkdir $design;
-}
+our ( $command, $database, $design ) = @ARGV;
 
-chdir $design || die "can't find $design: $!";
+die "usage: $0 [push|pull] database [design]\n" unless $database;
 
-my $ua = LWP::UserAgent->new;
 
-my $url = "http://localhost:5984/$database/_design/$design";
+my $ua = LWP::UserAgent->new;
 
 sub create_path {
 	my $path = shift;
@@ -63,7 +59,7 @@
 	my ( $path ) = @_;
 	my $file = "_attachemnts/$path";
 	create_path $file;
-	$ua->mirror( "$url/$path", $file );
+	$ua->mirror( "$couchdb/$database/_design/$design/$path", $file );
 	print "detached $file ", -s $file, " bytes\n";
 	svn $file;
 }
@@ -99,7 +95,10 @@
 
 }
 
-if ( $command eq 'pull' ) {
+sub pull_design {
+	$design = shift;
+
+	my $url = "$couchdb/$database/_design/$design";
 
 	warn "# get $url\n";
 	my $response = $ua->get( $url );
@@ -110,7 +109,10 @@
 
 	unroll( from_json $json, '' );
 
-} elsif ( $command eq 'push' ) {
+}
+
+sub push_database_design {
+	$design = shift;
 
 	$ua->request( HTTP::Request::Common::PUT( "http://localhost:5984/$database" ) ) && warn "# created database $database\n";
 
@@ -161,6 +163,7 @@
 	print "push $database/_design/$design\n";
 	write_file "../$database-$design.push.js", to_json $json;
 
+	my $url = "$couchdb/$database/_design/$design";
 	warn "# put $url\n";
 	my $response = $ua->request(
 		HTTP::Request::Common::PUT(
@@ -185,6 +188,50 @@
 		die $response->status_line if $response->is_error;
 		warn "push new $url\n";
 	}
+}
+
+
+# XXX main
+
+
+if ( $command eq 'push' ) {
+
+	my @designs = map { (split(m{/},2))[0] } @{ glob '*/views' };
+	@designs = ( $design ) if $design;
+
+warn "XX ",dump( @designs );
+
+	foreach my $design ( @designs ) {
+
+		chdir $design;
+		push_design( $design );
+		chdir '..';
+
+	}
+
+} elsif ( $command eq 'pull' ) {
+
+	my $designs = from_json $ua->get( "$couchdb/$database/_all_docs?startkey=%22_design%2F%22&endkey=%22_design0%22" )->decoded_content;
+	my @designs =
+		map {
+			my $name = $_->{id};
+			$name =~ s{^_design/}{};
+			$name;
+		} @{ $designs->{rows} }
+	;
+
+	warn "# $database/_design ",dump( @designs );
+
+	@designs = ( $design ) if $design;
+
+	foreach my $design ( @designs ) {
+
+		mkdir $design unless -e $design;
+		chdir $design;
+		pull_design( $design );
+		chdir '..';
+
+	}
 
 } else {
 	die "$0: unknown command $command";