--- couchdb/design-couch.pl	2009/08/18 12:18:39	248
+++ couchdb/design-couch.pl	2009/09/07 10:30:19	388
@@ -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,14 +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/';
 
-chdir $design || die "can't find $design: $!";
+our ( $command, $database, $design ) = @ARGV;
+
+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;
@@ -38,20 +39,29 @@
 		#warn "# dir $dir";
 	}
 }
+
+sub svn {
+	my $path = shift;
+	return if $path =~ m{(_.*|.*\.(push|pull)\.js)$};
+	system "svn add --parents $path";
+}
+
 sub write_file {
 	my ( $path, $content ) = @_;
 	$path =~ s{^/+}{};
 	create_path $path;
 	File::Slurp::write_file $path, $content;
 	print "$path ", -s $path, " bytes created\n";
+	svn $path;
 }
 
 sub write_attachment {
 	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;
 }
 
 
@@ -85,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 );
@@ -96,13 +109,19 @@
 
 	unroll( from_json $json, '' );
 
-} elsif ( $command eq 'push' ) {
+}
+
+sub push_design {
+	$design = shift;
+
+	$ua->request( HTTP::Request::Common::PUT( "http://localhost:5984/$database" ) ) && warn "# created database $database\n";
 
 	my $json;
 
 	find({ no_chdir => 1, wanted => sub {
 		my $path = $File::Find::name;
 		return unless -f $path;
+		return if $path =~ m{/\.svn};
 
 warn "## $path\n";
 
@@ -144,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(
@@ -168,6 +188,48 @@
 		die $response->status_line if $response->is_error;
 		warn "push new $url\n";
 	}
+}
+
+
+# XXX main
+
+
+if ( $command eq 'push' ) {
+
+	my @designs = map { s{/.+$}{}; $_ } glob '*/views';
+	@designs = ( $design ) if $design;
+
+	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";