13 |
# |
# |
14 |
# 04/26/09 21:12:28 CEST Dobrica Pavlinusic <dpavlin@rot13.org> |
# 04/26/09 21:12:28 CEST Dobrica Pavlinusic <dpavlin@rot13.org> |
15 |
|
|
16 |
|
my ( $database, $design ) = @ARGV; |
17 |
|
die "usage: $0 database design\n" unless $database && $design; |
18 |
|
|
19 |
my $ua = LWP::UserAgent->new; |
my $ua = LWP::UserAgent->new; |
20 |
|
|
21 |
my $url = 'http://llin.lan:5984/blog/_design/sofa'; |
my $url = "http://llin.lan:5984/$database/_design/$design"; |
22 |
|
|
23 |
|
warn "# get $url\n"; |
24 |
my $response = $ua->get( $url ); |
my $response = $ua->get( $url ); |
25 |
|
|
26 |
die $response->status_line if $response->is_error; |
die $response->status_line if $response->is_error; |
27 |
|
|
|
my $design = from_json $response->decoded_content; |
|
|
|
|
|
my $path; |
|
|
|
|
28 |
sub write_file { |
sub write_file { |
29 |
my ( $path, $content ) = @_; |
my ( $path, $content ) = @_; |
30 |
if ( $path =~ m{/} ) { |
if ( $path =~ m{/} ) { |
31 |
my $dir = $path; |
my $dir = $path; |
32 |
$dir =~ s{/[^/]+$}{}; |
$dir =~ s{/[^/]+$}{}; |
33 |
mkpath $dir if ! -e $dir; |
mkpath $dir if ! -e $dir; |
34 |
warn "# dir $dir"; |
#warn "# dir $dir"; |
35 |
} |
} |
|
warn "# write_file $path $content"; |
|
36 |
File::Slurp::write_file $path, $content; |
File::Slurp::write_file $path, $content; |
37 |
|
#warn "# write_file $path ", -s $path, " bytes\n"; |
38 |
} |
} |
39 |
|
|
40 |
sub unroll { |
sub unroll { |
60 |
|
|
61 |
} |
} |
62 |
|
|
63 |
unroll( $design, '/' ); |
my $json = $response->decoded_content; |
64 |
|
write_file 'design.js', $json; |
65 |
|
|
66 |
|
unroll( from_json $json, '/' ); |
67 |
|
|