use Devel::Declare ();
use Test::More qw(no_plan);
{
package FoomHandlers;
use strict;
use warnings;
our ($Declarator, $Offset);
sub skip_declarator {
$Offset += Devel::Declare::toke_move_past_token($Offset);
}
sub skipspace {
$Offset += Devel::Declare::toke_skipspace($Offset);
}
sub strip_name {
skipspace;
if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
my $linestr = Devel::Declare::get_linestr();
my $name = substr($linestr, $Offset, $len);
substr($linestr, $Offset, $len) = '';
Devel::Declare::set_linestr($linestr);
return $name;
}
return;
}
sub strip_proto {
skipspace;
my $linestr = Devel::Declare::get_linestr();
if (substr($linestr, $Offset, 1) eq '(') {
my $length = Devel::Declare::toke_scan_str($Offset);
my $proto = Devel::Declare::get_lex_stuff();
Devel::Declare::clear_lex_stuff();
$linestr = Devel::Declare::get_linestr();
substr($linestr, $Offset, $length) = '';
Devel::Declare::set_linestr($linestr);
return $proto;
}
return;
}
sub shadow {
my $pack = Devel::Declare::get_curstash_name;
Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
}
sub inject_str {
my $linestr = Devel::Declare::get_linestr;
substr($linestr, $Offset, 0) = $_[0];
Devel::Declare::set_linestr($linestr);
}
sub strip_str {
my $linestr = Devel::Declare::get_linestr;
if (substr($linestr, $Offset, length($_[0])) eq $_[0]) {
substr($linestr, $Offset, length($_[0])) = '';
Devel::Declare::set_linestr($linestr);
return 1;
}
return 0;
}
sub const {
local ($Declarator, $Offset) = @_;
skip_declarator;
my $name = strip_name;
my $str = "happy ".(defined $name ? "foom: ${name}" : "anonymous foom");
if (defined(my $proto = strip_proto)) {
$str .= "; ${proto}";
}
shadow(sub { $str });
}
package Foo;
use strict;
use warnings;
sub foom { }
BEGIN {
Devel::Declare->setup_for(
__PACKAGE__,
{ foom => {
const => \&FoomHandlers::const,
} }
);
}
::is(foom, "happy anonymous foom", "foom");
::is(foom KABOOM, "happy foom: KABOOM", "foom KABOOM");
::is(foom (zoom), "happy anonymous foom; zoom", "foom (zoom)");
::is(foom KABOOM (zoom), "happy foom: KABOOM; zoom", "foom KABOOM (zoom)");
}