'SQL::Abstract' => 1.20,
'SQL::Abstract::Limit' => 0.101,
'DBD::SQLite' => 1.08,
+ 'Class::C3' => 0.07,
+ 'Tie::IxHash' => 0,
+ 'Module::Find' => 0,
+ 'Storable' => 0,
# Following for CDBICompat only
'Class::Trigger' => 0,
'DBIx::ContextualFetch' => 0,
- 'Tie::IxHash' => 0,
- 'Storable' => 0,
- 'Module::Find' => 0,
- 'Class::C3' => 0.05,
},
recommends => {
'Data::UUID' => 0,
use vars qw($VERSION);
use base qw/DBIx::Class::Componentised Class::Data::Inheritable/;
-$VERSION = '0.03999_01';
+$VERSION = '0.03999_02';
1;
use strict;
use warnings;
-use NEXT;
-
=head1 NAME
DBIx::Class::AccessorGroup - Lets you build groups of accessors
use strict;
use warnings;
-use base qw/DBIx::Class/;
+use base qw/DBIx::Class::Core DBIx::Class::DB/;
__PACKAGE__->load_own_components(qw/
Constraints
Constructor
AccessorMapping
ColumnCase
- HasMany
HasA
+ HasMany
MightHave
LazyLoading
AutoUpdate
use strict;
use warnings;
-use NEXT;
-
sub mk_group_accessors {
my ($class, $group, @cols) = @_;
unless ($class->can('accessor_name') || $class->can('mutator_name')) {
}
}
-sub create {
+sub new {
my ($class, $attrs, @rest) = @_;
$class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
- $attrs = { %$attrs };
- my %att;
foreach my $col ($class->columns) {
if ($class->can('accessor_name')) {
my $acc = $class->accessor_name($col);
-#warn "$col $acc";
- $att{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
+ $attrs->{$col} = delete $attrs->{$acc} if exists $attrs->{$acc};
}
if ($class->can('mutator_name')) {
my $mut = $class->mutator_name($col);
- $att{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
+ $attrs->{$col} = delete $attrs->{$mut} if exists $attrs->{$mut};
}
}
- return $class->next::method({ %$attrs, %att }, @rest);
+ return $class->next::method($attrs, @rest);
}
1;
use strict;
use warnings;
-use NEXT;
+
+use base qw/DBIx::Class/;
sub _register_column_group {
my ($class, $group, @cols) = @_;
use strict;
use warnings;
-use NEXT;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class::Row/;
__PACKAGE__->mk_classdata('_column_groups' => { });
use warnings;
use DBIx::ContextualFetch;
-use NEXT;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->mk_classdata('_transform_sql_handler_order'
=> [ qw/TABLE ESSENTIAL JOIN/ ] );
use strict;
use warnings;
-use base qw/Class::Data::Inheritable/;
+use base qw/DBIx::Class/;
__PACKAGE__->mk_classdata('_temp_columns' => { });
unshift(@{"${target}::ISA"}, grep { $target ne $_ } @to_inject);
}
my $table = { Class::C3::_dump_MRO_table };
- eval "package $target; use Class::C3;" unless exists $table->{$target};
+ eval "package $target; import Class::C3;" unless exists $table->{$target};
Class::C3::reinitialize() if defined $table->{$target};
}
use strict;
use warnings;
+use base qw/DBIx::Class::Row/;
sub inflate_column {
my ($self, $col, $attrs) = @_;
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Class::ISA;
-
-my $class = $ARGV[0];
-
-die "usage: nextalyzer Some::Class" unless $class;
-
-eval "use $class;";
-
-die "Error using $class: $@" if $@;
-
-my @path = reverse Class::ISA::super_path($class);
-
-my %provided;
-my %overloaded;
-
-my @warnings;
-
-foreach my $super (@path) {
- my $file = $super;
- $file =~ s/\:\:/\//g;
- $file .= '.pm';
- my $file_path = $INC{$file};
- die "Couldn't get INC for $file, super $super" unless $file_path;
- #warn "$super $file $file_path";
- open IN, '<', $file_path;
- my $in_sub;
- my $ws;
- my $uses_next;
- my @provides;
- my @overloads;
- while (my $line = <IN>) {
- unless ($in_sub) {
- ($ws, $in_sub) = ($line =~ /^(\s*)sub (\S+)/);
- next unless $in_sub;
- }
- if ($line =~ /^$ws\}/) {
- if ($uses_next) {
- push(@overloads, $in_sub);
- } else {
- push(@provides, $in_sub);
- }
- undef $in_sub;
- undef $uses_next;
- undef $ws;
- next;
- }
- $uses_next++ if ($line =~ /\-\>NEXT/);
- }
- close IN;
- foreach (@overloads) {
- push(@warnings, "Method $_ overloaded in $class but not yet provided")
- unless $provided{$_};
- push(@{$overloaded{$_}}, $super);
- }
- $provided{$_} = $super for @provides;
- print "Class $super:\n";
- print "Provides: @provides\n";
- print "Overloads: @overloads\n";
-}
-
-print "\n\n";
-
-print join("\n", @warnings);
-
-foreach my $o (keys %overloaded) {
- my $pr = $provided{$o} || "**NEVER**";
- print "Method $o: ".join(' ', reverse @{$overloaded{$o}})." ${pr}\n";
-}