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

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