File: Root.pm

package info (click to toggle)
libcatalyst-perl 5.90132-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,016 kB
  • sloc: perl: 11,061; makefile: 7
file content (146 lines) | stat: -rw-r--r-- 3,568 bytes parent folder | download | duplicates (6)
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
package TestApp::Controller::Root;
use strict;
use warnings;
use base 'Catalyst::Controller';
use utf8;

__PACKAGE__->config->{namespace} = '';

sub chain_root_index : Chained('/') PathPart('') Args(0) { }

sub zero : Path('0') {
    my ( $self, $c ) = @_;
    $c->res->header( 'X-Test-Class' => ref($self) );
    $c->response->content_type('text/plain; charset=utf-8');
    $c->forward('TestApp::View::Dump::Request');
}

sub zerobody : Local {
    my ($self, $c) = @_;
    $c->res->body('0');
}

sub emptybody : Local {
    my ($self, $c) = @_;
    $c->res->body('');
}

sub index : Private {
    my ( $self, $c ) = @_;
    $c->res->body('root index');
}

sub global_action : Private {
    my ( $self, $c ) = @_;
    $c->forward('TestApp::View::Dump::Request');
}

sub class_forward_test_method :Private {
    my ( $self, $c ) = @_;
    $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
}

sub loop_test : Local {
    my ( $self, $c ) = @_;

    for( 1..1001 ) {
        $c->forward( 'class_forward_test_method' );
    }
}

sub recursion_test : Local {
    my ( $self, $c ) = @_;
    no warnings 'recursion';
    $c->forward( 'recursion_test' );
}

sub base_href_test : Local {
    my ( $self, $c ) = @_;

    my $body = <<"EndOfBody";
<html>
  <head>
    <base href="http://www.example.com/">
  </head>
  <body>
  </body>
</html>
EndOfBody

    $c->response->body($body);
}

sub body_semipredicate : Local {
    my ($self, $c) = @_;
    $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
    $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
    $c->res->body('Body');
}


sub test_redirect :Global {
    my ($self, $c) = @_;
    # Don't set content_type
    # Don't set body
    $c->res->redirect('/go_here');
    # route for /go_here doesn't exist
    # it is only for checking HTTP response code, content-type etc.
}

sub test_redirect_uri_for :Global {
    my ($self, $c) = @_;
    # Don't set content_type
    # Don't set body
    $c->res->redirect($c->uri_for('/go_here'));
    # route for /go_here doesn't exist
    # it is only for checking HTTP response code, content-type etc.
}

sub test_redirect_with_contenttype :Global {
    my ($self, $c) = @_;
    # set content_type but don't set body
    $c->res->content_type('image/jpeg');
    $c->res->redirect('/go_here');
    # route for /go_here doesn't exist
    # it is only for checking HTTP response code, content-type etc.
}

sub test_redirect_with_content :Global {
    my ($self, $c) = @_;
    $c->res->content_type('text/plain');
    $c->res->body('Please kind sir, I beg you to go to /go_here.');
    $c->res->redirect('/go_here');
    # route for /go_here doesn't exist
    # it is only for checking HTTP response code, content-type etc.
}

sub test_remove_body_with_304 :Global {
    my ($self, $c) = @_;
    $c->res->status(304);
    $c->res->content_type('text/html');
    $c->res->body("<html><body>Body should not be set</body></html>");
}

sub test_remove_body_with_204 :Global {
    my ($self, $c) = @_;
    $c->res->status(204);
    $c->res->content_type('text/html');
    $c->res->body("<html><body>Body should not be set</body></html>");
}

sub test_remove_body_with_100 :Global {
    my ($self, $c) = @_;
    $c->res->status(100);
    $c->res->body("<html><body>Body should not be set</body></html>");
}

sub test_nobody_with_100 :Global {
    my ($self, $c) = @_;
    $c->res->status(100);
}

sub end : Private {
    my ($self,$c) = @_;
}

1;