view release on metacpan or  search on metacpan

lib/Acme/What.pm  view on Meta::CPAN

use 5.010;
use strict;
use warnings;

package Acme::What;

BEGIN {
	$Acme::What::AUTHORITY = 'cpan:TOBYINK';
	$Acme::What::VERSION   = '0.005';
}

use Devel::Declare;
use Sub::Util qw/set_subname/;

use base qw/Devel::Declare::Context::Simple/;

sub import
{
	no strict 'refs';
	
	my $caller = caller;
	my $self   = shift;
	my $method = shift // 'WHAT';
	
	my $export = "$caller\::what";
	unless ( exists &$export )
	{
		$self = $self->new unless ref $self;
		Devel::Declare->setup_for(
			$caller,
			{ what => { const => sub { $self->_parser(@_) } } }
		);
		*$export = set_subname($export => sub ($) { $self->_do(@_) });
	}
	
	$^H{(__PACKAGE__)} = $method =~ m{^\+(.+)$}
		? $1
		: sprintf("$caller\::$method");
}

sub unimport
{
	$^H{(__PACKAGE__)} = undef;
}

sub _parser
{
	my $self = shift;
	$self->init(@_);
	$self->skip_declarator;
	$self->skipspace;
	my $linestr = $self->get_linestr;
	
	my $remaining = substr($linestr, $self->offset);
	
	if ($remaining =~ /^(.*?);(.*)$/)
	{
		# Found semicolon
		my $quoted = $self->_quote($1);
		substr($linestr, $self->offset) = "('$quoted');" . $2;
	}
	else
	{
		chomp $remaining;
		my $quoted = $self->_quote($remaining);
		substr($linestr, $self->offset) = "('$quoted');\n";
	}
	
	$self->set_linestr($linestr);
}

sub _quote
{
	my ($self, $str) = @_;
	$str =~ s{([\\\'])}{\\$1}g;
	return $str;
}

sub _do
{
	no strict 'refs';
	my ($self, @args) = @_;
	my @caller = caller(1);
	
	my $meth = $caller[10]{ (__PACKAGE__) };
	
	if (not defined $meth) {
		require Carp;
		Carp::croak("Acme::What disabled");
	}
	
	return $meth->(@args);
}

__PACKAGE__
__END__