view release on metacpan or  search on metacpan

lib/Dancer/Plugin/FakeCGI/Apache1.pm  view on Meta::CPAN

sub request_time { time }

sub uri {
    my $self = shift;

    $self->{uri} ||= $self->{query}->script_name . $self->path_info || '';
}

# Is this available in CGI?
# sub filename {}

# "The $r->location method will return the path of the
# <Location> section from which the current "Perl*Handler"
# is being called." This is irrelevant, I think.
# sub location {}

sub path_info { $_[0]->{query}->path_info }

sub args {
    my $self = shift;

    my %all_params = Dancer->request->params;
    delete($all_params{"splat"});    # Delete 'splat' from params. Dancer put to this if use 'splat' function

    if (@_) {

        # Assign args here.
    }

    return unless keys %all_params;

    # Redirected when is only method 'GET' and not existed CONTENT_TYPE
    # we must return params as string with separator & or ;
    if ($ENV{'REQUEST_METHOD'} eq 'GET' && !$ENV{'CONTENT_TYPE'}) {
        my @a = ();
        while (my ($k, $d) = each %all_params) {
            push(@a, $k . "=" . ($d || ""));
        }
        return join("&", @a);
    }

    return %all_params if wantarray;
    return \%all_params;

    #return $self->{query}->Vars unless wantarray;

    # Do more here to return key => arg values.
}

sub headers_in {
    my $self = shift;

    # Create the headers table if necessary. Decided how to build it based on
    # information here:
    # http://cgi-spec.golux.com/draft-coar-cgi-v11-03-clean.html#6.1
    #
    # Try to get as much info as possible from CGI.pm, which has
    # workarounds for things like the IIS PATH_INFO bug.
    #
    $self->{headers_in} ||= Apache::Table->new(
        'Authorization' => $self->{query}->auth_type,    # No credentials though.

        #'Cookie' => $ENV{HTTP_COOKIE} || $ENV{COOKIE},
        'Content-Length' => $ENV{CONTENT_LENGTH},
        'Content-Type'   => (
              $self->{query}->can('content_type')
            ? $self->{query}->content_type
            : $ENV{CONTENT_TYPE}
        ),

        # Convert HTTP environment variables back into their header names.
        map {
            my $k = ucfirst lc;
            $k =~ s/_(.)/-\u$1/g;
            ($k => $self->{query}->http($_))
          } grep {
            s/^HTTP_//
          } keys %ENV
    );

    # Give 'em the hash list of the hash table.
    return wantarray ? %{$self->{headers_in}} : $self->{headers_in};
}

sub header_in {
    my ($self, $header) = (shift, shift);
    my $h = $self->headers_in;
    return @_ ? $h->set($header, shift) : $h->get($header);
}

# The $r->content method will return the entity body
# read from the client, but only if the request content
# type is "application/x-www-form-urlencoded".  When
# called in a scalar context, the entire string is
# returned.  When called in a list context, a list of
# parsed key => value pairs are returned.  *NOTE*: you
# can only ask for this once, as the entire body is read
# from the client.
# Not sure what to do with this one.
# sub content {}

# I think this may be irrelevant under CGI.
# sub read {}

# Use LWP?
sub get_remote_host    { }
sub get_remote_logname { }

sub http_header {
    my $self   = shift;
    my $h      = $self->headers_out;
    my $e      = $self->err_headers_out;
    my $method = exists $h->{Location}
      || exists $e->{Location} ? 'redirect' : 'header';

    #return $self->{query}->$method(tied(%$h)->cgi_headers, tied(%$e)->cgi_headers);
    return "";
}

sub send_http_header {
    my $self = shift;