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   # get the safe compartment's namespace as a hash
   46   no strict 'refs';
   47   my %symbolHash = %{$safe->root."::"};
   48   use strict 'refs';
   49 
   50   # convert the symbol hash into a hash of regular variables.
   51   my $self = {};
   52   foreach my $name (keys %symbolHash) {
   53     # weed out internal symbols
   54     next if $name =~ /^(INC|_|__ANON__|main::)$/;
   55     # pull scalar, array, and hash values for this symbol
   56     my $scalar = ${*{$symbolHash{$name}}};
   57     my @array = @{*{$symbolHash{$name}}};
   58     my %hash = %{*{$symbolHash{$name}}};
   59     # for multiple variables sharing a symbol, scalar takes precedence
   60     # over array, which takes precedence over hash.
   61     if (defined $scalar) {
   62       $self->{$name} = $scalar;
   63     } elsif (@array) {
   64       $self->{$name} = \@array;
   65     } elsif (%hash) {
   66       $self->{$name} = \%hash;
   67     }
   68   }
   69 
   70   bless $self, $class;
   71   return $self;
   72 }
   73 
   74 sub hash2string {
   75   my $hr = shift;
   76   my $indent = shift || 0;
   77   my $result;
   78   foreach (keys %$hr) {
   79     $result .= "\t"x$indent . "{$_} =";
   80     if (ref $hr->{$_} eq 'HASH') {
   81       $result .= "\n";
   82       $result .= hash2string($hr->{$_}, $indent+1);
   83     } elsif (ref $hr->{$_} eq 'ARRAY') {
   84       $result .= "\n";
   85       $result .= array2string($hr->{$_}, $indent+1);
   86     } else {
   87       $result .= " " . $hr->{$_} . "\n";
   88     }
   89   }
   90   return $result;
   91 }
   92 
   93 sub array2string {
   94   my $ar = shift;
   95   my $indent = shift || 0;
   96   my $result;
   97   foreach (0 .. @$ar-1) {
   98     $result .= "\t"x$indent . "[$_] =";
   99     if (ref $ar->[$_] eq 'HASH') {
  100       $result .= "\n";
  101       $result .= hash2string($ar->[$_], $indent+1);
  102     } elsif (ref $ar->[$_] eq 'ARRAY') {
  103       $result .= "\n";
  104       $result .= array2string($ar->[$_], $indent+1);
  105     } else {
  106       $result .= " " . $ar->[$_] . "\n";
  107     }
  108   }
  109   return $result;
  110 }
  111 
  112 # ----- utils -----
  113 
  114 sub readFile {
  115   my $fileName = shift;
  116   open INPUTFILE, "<", $fileName
  117     or die "Couldn't open environment file $fileName: $!";
  118   my $result = join "\n", <INPUTFILE>;
  119   close INPUTFILE;
  120   return $result;
  121 }
  122 
  123 1;