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 |
# |
# |
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"; |