lib/Frey/CouchAPI.pm

package Frey::CouchAPI;

use JSON;
use Data::Dump qw/dump/;
use URI::Escape;

sub rewrite_urls {
        my ( $self, $tx ) = @_;
        if ( $tx->req->url->path =~ m{/_utils/} ) {
                my $path = $tx->req->url->path;
                $path =~ s{(/_utils)/?$}{$1/index.html}; # poor man's DirectoryIndex
                $path =~  s{/_utils}{/static/futon};
                $tx->req->url->path( $path );
                my $url = $tx->req->url->to_string;
                my $old = $url;
                $url = $tx->req->url->to_string;
                warn "# rewrite $old -> $url\n";
        }
}

my $path = '/data/webpac2/var/row';
my @all_dbs = map {
        s{^\Q$path\E/*}{};
        $_;
} glob "$path/*/*";

my $regex_dbs = join('|', @all_dbs);

sub dispatch {
        my ($self,$tx) = @_;

        my $url = $tx->req->url->to_string;
        $url = uri_unescape( $url );

        warn "INFO: using Apache CouchDB emulation API $url\n";

        warn "## tx = ",dump( $tx );

        my $json = {};

        if ( $url eq '/' ) {
                $json = {
                        couchdb => "Emulated on Frey",
                        version => 0,
                }
        } elsif ( $url eq '/_all_dbs' ) {
                $json = [ @all_dbs ];
        } elsif ( $url =~ m{($regex_dbs)} ) {
                warn "# collecting docs from $path/$1/*\n";
                my @docs = glob "$path/$1/*";
                $json = {
                        db_name => $1,
                        doc_count => $#docs + 1,
                        doc_del_count => 0,
                        update_seq => 0,
                        purge_seq => 0,
                        capacity_running => JSON::false,
                        disk_size => 0,
                        instance_start_time => time(),
                };

                warn "## calculating disk_size\n";
                $json->{disk_size} += -s "$path/$1/$_" foreach $docs;
        }

        $tx->res->code( 200 );
        $tx->res->headers->content_type( 'text/json' );
        $tx->res->body( to_json $json );
        return $tx;

}

1;
1	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;