[LON-CAPA-cvs] cvs: modules /jerf/tests ApacheRequest.pm ApacheRequestTest.pm Utils.pm

bowersj2 lon-capa-cvs@mail.lon-capa.org
Mon, 30 Jun 2003 20:08:07 -0000


This is a MIME encoded message

--bowersj21057003687
Content-Type: text/plain

bowersj2		Mon Jun 30 16:08:07 2003 EDT

  Modified files:              
    /modules/jerf/tests	ApacheRequest.pm ApacheRequestTest.pm Utils.pm 
  Log:
  Can now create courses from outside of the web server.
  
  
--bowersj21057003687
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030630160807.txt"

Index: modules/jerf/tests/ApacheRequest.pm
diff -u modules/jerf/tests/ApacheRequest.pm:1.6 modules/jerf/tests/ApacheRequest.pm:1.7
--- modules/jerf/tests/ApacheRequest.pm:1.6	Mon Jun 30 10:48:42 2003
+++ modules/jerf/tests/ApacheRequest.pm	Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Apache Request Simulator
 #
-# $Id: ApacheRequest.pm,v 1.6 2003/06/30 14:48:42 bowersj2 Exp $
+# $Id: ApacheRequest.pm,v 1.7 2003/06/30 20:08:07 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -70,6 +70,15 @@
     this request. (This copies the user's environment into the request environment,
     with the 'user.' prefixes applied.)
 
+=item * I<filename>: A string that will be returned by the filename method.
+    Since we can't guess in advance what the filename will be, you need to
+    supply it if the handler will care. (For instance, lonacc does.)
+
+=item * I<handler_list>: An array reference full of strings representing other
+    handlers that should be executed before any main handler is executed. This
+    is frequently useful for lonacc, which does stuff that other handlers depend
+    on.
+
 =back
 
 =head2 Using the ApacheRequest Object to Simulate Execution.
@@ -88,6 +97,17 @@
 
 Then call B<$r-E<gt>doHandler('Apache::lonmodule')>;
 
+=head2 Tricks and Tips
+
+The state of the request objects is pretty much captured by the {env}. If
+you want to use the state of an existing request, such as one representing a
+logged in user, you can pass that request's {env} parameter to the new request.
+The new request can then submit a form or modify other request parameters, and
+will automatically update the original request's environment since it was passed
+by reference.
+
+The testing framework uses this extensively.
+
 =cut
 
 package ApacheRequest;
@@ -95,7 +115,7 @@
 use lib '.';
 use lib '/home/httpd/lib/perl/';
 
-use Apache::Constants qw(:common :http);
+use Apache::Constants qw(:common :http :methods);
 use Apache::lonnet; # For simulating $r->dir_config correctly
 use Apache;
 
@@ -142,6 +162,17 @@
                    "SERVER_SIGNATURE" => "<i>Apache/1.3.27 Server at uhura.lite.msu.edu Port 80</i>",
                    "SERVER_SOFTWARE" => "Apache/1.3.27 (Unix) (Gentoo/Linux) mod_perl/1.27");
 
+# Map method types to name, update as needed.
+my %methodNames = ( 
+		    Apache::Constants::M_GET => 'GET',
+		    Apache::Constants::M_POST => 'POST'
+		    );
+
+my %methodNumbers = (
+		     GET => Apache::Constants::M_GET,
+		     POST => Apache::Constants::M_POST
+		     );
+
 sub new {
     my $proto = shift;
     my $class = ref($proto) || $proto;
@@ -156,6 +187,9 @@
     # set up document root to the perlvar lonDocRoot
     $ENV{'DOCUMENT_ROOT'} = $Apache::lonnet::perlvar{'lonDocRoot'};
 
+    # By default, this is a GET
+    $self->{method} = Apache::Constants::M_GET;
+
     # Handle args & post, if any
     for my $input ('querystring', 'postcontent') {
         if (defined($self->{$input})) {
@@ -166,6 +200,10 @@
                 }
                 $self->{$input} = join('&', @$args);
             }
+	    if ($input eq 'postcontent') {
+		# If we are posting data, set type to POST
+		$self->{method} = Apache::Constants::M_POST;
+	    }
         } # else, just leave the string along
 
         if ($input eq 'querystring' && defined($self->{querystring})) {
@@ -181,8 +219,13 @@
         $ENV{'REQUEST_URI'} = $self->{'uri'};
     } 
 
-    # Prepare headers
-    $self->{headers} = {};
+    # Prepare headers, if they weren't given to us
+    if (!defined($self->{headers})) {
+	$self->{headers} = {};
+    }
+
+    # Prepare headers_in for the one call in LON-CAPA that uses it.
+    $self->{headers_in} = ApacheRequest::Headers->new();
 
     Apache->request($self);
     
@@ -383,6 +426,102 @@
 
 =pod
 
+=item * I<filename>(): Returns the filename given in the constructor; normally
+    supposed to return the result of the URI translation phase. Does not support
+    setting it.
+
+=cut
+
+sub filename {
+    my $self = shift;
+    return $self->{filename};
+}
+
+=pod
+
+=item * I<read>($readbuffer, $buffersize): Ignores the buffersize and inserts
+    the postcontent into the readbuffer.
+
+=cut
+
+sub read {
+    my $self = shift;
+    $_[0] = $self->{postcontent};
+}
+
+=pod
+
+=item * I<method>($method): Works only with GET and POST; to make this work
+    with more, add the desired methods to the methodNames and methodNumbers
+    hashes. Note both this and I<method> actually set the same
+    variable in the request object, unlike real Apache request objects which
+    may keep them seperate.
+
+=cut
+
+sub method {
+    my $self = shift;
+    my $setting = shift;
+
+    if (defined($setting)) {
+	$self->{method} = $methodNumbers{$setting};
+	return;
+    } else {
+	return $methodNames{$self->{method}};
+    }
+}
+
+=pod
+
+=item * I<method_number>($method_number): Works only with M_GET and M_POST; to
+    make this work with more, add the desired methods to the methodNames and
+    methodNumbers hashes. Note both this and I<method> actually set the same
+    variable in the request object, unlike real Apache request objects which
+    may keep them seperate.
+
+=cut
+
+sub method_number {
+    my $self = shift;
+    my $setting = shift;
+
+    if (defined($setting)) {
+	$self->{method} = $setting;
+    } else {
+	return $self->{method};
+    }
+}
+
+=pod
+
+=item * I<headers_in>: Returns an object that can have the "unset" method called.
+    Does nothing, except prevent the one place in LON-CAPA this is used from crashing.
+
+=cut
+
+sub headers_in {
+    my $self = shift;
+    return $self->{headers_in};
+}
+
+=pod
+
+=item * I<no_cache>(): Does nothing.
+
+=cut
+
+sub no_cache { }
+
+=pod
+
+=item * I<header_out>(): Currently does nothing.
+
+=cut
+
+sub header_out { }
+
+=pod
+
 =back
 
 =cut
@@ -418,12 +557,24 @@
 
 =item * I<doHandler>(handlerPackageName): Executes the handler indicated by the
     handlerPackageName. Does a "use $handlerPackageName" and calls the handler
-    on this instance of the ApacheRequest object.
+    on this instance of the ApacheRequest object. Executes any other handlers
+    in the $r->{handler_list} first (like access handlers); right now, just
+    ignores the output from those.
 
 =cut
 
 sub doHandler {
     my $self = shift;
+    my $handlerPackageName = shift;
+
+    for my $handler (@{$self->{handler_list}}) {
+	$self->realDoHandler($handler);
+    }
+    return $self->realDoHandler($handlerPackageName);
+}
+
+sub realDoHandler {
+    my $self = shift;
     (my $handlerPackageName) = @_;
 
     eval "use $handlerPackageName;";
@@ -570,6 +721,22 @@
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
     return $str;
 }
+
+1;
+
+package ApacheRequest::Headers;
+
+# Undocumented, because it doesn't matter must; only one place in the entire
+# LON-CAPA system uses this, loncommon at the end of the cgi setting stuff.
+# This will allow that to call "unset" on "headers_in" without crashing.
+
+sub new {
+    my $class = shift;
+    my $self = {};
+    bless ($self, $class);
+}
+
+sub unset { }
 
 1;
 
Index: modules/jerf/tests/ApacheRequestTest.pm
diff -u modules/jerf/tests/ApacheRequestTest.pm:1.5 modules/jerf/tests/ApacheRequestTest.pm:1.6
--- modules/jerf/tests/ApacheRequestTest.pm:1.5	Tue Jun 24 15:00:46 2003
+++ modules/jerf/tests/ApacheRequestTest.pm	Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Apache Request Simulator Tester
 #
-# $Id: ApacheRequestTest.pm,v 1.5 2003/06/24 19:00:46 bowersj2 Exp $
+# $Id: ApacheRequestTest.pm,v 1.6 2003/06/30 20:08:07 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -43,7 +43,7 @@
 use base qw(Test::Unit::TestCase);
 use strict;
 use Data::Dumper; # for debugging, not always literally used
-use Apache::Constants qw(:common); # for checking handler return values
+use Apache::Constants qw(:common :http :methods); # for checking handler return values
 
 # Since we're testing this, we need this in here
 use ApacheRequest;
@@ -244,6 +244,76 @@
     $self->assert(!defined($r->{env}->{'shouldnebeseen'}));
     $self->assert($r->{env}->{'todd'} eq 'steve');
 }
+
+sub test_cookie_setting_via_cgi_headers {
+    my $self = shift;
+
+    # Test that outputting a Set-cookie: header with cgi_headers works.
+    my $r = ApacheRequest->new();
+    $self->assert(!defined($r->header_in('CoOkIe')));
+    $r->send_cgi_header(<<HEADERS);
+Garbage: Sneeze
+Set-cookie: test-cookie
+Attack-Of-The-Killer-Clowns: X-Smooch.
+HEADERS
+
+    $self->assert($r->header_in('CoOkIe') eq 'test-cookie');
+}
+
+sub test_filename_works {
+    my $self = shift;
+    
+    # Test that the filename works
+    my $r = ApacheRequest->new();
+    $self->assert($r->filename() eq '');
+    my $f = 'testfilename';
+    $r = ApacheRequest->new({filename => $f});
+    $self->assert($r->filename() eq $f);
+}
+
+sub test_read_works {
+    my $self = shift;
+
+    # Test that the read works, at least to our specifications
+    my $r = ApacheRequest->new();
+    my $buffer = 'garbage';
+    $r->read($buffer, $r->header_in("Content-length"));
+    $self->assert($buffer eq '');
+}
+
+sub test_method_works {
+    my $self = shift;
+
+    # Test that the method stuff works; by default, it's a GET,
+    # unless we sent postcontent in which case it's POST
+    my $r = ApacheRequest->new();
+    $self->assert($r->method eq 'GET');
+    $self->assert($r->method_number == M_GET);
+    $r = ApacheRequest->new({postcontent => "a=b"});
+    $self->assert($r->method eq 'POST');
+    $self->assert($r->method_number == M_POST);
+    $r->method("GET");
+    $self->assert($r->method eq 'GET');
+    $self->assert($r->method_number == M_GET);
+    $r->method_number(M_POST);
+    $self->assert($r->method eq 'POST');
+    $self->assert($r->method_number == M_POST);
+    $r->method_number(M_GET);
+    $self->assert($r->method eq 'GET');
+    $self->assert($r->method_number == M_GET);
+    $r->method("POST");
+    $self->assert($r->method eq 'POST');
+    $self->assert($r->method_number == M_POST);
+}
+
+sub test_headers_in {
+    my $self = shift;
+
+    # Test that we can call headers_in->unset without crashing.
+    my $r = ApacheRequest->new();
+    $r->headers_in->unset("Bleh.");
+}
+
 1;
 
 package SimpleTestHandler;
Index: modules/jerf/tests/Utils.pm
diff -u modules/jerf/tests/Utils.pm:1.2 modules/jerf/tests/Utils.pm:1.3
--- modules/jerf/tests/Utils.pm:1.2	Mon Jun 30 10:48:42 2003
+++ modules/jerf/tests/Utils.pm	Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # testing utilities
 #
-# $Id: Utils.pm,v 1.2 2003/06/30 14:48:42 bowersj2 Exp $
+# $Id: Utils.pm,v 1.3 2003/06/30 20:08:07 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -65,6 +65,7 @@
 sub new {
     my $class = shift;
 
+    $self = {};
     $self->{domain} = shift;
     $self->{name} = shift;
     $self->{password} = shift;
@@ -226,6 +227,22 @@
     $r->doHandler("Apache::lonacc");
 }
 
+# FIXME: Document; selects the DC role for the user, if any
+# pass $r that has the user logged in.
+sub selectRoleDC {
+    my $self = shift;
+    my $request = shift;
+    
+    my $postcontent = { "dc./" . $Data::testDomain . "/" => 'Select',
+		    'selectrole' => 1 };
+    my $r = ApacheRequest->new({postcontent => $postcontent, 
+				env => $request->{env},
+			        'handler_list' => ['Apache::lonacc'],
+			        headers => $request->{headers},
+			        uri => "/adm/roles"});
+    $r->doHandler("Apache::lonroles");
+}
+
 1;
 
 package Utils::Course;
@@ -251,12 +268,54 @@
 
 =over 4
 
-=item * I<new>(
+=item * I<new>($r, $courseTitle, $courseMap, $courseCoordinator): $r should 
+    be a request after a domain coordinator has logged in. $courseTitle should be
+    the title of the course. $courseMap is the url of the top-level map (optional).
+    $courseCoordinator is the account of the course coordinator. The domain
+    and home server will be pulled from the current test environment.
 
 =back
 
 =cut
 
+use Data;
+use ApacheRequest;
 
+sub new {
+    my $class = shift;
+    my $self = {};
+
+    $self->{request} = shift;
+    $self->{title} = shift;
+    $self->{courseMap} = shift;
+    if (!defined($self->{courseMap})) { $self->{courseMap} = ''; }
+    $self->{courseCoordinator} = shift;
+
+    my $postcontent = {};
+
+    # Set up the request to the course creation handler
+    $postcontent->{title} = $self->{title};
+    $postcontent->{course_home} = $Data::testServer;
+    $postcontent->{crsid} = ''; # course id, leave blank
+    $postcontent->{firstres} = 'syl';
+    $postcontent->{openall} = '1';
+    $postcontent->{setpolicy} = '1';
+    $postcontent->{setcontent} = '1';
+    $postcontent->{ccuname} = $self->{courseCoordinator};
+    $postcontent->{ccdomain} = $Data::testDomain;
+    $postcontent->{expireown} = '1';
+    $postcontent->{submit} = 'Open Course';
+    $postcontent->{phase} = 'two';
+
+    # Create a request object to handle the course creation.
+    my $r = ApacheRequest->new({env => $self->{request}->{env},
+				postcontent => $postcontent,
+			        filename => '/home/httpd/html/adm/createcourse',
+				'handler_list' => ["Apache::lonacc"],
+				headers => $self->{request}->{headers}});
+    $r->doHandler("Apache::loncreatecourse");
+
+    bless($self, $class);
+}
 
 1;

--bowersj21057003687--