[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.09003';
$VERSION = eval $VERSION;

# Class::XSAccessor is segfaulting on win32, so be careful
# Win32 users can set $hasXS to try to use it anyway

our $hasXS;

sub _hasXS {

  if (not defined $hasXS) {
    $hasXS = 0;

    if ($^O ne 'MSWin32') {
      eval {
        require Class::XSAccessor;
        $hasXS = 1;
      };
    }
  }

  return $hasXS;
}

=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' ) {
                require Class::XSAccessor;
                Class::XSAccessor->import({
                  replace => 1,
                  class => $class,
                  accessors => {
                    $name => $field,
                    $alias => $field,
                  },
                });
            }
            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)};
};

1;

=head1 PERFORMANCE

You can speed up accessors of type 'simple' by installing L<Class::XSAccessor>.
Note however that the use of this module is disabled by default on Win32
systems, as it causes yet unresolved segfaults. If you are a Win32 user, and
want to try this module with L<Class::XSAccessor>, set
C<$Class::Accessor::Grouped::hasXS> to a true value B<before> registering
your accessors (e.g. in a C<BEGIN> block)

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