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 )