From: Matt S Trout Date: Tue, 19 Jul 2005 13:11:28 +0000 (+0000) Subject: Most of the first third of 02-Film now works :) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8fe001e1f588a2a35923a74d262cd011466d31aa;p=dbsrgits%2FDBIx-Class-Historic.git Most of the first third of 02-Film now works :) --- diff --git a/lib/DBIx/Class/CDBICompat.pm b/lib/DBIx/Class/CDBICompat.pm index 22fd5e7..cba2996 100644 --- a/lib/DBIx/Class/CDBICompat.pm +++ b/lib/DBIx/Class/CDBICompat.pm @@ -3,8 +3,10 @@ package DBIx::Class::CDBICompat; use strict; use warnings; -use base qw/DBIx::Class::CDBICompat::AccessorMapping +use base qw/DBIx::Class::CDBICompat::Convenience + DBIx::Class::CDBICompat::AccessorMapping DBIx::Class::CDBICompat::ColumnCase - DBIx::Class::CDBICompat::ColumnGroups/; + DBIx::Class::CDBICompat::ColumnGroups + DBIx::Class::CDBICompat::ImaDBI/; 1; diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm index 3bea78d..1c32842 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm @@ -25,16 +25,15 @@ sub columns { sub _set_column_group { my ($class, $group, @cols) = @_; $class->_register_column_group($group => @cols); - $class->_register_columns(@cols); - $class->_mk_column_accessors(@cols); + #$class->_register_columns(@cols); + #$class->_mk_column_accessors(@cols); + $class->set_columns(@cols); } sub _register_column_group { my ($class, $group, @cols) = @_; if ($group eq 'Primary') { - my %pri; - $pri{$_} = {} for @cols; - $class->_primaries(\%pri); + $class->set_primary(@cols); } my $groups = { %{$class->_column_groups} }; diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm index c90d7bc..8855123 100644 --- a/lib/DBIx/Class/Core.pm +++ b/lib/DBIx/Class/Core.pm @@ -3,6 +3,9 @@ package DBIx::Class::Core; use strict; use warnings; -use base qw/DBIx::Class::Table DBIx::Class::SQL DBIx::Class::DB/; +use base qw/DBIx::Class::PK + DBIx::Class::Table + DBIx::Class::SQL + DBIx::Class::DB/; 1; diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm index 3fc3013..0ef24b4 100644 --- a/lib/DBIx/Class/DB.pm +++ b/lib/DBIx/Class/DB.pm @@ -8,7 +8,8 @@ __PACKAGE__->mk_classdata('_dbh'); sub _get_dbh { my ($class) = @_; - unless ((my $dbh = $class->_dbh) && $dbh->FETCH('Active') && $dbh->ping) { + my $dbh; + unless (($dbh = $class->_dbh) && $dbh->FETCH('Active') && $dbh->ping) { $class->_populate_dbh; } return $class->_dbh; @@ -23,7 +24,13 @@ sub _populate_dbh { sub _dbi_connect { my ($class, @info) = @_; - return DBI->connect_cached(@info); + return DBI->connect(@info); +} + +sub connection { + my ($class, @info) = @_; + $class->_dbi_connect_package($class); + $class->_dbi_connect_info(\@info); } 1; diff --git a/lib/DBIx/Class/SQL.pm b/lib/DBIx/Class/SQL.pm index 2f6326e..a06062e 100644 --- a/lib/DBIx/Class/SQL.pm +++ b/lib/DBIx/Class/SQL.pm @@ -12,20 +12,22 @@ use constant COND => 2; __PACKAGE__->mk_classdata('_sql_statements', { 'select' => - sub { "SELECT ".join(', ', @$_[COLS])." FROM $_[FROM] WHERE $_[COND]"; }, + sub { "SELECT ".join(', ', @{$_[COLS]})." FROM $_[FROM] WHERE $_[COND]"; }, 'update' => - sub { "UPDATE $_[FROM] SET ".join(', ', map { "$_ = ?" } @$_[COLS]). + sub { "UPDATE $_[FROM] SET ".join(', ', map { "$_ = ?" } @{$_[COLS]}). " WHERE $_[COND]"; }, 'insert' => - sub { "INSERT INTO $_[FROM] (".join(', ', @$_[COLS]).") VALUES (". - join(', ', map { '?' } @$_[COLS]).")"; }, + sub { "INSERT INTO $_[FROM] (".join(', ', @{$_[COLS]}).") VALUES (". + join(', ', map { '?' } @{$_[COLS]}).")"; }, 'delete' => sub { "DELETE FROM $_[FROM] WHERE $_[COND]"; }, } ); sub _get_sql { my ($class, $name, $cols, $from, $cond) = @_; - return $class->_sql_statements->{$name}->($cols, $from, $cond); + my $sql = $class->_sql_statements->{$name}->($cols, $from, $cond); + #warn $sql; + return $sql; } sub _sql_to_sth { diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm index 9556eb9..8e5fc33 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -7,8 +7,6 @@ use base qw/Class::Data::Inheritable Class::Accessor DBIx::Class::SQL/; __PACKAGE__->mk_classdata('_columns' => {}); -__PACKAGE__->mk_classdata('_primaries' => {}); - __PACKAGE__->mk_classdata('_table_name'); sub new { @@ -16,11 +14,12 @@ sub new { $class = ref $class if ref $class; my $new = bless({ _column_data => { } }, $class); if ($attrs) { - die "Attrs must be a hashref" unless ref($attrs) eq 'HASH'; + die "attrs must be a hashref" unless ref($attrs) eq 'HASH'; while (my ($k, $v) = each %{$attrs}) { - $new->set_column($k => $v); + $new->set($k => $v); } } + return $new; } sub insert { @@ -30,11 +29,13 @@ sub insert { $self->_table_name, undef); $sth->execute(values %{$self->{_column_data}}); $self->{_in_database} = 1; + $self->{_dirty_columns} = {}; return $self; } sub create { my ($class, $attrs) = @_; + die "create needs a hashref" unless ref $attrs eq 'HASH'; return $class->new($attrs)->insert; } @@ -61,6 +62,7 @@ sub delete { sub get { my ($self, $column) = @_; + die "Can't fetch data as class method" unless ref $self; die "No such column '${column}'" unless $self->_columns->{$column}; return $self->{_column_data}{$column}; } @@ -73,16 +75,6 @@ sub set { return $self->{_column_data}{$column} = $value; } -sub _ident_cond { - my ($class) = @_; - return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries}); -} - -sub _ident_values { - my ($self) = @_; - return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); -} - sub _register_columns { my ($class, @cols) = @_; my $names = { %{$class->_columns} }; @@ -95,4 +87,44 @@ sub _mk_column_accessors { $class->mk_accessors(@cols); } +sub set_columns { + my ($class, @cols) = @_; + $class->_register_columns(@cols); + $class->_mk_column_accessors(@cols); +} + +sub retrieve_from_sql { + my ($class, $cond, @vals) = @_; + $cond =~ s/^\s*WHERE//; + my @cols = $class->_select_columns; + my $sth = $class->_get_sth( 'select', \@cols, $class->_table_name, $cond); + $sth->execute(@vals); + my @found; + while (my @row = $sth->fetchrow_array) { + my $new = $class->new; + $new->set($_, shift @row) for @cols; + $new->{_in_database} = 1; + push(@found, $new); + } + return @found; +} + +sub search { + my $class = shift; + my $where = ref $_[0] eq "HASH" ? shift: {@_}; + my $cond = join(' AND ', map { "$_ = ?" } keys %$where); + return $class->retrieve_from_sql($cond, values %$where); +} + +sub _select_columns { + return keys %{$_[0]->_columns}; +} + +sub copy { + my ($self, $changes) = @_; + my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self); + $new->set($_ => $changes->{$_}) for keys %$changes; + return $new; +} + 1; diff --git a/lib/DBIx/Class/Test/SQLite.pm b/lib/DBIx/Class/Test/SQLite.pm index 02d300d..28647a3 100644 --- a/lib/DBIx/Class/Test/SQLite.pm +++ b/lib/DBIx/Class/Test/SQLite.pm @@ -40,8 +40,8 @@ END { unlink $DB if -e $DB } my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 1 }); __PACKAGE__->connection(@DSN); -__PACKAGE__->set_sql(_table_pragma => 'PRAGMA table_info(__TABLE__)'); -__PACKAGE__->set_sql(_create_me => 'CREATE TABLE __TABLE__ (%s)'); +#__PACKAGE__->set_sql(_table_pragma => 'PRAGMA table_info(__TABLE__)'); +#__PACKAGE__->set_sql(_create_me => 'CREATE TABLE __TABLE__ (%s)'); =head1 METHODS @@ -62,8 +62,11 @@ sub set_table { sub _create_test_table { my $class = shift; - my @vals = $class->sql__table_pragma->select_row; - $class->sql__create_me($class->create_sql)->execute unless @vals; + my @vals = $class->_sql_to_sth( + 'PRAGMA table_info(__TABLE__)')->select_row; + $class->_sql_to_sth( + 'CREATE TABLE '.$class->table.' ('.$class->create_sql.')' + )->execute unless @vals; } =head2 create_sql (abstract) diff --git a/t/01-columns.t b/t/01-columns.t index 50d5831..ca1040e 100644 --- a/t/01-columns.t +++ b/t/01-columns.t @@ -87,7 +87,7 @@ ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG'); { SKIP: { - skip "Different error message", 1; + skip "No column objects", 1; eval { my @grps = State->__grouper->groups_for("Huh"); }; ok $@, "Huh not in groups"; @@ -101,7 +101,6 @@ ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG'); } SKIP: { - skip "->retrieve not yet supported by CDBI compat", 1; local $SIG{__WARN__} = sub { }; eval { DBIx::Class->retrieve(1) }; like $@, qr/Can't retrieve unless primary columns are defined/, "Need primary key for retrieve"; diff --git a/t/02-Film.t b/t/02-Film.t index ea2b2d7..5a8df07 100644 --- a/t/02-Film.t +++ b/t/02-Film.t @@ -15,9 +15,6 @@ INIT { ok(Film->can('db_Main'), 'set_db()'); is(Film->__driver, "SQLite", "Driver set correctly"); -SKIP: { - skip "Bunch of slightly different error messages", 5; - { my $nul = eval { Film->retrieve() }; is $nul, undef, "Can't retrieve nothing"; @@ -35,9 +32,7 @@ SKIP: { } eval { my $duh = Film->create; }; -like $@, qr/create needs a hashref/, "create needs a hashref"; - -} # End skip block +like $@, qr/create needs a hashref/, "needs a hashref"; ok +Film->create_test_film; @@ -349,7 +344,7 @@ if (0) { } SKIP: { - skip "Scalar::Util::weaken not available", 3 + skip "Scalar::Util::weaken not available", 3; #if !$Class::DBI::Weaken_Is_Available; # my bad taste is your bad taste