/[Frey]/trunk/lib/Frey/CouchAPI.pm
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 /trunk/lib/Frey/CouchAPI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1046 by dpavlin, Wed Apr 22 22:01:06 2009 UTC revision 1047 by dpavlin, Wed Apr 22 23:38:10 2009 UTC
# Line 3  package Frey::CouchAPI; Line 3  package Frey::CouchAPI;
3  use JSON;  use JSON;
4  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
5  use URI::Escape;  use URI::Escape;
6    use File::Path qw(make_path remove_tree);
7    use Storable;
8    
9  sub rewrite_urls {  sub rewrite_urls {
10          my ( $self, $tx ) = @_;          my ( $self, $tx ) = @_;
# Line 24  my @all_dbs = map { Line 26  my @all_dbs = map {
26          $_;          $_;
27  } glob "$path/*/*";  } glob "$path/*/*";
28    
29  my $regex_dbs = join('|', @all_dbs);  my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
30    
31    our $json = {};
32    our $stauts = 500;
33    
34    sub ok {
35            $json = { ok => JSON::true };
36            $status = 200;
37    }
38    
39  sub dispatch {  sub dispatch {
40          my ($self,$tx) = @_;          my ($self,$tx) = @_;
41    
42          my $url = $tx->req->url->to_string;          my $url = $tx->req->url->to_string;
43          $url = uri_unescape( $url );          $url = uri_unescape( $url );
44            my $method = $tx->req->method;
45    
46          warn "INFO: using Apache CouchDB emulation API $url\n";          warn "INFO: using Apache CouchDB emulation API\n";
   
         warn "## tx = ",dump( $tx );  
   
         my $json = {};  
47    
48          if ( $url eq '/' ) {          if ( $url eq '/' ) {
49                  $json = {                  $json = {
50                          couchdb => "Emulated on Frey",                          couchdb => "Welcome",
51                          version => 0,                          version => "0-Frey",
52                  }                  }
53          } elsif ( $url eq '/_all_dbs' ) {          } elsif ( $url eq '/_all_dbs' ) {
54                  $json = [ @all_dbs ];                  $json = [ @all_dbs ];
55          } elsif ( $url =~ m{($regex_dbs)} ) {                  $status = 200;
56                  warn "# collecting docs from $path/$1/*\n";          } elsif ( $url =~ m{($regex_dbs)/$} ) {
57                  my @docs = glob "$path/$1/*";  
58                  $json = {                  my $database = $1;
59                          db_name => $1,                  my $dir = "$path/$database";
60                          doc_count => $#docs + 1,  
61                          doc_del_count => 0,                  if ( $method eq 'GET' ) {
62                          update_seq => 0,                          $json = database_get( $database );
63                          purge_seq => 0,                  } elsif ( $method eq 'DELETE' ) {
64                          capacity_running => JSON::false,                          if ( ! -e $dir ) {
65                          disk_size => 0,                                  $status = 404;
66                          instance_start_time => time(),                          } else {
67                  };                                  remove_tree($dir) && ok || { $status = 501 };
68                            }
69                    } elsif ( $method eq 'PUT' ) {
70                            if ( ! -e $dir ) {
71                                    make_path($dir) && ok && warn "created $dir" || { $status = 501 };
72                            } else {
73                                    $status = 412;
74                            }
75                    }
76    
77            } elsif ( $url =~ m{($regex_dbs)/(.+)$} ) {
78                    my ($database,$id) = ($1,$2);
79            
80                    my $p = "$path/$database/$id";
81                    warn "## database: $database id: $id -> $p ";
82    
83                    if ( $id eq '_all_docs' ) {
84    
85                            my @docs = map {
86                                    s{^$path/$database/}{};
87                                    $_;
88                            } glob( "$path/$database/*" );
89    
90                            warn "## docs ", dump( @docs );
91    
92                            $json = {
93                                    total_rows =>  $#docs + 1,
94                                    offset => 0,
95                                    rows => [],
96                            };
97    
98                            foreach my $id ( @docs ) {
99                                    warn "++ $id\n";
100                                    my $p = "$path/$database/$id";
101                                    my $data = Storable::retrieve( $p );
102                                    push @{ $json->{rows} }, {
103                                            id => $id,
104                                            key => $id,
105                                            value => {
106                                                    rev => (stat($p))[9], # mtime
107                                            }
108                                    };
109                            }
110    
111                    } elsif ( $method eq 'PUT' ) {
112            
113                            warn "## ",dump( $tx->req );
114    
115                            my $data = $tx->req->content->file->slurp;
116    
117                            Storable::store( from_json($data), $p );
118                            warn "store $p ", -s $p, " bytes: $data\n";
119                    } elsif ( $method eq 'GET' ) {
120                            warn "retrive $p ", -s $p, " bytes\n";
121                            $json = Storable::retrieve( $p );
122                    } else {
123                            $status = 501;
124                    }
125    
                 warn "## calculating disk_size\n";  
                 $json->{disk_size} += -s "$path/$1/$_" foreach $docs;  
126          }          }
127    
128          $tx->res->code( 200 );          if ( $status >= 400 && $status < 500 && ! defined $json) {
129                    $json = { error => 'not_found', reason => 'Missing' };
130                    warn "fake $status";
131            }
132    
133            $tx->res->code( $status );
134          $tx->res->headers->content_type( 'text/json' );          $tx->res->headers->content_type( 'text/json' );
135          $tx->res->body( to_json $json );          my $body = to_json $json;
136            $tx->res->body( $body );
137            warn "CouchDB API: $method $url $status $body\n";
138          return $tx;          return $tx;
139    
140  }  }
141    
142    sub database_get {
143            my ($db_name) = @_;
144            warn "# collecting docs from $path/$db_name/*\n";
145            my @docs = glob "$path/$db_name/*";
146            my $json = {
147                    db_name => $db_name,
148                    doc_count => $#docs + 1,
149                    doc_del_count => 0,
150                    update_seq => 0,
151                    purge_seq => 0,
152                    capacity_running => JSON::false,
153                    disk_size => 0,
154                    instance_start_time => time(),
155            };
156    
157            warn "## calculating disk_size\n";
158            $json->{disk_size} += -s "$path/$1/$_" foreach $docs;
159            $status = 200;
160            return $json;
161    }
162    
163  1;  1;
Legend:
Removed from v.1046  
changed lines
  Added in v.1047
  ViewVC Help
Powered by ViewVC 1.1.26