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

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

our $VERSION = '0.09005';
$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";

    $field =~ s/'/\\'/g;

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

    return $code;
}

=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";

    $field =~ s/'/\\'/g;

    my $code = 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');
        }
    };";
    Carp::croak $@ if $@;

    return $code;
}

=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";

    $field =~ s/'/\\'/g;

    my $code = 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', \@_);
        }
    };";
    Carp::croak $@ if $@;

    return $code;
}

=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 ( ($class = ref $_[0]) && Scalar::Util::blessed $_[0]) {
        if (Scalar::Util::reftype $_[0] eq 'HASH') {
          return $_[0]->{$_[1]} if exists $_[0]->{$_[1]};
        }
        else {
          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/;

    my $cag_slot = '::__cag_'. $_[1];
    return ${$class.$cag_slot} if defined(${$class.$cag_slot});

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

    for (@{$class.'::__cag_supers__'}) {
        return ${$_.$cag_slot} if defined(${$_.$cag_slot});
    };

    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;
        require Class::Inspector;
        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 {
    return @{mro::get_linear_isa( ref($_[0]) || $_[0] )};
};

1;

=head1 PERFORMANCE

You can speed up accessors of type 'simple' by installing L<Class::XSAccessor>.

=head1 AUTHORS

Matt S. Trout <mst@shadowcatsystems.co.uk>

Christopher H. Laco <claco@chrislaco.com>

=head1 CONTRIBUTORS

Caelum: Rafael Kitover <rkitover@cpan.org>

groditi: Guillermo Roditi <groditi@cpan.org>

Jason Plum <jason.plum@bmmsi.com>

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