use strict; use warnings; package Jifty::View::Mason::Handler; =head1 NAME Jifty::View::Mason::Handler - Handler for Mason requests inside of Jifty =head1 SUMMARY Jifty controls all of the input and output from the Mason templating engine; this means that we cannot use the Mason's standard L interface to interact with it. =cut use HTML::Mason; use HTML::Mason::Utils; use Params::Validate qw(:all); use HTML::Mason::Exceptions; use HTML::Mason::FakeApache; use Encode qw(); use Class::Container; use base qw(Class::Container); use HTML::Mason::MethodMaker ( read_write => [ qw( interp ) ] ); use vars qw($VERSION); __PACKAGE__->valid_params ( interp => { isa => 'HTML::Mason::Interp' }, ); __PACKAGE__->contained_objects ( interp => 'HTML::Mason::Interp', ); =head2 new PARAMHASH Takes a number of key-value parameters; see L. Defaults the C to L, and the C to L (below). Finally, adds C and C escapes, which map to L and L respectively. =cut sub new { my $package = shift; my %p = @_ || $package->config; my $self = $package->SUPER::new( request_class => 'HTML::Mason::Request::Jifty', out_method => \&out_method, %p ); $self->interp->compiler->add_allowed_globals('$r'); $self->interp->set_escape( h => \&escape_utf8 ); $self->interp->set_escape( u => \&escape_uri ); return $self; } =head2 config Returns our Mason config. We use the component root specified in the C framework configuration variable (or C by default). Additionally, we set up a C component root, as specified by the C configuration. All interpolations are HTML-escaped by default, and we use the fatal error mode. =cut sub config { my %config = ( static_source => 1, use_object_files => 1, preprocess => sub { # Force UTF-8 semantics on all our components by # prepending this block to all components as Mason # components defaults to parse the text as Latin-1 ${$_[0]} =~ s!^!<\%INIT>use utf8;\n!; }, data_dir => Jifty::Util->absolute_path( Jifty->config->framework('Web')->{'DataDir'} ), allow_globals => [ qw[ $JiftyWeb ], @{Jifty->config->framework('Web')->{'Globals'} || []}, ], comp_root => [ [application => Jifty::Util->absolute_path( Jifty->config->framework('Web')->{'TemplateRoot'} )], ], %{ Jifty->config->framework('Web')->{'MasonConfig'} }, ); for my $plugin (Jifty->plugins) { my $comp_root = $plugin->template_root; unless ( $comp_root and -d $comp_root) { next; } Jifty->log->debug( "Plugin @{[ref($plugin)]} mason component root added: (@{[$comp_root ||'']})"); push @{ $config{comp_root} }, [ ref($plugin)."-".Jifty->web->serial => $comp_root ]; } push @{$config{comp_root}}, [jifty => Jifty->config->framework('Web')->{'DefaultTemplateRoot'}]; # In developer mode, we want halos, refreshing and all that other good stuff. if (Jifty->config->framework('DevelMode') ) { push @{$config{'plugins'}}, 'Jifty::Mason::Halo'; $config{static_source} = 0; $config{use_object_files} = 0; } return %config; } =head2 out_method The default output method. Sets the content-type to C unless a content type has already been set, and then sends a header if need be. =cut sub out_method { my $m = HTML::Mason::Request->instance; my $r = Jifty->handler->apache; $r->content_type || $r->content_type('text/html; charset=utf-8'); # Set up a default if ($r->content_type =~ /charset=([\w-]+)$/ ) { my $enc = $1; if (lc($enc) =~ /utf-?8/) { binmode *STDOUT, ":utf8"; } else { binmode *STDOUT, ":encoding($enc)"; } } unless ($r->http_header_sent or not $m->auto_send_headers) { $r->send_http_header(); } # We could perhaps install a new, faster out_method here that # wouldn't have to keep checking whether headers have been # sent and what the $r->method is. That would require # additions to the Request interface, though. print STDOUT grep {defined} @_; } =head2 escape_utf8 SCALARREF Does a css-busting but minimalist escaping of whatever html you're passing in. =cut sub escape_utf8 { my $ref = shift; my $val = $$ref; use bytes; no warnings 'uninitialized'; $val =~ s/&/&/g; $val =~ s//>/g; $val =~ s/\(/(/g; $val =~ s/\)/)/g; $val =~ s/"/"/g; $val =~ s/'/'/g; $$ref = $val; Encode::_utf8_on($$ref); } =head2 escape_uri SCALARREF Escapes URI component according to RFC2396 =cut sub escape_uri { my $ref = shift; $$ref = Encode::encode_utf8($$ref); $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg; Encode::_utf8_on($$ref); } =head2 template_exists COMPONENT A convenience method for $self->interp->comp_exists(). (Jifty uses this method as part of its standard Templating system API). =cut sub template_exists { my $self = shift; return $self->interp->comp_exists(@_); } =head2 show COMPONENT Takes a component path to render. Deals with setting up a global L and Request object, and calling the component. =head2 handle_comp A synonym for show =cut sub show { shift->handle_comp(@_); } sub handle_comp { my ($self, $comp) = (shift, shift); # Set up the global my $r = Jifty->handler->apache; $self->interp->set_global('$r', $r); my %args = $self->request_args($r); my @result; if (wantarray) { @result = eval { $self->interp->exec($comp, %args) }; } elsif ( defined wantarray ) { $result[0] = eval { $self->interp->exec($comp, %args) }; } else { eval { $self->interp->exec($comp, %args) }; } if (my $err = $@) { my $retval = isa_mason_exception($err, 'Abort') ? $err->aborted_value : isa_mason_exception($err, 'Decline') ? $err->declined_value : rethrow_exception $err; # Unlike under mod_perl, we cannot simply return a 301 or 302 # status and let Apache send headers, we need to explicitly # send this header ourself. $r->send_http_header if $retval && grep { $retval eq $_ } ( 200, 301, 302 ); return $retval; } return wantarray ? @result : defined wantarray ? $result[0] : undef; } =head2 request_args The official source for request arguments is from the current L object. =cut sub request_args { return %{Jifty->web->request->arguments}; } ########################################################### package HTML::Mason::Request::Jifty; # Subclass for HTML::Mason::Request object $m =head1 HTML::Mason::Request::Jifty Subclass of L which is customised for Jifty's use. =cut use HTML::Mason::Exceptions; use HTML::Mason::Request; use base qw(HTML::Mason::Request); =head2 auto_send_headers Doesn't send headers if this is a subrequest (according to the current L). =cut sub auto_send_headers { return not Jifty->web->request->is_subrequest; } =head2 exec Actually runs the component; in case no headers have been sent after running the component, and we're supposed to send headers, sends them. =cut sub exec { my $self = shift; my $r = Jifty->handler->apache; my $retval; eval { $retval = $self->SUPER::exec(@_) }; if (my $err = $@) { $retval = isa_mason_exception($err, 'Abort') ? $err->aborted_value : isa_mason_exception($err, 'Decline') ? $err->declined_value : rethrow_exception $err; } # On a success code, send headers if they have not been sent and # if we are the top-level request. Since the out_method sends # headers, this will typically only apply after $m->abort. if ($self->auto_send_headers and not $r->http_header_sent and (!$retval or $retval==200)) { $r->send_http_header(); } } =head2 redirect Calls L. =cut sub redirect { my $self = shift; my $url = shift; Jifty->web->redirect($url); } 1;