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

   1 package SQL::Translator::Producer::TT::Base;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Base.pm,v 1.4 2004-05-14 03:37:37 grommit Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 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 = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
  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  package SQL::Translator::Producer::Foo;
 161
 162  use base qw/SQL::Translator::Producer::TT::Base/;
 163
 164  # Convert produce call into an object of our new class
 165  sub produce { return __PACKAGE__->new( translator => shift )->run; };
 166
 167  # Configure the Template object.
 168  sub tt_config { ( INTERPOLATE => 1 ); }
 169
 170  # Extra vars to add to the template
 171  sub tt_vars { ( foo => "bar" ); }
 172
 173  # Put template in DATA section (or use file with ttfile producer arg)
 174  __DATA__
 175  Schema
 176
 177  Database: [% schema.database %]
 178  Foo: $foo
 179  ...
 180
 181 =head1 DESCRIPTION
 182
 183 WARNING: This is currently WORK IN PROGRESS and so subject to change,
 184 but it does work ;-)
 185
 186 A base class producer designed to be sub-classed to create new TT based
 187 producers cheaply - by simply giving the template to use and sprinkling in some
 188 extra template variables and config.
 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, so we can sub-class it.
 192 This is done with the following code which B<must> appear in B<all> sub
 193 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 writing a template,
 201 then creating a module that starts like this;
 202
 203  package SQL::Translator::Producer::Foo;
 204
 205  use base qw/SQL::Translator::Producer::TT::Base/;
 206
 207  # Convert produce call into an object of our new class
 208  sub produce { return __PACKAGE__->new( translator => shift )->run; };
 209
 210 And then over ride the hooks detailed below in L<SUB CLASS HOOKS>.
 211
 212 See the L<SYNOPSIS> above for an example of creating a simple producer using
 213 a single template stored in the producers DATA section.
 214
 215 =head1 SUB CLASS HOOKS
 216
 217 Sub-classes should override these methods to control the templating by giving
 218 the template source, adding variables and giving config to the Tempate object.
 219
 220 =head2 tt_config
 221
 222  sub tt_config { ( INTERPOLATE => 1 ); }
 223
 224 Return hash of Template config to add to the config given to the
 225 C<< Template->new >> method.
 226
 227 =head2 tt_schema
 228
 229  sub tt_schema { "foo.tt"; }
 230  sub tt_schema { local $/ = undef; \<DATA>; }
 231
 232 Should return a template file name to use, or a scalar ref of TT source, or
 233 an L<IO::Handle>. See L<Template> for details, as the return from this is passed
 234 on to the produce call.
 235
 236 The default implimentation uses the producer arg C<ttfile> as a filename to read
 237 the template from. If the arg isn't there it will look for a __DATA__ section
 238 in the class, reading it as template source if found. Returns undef if both
 239 these fail, causing the produce call to fail with a 'no template!' error.
 240
 241 =head2 tt_vars
 242
 243  sub tt_vars { ( foo => "bar" ); }
 244
 245 Return hash of template vars to use in the template. Doesn't add anything
 246 by default, but see L<tt_default_vars> for the variables you get for free.
 247
 248 =head2 tt_default_vars
 249
 250 Return a hash-ref of the default vars given to the template.
 251 You wouldn't normally over-ride this, just inherit the default implimentation,
 252 to get the C<translator> & C<schema> variables, then over-ride L<tt_vars> to add
 253 your own.
 254
 255 The current default variables are:
 256
 257 =over 4
 258
 259 =item schema
 260
 261 The schema to template.
 262
 263 =item translator
 264
 265 The L<SQL::Translator> object.
 266
 267 =back
 268
 269 =head2 pre_process_schema
 270
 271 WARNING: This method is Experimental so may change!
 272
 273 Called with the Schema object and should return a Schema object (it doesn't have
 274 to be the same one) that will be used as the schema varibale used in the
 275 template.
 276
 277 Gets called from tt_default_vars.
 278
 279 =head1 PRODUCER OBJECT
 280
 281 The rest of the methods in the class set up a sub-classable producer object.
 282 You normally just inherit them.
 283
 284 =head2 new
 285
 286  my $tt_producer = TT::Base->new( translator => $translator );
 287
 288 Construct a new TT Producer object. Takes a single, named arg of the
 289 L<SQL::Translator> object running the translation. Dies if this is not given.
 290
 291 =head2 translator
 292
 293 Return the L<SQL::Translator> object.
 294
 295 =head2 schema
 296
 297 Return the L<SQL::Translator::Schema> we are translating. This is equivilent
 298 to C<< $tt_producer->translator->schema >>.
 299
 300 =head2 args
 301
 302 Util wrapper method around C<< TT::Base->translator->producer_args >> for
 303 (mostley) readonly access to the producer args. How it works depends on the
 304 number of arguments you give it and the context.
 305
 306  No args - Return hashref (the actual hash in Translator) or hash of args.
 307  1 arg   - Return value of the arg with the passed name.
 308  2+ args - List of names. In list context returns values of the given arg names,
 309            returns as a hashref in scalar context. Any names given that don't
 310            exist in the args are returned as undef.
 311
 312 This is still experimental but is a handy way to access the args when you use
 313 your own producer args to drive the templating.
 314
 315 =head2 run
 316
 317 Called to actually produce the output, calling the sub class hooks. Returns the
 318 produced text.
 319
 320 =head1 AUTHOR
 321
 322 Mark Addison E<lt>grommit@users.sourceforge.netE<gt>.
 323
 324 =head1 TODO
 325
 326 - Add support for a sqlf template repository, set as an INCLUDE_PATH,
 327 so that sub-classes can easily include file based templates using relative
 328 paths.
 329
 330 - Merge in TT::Table.
 331
 332 - Hooks to pre-process the schema and post-process the output.
 333
 334 =head1 SEE ALSO
 335
 336 SQL::Translator.
 337
 338 =cut