X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FModel%2FDBIC%2FSchema.pm;h=993c02c49d5aada4850d0fcd52b2622db2fd1c63;hb=7bd33abf92b0dfcfdd086532511e941868754d8b;hp=d1cdc0ab5fd951690a7a439aee0f67cbff6c83cb;hpb=2ff00e2b7f50d7a5a8403051dfbbad12d92398e9;p=catagits%2FCatalyst-Model-DBIC-Schema.git diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm index d1cdc0a..993c02c 100644 --- a/lib/Catalyst/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Model/DBIC/Schema.pm @@ -1,24 +1,23 @@ package Catalyst::Model::DBIC::Schema; use Moose; -no warnings 'uninitialized'; - -our $VERSION = '0.24'; - use mro 'c3'; extends 'Catalyst::Model'; -with 'MooseX::Object::Pluggable'; +with 'CatalystX::Component::Traits'; + +our $VERSION = '0.26'; +use namespace::autoclean; use Carp::Clan '^Catalyst::Model::DBIC::Schema'; use Data::Dumper; use DBIx::Class (); -use Scalar::Util 'reftype'; -use MooseX::ClassAttribute; use Moose::Autobox; +use Class::Inspector (); -use Catalyst::Model::DBIC::Schema::Types qw/ConnectInfo SchemaClass/; +use Catalyst::Model::DBIC::Schema::Types + qw/ConnectInfo LoadedClass/; -use namespace::clean -except => 'meta'; +use MooseX::Types::Moose qw/ArrayRef Str ClassName Undef/; =head1 NAME @@ -92,19 +91,34 @@ be used/accessed in the normal Catalyst manner, via $c->model(): my $actor = $c->model('FilmDB::Actor')->find(1); You can also use it to set up DBIC authentication with -Authentication::Store::DBIC in MyApp.pm: +L in MyApp.pm: package MyApp; - use Catalyst qw/... Authentication::Store::DBIC/; + use Catalyst qw/... Authentication .../; ... - __PACKAGE__->config->{authentication}{dbic} = { - user_class => 'FilmDB::Actor', - user_field => 'name', - password_field => 'password' - } + __PACKAGE__->config->{authentication} = + { + default_realm => 'members', + realms => { + members => { + credential => { + class => 'Password', + password_field => 'password', + password_type => 'hashed' + password_hash_type => 'SHA-256' + }, + store => { + class => 'DBIx::Class', + user_model => 'DB::User', + role_relation => 'roles', + role_field => 'rolename', + } + } + } + }; C<< $c->model('Schema::Source') >> returns a L for the source name parameter passed. To find out more about which methods can @@ -186,15 +200,13 @@ for more info. =head1 CONFIG PARAMETERS -=over 4 - -=item schema_class +=head2 schema_class This is the classname of your L Schema. It needs to be findable in C<@INC>, but it does not need to be inside the C namespace. This parameter is required. -=item connect_info +=head2 connect_info This is an arrayref of connection parameters, which are specific to your C (see your storage type documentation for more details). @@ -241,11 +253,13 @@ Or using L: schema_class MyApp::Schema::FilmDB + traits Caching dsn dbi:Pg:dbname=mypgdb user postgres - password '' + password "" auto_savepoint 1 + quote_char """ on_connect_do some SQL statement on_connect_do another SQL statement @@ -270,6 +284,7 @@ Or using L: LongTruncOk: 1 on_connect_do: [ "alter session set nls_date_format = 'YYYY-MM-DD HH24:MI:SS'" ] cursor_class: 'DBIx::Class::Cursor::Cached' + quote_char: '"' The old arrayref style with hashrefs for L then L options is also supported: @@ -290,131 +305,170 @@ supported: } ] -=item roles +=head2 traits -Array of Roles to apply at BUILD time. Roles are relative to the -C< then C<> -namespaces, unless prefixed with C<+> in which case they are taken to be a -fully qualified name. E.g.: +Array of Traits to apply to the instance. Traits are Ls. - roles Caching - roles +MyApp::DB::Role::Foo +They are relative to the C<< MyApp::TraitFor::Model::DBIC::Schema:: >>, then the C<< +Catalyst::TraitFor::Model::DBIC::Schema:: >> namespaces, unless prefixed with C<+> +in which case they are taken to be a fully qualified name. E.g.: -This is done using L. + traits Caching + traits +MyApp::TraitFor::Model::Foo A new instance is created at application time, so any consumed required attributes, coercions and modifiers will work. -Roles are applied before setup, schema and connection are set, and have a chance -to modify C. +Traits are applied at L time using +L. -C will not be what you expect. +C will be an anon class if any traits are applied, C<< +$self->_original_class_name >> will be the original class. -WARNING: you cannot modify C, modify C instead. +When writing a Trait, interesting points to modify are C, L and +L. -Roles that come with the distribution: +Traits that come with the distribution: =over 4 -=item L +=item L + +=item L =back -=item storage_type +=head2 storage_type Allows the use of a different C than what is set in your C (which in turn defaults to C<::DBI> if not set in current L). Completely optional, and probably unnecessary for most people until other storage backends become available for L. -=back +=head1 ATTRIBUTES + +The keys you pass in the model configuration are available as attributes. + +Other attributes available: + +=head2 connect_info + +Your connect_info args normalized to hashref form (with dsn/user/password.) See +L for more info on the hashref form of +L. + +=head2 model_name + +The model name L uses to resolve this model, the part after +C<::Model::> or C<::M::> in your class name. E.g. if your class name is +C the L will be C. + +=head2 _default_cursor_class + +What to reset your L to if a custom one +doesn't work out. Defaults to L. + +=head1 ATTRIBUTES FROM L + +=head2 _original_class_name + +The class name of your model before any L are applied. E.g. +C. + +=head2 _traits + +Unresolved arrayref of traits passed in the config. + +=head2 _resolved_traits + +Traits you used resolved to full class names. =head1 METHODS -=over 4 +Methods not listed here are delegated to the connected schema used by the model +instance, so the following are equivalent: -=item new + $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. The only required parameter is C. C is required in the case that C does not already have connection information defined for it. -=item schema +=head2 schema Accessor which returns the connected schema being used by the this model. There are direct shortcuts on the model class itself for schema->resultset, schema->source, and schema->class. -=item composed_schema +=head2 composed_schema Accessor which returns the composed schema, which has no connection info, which was used in constructing the C above. Useful for creating new connections based on the same schema/model. There are direct shortcuts from the model object for composed_schema->clone and composed_schema->connect -=item clone +=head2 clone Shortcut for ->composed_schema->clone -=item connect +=head2 connect Shortcut for ->composed_schema->connect -=item source +=head2 source Shortcut for ->schema->source -=item class +=head2 class Shortcut for ->schema->class -=item resultset +=head2 resultset Shortcut for ->schema->resultset -=item storage +=head2 storage Provides an accessor for the connected schema's storage object. Used often for debugging and controlling transactions. =cut -class_has 'composed_schema' => (is => 'rw', isa => 'DBIx::Class::Schema'); - -has 'schema' => (is => 'rw', isa => 'DBIx::Class::Schema'); - -has 'schema_class' => ( +has schema_class => ( is => 'ro', - isa => SchemaClass, + isa => LoadedClass, coerce => 1, required => 1 ); -has 'storage_type' => (is => 'ro', isa => 'Str'); - -has 'connect_info' => (is => 'ro', isa => ConnectInfo, coerce => 1); +has storage_type => (is => 'rw', isa => Str); -# ref $self changes to anon after roles are applied, and _original_class_name is -# broken in MX::O::P 0.0009 -has '_class_name' => (is => 'ro', isa => 'ClassName', default => sub { - ref shift -}); +has connect_info => (is => 'rw', isa => ConnectInfo, coerce => 1); -has 'model_name' => (is => 'ro', isa => 'Str', default => sub { - my $self = shift; - - my $class = ref $self; - (my $model_name = $class) =~ s/^[\w:]+::(?:Model|M):://; - - $model_name -}); +has model_name => ( + is => 'ro', + isa => Str, + required => 1, + lazy_build => 1, +); -has 'roles' => (is => 'ro', isa => 'ArrayRef|Str'); +has _default_cursor_class => ( + is => 'ro', + isa => LoadedClass, + default => 'DBIx::Class::Storage::DBI::Cursor', + coerce => 1 +); sub BUILD { my $self = shift; - my $class = ref $self; + my $class = $self->_original_class_name; my $schema_class = $self->schema_class; if( !$self->connect_info ) { @@ -422,7 +476,7 @@ sub BUILD { $self->connect_info($schema_class->storage->connect_info); } else { - croak "Either ->config->{connect_info} must be defined for $class" + die "Either ->config->{connect_info} must be defined for $class" . " or $schema_class must have connect info defined on it." . " Here's what we got:\n" . Dumper($self); @@ -435,16 +489,22 @@ sub BUILD { . " ".$self->connect_info->{cursor_class}.": $@"; } - $self->_plugin_ns('Role'); - - $self->load_plugins($self->roles->flatten) if $self->roles; - $self->setup; $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; + $self->schema->storage_type($self->storage_type) if $self->storage_type; @@ -457,20 +517,20 @@ sub clone { shift->composed_schema->clone(@_); } sub connect { shift->composed_schema->connect(@_); } -sub storage { shift->schema->storage(@_); } - -=item setup +=head2 setup -Called at C<> time, for modifying in roles/subclasses. +Called at C time before configuration, but after L is +set. To do something after configuuration use C<< after BUILD => >>. =cut sub setup { 1 } -=item ACCEPT_CONTEXT +=head2 ACCEPT_CONTEXT -Point of extension for doing things at C<<$c->model>> time, returns the model -instance, see L for more information. +Point of extension for doing things at C<< $c->model >> time with context, +returns the model instance, see L for +more information. =cut @@ -478,10 +538,16 @@ sub ACCEPT_CONTEXT { shift } sub _install_rs_models { my $self = shift; - my $class = $self->_class_name; + my $class = $self->_original_class_name; no strict 'refs'; - foreach my $moniker ($self->schema->sources) { + + my @sources = $self->schema->sources; + + die "No sources found (did you forget to define your tables?)" + unless @sources; + + foreach my $moniker (@sources) { my $classname = "${class}::$moniker"; *{"${classname}::ACCEPT_CONTEXT"} = sub { shift; @@ -490,9 +556,85 @@ sub _install_rs_models { } } -__PACKAGE__->meta->make_immutable; +sub _reset_cursor_class { + my $self = shift; -=back + if ($self->storage->can('cursor_class')) { + $self->storage->cursor_class($self->_default_cursor_class) + if $self->storage->cursor_class ne $self->_default_cursor_class; + } +} + +{ + my %COMPOSED_CACHE; + + sub composed_schema { + my $self = shift; + my $class = $self->_original_class_name; + my $store = \$COMPOSED_CACHE{$class}{$self->schema_class}; + + $$store = shift if @_; + + return $$store + } +} + +sub _build_model_name { + my $self = shift; + my $class = $self->_original_class_name; + (my $model_name = $class) =~ s/^[\w:]+::(?:Model|M):://; + + return $model_name; +} + +sub _delegates { + my $self = shift; + +# XXX change this to CMOP once CAG is updated + my @schema_methods = @{ Class::Inspector->methods($self->schema_class) }; + +# 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. 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 = shift; + + my @attributes = map $_->name, $self->meta->get_all_attributes; + my %attributes; + @attributes{@attributes} = (); + + for my $opt (keys %$self) { + if (not exists $attributes{$opt}) { + die "Invalid schema option: $opt" unless $self->schema->can($opt); + + $self->schema->$opt($self->{$opt}); + } + } +} + +__PACKAGE__->meta->make_immutable; =head1 SEE ALSO @@ -504,15 +646,21 @@ L, L, L, Stuff related to DBIC and this Model style: L, L, -L, L +L, L, +L, L + +Traits: + +L, +L =head1 AUTHOR -Brandon L Black, C +Brandon L Black C -Contributors: +=head1 CONTRIBUTORS -Rafael Kitover, C<> +caelum: Rafael Kitover C =head1 COPYRIGHT @@ -522,3 +670,4 @@ under the same terms as Perl itself. =cut 1; +# vim:sts=4 sw=4 et: