--- design/design-couch.pl	2009/04/28 15:06:02	34
+++ design/design-couch.pl	2009/04/28 20:52:52	35
@@ -10,6 +10,9 @@
 use File::Slurp qw//;
 use File::Find;
 use HTTP::Request::Common;
+use MIME::Base64;
+use Media::Type::Simple;
+
 
 # design-couch.pl
 #
@@ -36,7 +39,7 @@
 	$path =~ s{^/+}{};
 	create_path $path;
 	File::Slurp::write_file $path, $content;
-	print "$path ", -s $path, " bytes\n";
+	print "$path ", -s $path, " bytes created\n";
 }
 
 sub write_attachment {
@@ -47,6 +50,7 @@
 	print "detached $file ", -s $file, " bytes\n";
 }
 
+
 sub unroll {
 	my ( $tree, $path ) = @_;
 
@@ -92,8 +96,6 @@
 
 	my $json;
 
-	my @attached;
-
 	find({ no_chdir => 1, wanted => sub {
 		my $path = $File::Find::name;
 		return unless -f $path;
@@ -102,8 +104,21 @@
 
 		$path =~ s{^\./}{};
 
-		if ( $path =~ m{_attachemnts} ) {
-			push @attached, $path;
+		if ( $path =~ m{_attachemnts/(.+)} ) {
+
+			my $filename = $1;
+			my $content_type = 'text/plain';
+			$content_type = type_from_ext($1) if $filename =~ m{\.(\w+)$};
+
+			my $data = File::Slurp::read_file( $path );
+			$data = encode_base64( $data );
+			# XXX inline attachments must be single line
+			# XXX http://wiki.apache.org/couchdb/HTTP_Document_API
+			$data =~ s/[\n\r]+//gs;
+			$json->{_attachments}->{ $filename } = {
+				content_type => $content_type,
+				data         => $data,
+			};
 			return;
 		}
 
@@ -116,22 +131,31 @@
 #		warn "## json = ",dump( $json );
 	}}, '.' );
 
-	warn "# $database/_design/$design = ",dump( $json );
-	write_file "../$database-$design.push.js", to_json $json;
+	if ( ! defined $json->{_id} ) {
+		warn "creating _id for document\n";
+		$json->{_id} = $$ . '-' . time();
+	}
+	delete( $json->{_rev} ) && warn "removing _rev from document\n";
 
-	die "no _id?" unless $json->{_id};
-	delete( $json->{_rev} );
+	print "push $database/_design/$design\n";
+	write_file "../$database-$design.push.js", to_json $json;
 
 	warn "# put $url\n";
-	my $response = $ua->request( HTTP::Request::Common::PUT($url, 'Content-Type' => 'application/json', Content => to_json $json ) );
+	my $response = $ua->request(
+		HTTP::Request::Common::PUT(
+			$url,
+			'Content-Type' => 'application/json',
+			Content => to_json $json,
+		)
+	);
 
 	if ( $response->code == 409 ) {
-		warn "## get old $url\n";
+		warn "## update $url\n";
 		my $response = $ua->get( $url );
 		die $response->status_line if $response->is_error;
 
-		my $data = from_json $response;
-		$json->{$_} = $data->{$_} foreach ( 'rev', '_id' );
+		my $data = from_json $response->decoded_content;
+		$json->{$_} = $data->{$_} foreach ( '_rev', '_id' );
 
 		$response = $ua->request( HTTP::Request::Common::PUT($url, 'Content-Type' => 'application/json', Content => to_json $json ) );
 		die $response->status_line if $response->is_error;
@@ -141,8 +165,6 @@
 		warn "push new $url\n";
 	}
 
-	warn "FIXME: ignore attachments: ",dump( @attached );
-
 } else {
 	die "$0: unknown command $command";
 }