/[pxelator]/couchdb/design-couch.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /couchdb/design-couch.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 373 by dpavlin, Sun Aug 30 12:07:15 2009 UTC revision 374 by dpavlin, Sun Aug 30 13:33:09 2009 UTC
# Line 11  use File::Slurp qw//; Line 11  use File::Slurp qw//;
11  use File::Find;  use File::Find;
12  use HTTP::Request::Common;  use HTTP::Request::Common;
13  use MIME::Base64;  use MIME::Base64;
14    use autodie;
15    
16  use lib qw(lib ../lib);  use lib qw(lib ../lib);
17  use Media::Type::Simple;  use Media::Type::Simple;
# Line 20  use Media::Type::Simple; Line 21  use Media::Type::Simple;
21  #  #
22  # 04/26/09 21:12:28 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  # 04/26/09 21:12:28 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
23    
24  my ( $command, $database, $design ) = @ARGV;  our $couchdb = $ENV{COUCHDB} || 'http://localhost:5984/';
 die "usage: $0 [push|pull] database design\n" unless $database && $design;  
25    
26  if ( ! -e $design && $command eq 'pull') {  our ( $command, $database, $design ) = @ARGV;
         warn "# create new design $design\n";  
         mkdir $design;  
 }  
27    
28  chdir $design || die "can't find $design: $!";  die "usage: $0 [push|pull] database [design]\n" unless $database;
29    
 my $ua = LWP::UserAgent->new;  
30    
31  my $url = "http://localhost:5984/$database/_design/$design";  my $ua = LWP::UserAgent->new;
32    
33  sub create_path {  sub create_path {
34          my $path = shift;          my $path = shift;
# Line 63  sub write_attachment { Line 59  sub write_attachment {
59          my ( $path ) = @_;          my ( $path ) = @_;
60          my $file = "_attachemnts/$path";          my $file = "_attachemnts/$path";
61          create_path $file;          create_path $file;
62          $ua->mirror( "$url/$path", $file );          $ua->mirror( "$couchdb/$database/_design/$design/$path", $file );
63          print "detached $file ", -s $file, " bytes\n";          print "detached $file ", -s $file, " bytes\n";
64          svn $file;          svn $file;
65  }  }
# Line 99  sub unroll { Line 95  sub unroll {
95    
96  }  }
97    
98  if ( $command eq 'pull' ) {  sub pull_design {
99            $design = shift;
100    
101            my $url = "$couchdb/$database/_design/$design";
102    
103          warn "# get $url\n";          warn "# get $url\n";
104          my $response = $ua->get( $url );          my $response = $ua->get( $url );
# Line 110  if ( $command eq 'pull' ) { Line 109  if ( $command eq 'pull' ) {
109    
110          unroll( from_json $json, '' );          unroll( from_json $json, '' );
111    
112  } elsif ( $command eq 'push' ) {  }
113    
114    sub push_database_design {
115            $design = shift;
116    
117          $ua->request( HTTP::Request::Common::PUT( "http://localhost:5984/$database" ) ) && warn "# created database $database\n";          $ua->request( HTTP::Request::Common::PUT( "http://localhost:5984/$database" ) ) && warn "# created database $database\n";
118    
# Line 161  warn "## $path\n"; Line 163  warn "## $path\n";
163          print "push $database/_design/$design\n";          print "push $database/_design/$design\n";
164          write_file "../$database-$design.push.js", to_json $json;          write_file "../$database-$design.push.js", to_json $json;
165    
166            my $url = "$couchdb/$database/_design/$design";
167          warn "# put $url\n";          warn "# put $url\n";
168          my $response = $ua->request(          my $response = $ua->request(
169                  HTTP::Request::Common::PUT(                  HTTP::Request::Common::PUT(
# Line 185  warn "## $path\n"; Line 188  warn "## $path\n";
188                  die $response->status_line if $response->is_error;                  die $response->status_line if $response->is_error;
189                  warn "push new $url\n";                  warn "push new $url\n";
190          }          }
191    }
192    
193    
194    # XXX main
195    
196    
197    if ( $command eq 'push' ) {
198    
199            my @designs = map { (split(m{/},2))[0] } @{ glob '*/views' };
200            @designs = ( $design ) if $design;
201    
202    warn "XX ",dump( @designs );
203    
204            foreach my $design ( @designs ) {
205    
206                    chdir $design;
207                    push_design( $design );
208                    chdir '..';
209    
210            }
211    
212    } elsif ( $command eq 'pull' ) {
213    
214            my $designs = from_json $ua->get( "$couchdb/$database/_all_docs?startkey=%22_design%2F%22&endkey=%22_design0%22" )->decoded_content;
215            my @designs =
216                    map {
217                            my $name = $_->{id};
218                            $name =~ s{^_design/}{};
219                            $name;
220                    } @{ $designs->{rows} }
221            ;
222    
223            warn "# $database/_design ",dump( @designs );
224    
225            @designs = ( $design ) if $design;
226    
227            foreach my $design ( @designs ) {
228    
229                    mkdir $design unless -e $design;
230                    chdir $design;
231                    pull_design( $design );
232                    chdir '..';
233    
234            }
235    
236  } else {  } else {
237          die "$0: unknown command $command";          die "$0: unknown command $command";

Legend:
Removed from v.373  
changed lines
  Added in v.374

  ViewVC Help
Powered by ViewVC 1.1.26