[Bast-commits] r3938 - in
DBIx-Class/0.08/branches/cdbicompat_integration: .
lib/DBIx/Class lib/DBIx/Class/CDBICompat t t/cdbi-t
schwern at dev.catalyst.perl.org
schwern at dev.catalyst.perl.org
Wed Jan 16 07:57:38 GMT 2008
Author: schwern
Date: 2008-01-16 07:57:37 +0000 (Wed, 16 Jan 2008)
New Revision: 3938
Added:
DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t
Modified:
DBIx-Class/0.08/branches/cdbicompat_integration/
DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat.pm
DBIx-Class/0.08/branches/cdbicompat_integration/t/03podcoverage.t
Log:
r52284 at windhund: schwern | 2008-01-15 18:23:19 -0800
Allow CDBI objects to be accessed like hashes as people tend to do for
performance reasons.
Property changes on: DBIx-Class/0.08/branches/cdbicompat_integration
___________________________________________________________________
Name: svk:merge
- 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:32850
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3729
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:52284
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:3729
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
Added: DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm (rev 0)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm 2008-01-16 07:57:37 UTC (rev 3938)
@@ -0,0 +1,108 @@
+package
+ DBIx::Class::CDBICompat::ColumnsAsHash;
+
+use strict;
+use warnings;
+
+use Scalar::Defer;
+use Scalar::Util qw(weaken);
+use Carp;
+
+
+=head1 NAME
+
+DBIx::Class::CDBICompat::ColumnsAsHash
+
+=head1 SYNOPSIS
+
+See DBIx::Class::CDBICompat for directions for use.
+
+=head1 DESCRIPTION
+
+Emulates the I<undocumnted> behavior of Class::DBI where the object can be accessed as a hash of columns. This is often used as a performance hack.
+
+ my $column = $row->{column};
+
+=head2 Differences from Class::DBI
+
+This will warn when a column is accessed as a hash key.
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ my $new = $class->next::method(@_);
+
+ $new->_make_columns_as_hash;
+
+ return $new;
+}
+
+sub inflate_result {
+ my $class = shift;
+
+ my $new = $class->next::method(@_);
+
+ $new->_make_columns_as_hash;
+
+ return $new;
+}
+
+
+sub _make_columns_as_hash {
+ my $self = shift;
+
+ weaken $self;
+ for my $col ($self->columns) {
+ if( exists $self->{$col} ) {
+ warn "Skipping mapping $col to a hash key because it exists";
+ }
+
+ next unless $self->can($col);
+ $self->{$col} = defer {
+ my $class = ref $self;
+ carp "Column '$col' of '$class/$self' was accessed as a hash";
+ $self->$col();
+ };
+ }
+}
+
+sub update {
+ my $self = shift;
+
+ for my $col ($self->columns) {
+ if( $self->_hash_changed($col) ) {
+ my $class = ref $self;
+ carp "Column '$col' of '$class/$self' was updated as a hash";
+ $self->$col($self->_get_column_from_hash($col));
+ $self->{$col} = defer { $self->$col() };
+ }
+ }
+
+ return $self->next::method(@_);
+}
+
+sub _hash_changed {
+ my($self, $col) = @_;
+
+ return 0 unless exists $self->{$col};
+
+ my $hash = $self->_get_column_from_hash($col);
+ my $obj = $self->$col();
+
+ return 1 if defined $hash xor defined $obj;
+ return 0 if !defined $hash and !defined $obj;
+ return 1 if $hash ne $obj;
+ return 0;
+}
+
+# get the column value without a warning
+sub _get_column_from_hash {
+ my($self, $col) = @_;
+
+ local $SIG{__WARN__} = sub {};
+ return force $self->{$col};
+}
+
+1;
Modified: DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat.pm
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat.pm 2008-01-15 16:06:01 UTC (rev 3937)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/lib/DBIx/Class/CDBICompat.pm 2008-01-16 07:57:37 UTC (rev 3938)
@@ -33,6 +33,7 @@
Retrieve
Pager
ColumnGroups
+ ColumnsAsHash
AbstractSearch
ImaDBI
Iterator
Modified: DBIx-Class/0.08/branches/cdbicompat_integration/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/t/03podcoverage.t 2008-01-15 16:06:01 UTC (rev 3937)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/t/03podcoverage.t 2008-01-16 07:57:37 UTC (rev 3938)
@@ -37,6 +37,9 @@
},
'DBIx::Class::CDBICompat::AttributeAPI' => { skip => 1 },
'DBIx::Class::CDBICompat::AutoUpdate' => { skip => 1 },
+ 'DBIx::Class::CDBICompat::ColumnsAsHash' => {
+ ignore => [qw(inflate_result new update)]
+ },
'DBIx::Class::CDBICompat::ColumnCase' => { skip => 1 },
'DBIx::Class::CDBICompat::ColumnGroups' => { skip => 1 },
'DBIx::Class::CDBICompat::Constraints' => { skip => 1 },
Added: DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t
===================================================================
--- DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t (rev 0)
+++ DBIx-Class/0.08/branches/cdbicompat_integration/t/cdbi-t/columns_as_hashes.t 2008-01-16 07:57:37 UTC (rev 3938)
@@ -0,0 +1,39 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use Test::Warn;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 6);
+}
+
+use lib 't/testlib';
+use Film;
+
+my $waves = Film->insert({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ Rating => 'R'
+});
+
+warnings_like {
+ is $waves->{title}, $waves->Title, "columns can be accessed as hashes";
+} qr{^Column 'title' of 'Film/$waves' was accessed as a hash at .*$};
+
+$waves->Rating("G");
+
+warnings_like {
+ is $waves->{rating}, "G", "updating via the accessor updates the hash";
+} qr{^Column 'rating' of 'Film/$waves' was accessed as a hash .*$};
+
+$waves->{rating} = "PG";
+
+warnings_like {
+ $waves->update;
+} qr{^Column 'rating' of 'Film/$waves' was updated as a hash .*$};
+
+my @films = Film->search( Rating => "PG", Title => "Breaking the Waves" );
+is @films, 1, "column updated as hash was saved";
More information about the Bast-commits
mailing list