1package Bigtop::Backend::Model::GantryCDBI; 2use strict; use warnings; 3 4use Bigtop::Backend::Model; 5use File::Spec; 6use Inline; 7use Bigtop; 8 9#----------------------------------------------------------------- 10# The Default Template 11#----------------------------------------------------------------- 12 13our $template_is_setup = 0; 14our $default_template_text = <<'EO_TT_blocks'; 15[% BLOCK stub_table_module %] 16package [% package_name %]; 17use strict; use warnings; 18 19use base '[% base_class || base_class_default %]', 'Exporter'; 20 21use [% gen_package_name %]; 22 23our $[% package_alias %] = '[% package_name %]'; 24 25our @EXPORT_OK = ( '$[% package_alias %]' ); 26 271; 28 29=head1 NAME 30 31[% package_name %] - model for [% table_name %] table (stub part) 32 33=head1 DESCRIPTION 34 35This model inherits from [% base_class || base_class_default %] and uses its generated 36helper [% gen_package_name %]. 37 38It was generated by Bigtop, but is NOT subject to regeneration. 39 40=cut 41[% END %] 42 43[% BLOCK gen_table_module %] 44# NEVER EDIT this file. It was generated and will be overwritten without 45# notice upon regeneration of this application. You have been warned. 46package [% package_name %]; 47use strict; use warnings; 48 49[% package_name %]->table ( '[% real_table_name %]' ); 50[% IF sequence_name %] 51[% package_name %]->sequence( '[% sequence_name %]' ); 52[% END %] 53[% IF primary_key %] 54[% package_name %]->columns ( Primary => qw/ 55[% IF primary_key.0 %] 56 [% primary_key.join( ' ' ) +%] 57[% ELSE %] 58 [% primary_key +%] 59[% END -%] 60/ ); 61[% END -%] 62 63[% package_name %]->columns ( All => qw/ 64[% FOREACH column IN all_columns %] 65 [% column +%] 66[% END %] 67/ ); 68 69[% package_name %]->columns ( Essential => qw/ 70[% FOREACH essential_column IN essential_columns %] 71 [% essential_column +%] 72[% END %] 73/ ); 74 75[% FOREACH has_a IN has_a_list %] 76[% package_name %]->has_a( [% has_a.column %] => '[% base_package_name %]::[% has_a.table %]' ); 77[% END +%] 78sub get_foreign_display_fields { 79 return [ qw( [% foreign_display_columns %] ) ]; 80} 81 82sub get_foreign_tables { 83 return qw( 84[% FOREACH foreign_table IN foreign_tables %] 85 [% base_package_name %]::[% foreign_table +%] 86[% END %] 87 ); 88} 89 90sub foreign_display { 91 my $self = shift; 92 93[% foreign_display_body %] 94} 95 961; 97 98=head1 NAME 99 100[% gen_package_name %] - model for [% table_name %] table (generated part) 101 102=head1 DESCRIPTION 103 104This model mixes into [% package_name %], 105because Class::DBI bindings don't really allow a choice. 106It was generated by Bigtop, and IS subject to regeneration. 107 108=head1 METHODS 109 110You may use all normal Class::DBI::Sweet methods and the ones listed here: 111 112=over 4 113 114=item get_foreign_display_fields 115 116=item get_foreign_tables 117 118=item foreign_display 119 120=back 121 122=cut 123[% END %] 124EO_TT_blocks 125 126#----------------------------------------------------------------- 127# Methods in the Bigtop::Model::GantryCDBI package 128#----------------------------------------------------------------- 129 130sub what_do_you_make { 131 return [ 132 [ 'lib/AppName/Model/*.pm' => 133 'Class::DBI style model stubs [safe to change]' ], 134 [ 'lib/AppName/Model/GEN/*.pm' => 135 'Class::DBI style model specifications [please, do not change]' ], 136 [ 'note' => 137 'This backend is incompatible with other Model backends.' ], 138 ]; 139} 140 141sub backend_block_keywords { 142 return [ 143 { keyword => 'no_gen', 144 label => 'No Gen', 145 descr => 'Skip everything for this backend', 146 type => 'boolean' }, 147 148 { keyword => 'model_base_class', 149 label => 'Models Inherit From', 150 descr => 'Defaults to Gantry::Utils::CDBI', 151 type => 'text' }, 152 153 { keyword => 'template', 154 label => 'Alternate Template', 155 descr => 'A custom TT template.', 156 type => 'text' }, 157 ]; 158} 159 160sub setup_template { 161 my $class = shift; 162 my $template_text = shift || $default_template_text; 163 164 return if ( $template_is_setup ); 165 166 Inline->bind( 167 TT => $template_text, 168 POST_CHOMP => 1, 169 TRIM_LEADING_SPACE => 0, 170 TRIM_TRAILING_SPACE => 0, 171 ); 172 173 $template_is_setup = 1; 174} 175 176sub gen_Model { 177 my $class = shift; 178 my $build_dir = shift; 179 my $bigtop_tree = shift; 180 181 # make sure the directories are ready for us 182 my $model_name = $bigtop_tree->get_appname() . '::Model'; 183 184 my ( $module_dir, @sub_dirs ) 185 = Bigtop::make_module_path( $build_dir, $model_name ); 186 187 my $gen_dir = File::Spec->catdir( $module_dir, 'GEN' ); 188 189 mkdir $gen_dir; 190 191 # see if there is an alternate default base module 192 my $config_block = $bigtop_tree->get_config()->{ Model }; 193 194 # build the individual model packages 195 $bigtop_tree->walk_postorder( 196 'output_model', 197 { 198 module_dir => $module_dir, 199 model_name => $model_name, 200 lookup => $bigtop_tree->{application}{lookup}, 201 model_base_class => $config_block->{model_base_class} 202 || 'Gantry::Utils::CDBI', 203 }, 204 ); 205 206} 207 208#----------------------------------------------------------------- 209# Packages named in the grammar 210#----------------------------------------------------------------- 211 212# table_block 213package # table_block 214 table_block; 215use strict; use warnings; 216 217sub output_model { 218 my $self = shift; 219 my $child_output = shift; 220 my $data = shift; 221 222 # Skip sequences, etc. 223 return unless ( $self->{__TYPE__} eq 'tables' ); 224 225 my $table_lookup = $data->{lookup}{tables}{ $self->{__NAME__} }; 226 227 if ( $table_lookup->{not_for} ) { 228 foreach my $skipped_type ( @{ $table_lookup->{not_for}{__ARGS__} } ) { 229 return if ( $skipped_type eq 'Model' ); 230 } 231 } 232 233 # get columns sets 234 my $lookup = $table_lookup->{fields}; 235 236 my $all = $self->walk_postorder( 237 'output_all_fields_cdbi', $lookup 238 ); 239 my $essentials = $self->walk_postorder( 240 'output_essential_fields_cdbi', $lookup 241 ); 242 243 # deal with foreign keys 244 my $foreign_tables = $self->walk_postorder( 245 'output_foreign_tables_cdbi', $lookup 246 ); 247 248 my @foreign_table_names; 249 my @has_a_list; 250 251 foreach my $entry ( @{ $foreign_tables } ) { 252 my $entry_hash = { @{ $entry } }; 253 254 my $foreign_table = $entry_hash->{ table }; 255 $foreign_table =~ s/\./_/; 256 257 push @foreign_table_names, $foreign_table; 258 259 push @has_a_list, { 260 table => $foreign_table, 261 column => $entry_hash->{ column }, 262 }; 263 } 264 265 # Gone Fishing. 266 my $table = $self->{__NAME__}; 267 $table =~ s/\./_/; 268 my $module_name = $data->{model_name} . '::' . $table; 269 my $gen_pack_name = $data->{model_name} . '::GEN::' . $table; 270 my $alias = uc $table; 271 my $sequence = $table_lookup->{sequence}; 272 my $foreign_display = $table_lookup->{foreign_display}; 273 274 my $sequence_name; 275 276 if ( $sequence ) { 277 $sequence_name = $sequence->{__ARGS__}[0]; 278 } 279 280 my $primary_key = $self->find_primary_key( 281 $self->{__NAME__}, 282 $data->{ lookup }, 283 ); 284 285 my $foreign_display_columns; 286 my $foreign_display_body; 287 288 if ( $foreign_display ) { 289 my $foreign_display_cols = $foreign_display->{__ARGS__}[0]; 290 291 my @field_names = ( $foreign_display_cols =~ /%([\w\d_]*)/g ); 292 $foreign_display_columns = "@field_names"; 293 294 $foreign_display_body = _build_foreign_display_body( 295 $foreign_display_cols, @field_names 296 ); 297 } 298 299 my $base_class; 300 301 if ( defined $table_lookup->{model_base_class} ) { 302 $base_class = $table_lookup->{model_base_class}{__ARGS__}[0]; 303 } 304 305 # generate output 306 my $stub_content = Bigtop::Backend::Model::GantryCDBI::stub_table_module( 307 { 308 base_class => $base_class, 309 base_class_default => $data->{model_base_class}, 310 base_package_name => $data->{model_name}, 311 gen_package_name => $gen_pack_name, 312 package_name => $module_name, 313 package_alias => $alias, 314 table_name => $table, 315 } 316 ); 317 318 my $gen_content = Bigtop::Backend::Model::GantryCDBI::gen_table_module( 319 { 320 base_package_name => $data->{model_name}, 321 package_name => $module_name, 322 gen_package_name => $gen_pack_name, 323 package_alias => $alias, 324 table_name => $table, 325 real_table_name => $self->{__NAME__}, 326 sequence_name => $sequence_name, 327 primary_key => $primary_key, 328 foreign_display_columns => $foreign_display_columns, 329 foreign_display_body => $foreign_display_body, 330 all_columns => $all, 331 essential_columns => $essentials, 332 has_a_list => \@has_a_list, 333 foreign_tables => \@foreign_table_names, 334 } 335 ); 336 337 # store it 338 my $module_file = File::Spec->catfile( $data->{module_dir}, "$table.pm" ); 339 my $gen_dir = File::Spec->catdir ( $data->{module_dir}, 'GEN' ); 340 my $gen_file = File::Spec->catfile( $gen_dir, "$table.pm" ); 341 342 eval { 343 no warnings qw( Bigtop ); 344 Bigtop::write_file( $module_file, $stub_content, 'no overwrite' ); 345 }; 346 warn $@ if $@; 347 348 eval { 349 Bigtop::write_file( $gen_file, $gen_content ); 350 }; 351 warn $@ if $@; 352} 353 354# table_element_block 355package # table_element_block 356 table_element_block; 357use strict; use warnings; 358 359sub output_all_fields_cdbi { 360 my $self = shift; 361 shift; 362 my $data = shift; 363 364 return unless ( ref( $self->{__BODY__} ) ); 365 366 my $field = $data->{ $self->{__NAME__} }; 367 368 return if ( _not_for_model( $field ) ); 369 370 return [ $self->{__NAME__} ]; 371} 372 373sub output_essential_fields_cdbi { 374 my $self = shift; 375 shift; 376 my $data = shift; 377 378 return unless ( ref( $self->{__BODY__} ) ); 379 380 my $field = $data->{ $self->{__NAME__} }; 381 382 if ( $field->{non_essential} ) { 383 my $non_essential_value = $field->{non_essential}{args}[0]; 384 385 return if ( $non_essential_value ); 386 } 387 388 return if ( _not_for_model( $field ) ); 389 390 return [ $self->{__NAME__} ]; 391} 392 393sub output_foreign_tables_cdbi { 394 my $self = shift; 395 shift; 396 my $data = shift; 397 398 return unless ( ref( $self->{__BODY__} ) ); 399 400 my $field = $data->{ $self->{__NAME__} }; 401 402 if ( $field->{refers_to} ) { 403 my $foreign_table_name = $field->{refers_to}{args}[0]; 404 405 if ( ref( $foreign_table_name ) eq 'HASH' ) { 406 ( $foreign_table_name ) = %{ $foreign_table_name }; 407 } 408 409 return [ 410 [ column => $self->{__NAME__}, table => $foreign_table_name ] 411 ]; 412 } 413 return; 414} 415 4161; 417 418__END__ 419 420=head1 NAME 421 422Bigtop::Backend::Model::GantryCDBI - Bigtop backend generating Class::DBI::Sweet models 423 424=head1 SYNOPSIS 425 426If your bigtop file looks like this: 427 428 config { 429 base_dir `/home/user`; 430 ... 431 Model GantryCDBI {} 432 } 433 app Name {...} 434 435and there are tables in the app block, when you type: 436 437 bigtop your.bigtop Model 438 439or 440 bigtop your.bigtop all 441 442this module will make model modules which are subclasses of 443Gantry::Utils::CDBI (which inherits from Class::DBI::Sweet in a 444mod_perl safe way). 445 446All modules will live in the lib subdirectory of the app's build directory. 447See Bigtop::Init::Std for an explanation of how base_dir and the 448build directory are related. 449 450=head1 DESCRIPTION 451 452This is a Bigtop backend which generates data model modules which are 453subclasses of Gantry::Utils::CDBI. 454 455=head1 KEYWORDS 456 457This module does not register any keywords. See Bigtop::Model for 458a list of keywords models understand. 459 460The default for the model_base_class keyword is Gantry::Utils::CDBI. 461 462=head1 METHODS 463 464To keep podcoverage tests happy. 465 466=over 4 467 468=item backend_block_keywords 469 470Tells tentmaker that I understand these config section backend block keywords: 471 472 no_gen 473 model_base_class 474 template 475 476=item what_do_you_make 477 478Tells tentmaker what this module makes. Summary: Class::DBI models. 479 480=item gen_Model 481 482Called by Bigtop::Parser to get me to do my thing. 483 484=item setup_template 485 486Called by Bigtop::Parser so the user can substitute an alternate template 487for the hard coded one here. 488 489=back 490 491=head1 AUTHOR 492 493Phil Crow <crow.phil@gmail.com> 494 495=head1 COPYRIGHT and LICENSE 496 497Copyright (C) 2005 by Phil Crow 498 499This library is free software; you can redistribute it and/or modify 500it under the same terms as Perl itself, either Perl version 5.8.6 or, 501at your option, any later version of Perl 5 you may have available. 502 503=cut 504