From: Nigel Metheringham Date: Wed, 31 May 2006 12:13:21 +0000 (+0000) Subject: Initial work on getting POD coverage testing working X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7eb4ecc8fc02a8b99fbe8be59b03321dd773ab9a;p=dbsrgits%2FDBIx-Class-Historic.git Initial work on getting POD coverage testing working --- diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm index 9e67f5c..07c8924 100644 --- a/lib/DBIx/Class/DB.pm +++ b/lib/DBIx/Class/DB.pm @@ -19,16 +19,6 @@ __PACKAGE__->load_components(qw/ResultSetProxy/); sub storage { shift->schema_instance(@_)->storage; } -sub resultset_instance { - my $class = ref $_[0] || $_[0]; - my $source = $class->result_source_instance; - if ($source->result_class ne $class) { - $source = $source->new($source); - $source->result_class($class); - } - return $source->resultset; -} - =head1 NAME DBIx::Class::DB - (DEPRECATED) classdata schema component @@ -150,6 +140,43 @@ sub txn_do { shift->schema_instance->txn_do(@_); } } } +=head2 resultset_instance + +Returns an instance of a resultset for this class - effectively +mapping the L connection-as-classdata paradigm into the +native L system. + +=cut + +sub resultset_instance { + my $class = ref $_[0] || $_[0]; + my $source = $class->result_source_instance; + if ($source->result_class ne $class) { + $source = $source->new($source); + $source->result_class($class); + } + return $source->resultset; +} + +=head2 resolve_class + +****DEPRECATED**** + +See L + +=head2 dbi_commit + +****DEPRECATED**** + +Alias for L + +=head2 dbi_rollback + +****DEPRECATED**** + +Alias for L + + 1; =head1 AUTHORS diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index d9817fe..3cea9bb 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -94,6 +94,17 @@ sub _deflated_column { return $deflate->($value, $self); } +=head2 get_inflated_column + + my $val = $obj->get_inflated_column($col); + +Fetch a column value in its inflated state. This is directly +analogous to L in that it only fetches a +column already retreived from the database, and then inflates it. +Throws an exception if the column requested is not an inflated column. + +=cut + sub get_inflated_column { my ($self, $col) = @_; $self->throw_exception("$col is not an inflated column") @@ -105,12 +116,31 @@ sub get_inflated_column { $self->_inflated_column($col, $self->get_column($col)); } +=head2 set_inflated_column + + my $copy = $obj->set_inflated_column($col => $val); + +Sets a column value from an inflated value. This is directly +analogous to L. + +=cut + sub set_inflated_column { my ($self, $col, @rest) = @_; my $ret = $self->_inflated_column_op('set', $col, @rest); return $ret; } +=head2 store_inflated_column + + my $copy = $obj->store_inflated_column($col => $val); + +Sets a column value from an inflated value without marking the column +as dirty. This is directly analogous to +L. + +=cut + sub store_inflated_column { my ($self, $col, @rest) = @_; my $ret = $self->_inflated_column_op('store', $col, @rest); @@ -133,6 +163,13 @@ sub _inflated_column_op { return $obj; } +=head2 update + +Updates a row in the same way as L, handling +inflation and deflation of columns appropriately. + +=cut + sub update { my ($class, $attrs, @rest) = @_; $attrs ||= {}; @@ -146,6 +183,13 @@ sub update { return $class->next::method($attrs, @rest); } +=head2 new + +Creates a row in the same way as L, handling +inflation and deflation of columns appropriately. + +=cut + sub new { my ($class, $attrs, @rest) = @_; $attrs ||= {}; diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 689de7d..9fd7a2a 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -30,6 +30,16 @@ retrieved, most usually a table (see L) =head1 METHODS +=pod + +=head2 new + + $class->new(); + + $class->new({attribute_name => value}); + +Creates a new ResultSource object. Not normally called directly by end users. + =cut sub new { diff --git a/t/03podcoverage.t.disabled b/t/03podcoverage.t.disabled index d91be5e..688b529 100644 --- a/t/03podcoverage.t.disabled +++ b/t/03podcoverage.t.disabled @@ -4,4 +4,34 @@ eval "use Test::Pod::Coverage 1.04"; plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD}; -all_pod_coverage_ok(); +my @modules = sort { $a cmp $b } (all_modules()); +plan tests => scalar(@modules); + +my $exceptions = { + 'DBIx::Class' => { + ignore => [ + qw/MODIFY_CODE_ATTRIBUTES + component_base_class + mk_classdata/ + ] + }, + 'DBIx::Class::ResultSetProxy' => { skip => 1 }, + 'DBIx::Class::ResultSourceProxy' => { skip => 1 }, + 'DBIx::Class::Componentised' => { skip => 1 }, +}; + +foreach my $module (@modules) { + SKIP: + { + skip "No real methods", 1 if ($exceptions->{$module}{skip}); + + # build parms up from ignore list + my $parms = {}; + $parms->{trustme} = + [ map { qr/^$_$/ } @{ $exceptions->{$module}{ignore} } ] + if exists($exceptions->{$module}{ignore}); + + # run the test with the potentially modified parm set + pod_coverage_ok($module, $parms, "$module POD coverage"); + } +}