[Catalyst-commits] r9746 - in trunk/Catalyst-Model-DBIC-Schema: .
lib/Catalyst/Helper/Model/DBIC lib/Catalyst/Model/DBIC
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Sun Apr 19 17:40:32 GMT 2009
Author: caelum
Date: 2009-04-19 18:40:32 +0100 (Sun, 19 Apr 2009)
New Revision: 9746
Added:
trunk/Catalyst-Model-DBIC-Schema/TODO
Modified:
trunk/Catalyst-Model-DBIC-Schema/Changes
trunk/Catalyst-Model-DBIC-Schema/Makefile.PL
trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Helper/Model/DBIC/Schema.pm
trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm
Log:
M::DBIC::Schema -- refactored helper, caching support
Modified: trunk/Catalyst-Model-DBIC-Schema/Changes
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/Changes 2009-04-18 23:03:03 UTC (rev 9745)
+++ trunk/Catalyst-Model-DBIC-Schema/Changes 2009-04-19 17:40:32 UTC (rev 9746)
@@ -1,5 +1,10 @@
Revision history for Perl extension Catalyst::Model::DBIC::Schema
+ - switch to hashref connect_info for DBIC 8100
+ - better helper option parsing
+ - pass loader opts to dynamic schemas
+ - cursor caching support for model
+
0.23 Sun Mar 8 20:30:02 GMT 2009
- Kill a couple of warnings (one due to MRO::Compat)
Modified: trunk/Catalyst-Model-DBIC-Schema/Makefile.PL
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/Makefile.PL 2009-04-18 23:03:03 UTC (rev 9745)
+++ trunk/Catalyst-Model-DBIC-Schema/Makefile.PL 2009-04-19 17:40:32 UTC (rev 9746)
@@ -3,13 +3,16 @@
name 'Catalyst-Model-DBIC-Schema';
all_from 'lib/Catalyst/Model/DBIC/Schema.pm';
-requires 'DBIx::Class' => '0.07006';
+requires 'DBIx::Class' => '0.08101';
+requires 'DBIx::Class::Cursor::Cached';
requires 'Catalyst::Runtime' => '5.70';
requires 'UNIVERSAL::require' => '0.10';
requires 'Class::Data::Accessor' => '0.02';
requires 'Class::Accessor::Fast' => '0.22';
+requires 'parent';
requires 'MRO::Compat';
+requires 'namespace::clean';
if($] < 5.009_005) {
requires 'Class::C3::XS' => '0.08';
@@ -21,6 +24,7 @@
feature 'Catalyst::Helper support',
-default => 0,
'Catalyst::Devel' => '1.0',
+ 'Tie::IxHash' => 0,
'DBIx::Class::Schema::Loader' => '0.04005';
if(-e 'MANIFEST.SKIP') {
Added: trunk/Catalyst-Model-DBIC-Schema/TODO
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/TODO (rev 0)
+++ trunk/Catalyst-Model-DBIC-Schema/TODO 2009-04-19 17:40:32 UTC (rev 9746)
@@ -0,0 +1 @@
+timezone and locale support for dates at helper time
Modified: trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Helper/Model/DBIC/Schema.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Helper/Model/DBIC/Schema.pm 2009-04-18 23:03:03 UTC (rev 9745)
+++ trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Helper/Model/DBIC/Schema.pm 2009-04-19 17:40:32 UTC (rev 9746)
@@ -4,18 +4,29 @@
use warnings;
no warnings 'uninitialized';
-our $VERSION = '0.23';
+our $VERSION = '0.24';
+use parent 'Class::Accessor::Fast';
+
use Carp;
use UNIVERSAL::require;
+use Tie::IxHash ();
+use Data::Dumper ();
+use List::Util ();
+__PACKAGE__->mk_accessors(qw/
+ helper schema_class loader_args connect_info _old_schema
+/);
+
=head1 NAME
Catalyst::Helper::Model::DBIC::Schema - Helper for DBIC Schema Models
=head1 SYNOPSIS
- script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass [ create=dynamic | create=static ] [ Schema::Loader opts ] [ connect_info arguments ]
+ script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass \
+ [ create=dynamic | create=static ] [ Schema::Loader opts ] \
+ [ dsn user pass ] [ other connect_info arguments ]
=head1 DESCRIPTION
@@ -58,19 +69,31 @@
# Use DBIx::Class::Schema::Loader to create a static DBIx::Class::Schema,
# and a Model which references it:
- script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
+ script/myapp_create.pl model CatalystModelName DBIC::Schema \
+ MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
+ # Same, with extra connect_info args
+ script/myapp_create.pl model CatalystModelName DBIC::Schema \
+ MyApp::SchemaClass create=static dbi:SQLite:foo.db '' '' \
+ AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
+ on_connect_do='["select 1", "select 2"]'
+
# Same, but with extra Schema::Loader args (separate multiple values by commas):
- script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass create=static db_schema=foodb components=Foo,Bar exclude='^wibble|wobble$' dbi:Pg:dbname=foodb myuname mypass
+ script/myapp_create.pl model CatalystModelName DBIC::Schema \
+ MyApp::SchemaClass create=static db_schema=foodb components=Foo,Bar \
+ exclude='^wibble|wobble$' moniker_map='{ foo => "FFFFUUUU" }' \
+ dbi:Pg:dbname=foodb myuname mypass
# See DBIx::Class::Schema::Loader::Base for list of options
# Create a dynamic DBIx::Class::Schema::Loader-based Schema,
# and a Model which references it:
- script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
+ script/myapp_create.pl model CatalystModelName DBIC::Schema \
+ MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
# Reference an existing Schema of any kind, and provide some connection information for ->config:
- script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass dbi:mysql:foodb myuname mypass
+ script/myapp_create.pl model CatalystModelName DBIC::Schema \
+ MyApp::SchemaClass dbi:mysql:foodb myuname mypass
# Same, but don't supply connect information yet (you'll need to do this
# in your app config, or [not recommended] in the schema itself).
@@ -83,112 +106,297 @@
=cut
sub mk_compclass {
- my ( $self, $helper, $schema_class, @connect_info) = @_;
+ my ($package, $helper, $schema_class, @args) = @_;
+ my $self = $package->new;
+
$helper->{schema_class} = $schema_class
or croak "Must supply schema class name";
+ $self->schema_class($schema_class);
+ $self->helper($helper);
+
my $create = '';
- if($connect_info[0] && $connect_info[0] =~ /^create=(dynamic|static)$/) {
+ if ($args[0] && $args[0] =~ /^create=(dynamic|static)$/) {
$create = $1;
- shift @connect_info;
+ shift @args;
+
+ if (@args) {
+ $self->_parse_loader_args(\@args);
+
+ if (List::Util::first { /dbi:/ } @args) {
+ $helper->{setup_connect_info} = 1;
+
+ $helper->{connect_info} =
+ $self->_build_helper_connect_info(\@args);
+
+ $self->_parse_connect_info(\@args) if $create eq 'static';
+ }
+ }
}
- my %extra_args;
- while (@connect_info && $connect_info[0] !~ /^dbi:/) {
- my ($key, $val) = split /=/, shift(@connect_info);
+ $helper->{generator} = ref $self;
+ $helper->{generator_version} = $VERSION;
+ if ($create eq 'dynamic') {
+ $self->helper->{loader_args} = $self->_build_helper_loader_args;
+ $self->_gen_dynamic_schema;
+ } elsif ($create eq 'static') {
+ $self->_gen_static_schema;
+ }
+
+ $self->_gen_model;
+}
+
+sub _parse_loader_args {
+ my ($self, $args) = @_;
+
+ my %loader_args = $self->_read_loader_args($args);
+
+ while (my ($key, $val) = each %loader_args) {
+ next if $key =~ /^(?:components|constraint|exclude)\z/;
+
+ $loader_args{$key} = eval $val;
+ die "syntax error for loader args key '$key' with value '$val': $@"
+ if $@;
+ }
+
+ my @components =
+ $self->_build_loader_components(delete $loader_args{components});
+
+ for my $re_opt (qw/constraint exclude/) {
+ $loader_args{$re_opt} = qr/$loader_args{$re_opt}/
+ if exists $loader_args{$re_opt};
+ }
+
+ tie my %result, 'Tie::IxHash';
+
+ %result = (
+ relationships => 1,
+ (%loader_args ? %loader_args : ()),
+ (!$self->_is_old_schema ? (
+ use_namespaces => 1
+ ) : ()),
+ (@components ? (
+ components => \@components
+ ) : ())
+ );
+
+ $self->loader_args(\%result);
+
+ wantarray ? %result : \%result;
+}
+
+sub _read_loader_args {
+ my ($self, $args) = @_;
+
+ my %loader_args;
+
+ while (@$args && $args->[0] !~ /^dbi:/) {
+ my ($key, $val) = split /=/, shift(@$args), 2;
+
if ((my @vals = split /,/ => $val) > 1) {
- $extra_args{$key} = \@vals;
+ $loader_args{$key} = \@vals;
} else {
- $extra_args{$key} = $val;
+ $loader_args{$key} = $val;
}
}
- if(@connect_info) {
- $helper->{setup_connect_info} = 1;
- my @helper_connect_info = @connect_info;
- for(@helper_connect_info) {
- $_ = qq{'$_'} if $_ !~ /^\s*[[{]/;
+ wantarray ? %loader_args : \%loader_args;
+}
+
+sub _build_helper_loader_args {
+ my $self = shift;
+
+ my $args = $self->loader_args;
+
+ tie my %loader_args, 'Tie::IxHash';
+
+ while (my ($arg, $val) = each %$args) {
+ if (ref $val) {
+ $loader_args{$arg} = $self->_data_struct_to_string($val);
+ } else {
+ $loader_args{$arg} = qq{'$val'};
}
- $helper->{connect_info} = \@helper_connect_info;
}
- if($create eq 'dynamic') {
- my @schema_parts = split(/\:\:/, $helper->{schema_class});
- my $schema_file_part = pop @schema_parts;
+ \%loader_args
+}
- my $schema_dir = File::Spec->catfile( $helper->{base}, 'lib', @schema_parts );
- my $schema_file = File::Spec->catfile( $schema_dir, $schema_file_part . '.pm' );
+sub _build_loader_components {
+ my ($self, $components) = @_;
- $helper->mk_dir($schema_dir);
- $helper->render_file( 'schemaclass', $schema_file );
+ my @components = $self->_is_old_schema ? () : ('InflateColumn::DateTime');
+
+ if ($components) {
+ $components = [ $components ] if !ref $components;
+ push @components, @$components;
}
- elsif($create eq 'static') {
- my $schema_dir = File::Spec->catfile( $helper->{base}, 'lib' );
- DBIx::Class::Schema::Loader->use("dump_to_dir:$schema_dir", 'make_schema_at')
- or croak "Cannot load DBIx::Class::Schema::Loader: $@";
- my @loader_connect_info = @connect_info;
- my $num = 6; # argument number on the commandline for "dbi:..."
- for(@loader_connect_info) {
- if(/^\s*[[{]/) {
- $_ = eval "$_";
- croak "Perl syntax error in commandline argument $num: $@" if $@;
+ wantarray ? @components : \@components;
+}
+
+sub _build_helper_connect_info {
+ my ($self, $connect_info) = @_;
+
+ my @connect_info = @$connect_info;
+
+ my ($dsn, $user, $password) = splice @connect_info, 0, 3;
+
+ tie my %helper_connect_info, 'Tie::IxHash';
+
+ %helper_connect_info = (
+ dsn => qq{'$dsn'},
+ user => qq{'$user'},
+ password => qq{'$password'}
+ );
+
+ for (@connect_info) {
+ if (/^\s*{.*}\s*\z/) {
+ my $hash = eval $_;
+ die "Syntax errorr in connect_info hash: $_: $@" if $@;
+ my %hash = %$hash;
+
+ for my $key (keys %hash) {
+ my $val = $hash{$key};
+
+ if (ref $val) {
+ $val = $self->_data_struct_to_string($val);
+ } else {
+ $val = qq{'$val'};
+ }
+
+ $helper_connect_info{$key} = $val;
}
- $num++;
+
+ next;
}
-# Check if we need to be backward-compatible.
- my $compatible = 0;
+ my ($key, $val) = split /=/, $_, 2;
- my @schema_pm = split '::', $schema_class;
- $schema_pm[-1] .= '.pm';
- my $schema_file = File::Spec->catfile($helper->{base}, 'lib', @schema_pm);
+ $helper_connect_info{$key} = $self->_quote_unless_struct($val);
+ }
- if (-f $schema_file) {
- my $schema_code = do { local (@ARGV, $/) = $schema_file; <> };
- $compatible = 1 if $schema_code =~ /->load_classes/;
- }
+ \%helper_connect_info
+}
- my @components = $compatible ? () : ('InflateColumn::DateTime');
+sub _data_struct_to_string {
+ my ($self, $data) = @_;
- if (exists $extra_args{components}) {
- $extra_args{components} = [ $extra_args{components} ]
- unless ref $extra_args{components};
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Indent = 0;
+ local $Data::Dumper::Useqq = 1;
- push @components, @{ delete $extra_args{components} };
- }
+ return Data::Dumper->Dump([$data]);
+}
- for my $re_opt (qw/constraint exclude/) {
- $extra_args{$re_opt} = qr/$extra_args{$re_opt}/
- if exists $extra_args{$re_opt};
- }
+sub _parse_connect_info {
+ my ($self, $connect_info) = @_;
- if (exists $extra_args{moniker_map}) {
- die "The moniker_map option is not currently supported by this helper, please write your own DBIx::Class::Schema::Loader script if you need it."
+ my @connect_info = @$connect_info;
+
+ my ($dsn, $user, $password) = splice @connect_info, 0, 3;
+
+ tie my %connect_info, 'Tie::IxHash';
+ @connect_info{qw/dsn user password/} = ($dsn, $user, $password);
+
+ for (@connect_info) {
+ if (/^\s*{.*}\s*\z/) {
+ my $hash = eval $_;
+ die "Syntax errorr in connect_info hash: $_: $@" if $@;
+
+ %connect_info = (%connect_info, %$hash);
+
+ next;
}
- make_schema_at(
- $schema_class,
- {
- relationships => 1,
- (%extra_args ? %extra_args : ()),
- (!$compatible ? (
- use_namespaces => 1
- ) : ()),
- (@components ? (
- components => \@components
- ) : ())
- },
- \@loader_connect_info,
- );
+ my ($key, $val) = split /=/, $_, 2;
+
+ $connect_info{$key} = eval $val;
+ die "syntax error for connect_info key '$key' with value '$val': $@"
+ if $@;
}
- my $file = $helper->{file};
- $helper->render_file( 'compclass', $file );
+ $self->connect_info(\%connect_info);
+
+ \%connect_info
}
+sub _quote_unless_struct {
+ my ($self, $val) = @_;
+
+ $val = qq{'$val'} if $val !~ /^\s*[[{]/;
+
+ $val;
+}
+
+sub _gen_dynamic_schema {
+ my $self = shift;
+
+ my $helper = $self->helper;
+
+ my @schema_parts = split(/\:\:/, $self->schema_class);
+ my $schema_file_part = pop @schema_parts;
+
+ my $schema_dir = File::Spec->catfile(
+ $helper->{base}, 'lib', @schema_parts
+ );
+ my $schema_file = File::Spec->catfile(
+ $schema_dir, $schema_file_part . '.pm'
+ );
+
+ $helper->mk_dir($schema_dir);
+ $helper->render_file('schemaclass', $schema_file);
+}
+
+sub _gen_static_schema {
+ my $self = shift;
+
+ die "cannot load schema without connect info" unless $self->connect_info;
+
+ my $helper = $self->helper;
+
+ my $schema_dir = File::Spec->catfile($helper->{base}, 'lib');
+
+ DBIx::Class::Schema::Loader->use(
+ "dump_to_dir:$schema_dir", 'make_schema_at'
+ ) or croak "Cannot load DBIx::Class::Schema::Loader: $@";
+
+ make_schema_at(
+ $self->schema_class,
+ $self->loader_args,
+ [$self->connect_info]
+ );
+}
+
+sub _is_old_schema {
+ my $self = shift;
+
+ return $self->_old_schema if defined $self->_old_schema;
+
+ my @schema_pm = split '::', $self->schema_class;
+ $schema_pm[-1] .= '.pm';
+ my $schema_file =
+ File::Spec->catfile($self->helper->{base}, 'lib', @schema_pm);
+
+ if (-f $schema_file) {
+ my $schema_code = do { local (@ARGV, $/) = $schema_file; <> };
+ $self->_old_schema(1) if $schema_code =~ /->load_classes/;
+ } else {
+ $self->_old_schema(0);
+ }
+
+ return $self->_old_schema;
+}
+
+sub _gen_model {
+ my $self = shift;
+ my $helper = $self->helper;
+
+ $helper->render_file('compclass', $helper->{file} );
+}
+
=head1 SEE ALSO
General Catalyst Stuff:
@@ -225,13 +433,15 @@
use base qw/DBIx::Class::Schema::Loader/;
__PACKAGE__->loader_options(
- relationships => 1,
- # debug => 1,
+ [%- FOREACH key = loader_args.keys %]
+ [% key %] => [% loader_args.${key} %],
+ [%- END -%]
+
);
=head1 NAME
-[% schema_class %] - DBIx::Class::Schema::Loader class
+[% schema_class %] - L<DBIx::Class::Schema::Loader> class
=head1 SYNOPSIS
@@ -239,11 +449,15 @@
=head1 DESCRIPTION
-Generated by L<Catalyst::Model::DBIC::Schema> for use in L<[% class %]>
+Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>
+=head1 GENERATED BY
+
+[% generator %] - [% generator_version %]
+
=head1 AUTHOR
-[% author %]
+[% author.replace(',+$', '') %]
=head1 LICENSE
@@ -262,15 +476,18 @@
__PACKAGE__->config(
schema_class => '[% schema_class %]',
- [% IF setup_connect_info %]connect_info => [
- [% FOREACH arg = connect_info %][% arg %],
- [% END %]
- ],[% END %]
+ [% IF setup_connect_info %]connect_info => {
+ [%- FOREACH key = connect_info.keys %]
+ [% key %] => [% connect_info.${key} %],
+ [%- END -%]
+
+ }[% END %]
);
=head1 NAME
[% class %] - Catalyst DBIC Schema Model
+
=head1 SYNOPSIS
See L<[% app %]>
@@ -279,9 +496,13 @@
L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
+=head1 GENERATED BY
+
+[% generator %] - [% generator_version %]
+
=head1 AUTHOR
-[% author %]
+[% author.replace(',+$', '') %]
=head1 LICENSE
Modified: trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm
===================================================================
--- trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm 2009-04-18 23:03:03 UTC (rev 9745)
+++ trunk/Catalyst-Model-DBIC-Schema/lib/Catalyst/Model/DBIC/Schema.pm 2009-04-19 17:40:32 UTC (rev 9746)
@@ -2,19 +2,24 @@
use strict;
use warnings;
+no warnings 'uninitialized';
-our $VERSION = '0.23';
+our $VERSION = '0.24';
-use base qw/Catalyst::Model Class::Accessor::Fast Class::Data::Accessor/;
+use parent qw/Catalyst::Model Class::Accessor::Fast Class::Data::Accessor/;
use MRO::Compat;
use mro 'c3';
use UNIVERSAL::require;
use Carp;
use Data::Dumper;
-require DBIx::Class;
+use DBIx::Class ();
+use Scalar::Util 'reftype';
+use namespace::clean -except => 'meta';
__PACKAGE__->mk_classaccessor('composed_schema');
-__PACKAGE__->mk_accessors('schema');
+__PACKAGE__->mk_accessors(qw/
+ schema connect_info schema_class storage_type caching model_name
+/);
=head1 NAME
@@ -71,12 +76,11 @@
__PACKAGE__->config(
schema_class => 'MyApp::Schema::FilmDB',
- connect_info => [
- "DBI:...",
- "username",
- "password",
- {AutoCommit => 1}
- ]
+ connect_info => {
+ dsn => "DBI:...",
+ user => "username",
+ password => "password",
+ }
);
See below for a full list of the possible config parameters.
@@ -210,39 +214,39 @@
Examples:
- connect_info => [ 'dbi:Pg:dbname=mypgdb', 'postgres', '' ],
+ connect_info => {
+ dsn => 'dbi:Pg:dbname=mypgdb',
+ user => 'postgres',
+ password => ''
+ }
- connect_info => [
- 'dbi:SQLite:dbname=foo.db',
- {
- on_connect_do => [
- 'PRAGMA synchronous = OFF',
- ],
- }
- ],
+ connect_info => {
+ dsn => 'dbi:SQLite:dbname=foo.db',
+ on_connect_do => [
+ 'PRAGMA synchronous = OFF',
+ ]
+ }
- connect_info => [
- 'dbi:Pg:dbname=mypgdb',
- 'postgres',
- '',
- { AutoCommit => 0 },
- {
- on_connect_do => [
- 'some SQL statement',
- 'another SQL statement',
- ],
- }
- ],
+ connect_info => {
+ dsn => 'dbi:Pg:dbname=mypgdb',
+ user => 'postgres',
+ password => '',
+ pg_enable_utf8 => 1,
+ on_connect_do => [
+ 'some SQL statement',
+ 'another SQL statement',
+ ],
+ }
Or using L<Config::General>:
<Model::FilmDB>
schema_class MyApp::Schema::FilmDB
- connect_info dbi:Pg:dbname=mypgdb
- connect_info postgres
- connect_info
<connect_info>
- AutoCommit 0
+ dsn dbi:Pg:dbname=mypgdb
+ user postgres
+ password ''
+ auto_savepoint 1
on_connect_do some SQL statement
on_connect_do another SQL statement
</connect_info>
@@ -255,7 +259,57 @@
connect_info dbi:SQLite:dbname=foo.db
</Model::FilmDB>
+Or using L<YAML>:
+ Model::MyDB:
+ schema_class: MyDB
+ 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'
+
+The old arrayref style with hashrefs for L<DBI> then L<DBIx::Class> options is also
+supported:
+
+ connect_info => [
+ 'dbi:Pg:dbname=mypgdb',
+ 'postgres',
+ '',
+ {
+ pg_enable_utf8 => 1,
+ },
+ {
+ on_connect_do => [
+ 'some SQL statement',
+ 'another SQL statement',
+ ],
+ }
+ ]
+
+=item caching
+
+Whether or not to enable caching support using L<DBIx::Class::Cursor::Cached>
+and L<Catalyst::Plugin::Cache>. Enabled by default.
+
+In order for this to work, L<Catalyst::Plugin::Cache> must be configured and
+loaded. A possible configuration would look like this:
+
+ <Plugin::Cache>
+ <backend>
+ class Cache::FastMmap
+ unlink_on_exit 1
+ </backend>
+ </Plugin::Cache>
+
+Then in your queries, set the C<cache_for> ResultSet attribute to the number of
+seconds you want the query results to be cached for, eg.:
+
+ $c->model('DB::Table')->search({ foo => 'bar' }, { cache_for => 18000 });
+
=item storage_type
Allows the use of a different C<storage_type> than what is set in your
@@ -314,28 +368,26 @@
Provides an accessor for the connected schema's storage object.
Used often for debugging and controlling transactions.
-=back
-
=cut
sub new {
my $self = shift->next::method(@_);
- my $class = ref($self);
- my $model_name = $class;
- $model_name =~ s/^[\w:]+::(?:Model|M):://;
+ my $class = ref $self;
+ $self->_build_model_name;
+
croak "->config->{schema_class} must be defined for this model"
- unless $self->{schema_class};
+ unless $self->schema_class;
- my $schema_class = $self->{schema_class};
+ my $schema_class = $self->schema_class;
$schema_class->require
or croak "Cannot load schema class '$schema_class': $@";
- if( !$self->{connect_info} ) {
+ if( !$self->connect_info ) {
if($schema_class->storage && $schema_class->storage->connect_info) {
- $self->{connect_info} = $schema_class->storage->connect_info;
+ $self->connect_info($schema_class->storage->connect_info);
}
else {
croak "Either ->config->{connect_info} must be defined for $class"
@@ -346,35 +398,166 @@
}
$self->composed_schema($schema_class->compose_namespace($class));
+
$self->schema($self->composed_schema->clone);
- $self->schema->storage_type($self->{storage_type})
- if $self->{storage_type};
+ $self->schema->storage_type($self->storage_type)
+ if $self->storage_type;
- $self->schema->connection(
- ref $self->{connect_info} eq 'ARRAY' ?
- @{$self->{connect_info}} :
- $self->{connect_info}
- );
+ $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(@_); }
+
+=item ACCEPT_CONTEXT
+
+Sets up runtime cache support on $c->model invocation.
+
+=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;
+ }
+
+ 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
+ });
+ }
+
+ $self;
+}
+
+sub _normalize_connect_info {
+ my $self = shift;
+
+ my $connect_info = $self->connect_info;
+
+ my @connect_info = reftype $connect_info eq 'ARRAY' ?
+ @$connect_info : $connect_info;
+
+ my %connect_info;
+
+ if (!ref $connect_info[0]) { # array style
+ @connect_info{qw/dsn user password/} =
+ splice @connect_info, 0, 3;
+
+ for my $i (0..1) {
+ my $extra = shift @connect_info;
+ last unless $extra;
+ croak "invalid connect_info" unless reftype $extra eq 'HASH';
+
+ %connect_info = (%connect_info, %$extra);
+ }
+
+ 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}: $@";
+ }
+
+ $self->connect_info(\%connect_info);
+}
+
+sub _install_rs_models {
+ my $self = shift;
+ my $class = ref $self;
+
no strict 'refs';
foreach my $moniker ($self->schema->sources) {
my $classname = "${class}::$moniker";
*{"${classname}::ACCEPT_CONTEXT"} = sub {
shift;
- shift->model($model_name)->resultset($moniker);
+ shift->model($self->model_name)->resultset($moniker);
}
}
+}
- return $self;
+sub _build_model_name {
+ my $self = shift;
+
+ my $class = ref $self;
+ my $model_name = $class;
+ $model_name =~ s/^[\w:]+::(?:Model|M):://;
+
+ $self->model_name($model_name);
}
-sub clone { shift->composed_schema->clone(@_); }
+sub _setup_caching {
+ my $self = shift;
-sub connect { shift->composed_schema->connect(@_); }
+ return if defined $self->caching && !$self->caching;
-sub storage { shift->schema->storage(@_); }
+ $self->caching(0);
+ 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';
+
+ unless ($cursor_class->require) {
+ carp "Caching disabled, cannot load $cursor_class: $@";
+ return;
+ }
+
+ $self->connect_info->{cursor_class} = $cursor_class;
+ }
+
+ $self->caching(1);
+
+ 1;
+}
+
+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');
+ }
+
+ 1;
+}
+
+=back
+
=head1 SEE ALSO
General Catalyst Stuff:
More information about the Catalyst-commits
mailing list