View of /trunk/webwork-modperl/lib/WeBWorK/CourseEnvironment.pm

    1 package WeBWorK::CourseEnvironment;
    2 
    3 use strict;
    4 use warnings;
    5 use Safe;
    6 
    7 # new($invocant, $webworkRoot, $courseName)
    8 # $invocant implicitly set by caller
    9 # $webworkRoot  directory that contains the WeBWorK distribution
   10 # $courseName name of the course being used
   11 sub new {
   12   my $invocant = shift;
   13   my $class = ref($invocant) || $invocant;
   14   my $webworkRoot = shift;
   15   my $courseName = shift;
   16   my $safe = Safe->new;
   17 
   18   # set up some defaults that the environment files will need
   19   $safe->reval("\$webworkRoot = '$webworkRoot'");
   20   $safe->reval("\$courseName = '$courseName'");
   21 
   22   # determine location of globalEnvironmentFile
   23   my $globalEnvironmentFile = "$webworkRoot/conf/global.conf";
   24 
   25   # read and evaluate the global environment file
   26   my $globalFileContents = readFile($globalEnvironmentFile);
   27   $safe->reval($globalFileContents);
   28 
   29   # if that evaluation failed, we can't really go on...
   30   # we need a global environment!
   31   $@ and die "Could not evaluate global environment file $globalEnvironmentFile: $@";
   32 
   33   # determine location of courseEnvironmentFile
   34   # pull it out of $safe's symbol table ad hoc
   35   # (we don't want to do the hash conversion yet)
   36   no strict 'refs';
   37   my $courseEnvironmentFile = ${*{${$safe->root."::"}{courseFiles}}}{environment};
   38   use strict 'refs';
   39 
   40   # read and evaluate the course environment file
   41   # if readFile failed, we don't bother trying to reval
   42   my $courseFileContents = eval { readFile($courseEnvironmentFile) }; # catch exceptions
   43   $@ or $safe->reval($courseFileContents);
   44   $@ = "";
   45 
   46   # get the safe compartment's namespace as a hash
   47   no strict 'refs';
   48   my %symbolHash = %{$safe->root."::"};
   49   use strict 'refs';
   50 
   51   # convert the symbol hash into a hash of regular variables.
   52   my $self = {};
   53   foreach my $name (keys %symbolHash) {
   54     # weed out internal symbols
   55     next if $name =~ /^(INC|_|__ANON__|main::)$/;
   56     # pull scalar, array, and hash values for this symbol
   57     my $scalar = ${*{$symbolHash{$name}}};
   58     my @array = @{*{$symbolHash{$name}}};
   59     my %hash = %{*{$symbolHash{$name}}};
   60     # for multiple variables sharing a symbol, scalar takes precedence
   61     # over array, which takes precedence over hash.
   62     if (defined $scalar) {
   63       $self->{$name} = $scalar;
   64     } elsif (@array) {
   65       $self->{$name} = \@array;
   66     } elsif (%hash) {
   67       $self->{$name} = \%hash;
   68     }
   69   }
   70 
   71   bless $self, $class;
   72   return $self;
   73 }
   74 
   75 sub hash2string {
   76   my $hr = shift;
   77   my $indent = shift || 0;
   78   my $result;
   79   foreach (keys %$hr) {
   80     $result .= "\t"x$indent . "{$_} =";
   81     if (ref $hr->{$_} eq 'HASH') {
   82       $result .= "\n";
   83       $result .= hash2string($hr->{$_}, $indent+1);
   84     } elsif (ref $hr->{$_} eq 'ARRAY') {
   85       $result .= "\n";
   86       $result .= array2string($hr->{$_}, $indent+1);
   87     } else {
   88       $result .= " " . $hr->{$_} . "\n";
   89     }
   90   }
   91   return $result;
   92 }
   93 
   94 sub array2string {
   95   my $ar = shift;
   96   my $indent = shift || 0;
   97   my $result;
   98   foreach (0 .. @$ar-1) {
   99     $result .= "\t"x$indent . "[$_] =";
  100     if (ref $ar->[$_] eq 'HASH') {
  101       $result .= "\n";
  102       $result .= hash2string($ar->[$_], $indent+1);
  103     } elsif (ref $ar->[$_] eq 'ARRAY') {
  104       $result .= "\n";
  105       $result .= array2string($ar->[$_], $indent+1);
  106     } else {
  107       $result .= " " . $ar->[$_] . "\n";
  108     }
  109   }
  110   return $result;
  111 }
  112 
  113 # ----- utils -----
  114 
  115 sub readFile {
  116   my $fileName = shift;
  117   open INPUTFILE, "<", $fileName
  118     or die "Couldn't open environment file $fileName: $!";
  119   my $result = join "\n", <INPUTFILE>;
  120   close INPUTFILE;
  121   return $result;
  122 }
  123 
  124 1;