root/trunk/lib/Mungo/Response.pm

Revision 2, 5.4 kB (checked in by jesus, 7 years ago)

Initial import from Theo's private repository. From here on out it is open to the world.

Line 
1 package Mungo::Response;
2
3 # Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
4 # For information on licensing see:
5 #   https://labs.omniti.com/zetaback/trunk/LICENSE
6
7 use strict;
8 use Carp;
9 use IO::Handle;
10 use Mungo::Arbiter::Response;
11 use Mungo::Response::Trap;
12 use Mungo::Cookie;
13 our $AUTOLOAD;
14
15 my $one_true_buffer = '';
16
17 sub new {
18   my $class = shift;
19   my $parent = shift;
20   my $r = $parent->{'Apache::Request'};
21   my $singleton = $r->pnotes(__PACKAGE__);
22   return $singleton if ($singleton);
23   my %core_data = (
24     'Apache::Request' => $r,
25     'ContentType' => $r->dir_config('MungoContentType') || 'text/html',
26     # We don't set buffer here, we set it after it has been tied.
27     # 'Buffer' => $r->dir_config('MungoBuffer') || 0,
28     'Buffer' => 0,
29     'CacheControl' => $r->dir_config('MungoCacheControl') || 'private',
30     'Charset' => $r->dir_config('MungoCharset') || undef,
31     'Status' => 200,
32     'Mungo' => $parent,
33     'CookieClass' => $r->dir_config('MungoCookieClass') || 'Mungo::Cookie',
34     'Cookies' => undef, # placeholder for visibility
35   );
36   my %data;
37   $singleton = bless \%data, $class;
38   tie %data, 'Mungo::Arbiter::Response', $singleton, \%core_data;
39   $singleton->{Buffer} = $r->dir_config('MungoBuffer') || 0;
40   $r->pnotes(__PACKAGE__, $singleton);
41   return $singleton;
42 }
43
44 sub DESTROY {
45   my $self = shift;
46   $self->cleanse();
47 }
48
49 sub cleanse {
50   my $self = shift;
51   if(ref $self->{'IO_stack'} eq 'ARRAY') {
52     while (@{$self->{'IO_stack'}}) {
53       my $fh = pop @{$self->{'IO_stack'}};
54       close(select($fh));
55     }
56   }
57   delete $self->{$_} for keys %$self;
58   untie %$self if tied %$self;
59 }
60
61 sub send_http_header {
62   my $self = shift;
63   my $r = $self->{'Apache::Request'};
64   return if($self->{'__HEADERS_SENT__'});
65   $self->{'__HEADERS_SENT__'} = 1;
66   if($self->{CacheControl} eq 'no-cache') {
67     $r->no_cache(1);
68   }
69   else {
70     $r->header_out('Cache-Control', $self->{CacheControl});
71   }
72   $self->{Cookies}->inject_headers($r);
73   $r->status($self->{Status});
74   $r->send_http_header($self->{ContentType});
75 }
76
77 sub start {
78   my $self = shift;
79   return if(exists $self->{'IO_stack'} &&
80             scalar(@{$self->{'IO_stack'}}) > 0);
81   $self->{'IO_stack'} = [];
82   tie *DIRECT, ref $self, $self;
83   push @{$self->{'IO_stack'}}, select(DIRECT);
84 }
85
86 sub finish {
87   my $self = shift;
88   # Unbuffer outselves, this will actually induce a flush
89   $self->{Buffer} = 0;
90   untie *DIRECT if tied *DIRECT;
91   return unless(exists $self->{'IO_stack'});
92   my $fh = $self->{'IO_stack'}->[0];
93   delete $self->{'IO_stack'};
94   die __PACKAGE__." IO stack of wrong depth" if(scalar(@{$self->{'IO_stack'}}) != 1);
95 }
96
97 sub AddHeader {
98   my $self = shift;
99   my $r = $self->{'Apache::Request'};
100   die "Headers already sent." if($self->{'__HEADERS_SENT__'});
101   $r->header_out(@_);
102 }
103 sub Cookies {
104   my $self = shift;
105   die "Headers already sent." if($self->{'__HEADERS_SENT__'});
106   my $cookie = $self->{'Cookies'};
107   $cookie->__set(@_);
108 }
109 sub Redirect {
110   my $self = shift;
111   my $url = shift;
112   die "Cannot redirect, headers already sent\n" if($self->{'__HEADERS_SENT__'});
113   $self->{Status} = shift || 302;
114   $self->{'Apache::Request'}->header_out('Location', $url);
115   $self->send_http_header();
116   $self->End();
117 }
118 sub Include {
119   my $self = shift;
120   my $subject = shift;
121   my $rv;
122   eval {
123     if(ref $subject) {
124       $rv = $self->{'Mungo'}->include_mem($subject, @_);
125     }
126     else {
127       $rv = $self->{'Mungo'}->include_file($subject, @_);
128     }
129   };
130   if($@) {
131     print "<pre>Error: $@\n\n".Carp::shortmess()."\n</pre>\n";;
132     return undef;
133   }
134   return $rv;
135 }
136 sub TrapInclude {
137   my $self = shift;
138   my $output;
139   my $handle = \do { local *HANDLE };
140   tie *{$handle}, 'Mungo::Response::Trap', \$output;
141   push @{$self->{'IO_stack'}}, select(*{$handle});
142   eval {
143     $self->Include(@_);
144   };
145   untie *{$handle} if tied *{$handle};
146   select(pop @{$self->{'IO_stack'}});
147   die $@ if $@;
148   return $output;
149 }
150 sub End {
151   shift->Flush();
152   eval { goto MUNGO_HANDLER_FINISH; };
153 }
154 sub Flush {
155   my $self = shift;
156   # Flush doesn't apply unless we're immediately above STDOUT
157   return if(scalar(@{$self->{'IO_stack'}}) > 1);
158   unless($self->{'__OUTPUT_STARTED__'}) {
159     $self->send_http_header;
160     $self->{'__OUTPUT_STARTED__'} = 1;
161   }
162   $self->{'IO_stack'}->[-1]->print($one_true_buffer);
163   $one_true_buffer = '';
164 }
165
166 sub AUTOLOAD {
167   my $self = shift;
168   my $name = $AUTOLOAD;
169   $name =~ s/.*://;   # strip fully-qualified portion
170   die __PACKAGE__." AUTOLOAD($name)" unless(ref $self);
171   return undef;
172 }
173
174 sub TIEHANDLE {
175   my $class = shift;
176   my $self = shift;
177   return $self;
178 }
179 sub PRINT {
180   my $self = shift;
181   my $output = shift;
182   if(scalar(@{$self->{'IO_stack'}}) == 1) {
183     # Buffering a just-in-time headers only applies if we
184     # immediately above STDOUT
185     if($self->{Buffer}) {
186       $one_true_buffer .= $output;
187       return;
188     }
189     unless($self->{'__OUTPUT_STARTED__'}) {
190       $self->{'__OUTPUT_STARTED__'} = 1;
191       $self->send_http_header;
192     }
193   }
194   $self->{'IO_stack'}->[-1]->print($output);
195 }
196 sub PRINTF {
197   my $self = shift;
198   if(scalar(@{$self->{'IO_stack'}}) == 1) {
199     # Buffering a just-in-time headers only applies if we
200     # immediately above STDOUT
201     if($self->{Buffer}) {
202       $one_true_buffer .= sprintf(@_);
203       return;
204     }
205     unless($self->{'__OUTPUT_STARTED__'}) {
206       $self->{'__OUTPUT_STARTED__'} = 1;
207       $self->send_http_header;
208     }
209   }
210   $self->{'IO_stack'}->[-1]->printf(@_);
211 }
212 sub CLOSE {
213   my $self = shift;
214   $self->{Buffer} = 0;
215 }
216 sub UNTIE { }
217
218 1;
Note: See TracBrowser for help on using the browser.