'Data::Page' => 0,
'DBI' => 0,
'UNIVERSAL::require' => 0,
- 'NEXT' => 0,
'Scalar::Util' => 0,
'SQL::Abstract' => 1.20,
'SQL::Abstract::Limit' => 0.101,
'Tie::IxHash' => 0,
'Storable' => 0,
'Module::Find' => 0,
+ 'Class::C3' => 0.05,
},
recommends => {
'Data::UUID' => 0,
use warnings;
use vars qw($VERSION);
-use base qw/DBIx::Class::Componentised/;
+use base qw/DBIx::Class::Componentised Class::Data::Inheritable/;
$VERSION = '0.03004';
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 {
package DBIx::Class::DB;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
use DBIx::Class::Storage::DBI;
use DBIx::Class::ClassResolver::PassThrough;
use DBI;
$attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
}
}
- return $class->NEXT::ACTUAL::new($attrs, @rest);
+ return $class->next::method($attrs, @rest);
}
1;
use strict;
use warnings;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->mk_classdata('cache');
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;
}
use warnings;
use Tie::IxHash;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class::Row/;
__PACKAGE__->mk_classdata('_primaries' => {});
package DBIx::Class::PK::Auto;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class::PK/;
use strict;
use warnings;
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;
use strict;
use warnings;
-use base qw/DBIx::Class Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->load_own_components(qw/
HasMany
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);
use strict;
use warnings;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->mk_classdata('_relationships', { } );
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;
use strict;
use warnings;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
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));
use strict;
use warnings;
+use base qw/DBIx::Class/;
+
=head1 NAME
DBIx::Class::Row - Basic row methods
use strict;
use warnings;
+use DBIx::Class::DB;
-use base qw/Class::Data::Inheritable/;
use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/Exception Componentised/);
+__PACKAGE__->load_components(qw/Exception/);
__PACKAGE__->mk_classdata('class_registrations' => {});
=head1 NAME
my %map;
while (my ($comp, $comp_class) = each %reg) {
my $target_class = "${target}::${comp}";
- $class->inject_base($target_class, $conn_class, $comp_class);
+ $class->inject_base($target_class, $comp_class, $conn_class);
$target_class->table($comp_class->table);
@map{$comp, $comp_class} = ($target_class, $target_class);
}
sub setup_connection_class {
my ($class, $target, @info) = @_;
- $class->inject_base($target => 'DBIx::Class');
- $target->load_components('DB');
+ $class->inject_base($target => 'DBIx::Class::DB');
+ #$target->load_components('DB');
$target->connection(@info);
}
use DBIx::Class::ResultSet;
use Data::Page;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->mk_classdata('_columns' => {});
package DBIx::Class::UUIDColumns;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
use Data::UUID;
$self->store_column( $column, $self->get_uuid )
unless defined $self->get_column( $column );
}
- $self->NEXT::ACTUAL::insert;
+ $self->next::method;
}
sub get_uuid {