[p5sagit/Class-Accessor-Grouped.git] / lib / Class / Accessor / Grouped.pm

package Class::Accessor::Grouped;
use strict;
use warnings;
use Carp ();
use Class::Inspector ();
use Scalar::Util ();
use MRO::Compat;
use Sub::Name ();

our $VERSION = '0.09002';
$VERSION = eval $VERSION;

=head1 NAME

Class::Accessor::Grouped - Lets you build groups of accessors

=head1 SYNOPSIS

=head1 DESCRIPTION

This class lets you build groups of accessors that will call different
getters and setters.

=head1 METHODS

=head2 mk_group_accessors

=over 4

=item Arguments: $group, @fieldspec

Returns: none

=back

Creates a set of accessors in a given group.

$group is the name of the accessor group for the generated accessors; they
will call get_$group($field) on get and set_$group($field, $value) on set.

If you want to mimic Class::Accessor's mk_accessors $group has to be 'simple'
to tell Class::Accessor::Grouped to use its own get_simple and set_simple
methods.

@fieldspec is a list of field/accessor names; if a fieldspec is a scalar
this is used as both field and accessor name, if a listref it is expected to
be of the form [ $accessor, $field ].

=cut

sub mk_group_accessors {
  my ($self, $group, @fields) = @_;

  $self->_mk_group_accessors('make_group_accessor', $group, @fields);
  return;
}


{
    no strict 'refs';
    no warnings 'redefine';

    sub _mk_group_accessors {
        my($self, $maker, $group, @fields) = @_;
        my $class = Scalar::Util::blessed $self || $self;

        # So we don't have to do lots of lookups inside the loop.
        $maker = $self->can($maker) unless ref $maker;
        
        my $hasXS = _hasXS();

        foreach my $field (@fields) {
            if( $field eq 'DESTROY' ) {
                Carp::carp("Having a data accessor named DESTROY  in ".
                             "'$class' is unwise.");
            }

            my $name = $field;

            ($name, $field) = @$field if ref $field;
            
            my $alias = "_${name}_accessor";
            my $full_name = join('::', $class, $name);
            my $full_alias = join('::', $class, $alias);
            
            if ( $hasXS && $group eq 'simple' ) {
                Class::XSAccessor::newxs_accessor("${class}::${name}", $field, 0);
                Class::XSAccessor::newxs_accessor("${class}::${alias}", $field, 0);
                
                # XXX: is the alias accessor really necessary?
            }
            else {
                my $accessor = $self->$maker($group, $field);
                my $alias_accessor = $self->$maker($group, $field);
                
                *$full_name = Sub::Name::subname($full_name, $accessor);
                  #unless defined &{$class."\:\:$field"}
                
                *$full_alias = Sub::Name::subname($full_alias, $alias_accessor);
                  #unless defined &{$class."\:\:$alias"}
            }
        }
    }
}

=head2 mk_group_ro_accessors

=over 4

=item Arguments: $group, @fieldspec

Returns: none

=back

Creates a set of read only accessors in a given group. Identical to
L</mk_group_accessors> but accessors will throw an error if passed a value
rather than setting the value.

=cut

sub mk_group_ro_accessors {
    my($self, $group, @fields) = @_;

    $self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
}

=head2 mk_group_wo_accessors

=over 4

=item Arguments: $group, @fieldspec

Returns: none

=back

Creates a set of write only accessors in a given group. Identical to
L</mk_group_accessors> but accessors will throw an error if not passed a
value rather than getting the value.

=cut

sub mk_group_wo_accessors {
    my($self, $group, @fields) = @_;

    $self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
}

=head2 make_group_accessor

=over 4

=item Arguments: $group, $field

Returns: $sub (\CODE)

=back

Returns a single accessor in a given group; called by mk_group_accessors
for each entry in @fieldspec.

=cut

sub make_group_accessor {
    my ($class, $group, $field) = @_;

    my $set = "set_$group";
    my $get = "get_$group";

    # eval for faster fastiness
    return eval "sub {
        if(\@_ > 1) {
            return shift->$set('$field', \@_);
        }
        else {
            return shift->$get('$field');
        }
    };"
}

=head2 make_group_ro_accessor

=over 4

=item Arguments: $group, $field

Returns: $sub (\CODE)

=back

Returns a single read-only accessor in a given group; called by
mk_group_ro_accessors for each entry in @fieldspec.

=cut

sub make_group_ro_accessor {
    my($class, $group, $field) = @_;

    my $get = "get_$group";

    return eval "sub {
        if(\@_ > 1) {
            my \$caller = caller;
            Carp::croak(\"'\$caller' cannot alter the value of '$field' on \".
                        \"objects of class '$class'\");
        }
        else {
            return shift->$get('$field');
        }
    };"
}

=head2 make_group_wo_accessor

=over 4

=item Arguments: $group, $field

Returns: $sub (\CODE)

=back

Returns a single write-only accessor in a given group; called by
mk_group_wo_accessors for each entry in @fieldspec.

=cut

sub make_group_wo_accessor {
    my($class, $group, $field) = @_;

    my $set = "set_$group";

    return eval "sub {
        unless (\@_ > 1) {
            my \$caller = caller;
            Carp::croak(\"'\$caller' cannot access the value of '$field' on \".
                        \"objects of class '$class'\");
        }
        else {
            return shift->$set('$field', \@_);
        }
    };"
}

=head2 get_simple

=over 4

=item Arguments: $field

Returns: $value

=back

Simple getter for hash-based objects which returns the value for the field
name passed as an argument.

=cut

sub get_simple {
  return $_[0]->{$_[1]};
}

=head2 set_simple

=over 4

=item Arguments: $field, $new_value

Returns: $new_value

=back

Simple setter for hash-based objects which sets and then returns the value
for the field name passed as an argument.

=cut

sub set_simple {
  return $_[0]->{$_[1]} = $_[2];
}


=head2 get_inherited

=over 4

=item Arguments: $field

Returns: $value

=back

Simple getter for Classes and hash-based objects which returns the value for
the field name passed as an argument. This behaves much like
L<Class::Data::Accessor> where the field can be set in a base class,
inherited and changed in subclasses, and inherited and changed for object
instances.

=cut

sub get_inherited {
    my $class;

    if (Scalar::Util::blessed $_[0]) {
        my $reftype = Scalar::Util::reftype $_[0];
        $class = ref $_[0];

        if ($reftype eq 'HASH' && exists $_[0]->{$_[1]}) {
            return $_[0]->{$_[1]};
        } elsif ($reftype ne 'HASH') {
            Carp::croak('Cannot get inherited value on an object instance that is not hash-based');
        };
    } else {
        $class = $_[0];
    };

    no strict 'refs';
    no warnings qw/uninitialized/;
    return ${$class.'::__cag_'.$_[1]} if defined(${$class.'::__cag_'.$_[1]});

    # we need to be smarter about recalculation, as @ISA (thus supers) can very well change in-flight
    my $pkg_gen = mro::get_pkg_gen ($class);
    if ( ${$class.'::__cag_pkg_gen'} != $pkg_gen ) {
        @{$class.'::__cag_supers'} = $_[0]->get_super_paths;
        ${$class.'::__cag_pkg_gen'} = $pkg_gen;
    };

    foreach (@{$class.'::__cag_supers'}) {
        return ${$_.'::__cag_'.$_[1]} if defined(${$_.'::__cag_'.$_[1]});
    };

    return undef;
}

=head2 set_inherited

=over 4

=item Arguments: $field, $new_value

Returns: $new_value

=back

Simple setter for Classes and hash-based objects which sets and then returns
the value for the field name passed as an argument. When called on a hash-based
object it will set the appropriate hash key value. When called on a class, it
will set a class level variable.

B<Note:>: This method will die if you try to set an object variable on a non
hash-based object.

=cut

sub set_inherited {
    if (Scalar::Util::blessed $_[0]) {
        if (Scalar::Util::reftype $_[0] eq 'HASH') {
            return $_[0]->{$_[1]} = $_[2];
        } else {
            Carp::croak('Cannot set inherited value on an object instance that is not hash-based');
        };
    } else {
        no strict 'refs';

        return ${$_[0].'::__cag_'.$_[1]} = $_[2];
    };
}

=head2 get_component_class

=over 4

=item Arguments: $field

Returns: $value

=back

Gets the value of the specified component class.

    __PACKAGE__->mk_group_accessors('component_class' => 'result_class');

    $self->result_class->method();

    ## same as
    $self->get_component_class('result_class')->method();

=cut

sub get_component_class {
    return $_[0]->get_inherited($_[1]);
};

=head2 set_component_class

=over 4

=item Arguments: $field, $class

Returns: $new_value

=back

Inherited accessor that automatically loads the specified class before setting
it. This method will die if the specified class could not be loaded.

    __PACKAGE__->mk_group_accessors('component_class' => 'result_class');
    __PACKAGE__->result_class('MyClass');

    $self->result_class->method();

=cut

sub set_component_class {
    if ($_[2]) {
        local $^W = 0;
        if (Class::Inspector->installed($_[2]) && !Class::Inspector->loaded($_[2])) {
            eval "use $_[2]";

            Carp::croak("Could not load $_[1] '$_[2]': ", $@) if $@;
        };
    };

    return $_[0]->set_inherited($_[1], $_[2]);
};

=head2 get_super_paths

Returns a list of 'parent' or 'super' class names that the current class inherited from.

=cut

sub get_super_paths {
    my $class = Scalar::Util::blessed $_[0] || $_[0];

    return @{mro::get_linear_isa($class)};
};

# This is now a hard, rather than optional dep. Since we dep on Sub::Name, we no
# longer care about not using XS modules.

# Class::XSAccessor is segfaulting in some places, so removing for now.
{
    our $hasXS;

    sub _hasXS { 0 }

#    sub _hasXS {
#        return $hasXS if defined $hasXS;
#    
#        $hasXS = 0;
#        eval {
#            require Class::XSAccessor;
#            $hasXS = 1;
#        };
#    
#        return $hasXS;
#    }
}

1;

=head1 AUTHORS

Matt S. Trout <mst@shadowcatsystems.co.uk>
Christopher H. Laco <claco@chrislaco.com>

With contributions from:

Guillermo Roditi <groditi@cpan.org>

=head1 COPYRIGHT & LICENSE

Copyright (c) 2006-2009 Matt S. Trout <mst@shadowcatsystems.co.uk>

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

=cut
Commit	Line	Data
963a69a5	1	package Class::Accessor::Grouped;
	2	use strict;
	3	use warnings;
a0bce8bc	4	use Carp ();
331e820d	5	use Class::Inspector ();
a0bce8bc	6	use Scalar::Util ();
8787799c	7	use MRO::Compat;
1ee74bdd	8	use Sub::Name ();
331e820d	9
b9a69571	10	our $VERSION = '0.09002';
15cf8e32	11	$VERSION = eval $VERSION;
963a69a5	12
	13	=head1 NAME
	14
1ad8d8c6	15	Class::Accessor::Grouped - Lets you build groups of accessors
963a69a5	16
	17	=head1 SYNOPSIS
	18
	19	=head1 DESCRIPTION
	20
	21	This class lets you build groups of accessors that will call different
	22	getters and setters.
	23
	24	=head1 METHODS
	25
	26	=head2 mk_group_accessors
	27
	28	=over 4
	29
	30	=item Arguments: $group, @fieldspec
	31
	32	Returns: none
	33
	34	=back
	35
	36	Creates a set of accessors in a given group.
	37
	38	$group is the name of the accessor group for the generated accessors; they
	39	will call get_$group($field) on get and set_$group($field, $value) on set.
	40
22fa6720	41	If you want to mimic Class::Accessor's mk_accessors $group has to be 'simple'
	42	to tell Class::Accessor::Grouped to use its own get_simple and set_simple
	43	methods.
	44
963a69a5	45	@fieldspec is a list of field/accessor names; if a fieldspec is a scalar
	46	this is used as both field and accessor name, if a listref it is expected to
	47	be of the form [ $accessor, $field ].
	48
	49	=cut
	50
	51	sub mk_group_accessors {
	52	my ($self, $group, @fields) = @_;
	53
	54	$self->_mk_group_accessors('make_group_accessor', $group, @fields);
	55	return;
	56	}
	57
	58
	59	{
	60	no strict 'refs';
	61	no warnings 'redefine';
	62
	63	sub _mk_group_accessors {
	64	my($self, $maker, $group, @fields) = @_;
a0bce8bc	65	my $class = Scalar::Util::blessed $self \|\| $self;
963a69a5	66
	67	# So we don't have to do lots of lookups inside the loop.
	68	$maker = $self->can($maker) unless ref $maker;
9540f4e4	69
9540f4e4	70	my $hasXS = _hasXS();
963a69a5	71
	72	foreach my $field (@fields) {
	73	if( $field eq 'DESTROY' ) {
a0bce8bc	74	Carp::carp("Having a data accessor named DESTROY in ".
963a69a5	75	"'$class' is unwise.");
	76	}
	77
	78	my $name = $field;
	79
	80	($name, $field) = @$field if ref $field;
9540f4e4	81
963a69a5	82	my $alias = "_${name}_accessor";
1ee74bdd	83	my $full_name = join('::', $class, $name);
1ee74bdd	84	my $full_alias = join('::', $class, $alias);
9540f4e4	85
	86	if ( $hasXS && $group eq 'simple' ) {
	87	Class::XSAccessor::newxs_accessor("${class}::${name}", $field, 0);
	88	Class::XSAccessor::newxs_accessor("${class}::${alias}", $field, 0);
	89
	90	# XXX: is the alias accessor really necessary?
	91	}
	92	else {
	93	my $accessor = $self->$maker($group, $field);
	94	my $alias_accessor = $self->$maker($group, $field);
	95
	96	*$full_name = Sub::Name::subname($full_name, $accessor);
	97	#unless defined &{$class."\:\:$field"}
	98
	99	*$full_alias = Sub::Name::subname($full_alias, $alias_accessor);
	100	#unless defined &{$class."\:\:$alias"}
	101	}
963a69a5	102	}
	103	}
	104	}
	105
	106	=head2 mk_group_ro_accessors
	107
	108	=over 4
	109
	110	=item Arguments: $group, @fieldspec
	111
	112	Returns: none
	113
	114	=back
	115
	116	Creates a set of read only accessors in a given group. Identical to
a557f8ad	117	L</mk_group_accessors> but accessors will throw an error if passed a value
963a69a5	118	rather than setting the value.
	119
	120	=cut
	121
	122	sub mk_group_ro_accessors {
	123	my($self, $group, @fields) = @_;
	124
	125	$self->_mk_group_accessors('make_group_ro_accessor', $group, @fields);
	126	}
	127
	128	=head2 mk_group_wo_accessors
	129
	130	=over 4
	131
	132	=item Arguments: $group, @fieldspec
	133
	134	Returns: none
	135
	136	=back
	137
	138	Creates a set of write only accessors in a given group. Identical to
a557f8ad	139	L</mk_group_accessors> but accessors will throw an error if not passed a
963a69a5	140	value rather than getting the value.
	141
	142	=cut
	143
	144	sub mk_group_wo_accessors {
	145	my($self, $group, @fields) = @_;
	146
	147	$self->_mk_group_accessors('make_group_wo_accessor', $group, @fields);
	148	}
	149
	150	=head2 make_group_accessor
	151
	152	=over 4
	153
	154	=item Arguments: $group, $field
	155
	156	Returns: $sub (\CODE)
	157
	158	=back
	159
	160	Returns a single accessor in a given group; called by mk_group_accessors
	161	for each entry in @fieldspec.
	162
	163	=cut
	164
	165	sub make_group_accessor {
	166	my ($class, $group, $field) = @_;
	167
	168	my $set = "set_$group";
	169	my $get = "get_$group";
	170
a0bce8bc	171	# eval for faster fastiness
	172	return eval "sub {
	173	if(\@_ > 1) {
	174	return shift->$set('$field', \@_);
963a69a5	175	}
963a69a5	176	else {
a0bce8bc	177	return shift->$get('$field');
963a69a5	178	}
a0bce8bc	179	};"
963a69a5	180	}
	181
	182	=head2 make_group_ro_accessor
	183
	184	=over 4
	185
	186	=item Arguments: $group, $field
	187
	188	Returns: $sub (\CODE)
	189
	190	=back
	191
	192	Returns a single read-only accessor in a given group; called by
	193	mk_group_ro_accessors for each entry in @fieldspec.
	194
	195	=cut
	196
	197	sub make_group_ro_accessor {
	198	my($class, $group, $field) = @_;
	199
	200	my $get = "get_$group";
	201
a0bce8bc	202	return eval "sub {
	203	if(\@_ > 1) {
	204	my \$caller = caller;
	205	Carp::croak(\"'\$caller' cannot alter the value of '$field' on \".
	206	\"objects of class '$class'\");
963a69a5	207	}
963a69a5	208	else {
a0bce8bc	209	return shift->$get('$field');
963a69a5	210	}
a0bce8bc	211	};"
963a69a5	212	}
	213
	214	=head2 make_group_wo_accessor
	215
	216	=over 4
	217
	218	=item Arguments: $group, $field
	219
	220	Returns: $sub (\CODE)
	221
	222	=back
	223
	224	Returns a single write-only accessor in a given group; called by
	225	mk_group_wo_accessors for each entry in @fieldspec.
	226
	227	=cut
	228
	229	sub make_group_wo_accessor {
	230	my($class, $group, $field) = @_;
	231
	232	my $set = "set_$group";
	233
a0bce8bc	234	return eval "sub {
	235	unless (\@_ > 1) {
	236	my \$caller = caller;
	237	Carp::croak(\"'\$caller' cannot access the value of '$field' on \".
	238	\"objects of class '$class'\");
963a69a5	239	}
963a69a5	240	else {
a0bce8bc	241	return shift->$set('$field', \@_);
963a69a5	242	}
a0bce8bc	243	};"
963a69a5	244	}
	245
	246	=head2 get_simple
	247
	248	=over 4
	249
	250	=item Arguments: $field
	251
	252	Returns: $value
	253
	254	=back
	255
	256	Simple getter for hash-based objects which returns the value for the field
	257	name passed as an argument.
	258
	259	=cut
	260
	261	sub get_simple {
a0bce8bc	262	return $_[0]->{$_[1]};
963a69a5	263	}
	264
	265	=head2 set_simple
	266
	267	=over 4
	268
	269	=item Arguments: $field, $new_value
	270
	271	Returns: $new_value
	272
	273	=back
	274
	275	Simple setter for hash-based objects which sets and then returns the value
	276	for the field name passed as an argument.
	277
	278	=cut
	279
	280	sub set_simple {
a0bce8bc	281	return $_[0]->{$_[1]} = $_[2];
963a69a5	282	}
963a69a5	283
e6f2a0fd	284
	285	=head2 get_inherited
	286
	287	=over 4
	288
	289	=item Arguments: $field
	290
	291	Returns: $value
	292
	293	=back
	294
331e820d	295	Simple getter for Classes and hash-based objects which returns the value for
	296	the field name passed as an argument. This behaves much like
	297	L<Class::Data::Accessor> where the field can be set in a base class,
	298	inherited and changed in subclasses, and inherited and changed for object
	299	instances.
e6f2a0fd	300
	301	=cut
	302
	303	sub get_inherited {
a49c32d9	304	my $class;
e6f2a0fd	305
a0bce8bc	306	if (Scalar::Util::blessed $_[0]) {
	307	my $reftype = Scalar::Util::reftype $_[0];
	308	$class = ref $_[0];
a49c32d9	309
a0bce8bc	310	if ($reftype eq 'HASH' && exists $_[0]->{$_[1]}) {
a0bce8bc	311	return $_[0]->{$_[1]};
a49c32d9	312	} elsif ($reftype ne 'HASH') {
a0bce8bc	313	Carp::croak('Cannot get inherited value on an object instance that is not hash-based');
e6f2a0fd	314	};
a49c32d9	315	} else {
a0bce8bc	316	$class = $_[0];
e6f2a0fd	317	};
	318
	319	no strict 'refs';
fe63d727	320	no warnings qw/uninitialized/;
a0bce8bc	321	return ${$class.'::__cag_'.$_[1]} if defined(${$class.'::__cag_'.$_[1]});
e6f2a0fd	322
4f8ce9da	323	# we need to be smarter about recalculation, as @ISA (thus supers) can very well change in-flight
4f8ce9da	324	my $pkg_gen = mro::get_pkg_gen ($class);
fe63d727	325	if ( ${$class.'::__cag_pkg_gen'} != $pkg_gen ) {
a0bce8bc	326	@{$class.'::__cag_supers'} = $_[0]->get_super_paths;
4f8ce9da	327	${$class.'::__cag_pkg_gen'} = $pkg_gen;
a49c32d9	328	};
	329
	330	foreach (@{$class.'::__cag_supers'}) {
a0bce8bc	331	return ${$_.'::__cag_'.$_[1]} if defined(${$_.'::__cag_'.$_[1]});
e6f2a0fd	332	};
c46050d3	333
9c3d5179	334	return undef;
e6f2a0fd	335	}
	336
	337	=head2 set_inherited
	338
	339	=over 4
	340
	341	=item Arguments: $field, $new_value
	342
	343	Returns: $new_value
	344
	345	=back
	346
331e820d	347	Simple setter for Classes and hash-based objects which sets and then returns
	348	the value for the field name passed as an argument. When called on a hash-based
	349	object it will set the appropriate hash key value. When called on a class, it
	350	will set a class level variable.
e6f2a0fd	351
331e820d	352	B<Note:>: This method will die if you try to set an object variable on a non
331e820d	353	hash-based object.
e6f2a0fd	354
	355	=cut
	356
	357	sub set_inherited {
a0bce8bc	358	if (Scalar::Util::blessed $_[0]) {
	359	if (Scalar::Util::reftype $_[0] eq 'HASH') {
	360	return $_[0]->{$_[1]} = $_[2];
e6f2a0fd	361	} else {
a0bce8bc	362	Carp::croak('Cannot set inherited value on an object instance that is not hash-based');
e6f2a0fd	363	};
	364	} else {
	365	no strict 'refs';
	366
a0bce8bc	367	return ${$_[0].'::__cag_'.$_[1]} = $_[2];
e6f2a0fd	368	};
	369	}
	370
331e820d	371	=head2 get_component_class
	372
	373	=over 4
	374
	375	=item Arguments: $field
	376
	377	Returns: $value
	378
	379	=back
	380
	381	Gets the value of the specified component class.
	382
	383	__PACKAGE__->mk_group_accessors('component_class' => 'result_class');
97d76fb4	384
331e820d	385	$self->result_class->method();
97d76fb4	386
331e820d	387	## same as
	388	$self->get_component_class('result_class')->method();
	389
	390	=cut
	391
	392	sub get_component_class {
a0bce8bc	393	return $_[0]->get_inherited($_[1]);
331e820d	394	};
	395
	396	=head2 set_component_class
	397
	398	=over 4
	399
	400	=item Arguments: $field, $class
	401
	402	Returns: $new_value
	403
	404	=back
	405
	406	Inherited accessor that automatically loads the specified class before setting
	407	it. This method will die if the specified class could not be loaded.
	408
	409	__PACKAGE__->mk_group_accessors('component_class' => 'result_class');
	410	__PACKAGE__->result_class('MyClass');
97d76fb4	411
331e820d	412	$self->result_class->method();
	413
	414	=cut
	415
	416	sub set_component_class {
a0bce8bc	417	if ($_[2]) {
bce7bdf8	418	local $^W = 0;
a0bce8bc	419	if (Class::Inspector->installed($_[2]) && !Class::Inspector->loaded($_[2])) {
a0bce8bc	420	eval "use $_[2]";
331e820d	421
a0bce8bc	422	Carp::croak("Could not load $_[1] '$_[2]': ", $@) if $@;
331e820d	423	};
	424	};
	425
a0bce8bc	426	return $_[0]->set_inherited($_[1], $_[2]);
331e820d	427	};
331e820d	428
a49c32d9	429	=head2 get_super_paths
	430
	431	Returns a list of 'parent' or 'super' class names that the current class inherited from.
	432
	433	=cut
	434
	435	sub get_super_paths {
a0bce8bc	436	my $class = Scalar::Util::blessed $_[0] \|\| $_[0];
a49c32d9	437
8787799c	438	return @{mro::get_linear_isa($class)};
a49c32d9	439	};
a49c32d9	440
15cf8e32	441	# This is now a hard, rather than optional dep. Since we dep on Sub::Name, we no
15cf8e32	442	# longer care about not using XS modules.
b9a69571	443
b9a69571	444	# Class::XSAccessor is segfaulting in some places, so removing for now.
15cf8e32	445	{
	446	our $hasXS;
	447
b9a69571	448	sub _hasXS { 0 }
	449
	450	# sub _hasXS {
	451	# return $hasXS if defined $hasXS;
	452	#
	453	# $hasXS = 0;
	454	# eval {
	455	# require Class::XSAccessor;
	456	# $hasXS = 1;
	457	# };
	458	#
	459	# return $hasXS;
	460	# }
15cf8e32	461	}
15cf8e32	462
963a69a5	463	1;
	464
	465	=head1 AUTHORS
	466
	467	Matt S. Trout <mst@shadowcatsystems.co.uk>
97972dcb	468	Christopher H. Laco <claco@chrislaco.com>
963a69a5	469
dfb86526	470	With contributions from:
	471
	472	Guillermo Roditi <groditi@cpan.org>
	473
4fe25633	474	=head1 COPYRIGHT & LICENSE
963a69a5	475
4fe25633	476	Copyright (c) 2006-2009 Matt S. Trout <mst@shadowcatsystems.co.uk>
963a69a5	477
4fe25633	478	This program is free software; you can redistribute it and/or modify
4fe25633	479	it under the same terms as perl itself.
963a69a5	480
4fe25633	481	=cut