The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ANDK / CGI-XA-0.22303-alpha / lib / Apache / CGI.pm 

            

              
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

              
package Apache::CGI;
require Apache;
#require Apache::TieHandle;
#CGI->require_version(2.22);
use vars qw(@ISA $VERSION);
eval {require CGI::XA;};
if ($@) {
    $CGI::DefaultClass = 'CGI';
    require CGI;
    @ISA = qw(CGI); # maybe 
} else {
    @ISA = qw(CGI::XA);
}
$VERSION = "0.11301-alpha";
sub new {
    my($class) = shift;
    #tie *STDOUT => 'Apache::TieHandle';
    %ENV = Apache->request->cgi_env;
    my $self = $class->SUPER::new(@_);
    $self->{'.req'} = Apache->request;
    $self;
}
sub header {
    my $self = shift;
    my $r = $self->{'.req'};
    $r->basic_http_header;
    return $self->CGI::XA::header(@hdrs);
}                    
sub print {
    my($self) = shift;
    $self->{'.req'}->write_client(@_);
}
sub read_from_client {
    my($self, $fh, $buff, $len, $offset) = @_;
    my $r = $self->{'.req'} || Apache->request;
    my($own_buffer,$ret);
    # A.K.: unfortunately I couldn't find a way without our own buffer
    $ret = $r->read_client_block($own_buffer, $len);
#    my $own_len = length($own_buffer);
    if ($offset) {
        substr($$buff,$offset) = substr($own_buffer,0,$ret);
    } else {
        $$buff = substr($own_buffer,0,$ret);
    }
#    my $fulllen = length($$buff);
#    my $caller = "";#Carp::longmess();
#    warn qq{ret [$ret] len [$len] offset [$offset] own_len [$own_len] fulllen [$fulllen] caller [$caller]\n};
#    my $obs = substr($own_buffer,0,15);
#    my $obe = substr($own_buffer,-15);
#    warn qq{own_buffer [$obs]...[$obe] his buff [$$buff]\n};
    $ret;
}
sub new_MultipartBuffer {
    my $self = shift;
    my $new = Apache::MultipartBuffer->new($self, @_); 
    $new->{'.req'} = $self->{'.req'} || Apache->request;
    return $new;
}
package Apache::MultipartBuffer;
@ISA = qw(CGI::XA::MultipartBuffer);
sub wouldBlock { undef }
*Apache::MultipartBuffer::read_from_client = \&Apache::CGI::read_from_client;
1;
__END__
=head1 NAME
Apache::CGI - Make things work with CGI.pm against Perl-Apache API
=head1 SYNOPSIS
  
 require Apache::CGI;
 my $q = new Apache::CGI;
 $q->print($q->header);
 #do things just like you do with CGI.pm
=head1 DESCRIPTION
When using the Perl-Apache API, your applications are faster, but the
enviroment is different than CGI.
This module attempts to set-up that environment as best it can.
=head1 SEE ALSO
perl(1), Apache(3), CGI(3)
=head1 AUTHOR
Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>
=cut