1 |
dpavlin |
1046 |
package Frey::CouchAPI; |
2 |
|
|
|
3 |
|
|
use JSON; |
4 |
|
|
use Data::Dump qw/dump/; |
5 |
|
|
use URI::Escape; |
6 |
|
|
|
7 |
|
|
sub rewrite_urls { |
8 |
|
|
my ( $self, $tx ) = @_; |
9 |
|
|
if ( $tx->req->url->path =~ m{/_utils/} ) { |
10 |
|
|
my $path = $tx->req->url->path; |
11 |
|
|
$path =~ s{(/_utils)/?$}{$1/index.html}; # poor man's DirectoryIndex |
12 |
|
|
$path =~ s{/_utils}{/static/futon}; |
13 |
|
|
$tx->req->url->path( $path ); |
14 |
|
|
my $url = $tx->req->url->to_string; |
15 |
|
|
my $old = $url; |
16 |
|
|
$url = $tx->req->url->to_string; |
17 |
|
|
warn "# rewrite $old -> $url\n"; |
18 |
|
|
} |
19 |
|
|
} |
20 |
|
|
|
21 |
|
|
my $path = '/data/webpac2/var/row'; |
22 |
|
|
my @all_dbs = map { |
23 |
|
|
s{^\Q$path\E/*}{}; |
24 |
|
|
$_; |
25 |
|
|
} glob "$path/*/*"; |
26 |
|
|
|
27 |
|
|
my $regex_dbs = join('|', @all_dbs); |
28 |
|
|
|
29 |
|
|
sub dispatch { |
30 |
|
|
my ($self,$tx) = @_; |
31 |
|
|
|
32 |
|
|
my $url = $tx->req->url->to_string; |
33 |
|
|
$url = uri_unescape( $url ); |
34 |
|
|
|
35 |
|
|
warn "INFO: using Apache CouchDB emulation API $url\n"; |
36 |
|
|
|
37 |
|
|
warn "## tx = ",dump( $tx ); |
38 |
|
|
|
39 |
|
|
my $json = {}; |
40 |
|
|
|
41 |
|
|
if ( $url eq '/' ) { |
42 |
|
|
$json = { |
43 |
|
|
couchdb => "Emulated on Frey", |
44 |
|
|
version => 0, |
45 |
|
|
} |
46 |
|
|
} elsif ( $url eq '/_all_dbs' ) { |
47 |
|
|
$json = [ @all_dbs ]; |
48 |
|
|
} elsif ( $url =~ m{($regex_dbs)} ) { |
49 |
|
|
warn "# collecting docs from $path/$1/*\n"; |
50 |
|
|
my @docs = glob "$path/$1/*"; |
51 |
|
|
$json = { |
52 |
|
|
db_name => $1, |
53 |
|
|
doc_count => $#docs + 1, |
54 |
|
|
doc_del_count => 0, |
55 |
|
|
update_seq => 0, |
56 |
|
|
purge_seq => 0, |
57 |
|
|
capacity_running => JSON::false, |
58 |
|
|
disk_size => 0, |
59 |
|
|
instance_start_time => time(), |
60 |
|
|
}; |
61 |
|
|
|
62 |
|
|
warn "## calculating disk_size\n"; |
63 |
|
|
$json->{disk_size} += -s "$path/$1/$_" foreach $docs; |
64 |
|
|
} |
65 |
|
|
|
66 |
|
|
$tx->res->code( 200 ); |
67 |
|
|
$tx->res->headers->content_type( 'text/json' ); |
68 |
|
|
$tx->res->body( to_json $json ); |
69 |
|
|
return $tx; |
70 |
|
|
|
71 |
|
|
} |
72 |
|
|
|
73 |
|
|
1; |