remove messages from CRON

[pxelator] / couchdb / design-couch.pl

diff --git a/couchdb/design-couch.pl b/couchdb/design-couch.pl
index e5cdf10..7a8b544 100755 (executable)
--- a/couchdb/design-couch.pl
+++ b/couchdb/design-couch.pl
@@ -11,6 +11,7 @@ use File::Slurp qw//;
 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 @@ use Media::Type::Simple;
 #
 # 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;
@@ -46,7 +42,7 @@ sub create_path {
 
 sub svn {
        my $path = shift;
-       return if $path =~ m{(_rev|.*\.(push|pull)\.js)$};
+       return if $path =~ m{(_.*|.*\.(push|pull)\.js)$};
        system "svn add --parents $path";
 }
 
@@ -63,7 +59,7 @@ 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;
 }
@@ -99,7 +95,10 @@ sub unroll {
 
 }
 
-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,12 @@ if ( $command eq 'pull' ) {
 
        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;
 
@@ -159,6 +163,7 @@ warn "## $path\n";
        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(
@@ -183,6 +188,48 @@ warn "## $path\n";
                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";