lib/Function/Parameters/Info.pm

   1 package Function::Parameters::Info;
   2
   3 use v5.14.0;
   4 use warnings;
   5
   6 our $VERSION = '1.0301';
   7
   8 # If Moo isn't loaded yet but Moose is, avoid pulling in Moo and fall back to Moose
   9 my ($Moo, $meta_make_immutable);
  10 BEGIN {
  11         if ($INC{'Moose.pm'} && !$INC{'Moo.pm'}) {
  12                 $Moo = 'Moose';
  13                 $meta_make_immutable = sub { $_[0]->meta->make_immutable };
  14         } else {
  15                 require Moo;
  16                 $Moo = 'Moo';
  17                 $meta_make_immutable = sub {};
  18         }
  19         $Moo->import;
  20 }
  21
  22 {
  23         package Function::Parameters::Param;
  24
  25         BEGIN { $Moo->import; }
  26         use overload
  27                 fallback => 1,
  28                 '""'     => sub { $_[0]->name },
  29         ;
  30
  31         has $_ => (is => 'ro') for qw(name type);
  32
  33         __PACKAGE__->$meta_make_immutable;
  34 }
  35
  36 my @pn_ro = glob '{positional,named}_{required,optional}';
  37
  38 for my $attr (qw[keyword invocant slurpy], map "_$_", @pn_ro) {
  39         has $attr => (
  40                 is => 'ro',
  41         );
  42 }
  43
  44 for my $gen (join "\n", map "sub $_ { \@{\$_[0]->_$_} }", @pn_ro) {
  45         eval "$gen\n1" or die $@;
  46 }
  47
  48 sub args_min {
  49         my $self = shift;
  50         my $r = 0;
  51         $r++ if defined $self->invocant;
  52         $r += $self->positional_required;
  53         $r += $self->named_required * 2;
  54         $r
  55 }
  56
  57 sub args_max {
  58         my $self = shift;
  59         return 0 + 'Inf' if defined $self->slurpy || $self->named_required || $self->named_optional;
  60         my $r = 0;
  61         $r++ if defined $self->invocant;
  62         $r += $self->positional_required;
  63         $r += $self->positional_optional;
  64         $r
  65 }
  66
  67 __PACKAGE__->$meta_make_immutable;
  68
  69 'ok'
  70
  71 __END__
  72
  73 =encoding UTF-8
  74
  75 =head1 NAME
  76
  77 Function::Parameters::Info - Information about parameter lists
  78
  79 =head1 SYNOPSIS
  80
  81   use Function::Parameters;
  82
  83   fun foo($x, $y, :$hello, :$world = undef) {}
  84
  85   my $info = Function::Parameters::info \&foo;
  86   my $p0 = $info->invocant;             # undef
  87   my @p1 = $info->positional_required;  # ('$x', '$y')
  88   my @p2 = $info->positional_optional;  # ()
  89   my @p3 = $info->named_required;       # ('$hello')
  90   my @p4 = $info->named_optional;       # ('$world')
  91   my $p5 = $info->slurpy;               # undef
  92   my $min = $info->args_min;  # 4
  93   my $max = $info->args_max;  # inf
  94
  95   my $invocant = Function::Parameters::info(method () { 42 })->invocant;  # '$self'
  96
  97   my $slurpy = Function::Parameters::info(fun {})->slurpy;  # '@_'
  98
  99 =head1 DESCRIPTION
 100
 101 L<C<Function::Parameters::info>|Function::Parameters/Introspection> returns
 102 objects of this class to describe parameter lists of functions. The following
 103 methods are available:
 104
 105 =head2 $info->invocant
 106
 107 Returns the name of the variable into which the first argument is
 108 L<C<shift>|perlfunc/shift>ed automatically, or C<undef> if no such thing
 109 exists. This will usually return C<'$self'> for methods.
 110
 111 =head2 $info->positional_required
 112
 113 Returns a list of the names of the required positional parameters (or a count
 114 in scalar context).
 115
 116 =head2 $info->positional_optional
 117
 118 Returns a list of the names of the optional positional parameters (or a count
 119 in scalar context).
 120
 121 =head2 $info->named_required
 122
 123 Returns a list of the names of the required named parameters (or a count
 124 in scalar context).
 125
 126 =head2 $info->named_optional
 127
 128 Returns a list of the names of the optional named parameters (or a count
 129 in scalar context).
 130
 131 =head2 $info->slurpy
 132
 133 Returns the name of the final array or hash that gobbles up all remaining
 134 arguments, or C<undef> if no such thing exists.
 135
 136 As a special case, functions defined without an explicit parameter list (i.e.
 137 without C<( )>) will return C<'@_'> here because they accept any number of
 138 arguments.
 139
 140 =head2 $info->args_min
 141
 142 Returns the minimum number of arguments this function requires. This is
 143 computed as follows: Invocant and required positional parameters count 1 each.
 144 Optional parameters don't count. Required named parameters count 2 each (key +
 145 value). Slurpy parameters don't count either because they accept empty lists.
 146
 147 =head2 $info->args_max
 148
 149 Returns the maximum number of arguments this function accepts. This is computed
 150 as follows: If there is any named or slurpy parameter, the result is C<Inf>.
 151 Otherwise the result is the sum of all invocant and positional parameters.
 152
 153 =head2 Experimental feature: Types
 154
 155 All the methods described above actually return parameter objects wherever the
 156 description says "name". These objects have two methods: C<name>, which
 157 returns the name of the parameter (as a plain string), and C<type>, which
 158 returns the corresponding type constraint object (or undef if there was no type
 159 specified).
 160
 161 This should be invisible if you don't use types because the objects also
 162 L<overload|overload> stringification to call C<name>. That is, if you treat
 163 parameter objects like strings, they behave like strings (i.e. their names).
 164
 165 =head1 SEE ALSO
 166
 167 L<Function::Parameters>
 168
 169 =head1 AUTHOR
 170
 171 Lukas Mai, C<< <l.mai at web.de> >>
 172
 173 =head1 COPYRIGHT & LICENSE
 174
 175 Copyright 2013 Lukas Mai.
 176
 177 This program is free software; you can redistribute it and/or modify it
 178 under the terms of either: the GNU General Public License as published
 179 by the Free Software Foundation; or the Artistic License.
 180
 181 See http://dev.perl.org/licenses/ for more information.
 182
 183 =cut