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