Miscellaneous

mod_perl, environment vars

Re: mod_perl, environment vars

by Davide Cervone -
Number of replies: 0
For the record, here is another version of my program that handles Gateway Quiz assignments as well as homework assignments. For gateway quizzes, it prints out the score on each version of the quiz for each student.

Davide


#!/usr/bin/perl

#########################################
#
#  Values for course and set
#

my $courseID = "dpvc-test";
my $setID = "Gateway1";


#########################################

BEGIN {
  unless ($ENV{WEBWORK_ROOT}) {
    $ENV{WEBWORK_ROOT} = "/WeBWorK/webwork2";
  }
}

use lib "$ENV{WEBWORK_ROOT}/lib";
use WeBWorK::CourseEnvironment;
use WeBWorK::DB;

#########################################
#
#  Get course environment
#
our $ce = WeBWorK::CourseEnvironment->new({
  webwork_dir => $ENV{WEBWORK_ROOT},
  courseName => $courseID,
});
our $db = WeBWorK::DB->new($ce->{dbLayout});


#
#  Get set data and problems
#
my $globalSet = ($db->getGlobalSets($setID))[0];
my $isGateway = $globalSet->assignment_type =~ /gateway/i;
my @problemIDs = $db->listGlobalProblems($setID);

#
#  Get list of users
#
my %users;
foreach my $user ($db->getUsers($db->listUsers)) {
  next unless $user && $user->section ne "Practice";
  $users{$user->user_id} = $user
    if $ce->status_abbrev_has_behavior($user->status,"include_in_scoring");
}

#
#  Sort users and print out scores for those who have attempted the set
#
foreach my $user (sort {
  lc($users{$a}->last_name)  cmp lc($users{$b}->last_name) ||
  lc($users{$a}->first_name) cmp lc($users{$b}->first_name) ||
  lc($users{$a}->user_id)    cmp lc($users{$b}->user_id)
} keys %users) {
  my $User = $users{$user};
  my $scores = ($isGateway ? getGatewayScores($user,$setID) : getHomeworkScore($user,$setID));
  if (scalar(@$scores)) {
    my $score = join(', ',map {sprintf("%.1f",$_)} @$scores);
    print $User->last_name.", ".$User->first_name." (".$User->user_id."): $score\n";
  }
}

#########################################
#
#  Compute the scores for all versions of a gateway test
#
sub getGatewayScores {
  my $user = shift; my $setID = shift;
  my @scores = ();
  foreach my $v ($db->listSetVersions($user,$setID)) {
    my $score = 0; my $attempts = 0;
    my @records = $db->getProblemVersions(map {[$user,$setID,$v,$_]} @problemIDs);
    foreach $Problem (@records) {
      $score += $Problem->status * $Problem->value;
      $attempts++ if ($Problem->num_correct || 0) + ($Problem->num_incorrect || 0);
    }
    push(@scores,$score) if $attempts;
  }
  return [@scores];
}

#########################################
#
#  Compute the score for a homework set
#
sub getHomeworkScore {
  my $user = shift; my $setID = shift;
  my $score = 0; my $attempts = 0;
  my %problems = (map {$_->problem_id => $_} $db->getAllMergedUserProblems($user, $setID));
  foreach my $id (@problemIDs) {
    my $Problem = $problems{$id};
    if ($Problem) {
      $score += $Problem->status * $Problem->value;
      $attempts++ if ($Problem->num_correct || 0) + ($Problem->num_incorrect || 0);
    }
  }
  return ($attempts ? [$score] : []);
}

#########################################

1;