1 package Catalyst::Helper::Model::DBIC::Schema;
3 use namespace::autoclean;
5 no warnings 'uninitialized';
8 $VERSION = eval $VERSION;
13 use List::Util 'first';
14 use MooseX::Types::Moose qw/Str HashRef Bool ArrayRef/;
15 use Catalyst::Model::DBIC::Schema::Types 'CreateOption';
16 use List::MoreUtils 'firstidx';
17 use Scalar::Util 'looks_like_number';
18 use File::Find 'finddepth';
24 Catalyst::Helper::Model::DBIC::Schema - Helper for DBIC Schema Models
28 script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass \
29 [ create=dynamic | create=static ] [ traits=trait1,trait2... ] \
30 [ Schema::Loader opts ] [ dsn user pass ] \
31 [ other connect_info args ]
35 Helper for the DBIC Schema Models.
39 C<CatalystModelName> is the short name for the Catalyst Model class
40 being generated (i.e. callable with C<$c-E<gt>model('CatalystModelName')>).
42 C<MyApp::SchemaClass> is the fully qualified classname of your Schema,
43 which might or might not yet exist. Note that you should have a good
44 reason to create this under a new global namespace, otherwise use an
45 existing top level namespace for your schema class.
47 C<create=dynamic> instructs this Helper to generate the named Schema
48 class for you, basing it on L<DBIx::Class::Schema::Loader> (which
49 means the table information will always be dynamically loaded at
50 runtime from the database).
52 C<create=static> instructs this Helper to generate the named Schema
53 class for you, using L<DBIx::Class::Schema::Loader> in "one shot"
54 mode to create a standard, manually-defined L<DBIx::Class::Schema>
55 setup, based on what the Loader sees in your database at this moment.
56 A Schema/Model pair generated this way will not require
57 L<DBIx::Class::Schema::Loader> at runtime, and will not automatically
58 adapt itself to changes in your database structure. You can edit
59 the generated classes by hand to refine them.
61 C<traits> is the list of traits to apply to the model, see
62 L<Catalyst::Model::DBIC::Schema> for details.
64 C<Schema::Loader opts> are documented in L<DBIx::Class::Schema::Loader::Base>
65 and some examples are given in L</TYPICAL EXAMPLES> below.
67 C<connect_info> arguments are the same as what L<DBIx::Class::Schema/connect>
68 expects, and are storage_type-specific. They are documented in
69 L<DBIx::Class::Storage::DBI/connect_info>. For DBI-based storage, these
70 arguments are the dsn, username, password, and connect options, respectively.
71 These are optional for existing Schemas, but required if you use either of the
74 username and password can be omitted for C<SQLite> dsns.
76 Use of either of the C<create=> options requires L<DBIx::Class::Schema::Loader>.
78 =head1 TYPICAL EXAMPLES
80 Use DBIx::Class::Schema::Loader to create a static DBIx::Class::Schema,
81 and a Model which references it:
83 script/myapp_create.pl model CatalystModelName DBIC::Schema \
84 MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
86 Same, with extra connect_info args
87 user and pass can be omitted for sqlite, since they are always empty
89 script/myapp_create.pl model CatalystModelName DBIC::Schema \
90 MyApp::SchemaClass create=static dbi:SQLite:foo.db \
91 AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
92 on_connect_do='["select 1", "select 2"]' quote_names=1
94 B<ON WINDOWS COMMAND LINES QUOTING RULES ARE DIFFERENT>
96 In C<cmd.exe> the above example would be:
98 script/myapp_create.pl model CatalystModelName DBIC::Schema \
99 MyApp::SchemaClass create=static dbi:SQLite:foo.db \
100 AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
101 on_connect_do="[\"select 1\", \"select 2\"]" quote_names=1
103 Same, but with extra Schema::Loader args (separate multiple values by commas):
105 script/myapp_create.pl model CatalystModelName DBIC::Schema \
106 MyApp::SchemaClass create=static db_schema=foodb components=Foo,Bar \
107 exclude='^(wibble|wobble)$' moniker_map='{ foo => "FOO" }' \
108 dbi:Pg:dbname=foodb myuname mypass
110 Coderefs are also supported:
112 script/myapp_create.pl model CatalystModelName DBIC::Schema \
113 MyApp::SchemaClass create=static \
114 inflect_singular='sub { $_[0] =~ /\A(.+?)(_id)?\z/; $1 }' \
115 moniker_map='sub { join(q{}, map ucfirst, split(/[\W_]+/, lc $_[0])); }' \
116 dbi:mysql:foodb myuname mypass
118 See L<DBIx::Class::Schema::Loader::Base> for a list of options
120 Create a dynamic DBIx::Class::Schema::Loader-based Schema,
121 and a Model which references it (B<DEPRECATED>):
123 script/myapp_create.pl model CatalystModelName DBIC::Schema \
124 MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
126 Reference an existing Schema of any kind, and provide some connection information for ->config:
128 script/myapp_create.pl model CatalystModelName DBIC::Schema \
129 MyApp::SchemaClass dbi:mysql:foodb myuname mypass
131 Same, but don't supply connect information yet (you'll need to do this
132 in your app config, or [not recommended] in the schema itself).
134 script/myapp_create.pl model ModelName DBIC::Schema My::SchemaClass
138 has helper => (is => 'ro', isa => 'Catalyst::Helper', required => 1);
139 has create => (is => 'rw', isa => CreateOption);
140 has args => (is => 'ro', isa => ArrayRef);
141 has traits => (is => 'rw', isa => ArrayRef);
142 has schema_class => (is => 'ro', isa => Str, required => 1);
143 has loader_args => (is => 'rw', isa => HashRef);
144 has connect_info => (is => 'rw', isa => HashRef);
145 has old_schema => (is => 'rw', isa => Bool, lazy_build => 1);
146 has is_moose_schema => (is => 'rw', isa => Bool, lazy_build => 1);
147 has result_namespace => (is => 'rw', isa => Str, lazy_build => 1);
148 has components => (is => 'rw', isa => ArrayRef);
154 This is called by L<Catalyst::Helper> with the commandline args to generate the
160 my ($package, $helper, $schema_class, @args) = @_;
162 my $self = $package->new(
164 schema_class => $schema_class,
173 my $helper = $self->helper;
174 my @args = @{ $self->args || [] };
176 $helper->{schema_class} = $self->schema_class;
178 @args = $self->_cleanup_args(\@args);
180 my ($traits_idx, $traits);
181 if (($traits_idx = firstidx { ($traits) = /^traits=(\S*)\z/ } @args) != -1) {
182 my @traits = split /,/ => $traits;
184 $self->traits(\@traits);
186 $helper->{traits} = '['
187 .(join ',' => map { qq{'$_'} } @traits)
190 splice @args, $traits_idx, 1, ();
193 if ($args[0] && $args[0] =~ /^create=(\S*)\z/) {
198 $self->_parse_loader_args(\@args);
200 $helper->{loader_args} = $self->_build_helper_loader_args;
205 if (first { ($dbi_dsn_part) = /^(dbi):/i } @args) {
207 qq{DSN must start with 'dbi:' not '$dbi_dsn_part' (case matters!)}
208 if $dbi_dsn_part ne 'dbi';
210 $helper->{setup_connect_info} = 1;
212 $helper->{connect_info} =
213 $self->_build_helper_connect_info(\@args);
215 $self->_parse_connect_info(\@args);
218 $helper->{generator} = ref $self;
219 $helper->{generator_version} = $VERSION;
224 Can be called on an instance to generate the files.
231 if ($self->create eq 'dynamic') {
232 $self->_print_dynamic_deprecation_warning;
233 $self->_gen_dynamic_schema;
234 } elsif ($self->create eq 'static') {
235 $self->_gen_static_schema;
241 sub _parse_loader_args {
242 my ($self, $args) = @_;
244 my %loader_args = $self->_read_loader_args($args);
246 while (my ($key, $val) = each %loader_args) {
247 next if $key =~ /^(?:components|constraint|exclude)\z/;
249 $loader_args{$key} = $self->_eval($val);
250 die "syntax error for loader args key '$key' with value '$val': $@"
254 my @components = $self->_build_loader_components(
255 delete $loader_args{components},
256 $loader_args{use_namespaces},
259 $self->components(\@components);
261 for my $re_opt (qw/constraint exclude/) {
262 $loader_args{$re_opt} = qr/$loader_args{$re_opt}/
263 if exists $loader_args{$re_opt};
266 tie my %result, 'Tie::IxHash';
270 use_moose => $self->is_moose_schema ? 1 : 0,
271 col_collision_map => 'column_%s',
272 (!$self->old_schema ? (
276 components => \@components
278 (%loader_args ? %loader_args : ()),
281 $self->loader_args(\%result);
283 wantarray ? %result : \%result;
286 sub _read_loader_args {
287 my ($self, $args) = @_;
291 while (@$args && $args->[0] !~ /^dbi:/i) {
292 my ($key, $val) = split /=/, shift(@$args), 2;
294 if ($self->_is_struct($val)) {
295 $loader_args{$key} = $val;
296 } elsif ((my @vals = split /,/ => $val) > 1) {
297 $loader_args{$key} = \@vals;
299 $loader_args{$key} = $val;
303 wantarray ? %loader_args : \%loader_args;
306 sub _build_helper_loader_args {
309 my $args = $self->loader_args;
311 tie my %loader_args, 'Tie::IxHash';
313 while (my ($arg, $val) = each %$args) {
315 $loader_args{$arg} = $self->_data_struct_to_string($val);
317 $loader_args{$arg} = qq{'$val'};
324 sub _build_loader_components {
325 my ($self, $components, $use_namespaces) = @_;
327 my @components = $self->old_schema && (not $use_namespaces) ? ()
328 : ('InflateColumn::DateTime');
331 $components = [ $components ] if !ref $components;
332 push @components, @$components;
335 wantarray ? @components : \@components;
338 sub _build_helper_connect_info {
339 my ($self, $connect_info) = @_;
341 my @connect_info = @$connect_info;
343 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
345 tie my %helper_connect_info, 'Tie::IxHash';
347 %helper_connect_info = (
350 password => qq{'$password'}
353 for (@connect_info) {
354 if (/^\s*{.*}\s*\z/) {
355 my $hash = $self->_eval($_);
356 die "Syntax errorr in connect_info hash: $_: $@" if $@;
359 for my $key (keys %hash) {
360 my $val = $hash{$key};
363 $val = $self->_data_struct_to_string($val);
365 $val = $self->_quote($val);
368 $helper_connect_info{$key} = $val;
374 my ($key, $val) = split /=/, $_, 2;
376 if ($key eq 'quote_char') {
377 $helper_connect_info{$key} = length($val) == 1 ?
378 $self->_quote($val) :
379 $self->_data_struct_to_string([split //, $val]);
381 $helper_connect_info{$key} = $self->_quote_unless_struct($val);
385 \%helper_connect_info
388 sub _build_old_schema {
391 return $self->result_namespace eq '' ? 1 : 0;
394 sub _build_is_moose_schema {
397 my @schema_parts = split '::', $self->schema_class;
399 my $result_dir = File::Spec->catfile(
400 $self->helper->{base}, 'lib', @schema_parts, $self->result_namespace
403 # assume yes for new schemas
404 return 1 if not -d $result_dir;
412 return if $File::Find::name !~ /\.pm\z/;
414 open my $fh, '<', $File::Find::name
415 or die "Could not open $File::Find::name: $!";
417 my $code = do { local $/; <$fh> };
420 $uses_moose = 0 if $code !~ /\nuse Moose;\n/;
431 sub _build_result_namespace {
434 my @schema_parts = split '::', $self->schema_class;
436 File::Spec->catfile($self->helper->{base}, 'lib', @schema_parts) . '.pm';
438 if (not -f $schema_pm) {
439 eval { Class::MOP::load_class('DBIx::Class::Schema::Loader') };
441 return 'Result' if $@;
443 return (try { DBIx::Class::Schema::Loader->VERSION('0.05') }) ? 'Result' : '';
446 open my $fh, '<', $schema_pm or die "Could not open $schema_pm: $!";
447 my $code = do { local $/; <$fh> };
450 my ($result_namespace) = $code =~ /result_namespace => '([^']+)'/;
452 return $result_namespace if $result_namespace;
454 return '' if $code =~ /->load_classes/;
459 sub _data_struct_to_string {
460 my ($self, $data) = @_;
462 local $Data::Dumper::Terse = 1;
463 local $Data::Dumper::Quotekeys = 0;
464 local $Data::Dumper::Indent = 0;
465 local $Data::Dumper::Useqq = 1;
467 return Data::Dumper->Dump([$data]);
470 sub _get_dsn_user_pass {
471 my ($self, $connect_info) = @_;
473 my $dsn = shift @$connect_info;
474 my ($user, $password);
476 if ($dsn =~ /sqlite/i) {
477 ($user, $password) = ('', '');
478 shift @$connect_info while @$connect_info and $connect_info->[0] eq '';
480 ($user, $password) = splice @$connect_info, 0, 2;
483 ($dsn, $user, $password)
486 sub _parse_connect_info {
487 my ($self, $connect_info) = @_;
489 my @connect_info = @$connect_info;
491 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
493 tie my %connect_info, 'Tie::IxHash';
494 @connect_info{qw/dsn user password/} = ($dsn, $user, $password);
496 for (@connect_info) {
497 if (/^\s*{.*}\s*\z/) {
498 my $hash = $self->_eval($_);
499 die "Syntax errorr in connect_info hash: $_: $@" if $@;
501 %connect_info = (%connect_info, %$hash);
506 my ($key, $val) = split /=/, $_, 2;
508 if ($key eq 'quote_char') {
509 $connect_info{$key} = length($val) == 1 ? $val : [split //, $val];
510 } elsif ($key =~ /^(?:name_sep|limit_dialect)\z/) {
511 $connect_info{$key} = $val;
513 $connect_info{$key} = $self->_eval($val);
516 die "syntax error for connect_info key '$key' with value '$val': $@"
520 $self->connect_info(\%connect_info);
526 my ($self, $val) = @_;
528 return $val =~ /^\s*(?:sub|[[{])/;
532 my ($self, $val) = @_;
534 return 'q{'.$val.'}';
537 sub _quote_unless_struct {
538 my ($self, $val) = @_;
540 $val = $self->_quote($val) if not $self->_is_struct($val);
546 my ($self, $code) = @_;
548 return $code if looks_like_number $code;
550 return $code if not $self->_is_struct($code);
552 return eval "{no strict; $code}";
555 sub _gen_dynamic_schema {
558 my $helper = $self->helper;
560 my @schema_parts = split(/\:\:/, $self->schema_class);
561 my $schema_file_part = pop @schema_parts;
563 my $schema_dir = File::Spec->catfile(
564 $helper->{base}, 'lib', @schema_parts
566 my $schema_file = File::Spec->catfile(
567 $schema_dir, $schema_file_part . '.pm'
570 $helper->mk_dir($schema_dir);
571 $helper->render_file('schemaclass', $schema_file);
574 sub _gen_static_schema {
577 die "cannot load schema without connect info" unless $self->connect_info;
579 my $helper = $self->helper;
581 my $schema_dir = File::Spec->catfile($helper->{base}, 'lib');
584 Class::MOP::load_class('DBIx::Class::Schema::Loader')
587 die "Cannot load DBIx::Class::Schema::Loader: $_";
590 DBIx::Class::Schema::Loader->import(
591 "dump_to_dir:$schema_dir", 'make_schema_at'
597 [$self->connect_info]
601 lib->import($schema_dir);
603 Class::MOP::load_class($self->schema_class);
605 my @sources = $self->schema_class->sources;
609 WARNING: No tables found, did you forget to specify db_schema?
616 my $helper = $self->helper;
618 $helper->render_file('compclass', $helper->{file} );
621 sub _print_dynamic_deprecation_warning {
623 ************************************ WARNING **********************************
624 * create=dynamic is DEPRECATED, please use create=static instead. *
625 *******************************************************************************
627 print "Continue? [y/n]: ";
628 chomp(my $response = <STDIN>);
629 exit 0 if $response =~ /^n(o)?\z/;
633 my ($self, $args) = @_;
635 # remove blanks, ie. someoned doing foo \ bar
636 my @res = grep !/^\s+\z/, @$args;
638 # remove leading whitespace, ie. foo \ bar
646 General Catalyst Stuff:
648 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
649 L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,
651 Stuff related to DBIC and this Model style:
653 L<DBIx::Class>, L<DBIx::Class::Schema>,
654 L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>
658 See L<Catalyst::Model::DBIC::Schema/AUTHOR> and
659 L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>.
663 See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>.
667 This library is free software, you can redistribute it and/or modify
668 it under the same terms as Perl itself.
679 package [% schema_class %];
682 use base qw/DBIx::Class::Schema::Loader/;
684 __PACKAGE__->loader_options(
685 [%- FOREACH key = loader_args.keys %]
686 [% key %] => [% loader_args.${key} %],
693 [% schema_class %] - L<DBIx::Class::Schema::Loader> class
701 Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>
705 [% generator %] - [% generator_version %]
709 [% author.replace(',+$', '') %]
713 This library is free software, you can redistribute it and/or modify
714 it under the same terms as Perl itself.
724 use base 'Catalyst::Model::DBIC::Schema';
727 schema_class => '[% schema_class %]',
728 [% IF traits %]traits => [% traits %],[% END %]
729 [% IF setup_connect_info %]connect_info => {
730 [%- FOREACH key = connect_info.keys %]
731 [% key %] => [% connect_info.${key} %],
739 [% class %] - Catalyst DBIC Schema Model
747 L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
751 [% generator %] - [% generator_version %]
755 [% author.replace(',+$', '') %]
759 This library is free software, you can redistribute it and/or modify
760 it under the same terms as Perl itself.