/[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 31 by dpavlin, Sun Apr 26 21:37:40 2009 UTC revision 32 by dpavlin, Sun Apr 26 22:33:20 2009 UTC
# Line 25  my $response = $ua->get( $url ); Line 25  my $response = $ua->get( $url );
25    
26  die $response->status_line if $response->is_error;  die $response->status_line if $response->is_error;
27    
28  sub write_file {  sub create_path {
29          my ( $path, $content ) = @_;          my $path = shift;
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          }          }
36    }
37    sub write_file {
38            my ( $path, $content ) = @_;
39            $path =~ s{^/+}{};
40            create_path $path;
41          File::Slurp::write_file $path, $content;          File::Slurp::write_file $path, $content;
42          #warn "# write_file $path ", -s $path, " bytes\n";          print "$path ", -s $path, " bytes\n";
43    }
44    
45    sub write_attachment {
46            my ( $path ) = @_;
47            my $file = "_attachemnts/$path";
48            create_path $file;
49            $ua->mirror( "$url/$path", $file );
50            print "detached $file ", -s $file, " bytes\n";
51  }  }
52    
53  sub unroll {  sub unroll {
# Line 42  sub unroll { Line 55  sub unroll {
55    
56          my $ref = ref $tree;          my $ref = ref $tree;
57          if ( $ref eq 'HASH' ) {          if ( $ref eq 'HASH' ) {
58                  unroll( $tree->{$_}, "$path/$_" ) foreach ( keys %$tree );                  foreach my $child ( keys %$tree ) {
59                            if ( $child eq '_attachments' ) {
60                                    write_attachment $_ foreach keys %{ $tree->{$child} };
61                            } else {
62                                    unroll( $tree->{$child}, "$path/$child" );
63                            }
64                    }
65            } elsif ( $ref ) {
66                    warn "UNSUPPORTED $path $ref ", dump( $tree );
67                    write_file "$path.json", to_json $tree;
68          } elsif ( $ref eq '' ) {          } elsif ( $ref eq '' ) {
                 $path =~ s{^/+}{};  
69    
70                  if ( $tree =~ m{^\s*function}i ) {                  if ( $tree =~ m[^\s*(function(.*){.*}|/\*|var)]is ) {
71                          $path .= '.js';                          $path .= '.js';
72                  } elsif ( $tree =~ m{<\w+>} ) {                  } elsif ( $tree =~ m{<%=.*%>} ) { # couchapp template
73                          $path .= '.html';                          $path .= '.html';
74                    } else {
75                            warn "can't detect type of $path!";
76                  }                  }
77    
78                  write_file $path, $tree;                  write_file $path, $tree;
                 print "$path ", -s $path, " bytes\n";  
79          }          }
80    
81  }  }
# Line 61  sub unroll { Line 83  sub unroll {
83  my $json = $response->decoded_content;  my $json = $response->decoded_content;
84  write_file "../$database-$design.js", $json;  write_file "../$database-$design.js", $json;
85    
86  unroll( from_json $json, '/' );  unroll( from_json $json, '' );
87    
Legend:
Removed from v.31  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.26