Class::Declare::Attributes - Class::Declare method types using Perl attributes.

Class-Declare-Attributes documentation Contained in the Class-Declare-Attributes distribution.

Index

Code Index:

NAME

Top

Class::Declare::Attributes - Class::Declare method types using Perl attributes.

SYNOPSIS

Top

  package My::Class;

  use 5.006;
  use strict;
  use warnings;

  use base qw( Class::Declare::Attributes );

  # declare the class/instance attributes
  __PACKAGE__->declare( ... );

  #
  # declare class/static/restricted/etc methods of this package
  #

  sub my_abstract   : abstract   { ... }
  sub my_class      : class      { ... }
  sub my_static     : static     { ... }
  sub my_restricted : restricted { ... }
  sub my_public     : public     { ... }
  sub my_private    : private    { ... }
  sub my_protected  : protected  { ... }

DESCRIPTION

Top

Class::Declare::Attributes extends Class::Declare by adding support for Perl attributes for specifying class method types. This extension was inspired by Damian Conway's Attribute::Handlers module, and Tatsuhiko Miyagawa's Attribute::Protected module. The original implementation used Attribute::Handlers, but now simply refers to attributes.

The addition of Perl attribute support (not to be confused with object attributes, which are entirely different, and also supported by Class::Declare) greatly simplifies the specification of Class::Declare-derived class and instance methods. This should aid in the porting of existing code (Perl, Java and C++) to a Class::Declare framework, as well as simplify the development of new modules.

With the addition of Perl attributes, Class::Declare methods can now be written as

  sub method : public
  {
    my $self = shift;
    ...
  }

instead of

  sub method
  {
    my $self = __PACKAGE__->public( shift );
    ...
  }

Attributes

Class::Declare::Attributes defines six method or subroutine attributes that correspond to the six method and object- and class-attribute types of Class::Declare:

:abstract

abstract methods are merely placeholders and must be defined in subclasses. If called, an abstract method will throw an error through die().

:class

class methods are accessible from anywhere, and may be called through the class, a derived class, or any instance derived from the defining class. This is the class equivalent of public methods.

:static

static methods may only be accessed within the defining class and instances of that class. This is the class equivalent of private methods.

:restricted

restricted methods may only be accessed from within the defining class and all classes and objects that inherit from it. This is the class equivalent of protected methods.

:public

public methods are accessible from anywhere, but only through object instances derived from the defining class.

:private

private methods are only accessible from within the defining class and instances of that class, and only through instances of the defining class.

:protected

protected methods are only accessible from within the defining class and all classes and objects derived from the defining class. As an instance method it may only be accessed via an object instance.

The attributes defined by Class::Declare::Attributes are not to be confused with the object and class attributes defined by Class::Declare::declare(). The clash in terminology is unfortunate, but as long as you remember the context of your attributes, i.e. are they Perl-attributes, or class-/object-attributes, the distinction should be clear.

Attribute Modifiers

Class::Declare::Attributes supports the use of the class and instance attribute modifiers defined by Class::Declare. These modifiers may be imported into the current namespace by either explicitly listing the modifier (rw and ro) or using one of the predefined tags: :read-write, :read-only and :modifiers. For example:

  use Class::Declare::Attributes qw( :read-only );

Note: The "magic" of Class::Declare::Attributes that defines the method attributes is performed during the compilation of the module it is used in. To access the attribute modifiers, the use base approach should be replaced with the more traditional:

  use Class::Declare::Attributes qw( :modifiers );
  use vars qw( @ISA );
  @ISA = qw( Class::Declare::Attributes );

However, because Class::Declare::Attributes (or more precisely Attribute::Handlers) operates before the execution phase, the assignment to @ISA will occur too late to take effect (resulting in an invalid attribute error). To prevent this error, and to bring the assignment to @ISA forward in the module compilation/execution phase, the assignment should be wrapped in a BEGIN {} block.

  BEGIN { @ISA = qw( Class::Declare::Attributes ); }

For more information on class and instance attribute modifiers, please refer to Class::Declare.

Methods

require( class )

In the event that a Class::Declare::Attributes-derived class needs to be loaded dynamically, the require() method should be used to ensure correct handling of the Class::Declare::Attributes-style attributes. require() is a class method of Class::Declare::Attributes and should therefore be called along the lines of the following:

  package My::Class;

  use strict;
  use warnings;

  use bae qw( Class::Declare::Attributes );

  ...

      my $class   = 'My::Class::To::Load';
         __PACKAGE__->require( $class )    or die;

$class can be either a class name (as above) or a string containing the definition of the class. require() will return true on success and undefined on failure, with $@ containing the error.

CAVEATS

Top

Class::Declare::Attributes is distributed as a separate module to Class::Declare as it requires Perl versions 5.6.0 and greater, while Class::Declare supports all object-aware versions of Perl (i.e. version 5.0 and above).

The interface Class::Declare::Attributes provides is not ideal. In fact, some might suggest that it's 'illegal'. In some ways, yes, it is illegal, because it has hijacked some lowercase attribute names that Perl has marked down for possible future use. However, as of Perl 5.8.0, these attributes are not in use (:shared is, which is why Class::Declare changed this class of attributes and methods to restricted), and so we may as well take advantage of them.

This is an example of what can be done with Perl (especially if you're willing to bend the rules), and who knows, maybe it's a glimpse of the sort of capabilities we'll see in Perl 6.

SEE ALSO

Top

Class::Declare, attributes, Attribute::Protected, Attribute::Handlers.

AUTHOR

Top

Ian Brayshaw, <ian@onemore.org>

COPYRIGHT AND LICENSE

Top

Copyright 2003-2010 by Ian Brayshaw. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Class-Declare-Attributes documentation Contained in the Class-Declare-Attributes distribution. 
# $Revision: 1515 $
package Class::Declare::Attributes;

use 5.006;
use strict;
use warnings;
use attributes;

use Class::Declare  qw( :modifiers );
use File::Spec::Functions       qw();
use base qw( Class::Declare        );
use vars qw( $VERSION $REVISION    );

    $VERSION      = '0.08';
    $REVISION     = '$Revision: 1515 $';

# need to copy the export symbols from Class::Declare
# to permit Class::Declare::Attributes to provide attribute modifiers
    *EXPORT_OK    = *Class::Declare::EXPORT_OK;
    *EXPORT_TAGS  = *Class::Declare::EXPORT_TAGS;


# declare the 'attributes' helper routines
BEGIN {

  # define the attributes that are wrapped by this class
  my  %__ATTR__ = map { $_ => 1 } qw( abstract
                                      class
                                      restricted
                                      static
                                      public
                                      protected
                                      private    );

  # suppress the warnings surrounding the use of attributes that may be
  # reserved for future use
  #   - this is naughty ... oh, well ... can be changed if necessary
  #   - we want to suppress this warning without disabling all warnings
  #   - we previously set $^W to 0, but this is very heavy handed, so
  #     let's try the following
  $SIG{__WARN__}  = sub {
    # if we detect a violation caused by C::D::A, then suppress it,
    # otherwise let it through
    my  $pkg    = __PACKAGE__;
    ( $_[0] =~ /attribute may clash .+? reserved word: (\w+)/o ||
      $_[0] =~ /^Declaration of (\w+) .+? package $pkg .+? reserved word/o )
        # ensure the attribute belongs to C::D::A
        and ( $__ATTR__{ $1 } )
        and return 1; # do nothing

    # otherwise, return the standard warn() response
    warn $_[0];
  };  # $SIG{__WARN__}()


  # keep a log of calls made to set the attributes
  my  %__PKGS__ = ();
  my  %__DONE__ = ();


# MODIFY_CODE_ATTRIBUTES()
#
# Keep a reference of the and type of attribute for each method specified as
#
#     sub method : type { ... }
#
sub MODIFY_CODE_ATTRIBUTES
{
  my  ( $pkg , $ref , @attr )   = @_;

  # only consider the attributes that we know about
  my    @unknown;   undef @unknown;
  foreach my $attr ( @attr ) {
    # if this not an attribute we care about, then add it to the list of
    # attributes to return
    push @unknown , $attr
      and next                unless ( exists $__ATTR__{ $attr } );

    # have we already assigned one of our attributes to this target?
    #   - if we have, then we should raise an error
    if ( defined ( my $previous =  $__PKGS__{ $pkg }->{ $ref } ) ) {
      # if this reference has already been assigned one of our attributes,
      # then we have a problem if we are attempting to now assign a different
      # attribute
      #   - something declared with the same attribute twice is not a problem
      #     as we just ignore the subsequent assignment
      next              if ( $previous eq $attr );

      # two conflicting attribute assignments
      die "conflicting CODE attribute assignments of '$previous' "
        . "and '$attr' in $pkg";
    }

    # store this attribute assignment
    $__PKGS__{ $pkg }->{ $ref } = $attr;
    
    # assign the CORE 'method' attribute to this reference as well
    #   - each code reference assigned a Class::Declare::Attributes interface
    #     is also actually a method
            attributes::->import( CORE => $ref => 'method' );
  }

  # if we have any unknown attributes, then return them
  return @unknown         if ( @unknown );

  # otherwise, there's nothing more to do
  return;
} # MODIFY_CODE_ATTRIBUTES()


# FETCH_CODE_ATTRIBUTES()
#
# Return the type of attribute for the given package and reference
sub FETCH_CODE_ATTRIBUTES
{
  my  ( $pkg , $ref )   = @_;

  # if this is known package and reference, then return its attributes
  return $__PKGS__{ $pkg }->{ $ref };
} # FETCH_CODE_ATTRIBUTES()



# __init__()
#
# Initialise the code wrapping for Class::Declare-style methods
#   - this needs to be called either at INIT time or when declare() is called
#     to ensure dynamically loaded modules are handled correctly and the
#     strict() setting is obeyed
sub __init__
{
  my  $self   = __PACKAGE__->static( shift );
  my  @pkg    = ( defined $_[0] ) ? ( $_[0] ) : keys %__PKGS__;

  # iterate through the given package(s)
  foreach my $pkg ( @pkg ) {
    no strict 'refs';

    # do we have strict checking for this package on?
    my  $strict = $pkg->strict;

    # if we have strict checking off and we've seen this package before
    # then we should ensure we 'unnwrap' all wrapped routines
    unless ( $strict ) {
      if ( my $wrapped = delete $__DONE__{ $pkg } ) {
        while ( my ( $glob , $ref ) = each %{ $wrapped } ) {
          no warnings 'redefine';

          *{ $glob }  = $ref;
        }
      }

      # no point proceeding, since we don't have strict checking on
      return;
    }

    # iterate through the symbol tree of this package
    while ( my ( $name , $sym ) = each %{ $pkg . '::' } ) {
      no warnings 'once';

      # if we don't have a normal symbol table entry, then skip
      #   - occasionally we will find a reference here not a GLOB
               ( ref $sym )                 and next;

      # if we don't have a CODE reference then we can't proceed
      my  $ref  = *{ $sym }{ CODE }           or next;
      my  @attr = grep { defined } attributes::get( $ref );

      # filter attributes that don't belong to the list fo C::D attributes
          @attr = grep { defined } grep { $__ATTR__{ $_ } } @attr;

      # if there are no attributes, then there's nothing to do
        ( @attr )                             or next;

      # extract the name of this subroutine
      my  $glob = $pkg . '::' . $name;

      # if we have strict access checking, then "wrap" this routine
      if ( $strict ) {
        no warnings 'redefine';

        my  $type   = $attr[0];
         *{ $glob } = sub { $pkg->$type( $_[0] , $glob ); goto $ref };

        # make note that this method has been wrapped
        #   - store the original CODE reference for this glob
        $__DONE__{ $pkg }->{ $glob }  = $ref;
      }
    }
  }
} # __init__()

} # BEGIN()


# require()
#
# Load the given class using Perl's require(), ensuring __init__() is called
# after the class has been successfully loaded. This is to ensure the correct
# subroutine wrappers are put in place.
#
# If the given class contains ';' then we assume that it's the string of the
# class rather than the filename, so we simply eval() that, rather than trying
# to load it from the filesystem.
sub require : class
{
  my  $self   = shift;
  # if there's no class then there's nothing to do
  my  $class  = shift                   or return undef;

  # do we have a file or the text of the class?
  if ( $class =~ m/;/o ) {
    # we assume we have the body of a class, so we just eval() it
    eval $class;

  # otherwise we have to load the file from disk
  } else {
    # convert the class into a file name
    my  $file   = File::Spec::Functions::catfile( split '::' , $class ) . '.pm';

    # attempt to load the file
    #   - return undef if there's a problem
    eval { require $file };
  }

  # if there were any problems, then we should fail
    ( $@ )                             and return undef;

  # if we've loaded this class, then ensure __init__() is called
      $self->__init__;

  1;  # everything is OK
} # require()


# for modules loaded by use(), ensure __init__() is called prior to code
# execution
INIT { __PACKAGE__->__init__ }


1;  # end of module
__END__