sub mk_group_accessors {
my ($class, $group, @cols) = @_;
unless ($class->can('accessor_name') || $class->can('mutator_name')) {
- return $class->NEXT::ACTUAL::mk_group_accessors($group => @cols);
+ return $class->next::method($group => @cols);
}
foreach my $col (@cols) {
my $ro_meth = ($class->can('accessor_name')
: $col);
#warn "$col $ro_meth $wo_meth";
if ($ro_meth eq $wo_meth) {
- $class->NEXT::ACTUAL::mk_group_accessors($group => [ $ro_meth => $col ]);
+ $class->next::method($group => [ $ro_meth => $col ]);
} else {
$class->mk_group_ro_accessors($group => [ $ro_meth => $col ]);
$class->mk_group_wo_accessors($group => [ $wo_meth => $col ]);
$att{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
}
}
- return $class->NEXT::ACTUAL::create({ %$attrs, %att }, @rest);
+ return $class->next::method({ %$attrs, %att }, @rest);
}
1;
sub set_column {
my $self = shift;
- my $ret = $self->NEXT::set_column(@_);
+ my $ret = $self->next::method(@_);
$self->update if ($self->autoupdate && $self->{_in_storage});
return $ret;
}
sub _register_column_group {
my ($class, $group, @cols) = @_;
- return $class->NEXT::ACTUAL::_register_column_group($group => map lc, @cols);
+ return $class->next::method($group => map lc, @cols);
}
sub _register_columns {
my ($class, @cols) = @_;
- return $class->NEXT::ACTUAL::_register_columns(map lc, @cols);
+ return $class->next::method(map lc, @cols);
}
sub has_a {
my ($class, $col, @rest) = @_;
- $class->NEXT::ACTUAL::has_a(lc($col), @rest);
+ $class->next::method(lc($col), @rest);
$class->mk_group_accessors('inflated_column' => $col);
return 1;
}
sub has_many {
my ($class, $rel, $f_class, $f_key, @rest) = @_;
- return $class->NEXT::ACTUAL::has_many($rel, $f_class, ( ref($f_key) ?
+ return $class->next::method($rel, $f_class, ( ref($f_key) ?
$f_key :
lc($f_key) ), @rest);
}
sub get_inflated_column {
my ($class, $get, @rest) = @_;
- return $class->NEXT::ACTUAL::get_inflated_column(lc($get), @rest);
+ return $class->next::method(lc($get), @rest);
}
sub store_inflated_column {
my ($class, $set, @rest) = @_;
- return $class->NEXT::ACTUAL::store_inflated_column(lc($set), @rest);
+ return $class->next::method(lc($set), @rest);
}
sub set_inflated_column {
my ($class, $set, @rest) = @_;
- return $class->NEXT::ACTUAL::set_inflated_column(lc($set), @rest);
+ return $class->next::method(lc($set), @rest);
}
sub get_column {
my ($class, $get, @rest) = @_;
- return $class->NEXT::ACTUAL::get_column(lc($get), @rest);
+ return $class->next::method(lc($get), @rest);
}
sub set_column {
my ($class, $set, @rest) = @_;
- return $class->NEXT::ACTUAL::set_column(lc($set), @rest);
+ return $class->next::method(lc($set), @rest);
}
sub store_column {
my ($class, $set, @rest) = @_;
- return $class->NEXT::ACTUAL::store_column(lc($set), @rest);
+ return $class->next::method(lc($set), @rest);
}
sub find_column {
my ($class, $col) = @_;
- return $class->NEXT::ACTUAL::find_column(lc($col));
+ return $class->next::method(lc($col));
}
sub _mk_group_accessors {
next if defined &{"${class}::${acc}"};
push(@extra, [ lc $acc => $field ]);
}
- return $class->NEXT::ACTUAL::_mk_group_accessors($type, $group,
+ return $class->next::method($type, $group,
@fields, @extra);
}
sub _cond_key {
my ($class, $attrs, $key, @rest) = @_;
- return $class->NEXT::ACTUAL::_cond_key($attrs, lc($key), @rest);
+ return $class->next::method($attrs, lc($key), @rest);
}
sub _cond_value {
my ($class, $attrs, $key, @rest) = @_;
- return $class->NEXT::ACTUAL::_cond_value($attrs, lc($key), @rest);
+ return $class->next::method($attrs, lc($key), @rest);
}
sub new {
my ($class, $attrs, @rest) = @_;
my %att;
$att{lc $_} = $attrs->{$_} for keys %$attrs;
- return $class->NEXT::ACTUAL::new(\%att, @rest);
+ return $class->next::method(\%att, @rest);
}
1;
$args->{cascade_delete} = 0;
}
- $class->NEXT::has_many($rel, $f_class, $f_key, $args);
+ $class->next::method($rel, $f_class, $f_key, $args);
if (@f_method) {
no strict 'refs';
my ($class, @info) = @_;
$info[3] = { %{ $info[3] || {}} };
$info[3]->{RootClass} = 'DBIx::ContextualFetch';
- return $class->NEXT::connection(@info);
+ return $class->next::method(@info);
}
sub __driver {
&& $_ ne 'All' }
keys %{ $self->_column_groups || {} });
}
- $self->NEXT::get_column(@_[1..$#_]);
+ $self->next::method(@_[1..$#_]);
}
sub _flesh {
sub insert {
my ($self, @rest) = @_;
- $self->NEXT::ACTUAL::insert(@rest);
+ $self->next::method(@rest);
# Because the insert will die() if it can't insert into the db (or should)
# we can be sure the object *was* inserted if we got this far. In which
# case, given primary keys are unique and ID only returns a
sub _row_to_object {
my ($class, @rest) = @_;
- my $new = $class->NEXT::ACTUAL::_row_to_object(@rest);
+ my $new = $class->next::method(@rest);
if (my $key = $new->ID) {
#warn "Key $key";
my $live = $class->live_object_index;
my ($self) = @_;
if (my $key = $self->ID) {
$self->remove_from_object_index;
- my $ret = $self->NEXT::ACTUAL::discard_changes;
+ my $ret = $self->next::method;
$self->live_object_index->{$key} = $self if $self->in_storage;
return $ret;
} else {
- return $self->NEXT::ACTUAL::discard_changes;
+ return $self->next::method;
}
}
sub might_have {
my ($class, $rel, $f_class, @columns) = @_;
if (ref $columns[0] || !defined $columns[0]) {
- return $class->NEXT::might_have($rel, $f_class, @columns);
+ return $class->next::method($rel, $f_class, @columns);
} else {
- return $class->NEXT::might_have($rel, $f_class, undef,
+ return $class->next::method($rel, $f_class, undef,
{ proxy => \@columns });
}
}
$tmp{$_} = 1 for @cols;
$class->_temp_columns(\%tmp);
} else {
- return $class->NEXT::ACTUAL::_add_column_group($group, @cols);
+ return $class->next::method($group, @cols);
}
}
foreach my $key (keys %$attrs) {
$temp{$key} = delete $attrs->{$key} if $class->_temp_columns->{$key};
}
- my $new = $class->NEXT::ACTUAL::new($attrs, @rest);
+ my $new = $class->next::method($attrs, @rest);
foreach my $key (keys %temp) {
$new->set_temp($key, $temp{$key});
}
sub find_column {
my ($class, $col, @rest) = @_;
return $col if $class->_temp_columns->{$col};
- return $class->NEXT::ACTUAL::find_column($col, @rest);
+ return $class->next::method($col, @rest);
}
sub get_temp {
sub insert {
my $self = shift;
$self->call_trigger('before_create');
- $self->NEXT::ACTUAL::insert(@_);
+ $self->next::method(@_);
$self->call_trigger('after_create');
return $self;
}
$self->call_trigger('before_update');
my @to_update = keys %{$self->{_dirty_columns} || {}};
return -1 unless @to_update;
- $self->NEXT::ACTUAL::update(@_);
+ $self->next::method(@_);
$self->call_trigger('after_update');
return $self;
}
sub delete {
my $self = shift;
$self->call_trigger('before_delete') if ref $self;
- $self->NEXT::ACTUAL::delete(@_);
+ $self->next::method(@_);
$self->call_trigger('after_delete') if ref $self;
return $self;
}
my ($self, $column, $value, @rest) = @_;
my $vals = { $column => $value };
$self->call_trigger("before_set_${column}", $value, $vals);
- return $self->NEXT::ACTUAL::store_column($column, $vals->{$column});
+ return $self->next::method($column, $vals->{$column});
}
1;
package DBIx::Class::Componentised;
+use Class::C3;
+
sub inject_base {
my ($class, $target, @to_inject) = @_;
{
no strict 'refs';
unshift(@{"${target}::ISA"}, grep { $target ne $_ } @to_inject);
}
+ eval "package $target; use Class::C3;";
}
sub load_components {
$attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
}
}
- return $class->NEXT::ACTUAL::new($attrs, @rest);
+ return $class->next::method($attrs, @rest);
}
1;
sub insert {
my $self = shift;
- $self->NEXT::ACTUAL::insert(@_);
+ $self->next::method(@_);
$self->_insert_into_cache if $self->cache;
return $self;
}
sub find {
my ($self,@vals) = @_;
- return $self->NEXT::ACTUAL::find(@vals) unless $self->cache;
+ return $self->next::method(@vals) unless $self->cache;
# this is a terrible hack here. I know it can be improved.
# but, it's a start anyway. probably find in PK.pm needs to
return $object;
}
- $object = $self->NEXT::ACTUAL::find(@vals);
+ $object = $self->next::method(@vals);
$object->_insert_into_cache if $object;
return $object;
}
sub update {
my $self = shift;
- my $new = $self->NEXT::ACTUAL::update(@_);
+ my $new = $self->next::method(@_);
$self->_insert_into_cache if $self->cache;
return;
}
sub delete {
my $self = shift;
$self->cache->remove($self->ID) if $self->cache;
- return $self->NEXT::ACTUAL::delete(@_);
+ return $self->next::method(@_);
}
sub _row_to_object {
my $self = shift;
- my $new = $self->NEXT::ACTUAL::_row_to_object(@_);
+ my $new = $self->next::method(@_);
$new->_insert_into_cache if $self->cache;
return $new;
}
sub insert {
my ($self, @rest) = @_;
- my $ret = $self->NEXT::ACTUAL::insert(@rest);
+ my $ret = $self->next::method(@rest);
# if all primaries are already populated, skip auto-inc
my $populated = 0;
sub add_relationship {
my ($class, $rel, @rest) = @_;
- my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
+ my $ret = $class->next::method($rel => @rest);
my $rel_obj = $class->_relationships->{$rel};
if (my $acc_type = $rel_obj->{attrs}{accessor}) {
$class->add_relationship_accessor($rel => $acc_type);
join(', ', keys %{$attrs->{_aliases} || {}}) );
}
}
- return $self->NEXT::ACTUAL::_cond_key($attrs, $key);
+ return $self->next::method($attrs, $key);
}
sub _cond_value {
}
}
- return $self->NEXT::ACTUAL::_cond_value($attrs, $key, $value)
+ return $self->next::method($attrs, $key, $value)
}
=item search_related
sub delete {
my ($self, @rest) = @_;
- return $self->NEXT::ACTUAL::delete(@rest) unless ref $self;
+ return $self->next::method(@rest) unless ref $self;
# I'm just ignoring this for class deletes because hell, the db should
# be handling this anyway. Assuming we have joins we probably actually
# *could* do them, but I'd rather not.
- my $ret = $self->NEXT::ACTUAL::delete(@rest);
+ my $ret = $self->next::method(@rest);
my %rels = %{ $self->_relationships };
my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
sub update {
my ($self, @rest) = @_;
- return $self->NEXT::ACTUAL::update(@rest) unless ref $self;
+ return $self->next::method(@rest) unless ref $self;
# Because update cascades on a class *really* don't make sense!
- my $ret = $self->NEXT::ACTUAL::update(@rest);
+ my $ret = $self->next::method(@rest);
my %rels = %{ $self->_relationships };
my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
sub add_relationship {
my ($class, $rel, @rest) = @_;
- my $ret = $class->NEXT::ACTUAL::add_relationship($rel => @rest);
+ my $ret = $class->next::method($rel => @rest);
if (my $proxy_list = $class->_relationships->{$rel}->{attrs}{proxy}) {
$class->proxy_to_related($rel,
(ref $proxy_list ? @$proxy_list : $proxy_list));
$self->store_column( $column, $self->get_uuid )
unless defined $self->get_column( $column );
}
- $self->NEXT::ACTUAL::insert;
+ $self->next::method;
}
sub get_uuid {