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=488c42e49f27252ed62eec705ba7e61068a1acb0;hpb=2201c2e4eadb70fe4567d1a288604c62a473a6e4;p=catagits%2FCatalyst-Model-DBIC-Schema.git diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm index 488c42e..993c02c 100644 --- a/lib/Catalyst/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Model/DBIC/Schema.pm @@ -1,25 +1,23 @@ package Catalyst::Model::DBIC::Schema; -use strict; -use warnings; -no warnings 'uninitialized'; +use Moose; +use mro 'c3'; +extends 'Catalyst::Model'; +with 'CatalystX::Component::Traits'; -our $VERSION = '0.24'; +our $VERSION = '0.26'; -use parent qw/Catalyst::Model Class::Accessor::Fast Class::Data::Accessor/; -use MRO::Compat; -use mro 'c3'; -use UNIVERSAL::require; -use Carp; +use namespace::autoclean; +use Carp::Clan '^Catalyst::Model::DBIC::Schema'; use Data::Dumper; use DBIx::Class (); -use Scalar::Util 'reftype'; -use namespace::clean -except => 'meta'; +use Moose::Autobox; +use Class::Inspector (); + +use Catalyst::Model::DBIC::Schema::Types + qw/ConnectInfo LoadedClass/; -__PACKAGE__->mk_classaccessor('composed_schema'); -__PACKAGE__->mk_accessors(qw/ - schema connect_info schema_class storage_type caching model_name -/); +use MooseX::Types::Moose qw/ArrayRef Str ClassName Undef/; =head1 NAME @@ -93,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 @@ -187,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). @@ -242,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 @@ -271,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: @@ -283,6 +297,7 @@ supported: pg_enable_utf8 => 1, }, { + auto_savepoint => 1, on_connect_do => [ 'some SQL statement', 'another SQL statement', @@ -290,273 +305,336 @@ supported: } ] -=item caching +=head2 traits + +Array of Traits to apply to the instance. Traits are Ls. + +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.: + + 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. + +Traits are applied at L time using +L. + +C will be an anon class if any traits are applied, C<< +$self->_original_class_name >> will be the original class. -Whether or not to enable caching support using L -and L. Enabled by default. +When writing a Trait, interesting points to modify are C, L and +L. -In order for this to work, L must be configured and -loaded. A possible configuration would look like this: +Traits that come with the distribution: - - - class Cache::FastMmap - unlink_on_exit 1 - - +=over 4 + +=item L -Then in your queries, set the C ResultSet attribute to the number of -seconds you want the query results to be cached for, eg.: +=item L - $c->model('DB::Table')->search({ foo => 'bar' }, { cache_for => 18000 }); +=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: + + $c->model('DB')->schema->my_accessor('foo'); + # or + $c->model('DB')->my_accessor('foo'); -=item new +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 -sub new { - my $self = shift->next::method(@_); - - my $class = ref $self; +has schema_class => ( + is => 'ro', + isa => LoadedClass, + coerce => 1, + required => 1 +); - $self->_build_model_name; +has storage_type => (is => 'rw', isa => Str); - croak "->config->{schema_class} must be defined for this model" - unless $self->schema_class; +has connect_info => (is => 'rw', isa => ConnectInfo, coerce => 1); - my $schema_class = $self->schema_class; +has model_name => ( + is => 'ro', + isa => Str, + required => 1, + lazy_build => 1, +); - $schema_class->require - or croak "Cannot load schema class '$schema_class': $@"; +has _default_cursor_class => ( + is => 'ro', + isa => LoadedClass, + default => 'DBIx::Class::Storage::DBI::Cursor', + coerce => 1 +); + +sub BUILD { + my $self = shift; + my $class = $self->_original_class_name; + my $schema_class = $self->schema_class; if( !$self->connect_info ) { if($schema_class->storage && $schema_class->storage->connect_info) { $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); } } + if (exists $self->connect_info->{cursor_class}) { + eval { Class::MOP::load_class($self->connect_info->{cursor_class}) } + or croak "invalid connect_info: Cannot load your cursor_class" + . " ".$self->connect_info->{cursor_class}.": $@"; + } + + $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; - $self->_normalize_connect_info; - - $self->_setup_caching; - $self->schema->connection($self->connect_info); $self->_install_rs_models; - - return $self; } sub clone { shift->composed_schema->clone(@_); } sub connect { shift->composed_schema->connect(@_); } -sub storage { shift->schema->storage(@_); } +=head2 setup -=item ACCEPT_CONTEXT - -Sets up runtime cache support on $c->model invocation. +Called at C time before configuration, but after L is +set. To do something after configuuration use C<< after BUILD => >>. =cut -sub ACCEPT_CONTEXT { - my ($self, $c) = @_; - - return $self unless - $self->caching; - - unless ($c->can('cache') && ref $c->cache) { - $c->log->debug("DBIx::Class cursor caching disabled, you don't seem to" - . " have a working Cache plugin."); - $self->caching(0); - $self->_reset_cursor_class; - return $self; - } +sub setup { 1 } - if (ref $self->schema->default_resultset_attributes) { - $self->schema->default_resultset_attributes->{cache_object} = - $c->cache; - } else { - $self->schema->default_resultset_attributes({ - cache_object => $c->cache - }); - } +=head2 ACCEPT_CONTEXT - $self; -} +Point of extension for doing things at C<< $c->model >> time with context, +returns the model instance, see L for +more information. -sub _normalize_connect_info { - my $self = shift; +=cut - my $connect_info = $self->connect_info; +sub ACCEPT_CONTEXT { shift } - my @connect_info = reftype $connect_info eq 'ARRAY' ? - @$connect_info : $connect_info; +sub _install_rs_models { + my $self = shift; + my $class = $self->_original_class_name; - my %connect_info; + no strict 'refs'; - if (!ref $connect_info[0]) { # array style - @connect_info{qw/dsn user password/} = - splice @connect_info, 0, 3; + my @sources = $self->schema->sources; - for my $i (0..1) { - my $extra = shift @connect_info; - last unless $extra; - croak "invalid connect_info" unless reftype $extra eq 'HASH'; + die "No sources found (did you forget to define your tables?)" + unless @sources; - %connect_info = (%connect_info, %$extra); + foreach my $moniker (@sources) { + my $classname = "${class}::$moniker"; + *{"${classname}::ACCEPT_CONTEXT"} = sub { + shift; + shift->model($self->model_name)->resultset($moniker); } - - croak "invalid connect_info" if @connect_info; - } elsif (@connect_info == 1 && reftype $connect_info[0] eq 'HASH') { - %connect_info = %{ $connect_info[0] }; - } elsif (reftype $connect_info eq 'HASH') { - %connect_info = %$connect_info; - } else { - croak "invalid connect_info"; } +} - if (exists $connect_info{cursor_class}) { - $connect_info{cursor_class}->require - or croak "invalid connect_info: Cannot load your cursor_class" - . " $connect_info{cursor_class}: $@"; - } +sub _reset_cursor_class { + my $self = shift; - $self->connect_info(\%connect_info); + if ($self->storage->can('cursor_class')) { + $self->storage->cursor_class($self->_default_cursor_class) + if $self->storage->cursor_class ne $self->_default_cursor_class; + } } -sub _install_rs_models { - my $self = shift; - my $class = ref $self; +{ + my %COMPOSED_CACHE; - no strict 'refs'; - foreach my $moniker ($self->schema->sources) { - my $classname = "${class}::$moniker"; - *{"${classname}::ACCEPT_CONTEXT"} = sub { - shift; - shift->model($self->model_name)->resultset($moniker); - } + 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 = ref $self; - my $model_name = $class; - $model_name =~ s/^[\w:]+::(?:Model|M):://; + my $self = shift; + my $class = $self->_original_class_name; + (my $model_name = $class) =~ s/^[\w:]+::(?:Model|M):://; - $self->model_name($model_name); + return $model_name; } -sub _setup_caching { +sub _delegates { my $self = shift; - return if defined $self->caching && !$self->caching; +# XXX change this to CMOP once CAG is updated + my @schema_methods = @{ Class::Inspector->methods($self->schema_class) }; - $self->caching(0); +# combine with any already added by other schemas + my @handles = eval { + @{ $self->meta->find_attribute_by_name('schema')->handles } + }; - if (my $cursor_class = $self->connect_info->{cursor_class}) { - unless ($cursor_class->can('clear_cache')) { - carp "Caching disabled, cursor_class $cursor_class does not" - . " support it."; - return; - } - } else { - my $cursor_class = 'DBIx::Class::Cursor::Cached'; +# 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') }; - unless ($cursor_class->require) { - carp "Caching disabled, cannot load $cursor_class: $@"; - return; - } + my %schema_methods; + @schema_methods{ @schema_methods, @handles } = (); + @schema_methods = keys %schema_methods; - $self->connect_info->{cursor_class} = $cursor_class; - } + my @my_methods = $self->meta->get_all_method_names; + my %my_methods; + @my_methods{@my_methods} = (); - $self->caching(1); + my @delegates; + for my $method (@schema_methods) { + push @delegates, $method unless exists $my_methods{$method}; + } - 1; + return \@delegates; } -sub _reset_cursor_class { +sub _pass_options_to_schema { my $self = shift; - if ($self->connect_info->{cursor_class} eq 'DBIx::Class::Cursor::Cached') { - $self->storage->cursor_class('DBIx::Class::Storage::DBI::Cursor'); + 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}); + } } - - 1; } -=back +__PACKAGE__->meta->make_immutable; =head1 SEE ALSO @@ -568,11 +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 + +=head1 CONTRIBUTORS + +caelum: Rafael Kitover C =head1 COPYRIGHT @@ -582,3 +670,4 @@ under the same terms as Perl itself. =cut 1; +# vim:sts=4 sw=4 et: