lib/Catalyst/Helper/Model/DBIC/Schema.pm

   1 package Catalyst::Helper::Model::DBIC::Schema;
   2
   3 use strict;
   4 use warnings;
   5 no warnings 'uninitialized';
   6
   7 our $VERSION = '0.23';
   8
   9 use Carp;
  10 use UNIVERSAL::require;
  11
  12 =head1 NAME
  13
  14 Catalyst::Helper::Model::DBIC::Schema - Helper for DBIC Schema Models
  15
  16 =head1 SYNOPSIS
  17
  18   script/create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass [ create=dynamic | create=static ] [ Schema::Loader opts ] [ connect_info arguments ]
  19
  20 =head1 DESCRIPTION
  21
  22 Helper for the DBIC Schema Models.
  23
  24 =head2 Arguments:
  25
  26 C<CatalystModelName> is the short name for the Catalyst Model class
  27 being generated (i.e. callable with C<$c-E<gt>model('CatalystModelName')>).
  28
  29 C<MyApp::SchemaClass> is the fully qualified classname of your Schema,
  30 which might or might not yet exist.  Note that you should have a good
  31 reason to create this under a new global namespace, otherwise use an
  32 existing top level namespace for your schema class.
  33
  34 C<create=dynamic> instructs this Helper to generate the named Schema
  35 class for you, basing it on L<DBIx::Class::Schema::Loader> (which
  36 means the table information will always be dynamically loaded at
  37 runtime from the database).
  38
  39 C<create=static> instructs this Helper to generate the named Schema
  40 class for you, using L<DBIx::Class::Schema::Loader> in "one shot"
  41 mode to create a standard, manually-defined L<DBIx::Class::Schema>
  42 setup, based on what the Loader sees in your database at this moment.
  43 A Schema/Model pair generated this way will not require
  44 L<DBIx::Class::Schema::Loader> at runtime, and will not automatically
  45 adapt itself to changes in your database structure.  You can edit
  46 the generated classes by hand to refine them.
  47
  48 C<connect_info> arguments are the same as what
  49 DBIx::Class::Schema::connect expects, and are storage_type-specific.
  50 For DBI-based storage, these arguments are the dsn, username,
  51 password, and connect options, respectively.  These are optional for
  52 existing Schemas, but required if you use either of the C<create=>
  53 options.
  54
  55 Use of either of the C<create=> options requires L<DBIx::Class::Schema::Loader>.
  56
  57 =head1 TYPICAL EXAMPLES
  58
  59   # Use DBIx::Class::Schema::Loader to create a static DBIx::Class::Schema,
  60   #  and a Model which references it:
  61   script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass create=static dbi:mysql:foodb myuname mypass
  62
  63   # Same, but with extra Schema::Loader args (separate multiple values by commas):
  64   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
  65
  66   # See DBIx::Class::Schema::Loader::Base for list of options
  67
  68   # Create a dynamic DBIx::Class::Schema::Loader-based Schema,
  69   #  and a Model which references it:
  70   script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass create=dynamic dbi:mysql:foodb myuname mypass
  71
  72   # Reference an existing Schema of any kind, and provide some connection information for ->config:
  73   script/myapp_create.pl model CatalystModelName DBIC::Schema MyApp::SchemaClass dbi:mysql:foodb myuname mypass
  74
  75   # Same, but don't supply connect information yet (you'll need to do this
  76   #  in your app config, or [not recommended] in the schema itself).
  77   script/myapp_create.pl model ModelName DBIC::Schema My::SchemaClass
  78
  79 =head1 METHODS
  80
  81 =head2 mk_compclass
  82
  83 =cut
  84
  85 sub mk_compclass {
  86     my ( $self, $helper, $schema_class, @connect_info) = @_;
  87
  88     $helper->{schema_class} = $schema_class
  89         or croak "Must supply schema class name";
  90
  91     my $create = '';
  92     if($connect_info[0] && $connect_info[0] =~ /^create=(dynamic|static)$/) {
  93         $create = $1;
  94         shift @connect_info;
  95     }
  96
  97     my %extra_args;
  98     while (@connect_info && $connect_info[0] !~ /^dbi:/) {
  99         my ($key, $val) = split /=/, shift(@connect_info);
 100
 101         if ((my @vals = split /,/ => $val) > 1) {
 102             $extra_args{$key} = \@vals;
 103         } else {
 104             $extra_args{$key} = $val;
 105         }
 106     }
 107
 108     if(@connect_info) {
 109         $helper->{setup_connect_info} = 1;
 110         my @helper_connect_info = @connect_info;
 111         for(@helper_connect_info) {
 112             $_ = qq{'$_'} if $_ !~ /^\s*[[{]/;
 113         }
 114         $helper->{connect_info} = \@helper_connect_info;
 115     }
 116
 117     if($create eq 'dynamic') {
 118         my @schema_parts = split(/\:\:/, $helper->{schema_class});
 119         my $schema_file_part = pop @schema_parts;
 120
 121         my $schema_dir  = File::Spec->catfile( $helper->{base}, 'lib', @schema_parts );
 122         my $schema_file = File::Spec->catfile( $schema_dir, $schema_file_part . '.pm' );
 123
 124         $helper->mk_dir($schema_dir);
 125         $helper->render_file( 'schemaclass', $schema_file );
 126     }
 127     elsif($create eq 'static') {
 128         my $schema_dir  = File::Spec->catfile( $helper->{base}, 'lib' );
 129         DBIx::Class::Schema::Loader->use("dump_to_dir:$schema_dir", 'make_schema_at')
 130             or croak "Cannot load DBIx::Class::Schema::Loader: $@";
 131
 132         my @loader_connect_info = @connect_info;
 133         my $num = 6; # argument number on the commandline for "dbi:..."
 134         for(@loader_connect_info) {
 135             if(/^\s*[[{]/) {
 136                 $_ = eval "$_";
 137                 croak "Perl syntax error in commandline argument $num: $@" if $@;
 138             }
 139             $num++;
 140         }
 141
 142 # Check if we need to be backward-compatible.
 143         my $compatible = 0;
 144
 145         my @schema_pm   = split '::', $schema_class;
 146         $schema_pm[-1] .= '.pm';
 147         my $schema_file = File::Spec->catfile($helper->{base}, 'lib', @schema_pm);
 148
 149         if (-f $schema_file) {
 150             my $schema_code = do { local (@ARGV, $/) = $schema_file; <> };
 151             $compatible = 1 if $schema_code =~ /->load_classes/;
 152         }
 153
 154         my @components = $compatible ? () : ('InflateColumn::DateTime');
 155
 156         if (exists $extra_args{components}) {
 157             $extra_args{components} = [ $extra_args{components} ]
 158                 unless ref $extra_args{components};
 159
 160             push @components, @{ delete $extra_args{components} };
 161         }
 162
 163         for my $re_opt (qw/constraint exclude/) {
 164             $extra_args{$re_opt} = qr/$extra_args{$re_opt}/
 165                 if exists $extra_args{$re_opt};
 166         }
 167
 168         if (exists $extra_args{moniker_map}) {
 169             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."
 170         }
 171
 172         make_schema_at(
 173             $schema_class,
 174             {
 175                 relationships => 1,
 176                 (%extra_args ? %extra_args : ()),
 177                 (!$compatible ? (
 178                     use_namespaces => 1
 179                 ) : ()),
 180                 (@components ? (
 181                     components => \@components
 182                 ) : ())
 183             },
 184             \@loader_connect_info,
 185         );
 186     }
 187
 188     my $file = $helper->{file};
 189     $helper->render_file( 'compclass', $file );
 190 }
 191
 192 =head1 SEE ALSO
 193
 194 General Catalyst Stuff:
 195
 196 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 197 L<Catalyst::Response>, L<Catalyst::Helper>, L<Catalyst>,
 198
 199 Stuff related to DBIC and this Model style:
 200
 201 L<DBIx::Class>, L<DBIx::Class::Schema>,
 202 L<DBIx::Class::Schema::Loader>, L<Catalyst::Model::DBIC::Schema>
 203
 204 =head1 AUTHOR
 205
 206 Brandon L Black, C<blblack@gmail.com>
 207
 208 =head1 LICENSE
 209
 210 This library is free software, you can redistribute it and/or modify
 211 it under the same terms as Perl itself.
 212
 213 =cut
 214
 215 1;
 216
 217 __DATA__
 218
 219 =begin pod_to_ignore
 220
 221 __schemaclass__
 222 package [% schema_class %];
 223
 224 use strict;
 225 use base qw/DBIx::Class::Schema::Loader/;
 226
 227 __PACKAGE__->loader_options(
 228     relationships => 1,
 229     # debug => 1,
 230 );
 231
 232 =head1 NAME
 233
 234 [% schema_class %] - DBIx::Class::Schema::Loader class
 235
 236 =head1 SYNOPSIS
 237
 238 See L<[% app %]>
 239
 240 =head1 DESCRIPTION
 241
 242 Generated by L<Catalyst::Model::DBIC::Schema> for use in L<[% class %]>
 243
 244 =head1 AUTHOR
 245
 246 [% author %]
 247
 248 =head1 LICENSE
 249
 250 This library is free software, you can redistribute it and/or modify
 251 it under the same terms as Perl itself.
 252
 253 =cut
 254
 255 1;
 256
 257 __compclass__
 258 package [% class %];
 259
 260 use strict;
 261 use base 'Catalyst::Model::DBIC::Schema';
 262
 263 __PACKAGE__->config(
 264     schema_class => '[% schema_class %]',
 265     [% IF setup_connect_info %]connect_info => [
 266         [% FOREACH arg = connect_info %][% arg %],
 267         [% END %]
 268     ],[% END %]
 269 );
 270
 271 =head1 NAME
 272
 273 [% class %] - Catalyst DBIC Schema Model
 274 =head1 SYNOPSIS
 275
 276 See L<[% app %]>
 277
 278 =head1 DESCRIPTION
 279
 280 L<Catalyst::Model::DBIC::Schema> Model using schema L<[% schema_class %]>
 281
 282 =head1 AUTHOR
 283
 284 [% author %]
 285
 286 =head1 LICENSE
 287
 288 This library is free software, you can redistribute it and/or modify
 289 it under the same terms as Perl itself.
 290
 291 =cut
 292
 293 1;