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

   1 package SQL::Translator::Producer::TT::Base;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Base.pm,v 1.2 2004-05-13 22:52:00 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 based Producer base class.
  28
  29 =head1 SYNOPSIS
  30
  31  package SQL::Translator::Producer::Foo;
  32  use base qw/SQL::Translator::Producer::TT::Base/;
  33
  34  # Convert produce call into an object of our new class
  35  sub produce { return __PACKAGE__->new( translator => shift )->run; };
  36
  37  # Return file name or template source
  38  sub tt_schema { local $/ = undef; return \<DATA>; }
  39
  40  # Extra vars to add to the template
  41  sub tt_vars   { ( foo => "bar" ); }
  42
  43 =head1 DESCRIPTION
  44
  45 A base class producer designed to be sub-classed to create new TT base
  46 producers cheaply by simply giving the template to use and sprinkling in some
  47 extra template variables.
  48
  49 See the synopsis above for an example of creating a simple producer using
  50 a single template stored in the producers DATA section.
  51
  52 WARNING: This is currently WORK IN PROGRESS and so subject to change,
  53 but it does work ;-)
  54
  55 =cut
  56
  57 # -------------------------------------------------------------------
  58
  59 use strict;
  60
  61 use vars qw[ $VERSION @EXPORT_OK ];
  62 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  63
  64 use Template;
  65 use Data::Dumper;
  66 use Exporter;
  67 use base qw(Exporter);
  68 @EXPORT_OK = qw(produce);
  69
  70 use SQL::Translator::Utils 'debug';
  71
  72 # Hack to convert the produce call into an object. ALL sub-classes need todo
  73 # this so that the correct class gets created.
  74 sub produce {
  75     return __PACKAGE__->new( translator => shift )->run;
  76 };
  77
  78 sub new {
  79     my $proto = shift;
  80     my $class = ref $proto || $proto;
  81     my %args  = @_;
  82
  83     my $me = bless {}, $class;
  84     $me->{translator} = delete $args{translator} || die "Need a translator.";
  85
  86     return $me;
  87 }
  88
  89 sub translator { shift->{translator}; }
  90 sub schema     { shift->{translator}->schema(@_); }
  91
  92 # Util args access method.
  93 # No args - Return hashref (the actual hash in Translator) or hash of args.
  94 # 1 arg   - Return that named args value.
  95 # Args    - List of names. Return values of the given arg names in list context
  96 #           or return as hashref in scalar context. Any names given that don't
  97 #           exist in the args are returned as undef.
  98 sub args {
  99     my $me = shift;
 100
 101     # No args
 102     unless (@_) {
 103         return wantarray
 104             ? %{ $me->{translator}->producer_args }
 105             : $me->{translator}->producer_args
 106         ;
 107     }
 108
 109     # 1 arg. Return the value whatever the context.
 110     return $me->{translator}->producer_args->{$_[0]} if @_ == 1;
 111
 112     # More args so return values list or hash ref
 113     my %args = %{ $me->{translator}->producer_args };
 114     return wantarray ? @args{@_} : { map { ($_=>$args{$_}) } @_ };
 115 }
 116
 117 # Run the produce and return the result.
 118 sub run {
 119     my $me = shift;
 120     my $scma = $me->schema;
 121     my %args = %{$me->args};
 122     my $tmpl = $me->tt_schema or die "No template!";
 123
 124     debug "Processing template $tmpl\n";
 125     my $out;
 126     my $tt = Template->new(
 127         #DEBUG    => $me->translator->debug,
 128         ABSOLUTE => 1,  # Set so we can use from the command line sensibly
 129         RELATIVE => 1,  # Maybe the cmd line code should set it! Security!
 130         $me->tt_config, # Hook for sub-classes to add config
 131         %args,          # Allow any TT opts to be passed in the producer_args
 132     ) || die "Failed to initialize Template object: ".Template->error;
 133
 134     $tt->process( $tmpl, {
 135         $me->tt_default_vars,
 136         $me->tt_vars,          # Sub-class hook for adding vars
 137     }, \$out )
 138     or die "Error processing template '$tmpl': ".$tt->error;
 139
 140     return $out;
 141 }
 142
 143 # Should returns a template file name to use, or a scalar ref of tt source, or
 144 # an io handle. See L<Template>
 145 sub tt_schema { shift->args("ttfile") };
 146
 147 # Returns hash-ref of the default vars given to the template.
 148 # You wouldn't normally over-ride this but its here just in case.
 149 sub tt_default_vars {
 150     my $me = shift;
 151     return (
 152         translator => $me->translator,
 153         schema     => $me->translator->schema,
 154     );
 155 }
 156
 157 # Return hash of template vars to add to the default set. Override this!
 158 sub tt_vars   { () };
 159
 160 # Return hash of Template config to add to the config given to the
 161 # Template->new method.
 162 sub tt_config { () };
 163 1;
 164
 165 # -------------------------------------------------------------------
 166
 167 =pod
 168
 169 =head1 AUTHOR
 170
 171 Mark Addison E<lt>grommit@users.sourceforge.netE<gt>.
 172
 173 =head1 TODO
 174
 175 Lots! But the next things include;
 176
 177 - Add support for a sqlf template repository somewhere, set as an INCLUDE_PATH,
 178 so that sub-classes can easily include file based templates.
 179
 180 - Merge in TT::Table.
 181
 182 =head1 SEE ALSO
 183
 184 SQL::Translator.
 185
 186 =cut