/[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 32 by dpavlin, Sun Apr 26 22:33:20 2009 UTC revision 33 by dpavlin, Tue Apr 28 12:40:19 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;  my ( $command, $database, $design ) = @ARGV;
17  die "usage: $0 database design\n" unless $database && $design;  die "usage: $0 [push|pull] 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/$database/_design/$design";  my $url = "http://llin.lan:5984/$database/_design/$design";
22    
 warn "# get $url\n";  
 my $response = $ua->get( $url );  
   
 die $response->status_line if $response->is_error;  
   
23  sub create_path {  sub create_path {
24          my $path = shift;          my $path = shift;
25          if ( $path =~ m{/} ) {          if ( $path =~ m{/} ) {
# Line 59  sub unroll { Line 54  sub unroll {
54                          if ( $child eq '_attachments' ) {                          if ( $child eq '_attachments' ) {
55                                  write_attachment $_ foreach keys %{ $tree->{$child} };                                  write_attachment $_ foreach keys %{ $tree->{$child} };
56                          } else {                          } else {
57                                  unroll( $tree->{$child}, "$path/$child" );                                  unroll( $tree->{$child}, $path ? "$path/$child" : $child );
58                          }                          }
59                  }                  }
60          } elsif ( $ref ) {          } elsif ( $ref ) {
# Line 67  sub unroll { Line 62  sub unroll {
62                  write_file "$path.json", to_json $tree;                  write_file "$path.json", to_json $tree;
63          } elsif ( $ref eq '' ) {          } elsif ( $ref eq '' ) {
64    
65                  if ( $tree =~ m[^\s*(function(.*){.*}|/\*|var)]is ) {                  if ( $tree =~ m[^\s*(function(.*){.*}|/\*|//|var)]is ) {
66                          $path .= '.js';                          $path .= '.js';
67                  } elsif ( $tree =~ m{<%=.*%>} ) { # couchapp template                  } elsif ( $tree =~ m{<%=.*%>} ) { # couchapp template
68                          $path .= '.html';                          $path .= '.html';
69                  } else {                  } else {
70                          warn "can't detect type of $path!";                          warn "# can't detect type of $path\n";
71                  }                  }
72    
73                  write_file $path, $tree;                  write_file $path, $tree;
# Line 80  sub unroll { Line 75  sub unroll {
75    
76  }  }
77    
78  my $json = $response->decoded_content;  if ( $command eq 'pull' ) {
79  write_file "../$database-$design.js", $json;  
80            warn "# get $url\n";
81            my $response = $ua->get( $url );
82    
83            die $response->status_line if $response->is_error;
84    
85            my $json = $response->decoded_content;
86            write_file "../$database-$design.js", $json;
87    
88  unroll( from_json $json, '' );          unroll( from_json $json, '' );
89    
90    } elsif ( $command eq 'push' ) {
91    
92    
93    
94    } else {
95            die "$0: unknown command $command";
96    }
97    
Legend:
Removed from v.32  
changed lines
  Added in v.33
  ViewVC Help
Powered by ViewVC 1.1.26