syntax

 view release on metacpan or  search on metacpan

lib/syntax.pm  view on Meta::CPAN

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__
=pod

=head1 NAME

syntax - Activate syntax extensions

=head1 VERSION

version 0.004

=head1 SYNOPSIS

    # either
    use syntax 'foo';



( run in 0.441 second using v1.01-cache-2.11-cpan-5511b514fd6 )