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';
21 use Module::Runtime 'use_module';
25 Catalyst::Helper::Model::DBIC::Schema - Helper for DBIC Schema Models
29 script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass \
30 [ create=dynamic | create=static ] [ traits=trait1,trait2... ] \
31 [ Schema::Loader opts ] [ dsn user pass ] \
32 [ other connect_info args ]
36 Helper for the DBIC Schema Models.
40 C<CatalystModelName> is the short name for the Catalyst Model class
41 being generated (i.e. callable with C<$c-E<gt>model('CatalystModelName')>).
43 C<MyApp::SchemaClass> is the fully qualified classname of your Schema,
44 which might or might not yet exist. Note that you should have a good
45 reason to create this under a new global namespace, otherwise use an
46 existing top level namespace for your schema class.
48 C<create=dynamic> instructs this Helper to generate the named Schema
49 class for you, basing it on L<DBIx::Class::Schema::Loader> (which
50 means the table information will always be dynamically loaded at
51 runtime from the database).
53 C<create=static> instructs this Helper to generate the named Schema
54 class for you, using L<DBIx::Class::Schema::Loader> in "one shot"
55 mode to create a standard, manually-defined L<DBIx::Class::Schema>
56 setup, based on what the Loader sees in your database at this moment.
57 A Schema/Model pair generated this way will not require
58 L<DBIx::Class::Schema::Loader> at runtime, and will not automatically
59 adapt itself to changes in your database structure. You can edit
60 the generated classes by hand to refine them.
62 C<traits> is the list of traits to apply to the model, see
63 L<Catalyst::Model::DBIC::Schema> for details.
65 C<Schema::Loader opts> are documented in L<DBIx::Class::Schema::Loader::Base>
66 and some examples are given in L</TYPICAL EXAMPLES> below.
68 C<connect_info> arguments are the same as what L<DBIx::Class::Schema/connect>
69 expects, and are storage_type-specific. They are documented in
70 L<DBIx::Class::Storage::DBI/connect_info>. For DBI-based storage, these
71 arguments are the dsn, username, password, and connect options, respectively.
72 These are optional for existing Schemas, but required if you use either of the
75 username and password can be omitted for C<SQLite> dsns.
77 Use of either of the C<create=> options requires L<DBIx::Class::Schema::Loader>.
79 =head1 TYPICAL EXAMPLES
81 Use DBIx::Class::Schema::Loader to create a static DBIx::Class::Schema,
82 and a Model which references it:
84 script/myapp_create.pl model CatalystModelName DBIC::Schema \
85 MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
87 Same, with extra connect_info args
88 user and pass can be omitted for sqlite, since they are always empty
90 script/myapp_create.pl model CatalystModelName DBIC::Schema \
91 MyApp::SchemaClass create=static dbi:SQLite:foo.db \
92 AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
93 on_connect_do='["select 1", "select 2"]' quote_names=1
95 B<ON WINDOWS COMMAND LINES QUOTING RULES ARE DIFFERENT>
97 In C<cmd.exe> the above example would be:
99 script/myapp_create.pl model CatalystModelName DBIC::Schema \
100 MyApp::SchemaClass create=static dbi:SQLite:foo.db \
101 AutoCommit=1 cursor_class=DBIx::Class::Cursor::Cached \
102 on_connect_do="[\"select 1\", \"select 2\"]" quote_names=1
104 Same, but with extra Schema::Loader args (separate multiple values by commas):
106 script/myapp_create.pl model CatalystModelName DBIC::Schema \
107 MyApp::SchemaClass create=static db_schema=foodb components=Foo,Bar \
108 exclude='^(wibble|wobble)$' moniker_map='{ foo => "FOO" }' \
109 dbi:Pg:dbname=foodb myuname mypass
111 Coderefs are also supported:
113 script/myapp_create.pl model CatalystModelName DBIC::Schema \
114 MyApp::SchemaClass create=static \
115 inflect_singular='sub { $_[0] =~ /\A(.+?)(_id)?\z/; $1 }' \
116 moniker_map='sub { join(q{}, map ucfirst, split(/[\W_]+/, lc $_[0])); }' \
117 dbi:mysql:foodb myuname mypass
119 See L<DBIx::Class::Schema::Loader::Base> for a list of options
121 Create a dynamic DBIx::Class::Schema::Loader-based Schema,
122 and a Model which references it (B<DEPRECATED>):
124 script/myapp_create.pl model CatalystModelName DBIC::Schema \
125 MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
127 Reference an existing Schema of any kind, and provide some connection information for ->config:
129 script/myapp_create.pl model CatalystModelName DBIC::Schema \
130 MyApp::SchemaClass dbi:mysql:foodb myuname mypass
132 Same, but don't supply connect information yet (you'll need to do this
133 in your app config, or [not recommended] in the schema itself).
135 script/myapp_create.pl model ModelName DBIC::Schema My::SchemaClass
139 has helper => (is => 'ro', isa => 'Catalyst::Helper', required => 1);
140 has create => (is => 'rw', isa => CreateOption);
141 has args => (is => 'ro', isa => ArrayRef);
142 has traits => (is => 'rw', isa => ArrayRef);
143 has schema_class => (is => 'ro', isa => Str, required => 1);
144 has loader_args => (is => 'rw', isa => HashRef);
145 has connect_info => (is => 'rw', isa => HashRef);
146 has old_schema => (is => 'rw', isa => Bool, lazy_build => 1);
147 has is_moose_schema => (is => 'rw', isa => Bool, lazy_build => 1);
148 has result_namespace => (is => 'rw', isa => Str, lazy_build => 1);
149 has components => (is => 'rw', isa => ArrayRef);
155 This is called by L<Catalyst::Helper> with the commandline args to generate the
161 my ($package, $helper, $schema_class, @args) = @_;
163 my $self = $package->new(
165 schema_class => $schema_class,
174 my $helper = $self->helper;
175 my @args = @{ $self->args || [] };
177 $helper->{schema_class} = $self->schema_class;
179 @args = $self->_cleanup_args(\@args);
181 my ($traits_idx, $traits);
182 if (($traits_idx = firstidx { ($traits) = /^traits=(\S*)\z/ } @args) != -1) {
183 my @traits = split /,/ => $traits;
185 $self->traits(\@traits);
187 $helper->{traits} = '['
188 .(join ',' => map { qq{'$_'} } @traits)
191 splice @args, $traits_idx, 1, ();
194 if ($args[0] && $args[0] =~ /^create=(\S*)\z/) {
199 $self->_parse_loader_args(\@args);
201 $helper->{loader_args} = $self->_build_helper_loader_args;
206 if (first { ($dbi_dsn_part) = /^(dbi):/i } @args) {
208 qq{DSN must start with 'dbi:' not '$dbi_dsn_part' (case matters!)}
209 if $dbi_dsn_part ne 'dbi';
211 $helper->{setup_connect_info} = 1;
213 $helper->{connect_info} =
214 $self->_build_helper_connect_info(\@args);
216 $self->_parse_connect_info(\@args);
219 $helper->{generator} = ref $self;
220 $helper->{generator_version} = $VERSION;
225 Can be called on an instance to generate the files.
232 if ($self->create eq 'dynamic') {
233 $self->_print_dynamic_deprecation_warning;
234 $self->_gen_dynamic_schema;
235 } elsif ($self->create eq 'static') {
236 $self->_gen_static_schema;
242 sub _parse_loader_args {
243 my ($self, $args) = @_;
245 my %loader_args = $self->_read_loader_args($args);
247 while (my ($key, $val) = each %loader_args) {
248 next if $key =~ /^(?:components|constraint|exclude)\z/;
250 $loader_args{$key} = $self->_eval($val);
251 die "syntax error for loader args key '$key' with value '$val': $@"
255 my @components = $self->_build_loader_components(
256 delete $loader_args{components},
257 $loader_args{use_namespaces},
260 $self->components(\@components);
262 for my $re_opt (qw/constraint exclude/) {
263 $loader_args{$re_opt} = qr/$loader_args{$re_opt}/
264 if exists $loader_args{$re_opt};
267 tie my %result, 'Tie::IxHash';
271 use_moose => $self->is_moose_schema ? 1 : 0,
272 col_collision_map => 'column_%s',
273 (!$self->old_schema ? (
277 components => \@components
279 (%loader_args ? %loader_args : ()),
282 $self->loader_args(\%result);
284 wantarray ? %result : \%result;
287 sub _read_loader_args {
288 my ($self, $args) = @_;
292 while (@$args && $args->[0] !~ /^dbi:/i) {
293 my ($key, $val) = split /=/, shift(@$args), 2;
295 if ($self->_is_struct($val)) {
296 $loader_args{$key} = $val;
297 } elsif ((my @vals = split /,/ => $val) > 1) {
298 $loader_args{$key} = \@vals;
300 $loader_args{$key} = $val;
304 # Use args after connect_info as loader args as well, because people always
305 # get the order confused.
307 if ($args->[0] =~ /sqlite/i) {
308 $i++ if $args->[$i] eq '';
309 $i++ if $args->[$i] eq '';
315 my $have_loader = try {
316 use_module('DBIx::Class::Schema::Loader::Base');
321 while (defined $args->[$i]) {
322 $i++ while $self->_is_struct($args->[$i]);
324 last if not defined $args->[$i];
326 my ($key, $val) = split /=/, $args->[$i], 2;
328 if (not DBIx::Class::Schema::Loader::Base->can($key)) {
333 if ($self->_is_struct($val)) {
334 $loader_args{$key} = $val;
335 } elsif ((my @vals = split /,/ => $val) > 1) {
336 $loader_args{$key} = \@vals;
338 $loader_args{$key} = $val;
341 splice @$args, $i, 1;
345 wantarray ? %loader_args : \%loader_args;
348 sub _build_helper_loader_args {
351 my $args = $self->loader_args;
353 tie my %loader_args, 'Tie::IxHash';
355 while (my ($arg, $val) = each %$args) {
357 $loader_args{$arg} = $self->_data_struct_to_string($val);
359 $loader_args{$arg} = qq{'$val'};
366 sub _build_loader_components {
367 my ($self, $components, $use_namespaces) = @_;
369 my @components = $self->old_schema && (not $use_namespaces) ? ()
370 : ('InflateColumn::DateTime');
373 $components = [ $components ] if !ref $components;
374 push @components, @$components;
377 wantarray ? @components : \@components;
380 sub _build_helper_connect_info {
381 my ($self, $connect_info) = @_;
383 my @connect_info = @$connect_info;
385 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
387 tie my %helper_connect_info, 'Tie::IxHash';
389 %helper_connect_info = (
392 password => qq{'$password'}
395 for (@connect_info) {
396 if (/^\s*{.*}\s*\z/) {
397 my $hash = $self->_eval($_);
398 die "Syntax errorr in connect_info hash: $_: $@" if $@;
401 for my $key (keys %hash) {
402 my $val = $hash{$key};
405 $val = $self->_data_struct_to_string($val);
407 $val = $self->_quote($val);
410 $helper_connect_info{$key} = $val;
416 my ($key, $val) = split /=/, $_, 2;
418 if ($key eq 'quote_char') {
419 $helper_connect_info{$key} = length($val) == 1 ?
420 $self->_quote($val) :
421 $self->_data_struct_to_string([split //, $val]);
423 $helper_connect_info{$key} = $self->_quote_unless_struct($val);
427 \%helper_connect_info
430 sub _build_old_schema {
433 return $self->result_namespace eq '' ? 1 : 0;
436 sub _build_is_moose_schema {
439 my @schema_parts = split '::', $self->schema_class;
441 my $result_dir = File::Spec->catfile(
442 $self->helper->{base}, 'lib', @schema_parts, $self->result_namespace
445 # assume yes for new schemas
446 return 1 if not -d $result_dir;
454 return if $File::Find::name !~ /\.pm\z/;
456 open my $fh, '<', $File::Find::name
457 or die "Could not open $File::Find::name: $!";
459 my $code = do { local $/; <$fh> };
462 $uses_moose = 0 if $code !~ /\nuse Moose;\n/;
473 sub _build_result_namespace {
476 my @schema_parts = split '::', $self->schema_class;
478 File::Spec->catfile($self->helper->{base}, 'lib', @schema_parts) . '.pm';
480 if (not -f $schema_pm) {
481 eval { use_module('DBIx::Class::Schema::Loader') };
483 return 'Result' if $@;
485 return (try { DBIx::Class::Schema::Loader->VERSION('0.05') }) ? 'Result' : '';
488 open my $fh, '<', $schema_pm or die "Could not open $schema_pm: $!";
489 my $code = do { local $/; <$fh> };
492 my ($result_namespace) = $code =~ /result_namespace => '([^']+)'/;
494 return $result_namespace if $result_namespace;
496 return '' if $code =~ /->load_classes/;
501 sub _data_struct_to_string {
502 my ($self, $data) = @_;
504 local $Data::Dumper::Terse = 1;
505 local $Data::Dumper::Quotekeys = 0;
506 local $Data::Dumper::Sortkeys = 1;
507 local $Data::Dumper::Indent = 0;
508 local $Data::Dumper::Useqq = 1;
510 return Data::Dumper->Dump([$data]);
513 sub _get_dsn_user_pass {
514 my ($self, $connect_info) = @_;
516 my $dsn = shift @$connect_info;
517 my ($user, $password);
519 if ($dsn =~ /sqlite/i) {
520 ($user, $password) = ('', '');
521 shift @$connect_info while @$connect_info and $connect_info->[0] eq '';
523 ($user, $password) = splice @$connect_info, 0, 2;
526 ($dsn, $user, $password)
529 sub _parse_connect_info {
530 my ($self, $connect_info) = @_;
532 my @connect_info = @$connect_info;
534 my ($dsn, $user, $password) = $self->_get_dsn_user_pass(\@connect_info);
536 tie my %connect_info, 'Tie::IxHash';
537 @connect_info{qw/dsn user password/} = ($dsn, $user, $password);
539 for (@connect_info) {
540 if (/^\s*{.*}\s*\z/) {
541 my $hash = $self->_eval($_);
542 die "Syntax errorr in connect_info hash: $_: $@" if $@;
544 %connect_info = (%connect_info, %$hash);
549 my ($key, $val) = split /=/, $_, 2;
551 if ($key eq 'quote_char') {
552 $connect_info{$key} = length($val) == 1 ? $val : [split //, $val];
553 } elsif ($key =~ /^(?:name_sep|limit_dialect)\z/) {
554 $connect_info{$key} = $val;
556 $connect_info{$key} = $self->_eval($val);
559 die "syntax error for connect_info key '$key' with value '$val': $@"
563 $self->connect_info(\%connect_info);
569 my ($self, $val) = @_;
571 return $val =~ /^\s*(?:sub|[[{])/;
575 my ($self, $val) = @_;
577 return 'q{'.$val.'}';
580 sub _quote_unless_struct {
581 my ($self, $val) = @_;
583 $val = $self->_quote($val) if not $self->_is_struct($val);
589 my ($self, $code) = @_;
591 return $code if looks_like_number $code;
593 return $code if not $self->_is_struct($code);
595 return eval "{no strict; $code}";
598 sub _gen_dynamic_schema {
601 my $helper = $self->helper;
603 my @schema_parts = split(/\:\:/, $self->schema_class);
604 my $schema_file_part = pop @schema_parts;
606 my $schema_dir = File::Spec->catfile(
607 $helper->{base}, 'lib', @schema_parts
609 my $schema_file = File::Spec->catfile(
610 $schema_dir, $schema_file_part . '.pm'
613 $helper->mk_dir($schema_dir);
614 $helper->render_file('schemaclass', $schema_file);
617 sub _gen_static_schema {
620 die "cannot load schema without connect info" unless $self->connect_info;
622 my $helper = $self->helper;
624 my $schema_dir = File::Spec->catfile($helper->{base}, 'lib');
627 use_module('DBIx::Class::Schema::Loader')
630 die "Cannot load DBIx::Class::Schema::Loader: $_";
633 DBIx::Class::Schema::Loader->import(
634 "dump_to_dir:$schema_dir", 'make_schema_at'
640 [$self->connect_info]
644 lib->import($schema_dir);
646 use_module($self->schema_class);
648 my @sources = $self->schema_class->sources;
652 WARNING: No tables found, did you forget to specify db_schema?
659 my $helper = $self->helper;
661 $helper->render_file('compclass', $helper->{file} );
664 sub _print_dynamic_deprecation_warning {
666 ************************************ WARNING **********************************
667 * create=dynamic is DEPRECATED, please use create=static instead. *
668 *******************************************************************************
670 print "Continue? [y/n]: ";
671 chomp(my $response = <STDIN>);
672 exit 0 if $response =~ /^n(o)?\z/;
676 my ($self, $args) = @_;
678 # remove blanks, ie. someoned doing foo \ bar
679 my @res = grep !/^\s+\z/, @$args;
681 # remove leading whitespace, ie. foo \ bar
689 General Catalyst Stuff:
691 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
692 L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,
694 Stuff related to DBIC and this Model style:
696 L<DBIx::Class>, L<DBIx::Class::Schema>,
697 L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>
701 See L<Catalyst::Model::DBIC::Schema/AUTHOR> and
702 L<Catalyst::Model::DBIC::Schema/CONTRIBUTORS>.
706 See L<Catalyst::Model::DBIC::Schema/COPYRIGHT>.
710 This library is free software, you can redistribute it and/or modify
711 it under the same terms as Perl itself.
722 package [% schema_class %];
725 use base qw/DBIx::Class::Schema::Loader/;
727 __PACKAGE__->loader_options(
728 [%- FOREACH key = loader_args.keys %]
729 [% key %] => [% loader_args.${key} %],
736 [% schema_class %] - L<DBIx::Class::Schema::Loader> class
744 Dynamic L<DBIx::Class::Schema::Loader> schema for use in L<[% class %]>
748 [% generator %] - [% generator_version %]
752 [% author.replace(',+$', '') %]
756 This library is free software, you can redistribute it and/or modify
757 it under the same terms as Perl itself.
767 use base 'Catalyst::Model::DBIC::Schema';
770 schema_class => '[% schema_class %]',
771 [% IF traits %]traits => [% traits %],[% END %]
772 [% IF setup_connect_info %]connect_info => {
773 [%- FOREACH key = connect_info.keys %]
774 [% key %] => [% connect_info.${key} %],
782 [% class %] - Catalyst DBIC Schema Model
790 L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
794 [% generator %] - [% generator_version %]
798 [% author.replace(',+$', '') %]
802 This library is free software, you can redistribute it and/or modify
803 it under the same terms as Perl itself.