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