lib/Frey/CouchAPI.pm

package Frey::CouchAPI;

use JSON;
use Data::Dump qw/dump/;
use URI::Escape;
use File::Path qw(make_path remove_tree);
use Storable;

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 = '[a-z][a-z0-9_\$\(\)\+\-/]+';

our $json = {};
our $stauts = 500;

sub ok {
        $json = { ok => JSON::true };
        $status = 200;
}

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

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

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

        if ( $url eq '/' ) {
                $json = {
                        couchdb => "Welcome",
                        version => "0-Frey",
                }
        } elsif ( $url eq '/_all_dbs' ) {
                $json = [ @all_dbs ];
                $status = 200;
        } elsif ( $url =~ m{($regex_dbs)/$} ) {

                my $database = $1;
                my $dir = "$path/$database";

                if ( $method eq 'GET' ) {
                        $json = database_get( $database );
                } elsif ( $method eq 'DELETE' ) {
                        if ( ! -e $dir ) {
                                $status = 404;
                        } else {
                                remove_tree($dir) && ok || { $status = 501 };
                        }
                } elsif ( $method eq 'PUT' ) {
                        if ( ! -e $dir ) {
                                make_path($dir) && ok && warn "created $dir" || { $status = 501 };
                        } else {
                                $status = 412;
                        }
                }

        } elsif ( $url =~ m{($regex_dbs)/(.+)$} ) {
                my ($database,$id) = ($1,$2);
        
                my $p = "$path/$database/$id";
                warn "## database: $database id: $id -> $p ";

                if ( $id eq '_all_docs' ) {

                        my @docs = map {
                                s{^$path/$database/}{};
                                $_;
                        } glob( "$path/$database/*" );

                        warn "## docs ", dump( @docs );

                        $json = {
                                total_rows =>  $#docs + 1,
                                offset => 0,
                                rows => [],
                        };

                        foreach my $id ( @docs ) {
                                warn "++ $id\n";
                                my $p = "$path/$database/$id";
                                my $data = Storable::retrieve( $p );
                                push @{ $json->{rows} }, {
                                        id => $id,
                                        key => $id,
                                        value => {
                                                rev => (stat($p))[9], # mtime
                                        }
                                };
                        }

                } elsif ( $method eq 'PUT' ) {
        
                        warn "## ",dump( $tx->req );

                        my $data = $tx->req->content->file->slurp;

                        Storable::store( from_json($data), $p );
                        warn "store $p ", -s $p, " bytes: $data\n";
                } elsif ( $method eq 'GET' ) {
                        warn "retrive $p ", -s $p, " bytes\n";
                        $json = Storable::retrieve( $p );
                } else {
                        $status = 501;
                }

        }

        if ( $status >= 400 && $status < 500 && ! defined $json) {
                $json = { error => 'not_found', reason => 'Missing' };
                warn "fake $status";
        }

        $tx->res->code( $status );
        $tx->res->headers->content_type( 'text/json' );
        my $body = to_json $json;
        $tx->res->body( $body );
        warn "CouchDB API: $method $url $status $body\n";
        return $tx;

}

sub database_get {
        my ($db_name) = @_;
        warn "# collecting docs from $path/$db_name/*\n";
        my @docs = glob "$path/$db_name/*";
        my $json = {
                db_name => $db_name,
                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;
        $status = 200;
        return $json;
}

1;
1	dpavlin	1046	package Frey::CouchAPI;
2
3			use JSON;
4			use Data::Dump qw/dump/;
5			use URI::Escape;
6	dpavlin	1047	use File::Path qw(make_path remove_tree);
7			use Storable;
8	dpavlin	1046
9			sub rewrite_urls {
10			my ( $self, $tx ) = @_;
11			if ( $tx->req->url->path =~ m{/_utils/} ) {
12			my $path = $tx->req->url->path;
13			$path =~ s{(/_utils)/?$}{$1/index.html}; # poor man's DirectoryIndex
14			$path =~ s{/_utils}{/static/futon};
15			$tx->req->url->path( $path );
16			my $url = $tx->req->url->to_string;
17			my $old = $url;
18			$url = $tx->req->url->to_string;
19			warn "# rewrite $old -> $url\n";
20			}
21			}
22
23			my $path = '/data/webpac2/var/row';
24			my @all_dbs = map {
25			s{^\Q$path\E/*}{};
26			$_;
27			} glob "$path//";
28
29	dpavlin	1047	my $regex_dbs = '[a-z][a-z0-9_\$\(\)\+\-/]+';
30	dpavlin	1046
31	dpavlin	1047	our $json = {};
32			our $stauts = 500;
33
34			sub ok {
35			$json = { ok => JSON::true };
36			$status = 200;
37			}
38
39	dpavlin	1046	sub dispatch {
40			my ($self,$tx) = @_;
41
42			my $url = $tx->req->url->to_string;
43			$url = uri_unescape( $url );
44	dpavlin	1047	my $method = $tx->req->method;
45	dpavlin	1046
46	dpavlin	1047	warn "INFO: using Apache CouchDB emulation API\n";
47	dpavlin	1046
48			if ( $url eq '/' ) {
49			$json = {
50	dpavlin	1047	couchdb => "Welcome",
51			version => "0-Frey",
52	dpavlin	1046	}
53			} elsif ( $url eq '/_all_dbs' ) {
54			$json = [ @all_dbs ];
55	dpavlin	1047	$status = 200;
56			} elsif ( $url =~ m{($regex_dbs)/$} ) {
57	dpavlin	1046
58	dpavlin	1047	my $database = $1;
59			my $dir = "$path/$database";
60
61			if ( $method eq 'GET' ) {
62			$json = database_get( $database );
63			} elsif ( $method eq 'DELETE' ) {
64			if ( ! -e $dir ) {
65			$status = 404;
66			} 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
126	dpavlin	1046	}
127
128	dpavlin	1047	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	dpavlin	1046	$tx->res->headers->content_type( 'text/json' );
135	dpavlin	1047	my $body = to_json $json;
136			$tx->res->body( $body );
137			warn "CouchDB API: $method $url $status $body\n";
138	dpavlin	1046	return $tx;
139
140			}
141
142	dpavlin	1047	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	dpavlin	1046	1;