C::M::DBIC::Schema - warn on create=dynamic, other cleanups, ::Role::Replicated ...
Rafael Kitover [Sun, 3 May 2009 05:14:43 +0000 (05:14 +0000)]
Changes
Makefile.PL
lib/Catalyst/Helper/Model/DBIC/Schema.pm
lib/Catalyst/Model/DBIC/Schema.pm
lib/Catalyst/Model/DBIC/Schema/Role/Caching.pm
lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm [new file with mode: 0644]
lib/Catalyst/Model/DBIC/Schema/Types.pm

diff --git a/Changes b/Changes
index fed9eac..5ebcbc2 100644 (file)
--- 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
index 7fc5ac6..c2025e7 100644 (file)
@@ -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';
 
index e7de1b1..8e0a437 100644 (file)
@@ -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 <<EOF;
+************************************ WARNING **********************************
+* create=dynamic is DEPRECATED, please use create=static instead.             *
+*******************************************************************************
+EOF
+    print "Continue? [y/n]: ";
+    chomp(my $response = <STDIN>);
+    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:
index bb17412..0f2370f 100644 (file)
@@ -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<DBIx::Class::Schema> Schema.  It needs
 to be findable in C<@INC>, but it does not need to be inside the 
 C<Catalyst::Model::> namespace.  This parameter is required.
 
-=item connect_info
+=head2 connect_info
 
 This is an arrayref of connection parameters, which are specific to your
 C<storage_type> (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<<MyApp::Model::DB::Role::> then C<<Catalyst::Model::DBIC::Schema::Role::>>
@@ -304,14 +302,13 @@ This is done using L<MooseX::Object::Pluggable>.
 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<connect_info>.
+Roles are applied before setup, schema and connection are set.
 
 C<ref $self> will be an anon class if any roles are applied.
 
 You cannot modify C<new> or C<BUILD>, modify C<setup> instead.
 
-L</ACCEPT_CONTEXT> can also be modified.
+L</ACCEPT_CONTEXT> and L</finalize> can also be modified.
 
 Roles that come with the distribution:
 
@@ -319,62 +316,60 @@ Roles that come with the distribution:
 
 =item L<Catalyst::Model::DBIC::Schema::Role::Caching>
 
+=item L<Catalyst::Model::DBIC::Schema::Role::Replicated>
+
 =back
 
-=item storage_type
+=head2 storage_type
 
 Allows the use of a different C<storage_type> than what is set in your
 C<schema_class> (which in turn defaults to C<::DBI> if not set in current
 L<DBIx::Class>).  Completely optional, and probably unnecessary for most
 people until other storage backends become available for L<DBIx::Class>.
 
-=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<schema_class>.  C<connect_info> is
 required in the case that C<schema_class> 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<schema> 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<<BUILD>> time, for modifying in roles/subclasses.
+Called at C<<BUILD>> time before configuration.
 
 =cut
 
 sub setup { 1 }
 
-=item ACCEPT_CONTEXT
+=head2 finalize
+
+Called at the end of C<BUILD> 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<Catalyst::Manual::Intro> 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<DBIx::Class>, L<DBIx::Class::Schema>,
 L<DBIx::Class::Schema::Loader>, L<Catalyst::Helper::Model::DBIC::Schema>,
 L<MooseX::Object::Pluggable>
 
+Roles:
+
+L<Catalyst::Model::DBIC::Schema::Role::Caching>,
+L<Catalyst::Model::DBIC::Schema::Role::Replicated>
+
 =head1 AUTHOR
 
 Brandon L Black, C<blblack@gmail.com>
index a122d43..ba374b5 100644 (file)
@@ -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<DBIx::Class::Storage::DBI::Cursor> if it's set to
-L<DBIx::Class::Cursor::Cached>.
+L<DBIx::Class::Cursor::Cached>, 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<Catalyst::Model::DBIC::Schema>, L<DBIx::Class>, L<Catalyst::Plugin::Cache>,
diff --git a/lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm b/lib/Catalyst/Model/DBIC/Schema/Role/Replicated.pm
new file mode 100644 (file)
index 0000000..2ef3c51
--- /dev/null
@@ -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<Catalyst::Model::DBIC::Schema>
+
+=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<DOES NOT WORK YET> -- requires some DBIC changes
+
+Sets your storage_type to L<DBIx::Class::Storage::DBI::Replicated> 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<Catalyst::Model::DBIC::Schema>, L<DBIx::Class>,
+L<DBIx::Class::Storage::DBI::Replicated>,
+L<Cache::FastMmap>, L<DBIx::Class::Cursor::Cached>
+
+=head1 AUTHOR
+
+Rafael Kitover, C<rkitover@cpan.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
index b3b3e0f..989d502 100644 (file)
@@ -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;