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.25 2004/07/04 14:04:24 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 WeBWorK::Debug;
   31 use Opcode qw(empty_opset);
   32 
   33 # NEW SYNTAX
   34 #
   35 # new($invocant, $seedVarsRef)
   36 #   $invocant       implicitly set by caller
   37 #   $seedVarsRef    reference to hash containing scalar variables with which to
   38 #                   seed the course environment
   39 #
   40 # OLD SYNTAX
   41 #
   42 # new($invocant, $webworkRoot, $webworkURLRoot, $pgRoot, $courseName)
   43 #   $invocant          implicitly set by caller
   44 #   $webworkRoot       directory that contains the WeBWorK distribution
   45 #   $webworkURLRoot    URL that points to the WeBWorK system
   46 #   $pgRoot            directory that contains the PG distribution
   47 #   $courseName        name of the course being used
   48 sub new {
   49   my ($invocant, @rest) = @_;
   50   my $class = ref($invocant) || $invocant;
   51 
   52   # contains scalar symbols/values with which to seed course environment
   53   my %seedVars;
   54 
   55   # where do we get the seed variables?
   56   if (ref $rest[0] eq "HASH") {
   57     %seedVars = %{$rest[0]};
   58   } else {
   59     debug __PACKAGE__, ": deprecated four-argument form of new() used.\n";
   60     #$seedVars{webworkRoot}    = $rest[0];
   61     #$seedVars{webworkURLRoot} = $rest[1];
   62     #$seedVars{pgRoot}         = $rest[2];
   63     $seedVars{webwork_dir}    = $rest[0];
   64     $seedVars{webwork_url}    = $rest[1];
   65     $seedVars{pg_dir}         = $rest[2];
   66     $seedVars{courseName}     = $rest[3];
   67   }
   68 
   69   my $safe = Safe->new;
   70 
   71   # seed course environment with initial values
   72   while (my ($var, $val) = each %seedVars) {
   73     $val = "" if not defined $val;
   74     $safe->reval("\$$var = '$val';");
   75   }
   76 
   77   # Compile the "include" function with all opcodes available.
   78   my $include = q[ sub include {
   79     my ($file) = @_;
   80     my $fullPath = "].$seedVars{webwork_dir}.q[/$file";
   81     # This regex matches any string that begins with "../",
   82     # ends with "/..", contains "/../", or is "..".
   83     if ($fullPath =~ m!(?:^|/)\.\.(?:/|$)!) {
   84       die "Included file $file has potentially insecure path: contains \"..\"";
   85     } else {
   86       local @INC = ();
   87       unless (my $result = do $fullPath) {
   88         # FIXME: "do" is misbehaving: if there's a syntax error, $@
   89         # should be set to the error string, but it's not getting set.
   90         # $! is set to an odd error message "Broken pipe" or something.
   91         # On the command line, both $! and $@ are set in the case of a
   92         # syntax error. This just means that errors will be confusing.
   93         $! and die "Failed to read include file $fullPath: $! (has it been created from the corresponding .dist file?)";
   94         $@ and die "Failed to compile include file $fullPath: $@";
   95         die "Include file $fullPath did not return a true value.";
   96       }
   97     }
   98   } ];
   99 
  100   my $maskBackup = $safe->mask;
  101   $safe->mask(empty_opset);
  102   $safe->reval($include);
  103   $@ and die "Failed to reval include subroutine: $@";
  104   $safe->mask($maskBackup);
  105 
  106   # determine location of globalEnvironmentFile
  107   my $globalEnvironmentFile = "$seedVars{webwork_dir}/conf/global.conf";
  108 
  109   # read and evaluate the global environment file
  110   my $globalFileContents = readFile($globalEnvironmentFile);
  111   $safe->reval($globalFileContents);
  112 
  113   # if that evaluation failed, we can't really go on...
  114   # we need a global environment!
  115   $@ and die "Could not evaluate global environment file $globalEnvironmentFile: $@";
  116 
  117   # determine location of courseEnvironmentFile
  118   # pull it out of $safe's symbol table ad hoc
  119   # (we don't want to do the hash conversion yet)
  120   no strict 'refs';
  121   my $courseEnvironmentFile = ${*{${$safe->root."::"}{courseFiles}}}{environment};
  122   use strict 'refs';
  123 
  124   # read and evaluate the course environment file
  125   # if readFile failed, we don't bother trying to reval
  126   my $courseFileContents = eval { readFile($courseEnvironmentFile) }; # catch exceptions
  127   $@ or $safe->reval($courseFileContents);
  128 
  129   # get the safe compartment's namespace as a hash
  130   no strict 'refs';
  131   my %symbolHash = %{$safe->root."::"};
  132   use strict 'refs';
  133 
  134   # convert the symbol hash into a hash of regular variables.
  135   my $self = {};
  136   foreach my $name (keys %symbolHash) {
  137     # weed out internal symbols
  138     next if $name =~ /^(INC|_|__ANON__|main::)$/;
  139     # pull scalar, array, and hash values for this symbol
  140     my $scalar = ${*{$symbolHash{$name}}};
  141     my @array = @{*{$symbolHash{$name}}};
  142     my %hash = %{*{$symbolHash{$name}}};
  143     # for multiple variables sharing a symbol, scalar takes precedence
  144     # over array, which takes precedence over hash.
  145     if (defined $scalar) {
  146       $self->{$name} = $scalar;
  147     } elsif (@array) {
  148       $self->{$name} = \@array;
  149     } elsif (%hash) {
  150       $self->{$name} = \%hash;
  151     }
  152   }
  153 
  154   bless $self, $class;
  155   return $self;
  156 }
  157 
  158 1;
  159 
  160 __END__
  161 
  162 =head1 SYNOPSIS
  163 
  164  use WeBWorK::CourseEnvironment;
  165  $ce = WeBWorK::CourseEnvironment->new({
  166   webwork_url         => "/webwork2",
  167   webwork_dir         => "/opt/webwork2",
  168   pg_dir              => "/opt/pg",
  169   webwork_htdocs_url  => "/webwork2_files",
  170   webwork_htdocs_dir  => "/opt/webwork2/htdocs",
  171   webwork_courses_url => "/webwork2_course_files",
  172   webwork_courses_dir => "/opt/webwork2/courses",
  173   courseName          => "name_of_course",
  174  });
  175 
  176  my $timeout = $courseEnv->{sessionKeyTimeout};
  177  my $mode    = $courseEnv->{pg}->{options}->{displayMode};
  178  # etc...
  179 
  180 =head1 DESCRIPTION
  181 
  182 The WeBWorK::CourseEnvironment module reads the system-wide F<global.conf> and
  183 course-specific F<course.conf> files used by WeBWorK to calculate and store
  184 settings needed throughout the system. The F<.conf> files are perl source files
  185 that can contain any code allowed under the default safe compartment opset.
  186 After evaluation of both files, any package variables are copied out of the
  187 safe compartment into a hash. This hash becomes the course environment.
  188 
  189 =head1 CONSTRUCTION
  190 
  191 =over
  192 
  193 =item new(HASHREF)
  194 
  195 HASHREF is a reference to a hash containing scalar variables with which to seed
  196 the course environment. It must contain at least a value for the key
  197 C<webworkRoot>.
  198 
  199 The C<new> method finds the file F<conf/global.conf> relative to the given
  200 C<webwork_dir> directory. After reading this file, it uses the
  201 C<$courseFiles{environment}> variable, if present, to locate the course
  202 environment file. If found, the file is read and added to the environment.
  203 
  204 =item new(ROOT URLROOT PGROOT COURSENAME)
  205 
  206 A deprecated form of the constructor in which four seed variables are given
  207 explicitly: C<webwork_dir>, C<webwork_url>, C<pg_dir>, and C<courseName>.
  208 
  209 =back
  210 
  211 =head1 ACCESS
  212 
  213 There are no formal accessor methods. However, since the course environemnt is
  214 a hash of hashes and arrays, is exists as the self hash of an instance
  215 variable:
  216 
  217   $ce->{someKey}->{someOtherKey};
  218 
  219 =head1 AUTHOR
  220 
  221 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
  222 
  223 =cut