use warnings;
use 5.008001;
-our $VERSION = 0.001000;
+our $VERSION = '0.001011';
# mirrored in Declare.xs as DD_HANDLE_*
my ($class, $target) = @_;
delete $declarators{$target};
delete $declarator_handlers{$target};
- teardown();
}
my $temp_name;
my $temp_save;
sub init_declare {
- my ($usepack, $use, $inpack, $name, $proto) = @_;
+ my ($usepack, $use, $inpack, $name, $proto, $traits) = @_;
my ($name_h, $XX_h, $extra_code)
= $declarator_handlers{$usepack}{$use}->(
- $usepack, $use, $inpack, $name, $proto, defined(wantarray)
+ $usepack, $use, $inpack, $name, $proto, defined(wantarray), $traits
);
($temp_name, $temp_save) = ([], []);
if ($name) {
package ${pack};
my \$body;
sub ${name} (${proto}) :lvalue {\n"
- .'my $ret = $body->(@_);
+ .' if (wantarray) {
+ goto &$body;
+ }
+ my $ret = $body->(@_);
return $ret;
};
sub { ($body) = @_; };';
$sub_proto =~ s/;//; $sub_proto = ';'.$sub_proto;
#my $installer = $class->build_sub_installer($pack, $name, $proto);
my $installer = $class->build_sub_installer($pack, $name, '@');
- my $proto_maker = eval q!
- sub {
- my $body = shift;
- sub (!.$sub_proto.q!) {
- $body->(@_);
- };
- };
- !;
$installer->(sub :lvalue {
+#{ no warnings 'uninitialized'; warn 'INST: '.join(', ', @_)."\n"; }
if (@_) {
if (ref $_[0] eq 'HASH') {
shift;
+ if (wantarray) {
+ my @ret = $run->(undef, undef, @_);
+ return @ret;
+ }
my $r = $run->(undef, undef, @_);
return $r;
} else {
- return $_[1];
+ return @_[1..$#_];
}
}
return my $sv;
$setup_for_args{$name} = [
$flags,
sub {
- my ($usepack, $use, $inpack, $name, $proto) = @_;
- my $extra_code = $compile->($name, $proto);
- my $main_handler = $proto_maker->(sub {
+ my ($usepack, $use, $inpack, $name, $proto, $shift_hashref, $traits) = @_;
+ my $extra_code = $compile->($name, $proto, $traits);
+ my $main_handler = sub { shift if $shift_hashref;
("DONE", $run->($name, $proto, @_));
- });
+ };
my ($name_h, $XX);
if (defined $proto) {
$name_h = sub :lvalue { return my $sv; };
$XX = $main_handler;
} elsif (defined $name && length $name) {
$name_h = $main_handler;
- } else {
- $extra_code ||= '';
- $extra_code = '}, sub {'.$extra_code;
}
+ $extra_code ||= '';
+ $extra_code = '}, sub {'.$extra_code;
return ($name_h, $XX, $extra_code);
}
];
=head1 SYNOPSIS
+Look at the tests. This module is currently on CPAN to ease smoke testing
+and allow early adopters who've been involved in the design to experiment
+with it.
+
=head1 DESCRIPTION
=head2 import
=head1 AUTHOR
-Matt S Trout - <mst@shadowcatsystems.co.uk>
+Matt S Trout - <mst@shadowcat.co.uk>
-Company: http://www.shadowcatsystems.co.uk/
+Company: http://www.shadowcat.co.uk/
Blog: http://chainsawblues.vox.com/
=head1 LICENSE