File Coverage

blib/lib/syntax.pm

Criterion	Covered	Total	%
statement	47	49	95.9
branch	1	2	50.0
condition			n/a
subroutine	13	13	100.0
pod	2	2	100.0
total	63	66	95.4

use strict;
use warnings;

# ABSTRACT: Activate syntax extensions

package syntax;
{
  $syntax::VERSION = '0.004';
}
BEGIN {
  $syntax::AUTHORITY = 'cpan:PHAYLON';
}

use Carp                qw( carp );
use Data::OptList 0.104 qw( mkopt );

use namespace::clean;

$Carp::Internal{ +__PACKAGE__ }++;
$Carp::Internal{ 'Devel::Declare' } ||= 1;

sub import_into {
    my ($class, $into, @args) = @_;

    my $import = mkopt \@args;

    for my $declaration (@$import) {
        my ($feature, $options) = @$declaration;

        $class->_install_feature(
            $feature,
            $into,
            $options,
            [@args],
        );
    }

    return 1;
}

sub unimport_from {
    my ($class, $from, @args) = @_;

    for my $feature (@args) {

        $class->_uninstall_feature(
            $feature,
            $from,
        );
    }

    return 1;
}

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

    my $caller = caller;

    return $class->import_into($caller, @args);
}

sub unimport {
    my ($class, @args) = @_;

    my $caller = caller;

    return $class->unimport_from($caller, @args);
}

sub _parse_feature_name {
    my ($class, $feature) = @_;

    my $name =
        join '/',
        map ucfirst,
        split m{/},
        join '',
        map ucfirst,
        split qr{_}, $feature;

    my $file    = "Syntax/Feature/${name}.pm";
    my $package = $file;
    s{ \/ }{::}xg, s{ \.pm \Z }{}xgi
        for $package;

    return $package, $file;
}

sub _uninstall_feature {
    my ($class, $feature, $target) = @_;

    my ($package, $file) = $class->_parse_feature_name($feature);

    require $file;
    unless ($package->can('uninstall')) {
        carp "Syntax extension $package does not know how to uninstall";
        return;
    }
    return $package->uninstall(
        from        => $target,
        identifier  => $feature,
    );
}

sub _install_feature {
    my ($class, $feature, $target, $options, $all_params) = @_;

    my ($package, $file) = $class->_parse_feature_name($feature);

    require $file;
    return $package->install(
        into        => $target,
        options     => $options,
        identifier  => $feature,
        outer       => $all_params,
    );
}

1;


__END__