EOP
-print OUT '$VERSION = '.MM->parse_version('version.pm').";\n\n";
+print OUT '$VERSION = q{'.MM->parse_version('version.pm')."};\n\n";
print OUT "bootstrap FCGI;\n" unless ($pure);
+print OUT '$VERSION = eval $VERSION;';
+
print OUT <<'EOP' if ($pure);
use Symbol;
use POSIX 'ENOTCONN';
use constant FILTER => 3;
%FCGI::rolenames = (RESPONDER, "RESPONDER",
- AUTHORIZER, "AUTHORIZER",
- FILTER, "FILTER",
- );
+ AUTHORIZER, "AUTHORIZER",
+ FILTER, "FILTER",
+ );
# This only works on Unix; anyone familiar with Windows is welcome
# to give a hand here
sub IsFastCGI {
my ($req) = @_;
$req->{isfastcgi} =
- (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
- unless exists $req->{isfastcgi};
+ (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
+ unless exists $req->{isfastcgi};
return $req->{isfastcgi};
}
return undef unless read $stream, $buf, 1, 0;
my ($len) = unpack("C", $buf);
if ($len & 0x80) {
- $buf = pack("C", $len & 0x7F);
- return undef unless read $stream, $buf, 3, 1;
- $len = unpack("N", $buf);
+ $buf = pack("C", $len & 0x7F);
+ return undef unless read $stream, $buf, 3, 1;
+ $len = unpack("N", $buf);
}
$len;
}
sub RequestX {
my $self = {
- in => shift,
- out => shift,
- err => shift,
- env => shift,
- socket => shift,
- flags => shift,
- last => 0,
+ in => shift,
+ out => shift,
+ err => shift,
+ env => shift,
+ socket => shift,
+ flags => shift,
+ last => 0,
};
open $self->{listen_sock}, "<&=0";
bless $self, "FCGI";
my ($req) = @_;
unless ($req->IsFastCGI()) {
- return -1 if $run_once;
+ return -1 if $run_once;
- $run_once = 1;
- return 0;
+ $run_once = 1;
+ return 0;
}
$req->Finish();
$req->{socket} = gensym();
if ($req->{last} || !accept($req->{socket}, $req->{listen_sock})) {
- $req->{error} = "accept";
- return -1;
+ $req->{error} = "accept";
+ return -1;
}
my ($type, $id, $body) = $req->read_record();
if ($type != BEGIN_REQUEST) {
- $req->{error} = "begin request";
- return -1;
+ $req->{error} = "begin request";
+ return -1;
}
my ($role, $flags) = unpack("nC", $body);
$req->{role} = $role;
my $param = FCGI::Stream->new($req, PARAMS);
my ($nlen, $vlen);
while (defined($nlen = read_nv_len($param)) &&
- defined($vlen = read_nv_len($param))) {
- my ($name, $val);
- read $param, $name, $nlen;
- read $param, $val, $vlen;
- $req->{env}{$name} = $val;
+ defined($vlen = read_nv_len($param))) {
+ my ($name, $val);
+ read $param, $name, $nlen;
+ read $param, $val, $vlen;
+ $req->{env}{$name} = $val;
}
$req->Bind;
$req->{accepted} = 1;
my ($req) = @_;
return unless $req->{accepted};
if ($req->{bound}) {
- $req->UndoBindings();
- # apparently these are harmful
- # close ${$req->{out}};
- # close ${$req->{err}};
+ $req->UndoBindings();
+ # apparently these are harmful
+ # close ${$req->{out}};
+ # close ${$req->{err}};
}
$req->{accepted} = 0;
}
sub read {
my ($self, $rtype, $len) = @_;
while (length $self->{buf} < $len) {
- my ($type, $id, $buf) = $self->read_record();
- return undef unless defined $buf;
- if ($type != $rtype) {
- $self->{error} = "unexpected stream type";
- return 0;
- }
- $self->{buf} .= $buf;
+ my ($type, $id, $buf) = $self->read_record();
+ return undef unless defined $buf;
+ if ($type != $rtype) {
+ $self->{error} = "unexpected stream type";
+ return 0;
+ }
+ $self->{buf} .= $buf;
}
my ($newbuf, $result) = (substr($self->{buf}, $len),
- substr($self->{buf}, 0, $len));
+ substr($self->{buf}, 0, $len));
$self->{buf} = $newbuf;
$result;
}
my ($self, $type, $content, $length) = @_;
my $offset = 0;
while ($length > 0) {
- my $len = $length > 32*1024 ? 32*1024 : $length;
- my $padlen = (8 - ($len % 8)) % 8;
- my $templ = "CCnnCxa${len}x$padlen";
- my $data = pack($templ,
- VERSION_1, $type, $self->{id}, $len, $padlen,
- substr($content, $offset, $len));
- syswrite $self->{socket}, $data;
- $length -= $len;
- $offset += $len;
+ my $len = $length > 32*1024 ? 32*1024 : $length;
+ my $padlen = (8 - ($len % 8)) % 8;
+ my $templ = "CCnnCxa${len}x$padlen";
+ my $data = pack($templ,
+ VERSION_1, $type, $self->{id}, $len, $padlen,
+ substr($content, $offset, $len));
+ syswrite $self->{socket}, $data;
+ $length -= $len;
+ $offset += $len;
}
}
sub PRINT {
my ($stream) = shift;
for (@_) {
- $stream->{src}->write($stream->{type}, $_, length($_));
+ $stream->{src}->write($stream->{type}, $_, length($_));
}
+ return 1;
}
sub CLOSE {
*FAIL_ACCEPT_ON_INTR = sub() { 1 };
sub Request(;***$*$) {
- my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, 0);
+ my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR());
$_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
splice @defaults,0,@_,@_;
RequestX(@defaults);
sub accept() {
warn "accept called as a method; you probably wanted to call Accept" if @_;
- if (defined %FCGI::ENV) {
- %ENV = %FCGI::ENV;
+ if (%FCGI::ENV) {
+ %ENV = %FCGI::ENV;
} else {
- %FCGI::ENV = %ENV;
+ %FCGI::ENV = %ENV;
}
my $rc = Accept($global_request);
for (keys %FCGI::ENV) {
- $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
+ $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
}
# not SFIO
sub finish() {
warn "finish called as a method; you probably wanted to call Finish" if @_;
- %ENV = %FCGI::ENV if (defined %FCGI::ENV);
+ %ENV = %FCGI::ENV if %FCGI::ENV;
# not SFIO
if (tied (*STDIN)) {
- delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
- delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
+ delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
+ delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
}
Finish ($global_request);
$c = $stream->GETC();
if ($/ eq '') {
- while ($c eq "\n") {
- $c = $stream->GETC();
- }
+ while ($c eq "\n") {
+ $c = $stream->GETC();
+ }
}
while (defined $c) {
- $s .= $c;
- last if $c eq $l and substr($s, -$len) eq $rs;
- $c = $stream->GETC();
+ $s .= $c;
+ last if $c eq $l and substr($s, -$len) eq $rs;
+ $c = $stream->GETC();
}
$s;
}
sub OPEN {
$_[0]->CLOSE;
if (@_ == 2) {
- return open($_[0], $_[1]);
+ return open($_[0], $_[1]);
} else {
- my $rc;
- eval("$rc = open($_[0], $_[1], $_[2])");
- die $@ if $@;
- return $rc;
+ my $rc;
+ eval("$rc = open($_[0], $_[1], $_[2])");
+ die $@ if $@;
+ return $rc;
}
}
my $request = FCGI::Request();
while($request->Accept() >= 0) {
- print("Content-type: text/html\r\n\r\n", ++$count);
+ print("Content-type: text/html\r\n\r\n", ++$count);
}
=head1 DESCRIPTION
=item error perl file handle (default: \*STDERR)
These filehandles will be setup to act as input/output/error
-on succesful Accept.
+on successful Accept.
=item environment hash reference (default: \%ENV)
=back
+=HEAD1 LIMITATIONS
+
+FCGI.pm isn't Unicode aware, only characters within the range 0x00-0xFF are
+supported. Attempts to output strings containing characters above 0xFF results
+in a exception: (F) C<Wide character in %s>.
+
+Users who wants the previous (FCGI.pm <= 0.68) incorrect behavior can disable the
+exception by using the C<bytes> pragma.
+
+ {
+ use bytes;
+ print "\x{263A}";
+ }
+
+
=head1 AUTHOR
Sven Verdoolaege <skimo@kotnet.org>
projects / catagits/fcgi2.git / blobdiff