This file is indexed.

/usr/share/perl5/Mason/Request.pm is in libmason-perl 2.24-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
package Mason::Request;
$Mason::Request::VERSION = '2.24';
use Carp;
use File::Basename;
use Guard;
use Log::Any qw($log);
use Mason::Exceptions;
use Mason::TieHandle;
use Mason::Types;
use Mason::Moose;
use Scalar::Util qw(blessed reftype weaken);
use Try::Tiny;

my $default_out = sub { my ( $text, $self ) = @_; $self->result->_append_output($text) };
my $next_id = 0;

# Passed attributes
#
has 'interp'     => ( required => 1, weak_ref => 1 );
has 'out_method' => ( isa => 'Mason::Types::OutMethod', default => sub { $default_out }, coerce => 1 );

# Derived attributes
#
has 'buffer_stack'       => ( init_arg => undef, default => sub { [] } );
has 'declined'           => ( init_arg => undef, is => 'rw' );
has 'declined_paths'     => ( default => sub { {} } );
has 'go_result'          => ( init_arg => undef );
has 'id'                 => ( init_arg => undef, default => sub { $next_id++ } );
has 'output'             => ( init_arg => undef, default => '' );
has 'page'               => ( init_arg => undef );
has 'path_info'          => ( init_arg => undef, default => '' );
has 'request_args'       => ( init_arg => undef );
has 'request_code_cache' => ( init_arg => undef, default => sub { {} } );
has 'request_path'       => ( init_arg => undef );
has 'result'             => ( init_arg => undef, lazy_build => 1 );
has 'run_params'         => ( init_arg => undef );

# Globals, localized to each request
#
our ( $current_request, $current_buffer );
method current_request () { $current_request }

#
# BUILD
#

method BUILD ($params) {

    # Make a copy of params sans interp
    #
    $self->{orig_request_params} = $params;
    delete( $self->{orig_request_params}->{interp} );
}

method _build_result () {
    return $self->interp->result_class->new;
}

#
# PUBLIC METHODS
#

method abort ($aborted_value) {
    Mason::Exception::Abort->throw(
        error         => 'Request->abort was called',
        aborted_value => $aborted_value
    );
}

method aborted ($err) {
    return blessed($err) && $err->isa('Mason::Exception::Abort');
}

method add_cleanup ($code) {
    push( @{ $self->{cleanups} }, $code );
}

method cache () {
    die 'caching is now in the cache plugin (Mason::Plugin::Cache)';
}

method capture ($code) {
    croak "capture() expects a code reference" unless defined($code) && ref($code) eq 'CODE';
    my $output;
    {
        $self->_push_buffer;
        scope_guard { $output = ${ $self->_current_buffer }; $self->_pop_buffer; };
        $code->();
    }
    return $output;
}

method clear_and_abort () {
    $self->clear_buffer;
    $self->abort(@_);
}

method clear_buffer () {
    foreach my $buffer ( @{ $self->buffer_stack } ) {
        $$buffer = '';
    }
}

method comp () {
    $self->construct(@_)->main();
}

method comp_exists ($path) {
    return $self->interp->comp_exists( $self->rel_to_abs($path) );
}

method construct () {
    my $path  = shift;
    my $compc = $self->load($path)
      or $self->_comp_not_found($path);
    return $compc->new( @_, 'm' => $self );
}

method current_comp_class () {
    my $cnt = 1;
    while (1) {
        if ( my $pkg = ( caller($cnt) )[0] ) {
            return $pkg if $pkg->isa('Mason::Component') && $pkg ne 'Mason::Component';
        }
        else {
            confess("cannot determine current_comp_class from stack");
        }
        $cnt++;
    }
}

method decline () {
    $self->declined(1);
    $self->clear_and_abort;
}

method filter () {
    $self->_apply_filters(@_);
}

method flush_buffer () {
    my $request_buffer = $self->_request_buffer;
    $self->process_output($request_buffer);
    $self->out_method->( $$request_buffer, $self )
      if length $$request_buffer;
    $$request_buffer = '';
}

method go () {
    $self->clear_buffer;
    my %request_params = ( %{ $self->{orig_request_params} } );
    if ( ref( $_[0] ) eq 'HASH' ) {
        %request_params = ( %request_params, %{ shift(@_) } );
    }
    $self->{go_result} = $self->_run_subrequest( \%request_params, @_ );
    $self->abort();
}

method load ($path) {
    my $compc = $self->interp->load( $self->rel_to_abs($path) );
}

method log () {
    return $self->current_comp_class->cmeta->log();
}

method notes () {
    return $self->{notes}
      unless @_;
    my $key = shift;
    return $self->{notes}->{$key} unless @_;
    return $self->{notes}->{$key} = shift;
}

method print () {
    my $buffer = $self->_current_buffer;
    for (@_) {
        $$buffer .= $_ if defined;
    }
}

method rel_to_abs ($path) {
    $path = join( "/", $self->current_comp_class->cmeta->dir_path, $path )
      unless substr( $path, 0, 1 ) eq '/';
    return $path;
}

method scomp () {
    my @params = @_;
    my $buf = $self->capture( sub { $self->comp(@params) } );
    return $buf;
}

method visit () {
    my $buf;
    my %request_params = ( %{ $self->{orig_request_params} }, out_method => \$buf );
    if ( ref( $_[0] ) eq 'HASH' ) {
        %request_params = ( %request_params, %{ shift(@_) } );
    }
    my $result = $self->_run_subrequest( \%request_params, @_ );
    $self->print($buf);
    return $result;
}

#
# MODIFIABLE METHODS
#

method cleanup_request () {
    $self->interp->_flush_load_cache();
    foreach my $cleanup ( @{ $self->{cleanups} } ) {
        try {
            $cleanup->($self);
        }
        catch {
            warn "error during request cleanup: $_";
        };
    }
}

method construct_page_component ($compc, $args) {
    return $compc->new( %$args, 'm' => $self );
}

method catch_abort ($code) {
    my $retval;
    try {
        $retval = $code->();
    }
    catch {
        my $err = $_;
        if ( $self->aborted($err) ) {
            $retval = $err->aborted_value;
        }
        else {
            die $err;
        }
    };
    return $retval;
}

method match_request_path ($request_path) {
    $self->interp->match_request_path->( $self, $request_path );
}

method process_output ($outref) {

    # No-op by default
}

method run () {

    # Get path and either hash or hashref of arguments
    #
    my $request_path = shift;
    $self->interp->_assert_absolute_path($request_path);
    my $request_args;
    if ( @_ == 1 && reftype( $_[0] ) eq 'HASH' ) {
        $request_args = shift;
    }
    else {
        $request_args = {@_};
    }

    # Save off the requested path and args
    #
    $self->{request_path} = $request_path;
    $self->{request_args} = $request_args;

    # Localize current_request and current_buffer until end of scope. Use a guard
    # because 'local' doesn't work with the aliases inside components.
    #
    my $save_current_request = $current_request;
    my $save_current_buffer  = $current_buffer;
    scope_guard { $current_request = $save_current_request; $current_buffer = $save_current_buffer };
    $current_request = $self;
    $self->_push_buffer();

    # Clean up after request
    #
    scope_guard { $self->cleanup_request() };

    # Flush interp load cache
    #
    $self->interp->_flush_load_cache();

    # Check the static_source touch file, if it exists, before the
    # first component is loaded.
    #
    $self->interp->_check_static_source_touch_file();

    # Turn request path into a page component
    #
  match_request_path:
    my $page_path  = $self->match_request_path($request_path);
    my $page_compc = $self->interp->load($page_path);
    $log->debugf( "starting request with component '%s'", $page_path )
      if $log->is_debug;

    $self->catch_abort(
        sub {

            # Construct page component
            #
            my $page = $self->construct_page_component( $page_compc, $request_args );
            $self->{page} = $page;

            # Dispatch to page component, with 'print' tied to component output.
            #
            $self->with_tied_print( sub { $page->handle } );
        }
    );

    # If declined, retry match
    #
    if ( $self->declined ) {
        $self->declined(0);
        $self->{declined_paths}->{$page_path} = 1;
        goto match_request_path;
    }

    # If go() was called in this request, return the result of the subrequest
    #
    return $self->go_result if defined( $self->go_result );

    # Send output to its final destination
    #
    $self->flush_buffer;

    return $self->result;
}

method with_tied_print ($code) {
    local *TH;
    tie *TH, 'Mason::TieHandle';
    my $old = select TH;
    scope_guard { select $old };
    return $code->();
}

#
# PRIVATE METHODS
#

method _apply_one_filter ($filter, $yield) {
    my $filtered_output;
    if ( ref($yield) ne 'CODE' ) {
        my $orig_yield = defined($yield) ? $yield : '';
        $yield = sub { $orig_yield };
    }
    if ( ref($filter) eq 'CODE' ) {
        local $_ = $yield->();
        $_ = '' if !defined($_);
        $filtered_output = $filter->($_);
    }
    elsif ( blessed($filter) && $filter->can('apply_filter') ) {
        $filtered_output = $filter->apply_filter($yield);
    }
    else {
        die "'$filter' is neither a code ref nor a filter object";
    }
    return $filtered_output;
}

method _apply_filters () {
    my $yield = pop(@_);
    if ( ref($yield) ne 'CODE' ) {
        my $orig_yield = defined($yield) ? $yield : '';
        $yield = sub { $orig_yield };
    }
    if ( !@_ ) {
        return $yield->();
    }
    else {
        my $filter = pop(@_);
        return $self->_apply_filters( @_, sub { $self->_apply_one_filter( $filter, $yield ) } );
    }
}

method _apply_filters_to_output () {
    my $output_method = pop(@_);
    my $yield         = sub {
        my @args = @_;
        $self->capture( sub { $output_method->(@args) } );
    };
    my $filtered_output = $self->_apply_filters( @_, $yield );
    $self->print($filtered_output);
}

method _comp_not_found ($path) {
    croak sprintf( "could not find component for path '%s' - component root is [%s]",
        $path, join( ", ", @{ $self->interp->comp_root } ) );
}

method _current_buffer () {
    $self->{buffer_stack}->[-1];
}

method _pop_buffer () {
    pop( @{ $self->{buffer_stack} } );
    $current_buffer = $self->_current_buffer;
}

method _push_buffer () {
    my $s = '';
    push( @{ $self->{buffer_stack} }, \$s );
    $current_buffer = \$s;
}

method _request_buffer () {
    $self->{buffer_stack}->[0];
}

method _reset_next_id () {

    # for testing
    $next_id = 0;
}

method _run_subrequest () {
    my $request_params = shift(@_);
    my $path           = $self->rel_to_abs( shift(@_) );
    $self->interp->run( $request_params, $path, @_ );
}

__PACKAGE__->meta->make_immutable();

1;

__END__

=pod

=head1 NAME

Mason::Request - Mason Request Class

=head1 SYNOPSIS

    $m->abort (...)
    $m->comp (...)
    etc.

=head1 DESCRIPTION

Mason::Request represents a single request for a page, and is the access point
for most Mason features not provided by syntactic tags.

A Mason request is created when you call C<< $interp->run >>, or in a web
environment, for each new web request. A new (sub-)request is also created when
you call L<visit|/visit> or L<go|/go> on the current request.

Inside a component you can access the current request object via the global
C<$m>.  Outside of a component, you can use the class method
C<Mason::Request-E<gt>current_request>.

=head1 COMPONENT PATHS

The methods L<comp|/comp>, L<comp_exists|/comp_exists>,
L<construct|/construct>, L<go|/go>, L<load|/load>, and L<visit|/visit> take a
component path argument. If the path does not begin with a '/', then it is made
absolute based on the current component path (using L<rel_to_abs|/rel_to_abs>).

Component paths are like URL paths, and always use a forward slash (/) as the
separator, regardless of what your operating system uses.

=head1 PARAMETERS TO THE new() CONSTRUCTOR

These parameters would normally be passed in an initial hashref to  C<<
$interp->run >>, C<< $m->visit >>, or C<< $m->go >>.

=over

=item out_method

Indicates where to send the page output. If out_method is a scalar reference,
output is appended to the scalar.  If out_method is a code reference, the code
is called with the output string. For example, to send output to a file called
"mason.out":

    open(my $fh, ">", "mason.out);
    ...
    out_method => sub { $fh->print($_[0]) }

When C<out_method> is unspecified, the output can be obtained from the
L<Mason::Result|Mason::Result> object returned from C<< $interp->run >>.

=back

=head1 PUBLIC METHODS

=over

=item abort ()

Ends the current request, finishing the page without returning through
components.

C<abort> is implemented by throwing an C<Mason::Exception::Abort> object and
can thus be caught by C<eval>. The C<aborted> method is a shortcut for
determining whether a caught error was generated by C<abort>.

=item aborted ([$err])

Returns true or undef indicating whether the specified C<$err> was generated by
C<abort>. If no C<$err> was passed, uses C<$@>.

In this L<Try::Tiny|Try::Tiny> code, we catch and process fatal errors while
letting C<abort> exceptions pass through:

    try {
        code_that_may_fail_or_abort()
    } catch {
        die $_ if $m->aborted($_);
        # handle fatal errors...
    };

=item add_cleanup (code)

Add a code reference to be executed when the request is L<cleaned
up|/cleanup_request>.

=item clear_and_abort ()

This method is syntactic sugar for calling C<clear_buffer()> and then
C<abort()>.  If you are aborting the request because of an error (or, in a web
environment, to do a redirect), you will often want to clear the buffer first
so that any output generated up to that point is not sent to the client.

=item capture (code)

Execute the I<code>, capturing and returning any Mason output instead of
outputting it. e.g. the following

    my $buf = $m->capture(sub { $m->comp('/foo') });

is equivalent to

    my $buf = $m->scomp('/foo');

=item clear_buffer ()

Clears the Mason output buffer. Any output sent before this line is discarded.
Useful for handling error conditions that can only be detected in the middle of
a request.

clear_buffer is, of course, thwarted by L<flush_buffer|/flush_buffer>.

=item comp (path[, params ...])

Creates a new instance of the component designated by I<path>, and calls its
C<main> method. I<params>, if any, are passed to the constructor.

The C<< <& &> >> tag provides a shortcut for C<$m-E<gt>comp>.

=item comp_exists (path)

Makes the component I<path> absolute if necessary, and calls L<Interp
comp_exists|Mason::Interp/comp_exists> to determine whether a component exists
at that path.

=item current_comp_class ()

Returns the current component class. This is determined by walking up the Perl
caller() stack until the first Mason::Component subclass is found.

=item current_request ()

This class method returns the C<Mason::Request> currently in use.  If called
when no Mason request is active it will return C<undef>.

=item construct (path[, params ...])

Constructs and return a new instance of the component designated by I<path>.
I<params>, if any, are passed to the constructor. Throws an error if I<path>
does not exist.

=item decline ()

Clears the output buffer and tries the current request again, but acting as if
the previously chosen page component(s) do not exist.

For example, if the following components exist:

    /news/sports.mc
    /news/dhandler.mc
    /dhandler.mc

then a request for path C</news/sports> will initially resolve to
C</news/sports.mc>.  A call to C<< $m->decline >> would restart the request and
resolve to C</news/dhandler.mc>, a second C<< $m->decline >> would resolve to
C</dhandler.mc>, and a third would throw a "not found" error.

=item filter (filter_expr, [filter_expr...], string|coderef)

Applies one or more filters to a string or to a coderef that returns a string.

    my $filtered_string = $m->filter($.Trim, $.NoBlankLines, $string);

=item flush_buffer ()

Flushes the main output buffer. Anything currently in the buffer is sent to the
request's L<out_method|/out_method>.

Note that anything output within a C<< $m->scomp >> or C<< $m->capture >> will
not have made it to the main output buffer, and thus cannot be flushed.

=item go ([request params], path, args...)

Performs an internal redirect. Clears the output buffer, runs a new request for
the given I<path> and I<args>, and then L<aborts|/abort> when that request is
done.

The first argument may optionally be a hashref of parameters which are passed
to the C<Mason::Request> constructor.

See also L<visit|/visit>.

=item interp ()

Returns the L<Interp|Mason::Interp> object associated with this request.

=item load (path)

Makes the component I<path> absolute if necessary, and calls L<Interp
load|Mason::Interp/load> to load the component class associated with the path.

=item log ()

Returns a C<Log::Any> logger with a log category specific to the current
component.  The category for a component "/foo/bar" would be
"Mason::Component::foo::bar".

=item notes ([key[, value]])

The C<notes()> method provides a place to store application data between
components - essentially, a hash which persists for the duration of the
request.

C<notes($key, $value)> stores a new entry in the hash; C<notes($key)> returns a
previously stored value; and C<notes()> without any arguments returns a
reference to the entire hash of key-value pairs.

Consider storing this kind of data in a read-write attribute of the page
component.

=item print (string)

Add the given I<string> to the Mason output buffer. This happens implicitly for
all content placed in the main component body.

=item page ()

Returns the page component originally called in the request.

=item path_info ()

Returns the remainder of the request path beyond the path of the page
component, with no leading slash. e.g. If a request for '/foo/bar/baz' resolves
to "/foo.mc", the path_info is "bar/baz". For an exact match, it will contain
the empty string (never undef), so you can determine whether there's a
path_info with

    if ( length($m->path_info) )

=item rel_to_abs (path)

Converts a component I<path> to absolute form based on the current component,
if it does not already begin with a '/'.

=item request_args ()

Returns the original hashref of arguments passed to the request, e.g. via C<<
$interp->run >>.

=item request_path ()

Returns the original path passed to the request, e.g. in C<< $interp->run >>.

=item scomp (comp, args...)

Like L<comp|Mason::Request/item_comp>, but returns the component output as a
string instead of printing it. (Think sprintf versus printf.)

See also L<capture|/capture>.

=item visit ([request params], path, args...)

Performs a subrequest with the given I<path> and I<args>, with output being
sent to the current output buffer.

The first argument may optionally be a hashref of parameters which are passed
to the C<Mason::Request> constructor. e.g. to capture the output of the
subrequest:

    $m->visit({out_method => \my $buffer}, ...);

See also L<go|/go>.

=back

=head1 MODIFIABLE METHODS

These methods are not intended to be called externally, but may be useful to
modify with method modifiers in L<plugins|Mason::Manual::Plugins> and
L<subclasses|Mason::Manual::Subclasses>. Their APIs will be kept as stable as
possible.

=over

=item cleanup_request ()

A place to perform cleanup duties when the request finishes or dies with an
error, even if the request object is not immediately destroyed. Includes
anything registered with L<add_cleanup|/add_cleanup>.

=item construct_page_component ($compc, $args)

Constructs the page component of class I<$compc>, with hashref of constructor
arguments I<$args>.

=item match_request_path ($request_path)

Given a top level I<$request_path>, return a corresponding component path or
undef if none was found. Search includes dhandlers and index files. See
L<Mason::Manual::RequestDispatch>.

=item process_output ($outref)

This method is called on the output buffer right before it is sent to its final
destination. I<$outref> is a reference to the output string; the method can
modify it as desired.

=item run ($request_path, args)

Runs the request with I<$request_path> and I<args>, where the latter can be
either a hashref or a hash. This is generally called via << $interp->run >>.

=item with_tied_print ($code)

Execute the given I<$code> with the current selected filehandle ('print') tied
to the Mason output stream. You could disable the filehandle selection by
overriding this to just call I<$code>.

=back

=head1 SEE ALSO

L<Mason|Mason>

=head1 AUTHOR

Jonathan Swartz <swartz@pobox.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Jonathan Swartz.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut