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

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

revision 1053 by dpavlin, Thu Apr 23 20:24:48 2009 UTC revision 1059 by dpavlin, Fri Apr 24 15:32:04 2009 UTC
# Line 60  our $status; Line 60  our $status;
60  sub ok {  sub ok {
61          $json = { ok => JSON::true };          $json = { ok => JSON::true };
62          $status = 200;          $status = 200;
63          warn "ok\n";          warn "ok from ",join(' ',caller),$/;
64  }  }
65    
66    sub file_rev { (stat($_[0]))[9] } # mtime
67    
68  sub dispatch {  sub dispatch {
69          my ($self,$tx) = @_;          my ($self,$tx) = @_;
# Line 72  sub dispatch { Line 73  sub dispatch {
73          my $url = $tx->req->url->to_string;          my $url = $tx->req->url->to_string;
74          $url = uri_unescape( $url );          $url = uri_unescape( $url );
75          my $method = $tx->req->method;          my $method = $tx->req->method;
76            my $path = $config->{path};
77                    
78          if ( $url eq '/' ) {          if ( $url eq '/' ) {
79                  $json = {                  $json = {
# Line 116  warn "json ",dump( $json ), " config ", Line 118  warn "json ",dump( $json ), " config ",
118                          $status = 501;                          $status = 501;
119                  }                  }
120    
         } elsif ( $url =~ m{($regex_dbs)/$} ) {  
   
121  =head2 Database  =head2 Database
122    
123  L<http://wiki.apache.org/couchdb/HTTP_database_API> except compaction  L<http://wiki.apache.org/couchdb/HTTP_database_API> except compaction
124    
125  =cut  =cut
126    
127            } elsif (
128                       $url =~ m{($regex_dbs)/$}
129                    # DELETE doesn't have trailing slash
130                    || $method eq 'DELETE' && $url =~ m{($regex_dbs)$}
131            ) {
132    
133                  my $database = $1;                  my $database = $1;
134                  my $dir = "$config->{path}/$database";  
135                    my $dir = "$path/$database";
136    
137                  if ( $method eq 'GET' ) {                  if ( $method eq 'GET' ) {
138                          $json = database_get( $database );                          $json = database_get( $database );
# Line 133  L<http://wiki.apache.org/couchdb/HTTP_da Line 140  L<http://wiki.apache.org/couchdb/HTTP_da
140                          if ( ! -e $dir ) {                          if ( ! -e $dir ) {
141                                  $status = 404;                                  $status = 404;
142                          } else {                          } else {
143                                  remove_tree($dir) && ok || { $status = 500 };                                  remove_tree($dir);
144                                    if ( ! -d $dir ) {
145                                            ok;
146                                    } else {
147                                            $status = 500;
148                                    }
149                          }                          }
150                  } elsif ( $method eq 'PUT' ) {                  } elsif ( $method eq 'PUT' ) {
151                          if ( ! -e $dir ) {                          if ( -e $dir ) {
                                 make_path($dir) && ok && warn "created $dir" || { $status = 500 };  
                         } else {  
152                                  $status = 412;                                  $status = 412;
153                            } else {
154                                    make_path($dir);
155                                    if ( -e $path ) {
156                                            ok;
157                                            $status = 201;
158                                    } else {
159                                            $status = 500;
160                                    }
161                          }                          }
162                  }                  }
163    
164                    warn "## database $database $status ",dump( $json );
165    
166          } elsif ( $url =~ m{($regex_dbs)/([^?]+)\??(.+)?$} ) {          } elsif ( $url =~ m{($regex_dbs)/([^?]+)\??(.+)?$} ) {
167                  my ($database,$id,$args) = ($1,$2,$3);                  my ($database,$id,$args) = ($1,$2,$3);
168    
# Line 161  L<http://wiki.apache.org/couchdb/HTTP_Do Line 181  L<http://wiki.apache.org/couchdb/HTTP_Do
181                          }                          }
182                  }                  }
183    
                 my $path = $config->{path};  
184                  warn "ERROR: path $path doesn't exist\n" unless -e $path;                  warn "ERROR: path $path doesn't exist\n" unless -e $path;
185    
186                  my $p = "$path/$database/$id";                  my $p = "$path/$database/$id";
187                  warn "## database: $database id: $id -> $p ", dump( $arg ),"\n";                  warn "## database: $database id: $id -> $p ", dump( $arg ),"\n";
188    
189    
190                  if ( $id =~ m{_all_docs(\w+)?$} ) {                  if ( $id =~ m{_all_docs(\w*)$} ) {
191    
192                          my $by = $1;                          my $by = $1;
193                          my $offset = 0;                          my $offset = 0;
# Line 178  L<http://wiki.apache.org/couchdb/HTTP_Do Line 197  L<http://wiki.apache.org/couchdb/HTTP_Do
197                          my $total_rows = 0;                          my $total_rows = 0;
198    
199                          my @docs = grep { length $_ } map {                          my @docs = grep { length $_ } map {
200                                  return '' if defined $limit && $total_rows == $limit;  
201                                    if ( $limit > 0 && $total_rows == $limit ) {
202                                            '';
203                                    } else {
204                    
205                                  s{^$path/$database/}{};                                          s{^$path/$database/}{};
                                 return '' if defined $endkey && $_ gt $endkey;  
206    
207                                  if ( $startkey ) {                                          if ( defined $endkey && $_ gt $endkey ) {
208                                          if ( $_ ge $startkey ) {                                                  '';
209                                            } elsif ( $startkey ) {
210                                                    if ( $_ ge $startkey ) {
211                                                            $total_rows++;
212                                                            $_;
213                                                    } else {
214                                                            $offset++;
215                                                            '';
216                                                    }
217                                            } else {
218                                                  $total_rows++;                                                  $total_rows++;
219                                                  $_;                                                  $_;
                                         } else {  
                                                 $offset++;  
                                                 return '';  
220                                          }                                          }
                                 } else {  
                                         $total_rows++;  
                                         $_;  
221                                  }                                  }
222    
223                          } glob( "$path/$database/*" );                          } glob( "$path/$database/*" );
224    
225    
226                          warn "## docs $startkey -> $endkey limit $limit ", dump( @docs ); # if $debug;                          warn "## docs $startkey -> $endkey limit $limit ", dump( @docs ); # if $debug;
227    
228                          $json = {                          $json = {
# Line 222  L<http://wiki.apache.org/couchdb/HTTP_Do Line 247  L<http://wiki.apache.org/couchdb/HTTP_Do
247                                          id => $id,                                          id => $id,
248                                          key => $id,                                          key => $id,
249                                          value => {                                          value => {
250                                                  rev => (stat($p))[9], # mtime                                                  rev => file_rev $p,
251                                          }                                          }
252                                  };                                  };
253                          }                          }
# Line 237  L<http://wiki.apache.org/couchdb/HTTP_Do Line 262  L<http://wiki.apache.org/couchdb/HTTP_Do
262                                  push @{ $json->{rows} }, $rows->{$id};                                  push @{ $json->{rows} }, $rows->{$id};
263                          }                          }
264    
265                            $status = 200;
266    
267                  } elsif ( $method eq 'PUT' ) {                  } elsif ( $method eq 'PUT' ) {
268                    
269                          warn "## ",dump( $tx->req ) if $debug;                          warn "## ",dump( $tx->req ) if $debug;
270    
271                          my $data = $tx->req->content->file->slurp;                          my $data = $tx->req->content->file->slurp;
272    
273                            my $db_path = "$path/$database";
274                            make_path $db_path unless -e $db_path;
275    
276                          Storable::store( from_json($data), $p );                          Storable::store( from_json($data), $p );
277                          warn "store $p ", -s $p, " bytes: $data\n";                          my $rev = file_rev $p;
278                            warn "store $p $rev size ", -s $p, " bytes | $data\n";
279    
280                          $status = 201; # Created                          $status = 201; # Created
281                                    $json = {
282                                    id => $id,
283                                    ok => JSON::true,
284                                    rev => $rev,
285                            };
286    
287                  } elsif ( $method eq 'GET' ) {                  } elsif ( $method eq 'GET' ) {
288                          if ( ! -e $p ) {                          if ( ! -e $p ) {
289                                  $status = 404;                                  $status = 404;
290                          } else {                          } else {
291                                  warn "retrive $p ", -s $p, " bytes\n";                                  warn "retrive $p ", -s $p, " bytes\n";
292                                  $json = Storable::retrieve( $p );                                  $json = Storable::retrieve( $p );
293                                    if ( delete $arg->{revs_info} ) {
294                                            my $rev = file_rev $p;
295                                            $json->{_rev} = $rev;
296                                            $json->{_revs_info} = [
297                                                    { rev => $rev, status => 'available' }
298                                            ];
299                                    }
300                                    $status = 200;
301    
302                          }                          }
303                  } elsif ( $method eq 'DELETE' ) {                  } elsif ( $method eq 'DELETE' ) {
304                          if ( -e $p ) {                          if ( -e $p ) {
305                                  unlink $p || { $status = 500 };                                  unlink $p && ok || { $status = 500 };
306                          } else {                          } else {
307                                  $status = 404;                                  $status = 404;
308                          }                          }
309                    } elsif ( $method eq 'POST' ) {
310                            $json = { total_rows => 0, offset => 0 };
311                            $status = 202; # FIXME implement real view server and return 200
312                  } else {                  } else {
313                          $status = 501;                          $status = 501;
314                  }                  }
315    
316                  warn "WARNING: arg left from $url = ",dump( $arg ),$/ if keys %$arg;                  if ( keys %$arg ) {
317                            warn "WARNING: arg left from $url = ",dump( $arg ),$/;
318                            $status = 501;
319                    }
320    
321          }          }
322    
# Line 281  L<http://wiki.apache.org/couchdb/HTTP_Do Line 333  L<http://wiki.apache.org/couchdb/HTTP_Do
333          $tx->res->headers->add_line( 'Cache-Control' => 'must-revalidate' );          $tx->res->headers->add_line( 'Cache-Control' => 'must-revalidate' );
334          $tx->res->headers->add_line( 'Server' => "Frey::CouchAPI/$VERSION" );          $tx->res->headers->add_line( 'Server' => "Frey::CouchAPI/$VERSION" );
335    
336          warn "INFO CouchDB API $method $url $status\n$body\n";          print "$method $url $status\n$body\n";
337    
338          warn "## headers ", $tx->res->headers->to_string;          warn "## headers ", $tx->res->headers->to_string;
339    
Legend:
Removed from v.1053  
changed lines
  Added in v.1059
  ViewVC Help
Powered by ViewVC 1.1.26