lib/Function/Parameters/Info.pm

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