teng_schema_dumper.pl

#!/usr/bin/env perl
use strict;
use warnings;
use FindBin qw($Bin);
use lib "$Bin/../lib";
use Teng::Schema::Dumper;
use String::Random qw(random_regex);
use Path::Class;;

my $file = shift or die "require sql file";

use DBI;
my $dbh = DBI->connect('dbi:mysql:', 'root', '', {
    PrintError           => 0,
    RaiseError           => 1,
    AutoCommit           => 1,
    AutoInactiveDestroy  => 1,
    ShowErrorStatement   => 1,
    mysql_enable_utf8    => 1,
    mysql_auto_reconnect => 0,
});

my $prefix = "t_s_d-";
my $dbname = $prefix . random_regex("[a-z0-9]{@{[ 64 - length $prefix ]}}");
$dbh->do("CREATE DATABASE `$dbname`");
$dbh->do("USE `$dbname`");
eval {
    for my $stmt (split /;/, file($file)->slurp) {
        next unless $stmt =~ /\S/;
        $dbh->do($stmt);
    }

    my $handle_data = q{
        deflate data => sub {
            my $value = shift;
            $value = {} if (!$value);
            return $JSON->encode($value);
        };
        inflate data => sub {
            my $value = shift;
            return $value ? $JSON->decode($value) : {};
        };
    };

    my $schema = Teng::Schema::Dumper->dump(
        namespace      => 'MyApp::DB',
        dbh            => $dbh,
        inflate        => +{
            foobar => $handle_data,
        },
    );

    $schema =~ s{use Teng::Schema::Declare;}{$&.q{
    use JSON::XS qw/encode_json decode_json/;
    my $JSON = JSON::XS->new->ascii(1)->canonical->convert_blessed(1);
    }}e;

    eval $schema or die $@;

    print $schema;
};
if ($@) {
    use Data::Dumper;
    warn Dumper $@ ;
}
$dbh->do("DROP DATABASE `$dbname`");