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

   1 package SQL::Translator::Producer::TT::Base;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Base.pm,v 1.1 2004-04-14 19:19:44 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.1 $ =~ /(\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 # Until 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 #           exists in the args return 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         %args,         # Allow any TT opts to be passed in the producer_args
 131     ) || die "Failed to initialize Template object: ".Template->error;
 132
 133     $tt->process( $tmpl, { $me->tt_default_vars, $me->tt_vars, }, \$out )
 134     or die "Error processing template '$tmpl': ".$tt->error;
 135
 136     return $out;
 137 }
 138
 139 # Returns template file to use, or a scalar ref of tt source, or io handle.
 140 # See L<Template>
 141 sub tt_schema { shift->args("ttfile") };
 142
 143 # Returns hash-ref of the defaults vars given to the template.
 144 # You wouldn't normally over-ride but here just in case.
 145 sub tt_default_vars {
 146     my $me = shift;
 147     return (
 148         translator => $me->translator,
 149         schema     => $me->translator->schema,
 150     );
 151 }
 152
 153 # Return hash of template vars to add to the default set.
 154 sub tt_vars { () };
 155 1;
 156
 157 # -------------------------------------------------------------------
 158
 159 =pod
 160
 161 =head1 AUTHOR
 162
 163 Mark Addison E<lt>grommit@users.sourceforge.netE<gt>.
 164
 165 =head1 TODO
 166
 167 Lots! But the next things include;
 168
 169 - Hook to allow sub-class to set the options given to the C<Template> instance.
 170
 171 - Add support for a sqlf template repository somewhere, set as an INCLUDE_PATH,
 172 so that sub-classes can easily include file based templates.
 173
 174 - Merge in TT::Table.
 175
 176 =head1 SEE ALSO
 177
 178 SQL::Translator.
 179
 180 =cut