Parent Directory
| 
Revision Log
Revision 4595 -
(view)
(download)
(as text)
Original Path: trunk/webwork-modperl/lib/WeBWorK/Request.pm
| 1 : | sh002i | 1842 | ################################################################################ |
| 2 : | # WeBWorK Online Homework Delivery System | ||
| 3 : | sh002i | 3973 | # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 : | sh002i | 4595 | # $CVSHeader: webwork2/lib/WeBWorK/Request.pm,v 1.8 2006/09/25 21:44:07 sh002i Exp $ |
| 5 : | sh002i | 1842 | # |
| 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 : | sh002i | 4192 | 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 : | sh002i | 4193 | # 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 : | sh002i | 4595 | *param = *mutable_param; |
| 50 : | sh002i | 4193 | } |
| 51 : | } | ||
| 52 : | |||
| 53 : | sh002i | 4595 | 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 : | sh002i | 1842 | =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 : | sh002i | 4192 | # 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 : | sh002i | 1842 | } |
| 104 : | |||
| 105 : | sh002i | 2955 | =back |
| 106 : | |||
| 107 : | =cut | ||
| 108 : | |||
| 109 : | sh002i | 1842 | =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 : | sh002i | 3742 | =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 : | sh002i | 1842 | =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; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |