/[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 29 by dpavlin, Sun Apr 26 19:45:11 2009 UTC revision 30 by dpavlin, Sun Apr 26 20:18:17 2009 UTC
# Line 13  use File::Slurp qw//; Line 13  use File::Slurp qw//;
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 {
# Line 60  sub unroll { Line 60  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    
Legend:
Removed from v.29  
changed lines
  Added in v.30
  ViewVC Help
Powered by ViewVC 1.1.26