package CouchDB::Deploy;
use strict;
use warnings;
our $VERSION = '0.03';
use CouchDB::Client;
use CouchDB::Deploy::Process;
use Carp qw(confess);
use Sub::Exporter -setup => {
exports => [
db => \&_build_db,
containing => \&_build_containing,
doc => \&_build_doc,
design => \&_build_design,
file => \&_build_file,
base64 => \&_build_base64,
],
groups => {
default => [qw(db containing doc design file base64)],
},
};
my $p;
BEGIN {
my $server = $ARGV[0] || $ENV{COUCHDB_DEPLOY_SERVER} || 'http://localhost:5984/';
confess "No server provided." unless $server;
$p = CouchDB::Deploy::Process->new($server);
}
sub _build_db {
return sub ($$) {
my ($db, $sub) = @_;
$p->createDBUnlessExists($db);
$sub->();
};
}
sub _build_containing { # syntax sugar
return sub (&) {
my $sub = shift;
return $sub;
};
}
sub _build_doc {
return sub (&) {
my $sub = shift;
my %data = $sub->();
my $id = delete($data{_id}) || confess "Document requires an '_id' field.";
confess "Document must not have a '_rev' field." if $data{_rev};
my $att = delete($data{_attachments}) || {};
$p->addDocumentUnlessExistsOrSame($id, \%data, $att);
};
}
sub _build_design {
return sub (&) {
my $sub = shift;
my %data = $sub->();
my $id = delete($data{_id}) || confess "Design document requires an '_id' field.";
$id = "_design/$id" unless $id =~ m{^_design/};
$p->addDesignDocUnlessExistsOrSame($id, \%data);
};
}
sub _build_file {
return sub ($) {
my $file = shift;
return $p->getFile($file);
};
}
sub _build_base64 {
return sub ($) {
my $content = shift;
return CouchDB::Client::Doc->toBase64($content);
};
}
1;
=pod
=head1 NAME
CouchDB::Deploy - Simple configuration scripting to deploy CouchDB databases
=head1 SYNOPSIS
use CouchDB::Deploy;
db 'my-test-db/', containing {
doc {
_id => 'foo',
key => 'value',
_attachments => {
'foo.txt' => {
content_type => 'text/plain',
data => 'RGFodXRzIEZvciBXb3JsZCBEb21pbmF0aW9uXCE=',
},
'bar.svg' => {
content_type => 'image/svg+xml',
data => file 'dahut.svg',
},
'circle.html' => {
content_type => 'text/html;charset=utf-8',
data => base64 <