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

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