Add DW::Request::Standard.
Patch by exor674.
diffs (285 lines):
diff -r 6198b849e8ec -r 09ce6d0bca17 cgi-bin/DW/Request/Standard.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Request/Standard.pm Wed Feb 17 04:57:01 2010 +0000
@@ -0,0 +1,281 @@
+#!/usr/bin/perl
+#
+# DW::Request::Standard
+#
+# Abstraction layer for standard HTTP::Request/HTTP::Response based systems.
+# We don't care who's giving us the data, ...
+#
+# Authors:
+# Mark Smith <[email protected]>
+# Andrea Nall <[email protected]>
+#
+# Copyright (c) 2010 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::Request::Standard;
+
+use strict;
+use Carp qw/ confess cluck /;
+use HTTP::Request;
+use HTTP::Response;
+use HTTP::Status qw//;
+
+use fields (
+ 'req', # The HTTP::Request object
+ 'res', # a HTTP::Response object
+ 'notes',
+ 'pnotes',
+
+ # these are mutually exclusive; if you use one you can't use the
other
+ 'content', # raw content
+ 'post_args', # hashref of POST arguments
+ 'get_args', # hashref of GET arguments
+
+ # we have to parse these out ourselves
+ 'uri',
+ 'querystring',
+ );
+
+# creates a new DW::Request object, based on what type of server environment we
+# are running under
+sub new {
+ my DW::Request::Standard $self = $_[0];
+ $self = fields::new( $self ) unless ref $self;
+
+ # setup object
+ $self->{req} = $_[1];
+ $self->{res} = HTTP::Response->new( 200 );
+ $self->{post_args} = undef;
+ $self->{content} = undef;
+ $self->{uri} = $self->{req}->uri;
+ $self->{notes} = {};
+ $self->{pnotes} = {};
+
+ # now stick ourselves as the primary request ...
+ unless ( $DW::Request::cur_req ) {
+ $DW::Request::determined = 1;
+ $DW::Request::cur_req = $self;
+ }
+
+ # done
+ return $self;
+}
+
+# current document root
+sub document_root {
+ confess "Not implemented, doesn't matter here ...\n";
+}
+
+# method string GET, POST, etc
+sub method {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{req}->method;
+}
+
+# the URI requested (does not include host:port info)
+sub uri {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{uri}->path;
+}
+
+sub content_type {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{req}->content_type( $_[1] );
+}
+
+# returns the query string
+sub query_string {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{uri}->query;
+}
+
+# returns the raw content of the body; note that this can be particularly
+# slow, so you should only call this if you really need it...
+sub content {
+ my DW::Request::Standard $self = $_[0];
+
+ die "already loaded post_args\n"
+ if defined $self->{post_args};
+
+ # keep a local copy ... bloats memory, and useless, why?
+ return $self->{content} if defined $self->{content};
+ return $self->{content} = $self->{req}->content;
+}
+
+# content of our response object
+sub response_content {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{res}->content;
+}
+
+# return a response as a string
+sub response_as_string {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{res}->as_string;
+}
+
+# get POST arguments as an APR::Table object (which is a tied hashref)
+sub post_args {
+ my DW::Request::Standard $self = $_[0];
+
+ die "already loaded content\n"
+ if defined $self->{content};
+
+ return $self->{post_args} if defined $self->{post_args};
+
+ # get the content and parse it. I would have expected there to be some
+ # official method of doing this on HTTP::Request? guess not.
+ return $self->{post_args} = { LJ::parse_args( $self->{req}->content ) };
+}
+
+sub get_args {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{get_args} if defined $self->{get_args};
+ return $self->{get_args} = { LJ::parse_args( $self->query_string ) };
+}
+
+# searches for a given note and returns the value, or sets it
+sub note {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ return $self->{notes}->{$_[1]};
+ } else {
+ return $self->{notes}->{$_[1]} = $_[2];
+ }
+}
+
+# searches for a given pnote and returns the value, or sets it
+sub pnote {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ return $self->{pnotes}->{$_[1]};
+ } else {
+ return $self->{pnotes}->{$_[1]} = $_[2];
+ }
+}
+
+# searches for a given header and returns the value, or sets it
+sub header_in {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ return $self->{req}->header( $_[1] );
+ } else {
+ return $self->{req}->header( $_[1] => $_[2] );
+ }
+}
+
+# searches for a given header and returns the value, or sets it
+sub header_out {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ return $self->{res}->header( $_[1] );
+ } else {
+ return $self->{res}->header( $_[1] => $_[2] );
+ }
+}
+
+# this may not be precisely correct? maybe we need to maintain our
+# own set of headers that are separate for errors... FIXME: investigate
+*err_header_out = \&header_out;
+
+# returns the ip address of the connected person
+sub get_remote_ip {
+ my DW::Request::Standard $self = $_[0];
+
+ # FIXME: this needs to support more than just the header ... what if we're
not
+ # running behind a proxy? can we use the environment? do we fake it?
for now,
+ # assume that if there is no X-Forwarded-For or we don't trust it, we just
put in
+ # a bogus IP...
+ return '127.0.0.100' unless $LJ::TRUST_X_HEADERS;
+
+ my @ips = split /\s*,\s*/, $self->{req}->header( 'X-Forwarded-For' );
+ return '127.0.0.101' unless @ips && $ips[0];
+
+ return $ips[0];
+}
+
+# sets last modified, this is called so that we set it up on the response
object
+sub set_last_modified {
+ my DW::Request::Standard $self = $_[0];
+ return $self->{res}->header( 'Last-Modified' => LJ::time_to_http( $_[1] )
);
+}
+
+# this is a response method
+sub status {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ # Set message to a default string, just setting code won't do it.
+ my $code = $_[1] || 500;
+ $self->{res}->code( $code );
+ $self->{res}->message( HTTP::Status::status_message($code) );
+ }
+ return $self->{res}->code;
+}
+
+# build or return a status line (RESPONSE)
+sub status_line {
+ my DW::Request::Standard $self = $_[0];
+ if ( scalar( @_ ) == 2 ) {
+ # We must set code and message seperately.
+ if ( $_[1] =~ m/^(\d+)\s+(.+)$/ ) {
+ $self->{res}->code( $1 );
+ $self->{res}->message( $2 );
+ }
+ }
+ return $self->{res}->status_line;
+}
+
+# meets conditions
+sub meets_conditions {
+ my DW::Request::Standard $self = $_[0];
+
+ # FIXME: this should be pretty easy ... check the If headers (only time
ones?)
+ # and see if they're good or not. return proper status code here (OK,
NOT_MODIFIED)
+ # go see the one caller in ljfeed
+ return 0;
+}
+
+sub print {
+ my DW::Request::Standard $self = $_[0];
+ $self->{res}->add_content( $_[1] );
+ return;
+}
+
+sub read {
+ my DW::Request::Standard $self = shift;
+ confess "Reading not implemented.\n";
+}
+
+# return the internal Standard request object... in this case, we are
+# just going to return ourself, as anybody that needs the request object
+# is probably an old Apache style caller that needs updating
+sub r {
+ my DW::Request::Standard $self = $_[0];
+ cluck "DW::Request::Standard->r called, please update the caller.\n";
+ return $self;
+}
+
+# calls the method as a handler.
+sub call_response_handler {
+ return $_[1]->();
+}
+
+sub call_bml {
+ confess "call_bml not (yet) supported\n";
+}
+
+# constants sometimes used
+sub OK { return 200; }
+sub REDIRECT { return 302; }
+sub NOT_FOUND { return 404; }
+
+# spawn a process for an external program
+sub spawn {
+ confess "Sorry, spawning not implemented.\n";
+}
+
+1;
_______________________________________________
dw-changelog mailing list
[email protected]
http://lists.dwscoalition.org/mailman/listinfo/dw-changelog
