1use strict;
2use warnings;
3
4package Jifty::View::Mason::Handler;
5
6=head1 NAME
7
8Jifty::View::Mason::Handler - Handler for Mason requests inside of Jifty
9
10=head1 SUMMARY
11
12Jifty controls all of the input and output from the Mason templating
13engine; this means that we cannot use the Mason's standard
14L<HTML::Mason::CGIHandler> interface to interact with it.
15
16=cut
17
18use HTML::Mason;
19use HTML::Mason::Utils;
20use Params::Validate qw(:all);
21use HTML::Mason::Exceptions;
22use HTML::Mason::FakeApache;
23use Encode qw();
24use Jifty::View::Mason::Request;
25
26use Class::Container;
27use base qw(Jifty::View Class::Container);
28
29use HTML::Mason::MethodMaker
30    ( read_write => [ qw( interp ) ] );
31
32use vars qw($VERSION);
33
34__PACKAGE__->valid_params
35    (
36     interp => { isa => 'HTML::Mason::Interp' },
37    );
38
39__PACKAGE__->contained_objects
40    (
41     interp => 'HTML::Mason::Interp',
42    );
43
44
45=head2 new PARAMHASH
46
47Takes a number of key-value parameters; see L<HTML::Mason::Params>.
48Defaults the C<out_method> to appending to L<Jifty::Handler/buffer>
49and the C<request_class> to L<Jifty::View::Mason::Request> (below).
50Finally, adds C<h> and C<u> escapes, which map to L</escape_uri> and
51L<escape_utf8> respectively.
52
53=cut
54
55sub new {
56    my $package = shift;
57
58    $package->create_cache_directories;
59
60    my %p = @_ || $package->config;
61    my $self = $package->SUPER::new( request_class => 'Jifty::View::Mason::Request',
62                                     out_method => sub {Carp::cluck("Mason output skipped Jifty's output stack!") if grep {defined and length} @_},
63                                     %p );
64    $self->interp->set_escape( h => \&escape_utf8 );
65    $self->interp->set_escape( u => \&escape_uri );
66
67    return $self;
68}
69
70
71=head2 config
72
73Returns our Mason config.  We use the component root specified in the
74C<Web/TemplateRoot> framework configuration variable (or C<html> by
75default).  Additionally, we set up a C<jifty> component root, as
76specified by the C<Web/DefaultTemplateRoot> configuration.  All
77interpolations are HTML-escaped by default, and we use the fatal error
78mode.
79
80=cut
81
82sub config {
83    my $self = shift;
84
85    my %config = (
86        static_source => 1,
87        use_object_files => 1,
88        preprocess => sub {
89            # Force UTF-8 semantics on all our components by
90            # prepending this block to all components as Mason
91            # components defaults to parse the text as Latin-1
92            ${$_[0]} =~ s!^!<\%INIT>use utf8;</\%INIT>\n!;
93        },
94        data_dir =>  Jifty::Util->absolute_path( Jifty->config->framework('Web')->{'DataDir'} ),
95        allow_globals => [
96            qw[ $JiftyWeb ],
97            @{Jifty->config->framework('Web')->{'Globals'} || []},
98        ],
99        comp_root     => [
100                          [application =>  Jifty::Util->absolute_path( Jifty->config->framework('Web')->{'TemplateRoot'} )],
101                         ],
102        %{ Jifty->config->framework('Web')->{'MasonConfig'} },
103    );
104
105    my $root_serial = 0;
106    my %seen; $seen{$_} = 1 for map Jifty->config->framework('Web')->{$_}, qw/TemplateRoot DefaultTemplateRoot/;
107    for my $plugin (Jifty->plugins) {
108        my $comp_root = $plugin->template_root;
109        next unless ( defined $comp_root and -d $comp_root and not $seen{$comp_root}++);
110        $plugin->log->debug( "Plugin @{[ref($plugin)]} mason component root added: (@{[$comp_root ||'']})");
111        push @{ $config{comp_root} }, [ ref($plugin)."-". $root_serial++ => $comp_root ];
112    }
113    push @{$config{comp_root}}, [jifty => Jifty::Util->absolute_path( Jifty->config->framework('Web')->{'DefaultTemplateRoot'})];
114
115    # In developer mode, we want refreshing and all that other good stuff.
116    if (Jifty->config->framework('DevelMode') ) {
117        $config{static_source}    = 0;
118        $config{use_object_files} = 0;
119    }
120
121    # We require autoflush now.
122    $config{autoflush} = 1;
123
124    return %config;
125}
126
127=head2 escape_utf8 SCALARREF
128
129Does a css-busting but minimalist escaping of whatever html you're passing in.
130
131=cut
132
133sub escape_utf8 {
134    my $ref = shift;
135    no warnings 'uninitialized';
136    $$ref =~ s/&/&#38;/g;
137    $$ref =~ s/</&lt;/g;
138    $$ref =~ s/>/&gt;/g;
139    $$ref =~ s/\(/&#40;/g;
140    $$ref =~ s/\)/&#41;/g;
141    $$ref =~ s/"/&#34;/g;
142    $$ref =~ s/'/&#39;/g;
143}
144
145=head2 escape_uri SCALARREF
146
147Escapes in-place URI component according to RFC2396. Takes a reference to
148perl string.
149
150*Note* that octets would be treated as latin1 encoded sequence and converted
151to UTF-8 encoding and then escaped. So this sub always provide UTF-8 escaped
152string. See also L<Encode> for more info about converting.
153
154=cut
155
156sub escape_uri {
157    my $ref = shift;
158    $$ref = Encode::encode_utf8($$ref);
159    $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
160}
161
162
163=head2 template_exists COMPONENT
164
165Checks if the C<COMPONENT> exists, or if C<COMPONENT/index.html>
166exists, and returns which one did.  If neither did, it searches for
167C<dhandler> components which could match, returning C<COMPONENT> if it
168finds one.  Finally, if it finds no possible component matches,
169returns undef.
170
171Note that this algorithm does not actually decisively return if Mason
172I<will> handle a given component; the I<dhandler>s could defer
173handling, for instance.
174
175=cut
176
177sub template_exists {
178    my $self = shift;
179    my ($component) = @_;
180    $component =~ s{^/*}{/};
181    return $component if $self->interp->comp_exists($component);
182    return "$component/index.html" if $self->interp->comp_exists("$component/index.html");
183
184    my $dhandler = $self->interp->dhandler_name;
185    $dhandler = "dhandler" unless defined $dhandler;
186    return if defined $dhandler and not length $dhandler;
187    return $component if $self->interp->find_comp_upwards($component, $dhandler);
188    return undef;
189}
190
191
192=head2 show COMPONENT
193
194Takes a component path to render.  Deals with setting up a global
195L<HTML::Mason::FakeApache> and Request object, and calling the
196component.
197
198=head2 handle_comp
199
200A synonym for show
201
202=cut
203
204sub show {
205    shift->handle_comp(@_);
206}
207
208sub _comp_setup {
209    my ($self, $comp, $args) = @_;
210
211    # XXX FIXME This is a kludge to get use_mason_wrapper to work
212    $self->interp->set_global('$jifty_internal_request', 0);
213    $self->interp->set_global('$jifty_internal_request', 1) if defined $args;
214
215    return $args ? %$args : $self->request_args;
216}
217
218sub handle_comp {
219    my $self = shift;
220    my ($comp) = @_;
221
222    my %args = $self->_comp_setup(@_);
223    $self->interp->exec($comp, %args);
224}
225
226=head2 request_args
227
228The official source for request arguments is from the current
229L<Jifty::Request> object.
230
231=cut
232
233sub request_args {
234    return %{Jifty->web->request->arguments}, %{Jifty->web->request->template_arguments || {}};
235}
236
237
238=head2 create_cache_directories
239
240Attempts to create our application's mason cache directory.
241
242=cut
243
244sub create_cache_directories {
245    for ( Jifty->config->framework('Web')->{'DataDir'} ) {
246        Jifty::Util->make_path( Jifty::Util->absolute_path($_) );
247    }
248}
249
2501;
251
252