Skip to content

Commit

Permalink
Merge pull request #16 from kfly8/no-UNIVERSAL
Browse files Browse the repository at this point in the history
[breaking change]improve: not use UNIVERSAL
  • Loading branch information
kfly8 committed Mar 15, 2021
2 parents 0801f9f + 5cb1acc commit 2b5c022
Show file tree
Hide file tree
Showing 10 changed files with 266 additions and 210 deletions.
1 change: 1 addition & 0 deletions META.json
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@
"Function::Parameters" : "2.000003",
"Scope::Upper" : "0",
"Sub::Meta" : "0.08",
"namespace::autoclean" : "0",
"perl" : "5.014004"
}
},
Expand Down
51 changes: 9 additions & 42 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -67,56 +67,23 @@ Or you can specify a package name:
use Function::Return pkg => 'MyClass';
```

## FUNCTIONS
# NOTE

### Function::Return::meta($coderef)
## handling meta information

The function `Function::Return::meta` lets you introspect return values:
[Function::Return::Meta](https://metacpan.org/pod/Function%3A%3AReturn%3A%3AMeta) can handle the meta information of `Function::Return`:

```perl
use Function::Return;
use Function::Return::Meta;
use Types::Standard -types;

sub baz() :Return(Str) { 'hello' }

my $meta = Function::Return::meta \&baz; # Sub::Meta
my $meta = Function::Return::Meta->get(\&baz); # Sub::Meta
$meta->returns->list; # [Str]
```

In addition, it can be used with [Function::Parameters](https://metacpan.org/pod/Function%3A%3AParameters):

```perl
use Function::Parameters;
use Function::Return;
use Types::Standard -types;

fun hello(Str $msg) :Return(Str) { 'hello' . $msg }

my $meta = Function::Return::meta \&hello; # Sub::Meta
$meta->returns->list; # [Str]

$meta->args->[0]->type; # Str
$meta->args->[0]->name; # $msg

# Note
Function::Parameters::info \&hello; # undef
```

This makes it possible to know both type information of function arguments and return value at compile time, making it easier to use for testing etc.

## CLASS METHODS

### wrap\_sub($coderef)

This interface is for power-user. Rather than using the `:Return` attribute, it's possible to wrap a coderef like this:

```perl
my $wrapped = Function::Return->wrap_sub($orig, [Str]);
$wrapped->();
```

# NOTE

## enforce LIST to simplify

`Function::Return` makes the original function is called in list context whether the wrapped function is called in list, scalar, void context:
Expand All @@ -132,23 +99,23 @@ The specified type checks against the value the original function was called in

## requirements of type constraint

The requirements of type constraint of `Function::Return` is the same as for `Function::Parameters`. Specific requirements are as follows:
The requirements of type constraint of `Function::Return` is the same as for [Function::Parameters](https://metacpan.org/pod/Function%3A%3AParameters). Specific requirements are as follows:

\> The only requirement is that the returned value (here referred to as $tc, for "type constraint") is an object that provides $tc->check($value) and $tc->get\_message($value) methods. check is called to determine whether a particular value is valid; it should return a true or false value. get\_message is called on values that fail the check test; it should return a string that describes the error.

## compare Return::Type

Both `Return::Type` and `Function::Return` perform type checking on function return value, but have some differences.
Both [Return::Type](https://metacpan.org/pod/Return%3A%3AType) and `Function::Return` perform type checking on function return value, but have some differences.

1\. `Function::Return` is not possible to specify different type constraints for scalar and list context, but `Return::Type` is possible.

2\. `Function::Return` check type constraint for void context, but `Return::Type` doesn't.

3\. `Function::Return::meta` can be used together with `Function::Parameters::Info`, but `Return::Type` seems a bit difficult.
3\. `Function::Return::Meta#get` can be used together with `Function::Parameters::Info`, but `Return::Type` seems a bit difficult.

# SEE ALSO

[Function::Parameters](https://metacpan.org/pod/Function%3A%3AParameters), [Return::Type](https://metacpan.org/pod/Return%3A%3AType)
[Function::Return::Meta](https://metacpan.org/pod/Function%3A%3AReturn%3A%3AMeta)

# LICENSE

Expand Down
1 change: 1 addition & 0 deletions cpanfile
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ requires 'Sub::Meta', '0.08';
requires 'Scope::Upper';
requires 'Function::Parameters', '2.000003';
requires 'B::Hooks::EndOfScope', '0.23';
requires 'namespace::autoclean';

on 'test' => sub {
requires 'Test::More', '0.98';
Expand Down
182 changes: 23 additions & 159 deletions lib/Function/Return.pm
Original file line number Diff line number Diff line change
Expand Up @@ -6,148 +6,41 @@ use warnings;
our $VERSION = "0.07";

use Attribute::Handlers;
use Scope::Upper ();
use B::Hooks::EndOfScope;

use Sub::Meta;
use Sub::Meta::Library;
use Sub::Meta::Creator;
use Sub::Meta::Finder::FunctionParameters;

use constant DEFAULT_NO_CHECK => !!($ENV{FUNCTION_RETURN_NO_CHECK} // 0);

my %NO_CHECK;
use Function::Return::Meta;
use namespace::autoclean;

sub import {
my $class = shift;
my %args = @_;
my $pkg = caller;

$pkg = $args{pkg} ? $args{pkg} : $pkg;
$NO_CHECK{$pkg} = exists $args{no_check} ? !!$args{no_check} : DEFAULT_NO_CHECK;
my $pkg = $args{pkg} ? $args{pkg} : scalar caller;
Function::Return::Meta->_set_no_check($pkg, $args{no_check}) if exists $args{no_check};

{
# allow importing package to use attribute
no strict 'refs';
push @{"${pkg}::ISA"}, $class;
}

return;
}

sub UNIVERSAL::Return :ATTR(CODE,BEGIN) {
sub Return :ATTR(CODE,BEGIN) {
my $class = __PACKAGE__;
my ($pkg, undef, $sub, $attr, $types) = @_;
$types //= [];

on_scope_end {
if ($class->no_check($pkg)) {
$class->_register_submeta($pkg, $sub, $types);
if (Function::Return::Meta->_no_check($pkg)) {
Function::Return::Meta->_register_submeta($pkg, $sub, $types);
}
else {
$class->_register_submeta_and_install($pkg, $sub, $types);
Function::Return::Meta->_register_submeta_and_install($pkg, $sub, $types);
}
};
}

sub no_check {
my ($class, $pkg) = @_;
$NO_CHECK{$pkg}
}

sub _croak {
my (undef, $file, $line) = caller 1;
die @_, " at $file line $line.\n"
}

sub wrap_sub {
my ($class, $sub, $types) = @_;

my $meta = Sub::Meta->new(sub => $sub);
my $shortname = $meta->subname;

{ # check type
my $file = $meta->file;
my $line = $meta->line;
for my $type (@$types) {
for (qw/check get_message/) {
die "Invalid type: $type. require `$_` method at $file line $line.\n"
unless $type->can($_)
}
}
}

my $src = q|
sub {
_croak "Required list context in fun $shortname because of multiple return values function"
if @$types > 1 && !wantarray;
# force LIST context.
my @ret = &Scope::Upper::uplevel($sub, @_, &Scope::Upper::CALLER(0));
# return Empty List
return if @$types == 0 && !@ret;
_croak "Too few return values for fun $shortname (expected @$types, got @{[map { defined $_ ? $_ : 'undef' } @ret]})" if @ret < @$types;
_croak "Too many return values for fun $shortname (expected @$types, got @{[map { defined $_ ? $_ : 'undef' } @ret]})" if @ret > @$types;
for my $i (0 .. $#$types) {
my $type = $types->[$i];
my $value = $ret[$i];
_croak "Invalid return in fun $shortname: return $i: @{[$type->get_message($value)]}" unless $type->check($value);
}
return @$types > 1 ? @ret # multi return
: $ret[0] # single return
};
|;

my $code = eval $src; ## no critic
if ($@) {
_croak $@;
}
return $code;
}

sub meta {
my ($sub) = @_;
Sub::Meta::Library->get($sub);
}

sub _register_submeta {
my ($class, $pkg, $sub, $types) = @_;

my $meta = Sub::Meta->new(sub => $sub, stashname => $pkg);
$meta->set_returns(list => $types);

if (my $materials = Sub::Meta::Finder::FunctionParameters::find_materials($sub)) {
$meta->set_is_method($materials->{is_method});
$meta->set_parameters($materials->{parameters});
}

Sub::Meta::Library->register($sub, $meta);
return;
}

sub _register_submeta_and_install {
my ($class, $pkg, $sub, $types) = @_;

my $original_meta = Sub::Meta->new(sub => $sub);
my $wrapped = $class->wrap_sub($sub, $types);

my $meta = Sub::Meta->new(sub => $wrapped, stashname => $pkg);
$meta->set_returns(list => $types);

if (my $materials = Sub::Meta::Finder::FunctionParameters::find_materials($sub)) {
$meta->set_is_method($materials->{is_method});
$meta->set_parameters($materials->{parameters});
}

$meta->apply_meta($original_meta);
Sub::Meta::Library->register($wrapped, $meta);

{
no strict qw(refs);
no warnings qw(redefine);
*{$meta->fullname} = $wrapped;
}
return;
}

1;
__END__
Expand Down Expand Up @@ -213,50 +106,21 @@ Or you can specify a package name:
use Function::Return pkg => 'MyClass';
=head2 FUNCTIONS
=head1 NOTE
=head3 Function::Return::meta($coderef)
=head2 handling meta information
The function C<Function::Return::meta> lets you introspect return values:
L<Function::Return::Meta> can handle the meta information of C<Function::Return>:
use Function::Return;
use Function::Return::Meta;
use Types::Standard -types;
sub baz() :Return(Str) { 'hello' }
my $meta = Function::Return::meta \&baz; # Sub::Meta
my $meta = Function::Return::Meta->get(\&baz); # Sub::Meta
$meta->returns->list; # [Str]
In addition, it can be used with L<Function::Parameters>:
use Function::Parameters;
use Function::Return;
use Types::Standard -types;
fun hello(Str $msg) :Return(Str) { 'hello' . $msg }
my $meta = Function::Return::meta \&hello; # Sub::Meta
$meta->returns->list; # [Str]
$meta->args->[0]->type; # Str
$meta->args->[0]->name; # $msg
# Note
Function::Parameters::info \&hello; # undef
This makes it possible to know both type information of function arguments and return value at compile time, making it easier to use for testing etc.
=head2 CLASS METHODS
=head3 wrap_sub($coderef)
This interface is for power-user. Rather than using the C<< :Return >> attribute, it's possible to wrap a coderef like this:
my $wrapped = Function::Return->wrap_sub($orig, [Str]);
$wrapped->();
=head1 NOTE
=head2 enforce LIST to simplify
C<Function::Return> makes the original function is called in list context whether the wrapped function is called in list, scalar, void context:
Expand All @@ -270,23 +134,23 @@ C<wantarray> is convenient, but it sometimes causes confusion. So, in this modul
=head2 requirements of type constraint
The requirements of type constraint of C<Function::Return> is the same as for C<Function::Parameters>. Specific requirements are as follows:
The requirements of type constraint of C<Function::Return> is the same as for L<Function::Parameters>. Specific requirements are as follows:
> The only requirement is that the returned value (here referred to as $tc, for "type constraint") is an object that provides $tc->check($value) and $tc->get_message($value) methods. check is called to determine whether a particular value is valid; it should return a true or false value. get_message is called on values that fail the check test; it should return a string that describes the error.
=head2 compare Return::Type
Both C<Return::Type> and C<Function::Return> perform type checking on function return value, but have some differences.
Both L<Return::Type> and C<Function::Return> perform type checking on function return value, but have some differences.
1. C<Function::Return> is not possible to specify different type constraints for scalar and list context, but C<Return::Type> is possible.
2. C<Function::Return> check type constraint for void context, but C<Return::Type> doesn't.
3. C<Function::Return::meta> can be used together with C<Function::Parameters::Info>, but C<Return::Type> seems a bit difficult.
3. C<Function::Return::Meta#get> can be used together with C<Function::Parameters::Info>, but C<Return::Type> seems a bit difficult.
=head1 SEE ALSO
L<Function::Parameters>, L<Return::Type>
L<Function::Return::Meta>
=head1 LICENSE
Expand Down

0 comments on commit 2b5c022

Please sign in to comment.