/[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 1051 by dpavlin, Thu Apr 23 19:35:26 2009 UTC revision 1052 by dpavlin, Thu Apr 23 20:12:45 2009 UTC
# Line 2  package Frey::CouchAPI; Line 2  package Frey::CouchAPI;
2    
3  =head1 DESCRIPTION  =head1 DESCRIPTION
4    
5  This is REST wrapper using L<Mojo::Transaction> to implement Apache's CouchDB API  This is REST wrapper using following L<Mojo> implement Apache's CouchDB API
6    
7    
8    L<Mojo::URL>
9    
10    L<Mojo::Transaction>
11    
12    
13  =head1 Supported HTTP API  =head1 Supported HTTP API
14    
# Line 49  my @all_dbs = map { Line 55  my @all_dbs = map {
55  my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';  my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
56    
57  our $json = {};  our $json = {};
58  our $status = 500;  our $status;
59    
60  sub ok {  sub ok {
61          $json = { ok => JSON::true };          $json = { ok => JSON::true };
62          $status = 200;          $status = 200;
63            warn "ok\n";
64  }  }
65    
66    
67  sub dispatch {  sub dispatch {
68          my ($self,$tx) = @_;          my ($self,$tx) = @_;
69    
70            $status = 500; # Internal Error
71    
72          my $url = $tx->req->url->to_string;          my $url = $tx->req->url->to_string;
73          $url = uri_unescape( $url );          $url = uri_unescape( $url );
74          my $method = $tx->req->method;          my $method = $tx->req->method;
# Line 68  sub dispatch { Line 77  sub dispatch {
77                  $json = {                  $json = {
78                          couchdb => "Welcome",                          couchdb => "Welcome",
79                          version => "CouchAPI $VERSION",                          version => "CouchAPI $VERSION",
80                  }                  };
81                    $status = 200;
82          } elsif ( $url eq '/_all_dbs' ) {          } elsif ( $url eq '/_all_dbs' ) {
83                  $json = [ @all_dbs ];                  $json = [ @all_dbs ];
84                  $status = 200;                  $status = 200;
# Line 123  L<http://wiki.apache.org/couchdb/HTTP_da Line 133  L<http://wiki.apache.org/couchdb/HTTP_da
133                          if ( ! -e $dir ) {                          if ( ! -e $dir ) {
134                                  $status = 404;                                  $status = 404;
135                          } else {                          } else {
136                                  remove_tree($dir) && ok || { $status = 501 };                                  remove_tree($dir) && ok || { $status = 500 };
137                          }                          }
138                  } elsif ( $method eq 'PUT' ) {                  } elsif ( $method eq 'PUT' ) {
139                          if ( ! -e $dir ) {                          if ( ! -e $dir ) {
140                                  make_path($dir) && ok && warn "created $dir" || { $status = 501 };                                  make_path($dir) && ok && warn "created $dir" || { $status = 500 };
141                          } else {                          } else {
142                                  $status = 412;                                  $status = 412;
143                          }                          }
# Line 235  L<http://wiki.apache.org/couchdb/HTTP_Do Line 245  L<http://wiki.apache.org/couchdb/HTTP_Do
245    
246                          Storable::store( from_json($data), $p );                          Storable::store( from_json($data), $p );
247                          warn "store $p ", -s $p, " bytes: $data\n";                          warn "store $p ", -s $p, " bytes: $data\n";
248                            $status = 201; # Created
249            
250                  } elsif ( $method eq 'GET' ) {                  } elsif ( $method eq 'GET' ) {
251                          if ( ! -e $p ) {                          if ( ! -e $p ) {
252                                  $status = 404;                                  $status = 404;
# Line 244  L<http://wiki.apache.org/couchdb/HTTP_Do Line 256  L<http://wiki.apache.org/couchdb/HTTP_Do
256                          }                          }
257                  } elsif ( $method eq 'DELETE' ) {                  } elsif ( $method eq 'DELETE' ) {
258                          if ( -e $p ) {                          if ( -e $p ) {
259                                  unlink $p || { $status = 501 };                                  unlink $p || { $status = 500 };
260                          } else {                          } else {
261                                  $status = 404;                                  $status = 404;
262                          }                          }
# Line 256  L<http://wiki.apache.org/couchdb/HTTP_Do Line 268  L<http://wiki.apache.org/couchdb/HTTP_Do
268    
269          }          }
270    
271          if ( $status >= 400 && $status < 500 && ! defined $json) {          $json = { error => 'not_found', reason => 'Missing' } if $status == 404;
272                  $json = { error => 'not_found', reason => 'Missing' };  
273                  warn "fake $status";          if ( $method =~ m{(DELETE|PUT)} ) {
274                    $tx->res->headers->add_line( 'Location' => $tx->req->url->to_abs );
275          }          }
276    
277          $tx->res->code( $status );          $tx->res->code( $status );
# Line 266  L<http://wiki.apache.org/couchdb/HTTP_Do Line 279  L<http://wiki.apache.org/couchdb/HTTP_Do
279          my $body = to_json $json;          my $body = to_json $json;
280          $tx->res->body( $body );          $tx->res->body( $body );
281          warn "CouchDB API: $method $url $status $body\n";          warn "CouchDB API: $method $url $status $body\n";
282    
283            warn "## headers ", $tx->res->headers->to_string;
284    
285          return $tx;          return $tx;
286    
287  }  }
Legend:
Removed from v.1051  
changed lines
  Added in v.1052
  ViewVC Help
Powered by ViewVC 1.1.26