From: Rafael Kitover Date: Sun, 3 May 2009 05:14:43 +0000 (+0000) Subject: C::M::DBIC::Schema - warn on create=dynamic, other cleanups, ::Role::Replicated ... X-Git-Tag: v0.26~41 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c4fee9b88f9183e17c6499c077fcf8572a95c165;hp=f090a1494f91dd017ebc9053107a83eeecdcc34a;p=catagits%2FCatalyst-Model-DBIC-Schema.git C::M::DBIC::Schema - warn on create=dynamic, other cleanups, ::Role::Replicated (does not work yet) --- diff --git a/Changes b/Changes index fed9eac..5ebcbc2 100644 --- a/Changes +++ b/Changes @@ -1,7 +1,8 @@ Revision history for Perl extension Catalyst::Model::DBIC::Schema + - create=dynamic deprecation warning - conversion to Moose (of Model, helper to follow) - - cursor caching support (via role) + - cursor caching support (via ::Role::Caching) - switch to hashref connect_info for DBIC 8100 - better helper option parsing - pass loader opts to dynamic schemas diff --git a/Makefile.PL b/Makefile.PL index 7fc5ac6..c2025e7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,18 +5,13 @@ all_from 'lib/Catalyst/Model/DBIC/Schema.pm'; requires 'DBIx::Class' => '0.08100'; requires 'Catalyst::Runtime' => '5.80002'; -requires 'Moose'; requires 'Moose::Autobox'; requires 'MooseX::ClassAttribute'; requires 'MooseX::Types'; -requires 'MooseX::Object::Pluggable' => '0.0009'; +requires 'MooseX::Object::Pluggable' => '0.0011'; requires 'namespace::clean'; requires 'Carp::Clan'; - -if($] < 5.009_005) { - requires 'Class::C3::XS' => '0.08'; - requires 'Class::C3' => '0.20'; -} +requires 'List::MoreUtils'; test_requires 'Test::More'; diff --git a/lib/Catalyst/Helper/Model/DBIC/Schema.pm b/lib/Catalyst/Helper/Model/DBIC/Schema.pm index e7de1b1..8e0a437 100644 --- a/lib/Catalyst/Helper/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Helper/Model/DBIC/Schema.pm @@ -8,7 +8,7 @@ our $VERSION = '0.24'; use Carp; use Tie::IxHash (); use Data::Dumper (); -use List::Util (); +use List::Util 'first'; use namespace::clean -except => 'meta'; @@ -139,7 +139,9 @@ sub mk_compclass { my $self = $package->new(helper => $helper, schema_class => $schema_class); $helper->{schema_class} = $schema_class - or croak "Must supply schema class name"; + or die "Must supply schema class name"; + + @args = $self->_cleanup_args(\@args); my $create = ''; if ($args[0] && $args[0] =~ /^create=(dynamic|static)\z/) { @@ -156,7 +158,7 @@ sub mk_compclass { if (@args) { $self->_parse_loader_args(\@args); - if (List::Util::first { /dbi:/ } @args) { + if (first { /^dbi:/i } @args) { $helper->{setup_connect_info} = 1; $helper->{connect_info} = @@ -171,6 +173,7 @@ sub mk_compclass { $helper->{generator_version} = $VERSION; if ($create eq 'dynamic') { + $self->_print_dynamic_deprecation_warning; $self->helper->{loader_args} = $self->_build_helper_loader_args; $self->_gen_dynamic_schema; } elsif ($create eq 'static') { @@ -189,7 +192,7 @@ sub _parse_loader_args { next if $key =~ /^(?:components|constraint|exclude)\z/; $loader_args{$key} = eval $val; - croak "syntax error for loader args key '$key' with value '$val': $@" + die "syntax error for loader args key '$key' with value '$val': $@" if $@; } @@ -286,7 +289,7 @@ sub _build_helper_connect_info { for (@connect_info) { if (/^\s*{.*}\s*\z/) { my $hash = eval $_; - croak "Syntax errorr in connect_info hash: $_: $@" if $@; + die "Syntax errorr in connect_info hash: $_: $@" if $@; my %hash = %$hash; for my $key (keys %hash) { @@ -336,7 +339,7 @@ sub _parse_connect_info { for (@connect_info) { if (/^\s*{.*}\s*\z/) { my $hash = eval $_; - croak "Syntax errorr in connect_info hash: $_: $@" if $@; + die "Syntax errorr in connect_info hash: $_: $@" if $@; %connect_info = (%connect_info, %$hash); @@ -346,7 +349,7 @@ sub _parse_connect_info { my ($key, $val) = split /=/, $_, 2; $connect_info{$key} = eval $val; - croak "syntax error for connect_info key '$key' with value '$val': $@" + die "syntax error for connect_info key '$key' with value '$val': $@" if $@; } @@ -385,14 +388,14 @@ sub _gen_dynamic_schema { sub _gen_static_schema { my $self = shift; - croak "cannot load schema without connect info" unless $self->connect_info; + die "cannot load schema without connect info" unless $self->connect_info; my $helper = $self->helper; my $schema_dir = File::Spec->catfile($helper->{base}, 'lib'); eval { Class::MOP::load_class('DBIx::Class::Schema::Loader') }; - croak "Cannot load DBIx::Class::Schema::Loader: $@" if $@; + die "Cannot load DBIx::Class::Schema::Loader: $@" if $@; DBIx::Class::Schema::Loader->import( "dump_to_dir:$schema_dir", 'make_schema_at' @@ -412,6 +415,29 @@ sub _gen_model { $helper->render_file('compclass', $helper->{file} ); } +sub _print_dynamic_deprecation_warning { + warn <); + exit 0 if $response =~ /^n(o)?\z/; +} + +sub _cleanup_args { + my ($self, $args) = @_; + +# remove blanks, ie. someoned doing foo \ bar + my @res = grep !/^\s*\z/, @$args; + +# remove leading whitespace, ie. foo \ bar + s/^\s*// for @res; + + @res +} + =head1 SEE ALSO General Catalyst Stuff: diff --git a/lib/Catalyst/Model/DBIC/Schema.pm b/lib/Catalyst/Model/DBIC/Schema.pm index bb17412..0f2370f 100644 --- a/lib/Catalyst/Model/DBIC/Schema.pm +++ b/lib/Catalyst/Model/DBIC/Schema.pm @@ -184,15 +184,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). @@ -289,7 +287,7 @@ supported: } ] -=item roles +=head2 roles Array of Roles to apply at BUILD time. Roles are relative to the C< then C<> @@ -304,14 +302,13 @@ This is done using L. 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. +Roles are applied before setup, schema and connection are set. C will be an anon class if any roles are applied. You cannot modify C or C, modify C instead. -L can also be modified. +L and L can also be modified. Roles that come with the distribution: @@ -319,62 +316,60 @@ Roles that come with the distribution: =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 METHODS -=over 4 - -=item new +=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. @@ -392,7 +387,7 @@ has 'schema_class' => ( required => 1 ); -has 'storage_type' => (is => 'ro', isa => 'Str'); +has 'storage_type' => (is => 'rw', isa => 'Str'); has 'connect_info' => (is => 'ro', isa => ConnectInfo, coerce => 1); @@ -452,6 +447,8 @@ sub BUILD { $self->schema->connection($self->connect_info); $self->_install_rs_models; + + $self->finalize; } sub clone { shift->composed_schema->clone(@_); } @@ -460,15 +457,23 @@ 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. =cut sub setup { 1 } -=item ACCEPT_CONTEXT +=head2 finalize + +Called at the end of C after everything has been configured. + +=cut + +sub finalize { 1 } + +=head2 ACCEPT_CONTEXT Point of extension for doing things at C<<$c->model>> time, returns the model instance, see L for more information. @@ -493,8 +498,6 @@ sub _install_rs_models { __PACKAGE__->meta->make_immutable; -=back - =head1 SEE ALSO General Catalyst Stuff: @@ -508,6 +511,11 @@ L, L, L, L, L +Roles: + +L, +L + =head1 AUTHOR Brandon L Black, C diff --git a/lib/Catalyst/Model/DBIC/Schema/Role/Caching.pm b/lib/Catalyst/Model/DBIC/Schema/Role/Caching.pm index a122d43..ba374b5 100644 --- a/lib/Catalyst/Model/DBIC/Schema/Role/Caching.pm +++ b/lib/Catalyst/Model/DBIC/Schema/Role/Caching.pm @@ -8,7 +8,7 @@ use namespace::clean -except => 'meta'; =head1 NAME Catalyst::Model::DBIC::Schema::Role::Caching - Query caching support for -DBIx::Class +Catalyst::Model::DBIC::Schema =head1 SYNOPSIS @@ -43,9 +43,7 @@ seconds you want the query results to be cached for, eg.: =head1 CONFIG PARAMETERS -=over 4 - -=item caching +=head2 caching Turn caching on or off, you can use: @@ -53,8 +51,6 @@ Turn caching on or off, you can use: to disable caching at runtime. -=back - =cut has 'caching' => (is => 'rw', isa => 'Int', default => 1); @@ -112,12 +108,10 @@ before ACCEPT_CONTEXT => sub { =head1 METHODS -=over 4 - -=item _reset_cursor_class +=head2 _reset_cursor_class Reset the cursor class to L if it's set to -L. +L, if possible. =cut @@ -125,14 +119,13 @@ sub _reset_cursor_class { my $self = shift; if ($self->connect_info->{cursor_class} eq 'DBIx::Class::Cursor::Cached') { - $self->storage->cursor_class('DBIx::Class::Storage::DBI::Cursor'); + $self->storage->cursor_class('DBIx::Class::Storage::DBI::Cursor') + if $self->storage->can('cursor_class'); } 1; } -=back - =head1 SEE ALSO L, L, L, diff --git a/lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm b/lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm new file mode 100644 index 0000000..2ef3c51 --- /dev/null +++ b/lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm @@ -0,0 +1,88 @@ +package Catalyst::Model::DBIC::Schema::Role::Replicated; + +use Moose::Role; +use Moose::Autobox; +use Carp::Clan '^Catalyst::Model::DBIC::Schema'; + +use Catalyst::Model::DBIC::Schema::Types 'ConnectInfos'; + +use namespace::clean -except => 'meta'; + +=head1 NAME + +Catalyst::Model::DBIC::Schema::Role::Replicated - Replicated storage support for +L + +=head1 SYNOPSiS + + __PACKAGE__->config({ + roles => ['Replicated'] + connect_info => + ['dbi:mysql:master', 'user', 'pass'], + replicants => [ + ['dbi:mysql:slave1', 'user', 'pass'], + ['dbi:mysql:slave2', 'user', 'pass'], + ['dbi:mysql:slave3', 'user', 'pass'], + ] + }); + +=head1 DESCRIPTION + +B -- requires some DBIC changes + +Sets your storage_type to L and connects +replicants provided in config. See that module for supported resultset +attributes. + +=head1 CONFIG PARAMETERS + +=head2 replicants + +Array of connect_info settings for every replicant. + +=cut + +has replicants => ( + is => 'ro', isa => ConnectInfos, coerce => 1, required => 1 +); + +after setup => sub { + my $self = shift; + +# check storage_type compatibility (if configured) + if (my $storage_type = $self->storage_type) { + my $class = $storage_type =~ /^::/ ? + "DBIx::Class::Storage$storage_type" + : $storage_type; + + croak "This storage_type cannot be used with replication" + unless $class->isa('DBIx::Class::Storage::DBI::Replicated'); + } else { + $self->storage_type('::DBI::Replicated'); + } +}; + +after finalize => sub { + my $self = shift; + + $self->storage->connect_replicants($self->replicants->flatten); +}; + +=head1 SEE ALSO + +L, L, +L, +L, L + +=head1 AUTHOR + +Rafael Kitover, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; diff --git a/lib/Catalyst/Model/DBIC/Schema/Types.pm b/lib/Catalyst/Model/DBIC/Schema/Types.pm index b3b3e0f..989d502 100644 --- a/lib/Catalyst/Model/DBIC/Schema/Types.pm +++ b/lib/Catalyst/Model/DBIC/Schema/Types.pm @@ -1,10 +1,11 @@ package Catalyst::Model::DBIC::Schema::Types; use MooseX::Types - -declare => [qw/ConnectInfo SchemaClass/]; + -declare => [qw/ConnectInfo ConnectInfos Replicants SchemaClass/]; use MooseX::Types::Moose qw/ArrayRef HashRef Str ClassName/; use Scalar::Util 'reftype'; +use List::MoreUtils 'all'; use Carp; use namespace::clean -except => 'meta'; @@ -25,35 +26,50 @@ coerce ConnectInfo, from Str, via { +{ dsn => $_ } }, from ArrayRef, - via { - my %connect_info; - - if (!ref $_->[0]) { # array style - $connect_info{dsn} = shift @$_; - $connect_info{user} = shift @$_ if !ref $_->[0]; - $connect_info{password} = shift @$_ if !ref $_->[0]; - - for my $i (0..1) { - my $extra = shift @$_; - last unless $extra; - croak "invalid connect_info" unless reftype $extra eq 'HASH'; - - %connect_info = (%connect_info, %$extra); - } - - croak "invalid connect_info" if @$_; - } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') { - return $_->[0]; - } else { - croak "invalid connect_info"; - } - - \%connect_info; -}; + via \&_coerce_connect_info_from_arrayref; # { connect_info => [ ... ] } coercion would be nice, but no chained coercions -# yet and no coercion from subtype (yet) but in Moose git already. +# yet. +# Also no coercion from base type (yet,) but in Moose git already. # from HashRef, # via { $_->{connect_info} }, +subtype ConnectInfos, + as ArrayRef[ConnectInfo], + message { "Not a valid array of connect_info's" }; + +coerce ConnectInfos, + from Str, + via { [ { dsn => $_ } ] }, + from ArrayRef[Str], + via { [ map +{ dsn => $_ }, @$_ ] }, + from ArrayRef[ArrayRef], + via { [ map \&_coerce_connect_info_from_arrayref, @$_ ] }; + +sub _coerce_connect_info_from_arrayref { + my %connect_info; + + if (!ref $_->[0]) { # array style + $connect_info{dsn} = shift @$_; + $connect_info{user} = shift @$_ if !ref $_->[0]; + $connect_info{password} = shift @$_ if !ref $_->[0]; + + for my $i (0..1) { + my $extra = shift @$_; + last unless $extra; + croak "invalid connect_info" unless reftype $extra eq 'HASH'; + + %connect_info = (%connect_info, %$extra); + } + + croak "invalid connect_info" if @$_; + } elsif (@$_ == 1 && reftype $_->[0] eq 'HASH') { + return $_->[0]; + } else { + croak "invalid connect_info"; + } + + \%connect_info; +} + 1;