lib/SQL/Translator/Producer/TT/Base.pm

   1 package SQL::Translator::Producer::TT::Base;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 SQL::Translator::Producer::TT::Base - TT (Template Toolkit) based Producer base
   8 class.
   9
  10 =cut
  11
  12 use strict;
  13 use warnings;
  14
  15 our @EXPORT_OK;
  16 our $VERSION = '1.59';
  17
  18 use Template;
  19 use Data::Dumper;
  20 use IO::Handle;
  21 use Exporter;
  22 use base qw(Exporter);
  23 @EXPORT_OK = qw(produce);
  24
  25 use SQL::Translator::Utils 'debug';
  26
  27 # Hack to convert the produce call into an object. ALL sub-classes need todo
  28 # this so that the correct class gets created.
  29 sub produce {
  30     return __PACKAGE__->new( translator => shift )->run;
  31 };
  32
  33 sub new {
  34     my $proto = shift;
  35     my $class = ref $proto || $proto;
  36     my %args  = @_;
  37
  38     my $me = bless {}, $class;
  39     $me->{translator} = delete $args{translator} || die "Need a translator.";
  40
  41     return $me;
  42 }
  43
  44 sub translator { shift->{translator}; }
  45 sub schema     { shift->{translator}->schema(@_); }
  46
  47 # Util args access method.
  48 # No args - Return hashref (the actual hash in Translator) or hash of args.
  49 # 1 arg   - Return that named args value.
  50 # Args    - List of names. Return values of the given arg names in list context
  51 #           or return as hashref in scalar context. Any names given that don't
  52 #           exist in the args are returned as undef.
  53 sub args {
  54     my $me = shift;
  55
  56     # No args
  57     unless (@_) {
  58         return wantarray
  59             ? %{ $me->{translator}->producer_args }
  60             : $me->{translator}->producer_args
  61         ;
  62     }
  63
  64     # 1 arg. Return the value whatever the context.
  65     return $me->{translator}->producer_args->{$_[0]} if @_ == 1;
  66
  67     # More args so return values list or hash ref
  68     my %args = %{ $me->{translator}->producer_args };
  69     return wantarray ? @args{@_} : { map { ($_=>$args{$_}) } @_ };
  70 }
  71
  72 # Run the produce and return the result.
  73 sub run {
  74     my $me = shift;
  75     my $scma = $me->schema;
  76     my %args = %{$me->args};
  77     my $tmpl = $me->tt_schema or die "No template!";
  78
  79     debug "Processing template $tmpl\n";
  80     my $out;
  81     my $tt = Template->new(
  82         #DEBUG    => $me->translator->debug,
  83         ABSOLUTE => 1,  # Set so we can use from the command line sensibly
  84         RELATIVE => 1,  # Maybe the cmd line code should set it! Security!
  85         $me->tt_config, # Hook for sub-classes to add config
  86         %args,          # Allow any TT opts to be passed in the producer_args
  87     ) || die "Failed to initialize Template object: ".Template->error;
  88
  89     $tt->process( $tmpl, {
  90         $me->tt_default_vars,
  91         $me->tt_vars,          # Sub-class hook for adding vars
  92     }, \$out )
  93     or die "Error processing template '$tmpl': ".$tt->error;
  94
  95     return $out;
  96 }
  97
  98
  99 # Sub class hooks
 100 #-----------------------------------------------------------------------------
 101
 102 sub tt_config { () };
 103
 104 sub tt_schema {
 105     my $me = shift;
 106     my $class = ref $me;
 107
 108     my $file = $me->args("ttfile");
 109     return $file if $file;
 110
 111     no strict 'refs';
 112     my $ref = *{"$class\:\:DATA"}{IO};
 113     if ( $ref->opened ) {
 114         local $/ = undef; # Slurp mode
 115         return \<$ref>;
 116     }
 117
 118     undef;
 119 };
 120
 121 sub tt_default_vars {
 122     my $me = shift;
 123     return (
 124         translator => $me->translator,
 125         schema     => $me->pre_process_schema($me->translator->schema),
 126     );
 127 }
 128
 129 sub pre_process_schema { $_[1] }
 130
 131 sub tt_vars   { () };
 132
 133 1;
 134
 135 =pod
 136
 137 =head1 SYNOPSIS
 138
 139  # Create a producer using a template in the __DATA__ section.
 140  package SQL::Translator::Producer::Foo;
 141
 142  use base qw/SQL::Translator::Producer::TT::Base/;
 143
 144  # Convert produce call into a method call on our new class
 145  sub produce { return __PACKAGE__->new( translator => shift )->run; };
 146
 147  # Configure the Template object.
 148  sub tt_config { ( INTERPOLATE => 1 ); }
 149
 150  # Extra vars to add to the template
 151  sub tt_vars { ( foo => "bar" ); }
 152
 153  # Put template in DATA section (or use file with ttfile producer arg)
 154  __DATA__
 155  Schema
 156
 157  Database: [% schema.database %]
 158  Foo: $foo
 159  ...
 160
 161 =head1 DESCRIPTION
 162
 163 A base class producer designed to be sub-classed to create new TT based
 164 producers cheaply - by simply giving the template to use and sprinkling in some
 165 extra template variables and config.
 166
 167 You can find an introduction to this module in L<SQL::Translator::Manual>.
 168
 169 The 1st thing the module does is convert the produce sub routine call we get
 170 from SQL::Translator into a method call on an object, which we can then
 171 sub-class. This is done with the following code which needs to appear in B<all>
 172 sub classes.
 173
 174  # Convert produce call into an object method call
 175  sub produce { return __PACKAGE__->new( translator => shift )->run; };
 176
 177 See L</PRODUCER OBJECT> below for details.
 178
 179 The upshot of this is we can make new template producers by sub classing this
 180 base class, adding the above snippet and a template.
 181 The module also provides a number of hooks into the templating process,
 182 see L</SUB CLASS HOOKS> for details.
 183
 184 See the L</SYNOPSIS> above for an example of creating a simple producer using
 185 a single template stored in the producers DATA section.
 186
 187 =head1 SUB CLASS HOOKS
 188
 189 Sub-classes can override these methods to control the templating by giving
 190 the template source, adding variables and giving config to the Tempate object.
 191
 192 =head2 tt_config
 193
 194  sub tt_config { ( INTERPOLATE => 1 ); }
 195
 196 Return hash of Template config to add to that given to the L<Template> C<new>
 197 method.
 198
 199 =head2 tt_schema
 200
 201  sub tt_schema { "foo.tt"; }
 202  sub tt_schema { local $/ = undef; \<DATA>; }
 203
 204 The template to use, return a file name or a scalar ref of TT
 205 source, or an L<IO::Handle>. See L<Template> for details, as the return from
 206 this is passed on to it's C<produce> method.
 207
 208 The default implementation uses the producer arg C<ttfile> as a filename to read
 209 the template from. If the arg isn't there it will look for a C<__DATA__> section
 210 in the class, reading it as template source if found. Returns undef if both
 211 these fail, causing the produce call to fail with a 'no template!' error.
 212
 213 =head2 tt_vars
 214
 215  sub tt_vars { ( foo => "bar" ); }
 216
 217 Return hash of template vars to use in the template. Nothing added here
 218 by default, but see L</tt_default_vars> for the variables you get for free.
 219
 220 =head2 tt_default_vars
 221
 222 Return a hash-ref of the default vars given to the template.
 223 You wouldn't normally over-ride this, just inherit the default implementation,
 224 to get the C<translator> & C<schema> variables, then over-ride L</tt_vars> to add
 225 your own.
 226
 227 The current default variables are:
 228
 229 =over 4
 230
 231 =item schema
 232
 233 The schema to template.
 234
 235 =item translator
 236
 237 The L<SQL::Translator> object.
 238
 239 =back
 240
 241 =head2 pre_process_schema
 242
 243 WARNING: This method is Experimental so may change!
 244
 245 Called with the L<SQL::Translator::Schema> object and should return one (it
 246 doesn't have to be the same one) that will become the C<schema> variable used
 247 in the template.
 248
 249 Gets called from tt_default_vars.
 250
 251 =head1 PRODUCER OBJECT
 252
 253 The rest of the methods in the class set up a sub-classable producer object.
 254 You normally just inherit them.
 255
 256 =head2 new
 257
 258  my $tt_producer = TT::Base->new( translator => $translator );
 259
 260 Construct a new TT Producer object. Takes a single, named arg of the
 261 L<SQL::Translator> object running the translation. Dies if this is not given.
 262
 263 =head2 translator
 264
 265 Return the L<SQL::Translator> object.
 266
 267 =head2 schema
 268
 269 Return the L<SQL::Translator::Schema> we are translating. This is equivalent
 270 to C<< $tt_producer->translator->schema >>.
 271
 272 =head2 run
 273
 274 Called to actually produce the output, calling the sub class hooks. Returns the
 275 produced text.
 276
 277 =head2 args
 278
 279 Util wrapper method around C<< TT::Base->translator->producer_args >> for
 280 (mostly) readonly access to the producer args. How it works depends on the
 281 number of arguments you give it and the context.
 282
 283  No args - Return hashref (the actual hash in Translator) or hash of args.
 284  1 arg   - Return value of the arg with the passed name.
 285  2+ args - List of names. In list context returns values of the given arg
 286            names, returns as a hashref in scalar context. Any names given
 287            that don't exist in the args are returned as undef.
 288
 289 This is still a bit messy but is a handy way to access the producer args when
 290 you use your own to drive the templating.
 291
 292 =head1 SEE ALSO
 293
 294 L<perl>,
 295 L<SQL::Translator>,
 296 L<Template>.
 297
 298 =head1 TODO
 299
 300 - Add support for a sqlf template repository, set as an INCLUDE_PATH,
 301 so that sub-classes can easily include file based templates using relative
 302 paths.
 303
 304 - Pass in template vars from the producer args and command line.
 305
 306 - Merge in L<TT::Table|SQL::Translator::Producer::TT::Table>.
 307
 308 - Hooks to pre-process the schema and post-process the output.
 309
 310 =head1 AUTHOR
 311
 312 Mark Addison E<lt>grommit@users.sourceforge.netE<gt>.
 313
 314 =cut