view release on metacpan or  search on metacpan

lib/Chart/GGPlot/Setup.pm  view on Meta::CPAN

use Log::Any::Adapter;
use Safe::Isa 1.000010 ();
use PerlX::Maybe ();

use Feature::Compat::Try ();
use Module::Load;
use Moose 2.1400;
use Moose::Role               ();
use MooseX::MungeHas 0.011;
use MooseX::StrictConstructor ();
use boolean                   ();

use List::AllUtils qw(uniq);

# for debug
if (my $trace_level = $ENV{CHART_GGPLOT_TRACE} ) {
    load Log::Dispatch;
    load POSIX, qw(strftime);
    my $logger = Log::Dispatch->new(
        outputs => [
            [
                'Screen',
                min_level => 'debug',
                newline   => 1,
                stderr    => 1,
            ]
        ],
        callbacks => sub {
            my %params = @_;
            my $msg = $params{message};
            my $level = uc($params{level});
            return sprintf("%s [Chart::GGPlot $level] %s", strftime('%Y-%m-%d %H:%M:%S', localtime(time)), $msg);
        },
    );
    Log::Any::Adapter->set( { category => qr/^Chart::GGPlot/ },
        'Dispatch', dispatcher => $logger, );
}

sub import {
    my ( $class, @tags ) = @_;

    unless (@tags) {
        @tags = qw(:base);
    }
    $class->_import( scalar(caller), @tags );
}

sub _import {
    my ( $class, $target, @tags ) = @_;

    my @remove_module = @tags;
    for my $tag ( uniq @tags ) {
        $class->_import_tag( $target, $tag );
    }
}

sub _import_tag {
    my ( $class, $target, $tag ) = @_;

    if ( $tag eq ':base' ) {
        strict->import::into($target);
        warnings->import::into($target);
        utf8->import::into($target);
        feature->import::into( $target, ':5.16' );

        Carp->import::into($target);
        Data::Dumper->import::into($target);
        Function::Parameters->import::into($target);
        Log::Any->import::into( $target, '$log' );
        Safe::Isa->import::into($target);
        PerlX::Maybe->import::into($target);
        Feature::Compat::Try->import::into($target);
        boolean->import::into($target);

        Data::Frame::Autobox->import::into($target);
    }
    elsif ( $tag eq ':class' ) {
        $class->_import_tag( $target, ':base' );

        Function::Parameters->import::into( $target,
            qw(classmethod :modifiers) );

        Moose->import::into($target);
        MooseX::MungeHas->import::into($target);
        MooseX::StrictConstructor->import::into($target);
    }
    elsif ( $tag eq ':role' ) {
        $class->_import_tag( $target, ':base' );

        Function::Parameters->import::into( $target,
            qw(classmethod :modifiers) );

        Moose::Role->import::into($target);
        MooseX::MungeHas->import::into($target);
    }
    elsif ( $tag eq ':pdl' ) {
        require PDL::Lite;
        require PDL::Core;
        require PDL::SV;
        require PDL::Factor;
        require PDL::DateTime;
        require Role::Tiny;

        PDL::Lite->import::into($target);
        PDL::Core->import::into( $target, qw(pdl null) );

        Role::Tiny->apply_roles_to_package( 'PDL', 'Data::Frame::PDL' );

        # "use PDL::SV;" (or PDL::Factor) would import names like float,
        # thus would pollute caller namespace and cause a warning with
        # Test::V0. So we don't do PDL::SV->import::into
    }
    else {
        croak qq["$tag" is not exported by the $class module\n];
    }
}

# this is similar to what the "aliased" module does, but "aliased"
#  does not work with Import::Into.
sub _alias {
    my ( $class, $target, $from, $to ) = @_;