View of /trunk/webwork2/lib/WeBWorK/CourseEnvironment.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork-modperl/lib/WeBWorK/CourseEnvironment.pm,v 1.23 2003/12/09 01:12:30 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::CourseEnvironment;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::CourseEnvironment - Read configuration information from global.conf
   22 and course.conf files.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use Safe;
   29 use WeBWorK::Utils qw(readFile);
   30 use Opcode qw(empty_opset);
   31 
   32 # 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 # $courseName   name of the course being used
   38 sub new {
   39   my $invocant = shift;
   40   my $class = ref($invocant) || $invocant;
   41   my $webworkRoot = shift;
   42   my $webworkURLRoot = shift;
   43   my $pgRoot = shift;
   44   my $courseName = shift || "";
   45   my $safe = Safe->new;
   46 
   47   # set up some defaults that the environment files will need
   48   $safe->reval("\$webworkRoot = '$webworkRoot'");
   49   $safe->reval("\$webworkURLRoot = '$webworkURLRoot'");
   50   $safe->reval("\$pgRoot = '$pgRoot'");
   51   $safe->reval("\$courseName = '$courseName'");
   52 
   53   # Compile the "include" function with all opcodes available.
   54   my $include = q[ sub include {
   55     my ($file) = @_;
   56     my $fullPath = "].$webworkRoot.q[/$file";
   57     # This regex matches any string that begins with "../",
   58     # ends with "/..", contains "/../", or is "..".
   59     if ($fullPath =~ m!(?:^|/)\.\.(?:/|$)!) {
   60       die "Included file $file has potentially insecure path: contains \"..\"";
   61     } else {
   62       local @INC = ();
   63       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     }
   74   } ];
   75 
   76   my $maskBackup = $safe->mask;
   77   $safe->mask(empty_opset);
   78   $safe->reval($include);
   79   $@ and die "Failed to reval include subroutine: $@";
   80   $safe->mask($maskBackup);
   81 
   82   # determine location of globalEnvironmentFile
   83   my $globalEnvironmentFile = "$webworkRoot/conf/global.conf";
   84 
   85   # read and evaluate the global environment file
   86   my $globalFileContents = readFile($globalEnvironmentFile);
   87   $safe->reval($globalFileContents);
   88 
   89   # if that evaluation failed, we can't really go on...
   90   # we need a global environment!
   91   $@ and die "Could not evaluate global environment file $globalEnvironmentFile: $@";
   92 
   93   # determine location of courseEnvironmentFile
   94   # 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   # read and evaluate the course environment file
  101   # if readFile failed, we don't bother trying to reval
  102   my $courseFileContents = eval { readFile($courseEnvironmentFile) }; # catch exceptions
  103   $@ or $safe->reval($courseFileContents);
  104 
  105   # 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   bless $self, $class;
  131   return $self;
  132 }
  133 
  134 1;
  135 
  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