App-Kit

 view release on metacpan or  search on metacpan

lib/App/Kit/Obj/DB.pm  view on Meta::CPAN

=item C<< missing required database >>

the dbh() hash (from args or conf file) is missing the required database param

=item C<< missing required dbd_driver >>

the dbh() hash (from args or conf file) is missing the required dbd_driver param

=item C<< Could not connect to database: %s >>

conn() throws this when its DBI->connect() fails

%s is DBI->errstr

=back

=head1 CONFIGURATION AND ENVIRONMENT

Requires no configuration files or environment variables.

=head1 DEPENDENCIES

lib/App/Kit/Obj/NS.pm  view on Meta::CPAN

=head2 ns2distname()

Lazy wrapper of L<Module::Want>’s ns2distname().

=head2 distname2ns()

Lazy wrapper of L<Module::Want>’s distname2ns().

=head2 sharedir()

Lazy wrapper of L<File::ShareDir>’s sharedir() that returns false instead of throwing exception (in that case $@ will be set).

=head2 caller related

=head3 enable(FNS)

Takes one or more full name spaces to functions and enables them directly in the current package, loading the module if necessary.

    $app->ns->enable('Foo::Bar::zing')
    zing(…); # zing() is from Foo::Bar

t/00.load.t  view on Meta::CPAN

for my $role_ar (@roles) {
    my $role    = $role_ar->[0];
    my $role_hr = $role_ar->[1];

    my $has = lc($role);
    ok( !exists $app->{$has}, "'$has' does not exist before it is called" );
    is( ref $app->$has(), $role_hr->{'isa'}, "'$has' returns the expected object" );
    ok( exists $app->{$has}, "'$has' exists after it is called" );

    throws_ok { $app->$has( bless {}, 'Foo' ) } qr/$has is a read-only accessor/, "'$has' is readonly by default";
}

done_testing;

t/03.str.t  view on Meta::CPAN

is( $zbt, "0E0", 'zero_but_true() returns 0E0' );
cmp_ok( $zbt, '==', 0, 'zero_but_true() is zero in numeric context' );
ok( $zbt, "zero_but_true() is true" );

ok( !exists $INC{'String/UnicodeUTF8.pm'}, 'lazy under pinning not loaded before' );
is( $app->str->bytes_size("I ♥ perl"), "10", "bytes_size() correct" );
ok( exists $INC{'String/UnicodeUTF8.pm'}, 'lazy under pinning loaded after' );
is( $app->str->char_count("I ♥ perl"), "8", "char_count() correct" );

is( $app->str->prefix, "appkit", 'prefix() default' );
throws_ok { $app->str->prefix('') } qr{prefix must be at least 1 character},             'prefix() too short';
throws_ok { $app->str->prefix('sevenly') } qr{prefix can not be more than 6 characters}, 'prefix() too long';
throws_ok { $app->str->prefix('../etc') } qr{prefix can only contain A\-Z and 0\-9},     'prefix() invalid char';
is( $app->str->prefix('new'), 'new', 'prefix setting returns prefix' );
is( $app->str->prefix,        'new', 'prefix setting retained' );

ok( !exists $INC{'Data/Rand.pm'}, 'lazy under pinning not loaded before' );
my $rand = $app->str->rand();
ok( exists $INC{'Data/Rand.pm'}, 'lazy under pinning loaded after' );
is( length($rand), 32, "rand() default length correct" );
like( $rand, qr/\A[0-9a-zA-Z]+\Z/, "rand() default items correct" );

my $randx = $app->str->rand( 2, [ "\xe2\x99\xa5", "\xe2\x98\xba" ] );

t/09.db.t  view on Meta::CPAN

    no warnings 'once';
    local *App::Kit::Obj::DB::_set__dbh = sub { };
    my @e = ( 'DBI:foo:database=mydb;host=localhost;', '', '', undef );
    my $n = 'min req keys';
    local *App::Kit::Obj::DB::conn = sub {
        my ( $o, @c ) = @_;
        is_deeply( \@c, [@e], "dbh() conn builder: $n" );
    };
    $app->db->dbh( { dbd_driver => "foo", database => "mydb", } );

    throws_ok { $app->db->dbh() } qr/no db conf in arguments or app configuration/, 'dbh() no args caught OK';

    throws_ok { $app->db->dbh( {} ) } qr/missing required dbd_driver and database/, 'dbh() empty hash ref fatal';
    throws_ok { $app->db->dbh( { dbd_driver => "fooo" } ) } qr/missing required database/,   'dbh() only dbd_driver fatal';
    throws_ok { $app->db->dbh( { database   => "medb" } ) } qr/missing required dbd_driver/, 'dbh() only database fatal';

    @e = ( 'DBI:foo:database=mydb;host=localhost;', 'usr', 'pss', undef );
    $n = 'user pass';
    $app->db->dbh( { dbd_driver => "foo", database => "mydb", user => "usr", pass => "pss" } );

    @e = ( 'DBI:foo:database=mydb;host=myhost;', '', '', undef );
    $n = 'given host';
    $app->db->dbh( { dbd_driver => "foo", database => "mydb", host => "myhost" } );

    @e = ( 'DBI:foo:database=mydb;host=localhost;', '', '', { foo => 42, bar => 99 } );

t/09.db.t  view on Meta::CPAN

my $f_dbh = $app->db->dbh( { _force_new => 1 } );
isa_ok( $f_dbh, 'DBI::db', '_force_new returns DBD obj' );
is( $f_dbh->{Driver}{Name}, 'SQLite', '_force_new respects config via file' );
isnt( $f_dbh, $prev, '_force_new gave a new object' );
ok( !$prev->ping, '_force_new disconnected the previous obj' );

# bad conf:
$app->fs->yaml_write( $conf_file, [ foo => 42 ] );
$app->db->disconn;
is( $app->db->_dbh, undef, 'sanity main DBH not set' );
throws_ok { $app->db->dbh() } qr/no db conf in app configuration/, 'dbh() invalid config file fatal';
unlink $conf_file;

#### dbh_is_still_good_check ##

throws_ok { $app->db->dbh_is_still_good_check(42) } qr/'dbh_is_still_good_check' must be undef or a coderef/, 'dbh_is_still_good_check(non-code-non-undef) dies';

my $c = 0;
my $s = 0;
{
    my $check = sub { ++$c };

    is( $app->db->dbh_is_still_good_check($check), $check, 'dbh_is_still_good_check set returns code ref' );
    is( $app->db->dbh_is_still_good_check(),       $check, 'dbh_is_still_good_check get returns code ref' );

    $app->db->disconn;

t/10.ex.t  view on Meta::CPAN

use Test::Exception;

use App::Kit;

diag("Testing ex() for App::Kit $App::Kit::VERSION");

my $app = App::Kit->new();

ok $app->ex->fsleep(0.25), 'fsleep() returns true';

throws_ok {
    $app->ex->runcom(
        'Starting test',
        [ 'step 1' => 'echo foo' ],
        [ 'step 2' => 'echo bar' ],
    );
}
qr/Due to compile time Shenanigans in an underlying module, you must 'use App::Kit::Util::RunCom;' to enable runcom\(\)\./, 'runcom() dies when not initiated';

ok( !exists $INC{'Unix/Whereis.pm'}, 'Sanity: Unix::Whereis not loaded before whereis()' );
is $app->ex->whereis('perl'), Unix::Whereis::whereis('perl'), 'whereis() matches underlying whereis';