File Coverage

blib/lib/SQL/Translator/Producer/TT/Base.pm
Criterion Covered Total %
statement 61 70 87.1
branch 8 16 50.0
condition 3 7 42.8
subroutine 17 20 85.0
pod 10 11 90.9
total 99 124 79.8


line stmt bran cond sub pod time code
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 1     1   438 use strict;
  1         2  
  1         25  
13 1     1   5 use warnings;
  1         2  
  1         41  
14              
15             our @EXPORT_OK;
16             our $VERSION = '1.6_3';
17              
18 1     1   5 use Template;
  1         5  
  1         19  
19 1     1   5 use Data::Dumper;
  1         1  
  1         54  
20 1     1   8 use IO::Handle;
  1         5  
  1         27  
21 1     1   4 use Exporter;
  1         1  
  1         33  
22 1     1   5 use base qw(Exporter);
  1         2  
  1         210  
23             @EXPORT_OK = qw(produce);
24              
25 1     1   7 use SQL::Translator::Utils 'debug';
  1         2  
  1         495  
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 0     0 0 0 return __PACKAGE__->new( translator => shift )->run;
31             };
32              
33             sub new {
34 1     1 1 25 my $proto = shift;
35 1   33     4 my $class = ref $proto || $proto;
36 1         4 my %args = @_;
37              
38 1         2 my $me = bless {}, $class;
39 1   50     15 $me->{translator} = delete $args{translator} || die "Need a translator.";
40              
41 1         5 return $me;
42             }
43              
44 2     2 1 28 sub translator { shift->{translator}; }
45 1     1 1 20 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 2     2 1 4 my $me = shift;
55              
56             # No args
57 2 100       5 unless (@_) {
58             return wantarray
59 0         0 ? %{ $me->{translator}->producer_args }
60             : $me->{translator}->producer_args
61 1 50       38 ;
62             }
63              
64             # 1 arg. Return the value whatever the context.
65 1 50       16 return $me->{translator}->producer_args->{$_[0]} if @_ == 1;
66              
67             # More args so return values list or hash ref
68 0         0 my %args = %{ $me->{translator}->producer_args };
  0         0  
69 0 0       0 return wantarray ? @args{@_} : { map { ($_=>$args{$_}) } @_ };
  0         0  
70             }
71              
72             # Run the produce and return the result.
73             sub run {
74 1     1 1 2 my $me = shift;
75 1         3 my $scma = $me->schema;
76 1         7 my %args = %{$me->args};
  1         3  
77 1 50       4 my $tmpl = $me->tt_schema or die "No template!";
78              
79 1         7 debug "Processing template $tmpl\n";
80 1         2 my $out;
81 1   50     3 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 1 50       20155 $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 1         203 return $out;
96             }
97              
98              
99             # Sub class hooks
100             #-----------------------------------------------------------------------------
101              
102 0     0 1 0 sub tt_config { () };
103              
104             sub tt_schema {
105 1     1 1 2 my $me = shift;
106 1         2 my $class = ref $me;
107              
108 1         2 my $file = $me->args("ttfile");
109 1 50       7 return $file if $file;
110              
111 1     1   6 no strict 'refs';
  1         2  
  1         184  
112 1         1 my $ref = *{"$class\:\:DATA"}{IO};
  1         9  
113 1 50       8 if ( $ref->opened ) {
114 1         16 local $/ = undef; # Slurp mode
115 1         36 return \<$ref>;
116             }
117              
118 0         0 undef;
119             };
120              
121             sub tt_default_vars {
122 1     1 1 2 my $me = shift;
123             return (
124 1         7 translator => $me->translator,
125             schema => $me->pre_process_schema($me->translator->schema),
126             );
127             }
128              
129 1     1 1 13 sub pre_process_schema { $_[1] }
130              
131 0     0 1   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.
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
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 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 for details.
183              
184             See the L 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