/[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 248 by dpavlin, Tue Aug 18 12:18:39 2009 UTC revision 388 by dpavlin, Mon Sep 7 10:30:19 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  chdir $design || die "can't find $design: $!";  our ( $command, $database, $design ) = @ARGV;
27    
28    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 38  sub create_path { Line 39  sub create_path {
39                  #warn "# dir $dir";                  #warn "# dir $dir";
40          }          }
41  }  }
42    
43    sub svn {
44            my $path = shift;
45            return if $path =~ m{(_.*|.*\.(push|pull)\.js)$};
46            system "svn add --parents $path";
47    }
48    
49  sub write_file {  sub write_file {
50          my ( $path, $content ) = @_;          my ( $path, $content ) = @_;
51          $path =~ s{^/+}{};          $path =~ s{^/+}{};
52          create_path $path;          create_path $path;
53          File::Slurp::write_file $path, $content;          File::Slurp::write_file $path, $content;
54          print "$path ", -s $path, " bytes created\n";          print "$path ", -s $path, " bytes created\n";
55            svn $path;
56  }  }
57    
58  sub write_attachment {  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;
65  }  }
66    
67    
# Line 85  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 96  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_design {
115            $design = shift;
116    
117            $ua->request( HTTP::Request::Common::PUT( "http://localhost:5984/$database" ) ) && warn "# created database $database\n";
118    
119          my $json;          my $json;
120    
121          find({ no_chdir => 1, wanted => sub {          find({ no_chdir => 1, wanted => sub {
122                  my $path = $File::Find::name;                  my $path = $File::Find::name;
123                  return unless -f $path;                  return unless -f $path;
124                    return if $path =~ m{/\.svn};
125    
126  warn "## $path\n";  warn "## $path\n";
127    
# Line 144  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 168  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 { s{/.+$}{}; $_ } glob '*/views';
200            @designs = ( $design ) if $design;
201    
202            foreach my $design ( @designs ) {
203    
204                    chdir $design;
205                    push_design( $design );
206                    chdir '..';
207    
208            }
209    
210    } elsif ( $command eq 'pull' ) {
211    
212            my $designs = from_json $ua->get( "$couchdb/$database/_all_docs?startkey=%22_design%2F%22&endkey=%22_design0%22" )->decoded_content;
213            my @designs =
214                    map {
215                            my $name = $_->{id};
216                            $name =~ s{^_design/}{};
217                            $name;
218                    } @{ $designs->{rows} }
219            ;
220    
221            warn "# $database/_design ",dump( @designs );
222    
223            @designs = ( $design ) if $design;
224    
225            foreach my $design ( @designs ) {
226    
227                    mkdir $design unless -e $design;
228                    chdir $design;
229                    pull_design( $design );
230                    chdir '..';
231    
232            }
233    
234  } else {  } else {
235          die "$0: unknown command $command";          die "$0: unknown command $command";

Legend:
Removed from v.248  
changed lines
  Added in v.388

  ViewVC Help
Powered by ViewVC 1.1.26