class_singleton.pl

#!perl
use strict;
use warnings;
use Test::More tests => 2;

{
    package MySchema;
#    use base qw(DBIx::Class::Schema::Loader);
#    __PACKAGE__->loader_options();
    use base qw(DBIx::Class::Schema);
    __PACKAGE__->load_namespaces();
}

{
    package MySingleton;
    use parent 'Class::Singleton';

    sub _new_instance {
        my ($class, @args) = @_;
        return MySchema->connect(@args);
    }
}

my $schema = MySingleton->instance(qw(dbi:mysql:test root));
my $schema2 = MySingleton->instance;

is $schema, $schema2;

is $schema->storage->dbh, $schema2->storage->dbh;

use Data::Dumper;
warn Dumper $schema->storage->dbh->selectall_arrayref('show tables');
warn Dumper $schema2->storage->dbh->selectall_arrayref('show tables');