[Summary view] [Print] [Text view]

   1  package attributes;
   2  
   3  our $VERSION = 0.08;
   4  
   5  @EXPORT_OK = qw(get reftype);
   6  @EXPORT = ();
   7  %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
   8  
   9  use strict;
  10  
  11  sub croak {
  12      require Carp;
  13      goto &Carp::croak;
  14  }
  15  
  16  sub carp {
  17      require Carp;
  18      goto &Carp::carp;
  19  }
  20  
  21  ## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{}
  22  #sub reftype ($) ;
  23  #sub _fetch_attrs ($) ;
  24  #sub _guess_stash ($) ;
  25  #sub _modify_attrs ;
  26  #
  27  # The extra trips through newATTRSUB in the interpreter wipe out any savings
  28  # from avoiding the BEGIN block.  Just do the bootstrap now.
  29  BEGIN { bootstrap attributes }
  30  
  31  sub import {
  32      @_ > 2 && ref $_[2] or do {
  33      require Exporter;
  34      goto &Exporter::import;
  35      };
  36      my (undef,$home_stash,$svref,@attrs) = @_;
  37  
  38      my $svtype = uc reftype($svref);
  39      my $pkgmeth;
  40      $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_$svtype}_ATTRIBUTES")
  41      if defined $home_stash && $home_stash ne '';
  42      my @badattrs;
  43      if ($pkgmeth) {
  44      my @pkgattrs = _modify_attrs($svref, @attrs);
  45      @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
  46      if (!@badattrs && @pkgattrs) {
  47              require warnings;
  48          return unless warnings::enabled('reserved');
  49          @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs;
  50          if (@pkgattrs) {
  51          for my $attr (@pkgattrs) {
  52              $attr =~ s/\(.+\z//s;
  53          }
  54          my $s = ((@pkgattrs == 1) ? '' : 's');
  55          carp "$svtype package attribute$s " .
  56              "may clash with future reserved word$s: " .
  57              join(' : ' , @pkgattrs);
  58          }
  59      }
  60      }
  61      else {
  62      @badattrs = _modify_attrs($svref, @attrs);
  63      }
  64      if (@badattrs) {
  65      croak "Invalid $svtype attribute" .
  66          (( @badattrs == 1 ) ? '' : 's') .
  67          ": " .
  68          join(' : ', @badattrs);
  69      }
  70  }
  71  
  72  sub get ($) {
  73      @_ == 1  && ref $_[0] or
  74      croak 'Usage: '.__PACKAGE__.'::get $ref';
  75      my $svref = shift;
  76      my $svtype = uc reftype $svref;
  77      my $stash = _guess_stash $svref;
  78      $stash = caller unless defined $stash;
  79      my $pkgmeth;
  80      $pkgmeth = UNIVERSAL::can($stash, "FETCH_$svtype}_ATTRIBUTES")
  81      if defined $stash && $stash ne '';
  82      return $pkgmeth ?
  83          (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) :
  84          (_fetch_attrs($svref))
  85      ;
  86  }
  87  
  88  sub require_version { goto &UNIVERSAL::VERSION }
  89  
  90  1;
  91  __END__
  92  #The POD goes here
  93  
  94  =head1 NAME
  95  
  96  attributes - get/set subroutine or variable attributes
  97  
  98  =head1 SYNOPSIS
  99  
 100    sub foo : method ;
 101    my ($x,@y,%z) : Bent = 1;
 102    my $s = sub : method { ... };
 103  
 104    use attributes ();    # optional, to get subroutine declarations
 105    my @attrlist = attributes::get(\&foo);
 106  
 107    use attributes 'get'; # import the attributes::get subroutine
 108    my @attrlist = get \&foo;
 109  
 110  =head1 DESCRIPTION
 111  
 112  Subroutine declarations and definitions may optionally have attribute lists
 113  associated with them.  (Variable C<my> declarations also may, but see the
 114  warning below.)  Perl handles these declarations by passing some information
 115  about the call site and the thing being declared along with the attribute
 116  list to this module.  In particular, the first example above is equivalent to
 117  the following:
 118  
 119      use attributes __PACKAGE__, \&foo, 'method';
 120  
 121  The second example in the synopsis does something equivalent to this:
 122  
 123      use attributes ();
 124      my ($x,@y,%z);
 125      attributes::->import(__PACKAGE__, \$x, 'Bent');
 126      attributes::->import(__PACKAGE__, \@y, 'Bent');
 127      attributes::->import(__PACKAGE__, \%z, 'Bent');
 128      ($x,@y,%z) = 1;
 129  
 130  Yes, that's a lot of expansion.
 131  
 132  B<WARNING>: attribute declarations for variables are still evolving.
 133  The semantics and interfaces of such declarations could change in
 134  future versions.  They are present for purposes of experimentation
 135  with what the semantics ought to be.  Do not rely on the current
 136  implementation of this feature.
 137  
 138  There are only a few attributes currently handled by Perl itself (or
 139  directly by this module, depending on how you look at it.)  However,
 140  package-specific attributes are allowed by an extension mechanism.
 141  (See L<"Package-specific Attribute Handling"> below.)
 142  
 143  The setting of subroutine attributes happens at compile time.
 144  Variable attributes in C<our> declarations are also applied at compile time.
 145  However, C<my> variables get their attributes applied at run-time.
 146  This means that you have to I<reach> the run-time component of the C<my>
 147  before those attributes will get applied.  For example:
 148  
 149      my $x : Bent = 42 if 0;
 150  
 151  will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute
 152  to the variable.
 153  
 154  An attempt to set an unrecognized attribute is a fatal error.  (The
 155  error is trappable, but it still stops the compilation within that
 156  C<eval>.)  Setting an attribute with a name that's all lowercase
 157  letters that's not a built-in attribute (such as "foo") will result in
 158  a warning with B<-w> or C<use warnings 'reserved'>.
 159  
 160  =head2 Built-in Attributes
 161  
 162  The following are the built-in attributes for subroutines:
 163  
 164  =over 4
 165  
 166  =item locked
 167  
 168  B<5.005 threads only!  The use of the "locked" attribute currently
 169  only makes sense if you are using the deprecated "Perl 5.005 threads"
 170  implementation of threads.>
 171  
 172  Setting this attribute is only meaningful when the subroutine or
 173  method is to be called by multiple threads.  When set on a method
 174  subroutine (i.e., one marked with the B<method> attribute below),
 175  Perl ensures that any invocation of it implicitly locks its first
 176  argument before execution.  When set on a non-method subroutine,
 177  Perl ensures that a lock is taken on the subroutine itself before
 178  execution.  The semantics of the lock are exactly those of one
 179  explicitly taken with the C<lock> operator immediately after the
 180  subroutine is entered.
 181  
 182  =item method
 183  
 184  Indicates that the referenced subroutine is a method.
 185  This has a meaning when taken together with the B<locked> attribute,
 186  as described there.  It also means that a subroutine so marked
 187  will not trigger the "Ambiguous call resolved as CORE::%s" warning.
 188  
 189  =item lvalue
 190  
 191  Indicates that the referenced subroutine is a valid lvalue and can
 192  be assigned to. The subroutine must return a modifiable value such
 193  as a scalar variable, as described in L<perlsub>.
 194  
 195  =back
 196  
 197  For global variables there is C<unique> attribute: see L<perlfunc/our>.
 198  
 199  =head2 Available Subroutines
 200  
 201  The following subroutines are available for general use once this module
 202  has been loaded:
 203  
 204  =over 4
 205  
 206  =item get
 207  
 208  This routine expects a single parameter--a reference to a
 209  subroutine or variable.  It returns a list of attributes, which may be
 210  empty.  If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>)
 211  to raise a fatal exception.  If it can find an appropriate package name
 212  for a class method lookup, it will include the results from a
 213  C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in
 214  L<"Package-specific Attribute Handling"> below.
 215  Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned.
 216  
 217  =item reftype
 218  
 219  This routine expects a single parameter--a reference to a subroutine or
 220  variable.  It returns the built-in type of the referenced variable,
 221  ignoring any package into which it might have been blessed.
 222  This can be useful for determining the I<type> value which forms part of
 223  the method names described in L<"Package-specific Attribute Handling"> below.
 224  
 225  =back
 226  
 227  Note that these routines are I<not> exported by default.
 228  
 229  =head2 Package-specific Attribute Handling
 230  
 231  B<WARNING>: the mechanisms described here are still experimental.  Do not
 232  rely on the current implementation.  In particular, there is no provision
 233  for applying package attributes to 'cloned' copies of subroutines used as
 234  closures.  (See L<perlref/"Making References"> for information on closures.)
 235  Package-specific attribute handling may change incompatibly in a future
 236  release.
 237  
 238  When an attribute list is present in a declaration, a check is made to see
 239  whether an attribute 'modify' handler is present in the appropriate package
 240  (or its @ISA inheritance tree).  Similarly, when C<attributes::get> is
 241  called on a valid reference, a check is made for an appropriate attribute
 242  'fetch' handler.  See L<"EXAMPLES"> to see how the "appropriate package"
 243  determination works.
 244  
 245  The handler names are based on the underlying type of the variable being
 246  declared or of the reference passed.  Because these attributes are
 247  associated with subroutine or variable declarations, this deliberately
 248  ignores any possibility of being blessed into some package.  Thus, a
 249  subroutine declaration uses "CODE" as its I<type>, and even a blessed
 250  hash reference uses "HASH" as its I<type>.
 251  
 252  The class methods invoked for modifying and fetching are these:
 253  
 254  =over 4
 255  
 256  =item FETCH_I<type>_ATTRIBUTES
 257  
 258  This method is called with two arguments:  the relevant package name,
 259  and a reference to a variable or subroutine for which package-defined
 260  attributes are desired.  The expected return value is a list of
 261  associated attributes.  This list may be empty.
 262  
 263  =item MODIFY_I<type>_ATTRIBUTES
 264  
 265  This method is called with two fixed arguments, followed by the list of
 266  attributes from the relevant declaration.  The two fixed arguments are
 267  the relevant package name and a reference to the declared subroutine or
 268  variable.  The expected return value is a list of attributes which were
 269  not recognized by this handler.  Note that this allows for a derived class
 270  to delegate a call to its base class, and then only examine the attributes
 271  which the base class didn't already handle for it.
 272  
 273  The call to this method is currently made I<during> the processing of the
 274  declaration.  In particular, this means that a subroutine reference will
 275  probably be for an undefined subroutine, even if this declaration is
 276  actually part of the definition.
 277  
 278  =back
 279  
 280  Calling C<attributes::get()> from within the scope of a null package
 281  declaration C<package ;> for an unblessed variable reference will
 282  not provide any starting package name for the 'fetch' method lookup.
 283  Thus, this circumstance will not result in a method call for package-defined
 284  attributes.  A named subroutine knows to which symbol table entry it belongs
 285  (or originally belonged), and it will use the corresponding package.
 286  An anonymous subroutine knows the package name into which it was compiled
 287  (unless it was also compiled with a null package declaration), and so it
 288  will use that package name.
 289  
 290  =head2 Syntax of Attribute Lists
 291  
 292  An attribute list is a sequence of attribute specifications, separated by
 293  whitespace or a colon (with optional whitespace).
 294  Each attribute specification is a simple
 295  name, optionally followed by a parenthesised parameter list.
 296  If such a parameter list is present, it is scanned past as for the rules
 297  for the C<q()> operator.  (See L<perlop/"Quote and Quote-like Operators">.)
 298  The parameter list is passed as it was found, however, and not as per C<q()>.
 299  
 300  Some examples of syntactically valid attribute lists:
 301  
 302      switch(10,foo(7,3))  :  expensive
 303      Ugly('\(") :Bad
 304      _5x5
 305      locked method
 306  
 307  Some examples of syntactically invalid attribute lists (with annotation):
 308  
 309      switch(10,foo()        # ()-string not balanced
 310      Ugly('(')            # ()-string not balanced
 311      5x5                # "5x5" not a valid identifier
 312      Y2::north            # "Y2::north" not a simple identifier
 313      foo + bar            # "+" neither a colon nor whitespace
 314  
 315  =head1 EXPORTS
 316  
 317  =head2 Default exports
 318  
 319  None.
 320  
 321  =head2 Available exports
 322  
 323  The routines C<get> and C<reftype> are exportable.
 324  
 325  =head2 Export tags defined
 326  
 327  The C<:ALL> tag will get all of the above exports.
 328  
 329  =head1 EXAMPLES
 330  
 331  Here are some samples of syntactically valid declarations, with annotation
 332  as to how they resolve internally into C<use attributes> invocations by
 333  perl.  These examples are primarily useful to see how the "appropriate
 334  package" is found for the possible method lookups for package-defined
 335  attributes.
 336  
 337  =over 4
 338  
 339  =item 1.
 340  
 341  Code:
 342  
 343      package Canine;
 344      package Dog;
 345      my Canine $spot : Watchful ;
 346  
 347  Effect:
 348  
 349      use attributes ();
 350      attributes::->import(Canine => \$spot, "Watchful");
 351  
 352  =item 2.
 353  
 354  Code:
 355  
 356      package Felis;
 357      my $cat : Nervous;
 358  
 359  Effect:
 360  
 361      use attributes ();
 362      attributes::->import(Felis => \$cat, "Nervous");
 363  
 364  =item 3.
 365  
 366  Code:
 367  
 368      package X;
 369      sub foo : locked ;
 370  
 371  Effect:
 372  
 373      use attributes X => \&foo, "locked";
 374  
 375  =item 4.
 376  
 377  Code:
 378  
 379      package X;
 380      sub Y::x : locked { 1 }
 381  
 382  Effect:
 383  
 384      use attributes Y => \&Y::x, "locked";
 385  
 386  =item 5.
 387  
 388  Code:
 389  
 390      package X;
 391      sub foo { 1 }
 392  
 393      package Y;
 394      BEGIN { *bar = \&X::foo; }
 395  
 396      package Z;
 397      sub Y::bar : locked ;
 398  
 399  Effect:
 400  
 401      use attributes X => \&X::foo, "locked";
 402  
 403  =back
 404  
 405  This last example is purely for purposes of completeness.  You should not
 406  be trying to mess with the attributes of something in a package that's
 407  not your own.
 408  
 409  =head1 SEE ALSO
 410  
 411  L<perlsub/"Private Variables via my()"> and
 412  L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
 413  L<attrs> for the obsolescent form of subroutine attribute specification
 414  which this module replaces;
 415  L<perlfunc/use> for details on the normal invocation mechanism.
 416  
 417  =cut
 418