view release on metacpan or  search on metacpan

lib/CGI/Builder/TT2.pm  view on Meta::CPAN

use Devel::Peek;

$Carp::Internal{ Template }++;
$Carp::Internal{+__PACKAGE__}++;

my $print_code;
BEGIN {
    $print_code = sub {
        shift()->CGI::Builder::TT2::_::tt_print( @_ )
    }
}


use Class::groups(
    { name    => 'tt_new_args' ,
      default => sub { 
          { INCLUDE_PATH => [ $_[0]->page_path ] }
      }
    } ,
);

use Class::props(
    { name    => 'tt' ,
      default => sub { shift()->tt_new( @_ ) }
    } ,
);

use Object::groups(
    { name    => 'tt_vars' ,
    } ,
);

use Object::props(
    { name    => 'tt_lookups_package' ,
      default => sub {
          ref( $_[0] ) . '::Lookups'
      }
    } ,
    { name    => 'tt_template' ,
      default => sub {
          $_[0]->page_name . $_[0]->page_suffix 
      }
    } ,
    { name    => 'page_suffix' ,
      default => '.tt2'
    } ,
    { name    => 'page_content' ,
      default => sub { $print_code },
    }
);

# Template->new takes a hashref as sole arg, force scalar context
sub tt_new { Template->new( scalar($_[0]->tt_new_args) ) }


sub CGI::Builder::TT2::_::tt_print
{
    my $s = shift;
    
    Scalar::Util::weaken( $s );
    $s->tt_vars( CBF => sub { return $s } );

    { 
		# Inspect the symbol table of the Lookups package, store refs
		# in tt_vars for TT to use.
        no strict;
        my $href = $s->tt_lookups_package() . '::';

        foreach my $symbol ( keys %$href ) {
            
            local *glob = $href->{ $symbol };

            $s->tt_vars( $symbol => defined $glob ? $glob 
                                  : defined @glob ? \@glob 
                                  : defined %glob ? \%glob
                                  : defined &glob ? \&glob
                                  :                 undef );
        }
    }

    foreach my $symbol ( keys %{ scalar $s->tt_vars() } ) {
        next unless ref( $s->tt_vars( $symbol ) ) eq 'CODE';
        $s->tt_vars( $symbol => 
            CGI::Builder::TT2::_::make_wrapper( $s->tt_vars( $symbol ), $s )
        )
    }

	# process() prints to STDOUT. Could pass a scalar to collect
	# output, but that would eat memory.
    my $ok = $s->tt->process( $s->tt_template(), scalar $s->tt_vars());
}


sub CGI::Builder::TT2::_::make_wrapper
{
    my $code       = shift;
    my $app_object = shift;

	# Stop memory leak by weakening enclosed references
	Scalar::Util::weaken($app_object);

    return sub {
        unshift @_, $app_object;
        goto &{ $code };
    }
}


sub page_content_check
{
    my $s = shift;

	# Template uses a search path to find templates, and can use different
	# providers to get templates from a DB or the web, so a -f test might not
	# be valid here. The tt->context->template method loads the template or
	# throws an exception if loading fails.
    if ($s->page_content eq $print_code) {
		eval { $s->tt->context->template($s->tt_template) };
		return !$@;
    }
    else {
        return length $s->page_content;
    }
}


1;

__END__

=head1 NAME

CGI::Builder::TT2 - CGI::Builder and Template Toolkit 2 integration

=head1 VERSION 0.02

=head1 INSTALLATION

=over

=item Prerequisites

    CGI::Builder    >= 1.12
    Template        >= 2.0

=item CPAN

    perl -MCPAN -e 'install CGI::Builder::TT2'

=item Standard installation

From the directory where this file is located, type:

    perl Makefile.PL
    make
    make test
    make install


=back