view release on metacpan or  search on metacpan

t/engine/subclassing.t  view on Meta::CPAN

#!perl

package main;
use strict;
use warnings;

use Test::More tests => 12;
use Test::Fatal;

use Sub::Override;
use Data::Collector;

my $sub = Sub::Override->new;

{
    package Data::Collector::Engine::MyTest;
    use Moose;
    extends 'Data::Collector::Engine';
    sub run { shift->connected(1) }
}

{
    package Data::Collector::Info::EG;
    use Moose;
    extends 'Data::Collector::Info';
    sub info_keys { [] }
    sub all       { {} }
}

{
    my $collector = Data::Collector->new( engine => 'NoExist' );

    isa_ok( $collector, 'Data::Collector' );
    ok(
        exception { $collector->collect },
        'Cannot load nonexistent engine class',
    );
}

{
    my $engine = Data::Collector::Engine::MyTest->new();
    isa_ok( $engine, 'Data::Collector::Engine::MyTest' );

    my $collector = Data::Collector->new(
        infos         => ['EG'],
        engine_object => $engine
    );

    isa_ok( $collector, 'Data::Collector' );
    isa_ok( $collector->engine_object, 'Data::Collector::Engine::MyTest' );

    my ( $connect, $disconnect );

    $sub->replace( 'Data::Collector::Engine::connect',    sub { $connect++    } );
    $sub->replace( 'Data::Collector::Engine::disconnect', sub { $disconnect++ } );

    $collector->collect;

    ok( $connect,    'Reached connect'    );
    ok( $disconnect, 'Reached disconnect' );
}

{
    my $engine = Data::Collector::Engine->new;
    isa_ok( $engine, 'Data::Collector::Engine' );
    like(
        exception { $engine->run },
        qr/^No default run method/,