Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-24 00:02:39
|
Log Message:
-----------
Merging HEAD to rel-2-4-dev 6/23/2008
View Value.pm for a complete list of changes.
Tags:
----
rel-2-4-dev
Modified Files:
--------------
pg/lib:
AnswerHash.pm
Fraction.pm
List.pm
Parser.pm
Units.pm
Value.pm
VectorField.pm
pg/lib/Parser:
BOP.pm
Complex.pm
Constant.pm
Context.pm
Differentiation.pm
Function.pm
Item.pm
List.pm
Number.pm
String.pm
UOP.pm
Value.pm
Variable.pm
pg/lib/Parser/BOP:
equality.pm
multiply.pm
power.pm
pg/lib/Parser/Context:
Default.pm
Functions.pm
Parens.pm
pg/lib/Parser/Function:
complex.pm
pg/lib/Parser/Legacy:
LimitedComplex.pm
LimitedNumeric.pm
NumberWithUnits.pm
Numeric.pm
PGcomplexmacros.pl
pg/lib/Parser/UOP:
minus.pm
pg/lib/Value:
AnswerChecker.pm
Complex.pm
Context.pm
Formula.pm
Infinity.pm
Interval.pm
List.pm
Matrix.pm
Point.pm
Real.pm
Set.pm
String.pm
Union.pm
Vector.pm
pg/lib/Value/Context:
Data.pm
pg/lib/WeBWorK:
EquationCache.pm
pg/lib/WeBWorK/PG:
Translator.pm
Added Files:
-----------
pg/lib:
Applet.pm
Revision Data
-------------
Index: minus.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP/minus.pm,v
retrieving revision 1.4.8.1
retrieving revision 1.4.8.2
diff -Llib/Parser/UOP/minus.pm -Llib/Parser/UOP/minus.pm -u -r1.4.8.1 -r1.4.8.2
--- lib/Parser/UOP/minus.pm
+++ lib/Parser/UOP/minus.pm
@@ -29,11 +29,13 @@
sub _reduce {
my $self = shift; my $op = $self->{op};
my $reduce = $self->{equation}{context}{reduction};
- $self = $op->{op} if $op->isNeg && $reduce->{'-(-x)'};
+ return $op->{op} if $op->isNeg && $reduce->{'-(-x)'};
+ return $op if $op->{isZero} && $reduce->{'-0'};
return $self;
}
$Parser::reduce->{'-(-x)'} = 1;
+$Parser::reduce->{'-0'} = 1;
#########################################################################
Index: Real.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Real.pm,v
retrieving revision 1.24.2.1
retrieving revision 1.24.2.2
diff -Llib/Value/Real.pm -Llib/Value/Real.pm -u -r1.24.2.1 -r1.24.2.2
--- lib/Value/Real.pm
+++ lib/Value/Real.pm
@@ -6,7 +6,7 @@
package Value::Real;
my $pkg = 'Value::Real';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
#
@@ -17,7 +17,8 @@
my $self = shift; my $class = ref($self) || $self;
my $context = (Value::isContext($_[0]) ? shift : $self->context);
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
- return $x if Value::isReal($x);
+ return $x->inContext($context) if Value::isReal($x);
+
$x = [$x] unless ref($x) eq 'ARRAY';
Value::Error("Can't convert ARRAY of length %d to %s",scalar(@{$x}),Value::showClass($self))
unless (scalar(@{$x}) == 1);
@@ -72,41 +73,41 @@
#
sub add {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
- return $self->make($l->{data}[0] + $r->{data}[0]);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ return $self->inherit($other)->make($l->{data}[0] + $r->{data}[0]);
}
sub sub {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
- return $self->make($l->{data}[0] - $r->{data}[0]);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ return $self->inherit($other)->make($l->{data}[0] - $r->{data}[0]);
}
sub mult {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
- return $self->make($l->{data}[0] * $r->{data}[0]);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ return $self->inherit($other)->make($l->{data}[0] * $r->{data}[0]);
}
sub div {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
Value::Error("Division by zero") if $r->{data}[0] == 0;
- return $self->make($l->{data}[0] / $r->{data}[0]);
+ return $self->inherit($other)->make($l->{data}[0] / $r->{data}[0]);
}
sub power {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my $x = $l->{data}[0] ** $r->{data}[0];
- return $self->make($x) unless $x eq 'nan';
+ return $self->inherit($other)->make($x) unless $x eq 'nan';
Value::Error("Can't raise a negative number to a power") if ($l->{data}[0] < 0);
Value::Error("Result of exponention is not a number");
}
sub modulo {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
$l = $l->{data}[0]; $r = $r->{data}[0];
- return $self->make(0) if $r == 0; # non-fuzzy check
+ return $self->inherit($other)->make(0) if $r == 0; # non-fuzzy check
my $m = $l/$r;
my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
- return $self->make($l - $n*$r);
+ return $self->inherit($other)->make($l - $n*$r);
}
sub compare {
@@ -116,6 +117,8 @@
#
my $m = $self->getFlag("period");
if (defined $m) {
+ $l = $l->with(period=>undef); # make sure tests below don't use period
+ $r = $r->with(period=>undef);
if ($self->getFlag("logPeriodic")) {
return 1 if $l->value == 0 || $r->value == 0; # non-fuzzy checks
$l = log($l); $r = log($r);
@@ -161,8 +164,8 @@
sub cos {my $self = shift; $self->make(CORE::cos($self->{data}[0]))}
sub atan2 {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
- return $self->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ return $self->inherit($other)->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
}
##################################################
@@ -170,7 +173,8 @@
sub string {
my $self = shift; my $equation = shift; my $prec = shift;
my $n = $self->{data}[0];
- my $format = $self->getFlag("format",$equation->{format} || ($equation->{context} || $self->context)->{format}{number});
+ my $format = $self->getFlag("format",$equation->{format} ||
+ ($equation->{context} || $self->context)->{format}{number});
if ($format) {
$n = sprintf($format,$n);
if ($format =~ m/#\s*$/) {$n =~ s/(\.\d*?)0*#$/$1/; $n =~ s/\.$//}
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Complex.pm,v
retrieving revision 1.18.6.1
retrieving revision 1.18.6.2
diff -Llib/Value/Complex.pm -Llib/Value/Complex.pm -u -r1.18.6.1 -r1.18.6.2
--- lib/Value/Complex.pm
+++ lib/Value/Complex.pm
@@ -3,10 +3,12 @@
package Value::Complex;
my $pkg = 'Value::Complex';
-use strict;
+
+use strict; no strict "refs";
our @ISA = qw(Value);
our $i; our $pi;
+
#
# Check that the inputs are:
# one or two real numbers, or
@@ -19,7 +21,7 @@
my $self = shift; my $class = ref($self) || $self;
my $context = (Value::isContext($_[0]) ? shift : $self->context);
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
- return $x if Value::isComplex($x) || (Value::isFormula($x) && $x->{tree}->isComplex);
+ return $x->inContext($context) if Value::isComplex($x) || (Value::isFormula($x) && $x->{tree}->isComplex);
$x = $x->data if Value::isReal($x);
$x = [$x] unless ref($x) eq 'ARRAY'; $x->[1] = 0 unless defined($x->[1]);
Value::Error("Can't convert ARRAY of length %d to a Complex Number",scalar(@{$x}))
@@ -39,7 +41,7 @@
my $self = shift; my $class = ref($self) || $self;
my $context = (Value::isContext($_[0]) ? shift : $self->context);
while (scalar(@_) < 2) {push(@_,0)}
- my $c = bless {data => [@_[0,1]], context => $context}, $class;
+ my $c = bless {$self->hash, data => [@_[0,1]], context => $context}, $class;
foreach my $x (@{$c->{data}}) {$x = $context->Package("Real")->make($context,$x) unless Value::isValue($x)}
return $c;
}
@@ -84,42 +86,44 @@
#
sub add {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
- return $self->make($a + $c, $b + $d);
+ return $self->inherit($other)->make($a + $c, $b + $d);
}
sub sub {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
- return $self->make($a - $c, $b - $d);
+ return $self->inherit($other)->make($a - $c, $b - $d);
}
sub mult {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
- return $self->make($a*$c - $b*$d, $b*$c + $a*$d);
+ return $self->inherit($other)->make($a*$c - $b*$d, $b*$c + $a*$d);
}
sub div {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
my $x = $c*$c + $d*$d;
Value::Error("Division by zero") if $x->value == 0;
- return $self->make(($a*$c + $b*$d)/$x,($b*$c - $a*$d)/$x);
+ return $self->inherit($other)->make(($a*$c + $b*$d)/$x,($b*$c - $a*$d)/$x);
}
sub power {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
- return $self->make(1,0) if ($a->value == 1 && $b->value == 0) || ($c->value == 0 && $d->value == 0);
- return $self->make(0,0) if $c->value > 0 && ($a->value == 0 && $b->value == 0);
+ return $self->inherit($other)->make(1,0) if ($a->value == 1 && $b->value == 0) || ($c->value == 0 && $d->value == 0);
+ return $self->inherit($other)->make(0,0) if $c->value > 0 && ($a->value == 0 && $b->value == 0);
return exp($r * log($l))
}
+
sub modulo {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
- return $self->make(0) if abs($r)->value == 0; # non-fuzzy check
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ return $self->inherit($other)->make(0) if abs($r)->value == 0; # non-fuzzy check
my $m = Re($l/$r)->value;
my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
return $l - $n*$r;
@@ -132,6 +136,8 @@
#
my $m = $self->getFlag("period");
if (defined $m) {
+ $l = $l->with(period=>undef); # make sure tests below don't use period
+ $r = $r->with(period=>undef);
if ($self->getFlag("logPeriodic")) {
return 1 if abs($l)->value == 0 || abs($r)->value == 0; # non-fuzzy checks
$l = log($l); $r = log($r);
@@ -248,7 +254,8 @@
# atan2(z1,z2) = atan(z1/z2)
sub atan2 {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+ $self = $self->inherit($other);
my ($a,$b) = $l->value; my ($c,$d) = $r->value;
if ($c->value == 0 && $d->value == 0) {
return $self->make(0,0) if ($a->value == 0 && $b->value == 0);
@@ -333,7 +340,8 @@
$a->{format} = $b->{format} = $format if defined $format;
my $bi = 'i';
return $a->$method($equation) if $b == 0;
- $bi = CORE::abs($b)->with(format=>$format)->$method($equation,1) . 'i' if CORE::abs($b) ne 1;
+ $bi = CORE::abs($b)->with(format=>$format)->$method($equation,1) . 'i'
+ if CORE::abs($b) !~ m/^1(\.0*)?$/;
$bi = '-' . $bi if $b < 0;
return $bi if $a == 0;
$bi = '+' . $bi if $b > 0;
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/List.pm,v
retrieving revision 1.19.6.1
retrieving revision 1.19.6.2
diff -Llib/Value/List.pm -Llib/Value/List.pm -u -r1.19.6.1 -r1.19.6.2
--- lib/Value/List.pm
+++ lib/Value/List.pm
@@ -5,7 +5,8 @@
package Value::List;
my $pkg = 'Value::List';
-use strict;
+
+use strict; no strict "refs";
our @ISA = qw(Value);
#
@@ -14,11 +15,14 @@
#
sub new {
my $self = shift; my $class = ref($self) || $self;
+
my $context = (Value::isContext($_[0]) ? shift : $self->context);
+ my $def = $context->lists->get("List");
my $p = shift; my $isFormula = 0;
my $isSingleton = (scalar(@_) == 0 && !(Value::isValue($p) && $p->classMatch('List')));
$p = $p->data if (Value::isValue($p) && $p->classMatch('List') && scalar(@_) == 0);
- $p = [$p,@_] if (ref($p) ne 'ARRAY' || scalar(@_) > 0);
+ $p = [] unless defined $p;
+ $p = [$p,@_] if ref($p) ne 'ARRAY' || scalar(@_) > 0;
my $type;
foreach my $x (@{$p}) {
$x = Value::makeValue($x,context=>$context) unless ref($x);
@@ -27,11 +31,20 @@
if (!$type) {$type = $x->type}
else {$type = 'unknown' unless $type eq $x->type}
} else {$type = 'unknown'}
+ if (!$isSingleton && $x->type eq 'List') {
+ $x->{open} = $def->{nestedOpen} unless $x->{open};
+ $x->{close} = $def->{nestedClose} unless $x->{close};
+ }
}
return $p->[0] if ($isSingleton && $type eq 'List' && !$p->[0]{open});
return $self->formula($p) if $isFormula;
my $list = bless {data => $p, type => $type, context=>$context}, $class;
- $list->{correct_ans} = $p->[0]{correct_ans} if $isSingleton && defined $p->[0]{correct_ans};
+ $list->{correct_ans} = $p->[0]{correct_ans}
+ if $isSingleton && defined scalar(@{$p}) && defined $p->[0]{correct_ans};
+ if (scalar(@{$p}) == 0) {
+ $list->{open} = $def->{nestedOpen};
+ $list->{close} = $def->{nestedClose};
+ }
return $list;
}
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context.pm,v
retrieving revision 1.10.6.1
retrieving revision 1.10.6.2
diff -Llib/Value/Context.pm -Llib/Value/Context.pm -u -r1.10.6.1 -r1.10.6.2
--- lib/Value/Context.pm
+++ lib/Value/Context.pm
@@ -6,6 +6,7 @@
package Value::Context;
my $pkg = "Value::Context";
use strict;
+use UNIVERSAL;
#
# Create a new Context object and initialize its data lists
@@ -28,7 +29,7 @@
msg => {}, # for localization
},
data => {
- hashes => [],
+ hashes => ['cmpDefaults'],
arrays => ['data'],
values => ['pattern','format','value'],
objects => [],
@@ -84,11 +85,16 @@
foreach my $data (@{$context->{data}{values}}) {
$context->{$data} = {%{$self->{$data}}};
}
+
$context->{error}{msg} = {%{$self->{error}{msg}}};
+ $context->{error}{convert} = $self->{error}{convert}
+ if defined $self->{error}{convert};
+ $context->{name} = $self->{name};
$context->{_initialized} = 1;
return $context;
}
+
#
# Returns the package name for the specificied Value object class
# (as specified by the context's {value} hash, or "Value::name").
@@ -96,11 +102,19 @@
sub Package {
my $context = shift; my $class = shift;
return $context->{value}{$class} if defined $context->{value}{$class};
+ $class =~ s/\(\)$//;
+ return $context->{value}{$class} if defined $context->{value}{$class};
return "Value::$class" if defined @{"Value::${class}::ISA"};
Value::Error("No such package 'Value::%s'",$class) unless $_[0];
}
#
+# Make these available to Contexts
+#
+sub isa {UNIVERSAL::isa(@_)}
+sub can {UNIVERSAL::can(@_)}
+
+#
# Make stringify produce TeX or regular strings
#
sub texStrings {shift->flags->set(StringifyAsTeX=>1)}
@@ -131,6 +145,8 @@
while ($more && $error->{msg}{$more}) {$more = $error->{msg}{$more}}
$message = sprintf($message,@args) if scalar(@args) > 0;
$message .= sprintf($more,$pos->[0]+1) if $more;
+ while ($message && $error->{msg}{$message}) {$message = $error->{msg}{$message}}
+ $message = &{$error->{convert}}($message) if defined $error->{convert};
$error->{message} = $message;
$error->{string} = $string;
$error->{pos} = $pos;
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/String.pm,v
retrieving revision 1.9.6.1
retrieving revision 1.9.6.2
diff -Llib/Value/String.pm -Llib/Value/String.pm -u -r1.9.6.1 -r1.9.6.2
--- lib/Value/String.pm
+++ lib/Value/String.pm
@@ -3,7 +3,7 @@
package Value::String;
my $pkg = 'Value::String';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
#
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.24.6.1
retrieving revision 1.24.6.2
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.24.6.1 -r1.24.6.2
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -3,7 +3,9 @@
package Value::Union;
my $pkg = 'Value::Union';
-use strict;
+ qw(Value);
+=======
+use strict; no strict "refs";
our @ISA = qw(Value);
#
@@ -104,7 +106,7 @@
return $context->Package("Set")->new($context,$x,@_) if scalar(@_) > 0 || Value::isReal($x);
return $x->inContext($context) if ref($x) eq $class;
$x = $context->Package("Interval")->promote($context,$x) if $x->canBeInUnion;
- return $self->make($context,$x) if Value::isValue($x) && $x->isSetOfReals;
+ return $self->make($context,$x) if $x->isSetOfReals;
Value::Error("Can't convert %s to an Interval, Set or Union",Value::showClass($x));
}
@@ -230,20 +232,31 @@
}
#
-# True if a union is reduced
+# True if a union is reduced.
+#
+# (In scalar context, is a pair whose first entry is true or
+# false, and when true the second value is the reason the
+# set is not reduced.)
#
sub isReduced {
my $self = shift;
return 1 if $self->{isReduced};
- return $self->{data}[0]->isReduced if $self->length == 1;
- my $reduced = $self->reduce;
- $reduced = $self->make($reduced) unless $reduced->type eq 'Union';
- return unless $reduced->length == $self->length;
- my @R = $reduced->sort->value; my @S = $self->sort->value;
- foreach my $i (0..$#R) {
- return unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
+ return $self->{data}[0]->isReduced if ($self->length == 1);
+ my @I; my @S; my $Sn = 0; my $error;
+ foreach my $x (@{$self->{data}})
+ {if ($x->type eq 'Interval') {push(@I,$x)} else {$Sn++; push(@S,@{$x->{data}})}}
+ my $U = $self->make(@I); my $sU = $U->sort;
+ my $S = $self->Package("Set")->new($self->context,@S);
+ foreach my $i (0..$sU->length-2) {
+ my ($x,$y) = ($sU->{data}[$i],$sU->{data}[$i+1]);
+ if ($x->intersects($y)) {$error = "overlaps"; last}
+ if (($x + $y)->reduce->type ne 'Union') {$error = "uncombined intervals"; last}
}
- return 1;
+ $error = "overlaps in sets" if !$error && $S->intersects($U);
+ $error = "uncombined sets" if !$error && $Sn > 1 && !$self->getFlag('reduceSets');
+ $error = "repeated elements in set" if !$error && !$S->isReduced;
+ return $error eq "" unless $error && wantarray;
+ return (0,$error);
}
#
Index: Infinity.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Infinity.pm,v
retrieving revision 1.9.6.1
retrieving revision 1.9.6.2
diff -Llib/Value/Infinity.pm -Llib/Value/Infinity.pm -u -r1.9.6.1 -r1.9.6.2
--- lib/Value/Infinity.pm
+++ lib/Value/Infinity.pm
@@ -3,7 +3,8 @@
package Value::Infinity;
my $pkg = 'Value::Infinity';
-use strict;
+
+use strict; no strict "refs";
our @ISA = qw(Value);
#
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Vector.pm,v
retrieving revision 1.23.2.1
retrieving revision 1.23.2.2
diff -Llib/Value/Vector.pm -Llib/Value/Vector.pm -u -r1.23.2.1 -r1.23.2.2
--- lib/Value/Vector.pm
+++ lib/Value/Vector.pm
@@ -5,12 +5,12 @@
package Value::Vector;
my $pkg = 'Value::Vector';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
#
# Convert a value to a Vector. The value can be
-# a list of numbers, or an reference to an array of numbers
+# a list of numbers, or a reference to an array of numbers
# a point or vector object (demote a vector)
# a matrix if it is n x 1 or 1 x n
# a string that parses to a vector
@@ -50,16 +50,6 @@
}
#
-# Make sure column vector is retained
-#
-sub make {
- my $self = shift;
- my $v = $self->SUPER::make(@_);
- $v->{ColumnVector} = 1 if ref($self) && $self->{ColumnVector};
- return $v;
-}
-
-#
# Try to promote arbitary data to a vector
#
sub promote {
@@ -69,7 +59,7 @@
return $self->new($context,$x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
$x = Value::makeValue($x,context=>$context);
return $x->inContext($context) if ref($x) eq $class;
- return $self->make($context,$x->value) if Value::classMatch($x,'Point');
+ return $self->make($context,$x->value)->inherit($x->without('open','close')) if Value::classMatch($x,'Point');
Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($self));
}
@@ -81,23 +71,23 @@
#
sub add {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
Value::Error("Can't add Vectors with different numbers of coordinates")
unless scalar(@l) == scalar(@r);
my @s = ();
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
}
sub sub {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
Value::Error("Can't subtract Vectors with different numbers of coordinates")
unless scalar(@l) == scalar(@r);
my @s = ();
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
}
sub mult {
@@ -137,13 +127,13 @@
}
sub cross {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
Value::Error("Vectors for cross product must be in 3-space")
unless scalar(@l) == 3 && scalar(@r) == 3;
- $self->make($l[1]*$r[2] - $l[2]*$r[1],
- -($l[0]*$r[2] - $l[2]*$r[0]),
- $l[0]*$r[1] - $l[1]*$r[0]);
+ $self->inherit($other)->make($l[1]*$r[2] - $l[2]*$r[1],
+ -($l[0]*$r[2] - $l[2]*$r[0]),
+ $l[0]*$r[1] - $l[1]*$r[0]);
}
#
@@ -153,7 +143,13 @@
sub compare {
my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
- return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
+ if (scalar(@l) != scalar(@r)) {
+ return scalar(@l) <=> scalar(@r) unless
+ ($l->getFlag("ijk") || $r->getFlag("ijk")) &&
+ ($l->getFlag("ijkAnyDimension") || $r->getFlag("ijkAnyDimension"));
+ if (scalar(@l) < scalar(@r)) {push(@l,0 x (scalar(@r)-scalar(@l)))}
+ else {push(@r,0 x (scalar(@l)-scalar(@r)))}
+ }
my $cmp = 0;
foreach my $i (0..scalar(@l)-1) {
$cmp = $l[$i] <=> $r[$i];
@@ -193,7 +189,13 @@
my $context = $self->context;
my $sameDirection = shift;
my @u = $U->value; my @v = $V->value;
- return 0 unless scalar(@u) == scalar(@v);
+ if (scalar(@u) != scalar(@v)) {
+ return 0 unless
+ ($U->getFlag("ijk") || $V->getFlag("ijk")) &&
+ ($U->getFlag("ijkAnyDimension") || $V->getFlag("ijkAnyDimension"));
+ if (scalar(@u) < scalar(@v)) {push(@u,0 x (scalar(@v)-scalar(@u)))}
+ else {push(@v,0 x (scalar(@u)-scalar(@v)))}
+ }
my $k = ''; # will be scaling factor for u = k v
foreach my $i (0..$#u) {
#
@@ -300,4 +302,3 @@
###########################################################################
1;
-
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.10.6.1
retrieving revision 1.10.6.2
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.10.6.1 -r1.10.6.2
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -3,7 +3,8 @@
package Value::Set;
my $pkg = 'Value::Set';
-use strict;
+
+use strict; no strict "refs";
our @ISA = qw(Value);
# Convert a value to a Set. The value can be
@@ -84,10 +85,11 @@
#
#
-# Addition forms additional sets
+# Addition forms unions (or combines sets)
#
sub add {
my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ return $self->make($l->value,$r->value) if $l->type eq 'Set' && $r->type eq 'Set';
Value::Union::form($self->context,$l,$r);
}
sub dot {my $self = shift; $self->add(@_)}
@@ -137,7 +139,7 @@
} elsif ($x < $b) {
my $context = $self->context;
push(@union,$context->Package("Interval")->make($context,$I->{open},$a,$x,')'));
- $I->{open} = '('; $I->{data}[0] = $x;
+ $I->{open} = '('; $I->{data}[0] = $a = $x;
} else {
$I->{close} = ')' if ($x == $b);
last;
@@ -207,12 +209,18 @@
}
#
-# True if the set is reduced
+# True if a union is reduced.
+#
+# (In scalar context, is a pair whose first entry is true or
+# false, and when true the second value is the reason the
+# set is not reduced.)
#
sub isReduced {
my $self = shift;
return 1 if $self->{isReduced} || $self->length < 2;
- return $self->reduce->length == $self->length;
+ my $isReduced = $self->reduce->length == $self->length;
+ return $isReduced if $isReduced || !wantarray;
+ return (0,"repeated elements");
}
#
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.91.2.1
retrieving revision 1.91.2.2
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.91.2.1 -r1.91.2.2
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -1,3 +1,4 @@
+
=head1 DESCRIPTION
#############################################################
@@ -25,10 +26,19 @@
#
$Value::defaultContext->{cmpDefaults} = {};
+=head5 $mathObject->cmp_defaults()
+
+# Internal use.
+# Set default flags for the answer checker in this object
+# showTypeWarnings => 1
+# showEqualErrors => 1
+# ignoreStrings => 1
+# studentsMustReduceUnions => 1
+# show UnionReduceWarnings => 1
+#
+
+=cut
-#
-# Default flags for the answer checkers
-#
sub cmp_defaults {(
showTypeWarnings => 1,
showEqualErrors => 1,
@@ -37,9 +47,11 @@
showUnionReduceWarnings => 1,
)}
+
#
# Special Context flags to be set for the student answer
#
+
sub cmp_contextFlags {
my $self = shift; my $ans = shift;
return (
@@ -62,10 +74,11 @@
#
# Create an answer checker for the given type of object
#
+
sub cmp {
my $self = shift;
my $ans = new AnswerEvaluator;
- my $correct = protectHTML($self->{correct_ans});
+ my $correct = preformat($self->{correct_ans});
$correct = $self->correct_ans unless defined($correct);
$self->{context} = Value->context unless defined($self->{context});
$ans->ans_hash(
@@ -74,11 +87,12 @@
correct_value => $self,
$self->cmp_defaults(@_),
%{$self->{context}{cmpDefaults}{$self->class} || {}}, # context-specified defaults
- @_
+ @_,
);
$ans->{debug} = $ans->{rh_ans}{debug};
+
$ans->install_evaluator(sub {
- $ans = shift;
+ my $ans = shift;
$ans->{_filter_name} = "MathObjects answer checker";
$ans->{correct_value}->cmp_parse($ans);
});
@@ -87,7 +101,7 @@
return $ans;
}
-sub correct_ans {protectHTML(shift->string)}
+sub correct_ans {preformat(shift->string)}
sub cmp_diagnostics {}
#
@@ -104,13 +118,16 @@
my $context = $ans->{correct_value}{context} || $current;
Parser::Context->current(undef,$context); # change to correct answser's context
my $flags = contextSet($context,$self->cmp_contextFlags($ans)); # save old context flags
- my $inputs = $self->getPG('$inputs_ref',{action=>""});
+ my $inputs = $self->getPG('$inputs_ref');
$ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/);
$ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
$ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
$ans->{preview_latex_string} = $ans->{preview_text_string} = '';
$context->clearError();
- $contest->{answerHash} = $ans; # values here can override context flags
+ $context->{answerHash} = $ans; # values here can override context flags
+
+ $context->{answerHash} = $ans; # values here can override context flags
+
#
# Parse and evaluate the student answer
@@ -129,16 +146,16 @@
unless Value::isValue($ans->{student_value});
$ans->{student_value}{isStudent} = 1;
$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
- $ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
+ $ans->{preview_text_string} = preformat($ans->{student_formula}->string);
#
# Get the string for the student answer
#
- for ($ans->{formatStudentAnswer} || $context->flag('formatStudentAnswer')) {
- /evaluated/i and do {$ans->{student_ans} = protectHTML($ans->{student_value}->string); last};
+ for ($self->getFlag('formatStudentAnswer')) {
+ /evaluated/i and do {$ans->{student_ans} = preformat($ans->{student_value}->string); last};
/parsed/i and do {$ans->{student_ans} = $ans->{preview_text_string}; last};
/reduced/i and do {
my $oldFlags = contextSet($context,reduceConstants=>1,reduceConstantFunctions=>0);
- $ans->{student_ans} = protectHTML($ans->{student_formula}->substitute()->string);
+ $ans->{student_ans} = preformat($ans->{student_formula}->substitute()->string);
contextSet($context,%{$oldFags}); last;
};
warn "Unkown student answer format |$ans->{formatStudentAnswer}|";
@@ -224,10 +241,13 @@
sub cmp_compare {
my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || '';
+ my $context = (Value::isValue($self) ? $self->context : Value->context);
return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
my @equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)};
- if (!defined($equal) && $@ ne '' && (!$self->context->{error}{flag} || $ans->{showAllErrors})) {
- $self->context->setError(["<I>An error occurred while checking your$nth answer:</I>\n".
+
+ if (!defined($equal) && $@ ne '' && (!$context->{error}{flag} || $ans->{showAllErrors})) {
+ $context->setError(["<I>An error occurred while checking your$nth answer:</I>\n".
+
'<DIV STYLE="margin-left:1em">%s</DIV>',$@],'',undef,undef,$CMP_ERROR);
warn "Please inform your instructor that an error occurred while checking your answer";
}
@@ -317,21 +337,17 @@
return unless $ans->{studentsMustReduceUnions} &&
$ans->{showUnionReduceWarnings} &&
!$ans->{isPreview} && !Value::isFormula($student);
- if ($student->type eq 'Union' && $student->length >= 2) {
- my $reduced = $student->reduce;
- return "Your$nth union can be written without overlaps"
- unless $reduced->type eq 'Union' && $reduced->length == $student->length;
- my @R = $reduced->sort->value;
- my @S = $student->sort->value;
- foreach my $i (0..$#R) {
- return "Your$nth union can be written without overlaps"
- unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
- }
- } elsif ($student->type eq 'Set' && $student->length >= 2) {
- return "Your$nth set should have no repeated elements"
- unless $student->reduce->length == $student->length;
- }
- return;
+ return unless $student->isSetOfReals;
+ my ($result,$error) = $student->isReduced;
+ return unless $error;
+ return {
+ "overlaps" => "Your$nth union contains overlapping intervals",
+ "overlaps in sets" => "Your$nth union contains sets and intervals that overlap",
+ "uncombined intervals" => "Your$nth union can be simplified by combining intervals",
+ "uncombined sets" => "Your$nth union can be simplified by combining some sets",
+ "repeated elements in set" => "Your$nth union contains sets with repeated elements",
+ "repeated elements" => "Your$nth set should have no repeated elements",
+ }->{$error};
}
#
@@ -592,13 +608,22 @@
# Quote HTML characters
#
sub protectHTML {
- my $string = shift;
- return unless defined($string);
- return $string if eval ('$main::displayMode') eq 'TeX';
- $string =~ s/&/\&/g;
- $string =~ s/</\</g;
- $string =~ s/>/\>/g;
- $string;
+ my $string = shift;
+ return unless defined($string);
+ return $string if eval ('$main::displayMode') eq 'TeX';
+ $string =~ s/&/\&/g;
+ $string =~ s/</\</g;
+ $string =~ s/>/\>/g;
+ $string;
+}
+
+#
+# Convert newlines to <BR>
+#
+sub preformat {
+ my $string = protectHTML(shift);
+ $string =~ s!\n!<br />!g unless eval('$main::displayMode') eq 'TeX';
+ $string;
}
#
@@ -846,8 +871,11 @@
return unless $ans->{score} == 0 && !$ans->{isPreview};
my $student = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
- if ($ans->{showDimensionHints} && $self->length != $student->length) {
- $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
+ if ($self->length != $student->length) {
+ ($self,$student) = $self->cmp_pad($student);
+ if ($ans->{showDimensionHints} && $self->length != $student->length) {
+ $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
+ }
}
if ($ans->{parallel} && !$student->isFormula && !$student->classMatch('String') &&
$self->isParallel($student,$ans->{sameDirection})) {
@@ -863,6 +891,23 @@
}
}
+#
+# Pad the student or correct answer if either is in ijk notation
+# and they are not the same dimension. Only add zeros when the other one
+# also has zeros in those places.
+#
+sub cmp_pad {
+ my $self = shift; my $student = shift;
+ if (($self->getFlag("ijk") || $student->getFlag("ijk")) && $self->getFlag("ijkAnyDimension")) {
+ $self = $self->copy; $student = $student->copy;
+ while ($self->length > $student->length && $self->{data}[$student->length] == 0)
+ {push(@{$student->{data}},Value::Real->new(0))}
+ while ($self->length < $student->length && $student->{data}[$self->length] == 0)
+ {push(@{$self->{data}},Value::Real->new(0))}
+ }
+ return ($self,$student);
+}
+
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
@@ -1089,8 +1134,10 @@
#
sub cmp_equal {
my ($self,$ans) = @_;
- return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
- $self->SUPER::cmp_equal($ans);
+ return $self->SUPER::cmp_equal($ans) unless $ans->{student_value}->type eq 'Set';
+ my $error = $self->cmp_checkUnionReduce($ans->{student_value},$ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ return Value::List::cmp_equal(@_);
}
#
@@ -1575,9 +1622,48 @@
$cmp->ans_hash(correct_value => $f);
Parser::Context->current(undef,$current);
}
+ $cmp->install_pre_filter(\&Value::Formula::cmp_call_filter,"cmp_prefilter");
+ $cmp->install_post_filter(\&Value::Formula::cmp_call_filter,"cmp_postfilter");
return $cmp;
}
+sub cmp_call_filter {
+ my $ans = shift; my $method = shift;
+ return $ans->{correct_value}->$method($ans);
+}
+
+sub cmp_prefilter {
+ my $self = shift; my $ans = shift;
+ $ans->{_filter_name} = "fetch_previous_answer";
+ $ans->{prev_ans} = undef;
+ if (defined($ans->{ans_label})) {
+ my $label = "previous_".$ans->{ans_label};
+ my $inputs = $self->getPG('$inputs_ref');
+ if (defined $inputs->{$label} and $inputs->{$label} =~ /\S/) {
+ $ans->{prev_ans} = $inputs->{$label};
+ #FIXME -- previous answer item is not always being updated in inputs_ref (which comes from formField)
+ }
+ }
+ return $ans;
+}
+
+sub cmp_postfilter {
+ my $self = shift; my $ans = shift;
+ $ans->{_filter_name} = "produce_equivalence_message";
+ return $ans if $ans->{ans_message}; # don't overwrite other messages
+ $ans->{prev_formula} = Parser::Formula($self->{context},$ans->{prev_ans});
+ if (defined($ans->{prev_formula}) && defined($ans->{student_formula})) {
+ my $prev = eval {$self->promote($ans->{prev_formula})}; break unless defined($prev);
+ $ans->{prev_equals_current} = Value::cmp_compare($prev,$ans->{student_formula},{});
+ if ( !$ans->{isPreview} # not preview mode
+ and $ans->{prev_equals_current} # equivalent
+ and $ans->{prev_ans} ne $ans->{original_student_ans}) # but not identical
+ {$ans->{ans_message} = "This answer is equivalent to the one you just submitted."}
+ }
+ return $ans;
+}
+
+
sub cmp_equal {
my $self = shift; my $ans = shift;
#
@@ -1970,7 +2056,10 @@
#
sub value {
my $self = shift;
+
+ return $self unless defined $self->{tree}{coords};
my $context = $self->context;
+
my @array = ();
if ($self->{tree}->type eq 'Matrix') {
foreach my $row (@{$self->{tree}->coords}) {
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.43.2.1
retrieving revision 1.43.2.2
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.43.2.1 -r1.43.2.2
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -5,14 +5,17 @@
package Value::Formula;
my $pkg = 'Value::Formula';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Parser Value);
+
+
my $UNDEF = bless {}, "UNDEF"; # used for undefined points
#
# Call Parser to make the new Formula
+
#
sub new {
my $self = shift;
@@ -32,11 +35,11 @@
# as the formula itself.
#
sub with {
- my $self = (shift)->copy; my %hash = @_;
- foreach my $id (keys(%hash)) {
- $self->{tree}{$id} = $hash{$id};
- $self->{$id} = $hash{$id};
- }
+
+ my $self = shift; my %hash = @_;
+ $self = $self->SUPER::with(@_);
+ $self->{tree} = $self->{tree}->copy($self); # make a new copy pointing to the new equation.
+ foreach my $id (keys(%hash)) {$self->{tree}{$id} = $hash{$id}}
return $self;
}
@@ -76,13 +79,14 @@
$formula->{context} = $r->{context};
$r = $r->{tree}->copy($formula);
} else {
- $r = $self->new($r)->{tree};
+ $r = $self->new($r)->{tree}->copy($formula);
}
if (ref($l) eq $class || ref($l) eq $pkg) {
$formula->{context} = $l->{context};
$l = $l->{tree}->copy($formula);
+
} else {
- $l = $self->new($l)->{tree};
+ $l = $self->new($l)->{tree}->copy($formula);
}
$bop = 'U' if $bop eq '+' &&
($l->type =~ m/Interval|Set|Union/ || $r->type =~ m/Interval|Set|Union/);
@@ -183,6 +187,11 @@
# to the ORIGINAL correct answer. (This will have to be
# fixed if we ever do adaptive parameters for non-real formulas)
#
+ # FIXME: it doesn't make sense to apply the ORIGINAL value's
+ # tolerance, and causes problems when the values
+ # differ in magnitude by much. Gavin has found several
+ # situations where this is a problem.
+ #
if ($l->AdaptParameters($r,$self->{context}->variables->parameters)) {
my $avalues = $l->{test_adapt};
my $tolerance = $self->getFlag('tolerance',1E-4);
@@ -413,53 +422,60 @@
#
sub AdaptParameters {
my $l = shift; my $r = shift;
- my @params = @_; my $d = scalar(@params);
+ my @params = @_; my $d = scalar(@params); my $D;
return 0 if $d == 0; return 0 unless $l->usesOneOf(@params);
$l->Error("Adaptive parameters can only be used for real-valued formulas")
unless $l->{tree}->isRealNumber;
+
#
- # Get coefficient matrix of adaptive parameters
- # and value vector for linear system
+ # Try up to three times (the random points might not work the first time)
#
- my ($p,$v) = $l->createRandomPoints($d);
- my @P = (0) x $d; my ($f,$F) = ($l->{f},$r->{f});
- my @A = (); my @b = ();
- foreach my $i (0..$d-1) {
- my @a = (); my @p = @{$p->[$i]};
- foreach my $j (0..$d-1) {
- $P[$j] = 1; push(@a,(&$f(@p,@P)-$v->[$i])->value);
- $P[$j] = 0;
+ foreach my $attempt (1..3) {
+ #
+ # Get coefficient matrix of adaptive parameters
+ # and value vector for linear system
+ #
+ my ($p,$v) = $l->createRandomPoints($d);
+ my @P = (0) x $d; my ($f,$F) = ($l->{f},$r->{f});
+ my @A = (); my @b = ();
+ foreach my $i (0..$d-1) {
+ my @a = (); my @p = @{$p->[$i]};
+ foreach my $j (0..$d-1) {
+ $P[$j] = 1; push(@a,(&$f(@p,@P)-$v->[$i])->value);
+ $P[$j] = 0;
+ }
+ push @A, [@a]; push @b, [(&$F(@p,@P)-$v->[$i])->value];
}
- push @A, [@a]; push @b, [(&$F(@p,@P)-$v->[$i])->value];
- }
- #
- # Use MatrixReal1.pm to solve system of linear equations
- #
- my $M = MatrixReal1->new($d,$d); $M->[0] = \@A;
- my $B = MatrixReal1->new($d,1); $B->[0] = \@b;
- ($M,$B) = $M->normalize($B);
- $M = $M->decompose_LR;
- if (($d,$B,$M) = $M->solve_LR($B)) {
- if ($d == 0) {
- #
- # Get parameter values and recompute the points using them
- #
- my @a; my $i = 0; my $max = $l->getFlag('max_adapt',1E8);
- foreach my $row (@{$B->[0]}) {
- if (abs($row->[0]) > $max) {
- $max = Value::makeValue($max); $row->[0] = Value::makeValue($row->[0]);
- $l->Error(["Constant of integration is too large: %s\n(maximum allowed is %s)",
- $row->[0]->string,$max->string]) if $params[$i] eq 'C0';
- $l->Error(["Adaptive constant is too large: %s = %s\n(maximum allowed is %s)",
- $params[$i],$row->[0]->string,$max->string]);
- }
- push @a, $row->[0]; $i++;
+
+ #
+ # Use MatrixReal1.pm to solve system of linear equations
+ #
+ my $M = MatrixReal1->new($d,$d); $M->[0] = \@A;
+ my $B = MatrixReal1->new($d,1); $B->[0] = \@b;
+ ($M,$B) = $M->normalize($B);
+ $M = $M->decompose_LR;
+ if (($D,$B,$M) = $M->solve_LR($B)) {
+ if ($D == 0) {
+ #
+ # Get parameter values and recompute the points using them
+ #
+ my @a; my $i = 0; my $max = $l->getFlag('max_adapt',1E8);
+ foreach my $row (@{$B->[0]}) {
+ if (abs($row->[0]) > $max) {
+ $max = Value::makeValue($max); $row->[0] = Value::makeValue($row->[0]);
+ $l->Error(["Constant of integration is too large: %s\n(maximum allowed is %s)",
+ $row->[0]->string,$max->string]) if $params[$i] eq 'C0' or $params[$i] eq 'n00';
+ $l->Error(["Adaptive constant is too large: %s = %s\n(maximum allowed is %s)",
+ $params[$i],$row->[0]->string,$max->string]);
+ }
+ push @a, $row->[0]; $i++;
+ }
+ my $context = $l->context;
+ foreach my $i (0..$#a) {$context->{variables}{$params[$i]}{value} = $a[$i]}
+ $l->{parameters} = [@a];
+ $l->createAdaptedValues;
+ return 1;
}
- my $context = $l->context;
- foreach my $i (0..$#a) {$context->{variables}{$params[$i]}{value} = $a[$i]}
- $l->{parameters} = [@a];
- $l->createAdaptedValues;
- return 1;
}
}
$l->Error("Can't solve for adaptive parameters");
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.28.6.1
retrieving revision 1.28.6.2
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.28.6.1 -r1.28.6.2
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -5,9 +5,10 @@
package Value::Interval;
my $pkg = 'Value::Interval';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
+
#
# Convert a value to an interval. The value consists of
# an open paren string, one or two real numbers or infinities,
@@ -15,14 +16,15 @@
#
sub new {
my $self = shift; my $class = ref($self) || $self;
+
my $context = (Value::isContext($_[0]) ? shift : $self->context);
- if (scalar(@_) == 1 && (!ref($_[0]) || ref($_[0]) eq 'ARRAY')) {
+ if (scalar(@_) == 1) {
my $x = Value::makeValue($_[0],context=>$context);
if (Value::isFormula($x)) {
return $x if $x->type eq 'Interval';
Value::Error("Formula does not return an Interval");
}
- return $self->promote($x);
+ return $self->promote($context,$x);
}
my @params = @_;
Value::Error("Interval can't be empty") unless scalar(@params) > 0;
@@ -30,7 +32,8 @@
return $context->Package("Set")->new($context,@params) if scalar(@params) == 1;
@params = ('(',@params,')') if (scalar(@params) == 2);
my ($open,$a,$b,$close) = @params;
- if (!defined($close)) {$close = $b; $b = $a}
+ ($b,$close) = ($a,$b) unless defined($close);
+ ($a,$b,$open) = ($open,$a,$b) if !ref($b) && ($b eq '(' || $b eq '[');
$a = Value::makeValue($a,context=>$context); $b = Value::makeValue($b,context=>$context);
return $self->formula($open,$a,$b,$close) if Value::isFormula($a) || Value::isFormula($b);
Value::Error("Endpoints of intervals must be numbers or infinities") unless
@@ -52,6 +55,7 @@
if $a == $b && ($open ne '[' || $close ne ']');
return $context->Package("Set")->new($context,$a) if $a == $b;
bless {
+ $self->hash,
data => [$a,$b], open => $open, close => $close,
leftInfinite => $nia, rightInfinite => $ib,
context => $context,
@@ -65,7 +69,9 @@
my $self = shift; my $class = ref($self) || $self;
my $context = (Value::isContext($_[0]) ? shift : $self->context);
my ($open,$a,$b,$close) = @_;
- $close = $b, $b = $a unless defined($close);
+ ($open,$a,$b,$close) = ("(",$open,$a,")") unless defined($b);
+ ($b,$close) = ($a,$b) unless defined($close);
+ ($a,$b,$open) = ($open,$a,$b) if !ref($b) && ($b eq '(' || $b eq '[');
bless {
data => [$a,$b], open => $open, close => $close,
leftInfinite => isNegativeInfinity($a), rightInfinite => isInfinity($b),
@@ -151,7 +157,7 @@
my $x = (scalar(@_) ? shift : $self);
return $self->new($context,$x,@_) if scalar(@_) > 0;
$x = Value::makeValue($x,context=>$context);
- return $x if $x->isSetOfReals;
+ return $x->inContext($context) if $x->isSetOfReals;
return $context->Package("Set")->new($context,$x) if Value::isReal($x);
my $open = $x->{open}; $open = '(' unless defined($open);
my $close = $x->{close}; $close = ')' unless defined($close);
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Matrix.pm,v
retrieving revision 1.22.4.1
retrieving revision 1.22.4.2
diff -Llib/Value/Matrix.pm -Llib/Value/Matrix.pm -u -r1.22.4.1 -r1.22.4.2
--- lib/Value/Matrix.pm
+++ lib/Value/Matrix.pm
@@ -7,9 +7,10 @@
package Value::Matrix;
my $pkg = 'Value::Matrix';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
+
#
# Convert a value to a matrix. The value can be:
# a list of numbers or list of (nested) references to arrays of numbers,
@@ -175,27 +176,28 @@
#
sub add {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = @{$l->data}; my @r = @{$r->data};
Value::Error("Can't add Matrices with different dimensions")
unless scalar(@l) == scalar(@r);
my @s = ();
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
}
sub sub {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = @{$l->data}; my @r = @{$r->data};
Value::Error("Can't subtract Matrices with different dimensions")
unless scalar(@l) == scalar(@r);
my @s = ();
+
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
}
sub mult {
- my ($l,$r,$flag) = @_; my $self = $l;
+ my ($l,$r,$flag) = @_; my $self = $l; my $other = $r;
#
# Constant multiplication
#
@@ -230,6 +232,7 @@
}
push(@M,$self->make(@row));
}
+ $self = $self->inherit($other) if Value::isValue($other);
return $self->make(@M);
}
Index: Point.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Point.pm,v
retrieving revision 1.18.6.1
retrieving revision 1.18.6.2
diff -Llib/Value/Point.pm -Llib/Value/Point.pm -u -r1.18.6.1 -r1.18.6.2
--- lib/Value/Point.pm
+++ lib/Value/Point.pm
@@ -5,9 +5,10 @@
package Value::Point;
my $pkg = 'Value::Point';
-use strict;
+use strict; no strict "refs";
our @ISA = qw(Value);
+
#
# Convert a value to a point. The value can be
# a list of numbers, or an reference to an array of numbers
@@ -60,23 +61,26 @@
#
sub add {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
Value::Error("Can't add Points with different numbers of coordinates")
unless scalar(@l) == scalar(@r);
my @s = ();
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
}
sub sub {
- my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+
+ my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
my @l = $l->value; my @r = $r->value;
Value::Error("Can't subtract Points with different numbers of coordinates")
unless scalar(@l) == scalar(@r);
my @s = ();
foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
- return $self->make(@s);
+ return $self->inherit($other)->make(@s);
+
}
sub mult {
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.9.6.1
retrieving revision 1.9.6.2
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.9.6.1 -r1.9.6.2
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -4,6 +4,7 @@
#
package Value::Context::Data;
use strict;
+use Scalar::Util;
sub new {
my $self = shift; my $class = ref($self) || $self;
@@ -17,6 +18,7 @@
namePattern => '', # pattern for allowed names for new items
name => '', Name => '', # lower- and upper-case names for the class of items
}, $class;
+ $data->weaken;
$data->init();
$parent->{$data->{dataName}} = {};
push @{$parent->{data}{objects}},"_$data->{dataName}";
@@ -47,6 +49,7 @@
$copy->{$name} = $data->{$name};
}
}
+
$self->{tokens} = {%{$orig->{tokens}}};
foreach my $p (keys %{$orig->{patterns}}) {
$self->{patterns}{$p} =
@@ -55,6 +58,11 @@
}
#
+# Make context pointer a weak pointer (avoids reference loops)
+#
+sub weaken {Scalar::Util::weaken((shift)->{context})}
+
+#
# Update the context patterns
#
sub update {(shift)->{context}->update}
--- /dev/null
+++ lib/Applet.pm
@@ -0,0 +1,673 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: pg/lib/Applet.pm,v 1.12.2.1 2008/06/23 23:44:48 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+
+=head1 NAME
+
+Applet.pl - Provides code for inserting FlashApplets and JavaApplets into webwork problems
+
+=head1 SYNPOSIS
+
+ ###################################
+ # Create link to applet
+ ###################################
+ my $appletName = "LineThruPointsWW";
+ $applet = new FlashApplet(
+ # can be replaced by $applet =FlashApplet() when using AppletObjects.pl
+ codebase => findAppletCodebase("$appletName.swf"),
+ appletName => $appletName,
+ appletId => $appletName,
+ submitActionAlias => 'checkAnswer',
+ );
+
+ ###################################
+ # Configure applet
+ ###################################
+
+ #xml data to set up the problem-rac
+ $applet->config(qq{<XML>
+ <point xval='$xval_1' yval='$yval_1' />
+ <point xval='$xval_2' yval='$yval_2' />
+ </XML>});
+
+
+ ###################################
+ # insert applet header material
+ ###################################
+ HEADER_TEXT($applet->insertHeader );
+
+ ###################################
+ # Text section
+ #
+
+ ###################################
+ #insert applet into body
+ ###################################
+ TEXT( MODES(TeX=>'object code', HTML=>$applet->insertObject));
+
+
+=head1 DESCRIPTION
+
+This file provides an object to store in one place
+all of the information needed to call an applet.
+
+The object FlashApplet has defaults for inserting flash applets.
+
+=over
+
+=item *
+
+=item *
+
+=back
+
+(not yet completed)
+
+The module JavaApplet has defaults for inserting java applets.
+
+The module Applet stores common code for the two types of applet.
+
+=head1 USAGE
+
+These modules are activate by listing it in the modules section of global.conf and rebooting the server.
+The companion file to this one is macros/AppletObjects.pl
+
+qw(Applet FlashApplet JavaApplet)
+
+=cut
+
+
+
+package Applet;
+
+use URI::Escape;
+
+
+
+use MIME::Base64 qw( encode_base64 decode_base64);
+
+
+=head2 Default javaScript functions placed in header
+
+These functions are automatically defined for use for
+any javaScript placed in the text of a PG question.
+
+ getApplet(appletName) -- finds the applet path in the DOM
+
+ submitAction() -- calls the submit action of the applets
+
+
+ initializeAction() -- calls the initialize action of the applets
+
+ getQE(name) -- gets an HTML element of the question by name
+ or by id. Be sure to keep all names and ids
+ unique within a given PG question.
+
+ getQuestionElement(name) -- long form of getQE(name)
+
+ listQuestionElements() -- for discovering the names of inputs in the
+ PG question. An alert dialog will list all
+ of the elements.
+ Usage: Place this at the END of the question,
+ just before END_DOCUMENT():
+
+ TEXT(qq!<script> listQuestionElements() </script>!);
+ ENDDOCUMENT();
+
+ list of accessor methods format: current_value = $self->method(new_value or empty)
+
+ appletId for simplicity and reliability appletId and appletName are always the same
+ appletName
+
+ archive the name of the .jar file containing the applet code
+ code the name of the applet code in the .jar archive
+ codebase a prefix url used to find the archive and the applet itself
+
+ height rectangle alloted in the html page for displaying the applet
+ width
+
+ params an anonymous array containing name/value pairs
+ to configure the applet [name =>'value, ...]
+
+ header stores the text to be added to the header section of the html page
+ object stores the text which places the applet on the html page
+
+ debug in debug mode several alerts mark progress through the procedure of calling the applet
+
+ config configuration are those customizable attributes of the applet which don't
+ change as it is used. When stored in hidden answer fields
+ it is usually stored in base64 encoded format.
+ base64_config base64 encode version of the contents of config
+
+ configAlias (default: config ) names the applet command called with the contents of $self->config
+ to configure the applet. The parameters are passed to the applet in plain text using <xml>
+ The outer tags must be <xml> ..... </xml>
+ state state consists of those customizable attributes of the applet which change
+ as the applet is used. It is stored by the calling .pg question so that
+ when revisiting the question the applet
+ will be restored to the same state it was left in when the question was last
+ viewed.
+
+ getStateAlias (default: getState) alias for command called to read the current state of the applet.
+ The state is passed in plain text xml format with outer tags: <xml>....</xml>
+ setStateAlias (default: setState) alias for the command called to reset the state of the applet.
+ The state is passed in plain text in xml format with outer tags: <xml>....</xml>
+
+ base64_state returns the base64 encoded version of the state stored in the applet object.
+
+ initializeActionAlias -- (default: initializeAction) the name of the javaScript subroutine called to initialize the applet (some overlap with config/ and setState
+ submitActionAlias -- (default: submitAction)the name of the javaScript subroutine called when the submit button of the
+ .pg question is pressed.
+
+ returnFieldName
+
+
+
+
+
+=cut
+
+
+
+
+sub new {
+ my $class = shift;
+ my $self = {
+ appletName =>'',
+ code=>'',
+ codebase=>'',
+# appletId =>'', #always use identical applet Id's and applet Names
+ params =>undef,
+ width => 550,
+ height => 400,
+ base64_state => undef, # this is an state to use for initializing the first occurence of the question.
+ base64_config => undef, # this is the initial (and final?) configuration
+ getStateAlias => 'getXML',
+ setStateAlias => 'setXML',
+ configAlias => 'config',
+ initializeActionAlias => 'setXML',
+ submitActionAlias => 'getXML',
+ returnFieldName => 'receivedField',
+ headerText => DEFAULT_HEADER_TEXT(),
+ objectText => '',
+ debug => 0,
+ @_,
+ };
+ bless $self, $class;
+ $self->state('<xml></xml>');
+ $self->config('<xml></xml>');
+ return $self;
+}
+
+sub header {
+ my $self = shift;
+ if ($_[0] eq "reset") { # $applet->header('reset'); erases default header text.
+ $self->{headerText}='';
+ } else {
+ $self->{headerText} .= join("",@_); # $applet->header(new_text); concatenates new_text to existing header.
+ }
+ $self->{headerText};
+}
+sub object {
+ my $self = shift;
+ if ($_[0] eq "reset") {
+ $self->{objectText}='';
+ } else {
+ $self->{objectText} .= join("",@_);
+ }
+ $self->{objectText};
+}
+sub params {
+ my $self = shift;
+ if (ref($_[0]) =~/HASH/) {
+ $self->{params} = shift;
+ } elsif ( !defined($_[0]) or $_[0] =~ '') {
+ # do nothing (read)
+ } else {
+ warn "You must enter a reference to a hash for the parameter list";
+ }
+ $self->{params};
+}
+
+sub initializeActionAlias {
+ my $self = shift;
+ $self->{initializeActionAlias} = shift ||$self->{initializeActionAlias}; # replace the current contents if non-empty
+ $self->{initializeActionAlias};
+}
+
+sub submitActionAlias {
+ my $self = shift;
+ $self->{submitActionAlias} = shift ||$self->{submitActionAlias}; # replace the current contents if non-empty
+ $self->{submitActionAlias};
+}
+sub getStateAlias {
+ my $self = shift;
+ $self->{getStateAlias} = shift ||$self->{getStateAlias}; # replace the current contents if non-empty
+ $self->{getStateAlias};
+}
+
+sub setStateAlias {
+ my $self = shift;
+ $self->{setStateAlias} = shift ||$self->{setStateAlias}; # replace the current contents if non-empty
+ $self->{setStateAlias};
+}
+sub configAlias {
+ my $self = shift;
+ $self->{configAlias} = shift ||$self->{configAlias}; # replace the current contents if non-empty
+ $self->{configAlias};
+}
+sub returnFieldName {
+ my $self = shift;
+ $self->{returnFieldName} = shift ||$self->{returnFieldName}; # replace the current contents if non-empty
+ $self->{returnFieldName};
+}
+sub codebase {
+ my $self = shift;
+ $self->{codebase} = shift ||$self->{codebase}; # replace the current ...
[truncated message content] |
|
From: Arnie P. v. a. <we...@ma...> - 2008-06-23 21:00:18
|
Log Message:
-----------
Format preview email better. Make COL[] info line up. Also identify
preview user.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
SendMail.pm
Revision Data
-------------
Index: SendMail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm,v
retrieving revision 1.64
retrieving revision 1.65
diff -Llib/WeBWorK/ContentGenerator/Instructor/SendMail.pm -Llib/WeBWorK/ContentGenerator/Instructor/SendMail.pm -u -r1.64 -r1.65
--- lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SendMail.pm
@@ -496,6 +496,11 @@
my $recipients = join(" ",@{$self->{ra_send_to} });
my $errorMessage = defined($self->{submit_message}) ? CGI::i($self->{submit_message} ) : '' ;
+
+ # Format message keeping the preview_header lined up
+ $errorMessage = wrap("","",$errorMessage);
+ $msg = wrap("","",$msg);
+
$msg = join("",
$errorMessage,
$preview_header,
@@ -506,7 +511,8 @@
$msg , "\n"
);
- return join("", '<pre>',wrap("","",$msg),"\n","\n",
+# return join("", '<pre>',wrap("","",$msg),"\n","\n",
+ return join("", '<pre>',$msg,"\n","\n",
'</pre>',
CGI::p('Use browser back button to return from preview mode'),
CGI::h3('Emails to be sent to the following:'),
@@ -633,7 +639,7 @@
-labels=>{all_students=>'All students in course',studentID => 'Selected students'},
-default=>'studentID', -linebreak=>0),
CGI::br(),$scrolling_user_list,
- CGI::i("Preview set to: "), $preview_record->last_name,
+ CGI::i("Preview set to: "), $preview_record->last_name,'(', $preview_record->user_id,')',
CGI::submit(-name=>'action', -value=>'preview',-label=>'Preview message'),' ',
),
); # end Tr
@@ -933,7 +939,7 @@
if ($for_preview) {
my @preview_COL = @COL;
shift @preview_COL; ## shift back for preview
- my $preview_header = CGI::pre({},data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
+ my $preview_header = CGI::p('',data_format(1..($#COL)),"<br>", data_format2(@preview_COL)).
CGI::h3( "This sample mail would be sent to $EMAIL");
return $msg, $preview_header;
} else {
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:18:34
|
Log Message:
-----------
Stats: update to correctly read data for gateway assignments.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
Stats.pm
Revision Data
-------------
Index: Stats.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm,v
retrieving revision 1.68
retrieving revision 1.69
diff -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -u -r1.68 -r1.69
--- lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
@@ -335,8 +335,19 @@
debug("Begin obtaining problem records for user $student set $setName");
# DBFIXME use an iterator
- my @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllUserProblems( $student, $setName );
+ my @problemRecords;
+ if ( $setRecord->assignment_type =~ /gateway/ ) {
+ my @setVersions = $db->listSetVersions($student, $setName);
+ foreach my $ver ( @setVersions ) {
+ push( @problemRecords,
+ $db->getAllProblemVersions($student,
+ $setName, $ver) );
+ }
+ } else {
+ @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllUserProblems( $student, $setName );
+ }
debug("End obtaining problem records for user $student set $setName");
+
my $num_of_problems = @problemRecords;
$max_num_problems = ($max_num_problems>= $num_of_problems) ? $max_num_problems : $num_of_problems;
########################################
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:17:06
|
Log Message:
-----------
StudentProgress: update test time display to reflect changes in
setting open_date/version_creation_time.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
StudentProgress.pm
Revision Data
-------------
Index: StudentProgress.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.36 -r1.37
--- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
@@ -553,11 +553,11 @@
if ( defined($userSet) ) {
$dateOfTest = localtime($userSet->version_creation_time());
if ( defined($userSet->version_last_attempt_time()) && $userSet->version_last_attempt_time() ) {
- $testTime = ($userSet->version_last_attempt_time() - $userSet->version_creation_time() ) / 60;
+ $testTime = ($userSet->version_last_attempt_time() - $userSet->open_date() ) / 60;
my $timeLimit = $userSet->version_time_limit()/60;
$testTime = $timeLimit if ( $testTime > $timeLimit );
$testTime = sprintf("%3.1f min", $testTime);
- } elsif ( time() - $userSet->version_creation_time() < $userSet->version_time_limit() ) {
+ } elsif ( time() - $userSet->open_date() < $userSet->version_time_limit() ) {
$testTime = 'still open';
} else {
$testTime = 'time limit ' .
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:16:15
|
Log Message:
-----------
Instructor/Index: correct link sent when acting as a user on a
set to allow for gateway test assignments.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
Index.pm
Revision Data
-------------
Index: Index.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Index.pm,v
retrieving revision 1.59
retrieving revision 1.60
diff -Llib/WeBWorK/ContentGenerator/Instructor/Index.pm -Llib/WeBWorK/ContentGenerator/Instructor/Index.pm -u -r1.59 -r1.60
--- lib/WeBWorK/ContentGenerator/Instructor/Index.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Index.pm
@@ -204,7 +204,16 @@
defined param $r "act_as_user" and do {
if ($nusers == 1 and $nsets <= 1) {
if ($nsets) {
- $module = "${pfx}::ProblemSet";
+ # unfortunately, we need to know what
+ # type of set it is to figure out
+ # the correct module
+ my $set = $db->getGlobalSet( $firstSetID );
+ if ( defined( $set ) &&
+ $set->assignment_type =~ /gateway/ ) {
+ $module = "${pfx}::GatewayQuiz";
+ } else {
+ $module = "${pfx}::ProblemSet";
+ }
$args{setID} = $firstSetID;
} else {
$module = "${pfx}::ProblemSets";
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:15:24
|
Log Message:
-----------
ProblemSets: correct display of test times for gateway assignments,
allow link to take test before open date if instructors have that
permission level.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
ProblemSets.pm
Revision Data
-------------
Index: ProblemSets.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/ProblemSets.pm,v
retrieving revision 1.91
retrieving revision 1.92
diff -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -u -r1.91 -r1.92
--- lib/WeBWorK/ContentGenerator/ProblemSets.pm
+++ lib/WeBWorK/ContentGenerator/ProblemSets.pm
@@ -389,8 +389,8 @@
my $interactive = CGI::a({-href=>$interactiveURL}, "$name");
# we choose not to display the link to start a new gateway that we've just
-# set up in the previous line if that's not available, so we work out here
-# if the set is open. for gateways this is a bit more complicated than
+# set up in the previous line if that's not available, so we work out here
+# if the set is open. for gateways this is a bit more complicated than
# for homework sets
my $setIsOpen = 0;
my $status = '';
@@ -410,17 +410,36 @@
# we let people go back to old tests
$setIsOpen = 1;
- } else {
+ # reset the link to give the test number
+ my $vnum = $set->version_id;
+ $interactive = CGI::a({-href=>$interactiveURL},
+ "$name (test$vnum)");
+ } else {
my $t = time();
if ( $t < $set->open_date() ) {
$status = "will open on " . $self->formatDateTime($set->open_date);
- $control = "" unless $preOpenSets;
- $interactive = $name unless $preOpenSets;
+ if ( $preOpenSets ) {
+ # reset the link
+ $interactive = CGI::a({-href=>$interactiveURL},
+ "Take $name test");
+ } else {
+ $control = "";
+ $interactive = "$name test";
+ }
} elsif ( $t < $set->due_date() ) {
$status = "now open, due " . $self->formatDateTime($set->due_date);
$setIsOpen = 1;
+ $interactive = CGI::a({-href=>$interactiveURL},
+ "Take $name test");
} else {
$status = "closed";
+
+ if ( $authz->hasPermissions( $user, "record_answers_after_due_date" ) ) {
+ $interactive = CGI::a({-href=>$interactiveURL},
+ "Take $name test");
+ } else {
+ $interactive = "$name test";
+ }
}
}
@@ -439,24 +458,7 @@
} else {
$status = "closed, answers available";
}
-
-# now edit the interactive link for gateways
- if ( $gwtype ) {
- if ( $gwtype == 1 ) {
- my $vnum = $set->version_id;
- $interactive = CGI::a({-href=>$interactiveURL},
- "$name (test$vnum)");
- } else { # this is the case of a template URL
- if ( $setIsOpen ) {
- $interactive = CGI::a({-href=>$interactiveURL},
- "Take $name test");
- } else {
- $interactive = "$name test";
- }
- }
- }
-
my $publishedClass = ($set->published) ? "Published" : "Unpublished";
$status = CGI::font({class=>$publishedClass}, $status) if $preOpenSets;
@@ -469,7 +471,7 @@
$status,
]));
} else {
- my ( $startTime, $score );
+ my ( $startTime, $score );
if ( defined( $set->assignment_type() ) &&
$set->assignment_type() =~ /gateway/ && $gwtype == 1 ) {
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:14:15
|
Log Message:
-----------
UserDetail: finish set version editing code; correct handling of
template set and set versions.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
UserDetail.pm
Revision Data
-------------
Index: UserDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm -u -r1.8 -r1.9
--- lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm
@@ -66,23 +66,27 @@
foreach my $setID (@setIDs) {
push @assignedSets, $setID if defined($r->param("set.$setID.assignment"));
}
+
+ # note: assignedSets are those sets that are assigned in the submitted form
debug("assignedSets", join(" ", @assignedSets));
+
my %selectedSets = map { $_ => 1 } @assignedSets;
+
#debug ##########################
#print STDERR ("aSsigned sets", join(" ",@assignedSets));
#my @params = $r->param();
#print STDERR " parameters ", join(" ", @params);
###############
+
#Get the user(s) whose records are to be modified
# for now: $editForUserID
# check the user exists? Is this necessary?
my $editUserRecord = $db->getUser($editForUserID);
die "record not found for $editForUserID.\n" unless $editUserRecord;
-
-
+
#Perform the desired assignments or deletions
my %userSets = map { $_ => 1 } $db->listUserSets($editForUserID);
-
+
# go through each possible set
debug(" parameters ", join(" ", $r->param()) );
foreach my $setRecord (@setRecords) {
@@ -91,29 +95,48 @@
if (exists $selectedSets{$setID}) {
# change by glarose, 2007/02/07: only assign set if the
# user doesn't already have the set assigned.
- $self->assignSetToUser($editForUserID, $setRecord) if ( ! $userSets{$setID} );
- #override dates
-
-
- my $userSetRecord = $db->getUserSet($editForUserID, $setID);
- # get the dates
-
+ $self->assignSetToUser($editForUserID, $setRecord) if ( ! $userSets{$setID} );
+ #override dates
+ my $userSetRecord = $db->getUserSet($editForUserID, $setID);
+ # get the dates
+ #do checks to see if new dates meet criteria
+ my $rh_dates = $self->checkDates($setRecord,$setID);
+ unless ( $rh_dates->{error} ) { #returns 1 if error
+ # if no error update database
+ foreach my $field (keys %{DATE_FIELDS()}) {
+ if (defined $r->param("set.$setID.$field.override")) {
+ $userSetRecord->$field($rh_dates->{$field});
+ } else {
+ $userSetRecord->$field(undef); #stop override
+ }
+ }
+ $db->putUserSet($userSetRecord);
+ }
- #do checks to see if new dates meet criteria
- my $rh_dates = $self->checkDates($setRecord,$setID);
- unless ( $rh_dates->{error} ) { #returns 1 if error
- # if no error update database
- foreach my $field (keys %{DATE_FIELDS()}) {
- if (defined $r->param("set.$setID.$field.override")) {
- $userSetRecord->$field($rh_dates->{$field});
- } else {
- $userSetRecord->$field(undef); #stop override
+ # if the set is a gateway set, also check to see if we're
+ # resetting the dates for any of the assigned set versions
+ if ( $setRecord->assignment_type =~ /gateway/ ) {
+ my @setVer = $db->listSetVersions( $editForUserID,
+ $setID );
+ foreach my $ver ( @setVer ) {
+ my $setVersionRecord =
+ $db->getSetVersion( $editForUserID,
+ $setID, $ver );
+ my $rh_dates = $self->checkDates($setVersionRecord,
+ "$setID,v$ver");
+ unless ( $rh_dates->{error} ) {
+ foreach my $field ( keys %{DATE_FIELDS()} ) {
+ if ( defined( $r->param("set.$setID,v$ver.$field.override") ) ) {
+ $setVersionRecord->$field($rh_dates->{$field});
+ } else {
+ $setVersionRecord->$field(undef);
+ }
}
+ $db->putSetVersion( $setVersionRecord );
}
- $db->putUserSet($userSetRecord);
-
}
+ }
} else {
# user asked to NOT have the set assigned to the selected user
@@ -371,11 +394,11 @@
}
warn("Truncated display of sets at 150 in UserDetail.pm. This is a " .
"brake to avoid spiraling into the abyss. If you really have " .
- "more than 150 sets in your course, reset the limit at line " .
+ "more than 150 sets in your course, reset the limit at about line " .
"370 in webwork/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm.")
if ( $numit == 150 );
-
+
foreach my $setID ( @setsToShow ) {
# catch the versioned sets that we just added
my $setVersion = 0;
@@ -406,7 +429,7 @@
print CGI::Tr(
CGI::td({ -align => "center" }, [
($setVersion) ? "" : CGI::checkbox({ type => 'checkbox',
- name => "set.$setID.assignment",
+ name => "set.$fullSetID.assignment",
label => '',
value => 'assigned',
checked => (defined $MergedSetRecord)}),
@@ -526,6 +549,12 @@
return CGI::div({class => "ResultsWithError"}, "No record exists for $recordType $recordID") unless defined $GlobalRecord;
+ # modify record name if we're dealing with versioned sets
+ if ( $recordType eq "set" && defined($MergedRecord) &&
+ $MergedRecord->assignment_type =~ /gateway/ &&
+ $MergedRecord->can( "version_id" ) ) {
+ $recordID .= ",v" . $MergedRecord->version_id;
+ }
my $r = $self->r;
my @fields = @$fieldsRef;
my @results;
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:13:22
|
Log Message:
-----------
global.conf.dist: add permission levels to create and record data
for new set versions.
Modified Files:
--------------
webwork2/conf:
global.conf.dist
Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v
retrieving revision 1.205
retrieving revision 1.206
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.205 -r1.206
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -677,6 +677,8 @@
check_answers_after_open_date_without_attempts => "guest",
check_answers_after_due_date => "guest",
check_answers_after_answer_date => "guest",
+ create_new_set_version_when_acting_as_student => undef,
+ record_set_version_answers_when_acting_as_student => undef,
record_answers_when_acting_as_student => undef,
# "record_answers_when_acting_as_student" takes precedence
# over the following for professors acting as students:
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 20:12:00
|
Log Message:
-----------
GatewayQuiz: adds ability to create new set versions when acting as
a student, cleans up minimization of data saving.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
GatewayQuiz.pm
Revision Data
-------------
Index: GatewayQuiz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -u -r1.51 -r1.52
--- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
+++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
@@ -168,7 +168,21 @@
$Set->version_last_attempt_time() : $timeNow;
if ($User->user_id ne $EffectiveUser->user_id) {
- return $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
+ my $recordAsOther = $authz->hasPermissions($User->user_id, "record_answers_when_acting_as_student");
+ my $recordVersionsAsOther = $authz->hasPermissions($User->user_id, "record_set_version_answers_when_acting_as_student");
+
+ if ( $recordAsOther ) {
+ return $recordAsOther;
+ } elsif ( ! $recordVersionsAsOther ) {
+ return $recordVersionsAsOther;
+ }
+ ## if we're not allowed to record answers as another user,
+ ## return that permission. if we're allowed to record
+ ## only set version answers, then we allow that between
+ ## the open and close dates, and so drop out of this
+ ## conditional to the usual one.
+ ## it isn't clear if this is the correct behavior, but I
+ ## think it's probably reasonable.
}
if (before($Set->open_date, $submitTime)) {
@@ -481,7 +495,7 @@
# should we allow a new version to be created when
# acting as a user?
- my $verCreateOK = ( defined( $r->param('createnew_ok') ) ) ?
+ my $verCreateOK = ( defined( $r->param('createnew_ok') ) ) ?
$r->param('createnew_ok') : 0;
# user checks
@@ -502,7 +516,7 @@
my $requestedVersion = ( $setName =~ /,v(\d+)$/ ) ? $1 : 0;
$setName =~ s/,v\d+$//;
# note that if we're already working with a version we want to be sure to stick
-# with that version. we do this after we've validated that the user is
+# with that version. we do this after we've validated that the user is
# assigned the set, below
###################################
@@ -685,8 +699,8 @@
&&
( $effectiveUserName eq $userName ||
( $authz->hasPermissions($userName, "record_answers_when_acting_as_student") ||
- $verCreateOK ) )
-
+ ( $authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student") && $verCreateOK ) ) )
+
) {
# assign set, get the right name, version
# number, etc., and redefine the $set
@@ -698,14 +712,17 @@
# get a clean version of the set to save,
# and the merged version to use in the
# rest of the routine
- my $cleanSet = $db->getSetVersion($userName,
- $setName,
- $setVersionNumber);
- $set = $db->getMergedSetVersion($userName,
- $setName,
- $setVersionNumber);
+ my $cleanSet = $db->getSetVersion(
+ $effectiveUserName, $setName,
+ $setVersionNumber);
+ $set = $db->getMergedSetVersion(
+ $effectiveUserName, $setName,
+ $setVersionNumber );
+
+ $Problem = $db->getMergedProblemVersion(
+ $effectiveUserName, $setName,
+ $setVersionNumber, 1);
- $Problem = $db->getMergedProblemVersion($userName, $setName, $setVersionNumber, 1);
# because we're creating this on the fly,
# it should be published
$set->published(1);
@@ -753,13 +770,30 @@
"maximum number\nallowed.";
} elsif ( $effectiveUserName ne $userName &&
- ! $authz->hasPermissions($userName, "record_answers_when_acting_as_student") ) {
+ $authz->hasPermissions($userName, "create_new_set_version_when_acting_as_student") ) {
+ $self->{invalidSet} = "User " .
+ "$effectiveUserName is being acted " .
+ "as. If you continue, you will " .
+ "create a new version of this set " .
+ "for that user, which will count " .
+ "against their allowed maximum " .
+ "number of versions for the current " .
+ "time interval. IN GENERAL, THIS " .
+ "IS NOT WHAT YOU WANT TO DO. " .
+ "Please be sure that you want to " .
+ "do this before clicking the \"" .
+ "Create new set version\" link " .
+ "below. Alternately, PRESS THE " .
+ "\"BACK\" BUTTON and continue.";
+ $self->{invalidVersionCreation} = 1;
+
+ } elsif ( $effectiveUserName ne $userName ) {
$self->{invalidSet} = "User " .
"$effectiveUserName is being acted " .
"as. When acting as another user, " .
"new versions of the set cannot be " .
"created.";
- $self->{invalidVersionCreation} = 1;
+ $self->{invalidVersionCreation} = 2;
} elsif ($currentNumAttempts < $maxAttemptsPerVersion &&
$timeNow < $set->due_date() + $grace ) {
@@ -784,10 +818,6 @@
"You may take the\ntest again after " .
"the time interval has expired.";
- } elsif ( $effectiveUserName ne $userName ) {
- $self->{invalidSet} = "You are acting as a " .
- "student, and cannot start new " .
- "versions of a set for the student.";
}
} else {
@@ -799,7 +829,7 @@
&&
( $effectiveUserName eq $userName ||
$authz->hasPermissions($userName,
- "record_answers_when_acting_as_student") )
+ "record_set_version_answers_when_acting_as_student") )
) {
if ( between($set->open_date(),
$set->due_date() + $grace,
@@ -1153,8 +1183,9 @@
}
my $newlink = '';
+ my $usernote = '';
if ( defined( $self->{invalidVersionCreation} ) &&
- $self->{invalidVersionCreation} ) {
+ $self->{invalidVersionCreation} == 1 ) {
my $gwpage = $urlpath->newFromModule($urlpath->module,
courseID=>$urlpath->arg("courseID"),
setID=>$urlpath->arg("setID"));
@@ -1164,12 +1195,17 @@
createnew_ok => 1} );
$newlink = CGI::p(CGI::a({href=>$link},
"Create new set version."));
+ $usernote = " (acted as by $user)";
+ } elsif ( defined( $self->{invalidVersionCreation} ) &&
+ $self->{invalidVersionCreation} == 2 ) {
+ $usernote = " (acted as by $user)";
}
return CGI::div({class=>"ResultsWithError"},
CGI::p("The selected problem set (" .
$urlpath->arg("setID") . ") is not " .
- "a valid set for $effectiveUser:"),
+ "a valid set for $effectiveUser" .
+ "$usernote:"),
CGI::p($self->{invalidSet}),
$newlink);
}
@@ -1677,11 +1713,13 @@
-value=>$set->due_date()}), "\n";
print CGI::endform();
- if ( $timeLeft < 1 && $timeLeft > 0 ) {
+ if ( $timeLeft < 1 && $timeLeft > 0 &&
+ ! $authz->hasPermissions($user, "record_answers_when_acting_as_student")) {
print CGI::span({-class=>"resultsWithError"},
CGI::b("You have less than 1 minute ",
"to complete this test.\n"));
- } elsif ( $timeLeft <= 0 ) {
+ } elsif ( $timeLeft <= 0 &&
+ ! $authz->hasPermissions($user, "record_answers_when_acting_as_student") ) {
print CGI::span({-class=>"resultsWithError"},
CGI::b("You are out of time. ",
"Press grade now!\n"));
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 14:39:53
|
Log Message:
-----------
Revise fields shown when editing set versions.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetDetail.pm
Revision Data
-------------
Index: ProblemSetDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm,v
retrieving revision 1.70
retrieving revision 1.71
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -u -r1.70 -r1.71
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
@@ -563,6 +563,13 @@
foreach my $gwfield ( @{ GATEWAY_SET_FIELD_ORDER() } ) {
+ # don't show template gateway fields when editing
+ # set versions
+ next if ( ( $gwfield eq "time_interval" ||
+ $gwfield eq "versions_per_interval" ) &&
+ ( $forUsers &&
+ $userRecord->can('version_id') ) );
+
my @fieldData =
($self->FieldHTML($userID, $setID, undef,
$globalRecord, $userRecord,
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-23 14:39:31
|
Log Message:
-----------
Correct handling of null max_attempts fields in the problem_user
database table.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
GatewayQuiz.pm
Revision Data
-------------
Index: GatewayQuiz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v
retrieving revision 1.50
retrieving revision 1.51
diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -u -r1.50 -r1.51
--- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
+++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
@@ -479,6 +479,11 @@
my $effectiveUserName = $r->param('effectiveUser');
my $key = $r->param('key');
+ # should we allow a new version to be created when
+ # acting as a user?
+ my $verCreateOK = ( defined( $r->param('createnew_ok') ) ) ?
+ $r->param('createnew_ok') : 0;
+
# user checks
my $User = $db->getUser($userName);
die "record for user $userName (real user) does not exist."
@@ -614,12 +619,13 @@
$Problem->num_correct() +
$Problem->num_incorrect() : 0 );
- # $maxAttempts turns into the maximum number of versions we can create;
- # if $Problem isn't defined, we can't have made any attempts, so it
+ # $maxAttempts turns into the maximum number of versions we can create;
+ # if $Problem isn't defined, we can't have made any attempts, so it
# doesn't matter
my $maxAttempts = ( defined($Problem) &&
- defined($Problem->max_attempts()) ?
- $Problem->max_attempts() : -1 );
+ defined($Problem->max_attempts()) &&
+ $Problem->max_attempts() ) ?
+ $Problem->max_attempts() : -1;
# finding the number of versions per time interval is a little harder.
# we interpret the time interval as a rolling interval: that is,
@@ -661,25 +667,27 @@
# if no specific version is requested, we can create a new one if
# need be
- if ( ! $requestedVersion ) {
- if ( ( $maxAttempts == -1 ||
+ if ( ! $requestedVersion ) {
+ if ( ( $maxAttempts == -1 ||
$totalNumVersions < $maxAttempts )
&&
( $setVersionNumber == 0 ||
- (
- ( $currentNumAttempts>=$maxAttemptsPerVersion
+ (
+ ( $currentNumAttempts>=$maxAttemptsPerVersion
||
$timeNow >= $set->due_date + $grace )
&&
( ! $versionsPerInterval
||
- $currentNumVersions < $versionsPerInterval )
- )
+ $currentNumVersions < $versionsPerInterval )
+ )
)
&&
( $effectiveUserName eq $userName ||
- $authz->hasPermissions($userName, "record_answers_when_acting_as_student") )
- ) {
+ ( $authz->hasPermissions($userName, "record_answers_when_acting_as_student") ||
+ $verCreateOK ) )
+
+ ) {
# assign set, get the right name, version
# number, etc., and redefine the $set
# and $Problem we're working with
@@ -751,6 +759,7 @@
"as. When acting as another user, " .
"new versions of the set cannot be " .
"created.";
+ $self->{invalidVersionCreation} = 1;
} elsif ($currentNumAttempts < $maxAttemptsPerVersion &&
$timeNow < $set->due_date() + $grace ) {
@@ -1143,11 +1152,26 @@
}
}
+ my $newlink = '';
+ if ( defined( $self->{invalidVersionCreation} ) &&
+ $self->{invalidVersionCreation} ) {
+ my $gwpage = $urlpath->newFromModule($urlpath->module,
+ courseID=>$urlpath->arg("courseID"),
+ setID=>$urlpath->arg("setID"));
+ my $link = $self->systemLink( $gwpage,
+ params=>{effectiveUser => $effectiveUser,
+ user => $user,
+ createnew_ok => 1} );
+ $newlink = CGI::p(CGI::a({href=>$link},
+ "Create new set version."));
+ }
+
return CGI::div({class=>"ResultsWithError"},
CGI::p("The selected problem set (" .
$urlpath->arg("setID") . ") is not " .
"a valid set for $effectiveUser:"),
- CGI::p($self->{invalidSet}));
+ CGI::p($self->{invalidSet}),
+ $newlink);
}
my $tmplSet = $self->{tmplSet};
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-21 17:13:46
|
Log Message:
-----------
Formatting changes.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
CourseAdmin.pm
Revision Data
-------------
Index: CourseAdmin.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v
retrieving revision 1.74
retrieving revision 1.75
diff -Llib/WeBWorK/ContentGenerator/CourseAdmin.pm -Llib/WeBWorK/ContentGenerator/CourseAdmin.pm -u -r1.74 -r1.75
--- lib/WeBWorK/ContentGenerator/CourseAdmin.pm
+++ lib/WeBWorK/ContentGenerator/CourseAdmin.pm
@@ -2430,104 +2430,106 @@
################################################################################
our $registered_file_name = "registered_$main::VERSION";
-sub display_registration_form {
-my $self = shift;
-my $ce = $self->r->ce;
-my $registeredQ = (-e ($ce->{courseDirs}->{root})."/$registered_file_name")?1:0;
-my $registration_subDisplay = ( $self->{method_to_call} eq "registration_form") ? 1: 0;
-return 0 if $registeredQ or $self->r->param("register_site"); #otherwise return registration form
-return q!
-<center>
-<table class="messagebox" style="background-color:#FFFFCC;width:60%">
-<tr><td>
-!,
-CGI::p("If you are using your WeBWorK server for courses please help us out by registering your server."),
-CGI::p("We are often asked how many institutions are using WeBWorK and how many students are using
-WeBWorK Since WeBWorK is open source and can be freely downloaded from http://www.openwebwork.org
-and http://webwork.maa.org it is frequently difficult for us to give a reasonable answer to this
-question."),
-CGI::p("You can help by registering your current version of WeBWorK -- click the button, answer a few
-questions (the ones you can answer easily) and send the email. It takes less than two minutes. Thank you!. -- The WeBWorK Team"),
-q!
-</td>
-</tr>
-<tr><td align="center">
-!,
-CGI::a({href=>$self->systemLink($self->r->urlpath, params=>{subDisplay=>"registration"})}, "Register"),
-q!
-</td></tr>
-</table>
-</center>
-!;
+sub display_registration_form {
+ my $self = shift;
+ my $ce = $self->r->ce;
+ my $registeredQ = (-e ($ce->{courseDirs}->{root})."/$registered_file_name")?1:0;
+ #my $registration_subDisplay = ( $self->{method_to_call} eq "registration_form") ? 1: 0;
+ return 0 if $registeredQ or $self->r->param("register_site"); #otherwise return registration form
+ return q!
+ <center>
+ <table class="messagebox" style="background-color:#FFFFCC;width:60%">
+ <tr><td>
+ !,
+ CGI::p("If you are using your WeBWorK server for courses please help us out by registering your server."),
+ CGI::p("We are often asked how many institutions are using WeBWorK and how many students are using
+ WeBWorK Since WeBWorK is open source and can be freely downloaded from http://www.openwebwork.org
+ and http://webwork.maa.org it is frequently difficult for us to give a reasonable answer to this
+ question."),
+ CGI::p("You can help by registering your current version of WeBWorK -- click the button, answer a few
+ questions (the ones you can answer easily) and send the email. It takes less than two minutes. Thank you!. -- The WeBWorK Team"),
+ q!
+ </td>
+ </tr>
+ <tr><td align="center">
+ !,
+ CGI::a({href=>$self->systemLink($self->r->urlpath, params=>{subDisplay=>"registration"})}, "Register"),
+ q!
+ </td></tr>
+ </table>
+ </center>
+ !;
+
}
-sub registration_form {
-my $self = shift;
-my $ce = $self->r->ce;
-
-print "<center>";
-print "\n",CGI::p({style=>"text-align: left; width:60%"},
-"\nPlease ",
-CGI::a({href=>'mailto:ga...@ma...?'
-.'subject=WeBWorK%20Server%20Registration'
-.'&body='
-.uri_escape("Thanks for registering your WeBWorK server. We'd appreciate if you would answer
-as many of these questions as you can conveniently. We need this data so we can better
-answer questions such as 'How many institutions have webwork servers?' and 'How many students
-use WeBWorK?'. Your email and contact information will be kept private. We will
-list your institution as one that uses WeBWorK unless you tell us to keep that private as well.
-\n\nThank you. \n\n--Mike Gage \n\n
-")
-.uri_escape("Server URL: ".$ce->{apache_root_url}." \n\n")
-.uri_escape("WeBWorK version: $main::VERSION \n\n")
-.uri_escape("Institution name (e.g. University of Rochester): \n\n")
-.uri_escape("Contact person name: \n\n")
-.uri_escape("Contact email: \n\n")
-.uri_escape("Approximate number of courses run each term: \n\n")
-.uri_escape("Approximate number of students using this server each term: \n\n")
-.uri_escape("Other institutions who use WeBWorK courses hosted on this server: \n\n")
-.uri_escape("Other comments: \n\n")
-},
-'click here'),
-q! to open your email application. There are a few questions, some of which have already
-been filled in for your installation. Fill in the other questions which you can answer easily and send
-the email to gage\@math.rochester.edu
-!
-);
-
-
-print "\n",CGI::p({style=>"text-align: left; width:60%"},q!Once you have emailed your registration information you can hide the "registration" banner
-for successive visits by clicking
-the button below.!)
-;
-
-print "</center>";
-print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
-print $self->hidden_authen_fields;
-print $self->hidden_fields("subDisplay");
-print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"register_site", -label=>"Site has been registered"));
-print CGI::end_form();
+sub registration_form {
+ my $self = shift;
+ my $ce = $self->r->ce;
+
+ print "<center>";
+ print "\n",CGI::p({style=>"text-align: left; width:60%"},
+ "\nPlease ",
+ CGI::a({href=>'mailto:ga...@ma...?'
+ .'subject=WeBWorK%20Server%20Registration'
+ .'&body='
+ .uri_escape("Thanks for registering your WeBWorK server. We'd appreciate if you would answer
+ as many of these questions as you can conveniently. We need this data so we can better
+ answer questions such as 'How many institutions have webwork servers?' and 'How many students
+ use WeBWorK?'. Your email and contact information will be kept private. We will
+ list your institution as one that uses WeBWorK unless you tell us to keep that private as well.
+ \n\nThank you. \n\n--Mike Gage \n\n
+ ")
+ .uri_escape("Server URL: ".$ce->{apache_root_url}." \n\n")
+ .uri_escape("WeBWorK version: $main::VERSION \n\n")
+ .uri_escape("Institution name (e.g. University of Rochester): \n\n")
+ .uri_escape("Contact person name: \n\n")
+ .uri_escape("Contact email: \n\n")
+ .uri_escape("Approximate number of courses run each term: \n\n")
+ .uri_escape("Approximate number of students using this server each term: \n\n")
+ .uri_escape("Other institutions who use WeBWorK courses hosted on this server: \n\n")
+ .uri_escape("Other comments: \n\n")
+ },
+ 'click here'),
+ q! to open your email application. There are a few questions, some of which have already
+ been filled in for your installation. Fill in the other questions which you can answer easily and send
+ the email to gage\@math.rochester.edu
+ !
+ );
+
+
+
+ print "\n",CGI::p({style=>"text-align: left; width:60%"},q!Once you have emailed your registration information you can hide the "registration" banner
+ for successive visits by clicking
+ the button below.!)
+ ;
+
+ print "</center>";
+ print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
+ print $self->hidden_authen_fields;
+ print $self->hidden_fields("subDisplay");
+ print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"register_site", -label=>"Site has been registered"));
+ print CGI::end_form();
}
sub do_registration {
-my $self = shift;
-my $ce = $self->r->ce;
-my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name";
-# warn qq!`echo "info" >$registered_file_path`!;
-`echo "info" >$registered_file_path`;
-
-print "\n<center>",CGI::p({style=>"text-align: left; width:60%"},q{Registration action completed. Thank you very much for registering WeBWorK!"});
-
-print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
-print $self->hidden_authen_fields;
-print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"registration_completed", -label=>"Continue"));
-print CGI::end_form();
-print "</center>";
+ my $self = shift;
+ my $ce = $self->r->ce;
+ my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name";
+ # warn qq!`echo "info" >$registered_file_path`!;
+ `echo "info" >$registered_file_path`;
+
+ print "\n<center>",CGI::p({style=>"text-align: left; width:60%"},q{Registration action completed. Thank you very much for registering WeBWorK!"});
+
+ print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
+ print $self->hidden_authen_fields;
+ print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"registration_completed", -label=>"Continue"));
+ print CGI::end_form();
+ print "</center>";
}
################################################################################
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-21 17:13:43
|
Log Message:
-----------
Pass permissionLevel to the PG question environment
allows the question to behave differently if the actual viewer is an
instructor. (The effectiveUser is the student for whom the
question was constructed -- the user -- is the person viewing the problem
which might be the student or it might be an instructor acting as the student
The permissionLevel is the one assigned to the "user".
Modified Files:
--------------
webwork2/lib/WeBWorK:
PG.pm
webwork2/lib/WeBWorK/ContentGenerator:
Problem.pm
Revision Data
-------------
Index: PG.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/PG.pm,v
retrieving revision 1.73
retrieving revision 1.74
diff -Llib/WeBWorK/PG.pm -Llib/WeBWorK/PG.pm -u -r1.73 -r1.74
--- lib/WeBWorK/PG.pm
+++ lib/WeBWorK/PG.pm
@@ -118,6 +118,7 @@
$envir{studentLogin} = $user->user_id;
$envir{studentName} = $user->first_name . " " . $user->last_name;
$envir{studentID} = $user->student_id;
+ $envir{permissionLevel} = $options->{permissionLevel};
# Answer Information
# REMOVED: refSubmittedAnswers
Index: Problem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v
retrieving revision 1.214
retrieving revision 1.215
diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGenerator/Problem.pm -u -r1.214 -r1.215
--- lib/WeBWorK/ContentGenerator/Problem.pm
+++ lib/WeBWorK/ContentGenerator/Problem.pm
@@ -609,9 +609,10 @@
showSolutions => $will{showSolutions},
refreshMath2img => $will{showHints} || $will{showSolutions},
processAnswers => 1,
+ permissionLevel => $db->getPermissionLevel($userName)->permission,
},
);
-
+
debug("end pg processing");
##### fix hint/solution options #####
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-21 17:13:41
|
Log Message:
-----------
Added information on error in AUTOLOAD
Modified Files:
--------------
webwork2/lib/WeBWorK/DB/Schema:
NewSQL.pm
Revision Data
-------------
Index: NewSQL.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Schema/NewSQL.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/WeBWorK/DB/Schema/NewSQL.pm -Llib/WeBWorK/DB/Schema/NewSQL.pm -u -r1.24 -r1.25
--- lib/WeBWorK/DB/Schema/NewSQL.pm
+++ lib/WeBWorK/DB/Schema/NewSQL.pm
@@ -334,7 +334,8 @@
if (exists $API{$2}) {
croak sprintf("%s does not implement &%s", $1, $2);
} else {
- croak sprintf("Undefined subroutine &%s called", $AUTOLOAD);
+ warn caller();
+ croak sprintf("Undefined subroutine &%s called ", $AUTOLOAD);
}
}
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-21 16:44:59
|
Log Message:
-----------
Give more information in error message.
Modified Files:
--------------
webwork2/lib:
WebworkSOAP.pm
Revision Data
-------------
Index: WebworkSOAP.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkSOAP.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/WebworkSOAP.pm -Llib/WebworkSOAP.pm -u -r1.11 -r1.12
--- lib/WebworkSOAP.pm
+++ lib/WebworkSOAP.pm
@@ -50,7 +50,7 @@
}
#Construct DB handle
my $db = eval { new WeBWorK::DB($ce->{dbLayout}); };
- $@ and soap_fault_major("Failed to initialize database handle.");
+ $@ and soap_fault_major("Failed to initialize database handle.<br>$@");
$self->{db} = $db;
$self->{ce} = $ce;
bless $self;
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-21 16:43:56
|
Log Message:
-----------
Update version to 2.4.5
Modified Files:
--------------
webwork2/lib:
WeBWorK.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK.pm,v
retrieving revision 1.100
retrieving revision 1.101
diff -Llib/WeBWorK.pm -Llib/WeBWorK.pm -u -r1.100 -r1.101
--- lib/WeBWorK.pm
+++ lib/WeBWorK.pm
@@ -34,7 +34,7 @@
=cut
-BEGIN { $main::VERSION = "2.x"; }
+BEGIN { $main::VERSION = "2.4.5"; }
use strict;
use warnings;
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-21 07:13:38
|
Log Message:
-----------
Allow instructors to edit versions of an assignment. This requires
that the input setID have ,vN appended, where N is the version number
to edit. The ability to edit and try problems from gateway tests
remains problematic, however.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetDetail.pm
Revision Data
-------------
Index: ProblemSetDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm,v
retrieving revision 1.69
retrieving revision 1.70
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -u -r1.69 -r1.70
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
@@ -331,6 +331,8 @@
my $gwFields = '';
# $isGWset will come in undef if we don't need to worry about it
$isGWset = 0 if ( ! defined( $isGWset ) );
+ # are we editing a set version?
+ my $setVersion = (defined($userRecord) && $userRecord->can("version_id")) ? 1 : 0;
# needed for ip restrictions
my $ipFields = '';
@@ -364,9 +366,9 @@
# we don't show the ip restriction option if there are
# no defined locations, nor the relax_restrict_ip option
# if we're not restricting ip access
- next if ( $field eq 'restrict_ip' && ! $numLocations );
- next if ($field eq 'relax_restrict_ip' &&
- (! $numLocations ||
+ next if ( $field eq 'restrict_ip' && ( ! $numLocations || $setVersion ) );
+ next if ($field eq 'relax_restrict_ip' &&
+ (! $numLocations || $setVersion ||
($forUsers && $userRecord->restrict_ip eq 'No') ||
(! $forUsers &&
( $globalRecord->restrict_ip eq '' ||
@@ -603,45 +605,48 @@
my @locations = sort {$a cmp $b} ($db->listLocations());
$numLocations = @locations;
- if ( ( ! $forUsers && $globalRecord->restrict_ip &&
- $globalRecord->restrict_ip ne 'No' ) ||
- ( $forUsers && $userRecord->restrict_ip ne 'No' ) ) {
-
- my @globalLocations = $db->listGlobalSetLocations($setID);
- # what ip locations should be selected?
- my @defaultLocations = ();
- if ( $forUsers &&
- ! $db->countUserSetLocations($userID, $setID) ) {
- @defaultLocations = @globalLocations;
- $ipOverride = 0;
- } elsif ( $forUsers ) {
- @defaultLocations = $db->listUserSetLocations($userID, $setID);
- $ipOverride = 1;
- } else {
- @defaultLocations = @globalLocations;
- }
- my $ipDefaults = join(', ', @globalLocations);
+ # we don't show ip selector fields if we're editing a set version
+ if ( defined( $userRecord ) && ! $userRecord->can("version_id") ) {
+ if ( ( ! $forUsers && $globalRecord->restrict_ip &&
+ $globalRecord->restrict_ip ne 'No' ) ||
+ ( $forUsers && $userRecord->restrict_ip ne 'No' ) ) {
+
+ my @globalLocations = $db->listGlobalSetLocations($setID);
+ # what ip locations should be selected?
+ my @defaultLocations = ();
+ if ( $forUsers &&
+ ! $db->countUserSetLocations($userID, $setID) ) {
+ @defaultLocations = @globalLocations;
+ $ipOverride = 0;
+ } elsif ( $forUsers ) {
+ @defaultLocations = $db->listUserSetLocations($userID, $setID);
+ $ipOverride = 1;
+ } else {
+ @defaultLocations = @globalLocations;
+ }
+ my $ipDefaults = join(', ', @globalLocations);
- my $ipSelector = CGI::scrolling_list({
- -name => "set.$setID.selected_ip_locations",
- -values => [ @locations ],
- -default => [ @defaultLocations ],
- -size => 5,
- -multiple => 'true'});
+ my $ipSelector = CGI::scrolling_list({
+ -name => "set.$setID.selected_ip_locations",
+ -values => [ @locations ],
+ -default => [ @defaultLocations ],
+ -size => 5,
+ -multiple => 'true'});
- my $override = ($forUsers) ?
- CGI::checkbox({ type => "checkbox",
+ my $override = ($forUsers) ?
+ CGI::checkbox({ type => "checkbox",
name => "set.$setID.selected_ip_locations.override",
label => "",
checked => $ipOverride }) : '';
- $ipFields .= CGI::Tr({-valign=>'top'},
- CGI::td({}, [ $override,
+ $ipFields .= CGI::Tr({-valign=>'top'},
+ CGI::td({}, [ $override,
'Restrict Locations',
$ipSelector,
$forUsers ?
" $ipDefaults" : '', ]
),
- );
+ );
+ }
}
return($gwFields, $ipFields, $numLocations, $procFields);
}
@@ -856,6 +861,15 @@
my $authz = $r->authz;
my $user = $r->param('user');
my $setID = $r->urlpath->arg("setID");
+
+ ## we're now allowing setID to come in as setID,v# to edit a set
+ ## version; catch this first
+ my $editingSetVersion = 0;
+ if ( $setID =~ /,v(\d+)$/ ) {
+ $editingSetVersion = $1;
+ $setID =~ s/,v(\d+)$//;
+ }
+
my $setRecord = $db->getGlobalSet($setID); # checked
die "global set $setID not found." unless $setRecord;
@@ -869,6 +883,9 @@
return unless ($authz->hasPermissions($user, "access_instructor_tools"));
return unless ($authz->hasPermissions($user, "modify_problem_sets"));
+ ## if we're editing a versioned set, it only makes sense to be
+ ## editing it for one user
+ return if ( $editingSetVersion && ! $forOneUser );
my %properties = %{ FIELD_PROPERTIES() };
@@ -954,6 +971,19 @@
# DBFIXME use a WHERE clause, iterator
my @userRecords = $db->getUserSets(map { [$_, $setID] } @editForUser);
+ # if we're editing a set version, we want to edit
+ # edit that instead of the userset, so get it
+ # too.
+ my $userSet = $userRecords[0];
+ my $setVersion = 0;
+ if ( $editingSetVersion ) {
+ $setVersion =
+ $db->getSetVersion($editForUser[0],
+ $setID,
+ $editingSetVersion);
+ @userRecords = ( $setVersion );
+ }
+
foreach my $record (@userRecords) {
foreach my $field ( @{ SET_FIELDS() } ) {
next unless canChange($forUsers, $field);
@@ -1006,7 +1036,11 @@
# $record->hide_score_by_problem('N');
# }
####################
- $db->putUserSet($record);
+ if ( $editingSetVersion ) {
+ $db->putSetVersion( $record );
+ } else {
+ $db->putUserSet($record);
+ }
}
#######################################################
@@ -1016,40 +1050,47 @@
# hash, so that we don't have to assume that we can
# override this information for users
- if ( $r->param("set.$setID.selected_ip_locations.override") ) {
- foreach my $record ( @userRecords ) {
- my $userID = $record->user_id;
- my @selectedLocations = $r->param("set.$setID.selected_ip_locations");
- my @userSetLocations = $db->listUserSetLocations($userID,$setID);
- my @addSetLocations = ();
- my @delSetLocations = ();
- foreach my $loc ( @selectedLocations ) {
- push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) );
- }
- foreach my $loc ( @userSetLocations ) {
- push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) );
- }
- # then update the user set_locations
- foreach ( @addSetLocations ) {
- my $Loc = $db->newUserSetLocation;
- $Loc->set_id( $setID );
- $Loc->user_id( $userID );
- $Loc->location_id($_);
- $db->addUserSetLocation($Loc);
- }
- foreach ( @delSetLocations ) {
- $db->deleteUserSetLocation($userID,$setID,$_);
+ ## should we allow resetting set locations for set versions? this
+ ## requires either putting in a new set of database routines
+ ## to deal with the versioned setID, or fudging it at this end
+ ## by manually putting in the versioned ID setID,v#. neither
+ ## of these seems desirable, so for now it's not allowed
+ if ( ! $editingSetVersion ) {
+ if ( $r->param("set.$setID.selected_ip_locations.override") ) {
+ foreach my $record ( @userRecords ) {
+ my $userID = $record->user_id;
+ my @selectedLocations = $r->param("set.$setID.selected_ip_locations");
+ my @userSetLocations = $db->listUserSetLocations($userID,$setID);
+ my @addSetLocations = ();
+ my @delSetLocations = ();
+ foreach my $loc ( @selectedLocations ) {
+ push( @addSetLocations, $loc ) if ( ! grep( /^$loc$/, @userSetLocations ) );
+ }
+ foreach my $loc ( @userSetLocations ) {
+ push( @delSetLocations, $loc ) if ( ! grep( /^$loc$/, @selectedLocations ) );
+ }
+ # then update the user set_locations
+ foreach ( @addSetLocations ) {
+ my $Loc = $db->newUserSetLocation;
+ $Loc->set_id( $setID );
+ $Loc->user_id( $userID );
+ $Loc->location_id($_);
+ $db->addUserSetLocation($Loc);
+ }
+ foreach ( @delSetLocations ) {
+ $db->deleteUserSetLocation($userID,$setID,$_);
+ }
}
- }
- } else {
- # if override isn't selected, then we want
- # to be sure that there are no
- # set_locations_user entries setting around
- foreach my $record ( @userRecords ) {
- my $userID = $record->user_id;
- my @userLocations = $db->listUserSetLocations($userID,$setID);
- foreach ( @userLocations ) {
- $db->deleteUserSetLocation($userID,$setID,$_);
+ } else {
+ # if override isn't selected, then we want
+ # to be sure that there are no
+ # set_locations_user entries setting around
+ foreach my $record ( @userRecords ) {
+ my $userID = $record->user_id;
+ my @userLocations = $db->listUserSetLocations($userID,$setID);
+ foreach ( @userLocations ) {
+ $db->deleteUserSetLocation($userID,$setID,$_);
+ }
}
}
}
@@ -1226,9 +1267,18 @@
# in the GlobalProblem record or for fields unique to the UserProblem record.
my @userIDs = @editForUser;
- my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs;
- # DBFIXME where clause? iterator?
- my @userProblemRecords = $db->getUserProblems(@userProblemIDs);
+
+ my @userProblemRecords;
+ if ( ! $editingSetVersion ) {
+ my @userProblemIDs = map { [$_, $setID, $problemID] } @userIDs;
+ # DBFIXME where clause? iterator?
+ @userProblemRecords = $db->getUserProblems(@userProblemIDs);
+ } else {
+ ## (we know that we're only editing for one user)
+ @userProblemRecords =
+ ( $db->getMergedProblemVersion( $userIDs[0], $setID, $editingSetVersion, $problemID ) );
+ }
+
foreach my $record (@userProblemRecords) {
my $changed = 0; # keep track of any changes, if none are made, avoid unnecessary db accesses
@@ -1261,7 +1311,11 @@
$changed ||= changed($record->$field, $param);
$record->$field($param);
}
- $db->putUserProblem($record) if $changed;
+ if ( ! $editingSetVersion ) {
+ $db->putUserProblem($record) if $changed;
+ } else {
+ $db->putProblemVersion($record) if $changed;
+ }
}
} else {
# Since we're editing for ALL set users, we will make changes to the GlobalProblem record.
@@ -1320,7 +1374,9 @@
}
}
- # Mark the specified problems as correct for all users
+ # Mark the specified problems as correct for all users (not applicable when editing a set
+ # version, because this only shows up when editing for users or editing the
+ # global set/problem, not for one user)
foreach my $problemID ($r->param('markCorrect')) {
# DBFIXME where clause, iterator
my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID));
@@ -1357,7 +1413,8 @@
}
}
- # Delete all problems marked for deletion
+ # Delete all problems marked for deletion (not applicable when editing
+ # for users)
foreach my $problemID ($r->param('deleteProblem')) {
$db->deleteGlobalProblem($setID, $problemID);
}
@@ -1523,6 +1580,16 @@
my $urlpath = $r->urlpath;
my $courseID = $urlpath->arg("courseID");
my $setID = $urlpath->arg("setID");
+
+ ## we're now allowing setID to come in as setID,v# to edit a set
+ ## version; catch this first
+ my $editingSetVersion = 0;
+ my $fullSetID = $setID;
+ if ( $setID =~ /,v(\d+)$/ ) {
+ $editingSetVersion = $1;
+ $setID =~ s/,v(\d+)$//;
+ }
+
my $setRecord = $db->getGlobalSet($setID) or die "No record for global set $setID.";
my $userRecord = $db->getUser($userID) or die "No record for user $userID.";
@@ -1535,6 +1602,9 @@
my @editForUser = $r->param('editForUser');
+ return CGI::div({class=>"ResultsWithError"}, "Versions of a set can only be " .
+ "edited for one user at a time.") if ( $editingSetVersion && @editForUser != 1 );
+
# Check that every user that we're editing for has a valid UserSet
my @assignedUsers;
my @unassignedUsers;
@@ -1557,11 +1627,17 @@
print CGI::div({class=>"ResultsWithError"}, "Global set data will be shown instead of user specific data");
}
}
-
+
# some useful booleans
my $forUsers = scalar(@editForUser);
my $forOneUser = $forUsers == 1;
+ # and check that if we're editing a set version for a user, that
+ # it exists as well
+ if ( $editingSetVersion && ! $db->existsSetVersion( $editForUser[0], $setID, $editingSetVersion ) ) {
+ return CGI::div({class=>"ResultsWithError"}, "The set-version ($setID, version $editingSetVersion) is not assigned to user $editForUser[0].");
+ }
+
# If you're editing for users, initially their records will be different but
# if you make any changes to them they will be the same.
# if you're editing for one user, the problems shown should be his/hers
@@ -1574,7 +1650,8 @@
my $userCount = $db->listUsers();
my $setCount = $db->listGlobalSets(); # if $forOneUser;
my $setUserCount = $db->countSetUsers($setID);
- my $userSetCount = $db->countUserSets($editForUser[0]) if $forOneUser;
+# if $forOneUser;
+ my $userSetCount = ($forOneUser && @editForUser) ? $db->countUserSets($editForUser[0]) : 0;
my $editUsersAssignedToSetURL = $self->systemLink(
@@ -1588,8 +1665,8 @@
my $setDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $setID);
- my $setDetailURL = $self->systemLink($setDetailPage, authen=>0);
-
+ my $fullsetDetailPage = $urlpath -> newFromModule($urlpath->module, courseID => $courseID, setID => $fullSetID);
+ my $setDetailURL = $self->systemLink($fullsetDetailPage, authen=>0);
my $userCountMessage = CGI::a({href=>$editUsersAssignedToSetURL}, $self->userCountMessage($setUserCount, $userCount));
my $setCountMessage = CGI::a({href=>$editSetsAssignedToUserURL}, $self->setCountMessage($userSetCount, $setCount)) if $forOneUser;
@@ -1603,25 +1680,43 @@
##############################################
my @userLinks = ();
foreach my $userID (@editForUser) {
- my $u = $db->getUser($userID);
- my $email_address = $u->email_address;
- my $line = $u->last_name.", ".$u->first_name." (".CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id."). Assigned to ";
- my $editSetsAssignedToUserURL = $self->systemLink(
- $urlpath->newFromModule(
- "WeBWorK::ContentGenerator::Instructor::UserDetail",
- courseID => $courseID, userID => $u->user_id));
- $line .= CGI::a({href=>$editSetsAssignedToUserURL},
- $self->setCountMessage($db->countUserSets($u->user_id), $setCount));
- unshift @userLinks,$line;
+ my $u = $db->getUser($userID);
+ my $email_address = $u->email_address;
+ my $line = $u->last_name.", " . $u->first_name . " (" .
+ CGI::a({-href=>"mailto:$email_address"},"email "). $u->user_id .
+ "). ";
+ if ( ! $editingSetVersion ) {
+ $line .= "Assigned to ";
+ my $editSetsAssignedToUserURL = $self->systemLink(
+ $urlpath->newFromModule(
+ "WeBWorK::ContentGenerator::Instructor::UserDetail",
+ courseID => $courseID, userID => $u->user_id));
+ $line .= CGI::a({href=>$editSetsAssignedToUserURL},
+ $self->setCountMessage($db->countUserSets($u->user_id),
+ $setCount));
+ } else {
+ my $editSetLink = $self->systemLink( $setDetailPage,
+ params=>{effectiveUser=>$u->user_id,
+ editForUser =>$u->user_id} );
+ $line .= "Edit set " . CGI::a({href=>$editSetLink},$setID) .
+ " for this user.";
+ }
+ unshift @userLinks,$line;
}
@userLinks = sort @userLinks;
+ # handy messages when editing gateway sets
+ my $gwmsg = ( $isGatewaySet && ! $editingSetVersion ) ?
+ CGI::br() . CGI::em("To edit a specific student version of this set, " .
+ "edit (all of) her/his assigned sets.") : "";
+ my $vermsg = ( $editingSetVersion ) ? ", test $editingSetVersion" : "";
+
print CGI::table({border=>2,cellpadding=>10},
CGI::Tr({},
CGI::td([
- "Editing problem set ".CGI::strong($setID)." data for these individual students:".CGI::br().
+ "Editing problem set ".CGI::strong($setID . $vermsg)." data for these individual students:".CGI::br().
CGI::strong(join CGI::br(), @userLinks),
- CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set."),
+ CGI::a({href=>$self->systemLink($setDetailPage) },"Edit set ".CGI::strong($setID)." data for ALL students assigned to this set.") . $gwmsg,
])
)
@@ -1713,6 +1808,13 @@
# pass it to FieldTable, so FieldTable can pass it to FieldHTML, so
# FieldHTML doesn't have to fetch it itself.
my $userSetRecord = $db->getUserSet($userToShow, $setID);
+
+ my $templateUserSetRecord;
+ # send in the set version if we're editing for versions
+ if ( $editingSetVersion ) {
+ $templateUserSetRecord = $userSetRecord;
+ $userSetRecord = $db->getSetVersion( $userToShow, $setID, $editingSetVersion );
+ }
print CGI::Tr({}, CGI::td({}, [
$self->FieldTable($userToShow, $setID, undef, $setRecord, $userSetRecord),
@@ -1852,7 +1954,12 @@
my @userKeypartsRef = map { [$editForUser[0], $setID, $_] } @problemIDList;
# DBFIXME shouldn't need to get key list here
@UserProblems{@problemIDList} = $db->getUserProblems(@userKeypartsRef);
- @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef);
+ if ( ! $editingSetVersion ) {
+ @MergedProblems{@problemIDList} = $db->getMergedProblems(@userKeypartsRef);
+ } else {
+ my @userversionKeypartsRef = map { [$editForUser[0], $setID, $editingSetVersion, $_] } @problemIDList;
+ @MergedProblems{@problemIDList} = $db->getMergedProblemVersions(@userversionKeypartsRef);
+ }
}
if (scalar @problemIDList) {
@@ -1879,12 +1986,18 @@
#$problemRecord = $db->getGlobalProblem($setID, $problemID);
$problemRecord = $GlobalProblems{$problemID}; # already fetched above --sam
}
-
+
#$self->addgoodmessage("");
#$self->addbadmessage($problemRecord->toString());
-
-
- my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID => $problemID });
+
+ # when we're editing a set version, we want to be sure to
+ # use the merged problem in the edit, because we could
+ # be using problem groups (for which the problem is generated
+ # and then stored in the problem version)
+ my $problemToShow = ( $editingSetVersion ) ?
+ $MergedProblems{$problemID} : $UserProblems{$problemID};
+
+ my $editProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $fullSetID, problemID => $problemID });
my $editProblemLink = $self->systemLink($editProblemPage, params => { make_local_copy => 0 });
@@ -1935,7 +2048,7 @@
# CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) .
($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) .
CGI::end_table(),
- $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}, $isGatewaySet),
+ $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $problemToShow, $isGatewaySet),
# A comprehensive list of problems is just TOO big to be handled well
# comboBox({
# name => "set.$setID.$problemID",
@@ -1950,7 +2063,7 @@
$setID,
$problemID,
$GlobalProblems{$problemID}, # pass previously fetched global record to FieldHTML --sam
- $UserProblems{$problemID}, # pass previously fetched user record to FieldHTML --sam
+ $problemToShow, # pass previously fetched user record to FieldHTML --sam
"source_file"
)) .
CGI::br() .
@@ -1980,25 +2093,22 @@
} else {
print CGI::p(CGI::b("This set doesn't contain any problems yet."));
}
- # always allow one to add a new problem.
- print CGI::checkbox({
- label=> "Add",
- name=>"add_blank_problem", value=>"1"}
+ # always allow one to add a new problem, unless we're editing a set version
+ if ( ! $editingSetVersion ) {
+ print CGI::checkbox({ label=> "Add",
+ name=>"add_blank_problem", value=>"1"}
),CGI::input({
- name=>"add_n_problems",
- size=>2,
- value=>1
- },
- "blank problem template(s) to end of homework set"
- ),
- CGI::br(),CGI::br(),
- CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}),
- CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}),
- "(Any unsaved changes will be lost.)"
- ;
+ name=>"add_n_problems",
+ size=>2,
+ value=>1 },
+ "blank problem template(s) to end of homework set"
+ );
+ }
+ print CGI::br(),CGI::br(),
+ CGI::input({type=>"submit", name=>"submit_changes", value=>"Save Changes"}),
+ CGI::input({type=>"submit", name=>"handle_numbers", value=>"Reorder problems only"}),
+ "(Any unsaved changes will be lost.)";
-
-
#my $editNewProblemPage = $urlpath->new(type => 'instructor_problem_editor_withset_withproblem', args => { courseID => $courseID, setID => $setID, problemID =>'new_problem' });
#my $editNewProblemLink = $self->systemLink($editNewProblemPage, params => { make_local_copy => 1, file_type => 'blank_problem' });
# This next feature isn't fully supported and is causing problems. Remove for now. #FIXME
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-21 04:43:38
|
Log Message:
-----------
Update to minimize the data that are saved when a new version of a
gateway assignment is created. This allows things like set invisibility
to propagate to all set versions that have been created, and cleans
up the stored data.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
GatewayQuiz.pm
Revision Data
-------------
Index: GatewayQuiz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v
retrieving revision 1.49
retrieving revision 1.50
diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -u -r1.49 -r1.50
--- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
+++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
@@ -172,7 +172,7 @@
}
if (before($Set->open_date, $submitTime)) {
- warn("case 0\n");
+ # warn("case 0\n");
return $authz->hasPermissions($User->user_id, "record_answers_before_open_date");
} elsif (between($Set->open_date, ($Set->due_date + $grace), $submitTime)) {
@@ -686,6 +686,13 @@
my $setTmpl = $db->getUserSet($effectiveUserName,$setName);
WeBWorK::ContentGenerator::Instructor::assignSetVersionToUser($self, $effectiveUserName, $setTmpl);
$setVersionNumber++;
+
+ # get a clean version of the set to save,
+ # and the merged version to use in the
+ # rest of the routine
+ my $cleanSet = $db->getSetVersion($userName,
+ $setName,
+ $setVersionNumber);
$set = $db->getMergedSetVersion($userName,
$setName,
$setVersionNumber);
@@ -704,12 +711,24 @@
$timeNow+$timeLimit<$set->due_date);
$set->answer_date($set->due_date + $ansOffset);
$set->version_last_attempt_time( 0 );
- # put this new info into the database. note
- # that this means that -all- of the merged
- # information gets put back into the
- # database. as long as the version doesn't
- # have a long lifespan, this is ok...
- $db->putSetVersion( $set );
+
+ # put this new info into the database. we
+ # put back that data which we need for the
+ # version, and leave blank any information
+ # that we'd like to inherit from the user
+ # set or global set. we set the data which
+ # determines if a set is open, because we
+ # don't want the set version to reopen after
+ # it's complete
+ $cleanSet->version_creation_time( $set->version_creation_time );
+ $cleanSet->open_date( $set->open_date );
+ $cleanSet->due_date( $set->due_date );
+ $cleanSet->answer_date( $set->answer_date );
+ $cleanSet->version_last_attempt_time( $set->version_last_attempt_time );
+ $cleanSet->version_time_limit( $set->version_time_limit );
+ $cleanSet->attempts_per_version( $set->attempts_per_version );
+ $cleanSet->assignment_type( $set->assignment_type );
+ $db->putSetVersion( $cleanSet );
# we have a new set version, so it's open
$versionIsOpen = 1;
@@ -1440,7 +1459,7 @@
my $setName = $set->set_id();
# save the submission time if we're recording the answer, or if the
- # first submission occurs after the due_date
+ # first submission occurs after the due_date
if ( $submitAnswers &&
( $will{recordAnswers} ||
( ! $set->version_last_attempt_time() &&
@@ -1451,7 +1470,14 @@
$set->assignment_type() eq 'proctored_gateway' ) {
$set->assignment_type( 'gateway' );
}
- $db->putSetVersion( $set );
+ # again, we save only parameters that are determine access to the
+ # set version
+ my $cleanSet = $db->getSetVersion($effectiveUser,
+ $setName,
+ $versionNumber);
+ $cleanSet->assignment_type( $set->assignment_type );
+ $cleanSet->version_last_attempt_time( $set->version_last_attempt_time );
+ $db->putSetVersion( $cleanSet );
}
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-21 03:13:41
|
Log Message:
-----------
Show versions of gateway assignments that have been taken by a user,
providing a mechanism for instructors to edit specific versions of the
assignments.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
UserDetail.pm
Revision Data
-------------
Index: UserDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm -u -r1.7 -r1.8
--- lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm
@@ -297,6 +297,20 @@
my %UserSetRecords = map { $_->set_id => $_ } $db->getUserSets(@UserSetRefs);
my @MergedSetRefs = map { [$editForUserID, $_] } sortByName(undef, @UserSetIDs);
my %MergedSetRecords = map { $_->set_id => $_ } $db->getMergedSets(@MergedSetRefs);
+
+ # get set versions of versioned sets
+ my %UserSetVersionRecords;
+ my %UserSetMergedVersionRecords;
+ foreach my $setid ( keys( %UserSetRecords ) ) {
+ if ( $GlobalSetRecords{$setid}->assignment_type =~ /gateway/ ) {
+ my @setVersionRefs = map { [$editForUserID, $setid, $_] }
+ $db->listSetVersions( $editForUserID, $setid );
+ if ( @setVersionRefs ) {
+ $UserSetVersionRecords{$setid} = [ $db->getSetVersions(@setVersionRefs) ];
+ $UserSetMergedVersionRecords{$setid} = [ $db->getMergedSetVersions(@setVersionRefs) ];
+ }
+ }
+ }
########################################
# Print warning
@@ -332,32 +346,72 @@
"Dates",
])
),"\n";
+
+ # get a list of sets to show
# DBFIXME already have this data
- foreach my $setID (sortByName(undef, $db->listGlobalSets())) {
+ my @setsToShow = sortByName( undef, $db->listGlobalSets() );
+ # insert any set versions that we have
+ my $i = $#setsToShow;
+ if ( defined( $UserSetVersionRecords{$setsToShow[$i]} ) ) {
+ push( @setsToShow, map{ $_->set_id . ",v" . $_->version_id }
+ @{$UserSetVersionRecords{$setsToShow[$i]}} );
+ }
+ $i--;
+ my $numit = 0;
+ while ( $i>=0 ) {
+ if ( defined( $UserSetVersionRecords{$setsToShow[$i]} ) ) {
+ splice( @setsToShow, $i+1, 0,
+ map{ $_->set_id . ",v" . $_->version_id }
+ @{$UserSetVersionRecords{$setsToShow[$i]}} );
+ }
+ $i--;
+ $numit++;
+ # just to be safe
+ last if $numit >= 150;
+ }
+ warn("Truncated display of sets at 150 in UserDetail.pm. This is a " .
+ "brake to avoid spiraling into the abyss. If you really have " .
+ "more than 150 sets in your course, reset the limit at line " .
+ "370 in webwork/lib/WeBWorK/ContentGenerator/Instructor/UserDetail.pm.")
+ if ( $numit == 150 );
+
+
+ foreach my $setID ( @setsToShow ) {
+ # catch the versioned sets that we just added
+ my $setVersion = 0;
+ my $fullSetID = $setID;
+ if ( $setID =~ /,v(\d+)$/ ) {
+ $setVersion = $1;
+ $setID =~ s/,v\d+$//;
+ }
+
my $GlobalSetRecord = $GlobalSetRecords{$setID};
- my $UserSetRecord = $UserSetRecords{$setID};
- my $MergedSetRecord = $MergedSetRecords{$setID};
+ my $UserSetRecord = (! $setVersion) ? $UserSetRecords{$setID} :
+ $UserSetVersionRecords{$setID}->[$setVersion-1];
+ my $MergedSetRecord = (! $setVersion) ? $MergedSetRecords{$setID} :
+ $UserSetMergedVersionRecords{$setID}->[$setVersion-1];
my $setListPage = $urlpath->new(type =>'instructor_set_detail',
args =>{
courseID => $courseID,
- setID => $setID
+ setID => $fullSetID
}
- );
+ );
my $url = $self->systemLink($setListPage,
params =>{effectiveUser => $editForUserID,
editForUser => $editForUserID,
});
+ my $setName = ( $setVersion ) ? "test $setVersion" : $setID;
+
print CGI::Tr(
CGI::td({ -align => "center" }, [
- CGI::checkbox({ type => 'checkbox',
+ ($setVersion) ? "" : CGI::checkbox({ type => 'checkbox',
name => "set.$setID.assignment",
label => '',
value => 'assigned',
- checked => (defined $MergedSetRecord)
- }),
- defined($MergedSetRecord) ? CGI::b(CGI::a({href=>$url},$setID, ) ) : CGI::b($setID, ),
- join "\n", $self->DBFieldTable($GlobalSetRecord, $UserSetRecord, $MergedSetRecord, "set", $setID, \@dateFields,$rh_dateFieldLabels),
+ checked => (defined $MergedSetRecord)}),
+ defined($MergedSetRecord) ? CGI::b(CGI::a({href=>$url},$setName, ) ) : CGI::b($setID, ),
+ join "\n", $self->DBFieldTable($GlobalSetRecord, $UserSetRecord, $MergedSetRecord, "set", $setID, \@dateFields, $rh_dateFieldLabels),
])
),"\n";
}
@@ -467,7 +521,8 @@
}
sub DBFieldTable {
- my ($self, $GlobalRecord, $UserRecord, $MergedRecord, $recordType, $recordID, $fieldsRef,$rh_fieldLabels) = @_;
+ my ($self, $GlobalRecord, $UserRecord, $MergedRecord, $recordType,
+ $recordID, $fieldsRef, $rh_fieldLabels) = @_;
return CGI::div({class => "ResultsWithError"}, "No record exists for $recordType $recordID") unless defined $GlobalRecord;
|
|
From: dpvc v. a. <we...@ma...> - 2008-06-20 15:19:34
|
Log Message:
-----------
Make non-inheritance scheme more general, and include additional
values in the default list. (Still need to look through all the basic
objects to see what might not want to be inherited.)
Modified Files:
--------------
pg/lib:
Value.pm
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.94
retrieving revision 1.95
diff -Llib/Value.pm -Llib/Value.pm -u -r1.94 -r1.95
--- lib/Value.pm
+++ lib/Value.pm
@@ -597,10 +597,20 @@
sub inherit {
my $self = shift;
$self = bless {(map {%$_} @_),%$self}, ref($self);
- delete $self->{correct_ans};
+ foreach my $id ($self->noinherit) {delete $self->{$id}};
return $self;
}
+#
+# The list of fields NOT to inherit.
+# Use the default list plus any specified explicitly in the object itself.
+# Subclasses can override and return additional fields, if necessary.
+#
+sub noinherit {
+ my $self = shift;
+ ("correct_ans","original_formula","equation",@{$self->{noinherit}||[]});
+}
+
######################################################################
#
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-20 14:57:44
|
Log Message:
-----------
An experimental collection of macros designed as a first attempt
to make writing sequential problems easier (Davide Cervone principal author)
The rules for using these macros may well change as we gain experience writing
sequential problems. (See also PGsequentialmacros.pl for some additional, lower level tools.)
Modified Files:
--------------
pg/macros:
PGchoicemacros.pl
PGinfo.pl
contextPiecewiseFunction.pl
Added Files:
-----------
pg/macros:
compoundProblem.pl
Revision Data
-------------
Index: PGinfo.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGinfo.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -Lmacros/PGinfo.pl -Lmacros/PGinfo.pl -u -r1.4 -r1.5
--- macros/PGinfo.pl
+++ macros/PGinfo.pl
@@ -95,6 +95,17 @@
TEXT( pretty_print($context->{$key}) );
}
}
+
+=head3 pp()
+
+ Usage: pp(Hash );
+ pp(Object);
+
+
+ Prints out the contents of Hash or the instance variables of Object
+
+=cut
+
sub pp {
my $hash = shift;
"printing |". ref($hash)."|$BR". pretty_print($hash);
Index: PGchoicemacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGchoicemacros.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -Lmacros/PGchoicemacros.pl -Lmacros/PGchoicemacros.pl -u -r1.9 -r1.10
--- macros/PGchoicemacros.pl
+++ macros/PGchoicemacros.pl
@@ -78,15 +78,20 @@
=cut
+# ^uses be_strict
BEGIN{
be_strict;
}
package main;
+
BEGIN {
be_strict();
}
+
+# ^function _PGchoicemacros_init
+
sub _PGchoicemacros_init{
}
@@ -117,6 +122,11 @@
=cut
+# ^function new_match_list
+# ^uses Match::new
+# ^uses &std_print_q
+# ^uses &std_print_a
+
sub new_match_list {
new Match(random(1,2000,1), \&std_print_q, \&std_print_a);
}
@@ -151,6 +161,11 @@
=cut
+# ^function new_select_list
+# ^uses Select::new
+# ^uses &std_print_q
+# ^uses &std_print_a
+
sub new_select_list {
new Select(random(1,2000,1), \&std_print_q, \&std_print_a);
}
@@ -166,6 +181,11 @@
=cut
+# ^function new_pop_up_select_list
+# ^uses Select::new
+# ^uses &pop_up_list_print_q
+# ^uses &std_print_a
+
sub new_pop_up_select_list {
new Select(random(1,2000,1), \&pop_up_list_print_q, \&std_print_a);
}
@@ -194,6 +214,11 @@
=cut
+# ^function new_multiple_choice
+# ^uses Multiple::new
+# ^uses &std_print_q
+# ^uses &radio_print_a
+
sub new_multiple_choice {
new Multiple(random(1,2000,1), \&std_print_q, \&radio_print_a);
}
@@ -210,6 +235,10 @@
=cut
+# ^function new_checkbox_multiple_choice
+# ^uses Multiple::new
+# ^uses &std_print_q
+# ^uses &checkbox_print_a
sub new_checkbox_multiple_choice {
new Multiple(random(1,2000,1), \&std_print_q, \&checkbox_print_a);
}
@@ -238,7 +267,9 @@
=cut
-#Standard method of printing questions in a matching or select list
+
+# ^function std_print_q
+
sub std_print_q {
my $self = shift;
my (@questions) = @_;
@@ -292,6 +323,9 @@
=cut
+
+# ^function pop_up_list_print_q
+
sub pop_up_list_print_q {
my $self = shift;
my (@questions) = @_;
@@ -330,17 +364,6 @@
}
-# For graphs in a matching question.
-
-#sub format_graphs {
-# my $self = shift;
-# my @in = @_;
-# my $out = "";
-# while (@in) {
-# $out .= shift(@in). "#" ;
-# }
-# $out;
-#}
=item quest_first_pop_up_list_print_q()
@@ -355,6 +378,9 @@
# To put pop-up-list at the end of a question.
# contributed by Mark Schmitt 3-6-03
+
+# ^function quest_first_pop_up_list_print_q
+
sub quest_first_pop_up_list_print_q {
my $self = shift;
my (@questions) = @_;
@@ -408,6 +434,9 @@
# To put pop-up-list in the middle of a question.
# contributed by Mark Schmitt 3-6-03
+
+# ^function ans_in_middle_pop_up_list_print_q
+
sub ans_in_middle_pop_up_list_print_q {
my $self = shift;
my (@questions) = @_;
@@ -456,6 +485,9 @@
# Units for physics class
# contributed by Mark Schmitt 3-6-03
+
+# ^function units_list_print_q
+
sub units_list_print_q {
my $self = shift;
my (@questions) = @_;
@@ -490,6 +522,7 @@
=cut
#Standard method of printing answers in a matching list
+# ^function std_print_a
sub std_print_a {
my $self = shift;
my(@array) = @_;
@@ -541,6 +574,9 @@
=cut
#Alternate method of printing answers as a list of radio buttons for multiple choice
+#Method for naming radio buttons is no longer round about and hackish
+
+# ^function radio_print_a
sub radio_print_a {
my $self = shift;
my (@answers) = @_;
@@ -596,8 +632,9 @@
=cut
-#Second alternate method of printing answers as a list of radio buttons for multiple choice
-#Method for naming radio buttons is no longer round about and hackish
+
+
+# ^function checkbox_print_a
sub checkbox_print_a {
my $self = shift;
my (@answers) = @_;
@@ -661,6 +698,8 @@
=cut
+# ^function qa [DEPRECATED]
+#
sub qa {
my($questionsRef,$answersRef,@questANDanswer) = @_;
while (@questANDanswer) {
@@ -679,6 +718,7 @@
=cut
+# ^function invert [DEPRECATED]
sub invert {
my @array = @_;
my @out = ();
@@ -697,6 +737,8 @@
=cut
+# ^function NchooseK [DEPRECATED]
+
sub NchooseK {
my($n,$k)=@_;;
my @array = 0..($n-1);
@@ -715,6 +757,8 @@
=cut
+# ^function shuffle [DEPRECATED]
+
sub shuffle {
my ($i) = @_;
my @out = &NchooseK($i,$i);
@@ -725,6 +769,8 @@
=cut
+# ^function match_questions_list [DEPRECATED]
+
sub match_questions_list {
my (@questions) = @_;
my $out = "";
@@ -761,6 +807,8 @@
=cut
+# ^function match_questions_list_varbox [DEPRECATED]
+
sub match_questions_list_varbox {
my ($length, @questions) = @_;
my $out = "";
Index: contextPiecewiseFunction.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextPiecewiseFunction.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -Lmacros/contextPiecewiseFunction.pl -Lmacros/contextPiecewiseFunction.pl -u -r1.8 -r1.9
--- macros/contextPiecewiseFunction.pl
+++ macros/contextPiecewiseFunction.pl
@@ -27,7 +27,7 @@
and then use
- Context("PiecewiseFuntion");
+ Context("PiecewiseFunction");
to select the context for piecewise functions. There are several
ways to produce a piecewise function. For example:
--- /dev/null
+++ macros/compoundProblem.pl
@@ -0,0 +1,625 @@
+sub _compoundProblem_init {}; # don't reload this file
+
+######################################################################
+#
+# This package implements a method of handling multi-part problems
+# that show only a single part at any one time. The students can
+# work on one part at a time, and then when they get it right (or
+# under other circumstances deterimed by the professor), they can
+# move on to the next part. Students can not return to earlier parts
+# once they have been completed. The score for problem as a whole is
+# made up from the scores on the individual parts, and the relative
+# weighting of the various parts can be specified by the problem
+# author.
+#
+# To use the compoundProblem library, use
+#
+# loadMacros("compoundProblem.pl");
+#
+# at the top of your file, and then create a compoundProblem object
+# via the command
+#
+# $cp = new compoundProblem(options)
+#
+# where '$cp' is the name of a variable that you will use to
+# refer to the compound problem, and 'options' can include:
+#
+# parts => n The number of parts in the problem.
+# Default: 1
+#
+# weights => [n1,...,nm] The relative weights to give to each
+# part in the problem. For example,
+# weights => [2,1,1]
+# would cause the first part to be worth 50%
+# of the points (twice the amount for each of
+# the other two), while the second and third
+# part would be worth 25% each. If weights
+# are not supplied, the parts are weighted
+# by the number of answer blanks in each part
+# (and you must provide the total number of
+# blanks in all the parts by supplying the
+# totalAnswers option).
+#
+# totalAnswers => n The total number of answer blanks in all
+# the parts put together (this is used when
+# computing the per-part scores, if part
+# weights are not provided).
+#
+# saveAllAnswers => 0 or 1 Usually, the contents of named answer blanks
+# from previous parts are made available to
+# later parts using variables with the
+# same name as the answer blank. Setting
+# saveAllAnswers to 1 will cause ALL answer
+# blanks to be available (via variables
+# like $AnSwEr1, and so on).
+# Default: 0
+#
+# parserValues => 0 or 1 Determines whether the answers from previous
+# parts are returned as MathObjects (like
+# those returned from Real(), Vector(), etc)
+# or as strings (the unparsed contents of the
+# student answer). If you intend to use the
+# previous answers as numbers, for example,
+# you would want to set this to 1 so that you
+# would get the final result of any formula
+# the student typed, rather than the formula
+# itself as a character string.
+# Default: 0
+#
+# nextVisible => type Tells when the "go on to the next part" option
+# is available to the student. The possible
+# types include:
+#
+# 'ifCorrect' next is available only when
+# all the answers are correct.
+#
+# 'Always' next is always available
+# (but remember that students
+# can't go back once they go
+# on.)
+#
+# 'Never' next is never allowed (the
+# problem will control going
+# on to the next part itself).
+#
+# Default: 'ifCorrect'
+#
+# nextStyle => type Determines the style of "next" indicator to display
+# (when it is available). The type can be one of:
+#
+# 'CheckBox' a checkbox that allows the students
+# to go on to the next part when they
+# submit their answers.
+#
+# 'Button' a button that submits their answers
+# and goes on to the next part.
+#
+# 'Forced' forces the student to go on to the
+# next part the next time they submit
+# answers.
+#
+# 'HTML' allows you to provide an arbitrary
+# HTML string of your own.
+#
+# Default: 'Checkbox'
+#
+# nextLabel => string Specifies the string to use as the label for the checkbox,
+# the name of the button, the text of the message indicating
+# that the next submit will move to the next part, or the
+# HTML string, depending on the setting of nextStyle above.
+#
+# nextNoChange => 0 or 1 Since the students must submit their answers again to go on
+# to the next part, it is possible for them to change their
+# answers before they submit, and if nextVisible is 'ifCorrect'
+# they might go on to the next without having correct answers
+# stored. This option lets you control whether the answers
+# are checked against the previous ones before going on to the
+# next part. If the answers don't match, a warning is issued
+# and they are not allowed to move on.
+# Default: 1
+#
+# allowReset => 0 or 1 Determines whether a "Go back to the first part" checkbox
+# is provided on parts 2 and later. This is intended for
+# the professor during testing of the problem (otherwise
+# it would be impossible to go back to earlier parts).
+# Default: 0
+#
+# resetLabel => string The string used to label the reset checkbox.
+#
+# Once you have created a compoundProblem object, you can use $cp->part to
+# determine the part that the student is working on, and use 'if' statements
+# to display the proper information for the given part. The compoundProblem
+# object takes care of maintaining the data as the parts change. (See the
+# compoundProblem.pg file for an example of a compound problem.)
+#
+# In order to handle the scoring of the problem as a whole when only part is
+# showing, the compoundProblem object uses its own problem grader to manage
+# the scores, and calls your own grader from there. The default is to use
+# the one that was installed before the compoundProblem object was created,
+# or avg_problem_grader if none was installed. You can specify a different
+# one using the $cp->useGrader() method (see below). It is important that
+# you NOT call install_problem_grader() yourself once you have created the
+# compoundProblem object, as that would disable the special grader, causing
+# the compound problem to fail to work properly.
+#
+# You may call the following methods once you have a compoundProblem:
+#
+# $cp->part Returns the part the student is working on.
+# $cp->part(n) Sets the part to be part n, as long as the
+# student has finished the preceeding parts.
+# If not, the part is set to the highest
+# one the student hasn't completed, and he
+# can work up to the given part. (The
+# nextVisible option is set to 'ifCorrect' if
+# it was 'Never' so that students can go on
+# once they finish the earlier parts.)
+#
+# $cp->useGrader(code_ref) Supplies your own grader to use in
+# place of the default one. For example:
+# $cp->useGrader(~~&std_problem_grader);
+#
+# $cp->score Returns the (weighted) score for this part.
+# Note that this is the score shown at the bottom
+# of the page on which the student pressed submit
+# (not the score for the answers the student is
+# submitting -- that is not available until
+# after the body of the problem has been created).
+#
+# $cp->scoreRaw Returns the unweighted score for this part.
+#
+# $cp->scoreOverall Returns the overall score for the problem
+# so far.
+#
+# $cp->addAnswers(list) Make additional answer blanks be available
+# from one part to another. E.g.,
+# $cp->addAnswers('AnSwEr1');
+# would make the first unnamed blank be available
+# in later parts as well. (This command should
+# be issued only when the part containing the
+# given answer blank is displayed.)
+#
+# $cp->nextCheckbox(label) Returns the HTML string for the "go on to next
+# part" checkbox so you can use it in the body of
+# the problem if you wish. This should not be
+# inserted when the $displayMode is 'TeX'. If the
+# label is not given or is blank, the default label
+# is used.
+#
+# $cp->nextButton(label) Returns the HTML string for the "go on to next
+# part" button so you can use it in the body of
+# the problem if you wish. This should not be
+# inserted when the $displayMode is 'TeX'. If the
+# label is not given or is blank, the default label
+# is used.
+#
+# $cp->nextForces(label) Returns the HTML string for the forced "go on to
+# next part" so you can use it in the body of
+# the problem if you wish. This should not be
+# inserted when the $displayMode is 'TeX'. If the
+# label is not given or is blank, the default label
+# is used.
+#
+# $cp->reset Go back to part 1, clearing the answers
+# and score. (Best used when debugging problems.)
+#
+# $cp->resetCheckbox(label) Returns the HTML string for the reset checkbox
+# so that you can provide one within the body
+# of the problem if you wish. This should not be
+# inserted when the $displayMode is 'TeX'. If the
+# label is not given or is blank, the default label
+# will be used.
+#
+
+######################################################################
+
+
+package compoundProblem;
+
+#
+# The state data that is stored between invocations of
+# the problem.
+#
+our %defaultStatus = (
+ part => 1, # the current part
+ answers => "", # answer labels from previous parts
+ new_answers => "", # answer labels for THIS part
+ ans_rule_count => 0, # the ans_rule count from previous parts
+ new_ans_rule_count => 0, # the ans_rule count from THIS part
+ score => 0, # the (weighted) score on this part
+ total => 0, # the total on previous parts
+ raw => 0, # raw score on this part
+);
+
+#
+# Create a new instance of the compound Problem and initialize
+# it. This includes reading the status from the previous
+# parts, defining the variables from the answers to previous parts,
+# and setting up the grader so that the current data can be saved.
+#
+sub new {
+ my $self = shift; my $class = ref($self) || $self;
+ my $cp = bless {
+ parts => 1,
+ totalAnswers => undef,
+ weights => undef, # array of weights per part
+ saveAllAnswers => 0, # usually only save named answers
+ parserValues => 0, # make Parser objects from the answers?
+ nextVisible => "ifCorrect", # or "Always" or "Never"
+ nextStyle => "Checkbox", # or "Button", "Forced", or "HTML"
+ nextLabel => undef, # Checkbox text or button name or HTML
+ nextNoChange => 1, # true if answer can't change for new part
+ allowReset => 0, # true to show "back to part 1" button
+ resetLabel => undef, # label for reset button
+ grader => $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} || \&main::avg_problem_grader,
+ @_,
+ status => $defaultStatus,
+ }, $class;
+ die "You must provide either the totalAnswers or weights"
+ unless $cp->{totalAnswers} || $cp->{weights};
+ $cp->getTotalWeight if $cp->{weights};
+ main::loadMacros("Parser.pl") if $cp->{parserValues};
+ $cp->reset if $cp->{allowReset} && $main::inputs_ref->{_reset};
+ $cp->getStatus;
+ $cp->initPart;
+ return $cp;
+}
+
+#
+# Compute the total of the weights so that the parts can
+# be properly scaled.
+#
+sub getTotalWeight {
+ my $self = shift;
+ $self->{totalWeight} = 0; $self->{totalAnswers} = 1;
+ foreach my $w (@{$self->{weights}}) {$self->{totalWeight} += $w}
+ $self->{totalWeight} = 1 if $self->{totalWeight} == 0;
+}
+
+#
+# Look up the status from the previous invocation
+# and see if we need to go on to the next part.
+#
+sub getStatus {
+ my $self = shift;
+ main::RECORD_FORM_LABEL("_next");
+ main::RECORD_FORM_LABEL("_status");
+ $self->{status} = $self->decode;
+ $self->{isNew} = $main::inputs_ref->{_next} || ($main::inputs_ref->{submitAnswers} &&
+ $main::inputs_ref->{submitAnswers} eq ($self->{nextLabel} || "Go on to Next Part"));
+ if ($self->{isNew}) {
+ $self->checkAnswers;
+ $self->incrementPart unless $self->{nextNoChange} && $self->{answersChanged};
+ }
+}
+
+#
+# Initialize the current part by setting the ans_rule
+# count (so that later parts will get unique answer names),
+# installing the grader (to save the data), and setting
+# the variables for previous answers.
+#
+sub initPart {
+ my $self = shift;
+ $main::ans_rule_count = $self->{status}{ans_rule_count};
+ main::install_problem_grader(\&compoundProblem::grader);
+ $main::PG_FLAGS{compoundProblem} = $self;
+ $self->initAnswers($self->{status}{answers});
+}
+
+#
+# Look through the list of answer labels and set
+# the variables for them to be the associated student
+# answer. Make it a Parser value if requested.
+# Record the value so that is will be available
+# again on the next invocation.
+#
+sub initAnswers {
+ my $self = shift; my $answers = shift;
+ foreach my $id (split(/;/,$answers)) {
+ my $value = $main::inputs_ref->{$id}; $value = '' unless defined($value);
+ if ($self->{parserValues}) {
+ my $parser = Parser::Formula($value);
+ $parser = Parser::Evaluate($parser) if $parser && $parser->isConstant;
+ $value = $parser if $parser;
+ }
+ ${"main::$id"} = $value unless $id =~ m/$main::ANSWER_PREFIX/o;
+ $value = quoteHTML($value);
+ main::TEXT(qq!<input type="hidden" name="$id" value="$value" />!);
+ main::RECORD_FORM_LABEL($id);
+ }
+}
+
+#
+# Look to see is any answers have changed on this
+# invocation of the problem.
+#
+sub checkAnswers {
+ my $self = shift;
+ foreach my $id (keys(%{$main::inputs_ref})) {
+ if ($id =~ m/^previous_(.*)$/) {
+ if ($main::inputs_ref->{$id} ne $main::inputs_ref->{$1}) {
+ $self->{answersChanged} = 1;
+ $self->{isNew} = 0 if $self->{nextNoChange};
+ return;
+ }
+ }
+ }
+}
+
+#
+# Go on to the next part, updating the status
+# to include the data from the old part so that
+# it will be properly preserved when the next
+# part is showing.
+#
+sub incrementPart {
+ my $self = shift;
+ my $status = $self->{status};
+ if ($status->{part} < $self->{parts}) {
+ $status->{part}++;
+ $status->{answers} .= ';' if $status->{answers};
+ $status->{answers} .= $status->{new_answers};
+ $status->{ans_rule_count} = $status->{new_ans_rule_count};
+ $status->{total} += $status->{score};
+ $status->{score} = $status->{raw} = 0;
+ $status->{new_answers} = '';
+ }
+}
+
+######################################################################
+
+#
+# Encode all the status information so that it can be
+# maintained as the student submits answers. Since this
+# state information includes things like the score from
+# the previous parts, it is "encrypted" using a dumb
+# hex encoding (making it harder for a student to recognize
+# it as valuable data if they view the page source).
+#
+sub encode {
+ my $self = shift; my $status = shift || $self->{status};
+ my @data = (); my $data = "";
+ foreach my $id (main::lex_sort(keys(%defaultStatus))) {push(@data,$status->{$id})}
+ foreach my $c (split(//,join('|',@data))) {$data .= toHex($c)}
+ return $data;
+}
+
+#
+# Decode the data and break it into the status hash.
+#
+sub decode {
+ my $self = shift; my $status = shift || $main::inputs_ref->{_status};
+ return {%defaultStatus} unless $status;
+ my @data = (); foreach my $hex (split(/(..)/,$status)) {push(@data,fromHex($hex)) if $hex ne ''}
+ @data = split('\\|',join('',@data)); $status = {%defaultStatus};
+ foreach my $id (main::lex_sort(keys(%defaultStatus))) {$status->{$id} = shift(@data)}
+ return $status;
+}
+
+
+#
+# Hex encoding is shifted by 10 to obfuscate it further.
+# (shouldn't be a problem since the status will be made of
+# printable characters, so they are all above ASCII 32)
+#
+sub toHex {main::spf(ord(shift)-10,"%X")}
+sub fromHex {main::spf(hex(shift)+10,"%c")}
+
+
+#
+# Make sure the data can be properly preserved within
+# an HTML <INPUT TYPE="HIDDEN"> tag.
+#
+sub quoteHTML {
+ my $string = shift;
+ $string =~ s/&/\&/g; $string =~ s/"/\"/g;
+ $string =~ s/>/\>/g; $string =~ s/</\</g;
+ return $string;
+}
+
+######################################################################
+
+#
+# Set the grader for this part to the specified one.
+#
+sub useGrader {
+ my $self = shift;
+ $self->{grader} = shift;
+}
+
+#
+# Make additional answer blanks from the current part
+# be preserved for use in future parts.
+#
+sub addAnswers {
+ my $self = shift;
+ $self->{extraAnswers} = [] unless $self->{extraAnswers};
+ push(@{$self->{extraAnswers}},@_);
+}
+
+#
+# Go back to part 1 and clear the answers and scores.
+#
+sub reset {
+ my $self = shift;
+ if ($main::inputs_ref->{_status}) {
+ my $status = $self->decode($main::inputs_ref->{_status});
+ foreach my $id (split(/;/,$status->{answers})) {delete $main::inputs_ref->{$id}}
+ foreach my $id (1..$status->{ans_rule_count})
+ {delete $main::inputs_ref->{"${main::QUIZ_PREFIX}${main::ANSWER_PREFIX}$id"}}
+ }
+ $main::inputs_ref->{_status} = $self->encode(\%defaultStatus);
+ $main::inputs_ref->{_next} = 0;
+}
+
+#
+# Return the HTML for the "Go back to part 1" checkbox.
+#
+sub resetCheckbox {
+ my $self = shift;
+ my $label = shift || " <b>Go back to Part 1</b> (when you submit your answers).";
+ my $par = shift; $par = ($par ? $main::PAR : '');
+ qq'$par<input type="checkbox" name="_reset" value="1" />$label';
+}
+
+#
+# Return the HTML for the "next part" checkbox.
+#
+sub nextCheckbox {
+ my $self = shift;
+ my $label = shift || " <b>Go on to next part</b> (when you submit your answers).";
+ my $par = shift; $par = ($par ? $main::PAR : '');
+ $self->{nextInserted} = 1;
+ qq!$par<input type="checkbox" name="_next" value="next" />$label!;
+}
+
+#
+# Return the HTML for the "next part" button.
+#
+sub nextButton {
+ my $self = shift;
+ my $label = quoteHTML(shift || "Go on to Next Part");
+ my $par = shift; $par = ($par ? $main::PAR : '');
+ $par . qq!<input type="submit" name="submitAnswers" value="$label" !
+ . q!onclick="document.getElementById('_next').value=1" />!;
+}
+
+#
+# Return the HTML for when going to the next part is forced.
+#
+sub nextForced {
+ my $self = shift;
+ my $label = shift || "<b>Submit your answers again to go on to the next part.</b>";
+ $label = $main::PAR . $label if shift;
+ $self->{nextInserted} = 1;
+ qq!$label<input type="hidden" name="_next" id="_next" value="Next" />!;
+}
+
+#
+# Return the raw HTML provided
+#
+sub nextHTML {shift; shift}
+
+######################################################################
+
+#
+# Return the current part, or try to set the part to the given
+# part (returns the part actually set, which may be earlier if
+# the student didn't complete an earlier part).
+#
+sub part {
+ my $self = shift; my $status = $self->{status};
+ my $part = shift;
+ return $status->{part} unless defined $part && $main::displayMode ne 'TeX';
+ $part = 1 if $part < 1; $part = $self->{parts} if $part > $self->{parts};
+ if ($part > $status->{part} && !$main::inputs_ref->{_noadvance}) {
+ unless ((lc($self->{nextVisible}) eq 'ifcorrect' && $status->{raw} < 1) ||
+ lc($self->{nextVisible}) eq 'never') {
+ $self->initAnswers($status->{new_answers});
+ $self->incrementPart; $self->{isNew} = 1;
+ }
+ }
+ if ($part != $status->{part}) {
+ main::TEXT('<input type="hidden" name="_noadvance" value="1" />');
+ $self->{nextVisible} = 'IfCorrect' if lc($self->{nextVisible}) eq 'never';
+ }
+ return $status->{part};
+}
+
+#
+# Return the various scores
+#
+sub score {shift->{status}{score}}
+sub scoreRaw {shift->{status}{raw}}
+sub scoreOverall {
+ my $self = shift;
+ return $self->{status}{score} + $self->{status}{total};
+}
+
+######################################################################
+#
+# The custom grader that does the work of computing the scores
+# and saving the data.
+#
+sub grader {
+ my $self = $main::PG_FLAGS{compoundProblem};
+
+ #
+ # Get the answer names and the weight for the current part.
+ #
+ my @answers = keys(%{$_[0]});
+ my $weight = scalar(@answers)/$self->{totalAnswers};
+ $weight = $self->{weights}[$self->{status}{part}-1]/$self->{totalWeight}
+ if $self->{weights} && defined($self->{weights}[$self->{status}{part}-1]);
+ @answers = grep(!/$main::ANSWER_PREFIX/o,@answers) unless $self->{saveAllAnswers};
+ push(@answers,@{$self->{extraAnswers}}) if $self->{extraAnswers};
+ my $space = '<img src="about:blank" style="height:1px; width:3em; visibility:hidden" />';
+
+ #
+ # Call the original grader, but put back the old recorded_score
+ # (the grader will have updated it based on the score for the PART,
+ # not the problem as a whole).
+ #
+ my $oldScore = ($_[1])->{recorded_score};
+ my ($result,$state) = &{$self->{grader}}(@_);
+ $state->{recorded_score} = $oldScore;
+
+ #
+ # Update that state information and encode it.
+ #
+ my $status = $self->{status};
+ $status->{raw} = $result->{score};
+ $status->{score} = $result->{score}*$weight;
+ $status->{new_ans_rule_count} = $main::ans_rule_count;
+ $status->{new_answers} = join(';',@answers);
+ my $data = quoteHTML($self->encode);
+
+ #
+ # Update the recorded score
+ #
+ my $newScore = $status->{total} + $status->{score};
+ $state->{recorded_score} = $newScore if $newScore > $oldScore;
+ $state->{recorded_score} = 0 if $self->{allowReset} && $main::inputs_ref->{_reset};
+
+ #
+ # Add the compoundProblem message and data
+ #
+ $result->{type} = "compoundProblem ($result->{type})";
+ $result->{msg} .= '</i><p><b>Note:</b> <i>' if $result->{msg};
+ $result->{msg} .= 'This problem has more than one part.'
+ . '<br/>'.$space.'<small>Your score for this attempt is for this part only;</small>'
+ . '<br/>'.$space.'<small>your overall score is for all the parts combined.</small>'
+ . qq!<input type="hidden" name="_status" value="$data" />!;
+
+ #
+ # Warn if the answers changed when they shouldn't have
+ #
+ $result->{msg} .= '<p><b>You may not change your answers when going on to the next part!</b>'
+ if $self->{nextNoChange} && $self->{answersChanged};
+
+ #
+ # Include the "next part" checkbox, button, or whatever.
+ #
+ my $par = 1;
+ if ($self->{parts} > $status->{part} && !$main::inputs_ref->{previewAnswers}) {
+ if (lc($self->{nextVisible}) eq 'always' ||
+ (lc($self->{nextVisible}) eq 'ifcorrect' && $result->{score} >= 1)) {
+ my $method = "next".$self->{nextStyle}; $par = 0;
+ $result->{msg} .= $self->$method($self->{nextLabel},1).'<br/>';
+ }
+ }
+
+ #
+ # Add the reset checkbox, if needed
+ #
+ $result->{msg} .= $self->resetCheckbox($self->{resetLabel},$par)
+ if $self->{allowReset} && $status->{part} > 1;
+
+ #
+ # Make sure we don't go on unless the next button really is checked
+ #
+ $result->{msg} .= '<input type="hidden" name="_next" value="0" />'
+ unless $self->{nextInserted};
+
+ return ($result,$state);
+}
|
|
From: Mike G. v. a. <we...@ma...> - 2008-06-20 03:06:43
|
Log Message:
-----------
Added a ->cmp method for checking the answers.
It needs further improvement but it is a first
step toward making the List elements more
compatible with MathObjects.
The ->cmp method will be inherited by the
Select, Match and so forth objects
Modified Files:
--------------
pg/lib:
List.pm
Revision Data
-------------
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/List.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/List.pm -Llib/List.pm -u -r1.3 -r1.4
--- lib/List.pm
+++ lib/List.pm
@@ -217,7 +217,7 @@
# *** Utility methods ***
-
+#internal
#choose k random numbers out of n
sub NchooseK {
my $self = shift;
@@ -235,7 +235,7 @@
return @out;
}
-
+#internal
#return an array of random numbers
sub shuffle {
my $self = shift;
@@ -248,7 +248,7 @@
# *** Utility subroutines ***
-
+#internal
#swap subscripts with their respective values
sub invert {
my @array = @_;
@@ -260,7 +260,7 @@
return @out;
}
-
+#internal
#slice of the alphabet
sub ALPHABET {
return ('A'..'ZZ')[@_];
@@ -296,6 +296,12 @@
#Input answers
#defaults to inputting 'question', 'answer', 'question', etc (should be overloaded for other types of questions)
+
+=head3 qa
+ Usage: $ml->qa( qw( question1 answer1 question2 answer2 ) );
+
+=cut
+
sub qa {
my $self = shift;
my @questANDanswer = @_;
@@ -315,6 +321,7 @@
#Output questions
#Doesn't do actual output, refers to method given in call to 'new' (rf_print_q)
+
sub print_q {
my $self = shift;
@@ -336,6 +343,23 @@
return $self->{selected_a};
}
+=head3 cmp
+
+ Usage ANS($ml -> cmp);
+
+provides a MathObject like comparison method
+returns a string of comparison methods for checking the list object
+
+=cut
+
+sub cmp {
+ my $self = shift;
+ my @answers = @{$self->{selected_a}};
+ @answers = map {Value::makeValue($_)} @answers; # make sure answers are all MathObjects
+ @answers = map {$_->cmp} @answers; # replace the MathObjects by their AnswerEvaluators
+ return @answers;
+}
+
#Match and Select return references to arrays while Multiple justs returns a string
#so Match and Select use ra_correct_ans while Multiple uses correct_ans
sub correct_ans {
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-19 19:51:37
|
Log Message:
-----------
Correct message about time exceeded for gateway tests that are in
progress.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
StudentProgress.pm
Revision Data
-------------
Index: StudentProgress.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v
retrieving revision 1.35
retrieving revision 1.36
diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.35 -r1.36
--- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
@@ -557,6 +557,8 @@
my $timeLimit = $userSet->version_time_limit()/60;
$testTime = $timeLimit if ( $testTime > $timeLimit );
$testTime = sprintf("%3.1f min", $testTime);
+ } elsif ( time() - $userSet->version_creation_time() < $userSet->version_time_limit() ) {
+ $testTime = 'still open';
} else {
$testTime = 'time limit ' .
'exceeded';
|
|
From: Gavin L. v. a. <we...@ma...> - 2008-06-19 19:22:09
|
Log Message:
-----------
Gateway cleanup: make mark correct function mark all set versions
correct for gateway tests, take max attempts option out of problem
selectors for gateways (this should be strictly a function of the
set-level versions_per_interval).
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetDetail.pm
Revision Data
-------------
Index: ProblemSetDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm,v
retrieving revision 1.68
retrieving revision 1.69
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -u -r1.68 -r1.69
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
@@ -45,13 +45,16 @@
# these constants determine what order those fields should be displayed in
use constant HEADER_ORDER => [qw(set_header hardcopy_header)];
use constant PROBLEM_FIELD_ORDER => [qw(problem_seed status value max_attempts attempted last_answer num_correct num_incorrect)];
+# for gateway sets, we don't want to allow users to change max_attempts on a per
+# problem basis, as that's nothing but confusing.
+use constant GATEWAY_PROBLEM_FIELD_ORDER => [qw(problem_seed status value attempted last_answer num_correct num_incorrect)];
# we exclude the gateway set fields from the set field order, because they
-# are only displayed for sets that are gateways. this results in a bit of
-# convoluted logic below, but it saves burdening people who are only using
-# homework assignments with all of the gateway parameters
+# are only displayed for sets that are gateways. this results in a bit of
+# convoluted logic below, but it saves burdening people who are only using
+# homework assignments with all of the gateway parameters
# FIXME: in the long run, we may want to let hide_score and hide_work be
-# FIXME: set for non-gateway assignments. right now (11/30/06) they are
+# FIXME: set for non-gateway assignments. right now (11/30/06) they are
# FIXME: only used for gateways
use constant SET_FIELD_ORDER => [qw(open_date due_date answer_date published restrict_ip relax_restrict_ip assignment_type)];
# use constant GATEWAY_SET_FIELD_ORDER => [qw(attempts_per_version version_time_limit time_interval versions_per_interval problem_randorder problems_per_page hide_score hide_work)];
@@ -315,7 +318,7 @@
# if only the setID is included, it creates a table of set information
# if the problemID is included, it creates a table of problem information
sub FieldTable {
- my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord) = @_;
+ my ($self, $userID, $setID, $problemID, $globalRecord, $userRecord, $isGWset) = @_;
my $r = $self->r;
my @editForUser = $r->param('editForUser');
@@ -326,6 +329,8 @@
# needed for gateway output
my $gwFields = '';
+ # $isGWset will come in undef if we don't need to worry about it
+ $isGWset = 0 if ( ! defined( $isGWset ) );
# needed for ip restrictions
my $ipFields = '';
@@ -337,7 +342,8 @@
my $procFields = '';
if (defined $problemID) {
- @fieldOrder = @{ PROBLEM_FIELD_ORDER() };
+ @fieldOrder = ($isGWset) ? @{ GATEWAY_PROBLEM_FIELD_ORDER() } :
+ @{ PROBLEM_FIELD_ORDER() };
} else {
@fieldOrder = @{ SET_FIELD_ORDER() };
@@ -1318,12 +1324,35 @@
foreach my $problemID ($r->param('markCorrect')) {
# DBFIXME where clause, iterator
my @userProblemIDs = map { [$_, $setID, $problemID] } ($forUsers ? @editForUser : $db->listProblemUsers($setID, $problemID));
- my @userProblemRecords = $db->getUserProblems(@userProblemIDs);
- foreach my $record (@userProblemRecords) {
- if (defined $record && ($record->status eq "" || $record->status < 1)) {
- $record->status(1);
- $record->attempted(1);
- $db->putUserProblem($record);
+ # if the set is not a gateway set, this requires going through the
+ # user_problems and resetting their status; if it's a gateway set,
+ # then we have to go through every *version* of every user_problem.
+ # it may be that there is an argument for being able to get() all
+ # problem versions for all users in one database call. The current
+ # code may be slow for large classes.
+ if ( $setRecord->assignment_type !~ /gateway/ ) {
+ my @userProblemRecords = $db->getUserProblems(@userProblemIDs);
+ foreach my $record (@userProblemRecords) {
+ if (defined $record && ($record->status eq "" || $record->status < 1)) {
+ $record->status(1);
+ $record->attempted(1);
+ $db->putUserProblem($record);
+ }
+ }
+ } else {
+ my @userIDs = ( $forUsers ) ? @editForUser : $db->listProblemUsers($setID, $problemID);
+ foreach my $uid ( @userIDs ) {
+ my @versions = $db->listSetVersions( $uid, $setID );
+ my @userProblemVersionIDs =
+ map{ [ $uid, $setID, $_, $problemID ]} @versions;
+ my @userProblemVersionRecords = $db->getProblemVersions(@userProblemVersionIDs);
+ foreach my $record (@userProblemVersionRecords) {
+ if (defined $record && ($record->status eq "" || $record->status < 1)) {
+ $record->status(1);
+ $record->attempted(1);
+ $db->putProblemVersion($record);
+ }
+ }
}
}
}
@@ -1537,6 +1566,9 @@
# if you make any changes to them they will be the same.
# if you're editing for one user, the problems shown should be his/hers
my $userToShow = $forUsers ? $editForUser[0] : $userID;
+
+ # a useful gateway variable
+ my $isGatewaySet = ( $setRecord->assignment_type =~ /gateway/ ) ? 1 : 0;
# DBFIXME no need to get ID lists -- counts would be fine
my $userCount = $db->listUsers();
@@ -1719,7 +1751,8 @@
# we know exists, so if the getMergedSet failed
# (that is, the set isn't assigned to the
# the current user), we get the global set instead
- $guaranteed_set = $db->getGlobalSet( $setID );
+ # $guaranteed_set = $db->getGlobalSet( $setID );
+ $guaranteed_set = $setRecord;
}
foreach my $header (@headers) {
@@ -1835,6 +1868,7 @@
my %shownYet;
my $repeatFile;
+
foreach my $problemID (@problemIDList) {
my $problemRecord;
@@ -1858,8 +1892,14 @@
my $viewProblemPage = $urlpath->new(type => 'problem_detail', args => { courseID => $courseID, setID => $setID, problemID => $problemID });
my $viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)});
- my @fields = @{ PROBLEM_FIELDS() };
- push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser;
+ ###-----
+ ### The array @fields never gets used in the following, so
+ ### I'm commenting it out. If there's a reason it should
+ ### be here, someone else can add it back in and maybe
+ ### comment why. Thanks, Gavin. -glarose 6/19/08
+ ### my @fields = @{ PROBLEM_FIELDS() };
+ ### push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser;
+ ###-----
my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file;
@@ -1895,7 +1935,7 @@
# CGI::Tr({}, CGI::td({}, "Delete it?" . CGI::input({type => "checkbox", name => "deleteProblem", value => $problemID}))) .
($forOneUser ? "" : CGI::Tr({}, CGI::td({}, CGI::checkbox({name => "markCorrect", value => $problemID, label => "Mark Correct?"})))) .
CGI::end_table(),
- $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}),
+ $self->FieldTable($userToShow, $setID, $problemID, $GlobalProblems{$problemID}, $UserProblems{$problemID}, $isGatewaySet),
# A comprehensive list of problems is just TOO big to be handled well
# comboBox({
# name => "set.$setID.$problemID",
|
|
From: dpvc v. a. <we...@ma...> - 2008-06-19 12:47:10
|
Log Message:
-----------
Don't inherit the correct_ans field when combining objects via binary operators.
Modified Files:
--------------
pg/lib:
Value.pm
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.93
retrieving revision 1.94
diff -Llib/Value.pm -Llib/Value.pm -u -r1.93 -r1.94
--- lib/Value.pm
+++ lib/Value.pm
@@ -596,7 +596,9 @@
#
sub inherit {
my $self = shift;
- bless {(map {%$_} @_),%$self}, ref($self);
+ $self = bless {(map {%$_} @_),%$self}, ref($self);
+ delete $self->{correct_ans};
+ return $self;
}
######################################################################
|
2 messages has been excluded from this view by a project administrator.
