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

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