X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FModel%2FDBIC%2FSchema.pm;h=e672c31773692f90d6f3810e255b110739bd2701;hb=49c75c041373fc21f70a4b640335436b325e9201;hp=ad99846ec4101b2359d6b151c282a0fb75530145;hpb=fb691af97ffd7b3043d2d536db478af6219896f4;p=catagits%2FCatalyst-Model-DBIC-Schema.git diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm index ad99846..e672c31 100644 --- a/lib/Catalyst/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Model/DBIC/Schema.pm @@ -5,16 +5,16 @@ use mro 'c3'; extends 'Catalyst::Model'; with 'CatalystX::Component::Traits'; -our $VERSION = '0.24'; +our $VERSION = '0.29'; +$VERSION = eval $VERSION; use namespace::autoclean; use Carp::Clan '^Catalyst::Model::DBIC::Schema'; use Data::Dumper; use DBIx::Class (); -use Moose::Autobox; use Catalyst::Model::DBIC::Schema::Types - qw/ConnectInfo SchemaClass CursorClass/; + qw/ConnectInfo LoadedClass SchemaClass/; use MooseX::Types::Moose qw/ArrayRef Str ClassName Undef/; @@ -199,6 +199,8 @@ for more info. =head1 CONFIG PARAMETERS +Any options in your config not listed here are passed to your schema. + =head2 schema_class This is the classname of your L Schema. It needs @@ -262,6 +264,7 @@ Or using L: on_connect_do some SQL statement on_connect_do another SQL statement + user_defined_schema_accessor foo or @@ -275,14 +278,14 @@ Or using L: Model::MyDB: schema_class: MyDB + traits: Caching connect_info: dsn: dbi:Oracle:mydb user: mtfnpy password: mypass LongReadLen: 1000000 LongTruncOk: 1 - on_connect_do: [ "alter session set nls_date_format = 'YYYY-MM-DD HH24:MI:SS'" ] - cursor_class: 'DBIx::Class::Cursor::Cached' + on_connect_call: 'datetime_setup' quote_char: '"' The old arrayref style with hashrefs for L then L options is also @@ -384,6 +387,15 @@ Traits you used resolved to full class names. =head1 METHODS +Methods not listed here are delegated to the connected schema used by the model +instance, so the following are equivalent: + + $c->model('DB')->schema->my_accessor('foo'); + # or + $c->model('DB')->my_accessor('foo'); + +Methods on the model take precedence over schema methods. + =head2 new Instantiates the Model based on the above-documented ->config parameters. @@ -431,8 +443,6 @@ Used often for debugging and controlling transactions. =cut -has schema => (is => 'rw', isa => 'DBIx::Class::Schema'); - has schema_class => ( is => 'ro', isa => SchemaClass, @@ -442,7 +452,7 @@ has schema_class => ( has storage_type => (is => 'rw', isa => Str); -has connect_info => (is => 'ro', isa => ConnectInfo, coerce => 1); +has connect_info => (is => 'rw', isa => ConnectInfo, coerce => 1); has model_name => ( is => 'ro', @@ -453,13 +463,13 @@ has model_name => ( has _default_cursor_class => ( is => 'ro', - isa => CursorClass, + isa => LoadedClass, default => 'DBIx::Class::Storage::DBI::Cursor', coerce => 1 ); sub BUILD { - my $self = shift; + my ($self, $args) = @_; my $class = $self->_original_class_name; my $schema_class = $self->schema_class; @@ -485,8 +495,18 @@ sub BUILD { $self->composed_schema($schema_class->compose_namespace($class)); + $self->meta->make_mutable; + $self->meta->add_attribute('schema', + is => 'rw', + isa => 'DBIx::Class::Schema', + handles => $self->_delegates + ); + $self->meta->make_immutable; + $self->schema($self->composed_schema->clone); + $self->_pass_options_to_schema($args); + $self->schema->storage_type($self->storage_type) if $self->storage_type; @@ -499,13 +519,9 @@ sub clone { shift->composed_schema->clone(@_); } sub connect { shift->composed_schema->connect(@_); } -sub storage { shift->schema->storage(@_); } - -sub resultset { shift->schema->resultset(@_); } - =head2 setup -Called at C> time before configuration, but after L is +Called at C time before configuration, but after L is set. To do something after configuuration use C<< after BUILD => >>. =cut @@ -573,6 +589,55 @@ sub _build_model_name { return $model_name; } +sub _delegates { + my $self = shift; + + my $schema_meta = Class::MOP::Class->initialize($self->schema_class); + my @schema_methods = $schema_meta->get_all_method_names; + +# combine with any already added by other schemas + my @handles = eval { + @{ $self->meta->find_attribute_by_name('schema')->handles } + }; + +# now kill the attribute, otherwise add_attribute in BUILD will not do the right +# thing (it clears the handles for some reason.) May be a Moose bug. + eval { $self->meta->remove_attribute('schema') }; + + my %schema_methods; + @schema_methods{ @schema_methods, @handles } = (); + @schema_methods = keys %schema_methods; + + my @my_methods = $self->meta->get_all_method_names; + my %my_methods; + @my_methods{@my_methods} = (); + + my @delegates; + for my $method (@schema_methods) { + push @delegates, $method unless exists $my_methods{$method}; + } + + return \@delegates; +} + +sub _pass_options_to_schema { + my ($self, $args) = @_; + + my @attributes = map { + $_->init_arg || () + } $self->meta->get_all_attributes; + + my %attributes; + @attributes{@attributes} = (); + + for my $opt (keys %$args) { + if (not exists $attributes{$opt}) { + next unless $self->schema->can($opt); + $self->schema->$opt($self->{$opt}); + } + } +} + __PACKAGE__->meta->make_immutable; =head1 SEE ALSO @@ -586,7 +651,7 @@ Stuff related to DBIC and this Model style: L, L, L, L, -L +L, L Traits: @@ -595,15 +660,19 @@ L =head1 AUTHOR -Brandon L Black, C +Brandon L Black C + +=head1 CONTRIBUTORS + +caelum: Rafael Kitover C -Contributors: +Dan Dascalescu C -Rafael Kitover, C +Aran Deltac C =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it +This program is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut