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 # Use args after connect_info as loader args as well, because people always
304 # get the order confused.
306 if ($args->[0] =~ /sqlite/i) {
307 $i++ if $args->[$i] eq '';
308 $i++ if $args->[$i] eq '';
314 while (defined $args->[$i]) {
315 my ($key, $val) = split /=/, $args->[$i++], 2;
317 if ($self->_is_struct($val)) {
318 $loader_args{$key} = $val;
319 } elsif ((my @vals = split /,/ => $val) > 1) {
320 $loader_args{$key} = \@vals;
322 $loader_args{$key} = $val;
326 wantarray ? %loader_args : \%loader_args;
329 sub _build_helper_loader_args {
332 my $args = $self->loader_args;
334 tie my %loader_args, 'Tie::IxHash';
336 while (my ($arg, $val) = each %$args) {
338 $loader_args{$arg} = $self->_data_struct_to_string($val);
340 $loader_args{$arg} = qq{'$val'};
347 sub _build_loader_components {
348 my ($self, $components, $use_namespaces) = @_;
350 my @components = $self->old_schema && (not $use_namespaces) ? ()
351 : ('InflateColumn::DateTime');
354 $components = [ $components ] if !ref $components;
355 push @components, @$components;
358 wantarray ? @components : \@components;
361 sub _build_helper_connect_info {
362 my ($self, $connect_info) = @_;
364 my @connect_info = @$connect_info;
366 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
368 tie my %helper_connect_info, 'Tie::IxHash';
370 %helper_connect_info = (
373 password => qq{'$password'}
376 for (@connect_info) {
377 if (/^\s*{.*}\s*\z/) {
378 my $hash = $self->_eval($_);
379 die "Syntax errorr in connect_info hash: $_: $@" if $@;
382 for my $key (keys %hash) {
383 my $val = $hash{$key};
386 $val = $self->_data_struct_to_string($val);
388 $val = $self->_quote($val);
391 $helper_connect_info{$key} = $val;
397 my ($key, $val) = split /=/, $_, 2;
399 if ($key eq 'quote_char') {
400 $helper_connect_info{$key} = length($val) == 1 ?
401 $self->_quote($val) :
402 $self->_data_struct_to_string([split //, $val]);
404 $helper_connect_info{$key} = $self->_quote_unless_struct($val);
408 \%helper_connect_info
411 sub _build_old_schema {
414 return $self->result_namespace eq '' ? 1 : 0;
417 sub _build_is_moose_schema {
420 my @schema_parts = split '::', $self->schema_class;
422 my $result_dir = File::Spec->catfile(
423 $self->helper->{base}, 'lib', @schema_parts, $self->result_namespace
426 # assume yes for new schemas
427 return 1 if not -d $result_dir;
435 return if $File::Find::name !~ /\.pm\z/;
437 open my $fh, '<', $File::Find::name
438 or die "Could not open $File::Find::name: $!";
440 my $code = do { local $/; <$fh> };
443 $uses_moose = 0 if $code !~ /\nuse Moose;\n/;
454 sub _build_result_namespace {
457 my @schema_parts = split '::', $self->schema_class;
459 File::Spec->catfile($self->helper->{base}, 'lib', @schema_parts) . '.pm';
461 if (not -f $schema_pm) {
462 eval { Class::MOP::load_class('DBIx::Class::Schema::Loader') };
464 return 'Result' if $@;
466 return (try { DBIx::Class::Schema::Loader->VERSION('0.05') }) ? 'Result' : '';
469 open my $fh, '<', $schema_pm or die "Could not open $schema_pm: $!";
470 my $code = do { local $/; <$fh> };
473 my ($result_namespace) = $code =~ /result_namespace => '([^']+)'/;
475 return $result_namespace if $result_namespace;
477 return '' if $code =~ /->load_classes/;
482 sub _data_struct_to_string {
483 my ($self, $data) = @_;
485 local $Data::Dumper::Terse = 1;
486 local $Data::Dumper::Quotekeys = 0;
487 local $Data::Dumper::Indent = 0;
488 local $Data::Dumper::Useqq = 1;
490 return Data::Dumper->Dump([$data]);
493 sub _get_dsn_user_pass {
494 my ($self, $connect_info) = @_;
496 my $dsn = shift @$connect_info;
497 my ($user, $password);
499 if ($dsn =~ /sqlite/i) {
500 ($user, $password) = ('', '');
501 shift @$connect_info while @$connect_info and $connect_info->[0] eq '';
503 ($user, $password) = splice @$connect_info, 0, 2;
506 ($dsn, $user, $password)
509 sub _parse_connect_info {
510 my ($self, $connect_info) = @_;
512 my @connect_info = @$connect_info;
514 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
516 tie my %connect_info, 'Tie::IxHash';
517 @connect_info{qw/dsn user password/} = ($dsn, $user, $password);
519 for (@connect_info) {
520 if (/^\s*{.*}\s*\z/) {
521 my $hash = $self->_eval($_);
522 die "Syntax errorr in connect_info hash: $_: $@" if $@;
524 %connect_info = (%connect_info, %$hash);
529 my ($key, $val) = split /=/, $_, 2;
531 if ($key eq 'quote_char') {
532 $connect_info{$key} = length($val) == 1 ? $val : [split //, $val];
533 } elsif ($key =~ /^(?:name_sep|limit_dialect)\z/) {
534 $connect_info{$key} = $val;
536 $connect_info{$key} = $self->_eval($val);
539 die "syntax error for connect_info key '$key' with value '$val': $@"
543 $self->connect_info(\%connect_info);
549 my ($self, $val) = @_;
551 return $val =~ /^\s*(?:sub|[[{])/;
555 my ($self, $val) = @_;
557 return 'q{'.$val.'}';
560 sub _quote_unless_struct {
561 my ($self, $val) = @_;
563 $val = $self->_quote($val) if not $self->_is_struct($val);
569 my ($self, $code) = @_;
571 return $code if looks_like_number $code;
573 return $code if not $self->_is_struct($code);
575 return eval "{no strict; $code}";
578 sub _gen_dynamic_schema {
581 my $helper = $self->helper;
583 my @schema_parts = split(/\:\:/, $self->schema_class);
584 my $schema_file_part = pop @schema_parts;
586 my $schema_dir = File::Spec->catfile(
587 $helper->{base}, 'lib', @schema_parts
589 my $schema_file = File::Spec->catfile(
590 $schema_dir, $schema_file_part . '.pm'
593 $helper->mk_dir($schema_dir);
594 $helper->render_file('schemaclass', $schema_file);
597 sub _gen_static_schema {
600 die "cannot load schema without connect info" unless $self->connect_info;
602 my $helper = $self->helper;
604 my $schema_dir = File::Spec->catfile($helper->{base}, 'lib');
607 Class::MOP::load_class('DBIx::Class::Schema::Loader')
610 die "Cannot load DBIx::Class::Schema::Loader: $_";
613 DBIx::Class::Schema::Loader->import(
614 "dump_to_dir:$schema_dir", 'make_schema_at'
620 [$self->connect_info]
624 lib->import($schema_dir);
626 Class::MOP::load_class($self->schema_class);
628 my @sources = $self->schema_class->sources;
632 WARNING: No tables found, did you forget to specify db_schema?
639 my $helper = $self->helper;
641 $helper->render_file('compclass', $helper->{file} );
644 sub _print_dynamic_deprecation_warning {
646 ************************************ WARNING **********************************
647 * create=dynamic is DEPRECATED, please use create=static instead. *
648 *******************************************************************************
650 print "Continue? [y/n]: ";
651 chomp(my $response = <STDIN>);
652 exit 0 if $response =~ /^n(o)?\z/;
656 my ($self, $args) = @_;
658 # remove blanks, ie. someoned doing foo \ bar
659 my @res = grep !/^\s+\z/, @$args;
661 # remove leading whitespace, ie. foo \ bar
669 General Catalyst Stuff:
671 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
672 L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,
674 Stuff related to DBIC and this Model style:
676 L<DBIx::Class>, L<DBIx::Class::Schema>,
677 L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>
681 See L<Catalyst::Model::DBIC::Schema/AUTHOR> and
682 L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>.
686 See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>.
690 This library is free software, you can redistribute it and/or modify
691 it under the same terms as Perl itself.
702 package [% schema_class %];
705 use base qw/DBIx::Class::Schema::Loader/;
707 __PACKAGE__->loader_options(
708 [%- FOREACH key = loader_args.keys %]
709 [% key %] => [% loader_args.${key} %],
716 [% schema_class %] - L<DBIx::Class::Schema::Loader> class
724 Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>
728 [% generator %] - [% generator_version %]
732 [% author.replace(',+$', '') %]
736 This library is free software, you can redistribute it and/or modify
737 it under the same terms as Perl itself.
747 use base 'Catalyst::Model::DBIC::Schema';
750 schema_class => '[% schema_class %]',
751 [% IF traits %]traits => [% traits %],[% END %]
752 [% IF setup_connect_info %]connect_info => {
753 [%- FOREACH key = connect_info.keys %]
754 [% key %] => [% connect_info.${key} %],
762 [% class %] - Catalyst DBIC Schema Model
770 L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
774 [% generator %] - [% generator_version %]
778 [% author.replace(',+$', '') %]
782 This library is free software, you can redistribute it and/or modify
783 it under the same terms as Perl itself.