[catagits/Catalyst-Model-DBIC-Schema.git] / lib / Catalyst / Helper / Model / DBIC / Schema.pm

package Catalyst::Helper::Model::DBIC::Schema;

use strict;
use warnings;
no warnings 'uninitialized';

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 ] \
    [ dsn user pass ] [ other connect_info arguments ]

=head1 DESCRIPTION

Helper for the DBIC Schema Models.

=head2 Arguments:

C<CatalystModelName> is the short name for the Catalyst Model class
being generated (i.e. callable with C<$c-E<gt>model('CatalystModelName')>).

C<MyApp::SchemaClass> is the fully qualified classname of your Schema,
which might or might not yet exist.  Note that you should have a good
reason to create this under a new global namespace, otherwise use an
existing top level namespace for your schema class.

C<create=dynamic> instructs this Helper to generate the named Schema
class for you, basing it on L<DBIx::Class::Schema::Loader> (which
means the table information will always be dynamically loaded at
runtime from the database).

C<create=static> instructs this Helper to generate the named Schema
class for you, using L<DBIx::Class::Schema::Loader> in "one shot"
mode to create a standard, manually-defined L<DBIx::Class::Schema>
setup, based on what the Loader sees in your database at this moment.
A Schema/Model pair generated this way will not require
L<DBIx::Class::Schema::Loader> at runtime, and will not automatically
adapt itself to changes in your database structure.  You can edit
the generated classes by hand to refine them.

C<connect_info> arguments are the same as what
DBIx::Class::Schema::connect expects, and are storage_type-specific.
For DBI-based storage, these arguments are the dsn, username,
password, and connect options, respectively.  These are optional for
existing Schemas, but required if you use either of the C<create=>
options.

Use of either of the C<create=> options requires L<DBIx::Class::Schema::Loader>.

=head1 TYPICAL EXAMPLES

  # 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

  # 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$' 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

  # 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

  # 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).
  script/myapp_create.pl model ModelName DBIC::Schema My::SchemaClass

=head1 METHODS

=head2 mk_compclass

=cut

sub mk_compclass {
    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 ($args[0] && $args[0] =~ /^create=(dynamic|static)$/) {
        $create = $1;
        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';
            }
        }
    }

    $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) {
            $loader_args{$key} = \@vals;
        } else {
            $loader_args{$key} = $val;
        }
    }

    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'};
        }
    }

    \%loader_args
}

sub _build_loader_components {
    my ($self, $components) = @_;

    my @components = $self->_is_old_schema ? () : ('InflateColumn::DateTime');

    if ($components) {
        $components = [ $components ] if !ref $components;
        push @components, @$components;
    }

    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;
            }

            next;
        }

        my ($key, $val) = split /=/, $_, 2;

        $helper_connect_info{$key} = $self->_quote_unless_struct($val);
    }

    \%helper_connect_info
}

sub _data_struct_to_string {
    my ($self, $data) = @_;

    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Quotekeys = 0;
    local $Data::Dumper::Indent = 0;
    local $Data::Dumper::Useqq = 1;

    return Data::Dumper->Dump([$data]);
}

sub _parse_connect_info {
    my ($self, $connect_info) = @_;

    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;
        }

        my ($key, $val) = split /=/, $_, 2;

        $connect_info{$key} = eval $val;
        die "syntax error for connect_info key '$key' with value '$val': $@"
            if $@;
    }

    $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:

L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,

Stuff related to DBIC and this Model style:

L<DBIx::Class>, L<DBIx::Class::Schema>,
L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>

=head1 AUTHOR

Brandon L Black, C<blblack@gmail.com>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__DATA__

=begin pod_to_ignore

__schemaclass__
package [% schema_class %];

use strict;
use base qw/DBIx::Class::Schema::Loader/;

__PACKAGE__->loader_options(
    [%- FOREACH key = loader_args.keys %]
    [% key %] => [% loader_args.${key} %],
    [%- END -%]

);

=head1 NAME

[% schema_class %] - L<DBIx::Class::Schema::Loader> class

=head1 SYNOPSIS

See L<[% app %]>

=head1 DESCRIPTION

Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>

=head1 GENERATED BY

[% generator %] - [% generator_version %]

=head1 AUTHOR

[% author.replace(',+$', '') %]

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__compclass__
package [% class %];

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config(
    schema_class => '[% schema_class %]',
    [% 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 %]>

=head1 DESCRIPTION

L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>

=head1 GENERATED BY

[% generator %] - [% generator_version %]

=head1 AUTHOR

[% author.replace(',+$', '') %]

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
Commit	Line	Data
ad91060a	1	package Catalyst::Helper::Model::DBIC::Schema;
	2
	3	use strict;
0f2fd2c0	4	use warnings;
ffbf1967	5	no warnings 'uninitialized';
018eb0e2	6
2201c2e4	7	our $VERSION = '0.24';
	8
	9	use parent 'Class::Accessor::Fast';
018eb0e2	10
0f2fd2c0	11	use Carp;
781c6876	12	use UNIVERSAL::require;
2201c2e4	13	use Tie::IxHash ();
	14	use Data::Dumper ();
	15	use List::Util ();
	16
	17	__PACKAGE__->mk_accessors(qw/
	18	helper schema_class loader_args connect_info _old_schema
	19	/);
ad91060a	20
	21	=head1 NAME
	22
	23	Catalyst::Helper::Model::DBIC::Schema - Helper for DBIC Schema Models
	24
	25	=head1 SYNOPSIS
	26
2201c2e4	27	script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass \
	28	[ create=dynamic \| create=static ] [ Schema::Loader opts ] \
	29	[ dsn user pass ] [ other connect_info arguments ]
0f2fd2c0	30
d89e6c8a	31	=head1 DESCRIPTION
	32
	33	Helper for the DBIC Schema Models.
	34
	35	=head2 Arguments:
	36
018eb0e2	37	C<CatalystModelName> is the short name for the Catalyst Model class
018eb0e2	38	being generated (i.e. callable with C<$c-E<gt>model('CatalystModelName')>).
6116daed	39
018eb0e2	40	C<MyApp::SchemaClass> is the fully qualified classname of your Schema,
6116daed	41	which might or might not yet exist. Note that you should have a good
	42	reason to create this under a new global namespace, otherwise use an
	43	existing top level namespace for your schema class.
	44
018eb0e2	45	C<create=dynamic> instructs this Helper to generate the named Schema
6116daed	46	class for you, basing it on L<DBIx::Class::Schema::Loader> (which
	47	means the table information will always be dynamically loaded at
	48	runtime from the database).
	49
018eb0e2	50	C<create=static> instructs this Helper to generate the named Schema
6116daed	51	class for you, using L<DBIx::Class::Schema::Loader> in "one shot"
	52	mode to create a standard, manually-defined L<DBIx::Class::Schema>
	53	setup, based on what the Loader sees in your database at this moment.
	54	A Schema/Model pair generated this way will not require
	55	L<DBIx::Class::Schema::Loader> at runtime, and will not automatically
	56	adapt itself to changes in your database structure. You can edit
	57	the generated classes by hand to refine them.
	58
018eb0e2	59	C<connect_info> arguments are the same as what
6116daed	60	DBIx::Class::Schema::connect expects, and are storage_type-specific.
	61	For DBI-based storage, these arguments are the dsn, username,
	62	password, and connect options, respectively. These are optional for
	63	existing Schemas, but required if you use either of the C<create=>
	64	options.
d89e6c8a	65
d89e6c8a	66	Use of either of the C<create=> options requires L<DBIx::Class::Schema::Loader>.
0b2a7108	67
	68	=head1 TYPICAL EXAMPLES
	69
d89e6c8a	70	# Use DBIx::Class::Schema::Loader to create a static DBIx::Class::Schema,
d89e6c8a	71	# and a Model which references it:
2201c2e4	72	script/myapp_create.pl model CatalystModelName DBIC::Schema \
	73	MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
	74
	75	# Same, with extra connect_info args
	76	script/myapp_create.pl model CatalystModelName DBIC::Schema \
	77	MyApp::SchemaClass create=static dbi:SQLite:foo.db '' '' \
	78	AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
	79	on_connect_do='["select 1", "select 2"]'
0b2a7108	80
ca14239e	81	# Same, but with extra Schema::Loader args (separate multiple values by commas):
2201c2e4	82	script/myapp_create.pl model CatalystModelName DBIC::Schema \
	83	MyApp::SchemaClass create=static db_schema=foodb components=Foo,Bar \
	84	exclude='^wibble\|wobble$' moniker_map='{ foo => "FFFFUUUU" }' \
	85	dbi:Pg:dbname=foodb myuname mypass
34f036a0	86
ca14239e	87	# See DBIx::Class::Schema::Loader::Base for list of options
34f036a0	88
d89e6c8a	89	# Create a dynamic DBIx::Class::Schema::Loader-based Schema,
d89e6c8a	90	# and a Model which references it:
2201c2e4	91	script/myapp_create.pl model CatalystModelName DBIC::Schema \
2201c2e4	92	MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
ad91060a	93
d89e6c8a	94	# Reference an existing Schema of any kind, and provide some connection information for ->config:
2201c2e4	95	script/myapp_create.pl model CatalystModelName DBIC::Schema \
2201c2e4	96	MyApp::SchemaClass dbi:mysql:foodb myuname mypass
ad91060a	97
d89e6c8a	98	# Same, but don't supply connect information yet (you'll need to do this
	99	# in your app config, or [not recommended] in the schema itself).
	100	script/myapp_create.pl model ModelName DBIC::Schema My::SchemaClass
ad91060a	101
018eb0e2	102	=head1 METHODS
ad91060a	103
018eb0e2	104	=head2 mk_compclass
ad91060a	105
	106	=cut
	107
	108	sub mk_compclass {
2201c2e4	109	my ($package, $helper, $schema_class, @args) = @_;
	110
	111	my $self = $package->new;
0f2fd2c0	112
d89e6c8a	113	$helper->{schema_class} = $schema_class
592cd3ae	114	or croak "Must supply schema class name";
d89e6c8a	115
2201c2e4	116	$self->schema_class($schema_class);
	117	$self->helper($helper);
	118
d89e6c8a	119	my $create = '';
2201c2e4	120	if ($args[0] && $args[0] =~ /^create=(dynamic\|static)$/) {
d89e6c8a	121	$create = $1;
2201c2e4	122	shift @args;
	123
	124	if (@args) {
	125	$self->_parse_loader_args(\@args);
	126
	127	if (List::Util::first { /dbi:/ } @args) {
	128	$helper->{setup_connect_info} = 1;
	129
	130	$helper->{connect_info} =
	131	$self->_build_helper_connect_info(\@args);
	132
	133	$self->_parse_connect_info(\@args) if $create eq 'static';
	134	}
	135	}
d89e6c8a	136	}
0f2fd2c0	137
2201c2e4	138	$helper->{generator} = ref $self;
	139	$helper->{generator_version} = $VERSION;
	140
	141	if ($create eq 'dynamic') {
	142	$self->helper->{loader_args} = $self->_build_helper_loader_args;
	143	$self->_gen_dynamic_schema;
	144	} elsif ($create eq 'static') {
	145	$self->_gen_static_schema;
	146	}
	147
	148	$self->_gen_model;
	149	}
	150
	151	sub _parse_loader_args {
	152	my ($self, $args) = @_;
	153
	154	my %loader_args = $self->_read_loader_args($args);
	155
	156	while (my ($key, $val) = each %loader_args) {
	157	next if $key =~ /^(?:components\|constraint\|exclude)\z/;
	158
	159	$loader_args{$key} = eval $val;
	160	die "syntax error for loader args key '$key' with value '$val': $@"
	161	if $@;
	162	}
	163
	164	my @components =
	165	$self->_build_loader_components(delete $loader_args{components});
	166
	167	for my $re_opt (qw/constraint exclude/) {
	168	$loader_args{$re_opt} = qr/$loader_args{$re_opt}/
	169	if exists $loader_args{$re_opt};
	170	}
	171
	172	tie my %result, 'Tie::IxHash';
	173
	174	%result = (
	175	relationships => 1,
	176	(%loader_args ? %loader_args : ()),
	177	(!$self->_is_old_schema ? (
	178	use_namespaces => 1
	179	) : ()),
	180	(@components ? (
	181	components => \@components
	182	) : ())
	183	);
	184
	185	$self->loader_args(\%result);
	186
	187	wantarray ? %result : \%result;
	188	}
	189
	190	sub _read_loader_args {
	191	my ($self, $args) = @_;
	192
	193	my %loader_args;
	194
	195	while (@$args && $args->[0] !~ /^dbi:/) {
	196	my ($key, $val) = split /=/, shift(@$args), 2;
ca14239e	197
ca14239e	198	if ((my @vals = split /,/ => $val) > 1) {
2201c2e4	199	$loader_args{$key} = \@vals;
ca14239e	200	} else {
2201c2e4	201	$loader_args{$key} = $val;
ca14239e	202	}
	203	}
	204
2201c2e4	205	wantarray ? %loader_args : \%loader_args;
	206	}
	207
	208	sub _build_helper_loader_args {
	209	my $self = shift;
	210
	211	my $args = $self->loader_args;
	212
	213	tie my %loader_args, 'Tie::IxHash';
	214
	215	while (my ($arg, $val) = each %$args) {
	216	if (ref $val) {
	217	$loader_args{$arg} = $self->_data_struct_to_string($val);
	218	} else {
	219	$loader_args{$arg} = qq{'$val'};
0b2a7108	220	}
0f2fd2c0	221	}
0f2fd2c0	222
2201c2e4	223	\%loader_args
	224	}
	225
	226	sub _build_loader_components {
	227	my ($self, $components) = @_;
d89e6c8a	228
2201c2e4	229	my @components = $self->_is_old_schema ? () : ('InflateColumn::DateTime');
d89e6c8a	230
2201c2e4	231	if ($components) {
	232	$components = [ $components ] if !ref $components;
	233	push @components, @$components;
d89e6c8a	234	}
2201c2e4	235
	236	wantarray ? @components : \@components;
	237	}
	238
	239	sub _build_helper_connect_info {
	240	my ($self, $connect_info) = @_;
	241
	242	my @connect_info = @$connect_info;
	243
	244	my ($dsn, $user, $password) = splice @connect_info, 0, 3;
	245
	246	tie my %helper_connect_info, 'Tie::IxHash';
	247
	248	%helper_connect_info = (
	249	dsn => qq{'$dsn'},
	250	user => qq{'$user'},
	251	password => qq{'$password'}
	252	);
	253
	254	for (@connect_info) {
	255	if (/^\s{.}\s*\z/) {
	256	my $hash = eval $_;
	257	die "Syntax errorr in connect_info hash: $_: $@" if $@;
	258	my %hash = %$hash;
	259
	260	for my $key (keys %hash) {
	261	my $val = $hash{$key};
	262
	263	if (ref $val) {
	264	$val = $self->_data_struct_to_string($val);
	265	} else {
	266	$val = qq{'$val'};
	267	}
	268
	269	$helper_connect_info{$key} = $val;
592cd3ae	270	}
2201c2e4	271
2201c2e4	272	next;
592cd3ae	273	}
592cd3ae	274
2201c2e4	275	my ($key, $val) = split /=/, $_, 2;
1d155058	276
2201c2e4	277	$helper_connect_info{$key} = $self->_quote_unless_struct($val);
2201c2e4	278	}
1d155058	279
2201c2e4	280	\%helper_connect_info
2201c2e4	281	}
1d155058	282
2201c2e4	283	sub _data_struct_to_string {
2201c2e4	284	my ($self, $data) = @_;
34f036a0	285
2201c2e4	286	local $Data::Dumper::Terse = 1;
	287	local $Data::Dumper::Quotekeys = 0;
	288	local $Data::Dumper::Indent = 0;
	289	local $Data::Dumper::Useqq = 1;
34f036a0	290
2201c2e4	291	return Data::Dumper->Dump([$data]);
2201c2e4	292	}
34f036a0	293
2201c2e4	294	sub _parse_connect_info {
	295	my ($self, $connect_info) = @_;
	296
	297	my @connect_info = @$connect_info;
	298
	299	my ($dsn, $user, $password) = splice @connect_info, 0, 3;
	300
	301	tie my %connect_info, 'Tie::IxHash';
	302	@connect_info{qw/dsn user password/} = ($dsn, $user, $password);
	303
	304	for (@connect_info) {
	305	if (/^\s{.}\s*\z/) {
	306	my $hash = eval $_;
	307	die "Syntax errorr in connect_info hash: $_: $@" if $@;
	308
	309	%connect_info = (%connect_info, %$hash);
ca14239e	310
2201c2e4	311	next;
ca14239e	312	}
ca14239e	313
2201c2e4	314	my ($key, $val) = split /=/, $_, 2;
	315
	316	$connect_info{$key} = eval $val;
	317	die "syntax error for connect_info key '$key' with value '$val': $@"
	318	if $@;
d89e6c8a	319	}
202d09c8	320
2201c2e4	321	$self->connect_info(\%connect_info);
	322
	323	\%connect_info
	324	}
	325
	326	sub _quote_unless_struct {
	327	my ($self, $val) = @_;
	328
	329	$val = qq{'$val'} if $val !~ /^\s*[[{]/;
	330
	331	$val;
	332	}
	333
	334	sub _gen_dynamic_schema {
	335	my $self = shift;
	336
	337	my $helper = $self->helper;
	338
	339	my @schema_parts = split(/\:\:/, $self->schema_class);
	340	my $schema_file_part = pop @schema_parts;
	341
	342	my $schema_dir = File::Spec->catfile(
	343	$helper->{base}, 'lib', @schema_parts
	344	);
	345	my $schema_file = File::Spec->catfile(
	346	$schema_dir, $schema_file_part . '.pm'
	347	);
	348
	349	$helper->mk_dir($schema_dir);
	350	$helper->render_file('schemaclass', $schema_file);
	351	}
	352
	353	sub _gen_static_schema {
	354	my $self = shift;
	355
	356	die "cannot load schema without connect info" unless $self->connect_info;
	357
	358	my $helper = $self->helper;
	359
	360	my $schema_dir = File::Spec->catfile($helper->{base}, 'lib');
	361
	362	DBIx::Class::Schema::Loader->use(
	363	"dump_to_dir:$schema_dir", 'make_schema_at'
	364	) or croak "Cannot load DBIx::Class::Schema::Loader: $@";
	365
	366	make_schema_at(
	367	$self->schema_class,
	368	$self->loader_args,
	369	[$self->connect_info]
	370	);
	371	}
	372
	373	sub _is_old_schema {
	374	my $self = shift;
	375
	376	return $self->_old_schema if defined $self->_old_schema;
	377
	378	my @schema_pm = split '::', $self->schema_class;
	379	$schema_pm[-1] .= '.pm';
	380	my $schema_file =
	381	File::Spec->catfile($self->helper->{base}, 'lib', @schema_pm);
	382
	383	if (-f $schema_file) {
	384	my $schema_code = do { local (@ARGV, $/) = $schema_file; <> };
385	$self->_old_schema(1) if $schema_code =~ /->load_classes/;
386	} else {
387	$self->_old_schema(0);
388	}
389
390	return $self->_old_schema;
391	}
392
393	sub _gen_model {
394	my $self = shift;
395	my $helper = $self->helper;
396
397	$helper->render_file('compclass', $helper->{file} );
ad91060a	398	}
	399
	400	=head1 SEE ALSO
	401
7b39f3f0	402	General Catalyst Stuff:
7b39f3f0	403
ad91060a	404	L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
7b39f3f0	405	L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,
	406
	407	Stuff related to DBIC and this Model style:
	408
	409	L<DBIx::Class>, L<DBIx::Class::Schema>,
ef91bcf9	410	L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>
ad91060a	411
	412	=head1 AUTHOR
	413
	414	Brandon L Black, C<blblack@gmail.com>
	415
	416	=head1 LICENSE
	417
	418	This library is free software, you can redistribute it and/or modify
	419	it under the same terms as Perl itself.
	420
	421	=cut
	422
dce0dfe8	423	1;
dce0dfe8	424
ad91060a	425	__DATA__
ad91060a	426
5d11d759	427	=begin pod_to_ignore
5d11d759	428
d89e6c8a	429	__schemaclass__
	430	package [% schema_class %];
	431
	432	use strict;
	433	use base qw/DBIx::Class::Schema::Loader/;
	434
	435	__PACKAGE__->loader_options(
2201c2e4	436	[%- FOREACH key = loader_args.keys %]
	437	[% key %] => [% loader_args.${key} %],
	438	[%- END -%]
	439
d89e6c8a	440	);
	441
	442	=head1 NAME
	443
2201c2e4	444	[% schema_class %] - L<DBIx::Class::Schema::Loader> class
d89e6c8a	445
	446	=head1 SYNOPSIS
	447
	448	See L<[% app %]>
	449
	450	=head1 DESCRIPTION
	451
2201c2e4	452	Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>
	453
	454	=head1 GENERATED BY
	455
	456	[% generator %] - [% generator_version %]
d89e6c8a	457
	458	=head1 AUTHOR
	459
2201c2e4	460	[% author.replace(',+$', '') %]
d89e6c8a	461
	462	=head1 LICENSE
	463
	464	This library is free software, you can redistribute it and/or modify
	465	it under the same terms as Perl itself.
	466
	467	=cut
	468
	469	1;
	470
ad91060a	471	__compclass__
	472	package [% class %];
	473
	474	use strict;
	475	use base 'Catalyst::Model::DBIC::Schema';
	476
	477	__PACKAGE__->config(
0f2fd2c0	478	schema_class => '[% schema_class %]',
2201c2e4	479	[% IF setup_connect_info %]connect_info => {
	480	[%- FOREACH key = connect_info.keys %]
	481	[% key %] => [% connect_info.${key} %],
	482	[%- END -%]
	483
	484	}[% END %]
ad91060a	485	);
	486
	487	=head1 NAME
	488
1aeb6e1e	489	[% class %] - Catalyst DBIC Schema Model
2201c2e4	490
ad91060a	491	=head1 SYNOPSIS
	492
	493	See L<[% app %]>
	494
	495	=head1 DESCRIPTION
	496
d89e6c8a	497	L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
ad91060a	498
2201c2e4	499	=head1 GENERATED BY
	500
	501	[% generator %] - [% generator_version %]
	502
ad91060a	503	=head1 AUTHOR
ad91060a	504
2201c2e4	505	[% author.replace(',+$', '') %]
ad91060a	506
	507	=head1 LICENSE
	508
	509	This library is free software, you can redistribute it and/or modify
	510	it under the same terms as Perl itself.
	511
	512	=cut
	513
	514	1;