View of /branches/rel-2-3-exp/webwork2/lib/WeBWorK/Request.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/Request.pm,v 1.8 2006/09/25 21:44:07 sh002i Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::Request;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::Request - a request to the WeBWorK system, a subclass of
   22 Apache::Request with additional WeBWorK-specific fields.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 
   29 use mod_perl;
   30 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 );
   31 
   32 # This class inherits from Apache::Request under mod_perl and Apache2::Request under mod_perl2
   33 BEGIN {
   34   if (MP2) {
   35     require Apache2::Request;
   36     Apache2::Request->import;
   37     push @WeBWorK::Request::ISA, "Apache2::Request";
   38   } else {
   39     require Apache::Request;
   40     Apache::Request->import;
   41     push @WeBWorK::Request::ISA, "Apache::Request";
   42   }
   43 }
   44 
   45 # Apache2::Request's param method doesn't support setting parameters, so we need to provide the
   46 # behavior in this class if we're running under mod_perl2.
   47 BEGIN {
   48   if (MP2) {
   49     *param = *mutable_param;
   50   }
   51 }
   52 
   53 sub mutable_param {
   54   my $self = shift;
   55 
   56   if (not defined $self->{paramcache}) {
   57     my @names = $self->SUPER::param;
   58     @{$self->{paramcache}}{@names} = map { [ $self->SUPER::param($_) ] } @names;
   59   }
   60 
   61   @_ or return keys %{$self->{paramcache}};
   62 
   63   my $name = shift;
   64   if (@_) {
   65     my $val = shift;
   66     if (ref $val eq "ARRAY") {
   67       $self->{paramcache}{$name} = [@$val]; # make a copy
   68     } else {
   69       $self->{paramcache}{$name} = [$val];
   70     }
   71   }
   72   return unless exists $self->{paramcache}{$name};
   73   return wantarray ? @{$self->{paramcache}{$name}} : $self->{paramcache}{$name}->[0];
   74 }
   75 
   76 =head1 CONSTRUCTOR
   77 
   78 =over
   79 
   80 =item new(@args)
   81 
   82 Creates an new WeBWorK::Request. All arguments are passed to Apache::Request's
   83 constructor. You must specify at least an Apache request_rec object.
   84 
   85 =for comment
   86 
   87 From: http://search.cpan.org/~joesuf/libapreq-1.3/Request/Request.pm#SUBCLASSING_Apache::Request
   88 
   89 If the instances of your subclass are hash references then you can actually
   90 inherit from Apache::Request as long as the Apache::Request object is stored in
   91 an attribute called "r" or "_r". (The Apache::Request class effectively does the
   92 delegation for you automagically, as long as it knows where to find the
   93 Apache::Request object to delegate to.)
   94 
   95 =cut
   96 
   97 sub new {
   98   my ($invocant, @args) = @_;
   99   my $class = ref $invocant || $invocant;
  100   # construct the appropriate superclass instance depending on mod_perl version
  101   my $apreq_class = MP2 ? "Apache2::Request" : "Apache::Request";
  102   return bless { r => $apreq_class->new(@args) }, $class;
  103 }
  104 
  105 =back
  106 
  107 =cut
  108 
  109 =head1 METHODS
  110 
  111 =over
  112 
  113 =item ce([$new])
  114 
  115 Return the course environment (WeBWorK::CourseEnvironment) associated with this
  116 request. If $new is specified, set the course environment to $new before
  117 returning the value.
  118 
  119 =cut
  120 
  121 sub ce {
  122   my $self = shift;
  123   $self->{ce} = shift if @_;
  124   return $self->{ce};
  125 }
  126 
  127 =item db([$new])
  128 
  129 Return the database (WeBWorK::DB) associated with this request. If $new is
  130 specified, set the database to $new before returning the value.
  131 
  132 =cut
  133 
  134 sub db {
  135   my $self = shift;
  136   $self->{db} = shift if @_;
  137   return $self->{db};
  138 }
  139 
  140 =item authen([$new])
  141 
  142 Return the authenticator (WeBWorK::Authen) associated with this request. If $new
  143 is specified, set the authenticator to $new before returning the value.
  144 
  145 =cut
  146 
  147 sub authen {
  148   my $self = shift;
  149   $self->{authen} = shift if @_;
  150   return $self->{authen};
  151 }
  152 
  153 =item authz([$new])
  154 
  155 Return the authorizer (WeBWorK::Authz) associated with this request. If $new is
  156 specified, set the authorizer to $new before returning the value.
  157 
  158 =cut
  159 
  160 sub authz {
  161   my $self = shift;
  162   $self->{authz} = shift if @_;
  163   return $self->{authz};
  164 }
  165 
  166 =item urlpath([$new])
  167 
  168 Return the URL path (WeBWorK::URLPath) associated with this request. If $new is
  169 specified, set the URL path to $new before returning the value.
  170 
  171 =cut
  172 
  173 sub urlpath {
  174   my $self = shift;
  175   $self->{urlpath} = shift if @_;
  176   return $self->{urlpath};
  177 }
  178 
  179 =back
  180 
  181 =cut
  182 
  183 1;