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

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