The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# $Id: CGIOutputFastTemplate.pm,v 1.5 2005/01/27 23:30:50 scottb Exp $
#

package CGI::CRUD::CGIOutputFastTemplate;

use strict;
use CGI;
use DBI;
use CGI::AutoForm;
use CGI::FastTemplate;
use CGI::CRUD::Output;

@CGI::CRUD::CGIOutputFastTemplate::ISA = qw(CGI::CRUD::Output);

# CGI::FastTemplate path for templates
# May override by setting CRUDDY_FAST_TEMPLATE_PATH environment
# variable (e.g. SetEnv)
my $DEFAULT_TPL_PATH = '/var/www/tpl';

# CGI::FastTemplate 'main' template
# May override by setting CRUDDY_FAST_TEMPLATE_MAIN environment
# variable (e.g. SetEnv)
# -or-
# as a second argument to the C<output> method call
my $DEFAULT_TPL_MAIN = 'cruddy.tpl';


# May return undef if db connect error
sub new
{
    my $caller = shift;
    my ($q,$defaults) = @_;

    my $self = $caller->SUPER::new(@_);

    # Make sure to define env DBI_DSN, DBI_USER, etc (see man DBI)
    unless ($self->{dbh} = DBI->connect(undef,undef,undef,{ PrintError => 1, RaiseError => 0, AutoCommit => 1, }))
    {
        $self->perror("Database server not responding, contact your administrator");
        warn("Can't connect to db, check DBI_DSN, DBI_USER, etc env.");
        return undef;
    }

    $self->{cgi} = $q;
    $self->{user} = $q->remote_user();

    my %params = $q->Vars;

    my ($key,$val);
    while (($key,$val) = each(%params))
    {
        my @vals = split("\0",$params{$key});
        $params{$key} = \@vals if @vals > 1;
    }

    $self->{q} = \%params;

    $self->{tpl_vars} = $defaults;

    return $self;
}

sub form_attrs
{
    my ($caller,$form) = @_;
    $caller->SUPER::form_attrs($form);
    $form->{GT} = qq[WIDTH="80%" CELLPADDING="5" CELLSPACING="0" BORDER="0"];
    $form->{VFL} = qq[WIDTH="40%" ALIGN="RIGHT"];
    $form->{submit_button_attrs} = qq[class="formbutton" onmouseout="javascript:this.style.color='black';" onmouseover="javascript:this.style.color='red';"];
    return $form;
}

##at should somehow cache templates
##at Accept scalar references
sub output
{
    my ($self,$out,$tplf) = @_;
    $tplf = $ENV{CRUDDY_FAST_TEMPLATE_MAIN} || $DEFAULT_TPL_MAIN unless $tplf;

    my $tpl = new CGI::FastTemplate($ENV{CRUDDY_FAST_TEMPLATE_PATH} || $DEFAULT_TPL_PATH);
##at should check return value because an OS call was done
    $tpl->define(main => $tplf);
    $self->{tpl_vars}{BODY} = (ref($out) ? $$out : $out) if defined($out);
    $tpl->assign($self->{tpl_vars});
    $tpl->parse(CONTENT => 'main');
    my $gob = $tpl->fetch('CONTENT');

    print $self->{cgi}->header, $$gob;
    return 1;
}

1;