/[couchdb]/design/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 /design/design-couch.pl

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

revision 33 by dpavlin, Tue Apr 28 12:40:19 2009 UTC revision 34 by dpavlin, Tue Apr 28 15:06:02 2009 UTC
# Line 8  use JSON; Line 8  use JSON;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use File::Path qw/mkpath/;  use File::Path qw/mkpath/;
10  use File::Slurp qw//;  use File::Slurp qw//;
11    use File::Find;
12    use HTTP::Request::Common;
13    
14  # design-couch.pl  # design-couch.pl
15  #  #
# Line 79  if ( $command eq 'pull' ) { Line 81  if ( $command eq 'pull' ) {
81    
82          warn "# get $url\n";          warn "# get $url\n";
83          my $response = $ua->get( $url );          my $response = $ua->get( $url );
   
84          die $response->status_line if $response->is_error;          die $response->status_line if $response->is_error;
85    
86          my $json = $response->decoded_content;          my $json = $response->decoded_content;
87          write_file "../$database-$design.js", $json;          write_file "../$database-$design.pull.js", $json;
88    
89          unroll( from_json $json, '' );          unroll( from_json $json, '' );
90    
91  } elsif ( $command eq 'push' ) {  } elsif ( $command eq 'push' ) {
92    
93            my $json;
94    
95            my @attached;
96    
97            find({ no_chdir => 1, wanted => sub {
98                    my $path = $File::Find::name;
99                    return unless -f $path;
100    
101    warn "## $path\n";
102    
103                    $path =~ s{^\./}{};
104    
105                    if ( $path =~ m{_attachemnts} ) {
106                            push @attached, $path;
107                            return;
108                    }
109    
110                    my $data = File::Slurp::read_file( $path );
111                    $path =~ s[/]['}->{']g;
112                    $path =~ s{\.\w+$}{};
113                    my $code = "\$json->{'$path'} = \$data;";
114                    eval $code;
115                    die "ERROR in $code: $@" if $@;
116    #               warn "## json = ",dump( $json );
117            }}, '.' );
118    
119            warn "# $database/_design/$design = ",dump( $json );
120            write_file "../$database-$design.push.js", to_json $json;
121    
122            die "no _id?" unless $json->{_id};
123            delete( $json->{_rev} );
124    
125            warn "# put $url\n";
126            my $response = $ua->request( HTTP::Request::Common::PUT($url, 'Content-Type' => 'application/json', Content => to_json $json ) );
127    
128            if ( $response->code == 409 ) {
129                    warn "## get old $url\n";
130                    my $response = $ua->get( $url );
131                    die $response->status_line if $response->is_error;
132    
133                    my $data = from_json $response;
134                    $json->{$_} = $data->{$_} foreach ( 'rev', '_id' );
135    
136                    $response = $ua->request( HTTP::Request::Common::PUT($url, 'Content-Type' => 'application/json', Content => to_json $json ) );
137                    die $response->status_line if $response->is_error;
138                    warn "push updated $url\n";
139            } else {
140                    die $response->status_line if $response->is_error;
141                    warn "push new $url\n";
142            }
143    
144            warn "FIXME: ignore attachments: ",dump( @attached );
145    
146  } else {  } else {
147          die "$0: unknown command $command";          die "$0: unknown command $command";
Legend:
Removed from v.33  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.26