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