Parent Directory
| 
Revision Log
Revision 1695 - (view) (download) (as text)
| 1 : | sh002i | 440 | ################################################################################ |
| 2 : | sh002i | 1663 | # WeBWorK Online Homework Delivery System |
| 3 : | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ | ||
| 4 : | sh002i | 1695 | # $CVSHeader: webwork-modperl/lib/WeBWorK/CourseEnvironment.pm,v 1.23 2003/12/09 01:12:30 sh002i Exp $ |
| 5 : | sh002i | 1663 | # |
| 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 : | sh002i | 440 | ################################################################################ |
| 16 : | |||
| 17 : | malsyned | 283 | package WeBWorK::CourseEnvironment; |
| 18 : | |||
| 19 : | sh002i | 455 | =head1 NAME |
| 20 : | |||
| 21 : | WeBWorK::CourseEnvironment - Read configuration information from global.conf | ||
| 22 : | and course.conf files. | ||
| 23 : | |||
| 24 : | =cut | ||
| 25 : | |||
| 26 : | sh002i | 319 | use strict; |
| 27 : | use warnings; | ||
| 28 : | malsyned | 283 | use Safe; |
| 29 : | sh002i | 412 | use WeBWorK::Utils qw(readFile); |
| 30 : | malsyned | 1092 | use Opcode qw(empty_opset); |
| 31 : | malsyned | 283 | |
| 32 : | sh002i | 1051 | # new($invocant, $webworkRoot, $webworkURLRoot, $pgRoot, $courseName) |
| 33 : | # $invocant implicitly set by caller | ||
| 34 : | # $webworkRoot directory that contains the WeBWorK distribution | ||
| 35 : | # $webworkURLRoot URL that points to the WeBWorK system | ||
| 36 : | # $pgRoot directory that contains the PG distribution | ||
| 37 : | sh002i | 798 | # $courseName name of the course being used |
| 38 : | malsyned | 283 | sub new { |
| 39 : | sh002i | 319 | my $invocant = shift; |
| 40 : | my $class = ref($invocant) || $invocant; | ||
| 41 : | malsyned | 283 | my $webworkRoot = shift; |
| 42 : | sh002i | 695 | my $webworkURLRoot = shift; |
| 43 : | sh002i | 1051 | my $pgRoot = shift; |
| 44 : | sh002i | 700 | my $courseName = shift || ""; |
| 45 : | sh002i | 319 | my $safe = Safe->new; |
| 46 : | malsyned | 283 | |
| 47 : | sh002i | 319 | # set up some defaults that the environment files will need |
| 48 : | $safe->reval("\$webworkRoot = '$webworkRoot'"); | ||
| 49 : | sh002i | 695 | $safe->reval("\$webworkURLRoot = '$webworkURLRoot'"); |
| 50 : | sh002i | 1051 | $safe->reval("\$pgRoot = '$pgRoot'"); |
| 51 : | sh002i | 319 | $safe->reval("\$courseName = '$courseName'"); |
| 52 : | |||
| 53 : | malsyned | 1092 | # Compile the "include" function with all opcodes available. |
| 54 : | gage | 1119 | my $include = q[ sub include { |
| 55 : | malsyned | 1093 | my ($file) = @_; |
| 56 : | gage | 1119 | my $fullPath = "].$webworkRoot.q[/$file"; |
| 57 : | sh002i | 1695 | # This regex matches any string that begins with "../", |
| 58 : | # ends with "/..", contains "/../", or is "..". | ||
| 59 : | gage | 1119 | if ($fullPath =~ m!(?:^|/)\.\.(?:/|$)!) { |
| 60 : | malsyned | 1093 | die "Included file $file has potentially insecure path: contains \"..\""; |
| 61 : | malsyned | 1085 | } else { |
| 62 : | malsyned | 1093 | local @INC = (); |
| 63 : | sh002i | 1695 | unless (my $result = do $fullPath) { |
| 64 : | # FIXME: "do" is misbehaving: if there's a syntax error, $@ | ||
| 65 : | # should be set to the error string, but it's not getting set. | ||
| 66 : | # $! is set to an odd error message "Broken pipe" or something. | ||
| 67 : | # On the command line, both $! and $@ are set in the case of a | ||
| 68 : | # syntax error. This just means that errors will be confusing. | ||
| 69 : | $! and die "Failed to read include file $fullPath: $! (has it been created from the corresponding .dist file?)"; | ||
| 70 : | $@ and die "Failed to compile include file $fullPath: $@"; | ||
| 71 : | die "Include file $fullPath did not return a true value."; | ||
| 72 : | } | ||
| 73 : | malsyned | 1085 | } |
| 74 : | gage | 1119 | } ]; |
| 75 : | malsyned | 1092 | |
| 76 : | my $maskBackup = $safe->mask; | ||
| 77 : | $safe->mask(empty_opset); | ||
| 78 : | $safe->reval($include); | ||
| 79 : | sh002i | 1695 | $@ and die "Failed to reval include subroutine: $@"; |
| 80 : | malsyned | 1092 | $safe->mask($maskBackup); |
| 81 : | malsyned | 1085 | |
| 82 : | malsyned | 283 | # determine location of globalEnvironmentFile |
| 83 : | my $globalEnvironmentFile = "$webworkRoot/conf/global.conf"; | ||
| 84 : | sh002i | 319 | |
| 85 : | malsyned | 283 | # read and evaluate the global environment file |
| 86 : | my $globalFileContents = readFile($globalEnvironmentFile); | ||
| 87 : | sh002i | 319 | $safe->reval($globalFileContents); |
| 88 : | |||
| 89 : | # if that evaluation failed, we can't really go on... | ||
| 90 : | # we need a global environment! | ||
| 91 : | malsyned | 283 | $@ and die "Could not evaluate global environment file $globalEnvironmentFile: $@"; |
| 92 : | |||
| 93 : | # determine location of courseEnvironmentFile | ||
| 94 : | sh002i | 319 | # pull it out of $safe's symbol table ad hoc |
| 95 : | # (we don't want to do the hash conversion yet) | ||
| 96 : | no strict 'refs'; | ||
| 97 : | my $courseEnvironmentFile = ${*{${$safe->root."::"}{courseFiles}}}{environment}; | ||
| 98 : | use strict 'refs'; | ||
| 99 : | |||
| 100 : | malsyned | 283 | # read and evaluate the course environment file |
| 101 : | sh002i | 319 | # if readFile failed, we don't bother trying to reval |
| 102 : | my $courseFileContents = eval { readFile($courseEnvironmentFile) }; # catch exceptions | ||
| 103 : | $@ or $safe->reval($courseFileContents); | ||
| 104 : | malsyned | 304 | |
| 105 : | sh002i | 319 | # get the safe compartment's namespace as a hash |
| 106 : | no strict 'refs'; | ||
| 107 : | my %symbolHash = %{$safe->root."::"}; | ||
| 108 : | use strict 'refs'; | ||
| 109 : | |||
| 110 : | # convert the symbol hash into a hash of regular variables. | ||
| 111 : | my $self = {}; | ||
| 112 : | foreach my $name (keys %symbolHash) { | ||
| 113 : | # weed out internal symbols | ||
| 114 : | next if $name =~ /^(INC|_|__ANON__|main::)$/; | ||
| 115 : | # pull scalar, array, and hash values for this symbol | ||
| 116 : | my $scalar = ${*{$symbolHash{$name}}}; | ||
| 117 : | my @array = @{*{$symbolHash{$name}}}; | ||
| 118 : | my %hash = %{*{$symbolHash{$name}}}; | ||
| 119 : | # for multiple variables sharing a symbol, scalar takes precedence | ||
| 120 : | # over array, which takes precedence over hash. | ||
| 121 : | if (defined $scalar) { | ||
| 122 : | $self->{$name} = $scalar; | ||
| 123 : | } elsif (@array) { | ||
| 124 : | $self->{$name} = \@array; | ||
| 125 : | } elsif (%hash) { | ||
| 126 : | $self->{$name} = \%hash; | ||
| 127 : | } | ||
| 128 : | } | ||
| 129 : | |||
| 130 : | malsyned | 283 | bless $self, $class; |
| 131 : | return $self; | ||
| 132 : | } | ||
| 133 : | |||
| 134 : | 1; | ||
| 135 : | sh002i | 440 | |
| 136 : | __END__ | ||
| 137 : | |||
| 138 : | =head1 SYNOPSIS | ||
| 139 : | |||
| 140 : | use WeBWorK::CourseEnvironment; | ||
| 141 : | $courseEnv = WeBWorK::CourseEnvironment->new($webworkRoot, $courseName); | ||
| 142 : | |||
| 143 : | $timeout = $courseEnv->{sessionKeyTimeout}; | ||
| 144 : | $mode = $courseEnv->{pg}->{options}->{displayMode}; | ||
| 145 : | # etc... | ||
| 146 : | |||
| 147 : | =head1 DESCRIPTION | ||
| 148 : | |||
| 149 : | The WeBWorK::CourseEnvironment module reads the system-wide F<global.conf> and | ||
| 150 : | course-specific F<course.conf> files used by WeBWorK to calculate and store | ||
| 151 : | settings needed throughout the system. The F<.conf> files are perl source files | ||
| 152 : | that can contain any code allowed under the default safe compartment opset. | ||
| 153 : | After evaluation of both files, any package variables are copied out of the | ||
| 154 : | safe compartment into a hash. This hash becomes the course environment. | ||
| 155 : | |||
| 156 : | =head1 CONSTRUCTION | ||
| 157 : | |||
| 158 : | =over | ||
| 159 : | |||
| 160 : | =item new (ROOT, COURSE) | ||
| 161 : | |||
| 162 : | The C<new> method finds the file F<conf/global.conf> relative to the given ROOT | ||
| 163 : | directory. After reading this file, it uses the C<$courseFiles{environment}> | ||
| 164 : | variable, if present, to locate the course environment file. If found, the file | ||
| 165 : | is read and added to the environment. | ||
| 166 : | |||
| 167 : | =back | ||
| 168 : | |||
| 169 : | =head1 ACCESS | ||
| 170 : | |||
| 171 : | There are no formal accessor methods. However, since the course environemnt is | ||
| 172 : | a hash of hashes and arrays, is exists as the self hash of an instance | ||
| 173 : | variable: | ||
| 174 : | |||
| 175 : | $courseEnvironment->{someKey}->{someOtherKey}; | ||
| 176 : | |||
| 177 : | =head1 AUTHOR | ||
| 178 : | |||
| 179 : | Written by Sam Hathaway, sh002i (at) math.rochester.edu. | ||
| 180 : | |||
| 181 : | =cut |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |