| Subject: | missing file(s)? |
Class-Meta-0.31 seems to have one or more missing files, namely SemiAffordance.pm and any related tests. Perhaps it's a cvs related issue?
I've made a stand-in for my own purposes, and submitted it here just in case it's useful for you.
package Class::Meta::AccessorBuilder::SemiAffordance;
# $Id$
=head1 NAME
Class::Meta::AccessorBuilder::SemiAffordance - Semi Affordance style accessor generation
=head1 SYNOPSIS
package MyApp::TypeDef;
use strict;
use Class::Meta::Type;
use IO::Socket;
my $type = Class::Meta::Type->add( key => 'io_socket',
builder => 'affordance',
desc => 'IO::Socket object',
name => 'IO::Socket Object' );
=head1 DESCRIPTION
This module provides the semi-affordance style accessor builder for
Class::Meta. Like affordance accessors, semi-affordance accessors are
attribute accessor methods that separate the getting and setting of an
attribute value into distinct methods. The difference is in the naming of
the attributes. Semi affordance accessors use the perl standard for
accessor naming for the 'get' accessor, which is to say that it is simply
the name of the attribute being accessed. Meanwhile the set accessor is
named "set_" and the name of the attribute. The idea behind this is that
it will simplify coding for API users who are mainly interested in getting
data out of objects of your class.
=head2 Accessors
Class::Meta::AccessorBuilder::SemiAffordance creates two different types of
accessors: getters and setters. The type of accessors created depends on
the value of the C<authz> attribute of the Class::Meta::Attribute for which
the accessor is being created.
For example, if the C<authz> is Class::Meta::RDWR, then two accessor methods
will be created:
my $value = $obj->io_socket;
$obj->set_io_socket($value);
If the value of C<authz> is Class::Meta::READ, then only the get method
will be created:
my $value = $obj->io_socket;
And finally, if the value of C<authz> is Class::Meta::WRITE, then only the set
method will be created (David is not clear on the usefullness of this, and
neither am I, but I too will include it for completeness):
my $value = $obj->set_io_socket;
=head2 Data Type Validation
Class::Meta::AccessorBuilder::SemiAffordance uses all of the validation
checks passed to it to validate new values before assigning them to an
attribute. It also checks to see if the attribute is required, and if so,
adds a check to ensure that its value is never undefined. It does not
currently check to ensure that private and protected methods are used only
in their appropriate contexts, but may do so in a future release.
=head2 Class Attributes
If the C<context> attribute of the attribute object for which accessors are to
be built is C<Class::Meta::CLASS>, Class::Meta::AccessorBuilder will build
accessors for a class attribute instead of an object attribute. Of course,
this means that if you change the value of the class attribute in any
context--whether via a an object, the class name, or an an inherited class
name or object, the value will be changed everywhere.
For example, for a class attribute "count", you can expect the following to
work:
MyApp::Custom->set_count(10);
my $count = MyApp::Custom->count; # Returns 10.
my $obj = MyApp::Custom->new;
$count = $obj->count; # Returns 10.
$obj->set_count(22);
$count = $obj->count; # Returns 22.
my $count = MyApp::Custom->count; # Returns 22.
MyApp::Custom->set_count(35);
$count = $obj->count; # Returns 35.
my $count = MyApp::Custom->count; # Returns 35.
Currently, class attribute accessors are not designed to be inheritable in the
way designed by Class::Data::Inheritable, although this might be changed in a
future release. For now, I expect that the current simple approach will cover
the vast majority of circumstances.
=head1 Private and Protected Attributes
Any attributes that have their C<view> attribute set to Class::Meta::Private
or Class::Meta::Protected get additional validation installed to ensure that
they're truly private and protected. This includes when they are set via
parameters to constructors generated by Class::Meta. The validation is
performed by checking the caller of the accessors, and throwing an exception
when the caller isn't the class that owns the attribute (for private
attributes) or when it doesn't inherit from the class that owns the attribute
(for protected attributes).
As an implementation note, this validation is performed for parameters passed
to constructors created by Class::Meta by ignoring looking for the first
caller that isn't Class::Meta::Constructor:
my $caller = caller;
# Circumvent generated constructors.
for (my $i = 1; $caller eq 'Class::Meta::Constructor'; $i++) {
$caller = caller($i);
}
This works because Class::Meta::Constructor installs the closures that become
constructors, and thus, when those closures call accessors to set new values
for attributes, the caller is Class::Meta::Constructor. By going up the stack
until we find another package, we correctly check to see what context is
setting attribute values via a constructor, rather than the constructor method
itself being the context.
This is a bit of a hack, but since Perl uses call stacks for checking security
in this way, it's the best I could come up with. Other suggestions welcome. Or
see L<Class::Meta::Type|Class::Meta::Type/"Custom Accessor Building"> to
create your own accessor generation code
=cut
use strict;
use Class::Meta;
our $VERSION = "0.14";
sub build_attr_get {
UNIVERSAL::can($_[0]->package, $_[0]->name);
}
sub build_attr_set {
UNIVERSAL::can($_[0]->package, 'set_' . $_[0]->name);
}
my $croak = sub {
require Carp;
our @CARP_NOT = qw(Class::Meta::Attribute);
Carp::croak(@_);
};
my $req_chk = sub {
$croak->("Attribute must be defined") unless defined $_[0];
};
sub build {
my ($pkg, $attr, $create, @checks) = @_;
my $name = $attr->name;
# Add the required check, if needed.
unshift @checks, $req_chk if $attr->required;
my ($get, $set);
if ($attr->context == Class::Meta::CLASS) {
# Create class attribute accessors by creating a closure tha
# references this variable.
my $data = $attr->default;
if ($create >= Class::Meta::GET) {
# Create GET accessor.
$get = sub { $data };
}
if ($create >= Class::Meta::SET) {
# Create SET accessor.
if (@checks) {
$set = sub {
# Check the value passed in.
$_->($_[1]) for @checks;
# Assign the value.
$data = $_[1];
};
} else {
$set = sub {
# Assign the value.
$data = $_[1];
};
}
}
} else {
# Create object attribute accessors.
if ($create >= Class::Meta::GET) {
# Create GET accessor.
$get = sub { $_[0]->{$name} };
}
if ($create >= Class::Meta::SET) {
# Create SET accessor.
if (@checks) {
$set = sub {
# Check the value passed in.
$_->($_[1]) for @checks;
# Assign the value.
$_[0]->{$name} = $_[1];
};
} else {
$set = sub {
# Assign the value.
$_[0]->{$name} = $_[1];
};
}
}
}
# Add public and private checks, if required.
if ($attr->view == Class::Meta::PROTECTED) {
for ($get, $set) {
my $real_sub = $_ or next;
$_ = sub {
my $caller = caller;
# Circumvent generated constructors.
for (my $i = 1; $caller eq 'Class::Meta::Constructor'; $i++) {
$caller = caller($i);
}
$croak->("$name is a protected attribute of $pkg")
unless UNIVERSAL::isa($caller, $pkg);
goto &$real_sub;
};
}
} elsif ($attr->view == Class::Meta::PRIVATE) {
for ($get, $set) {
my $real_sub = $_ or next;
$_ = sub {
my $caller = caller;
# Circumvent generated constructors.
for (my $i = 1; $caller eq 'Class::Meta::Constructor'; $i++) {
$caller = caller($i);
}
$croak->("$name is a private attribute of $pkg")
unless $caller eq $pkg;
goto &$real_sub;
};
}
}
# Install the accessors.
no strict 'refs';
*{"${pkg}::set_$name"} = $set if $set;
*{"${pkg}::$name"} = $get if $get;
}
1;
__END__
=head1 DISTRIBUTION INFORMATION
This file was packaged with the Class-Meta-0.15 distribution.
=head1 BUGS
Please report all bugs via the CPAN Request Tracker at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Meta>.
=head1 AUTHOR
Mark Jaroski <mark@geekhive.net>
=head1 SEE ALSO
=over 4
=item L<Class::Meta|Class::Meta>
This class contains most of the documentation you need to get started with
Class::Meta.
=item L<Class::Meta::AccessorBuilder|Class::Meta::AccessorBuilder>
This module generates Perl style accessors.
=item L<Class::Meta::AccessorBuilder::Affordance|Class::Meta::AccessorBuilder::Affordance>
This module generates affordance accessors.
=item L<Class::Meta::Type|Class::Meta::Type>
This class manages the creation of data types.
=item L<Class::Meta::Attribute|Class::Meta::Attribute>
This class manages Class::Meta class attributes, most of which will have
generated accessors.
=back
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2002-2004, Mark Jaroski. All Rights Reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut