Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
106 lines (76 sloc) 2.37 KB
#!/usr/bin/env perl
# usage: waack <dsn> <user> <password>
use 5.20.0;
use experimental 'signatures', 'postderef';
use List::AllUtils qw/ zip /;
use SQL::Translator;
use Clone 'clone';
use Dancer;
config->{engines}{JSON} = {
convert_blessed => 1,
allow_blessed => 1
};
set serializer => 'JSON';
set logger => 'console';
{
package Waack::DB;
use parent 'DBIx::Class::Schema::Loader';
__PACKAGE__->naming('current');
__PACKAGE__->use_namespaces(1);
__PACKAGE__->loader_options( components => [ 'Helper::Row::ToJSON' ]);
}
my $schema = Waack::DB->connect( @ARGV );
# serialize ALL THE THINGS
$_->{is_serializable} = 1
for map {values $_->columns_info->%* }
map { $schema->source($_) }
$schema->sources ;
get '/_tables' => sub { [ $schema->sources ] };
get '/_schema' => sub {
my $trans = SQL::Translator->new (
parser => 'SQL::Translator::Parser::DBIx::Class',
parser_args => {
dbic_schema => $schema,
},
);
# warning SQL::Translator::Producer::HTML needs patching
my $output = request()->accept =~ m#text/html# ? 'HTML' : 'JSON';
content_type 'application/json' if $output eq 'JSON';
return $trans->translate( to => $output );
};
create_routes_for_table( $schema, $_ ) for $schema->sources;
sub create_routes_for_table ( $schema, $table ) {
my @primary_key = $schema->source($table)->primary_columns;
# will be /<table name>/<key 1>/<key 2>
my $row_url = join '/', undef, $table, ( '*' ) x @primary_key;
get "/$table" => sub {
my @things = $schema->resultset($table)->search({ params() })->all;
return \@things;
};
get "/$table/_schema" => sub {
my $columns = clone $schema->source($table)->columns_info;
for my $c ( values $columns ) {
delete $c->{$_} for grep { /^_/ } keys $c;
}
return $columns;
};
get $row_url => sub {
my @ids = splat;
return $schema->resultset($table)->find({
zip @primary_key, @ids
});
};
post "/$table" => sub {
$schema->resultset($table)->create({ params() });
};
put $row_url => sub {
my @ids = splat;
delete params->{splat};
my $row = $schema->resultset($table)->find({
zip @primary_key, @ids
});
$row->update({ params() });
$row;
};
}
dance;