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: Sam H. v. a. <we...@ma...> - 2005-09-07 20:57:19
|
Log Message:
-----------
string2hash will now handle strings with newlines, fixing GDBM.
Modified Files:
--------------
webwork2/lib/WeBWorK/DB:
Utils.pm
Revision Data
-------------
Index: Utils.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Utils.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/WeBWorK/DB/Utils.pm -Llib/WeBWorK/DB/Utils.pm -u -r1.14 -r1.15
--- lib/WeBWorK/DB/Utils.pm
+++ lib/WeBWorK/DB/Utils.pm
@@ -134,7 +134,7 @@
sub string2hash($) {
my $string = shift;
return unless defined $string and $string;
- my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/g;
+ my %hash = $string =~ /(.*?)(?<!\\)=(.*?)(?:(?<!\\)&|$)/gs; # /s allows . to match \n
$hash{$_} =~ s/\\(&|=)/$1/g foreach keys %hash; # unescape & and =
return %hash;
}
|
|
From: Sam H. v. a. <we...@ma...> - 2005-09-07 18:01:26
|
Log Message:
-----------
disable newlines every 76 characters in base64-encoded answers. this is
nice for examining database contents manually since it prevents newlines
from being introduced into database records.
Modified Files:
--------------
webwork2/lib/WeBWorK:
Utils.pm
Revision Data
-------------
Index: Utils.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Utils.pm,v
retrieving revision 1.67
retrieving revision 1.68
diff -Llib/WeBWorK/Utils.pm -Llib/WeBWorK/Utils.pm -u -r1.67 -r1.68
--- lib/WeBWorK/Utils.pm
+++ lib/WeBWorK/Utils.pm
@@ -747,7 +747,10 @@
}
$string =~ s/##$//; # remove last pair of hashs
- $string = $BASE64_ENCODED.encode_base64($string);
+ $string = $BASE64_ENCODED.encode_base64($string, "");
+ # Empty string in second argument prevents end-of-line characters from being used.
+ # This is nice for examining database contents manually since it prevents newlines
+ # from being introduced into database records.
return $string;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-09-07 01:17:15
|
Log Message:
-----------
Typographic clean up of global.conf.dist
Modified Files:
--------------
webwork-modperl/conf:
global.conf.dist
Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/conf/global.conf.dist,v
retrieving revision 1.134
retrieving revision 1.135
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.134 -r1.135
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -60,7 +60,10 @@
$externalPrograms{tar} = "/usr/bin/tar";
# Basic image manipulation utilities
+
+####################################################
# Most sites only need to configure the first line
+####################################################
my $netpbm_prefix = "/usr/bin";
$externalPrograms{giftopnm} = "$netpbm_prefix/giftopnm";
$externalPrograms{ppmtopgm} = "$netpbm_prefix/ppmtopgm";
@@ -72,7 +75,7 @@
# The source file is input with cat, and the output is redirected to
# the desired file.
-$externalPrograms{gif2eps} = "$externalPrograms{giftopnm} | $externalPrograms{ppmtopgm}| $externalPrograms{pnmtops} -noturn 2>/dev/null";
+$externalPrograms{gif2eps} = "$externalPrograms{giftopnm} | $externalPrograms{ppmtopgm}| $externalPrograms{pnmtops} -noturn 2>/dev/null";
$externalPrograms{png2eps} = "$externalPrograms{pngtopnm} | $externalPrograms{ppmtopgm} | $externalPrograms{pnmtops} -noturn 2>/dev/null";
$externalPrograms{gif2png} = "$externalPrograms{giftopnm} | $externalPrograms{pnmtopng}";
@@ -82,13 +85,15 @@
# However, this was causing improper display of some sort in PDFs.
+
+
################################################################################
# Mail settings
################################################################################
# Mail sent by the PG system and the mail merge and feedback modules will be
# sent via this SMTP server.
-$mail{smtpServer} = 'mail.yourschool.edu';
+$mail{smtpServer} = 'mail.rochester.edu';
# When connecting to the above server, WeBWorK will send this address in the
# MAIL FROM command. This has nothing to do with the "From" address on the mail
|
|
From: dpvc v. a. <we...@ma...> - 2005-09-07 01:10:14
|
Log Message:
-----------
Added support for cplx_cmp() using the Parser. Move
lib/Parser/Legacy/PGcomplexmacros.pl to the pg/macros directory to use
it. As with the other legacy macros, $useOldAnswerMacros can be
controlled to determine whether the new or the old macros are used.
There is a new mode 'strict_cartesian' that is parallel to
'strict_polar'. You must enter a+bi form, but the a and b can have
operations within them.
Modified Files:
--------------
pg/lib/Parser:
Legacy.pm
Added Files:
-----------
pg/lib/Parser/Legacy:
LimitedComplex.pm
PGcomplexmacros.pl
Revision Data
-------------
Index: Legacy.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Legacy.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Parser/Legacy.pm -Llib/Parser/Legacy.pm -u -r1.2 -r1.3
--- lib/Parser/Legacy.pm
+++ lib/Parser/Legacy.pm
@@ -6,4 +6,6 @@
use Parser::Legacy::LimitedNumeric;
use Parser::Legacy::Numeric;
+use Parser::Legacy::LimitedComplex;
+
1;
--- /dev/null
+++ lib/Parser/Legacy/LimitedComplex.pm
@@ -0,0 +1,275 @@
+##########################################################
+#
+# Implements a context in which complex numbers can be entered,
+# but no complex operations are permitted. So students will
+# be able to perform operations within the real and imaginary
+# parts of the complex numbers, but not between complex numbers.
+#
+#
+# Complex Numbers can still be entered in a+bi or a*e^(bt) form.
+# The e and i are allowed to be entered only once, so we have
+# to keep track of that, and allow SOME complex operations,
+# but only when one term is one of these constants (or an expression
+# involving it that we've already OKed).
+#
+# You control which format to use by setting the complex_format
+# context flag to 'cartesian', 'polar' or 'either'. E.g.,
+#
+# Context()->flags->set(complex_format => 'polar');
+#
+# The default is 'either'. There are predefined contexts that
+# already have these values set:
+#
+# Context("LimitedComplex-cartesian");
+# Context("LimitedComplex-polar");
+#
+# You can require that the a and b used in these forms be strictly
+# numbers (not expressions) by setting the strict_numeric flag and
+# disabling all the functions:
+#
+# Context()->flags->set(strict_numeric=>1);
+# Context()->functions->disable('All');
+#
+# There are predefined contexts that already have these values
+# set:
+#
+# Context("LimitedComplex-cartesian-strict");
+# Context("LimitedComplex-polar-strict");
+# Context("LimitedComplex-strict");
+#
+
+#
+# Handle common checking for BOPs
+#
+package Parser::Legacy::LimitedComplex::BOP;
+
+#
+# Do original check and then if the operands are numbers, its OK.
+# Otherwise, do an operator-specific check for if complex numbers are OK.
+# Otherwise report an error.
+#
+sub _check {
+ my $self = shift;
+ my $super = ref($self); $super =~ s/Legacy::LimitedComplex:://;
+ &{$super."::_check"}($self);
+ if ($self->{lop}->isRealNumber && $self->{rop}->isRealNumber) {
+ return unless $self->{equation}{context}{flags}{strict_numeric};
+ } else {
+ Value::Error("The constant 'i' may appear only once in your formula")
+ if ($self->{lop}->isComplex and $self->{rop}->isComplex);
+ return if $self->checkComplex;
+ $self->Error("Exponential form is 'a*e^(bi)'")
+ if $self->{lop}{isPower} || $self->{rop}{isPower};
+ }
+ $self->Error("Your answer should be of the form %s",$self->theForm)
+}
+
+#
+# filled in by subclasses
+#
+sub checkComplex {return 0}
+
+#
+# Get the form for use in error messages
+#
+sub theForm {
+ my $self = shift;
+ my $format = $self->{equation}{context}{flags}{complex_format};
+ return 'a+bi' if $format eq 'cartesian';
+ return 'a*e^(bi)' if $format eq 'polar';
+ return 'a+bi or a*e^(bi)';
+}
+
+##############################################
+#
+# Now we get the individual replacements for the operators
+# that we don't want to allow. We inherit everything from
+# the original Parser::BOP class, and just add the
+# complex checks here. Note that checkComplex only
+# gets called if exactly one of the terms is complex
+# and the other is real.
+#
+
+package Parser::Legacy::LimitedComplex::BOP::add;
+our @ISA = qw(Parser::Legacy::LimitedComplex::BOP Parser::BOP::add);
+
+sub checkComplex {
+ my $self = shift;
+ return 0 if $self->{equation}{context}{flags}{complex_format} eq 'polar';
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ if ($l->isComplex) {my $tmp = $l; $l = $r; $r = $tmp};
+ return $r->class eq 'Constant' || $r->{isMult} ||
+ ($r->class eq 'Complex' && $r->{value}[0] == 0);
+}
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::BOP::subtract;
+our @ISA = qw(Parser::Legacy::LimitedComplex::BOP Parser::BOP::subtract);
+
+sub checkComplex {
+ my $self = shift;
+ return 0 if $self->{equation}{context}{flags}{complex_format} eq 'polar';
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ if ($l->isComplex) {my $tmp = $l; $l = $r; $r = $tmp};
+ return $r->class eq 'Constant' || $r->{isMult} ||
+ ($r->class eq 'Complex' && $r->{value}[0] == 0);
+}
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::BOP::multiply;
+our @ISA = qw(Parser::Legacy::LimitedComplex::BOP Parser::BOP::multiply);
+
+sub checkComplex {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->{isMult} = !$r->{isPower};
+ return (($l->class eq 'Constant' || $l->isRealNumber) &&
+ ($r->class eq 'Constant' || $r->isRealNumber || $r->{isPower}));
+}
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::BOP::divide;
+our @ISA = qw(Parser::Legacy::LimitedComplex::BOP Parser::BOP::divide);
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::BOP::power;
+our @ISA = qw(Parser::Legacy::LimitedComplex::BOP Parser::BOP::power);
+
+#
+# Base must be 'e' (then we know the other is the complex
+# since we only get here if exactly one term is complex)
+#
+sub checkComplex {
+ my $self = shift;
+ return 0 if $self->{equation}{context}{flags}{complex_format} eq 'cartesian';
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->{isPower} = 1;
+ return 1 if ($l->class eq 'Constant' && $l->{name} eq 'e' &&
+ ($r->class eq 'Constant' || $r->{isMult} || $r->{isOp} ||
+ $r->class eq 'Complex' && $r->{value}[0] == 0));
+ $self->Error("Exponentials can only be of the form 'e^(ai)' in this context");
+}
+
+##############################################
+##############################################
+#
+# Now we do the same for the unary operators
+#
+
+package Parser::Legacy::LimitedComplex::UOP;
+
+sub _check {
+ my $self = shift;
+ my $super = ref($self); $super =~ s/Legacy::LimitedComplex:://;
+ &{$super."::_check"}($self);
+ my $op = $self->{op}; $self->{isOp} = 1;
+ if ($op->isRealNumber) {
+ return unless $self->{equation}{context}{flags}{strict_numeric};
+ return if $op->class eq 'Number';
+ } else {
+ return if $self->{op}{isMult} || $self->{op}{isPower};
+ return if $op->class eq 'Constant' && $op->{name} eq 'i';
+ }
+ $self->Error("Your answer should be of the form %s",$self->theForm)
+}
+
+sub checkComplex {return 0}
+
+sub theForm {Parser::Legacy::LimitedComplex::BOP::theForm(@_)}
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::UOP::plus;
+our @ISA = qw(Parser::Legacy::LimitedComplex::UOP Parser::UOP::plus);
+
+##############################################
+
+package Parser::Legacy::LimitedComplex::UOP::minus;
+our @ISA = qw(Parser::Legacy::LimitedComplex::UOP Parser::UOP::minus);
+
+##############################################
+##############################################
+#
+# Absolute value does complex norm, so we
+# trap that as well.
+#
+
+package Parser::Legacy::LimitedComplex::List::AbsoluteValue;
+our @ISA = qw(Parser::List::AbsoluteValue);
+
+sub _check {
+ my $self = shift;
+ $self->SUPER::_check;
+ return if $self->{coords}[0]->isRealNumber;
+ $self->Error("Can't take absolute value of Complex Numbers in this context");
+}
+
+##############################################
+##############################################
+
+package Parser::Legacy::LimitedComplex;
+
+#
+# Now build the new context that calls the
+# above classes rather than the usual ones
+#
+
+my $context = $Parser::Context::Default::context{Complex}->copy;
+$Parser::Context::Default::context{LimitedComplex} = $context;
+$context->operators->set(
+ '+' => {class => 'Parser::Legacy::LimitedComplex::BOP::add'},
+ '-' => {class => 'Parser::Legacy::LimitedComplex::BOP::subtract'},
+ '*' => {class => 'Parser::Legacy::LimitedComplex::BOP::multiply'},
+ '* ' => {class => 'Parser::Legacy::LimitedComplex::BOP::multiply'},
+ ' *' => {class => 'Parser::Legacy::LimitedComplex::BOP::multiply'},
+ ' ' => {class => 'Parser::Legacy::LimitedComplex::BOP::multiply'},
+ '/' => {class => 'Parser::Legacy::LimitedComplex::BOP::divide'},
+ ' /' => {class => 'Parser::Legacy::LimitedComplex::BOP::divide'},
+ '/ ' => {class => 'Parser::Legacy::LimitedComplex::BOP::divide'},
+ '^' => {class => 'Parser::Legacy::LimitedComplex::BOP::power'},
+ '**' => {class => 'Parser::Legacy::LimitedComplex::BOP::power'},
+ 'u+' => {class => 'Parser::Legacy::LimitedComplex::UOP::plus'},
+ 'u-' => {class => 'Parser::Legacy::LimitedComplex::UOP::minus'},
+);
+#
+# Remove these operators and functions
+#
+$context->lists->set(
+ AbsoluteValue => {class => 'Parser::Legacy::LimitedComplex::List::AbsoluteValue'},
+);
+$context->operators->undefine('_','U');
+$context->functions->disable('Complex');
+foreach my $fn ($context->functions->names) {$context->{functions}{$fn}{nocomplex} = 1}
+#
+# Format can be 'cartesian', 'polar', or 'either'
+#
+$context->flags->set(complex_format => 'either');
+
+$context = $context->copy;
+$Parser::Context::Default::context{'LimitedComplex-cartesian'} = $context;
+$context->flags->set(complex_format => 'cartesian');
+
+$context = $context->copy;
+$Parser::Context::Default::context{'LimitedComplex-cartesian-strict'} = $context;
+$context->flags->set(strict_numeric => 1);
+$context->functions->disable('All');
+
+$context = $Parser::Context::Default::context{'LimitedComplex'}->copy;
+$Parser::Context::Default::context{'LimitedComplex-polar'} = $context;
+$context->flags->set(complex_format => 'polar');
+
+$context = $context->copy;
+$Parser::Context::Default::context{'LimitedComplex-polar-strict'} = $context;
+$context->flags->set(strict_numeric => 1);
+$context->functions->disable('All');
+
+$context = $Parser::Context::Default::context{'LimitedComplex'}->copy;
+$Parser::Context::Default::context{'LimitedComplex-strict'} = $context;
+$context->flags->set(strict_numeric => 1);
+$context->functions->disable('All');
+
+1;
--- /dev/null
+++ lib/Parser/Legacy/PGcomplexmacros.pl
@@ -0,0 +1,1343 @@
+# This file is PGcomplexmacros.pl
+# This includes the subroutines for the ANS macros, that
+# is, macros allowing a more flexible answer checking
+####################################################################
+# Copyright @ 1995-2002 The WeBWorK Team
+# All Rights Reserved
+####################################################################
+#$Id: PGcomplexmacros.pl,v 1.1 2005/09/07 01:10:58 dpvc Exp $
+
+
+=head1 NAME
+
+ Macros for complex numbers for the PG language
+
+=head1 SYNPOSIS
+
+
+
+=head1 DESCRIPTION
+
+=cut
+
+
+BEGIN{
+ be_strict();
+
+}
+
+
+
+sub _PGcomplexmacros_init {
+}
+# export functions from Complex1.
+
+foreach my $f (@Complex1::EXPORT) {
+# #PG_restricted_eval("\*$f = \*Complex1::$f"); # this is too clever --
+ # the original subroutines are destroyed
+# next if $f eq 'sqrt'; #exporting the square root caused conflicts with the standard version
+# # You can still use Complex1::sqrt to take square root of complex numbers
+# next if $f eq 'log'; #exporting loq caused conflicts with the standard version
+# # You can still use Complex1::log to take square root of complex numbers
+
+ next if $f eq 'i' || $f eq 'pi';
+ my $code = PG_restricted_eval("\\&CommonFunction::$f");
+ if (defined($code) && defined(&{$code})) {
+ $CommonFunction::function{$f} = "Complex1::$f"; # PGcommonMacros now takes care of this.
+ } else {
+ my $string = qq{sub main::$f {&Complex1::$f}};
+ PG_restricted_eval($string);
+ }
+
+}
+
+
+# You need to add
+# sub i(); # to your problem or else to dangerousMacros.pl
+# in order to use expressions such as 1 +3*i;
+# Without this prototype you would have to write 1+3*i();
+# The prototype has to be defined at compile time, but dangerousMacros.pl is complied first.
+#Complex1::display_format('cartesian');
+
+# number format used frequently in strict prefilters
+my $number = '([+-]?)(?=\d|\.\d)\d*(\.\d*)?(E([+-]?\d+))?';
+
+
+
+
+=head4 cplx_cmp
+
+ This subroutine compares complex numbers.
+ Available prefilters include:
+ each of these are called by cplx_cmp( answer, mode => '(prefilter name)' )
+ 'std' The standard comparison method for complex numbers. This option it the default
+ and works with any combination of cartesian numbers, polar numbers, and
+ functions. The default display method is cartesian, for all methods, but if
+ the student answer is polar, even in part, then their answer will be displayed
+ that way.
+ 'strict_polar' This is still under developement. The idea is to check to make sure that there
+ only a single term in front of the e and after it... but the method does not
+ check to make sure that the i is in the exponent, nor does it handle cases
+ where the polar has e** coefficients.
+ 'strict_num_cartesian' This prefilter allows only complex numbers of the form "a+bi" where a and b
+ are strictly numbers.
+ 'strict_num_polar' This prefilter allows only complex numbers of the form "ae^(bi)" where a and b
+ are strictly numbers.
+ 'strict' This is a combination of strict_num_cartesian and strict_num_polar, so it
+ allows complex numbers of either the form "a+bi" or "ae^(bi)" where a and b
+ are strictly numbers.
+
+
+=cut
+
+my %cplx_context = (
+ 'std' => 'Complex',
+ 'strict' => 'LimitedComplex-strict',
+ 'strict_polar' => 'LimitedComplex-polar',
+ 'strict_cartesian' => 'LimitedComplex-cartesian',
+ 'strict_num_polar' => 'LimitedComplex-polar-strict',
+ 'strict_num_cartesian' => 'LimitedComplex-cartesian-strict',
+);
+
+sub cplx_cmp {
+ return original_cplx_cmp(@_) if $main::useOldAnswerMacros;
+
+ my $correctAnswer = shift;
+ my %cplx_params = @_;
+
+ #
+ # Get default options
+ #
+ assign_option_aliases( \%cplx_params,
+ 'reltol' => 'relTol',
+ );
+ set_default_options(\%cplx_params,
+ 'tolType' => (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
+ # default mode should be relative, to obtain this tol must not be defined
+ 'tolerance' => $main::numAbsTolDefault,
+ 'relTol' => $main::numRelPercentTolDefault,
+ 'zeroLevel' => $main::numZeroLevelDefault,
+ 'zeroLevelTol' => $main::numZeroLevelTolDefault,
+ 'format' => $main::numFormatDefault,
+ 'debug' => 0,
+ 'mode' => 'std',
+ 'strings' => undef,
+ );
+ my $format = $cplx_params{'format'};
+ my $mode = $cplx_params{'mode'};
+
+ if( $cplx_params{tolType} eq 'relative' ) {
+ $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
+ }
+
+ my $context = $cplx_context{$mode};
+ unless ($context) {$context = "Complex"; warn "Unknown mode '$mode'"}
+ $context = $Parser::Context::Default::context{$context}->copy;
+
+ #
+ # Set the format for the context
+ #
+ $context->{format}{number} = $cplx_params{'format'} if $cplx_params{'format'};
+
+ #
+ # Add the strings to the context
+ #
+ if ($cplx_params{strings}) {
+ foreach my $string (@{$cplx_params{strings}}) {
+ my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): ();
+ $context->strings->add(uc($string) => {%tex})
+ unless $context->strings->get(uc($string));
+ }
+ }
+
+ #
+ # Set the tolerances
+ #
+ if ($cplx_params{tolType} eq 'absolute') {
+ $context->flags->set(
+ tolerance => $cplx_params{tolerance},
+ tolType => 'absolute',
+ );
+ } else {
+ $context->flags->set(
+ tolerance => .01*$cplx_params{tolerance},
+ tolType => 'relative',
+ );
+ }
+ $context->flags->set(
+ zeroLevel => $cplx_params{zeroLevel},
+ zeroLevelTol => $cplx_params{zeroLevelTol},
+ );
+
+ #
+ # Get the proper Parser object for the professor's answer
+ # using the initialized context
+ #
+ my $oldContext = Parser::Context->current(\%main::context,$context); my $z;
+ if (ref($correctAnswer) eq 'Complex') {
+ $z = Value::Complex->new($correctAnswer->Re,$correctAnswer->Im);
+ } else {
+ $z = Value::Formula->new($correctAnswer);
+ die "The professor's answer can't be a formula" unless $z->isConstant;
+ $z = $z->eval; $z = new Value::Complex($z) unless Value::class($z) eq 'String';
+ }
+ $z->{correct_ans} = $correctAnswer;
+
+ #
+ # Get the answer checker from the parser object
+ #
+ my $cmp = $z->cmp;
+ $cmp->install_pre_filter(sub {
+ my $rh_ans = shift;
+ $rh_ans->{original_student_ans} = $rh_ans->{student_ans};
+ $rh_ans->{original_correct_ans} = $rh_ans->{correct_ans};
+ return $rh_ans;
+ });
+ $cmp->install_post_filter(sub {
+ my $rh_ans = shift; my $z = $rh_ans->{student_value};
+ #
+ # Stringify student answer (use polar form if student did)
+ #
+ if (ref($z) && $z->isNumber) {
+ $z = Value::Complex->new($z); # promote real to complex
+ if ($rh_ans->{original_student_ans} =~ m/(^|[^a-zA-Z])e\s*(\^|\*\*)/) {
+ my ($a,$b) = ($z->mod,$z->arg);
+ unless ($context->flag('strict_numeric')) {
+ my $rt = (new Complex($z->Re->value,$z->Im->value))->stringify_polar;
+ ($a,$b) = ($rt =~ m/\[(.*),(.*)\]/);
+ }
+ $a = Value::Real->new($a)->string;
+ $b = Value::Real->new($b)->string if Value::matchNumber($b);
+ if ($b eq '0') {
+ $rh_ans->{student_ans} = $a;
+ } else {
+ if ($a eq '1') {$a = ''} elsif ($a eq '-1') {$a = '-'} else {$a .= '*'}
+ if ($b eq '1') {$b = 'i'} elsif ($b eq '-1') {$b = '(-i)'} else {$b = "($b i)"}
+ $rh_ans->{student_ans} = $a.'e^'.$b;
+ }
+ } else {
+ $rh_ans->{student_ans} = $rh_ans->{student_value}->string;
+ }
+ }
+ return $rh_ans;
+ });
+ $cmp->{debug} = $cplx_params{debug};
+ Parser::Context->current(\%main::context,$oldContext);
+
+ return $cmp;
+}
+
+#
+# The original version, for backward compatibility
+# (can be removed when the Parser-based version is more fully tested.)
+#
+sub original_cplx_cmp {
+ my $correctAnswer = shift;
+ my %cplx_params = @_;
+
+ assign_option_aliases( \%cplx_params,
+ 'reltol' => 'relTol',
+ );
+ set_default_options(\%cplx_params,
+ 'tolType' => (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
+ # default mode should be relative, to obtain this tol must not be defined
+ 'tolerance' => $main::numAbsTolDefault,
+ 'relTol' => $main::numRelPercentTolDefault,
+ 'zeroLevel' => $main::numZeroLevelDefault,
+ 'zeroLevelTol' => $main::numZeroLevelTolDefault,
+ 'format' => $main::numFormatDefault,
+ 'debug' => 0,
+ 'mode' => 'std',
+ 'strings' => undef,
+ );
+ my $format = $cplx_params{'format'};
+ my $mode = $cplx_params{'mode'};
+
+ if( $cplx_params{tolType} eq 'relative' ) {
+ $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
+ }
+
+ my $formattedCorrectAnswer;
+ my $correct_num_answer;
+ my $corrAnswerIsString = 0;
+
+
+ if (defined($cplx_params{strings}) && $cplx_params{strings}) {
+ my $legalString = '';
+ my @legalStrings = @{$cplx_params{strings}};
+ $correct_num_answer = $correctAnswer;
+ $formattedCorrectAnswer = $correctAnswer;
+ foreach $legalString (@legalStrings) {
+ if ( uc($correctAnswer) eq uc($legalString) ) {
+ $corrAnswerIsString = 1;
+
+ last;
+ }
+ } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
+ } else {
+ $correct_num_answer = $correctAnswer;
+ $formattedCorrectAnswer = prfmt( $correctAnswer, $cplx_params{'format'} );
+ }
+ $correct_num_answer = math_constants($correct_num_answer);
+
+ my $PGanswerMessage = '';
+
+#
+# The following lines don't have any effect (other than to take time and produce errors
+# in the error log). The $correctVal is replaced on the line following the comments,
+# and the error values are never used. It LOOKS like this was supposed to perform a
+# check on the professor's answer, but that is not occurring. (There used to be some
+# error checking, but that was removed in version 1.9 and it had been commented out
+# prior to that because it was always producing errors. This is because $correct_num_answer
+# usually is somethine like "1+4i", which will produce a "missing operation before 'i'"
+# error, and "1-i" wil produce an "amiguous use of '-i' resolved as '-&i'" message.
+# You probably need a call to check_syntax and the other filters that are used on
+# the student answer first. (Unless the item is already a reference to a Complex,
+# in which canse you should just accept it.)
+#
+# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
+ my $correctVal;
+# if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
+# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
+# } else { # case of a string answer
+# $PG_eval_errors = ' ';
+# $correctVal = $correctAnswer;
+# }
+
+ ########################################################################
+ $correctVal = $correct_num_answer;
+ $correctVal = cplx( $correctVal, 0 ) unless ref($correctVal) =~/^Complex?/ || $corrAnswerIsString == 1;
+
+ #construct the answer evaluator
+ my $answer_evaluator = new AnswerEvaluator;
+ $answer_evaluator->{debug} = $cplx_params{debug};
+ $answer_evaluator->ans_hash(
+ correct_ans => $correctVal,
+ type => "cplx_cmp",
+ tolerance => $cplx_params{tolerance},
+ tolType => 'absolute', # $cplx_params{tolType},
+ original_correct_ans => $formattedCorrectAnswer,
+ answerIsString => $corrAnswerIsString,
+ answer_form => 'cartesian',
+ );
+ my ($in, $formattedSubmittedAnswer);
+ $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
+ $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
+ );
+ if (defined($cplx_params{strings}) && $cplx_params{strings}) {
+ $answer_evaluator->install_pre_filter(\&check_strings, %cplx_params);
+ }
+
+ $answer_evaluator->install_pre_filter(\&check_syntax);
+ $answer_evaluator->install_pre_filter(\&math_constants);
+ $answer_evaluator->install_pre_filter(\&cplx_constants);
+ $answer_evaluator->install_pre_filter(\&check_for_polar);
+ if ($mode eq 'std') {
+ # do nothing
+ } elsif ($mode eq 'strict_polar') {
+ $answer_evaluator->install_pre_filter(\&is_a_polar);
+ } elsif ($mode eq 'strict_num_cartesian') {
+ $answer_evaluator->install_pre_filter(\&is_a_numeric_cartesian);
+ } elsif ($mode eq 'strict_num_polar') {
+ $answer_evaluator->install_pre_filter(\&is_a_numeric_polar);
+ } elsif ($mode eq 'strict') {
+ $answer_evaluator->install_pre_filter(\&is_a_numeric_complex);
+ } else {
+ $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
+ $formattedSubmittedAnswer = $in;
+ }
+
+ if ($corrAnswerIsString == 0 ){ # avoiding running compare_cplx when correct answer is a string.
+ $answer_evaluator->install_evaluator(\&compare_cplx, %cplx_params);
+ }
+
+
+###############################################################################
+# We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
+# can be displayed in the answer message. This may still cause a few anomolies when strings are used
+#
+###############################################################################
+
+ $answer_evaluator->install_post_filter(\&fix_answers_for_display);
+ $answer_evaluator->install_post_filter(\&fix_for_polar_display);
+
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
+ return $rh_ans unless $rh_ans->catch_error('EVAL');
+ $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
+ $rh_ans->clear_error('EVAL'); } );
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('POLAR'); } );
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('CARTESIAN'); } );
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('COMPLEX'); } );
+ $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
+ $answer_evaluator;
+}
+
+
+
+# compares two complex numbers by comparing their real and imaginary parts
+sub compare_cplx {
+ my ($rh_ans, %options) = @_;
+ my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
+
+ if ($PG_eval_errors) {
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
+ $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
+ return $rh_ans;
+ } else {
+ $rh_ans->{student_ans} = prfmt($inVal,$options{format});
+ }
+
+ $inVal = cplx($inVal,0) unless ref($inVal) =~/Complex/;
+ my $permitted_error_Re;
+ my $permitted_error_Im;
+ if ($rh_ans->{tolType} eq 'absolute') {
+ $permitted_error_Re = $rh_ans->{tolerance};
+ $permitted_error_Im = $rh_ans->{tolerance};
+ }
+ elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
+ $permitted_error_Re = $options{zeroLevelTol}; ## want $tol to be non zero
+ $permitted_error_Im = $options{zeroLevelTol}; ## want $tol to be non zero
+ }
+ else {
+ $permitted_error_Re = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Re);
+ $permitted_error_Im = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Im);
+
+ }
+
+ $rh_ans->{score} = 1 if ( abs( $rh_ans->{correct_ans}->Complex::Re - $inVal->Complex::Re) <=
+ $permitted_error_Re && abs($rh_ans->{correct_ans}->Complex::Im - $inVal->Complex::Im )<= $permitted_error_Im );
+
+ $rh_ans;
+}
+
+=head4 multi_cmp
+
+
+ Checks a comma separated string of items against an array of evaluators.
+ For example this is useful for checking all of the complex roots of an equation.
+ Each student answer must be evaluated as correct by a DISTINCT answer evalutor.
+
+ This answer checker will only work reliably if each answer checker corresponds
+ to a distinct correct answer. For example if one answer checker requires
+ any positive number, and the second requires the answer 1, then 1,2 might
+ be judged incorrect since 1, satisifes the first answer checker, but 2 doesn't
+ satisfy the second. 2,1 would work however. Avoid this type of use!!
+
+ Including backtracking to fit the answers as best possible to each answer evaluator
+ in the best possible way, is beyond the ambitions of this evaluator.
+
+
+=cut
+
+sub multi_cmp {
+ my $ra_answer_evaluators = shift; # array of evaluators
+ my %options = @_;
+ my @answer_evaluators = @{$ra_answer_evaluators};
+ my $backup_ans_eval = $answer_evaluators[0];
+ my $multi_ans_evaluator = new AnswerEvaluator;
+ $multi_ans_evaluator->install_evaluator( sub {
+ my $rh_ans = shift;
+ my @student_answers = split/\s*,\s*/,$rh_ans->{student_ans};
+ my @evaluated_ans_hashes = ();
+ for ( my $j=0; $j<@student_answers; $j++ ) {
+ # find an answer evaluator which marks this answer correct.
+ my $student_ans = $student_answers[$j];
+ my $temp_hash;
+ for ( my $i=0; $i<@answer_evaluators; $i++ ) {
+ my $evaluator = $answer_evaluators[$i];
+ $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
+ %$temp_hash = %{$evaluator->evaluate($student_ans)};
+ if (($temp_hash->{score} == 1)) {
+ # save evaluated answer
+ push @evaluated_ans_hashes, $temp_hash;
+ # remove answer evaluator and check the next answer
+ splice(@answer_evaluators,$i,1);
+ last;
+ }
+ }
+ # if we exit the loop without finding a correct evaluation:
+ # make sure every answer is evaluated, even extra answers for which
+ # there will be no answer evaluators left.
+ if (not defined($temp_hash) ) { # make sure every answer is evaluated, even extra answers.
+ my $evaluator = $backup_ans_eval;
+ $temp_hash = new AnswerHash; # make a copy of the answer hash resulting from the evaluation
+ %$temp_hash = %{$evaluator->evaluate($student_ans)};
+ $temp_hash->{score} =0; # this was an extra answer -- clearly incorrect
+ $temp_hash->{correct_ans} = "too many answers";
+ }
+ # now make sure that even answers which
+ # don't never evaluate correctly are still recorded in the list
+ if ( $temp_hash->{score} <1) {
+ push @evaluated_ans_hashes, $temp_hash;
+ }
+
+
+ }
+ # construct the final answer hash
+ my $rh_ans_out = shift @evaluated_ans_hashes;
+ while (@evaluated_ans_hashes) {
+ my $temp_hash = shift @evaluated_ans_hashes;
+ $rh_ans_out =$rh_ans_out->AND($temp_hash);
+ }
+ $rh_ans_out->{student_ans} = $rh_ans->{student_ans};
+ $rh_ans_out->{score}=0 unless @{$ra_answer_evaluators} == @student_answers; # require the correct number of answers
+ $rh_ans_out;
+ });
+ $multi_ans_evaluator;
+}
+# sub multi_cmp_old{
+# my $pointer = shift; # array of evaluators
+# my %options = @_;
+# my @evals = @{$pointer};
+# my $answer_evaluator = new AnswerEvaluator;
+# $answer_evaluator->install_evaluator( sub {
+# my $rh_ans = shift;
+# $rh_ans->{score} = 1;#in order to use AND below, score must be 1
+# $rh_ans->{preview_text_string} = "";#needs to be initialized to prevent warnings
+# my @student_answers = split/,/,$rh_ans->{student_ans};
+# foreach my $eval ( @evals ){
+# my $temp_eval = new AnswerEvaluator;
+# my $temp_hash = $temp_eval->ans_hash;
+# $temp_hash->{preview_text_string} = "";#needs to be initialized to prevent warnings
+# #FIXME I believe there is a logic problem here.
+# # If each answer entered is judged correct by ONE answer evaluator
+# # then the answer is correct, but for example if you enter a correct
+# # root to an equation twice each answer will be judged correct and
+# # and the whole question correct, even though the answer omits
+# # the second root.
+# foreach my $temp ( @student_answers ){
+# $eval->evaluate($temp);
+# $temp = $eval->ans_hash->{student_ans} unless $eval->ans_hash->{student_ans}=~ /you/i;
+# $temp_hash = $temp_hash->OR( $eval->ans_hash );
+# if( $eval->ans_hash->{score} == 1){ last; }
+# }
+# $rh_ans = $rh_ans->AND( $temp_hash );
+# }
+# #$rh_ans->{correct_ans} =~ s/No correct answer specified (OR|AND) //g;
+# $rh_ans->{student_ans} = "";
+# foreach( @student_answers ){ $rh_ans->{student_ans} .= "$_, "; }
+# $rh_ans->{student_ans} =~ s/, \Z//;
+# if( scalar(@evals) != scalar(@student_answers) ){ $rh_ans->{score} = 0; }#wrong number of answers makes answer wrong
+# $rh_ans; });
+# $answer_evaluator;
+# }
+# this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
+# sub mult_cmp{
+# my $answer = shift;
+# my @answers = @{$answer} if ref($answer) eq 'ARRAY';
+# my %mult_params = @_;
+# my @keys = qw ( tolerance tolType format mode zeroLevel zeroLevelTol debug );
+# my @correctVal;
+# my $formattedCorrectAnswer;
+# my @correct_num_answer;
+# my ($PG_eval_errors,$PG_full_error_report);
+# assign_option_aliases( \%mult_params,
+# 'reltol' => 'relTol',
+# );
+# set_default_options(\%mult_params,
+# 'tolType' => (defined($mult_params{tol}) ) ? 'absolute' : 'relative',
+# # default mode should be relative, to obtain this tol must not be defined
+# 'tolerance' => $main::numAbsTolDefault,
+# 'relTol' => $main::numRelPercentTolDefault,
+# 'zeroLevel' => $main::numZeroLevelDefault,
+# 'zeroLevelTol' => $main::numZeroLevelTolDefault,
+# 'format' => $main::numFormatDefault,
+# 'debug' => 0,
+# 'mode' => 'std',
+# 'compare' => 'num',
+# );
+# my $format = $mult_params{'format'};
+# my $mode = $mult_params{'mode'};
+#
+#
+# if( $mult_params{tolType} eq 'relative' ) {
+# $mult_params{'tolerance'} = .01*$mult_params{'relTol'};
+# }
+#
+# if( $mult_params{ 'compare' } eq 'cplx' ){
+# foreach( @answers )
+# {
+# $_ = cplx( $_, 0 ) unless ref($_) =~/Complex/;
+# }
+# }
+#
+# my $corrAnswerIsString = 0;
+#
+# for( my $k = 0; $k < @answers; $k++ ){
+# if (defined($mult_params{strings}) && $mult_params{strings}) {
+# my $legalString = '';
+# my @legalStrings = @{$mult_params{strings}};
+# $correct_num_answer[$k] = $answers[$k];
+# $formattedCorrectAnswer .= $answers[$k] . ",";
+# foreach $legalString (@legalStrings) {
+# if ( uc($answers[$k]) eq uc($legalString) ) {
+# $corrAnswerIsString = 1;
+#
+# last;
+# }
+# } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
+# } else {
+# $correct_num_answer[$k] = $answers[$k];
+# $formattedCorrectAnswer .= prfmt( $answers[$k], $mult_params{'format'} ) . ", ";
+# }
+# $correct_num_answer[$k] = math_constants($correct_num_answer[$k]);
+# my $PGanswerMessage = '';
+#
+#
+# if (defined($correct_num_answer[$k]) && $correct_num_answer[$k] =~ /\S/ && $corrAnswerIsString == 0 ) {
+# ($correctVal[$k], $PG_eval_errors,$PG_full_error_report) =
+# PG_answer_eval($correct_num_answer[$k]);
+# } else { # case of a string answer
+# $PG_eval_errors = ' ';
+# $correctVal[$k] = $answers[$k];
+# }
+#
+# #if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal[$k])) && $corrAnswerIsString == 0)) {
+# ##error message from eval or above
+# #warn "Error in 'correct' answer: $PG_eval_errors<br>
+# #The answer $answers[$k] evaluates to $correctVal[$k],
+# #which cannot be interpreted as a number. ";
+#
+# #}
+# ########################################################################
+# $correctVal[$k] = $correct_num_answer[$k];
+# }
+# $formattedCorrectAnswer =~ s/, \Z//;
+#
+# #construct the answer evaluator
+#
+# my $answer_evaluator = new AnswerEvaluator;
+#
+#
+# $answer_evaluator->{debug} = $mult_params{debug};
+# $answer_evaluator->ans_hash(
+# correct_ans => [@correctVal],
+# type => "${mode}_number",
+# tolerance => $mult_params{tolerance},
+# tolType => 'absolute', # $mult_params{tolType},
+# original_correct_ans => $formattedCorrectAnswer,
+# answerIsString => $corrAnswerIsString,
+# answer_form => 'cartesian',
+# );
+# my ($in, $formattedSubmittedAnswer);
+# $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
+# $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
+# );
+# if (defined($mult_params{strings}) && $mult_params{strings}) {
+# $answer_evaluator->install_pre_filter(\&check_strings, %mult_params);
+# }
+#
+# $answer_evaluator -> install_pre_filter( \&mult_prefilters, %mult_params );
+# $answer_evaluator->install_pre_filter( sub{my $rh_ans = shift; $rh_ans->{original_student_ans} = $rh_ans->{student_ans};$rh_ans;});
+#
+# if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
+# $answer_evaluator->install_evaluator(\&compare_mult, %mult_params);
+# }
+#
+#
+# ###############################################################################
+# # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
+# # can be displayed in the answer message. This may still cause a few anomolies when strings are used
+# #
+# ###############################################################################
+# $answer_evaluator->install_post_filter( sub{my $rh_ans = shift; $rh_ans->{student_ans} = $rh_ans->{original_student_ans};$rh_ans;});
+# $answer_evaluator->install_post_filter(\&fix_answers_for_display);
+# $answer_evaluator->install_post_filter(\&fix_for_polar_display);
+#
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
+# return $rh_ans unless $rh_ans->catch_error('EVAL');
+# $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
+# $rh_ans->clear_error('EVAL'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('POLAR'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('CARTESIAN'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('COMPLEX'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
+# $answer_evaluator;
+# }
+
+# sub mult_prefilters{
+# my ($rh_ans, %options) = @_;
+# my @student_answers = split/,/,$rh_ans->{student_ans};
+# foreach( @student_answers ){
+# $rh_ans->{student_ans} = $_;
+# $rh_ans = &check_syntax( $rh_ans );
+# $rh_ans = &math_constants( $rh_ans );
+# if( $options{compare} eq 'cplx' ){
+# $rh_ans = &cplx_constants( $rh_ans );
+# #$rh_ans = &check_for_polar( $rh_ans );
+# }
+# if ( $options{mode} eq 'std') {
+# # do nothing
+# } elsif ($options{mode} eq 'strict_polar') {
+# $rh_ans = &is_a_polar( $rh_ans );
+# } elsif ($options{mode} eq 'strict_num_cartesian') {
+# $rh_ans = &is_a_numeric_cartesian( $rh_ans );
+# } elsif ($options{mode} eq 'strict_num_polar') {
+# $rh_ans = &is_a_numeric_polar( $rh_ans );
+# } elsif ($options{mode} eq 'strict') {
+# $rh_ans = &is_a_numeric_complex( $rh_ans );
+# } elsif ($options{mode} eq 'arith') {
+# $rh_ans = &is_an_arithmetic_expression( $rh_ans );
+# } elsif ($options{mode} eq 'frac') {
+# $rh_ans = &is_a_fraction( $rh_ans );
+#
+# } else {
+# #$PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
+# #$formattedSubmittedAnswer = $in;
+# }
+# $_ = $rh_ans->{student_ans};
+# }
+# my $ans_string;
+# foreach( @student_answers )
+# {
+# $ans_string .= ", $_";
+# }
+# $ans_string =~ s/\A,//;
+# $rh_ans->{student_ans} = $ans_string;
+# $rh_ans;
+# }
+
+# sub polar{
+# my $z = shift;
+# my %options = @_;
+# my $r = rho($z);
+# my $theta = $z->theta;
+# my $r_format = ':%0.3f';
+# my $theta_format = ':%0.3f';
+# $r_format=":" . $options{r_format} if defined($options{r_format});
+# $theta_format = ":" . $options{theta_format} if defined($options{theta_format});
+# "{$r$r_format} e^{i {$theta$theta_format}}";
+#
+# }
+
+# compares two complex numbers by comparing their real and imaginary parts
+# sub compare_mult {
+# my ($rh_ans, %options) = @_;
+# my @student_answers = split/,/,$rh_ans->{student_ans};
+# my @correct_answers = @{$rh_ans->{correct_ans}};
+# my $one_correct = 1/@correct_answers;
+# my $temp_score = 0;
+# foreach( @correct_answers ){
+# $rh_ans->{correct_ans} = $_;
+# foreach( @student_answers ){
+# $rh_ans->{student_ans} = $_;
+# if( $options{compare} eq 'cplx' ){
+# $rh_ans = &compare_cplx( $rh_ans, %options);
+# }else{
+# $rh_ans = &compare_numbers( $rh_ans, %options);
+# }
+# if( $rh_ans->{score} == 1 )
+# {
+# $temp_score += $one_correct;
+# $rh_ans->{score} = 0;
+# last;
+# }
+# }
+# }
+# $rh_ans->{score} = $temp_score;
+# $rh_ans;
+#
+# }
+
+
+
+# Output is text displaying the complex numver in "e to the i theta" form. The
+# formats for the argument theta is determined by the option C<theta_format> and the
+# format for the modulus is determined by the C<r_format> option.
+
+#this basically just checks for "e^" which unfortunately will show something like (e^4)*i as a polar, this should be changed
+sub check_for_polar{
+
+ my($in,%options) = @_;
+ my $rh_ans;
+ my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
+ if ($process_ans_hash) {
+ $rh_ans = $in;
+ $in = $rh_ans->{student_ans};
+ }
+ # The code fragment above allows this filter to be used when the input is simply a string
+ # as well as when the input is an AnswerHash, and options.
+ if( $in =~ /2.71828182845905\*\*/ ){
+ $rh_ans->{answer_form} = 'polar';
+ }
+ $rh_ans;
+}
+
+
+
+sub cplx_constants {
+ my($in,%options) = @_;
+ my $rh_ans;
+ my $process_ans_hash = ( ref( $in ) eq 'AnswerHash' ) ? 1 : 0 ;
+ if ($process_ans_hash) {
+ $rh_ans = $in;
+ $in = $rh_ans->{student_ans};
+ }
+ # The code fragment above allows this filter to be used when the input is simply a string
+ # as well as when the input is an AnswerHash, and options.
+ $in =~ s/\bi\b/(i)/g; #try to keep -i being recognized as a file reference
+ # and recognized as a function whose output is an imaginary number
+
+ if ($process_ans_hash) {
+ $rh_ans->{student_ans}=$in;
+ return $rh_ans;
+ } else {
+ return $in;
+ }
+}
+
+## allows only for numbers of the form a+bi and ae^(bi), where a and b are strict numbers
+sub is_a_numeric_complex {
+ my ($num,%options) = @_;
+ my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
+ my ($rh_ans);
+ if ($process_ans_hash) {
+ $rh_ans = $num;
+ $num = $rh_ans->{student_ans};
+ }
+
+ my $is_a_number = 0;
+ return $is_a_number unless defined($num);
+ $num =~ s/^\s*//; ## remove initial spaces
+ $num =~ s/\s*$//; ## remove trailing spaces
+
+ if ($num =~
+
+/^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\)|$number)$/){
+ $is_a_number = 1;
+ }
+
+ if ($process_ans_hash) {
+ if ($is_a_number == 1 ) {
+ $rh_ans->{student_ans}=$num;
+ return $rh_ans;
+ } else {
+ $rh_ans->{student_ans} = "Incorrect number format: You must enter a numeric complex, e.g. a+bi
+ or a*e^(bi)";
+ $rh_ans->throw_error('COMPLEX', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
+ return $rh_ans;
+ }
+ } else {
+ return $is_a_number;
+ }
+}
+
+## allows only for the form a + bi, where a and b are strict numbers
+sub is_a_numeric_cartesian {
+ my ($num,%options) = @_;
+ my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
+ my ($rh_ans);
+ if ($process_ans_hash) {
+ $rh_ans = $num;
+ $num = $rh_ans->{student_ans};
+ }
+
+ my $is_a_number = 0;
+ return $is_a_number unless defined($num);
+ $num =~ s/^\s*//; ## remove initial spaces
+ $num =~ s/\s*$//; ## remove trailing spaces
+
+ if ($num =~
+
+/^($number[+,-]?($number\*\(i\)|\(i\)|\(i\)\*$number)|($number\*\(i\)|-?\(i\)|-?\(i\)\*$number)([+,-]$number)?|$number)$/){
+ $is_a_number = 1;
+ }
+
+ if ($process_ans_hash) {
+ if ($is_a_number == 1 ) {
+ $rh_ans->{student_ans}=$num;
+ return $rh_ans;
+ } else {
+ $rh_ans->{student_ans} = "Incorrect number format: You must enter a numeric cartesian, e.g. a+bi";
+ $rh_ans->throw_error('CARTESIAN', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
+ return $rh_ans;
+ }
+ } else {
+ return $is_a_number;
+ }
+}
+
+## allows only for the form ae^(bi), where a and b are strict numbers
+sub is_a_numeric_polar {
+ my ($num,%options) = @_;
+ my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
+ my ($rh_ans);
+ if ($process_ans_hash) {
+ $rh_ans = $num;
+ $num = $rh_ans->{student_ans};
+ }
+
+ my $is_a_number = 0;
+ return $is_a_number unless defined($num);
+ $num =~ s/^\s*//; ## remove initial spaces
+ $num =~ s/\s*$//; ## remove trailing spaces
+ if ($num =~
+ /^($number|($number\*)?2.71828182845905\*\*\(($number\*\(i\)|\(i\)\*$number|i|-\(i\))\))$/){
+ $is_a_number = 1;
+ }
+
+ if ($process_ans_hash) {
+ if ($is_a_number == 1 ) {
+ $rh_ans->{student_ans}=$num;
+ return $rh_ans;
+ } else {
+ $rh_ans->{student_ans} = "Incorrect number format: You must enter a numeric polar, e.g. a*e^(bi)";
+ $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
+ return $rh_ans;
+ }
+ } else {
+ return $is_a_number;
+ }
+}
+
+#this subroutine mearly captures what is before and after the "e**" it does not verify that the "i" is there, or in the
+#exponent this must eventually be addresed
+sub is_a_polar {
+ my ($num,%options) = @_;
+ my $process_ans_hash = ( ref( $num ) eq 'AnswerHash' ) ? 1 : 0 ;
+ my ($rh_ans);
+ if ($process_ans_hash) {
+ $rh_ans = $num;
+ $num = $rh_ans->{student_ans};
+ }
+
+ my $is_a_number = 0;
+ return $is_a_number unless defined($num);
+ $num =~ s/^\s*//; ## remove initial spaces
+ $num =~ s/\s*$//; ## remove trailing spaces
+ $num =~ /^(.*)\*2.71828182845905\*\*(.*)/;
+ #warn "rho: ", $1;
+ #warn "theta: ", $2;
+ if( defined( $1 ) ){
+ if( &single_term( $1 ) && &single_term( $2 ) )
+ {
+ $is_a_number = 1;
+ }
+ }
+ if ($process_ans_hash) {
+ if ($is_a_number == 1 ) {
+ $rh_ans->{student_ans}=$num;
+ return $rh_ans;
+ } else {
+ $rh_ans->{student_ans} = "Incorrect number format: You must enter a polar, e.g. a*e^(bi)";
+ $rh_ans->throw_error('POLAR', 'You must enter a number, e.g. -6, 5.3, or 6.12E-3');
+ return $rh_ans;
+ }
+ } else {
+ return $is_a_number;
+ }
+}
+
+=head4 single_term()
+ This subroutine takes in a string, which is a mathematical expresion, and determines whether or not
+ it is a single term. This is accoplished using a stack. Open parenthesis pluses and minuses are all
+ added onto the stack, and when a closed parenthesis is reached, the stack is popped untill the open
+ parenthesis is found. If the original was a single term, the stack should be empty after
+ evaluation. If there is anything left ( + or - ) then false is returned.
+ Of course, the unary operator "-" must be handled... if it is a unary operator, and not a regular -
+ the only place it could occur unambiguously without being surrounded by parenthesis, is the very
+ first position. So that case is checked before the loop begins.
+=cut
+
+sub single_term{
+ my $term = shift;
+ my @stack;
+ $term = reverse $term;
+ if( length $term >= 1 )
+ {
+ my $temp = chop $term;
+ if( $temp ne "-" ){ $term .= $temp; }
+ }
+ while( length $term >= 1 ){
+ my $character = chop $term;
+ if( $character eq "+" || $character eq "-" || $character eq "(" ){
+ push @stack, $character;
+ }elsif( $character eq ")" ){
+ while( pop @stack ne "(" ){}
+ }
+
+ }
+ if( scalar @stack == 0 ){ return 1;}else{ return 0;}
+}
+
+# changes default to display as a polar
+sub fix_for_polar_display{
+ my ($rh_ans, %options) = @_;
+ if( ref( $rh_ans->{student_ans} ) =~ /Complex/ && $rh_ans->{answer_form} eq 'polar' ){
+ $rh_ans->{student_ans}->display_format( 'polar');
+ ## these lines of code have the polar displayed as re^(theta) instead of [rho,theta]
+ $rh_ans->{student_ans} =~ s/,/*e^\(/;
+ $rh_ans->{student_ans} =~ s/\[//;
+ $rh_ans->{student_ans} =~ s/\]/i\)/;
+ }
+ $rh_ans;
+}
+
+# this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
+# sub cplx_cmp2 {
+# my $correctAnswer = shift;
+# my %cplx_params = @_;
+# my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
+# assign_option_aliases( \%cplx_params,
+# 'reltol' => 'relTol',
+# );
+# set_default_options(\%cplx_params,
+# 'tolType' => (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
+# # default mode should be relative, to obtain this tol must not be defined
+# 'tolerance' => $main::numAbsTolDefault,
+# 'relTol' => $main::numRelPercentTolDefault,
+# 'zeroLevel' => $main::numZeroLevelDefault,
+# 'zeroLevelTol' => $main::numZeroLevelTolDefault,
+# 'format' => $main::numFormatDefault,
+# 'debug' => 0,
+# 'mode' => 'std',
+#
+# );
+# $correctAnswer = cplx($correctAnswer,0) unless ref($correctAnswer) =~/Complex/;
+# my $format = $cplx_params{'format'};
+# my $mode = $cplx_params{'mode'};
+#
+# if( $cplx_params{tolType} eq 'relative' ) {
+# $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
+# }
+#
+# my $formattedCorrectAnswer;
+# my $correct_num_answer;
+# my $corrAnswerIsString = 0;
+#
+#
+# if (defined($cplx_params{strings}) && $cplx_params{strings}) {
+# my $legalString = '';
+# my @legalStrings = @{$cplx_params{strings}};
+# $correct_num_answer = $correctAnswer;
+# $formattedCorrectAnswer = $correctAnswer;
+# foreach $legalString (@legalStrings) {
+# if ( uc($correctAnswer) eq uc($legalString) ) {
+# $corrAnswerIsString = 1;
+#
+# last;
+# }
+# } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
+# } else {
+# $correct_num_answer = $correctAnswer;
+# $formattedCorrectAnswer = prfmt( $correctAnswer, $cplx_params{'format'} );
+# }
+# $correct_num_answer = math_constants($correct_num_answer);
+# my $PGanswerMessage = '';
+#
+# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
+#
+# if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
+# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
+# } else { # case of a string answer
+# $PG_eval_errors = ' ';
+# $correctVal = $correctAnswer;
+# }
+#
+# if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
+# ##error message from eval or above
+# warn "Error in 'correct' answer: $PG_eval_errors<br>
+# The answer $correctAnswer evaluates to $correctVal,
+# which cannot be interpreted as a number. ";
+#
+# }
+# ########################################################################
+# $correctVal = $correct_num_answer;#it took me two and a half hours to figure out that correctVal wasn't
+# #getting the number properly
+# #construct the answer evaluator
+# my $answer_evaluator = new AnswerEvaluator;
+#
+#
+# $answer_evaluator->{debug} = $cplx_params{debug};
+# $answer_evaluator->ans_hash(
+# correct_ans => $correctVal,
+# type => "${mode}_number",
+# tolerance => $cplx_params{tolerance},
+# tolType => 'absolute', # $cplx_params{tolType},
+# original_correct_ans => $formattedCorrectAnswer,
+# answerIsString => $corrAnswerIsString,
+# answer_form => 'cartesian',
+# );
+# my ($in, $formattedSubmittedAnswer);
+# $answer_evaluator->install_pre_filter(sub {my $rh_ans = shift;
+# $rh_ans->{original_student_ans} = $rh_ans->{student_ans}; $rh_ans;}
+# );
+# if (defined($cplx_params{strings}) && $cplx_params{strings}) {
+# $answer_evaluator->install_pre_filter(\&check_strings, %cplx_params);
+# }
+# #$answer_evaluator->install_pre_filter(\&check_syntax);
+#
+# $answer_evaluator->install_pre_filter(\&math_constants);
+# $answer_evaluator->install_pre_filter(\&cplx_constants);
+# $answer_evaluator->install_pre_filter(\&check_for_polar);
+# if ($mode eq 'std') {
+# # do nothing
+# } elsif ($mode eq 'strict_polar') {
+# $answer_evaluator->install_pre_filter(\&is_a_polar);
+# } elsif ($mode eq 'strict_num_cartesian') {
+# $answer_evaluator->install_pre_filter(\&is_a_numeric_cartesian);
+# } elsif ($mode eq 'strict_num_polar') {
+# $answer_evaluator->install_pre_filter(\&is_a_numeric_polar);
+# } elsif ($mode eq 'strict') {
+# $answer_evaluator->install_pre_filter(\&is_a_numeric_complex);
+# } elsif ($mode eq 'arith') {
+# $answer_evaluator->install_pre_filter(\&is_an_arithmetic_expression);
+# } elsif ($mode eq 'frac') {
+# $answer_evaluator->install_pre_filter(\&is_a_fraction);
+#
+# } else {
+# $PGanswerMessage = 'Tell your professor that there is an error in his or her answer mechanism. No mode was specified.';
+# $formattedSubmittedAnswer = $in;
+# }
+# if ($corrAnswerIsString == 0 ){ # avoiding running compare_numbers when correct answer is a string.
+# $answer_evaluator->install_evaluator(\&compare_cplx2, %cplx_params);
+# }
+#
+#
+# ###############################################################################
+# # We'll leave these next lines out for now, so that the evaluated versions of the student's and professor's
+# # can be displayed in the answer message. This may still cause a few anomolies when strings are used
+# #
+# ###############################################################################
+#
+# $answer_evaluator->install_post_filter(\&fix_answers_for_display);
+# $answer_evaluator->install_post_filter(\&fix_for_polar_display);
+#
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift;
+# return $rh_ans unless $rh_ans->catch_error('EVAL');
+# $rh_ans->{student_ans} = $rh_ans->{original_student_ans}. ' '. $rh_ans->{error_message};
+# $rh_ans->clear_error('EVAL'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('SYNTAX'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('POLAR'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('CARTESIAN'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('COMPLEX'); } );
+# $answer_evaluator->install_post_filter(sub {my $rh_ans = shift; $rh_ans->clear_error('STRING'); } );
+# $answer_evaluator;
+# }
+
+
+# compares two complex numbers by comparing their real and imaginary parts
+# this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
+# sub compare_cplx2 {
+# my ($rh_ans, %options) = @_;
+# my @answers = split/,/,$rh_ans->{student_ans};
+# foreach( @answers )
+# {
+# $rh_ans->{student_ans} = $_;
+# $rh_ans = &check_syntax( $rh_ans );
+# my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($rh_ans->{student_ans});
+#
+# if ($PG_eval_errors) {
+# $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
+# $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
+# # return $rh_ans;
+# } else {
+# $rh_ans->{student_ans} = prfmt($inVal,$options{format});
+# }
+#
+# $inVal = cplx($inVal,0) unless ref($inVal) =~/Complex/;
+# my $permitted_error_Re;
+# my $permitted_error_Im;
+# if ($rh_ans->{tolType} eq 'absolute') {
+# $permitted_error_Re = $rh_ans->{tolerance};
+# $permitted_error_Im = $rh_ans->{tolerance};
+# }
+# elsif ( abs($rh_ans->{correct_ans}) <= $options{zeroLevel}) {
+# $permitted_error_Re = $options{zeroLevelTol}; ## want $tol to be non zero
+# $permitted_error_Im = $options{zeroLevelTol}; ## want $tol to be non zero
+# }
+# else {
+# $permitted_error_Re = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Re);
+# $permitted_error_Im = abs($rh_ans->{tolerance}*$rh_ans->{correct_ans}->Complex::Im);
+#
+# }
+#
+# $rh_ans->{score} = 1 if ( abs( $rh_ans->{correct_ans}->Complex::Re - $inVal->Complex::Re) <=
+# $permitted_error_Re && abs($rh_ans->{correct_ans}->Complex::Im - $inVal->Complex::Im )<= $permitted_error_Im );
+# if( $rh_ans->{score} == 1 ){ return $rh_ans; }
+#
+#
+# }
+# $rh_ans;
+#
+# }
+
+# this does not seem to be in use, so I'm commenting it out. Mike Gage 6/27/05
+# sub cplx_cmp_mult {
+# my $correctAnswer = shift;
+# my %cplx_params = @_;
+# my @keys = qw ( correctAnswer tolerance tolType format mode zeroLevel zeroLevelTol debug );
+# assign_option_aliases( \%cplx_params,
+# 'reltol' => 'relTol',
+# );
+# set_default_options(\%cplx_params,
+# 'tolType' => (defined($cplx_params{tol}) ) ? 'absolute' : 'relative',
+# # default mode should be relative, to obtain this tol must not be defined
+# 'tolerance' => $main::numAbsTolDefault,
+# 'relTol' => $main::numRelPercentTolDefault,
+# 'zeroLevel' => $main::numZeroLevelDefault,
+# 'zeroLevelTol' => $main::numZeroLevelTolDefault,
+# 'format' => $main::numFormatDefault,
+# 'debug' => 0,
+# 'mode' => 'std',
+#
+# );
+# $correctAnswer = cplx($correctAnswer,0) unless ref($correctAnswer) =~/Complex/;
+# my $format = $cplx_params{'format'};
+# my $mode = $cplx_params{'mode'};
+#
+# if( $cplx_params{tolType} eq 'relative' ) {
+# $cplx_params{'tolerance'} = .01*$cplx_params{'relTol'};
+# }
+#
+# my $formattedCorrectAnswer;
+# my $correct_num_answer;
+# my $corrAnswerIsString = 0;
+#
+#
+# if (defined($cplx_params{strings}) && $cplx_params{strings}) {
+# my $legalString = '';
+# my @legalStrings = @{$cplx_params{strings}};
+# $correct_num_answer = $correctAnswer;
+# $formattedCorrectAnswer = $correctAnswer;
+# foreach $legalString (@legalStrings) {
+# if ( uc($correctAnswer) eq uc($legalString) ) {
+# $corrAnswerIsString = 1;
+#
+# last;
+# }
+# } ## at this point $corrAnswerIsString = 0 iff correct answer is numeric
+# } else {
+# $correct_num_answer = $correctAnswer;
+# $formattedCorrectAnswer = prfmt( $correctAnswer, $cplx_params{'format'} );
+# }
+# $correct_num_answer = math_constants($correct_num_answer);
+# my $PGanswerMessage = '';
+#
+# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
+#
+# if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
+# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
+# } else { # case of a string answer
+# $PG_eval_errors = ' ';
+# $correctVal = $correctAnswer;
+# }
+#
+# if ( ($PG_eval_errors && $corrAnswerIsString == 0) or ((not is_a_number($correctVal)) && $corrAnswerIsString == 0)) {
+# ##error message from eval or above
+# warn "Error in 'correct' answer: $PG_eval_errors<br>
+# The answer $correctAnswer evaluates to $correctVal,
+# which cannot be interpreted as a number. ";
+#
+# }
+# ########################################################################
+# $correctVal = $correct_num_answer;#it took me two and a half hours to figure out that correctVal wasn't
+# #getting the number properly
+# #construct the answer evaluator
+# my $counter = 0;
+# my $answer_evaluator = new AnswerEvaluator;
+#
+# my $number;
+# $answer_evaluator->install_pre_filter( sub{ my $rh_ans = shift; my @temp =
+# split/,/,$rh_ans->{student_ans}; $number = @temp; warn "this number ", $number; $rh_ans;});
+# warn "number ", $number;
+# while( $counter < 4 )
+# {
+# $answer_evaluator = &answer_mult( $correctVal, $mode, $formattedCorrectAnswer,
+# $corrAnswerIsString, $counter, %cplx_params );
+# warn "answer_evaluator ", $answer_evaluator;
+# $answer_evaluator->install_evaluator( sub { my $rh_ans = shift; warn "score ", $rh_ans->{score};
+# $rh_ans;});
+# $counter += 1;
+# }
+...
[truncated message content] |
|
From: dpvc v. a. <we...@ma...> - 2005-09-07 01:05:31
|
Log Message:
-----------
Added "strict" versions of the limited complex contexts that don't
allow operations within the real and imaginary parts. Also cleaned up
some of the code and fixed a few situations that had been missed
before.
Note that in strict mode, e^(pi i) is accepted, but e^(pi/2 i) is
not. Should that be changed? It would be possible to make a context
in which a*e^(b*pi/c i) is accepted.
Modified Files:
--------------
pg/macros:
contextLimitedComplex.pl
Revision Data
-------------
Index: contextLimitedComplex.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedComplex.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextLimitedComplex.pl -Lmacros/contextLimitedComplex.pl -u -r1.1 -r1.2
--- macros/contextLimitedComplex.pl
+++ macros/contextLimitedComplex.pl
@@ -10,7 +10,7 @@
# parts of the complex numbers, but not between complex numbers.
#
#
-# Complex Numbers can still be entered in a+bi or r*e^(it) form.
+# Complex Numbers can still be entered in a+bi or a*e^(bt) form.
# The e and i are allowed to be entered only once, so we have
# to keep track of that, and allow SOME complex operations,
# but only when one term is one of these constants (or an expression
@@ -27,6 +27,20 @@
# Context("LimitedComplex-cartesian");
# Context("LimitedComplex-polar");
#
+# You can require that the a and b used in these forms be strictly
+# numbers (not expressions) by setting the strict_numeric flag and
+# disabling all the functions:
+#
+# Context()->flags->set(strict_numeric=>1);
+# Context()->functions->disable('All');
+#
+# There are predefined contexts that already have these values
+# set:
+#
+# Context("LimitedComplex-cartesian-strict");
+# Context("LimitedComplex-polar-strict");
+# Context("LimitedComplex-strict");
+#
#
# Handle common checking for BOPs
@@ -42,18 +56,16 @@
my $self = shift;
my $super = ref($self); $super =~ s/LimitedComplex/Parser/;
&{$super."::_check"}($self);
- return if $self->{lop}->isRealNumber && $self->{rop}->isRealNumber;
- Value::Error("The constant 'i' may appear only once in your formula")
- if ($self->{lop}->isComplex and $self->{rop}->isComplex);
- return if $self->checkComplex;
- my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("Exponential form is 'r*e^(ai)'")
- if $self->{lop}{isPower} || $self->{rop}{isPower};
- $self->Error("Your answer should be of the form a+bi")
- if $self->{equation}{context}{flags}{complex_format} eq 'cartesian';
- $self->Error("Your answer should be of the form r*e^(ai)")
- if $self->{equation}{context}{flags}{complex_format} eq 'polar';
- $self->Error("Your answer should be of the form a+bi or r*e^(ai)");
+ if ($self->{lop}->isRealNumber && $self->{rop}->isRealNumber) {
+ return unless $self->{equation}{context}{flags}{strict_numeric};
+ } else {
+ Value::Error("The constant 'i' may appear only once in your formula")
+ if ($self->{lop}->isComplex and $self->{rop}->isComplex);
+ return if $self->checkComplex;
+ $self->Error("Exponential form is 'a*e^(bi)'")
+ if $self->{lop}{isPower} || $self->{rop}{isPower};
+ }
+ $self->Error("Your answer should be of the form %s",$self->theForm)
}
#
@@ -61,6 +73,17 @@
#
sub checkComplex {return 0}
+#
+# Get the form for use in error messages
+#
+sub theForm {
+ my $self = shift;
+ my $format = $self->{equation}{context}{flags}{complex_format};
+ return 'a+bi' if $format eq 'cartesian';
+ return 'a*e^(bi)' if $format eq 'polar';
+ return 'a+bi or a*e^(bi)';
+}
+
##############################################
#
# Now we get the individual replacements for the operators
@@ -130,7 +153,7 @@
my ($l,$r) = ($self->{lop},$self->{rop});
$self->{isPower} = 1;
return 1 if ($l->class eq 'Constant' && $l->{name} eq 'e' &&
- ($r->class eq 'Constant' || $r->{isMult} ||
+ ($r->class eq 'Constant' || $r->{isMult} || $r->{isOp} ||
$r->class eq 'Complex' && $r->{value}[0] == 0));
$self->Error("Exponentials can only be of the form 'e^(ai)' in this context");
}
@@ -147,20 +170,21 @@
my $self = shift;
my $super = ref($self); $super =~ s/LimitedComplex/Parser/;
&{$super."::_check"}($self);
- my $op = $self->{op};
- return if $op->isRealNumber;
- return if $self->{op}{isMult} || $self->{op}{isPower};
- return if $op->class eq 'Constant' && $op->{name} eq 'i';
- my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("Your answer should be of the form a+bi")
- if $self->{equation}{context}{flags}{complex_format} eq 'cartesian';
- $self->Error("Your answer should be of the form r*e^(ai)")
- if $self->{equation}{context}{flags}{complex_format} eq 'polar';
- $self->Error("Your answer should be of the form a+bi or r*e^(ai)");
+ my $op = $self->{op}; $self->{isOp} = 1;
+ if ($op->isRealNumber) {
+ return unless $self->{equation}{context}{flags}{strict_numeric};
+ return if $op->class eq 'Number';
+ } else {
+ return if $self->{op}{isMult} || $self->{op}{isPower};
+ return if $op->class eq 'Constant' && $op->{name} eq 'i';
+ }
+ $self->Error("Your answer should be of the form %s",$self->theForm)
}
sub checkComplex {return 0}
+sub theForm {LimitedComplex::BOP::theForm(@_)}
+
##############################################
package LimitedComplex::UOP::plus;
@@ -221,7 +245,7 @@
AbsoluteValue => {class => 'LimitedComplex::List::AbsoluteValue'},
);
$context{LimitedComplex}->operators->undefine('_','U');
-Parser::Context::Functions::Disable('Complex');
+$context{LimitedComplex}->functions->disable('Complex');
foreach my $fn ($context{LimitedComplex}->functions->names)
{$context{LimitedComplex}->{functions}{$fn}{nocomplex} = 1}
#
@@ -235,4 +259,16 @@
$context{'LimitedComplex-polar'} = $context{LimitedComplex}->copy;
$context{'LimitedComplex-polar'}->flags->set(complex_format => 'polar');
+$context{'LimitedComplex-cartesian-strict'} = $context{'LimitedComplex-cartesian'}->copy;
+$context{'LimitedComplex-cartesian-strict'}->flags->set(strict_numeric => 1);
+$context{'LimitedComplex-cartesian-strict'}->functions->disable('All');
+
+$context{'LimitedComplex-polar-strict'} = $context{'LimitedComplex-polar'}->copy;
+$context{'LimitedComplex-polar-strict'}->flags->set(strict_numeric => 1);
+$context{'LimitedComplex-polar-strict'}->functions->disable('All');
+
+$context{'LimitedComplex-strict'} = $context{'LimitedComplex'}->copy;
+$context{'LimitedComplex-strict'}->flags->set(strict_numeric => 1);
+$context{'LimitedComplex-strict'}->functions->disable('All');
+
Context("LimitedComplex");
|
|
From: dpvc v. a. <we...@ma...> - 2005-09-06 21:01:23
|
Log Message:
-----------
Movified the copying of functions from Complex1:: into main:: to avoid
conflicts with the PGcommonFunctions.pl versions (these errors were
trapped, but still show up in the error log unnecessarily).
Also commented out some code that was not doing anything other than
producing error messages in the error log. (It was left over from a
syntax check on the professor's answer, but the actual check was
removed, leaving a portion that tries to process the answer, but
usually fails (because things like "1+4i" need to be converted to
"1+4*i" before they can be used in PG_answer_eval, but that was not
being done).
Because of this, it is not possible currently to do cplx_cmp("1+4i"),
and instead you must to cplx_cmp(new Complex(1,4)).
To fix this, you would need to call check_syntax (and the other
filters that are called on the student's answer) before calling
PG_answer_eval. Of course, you should only do this when the
professor's answer isn't already a Complex object.
I am going to work on a Legacy module like the ones for num_cmp and
fun_cmp to replace cplx_cmp, which should avoid these problems and
make the changes suggested above unnecessary.
Modified Files:
--------------
pg/macros:
PGcommonFunctions.pl
PGcomplexmacros.pl
Revision Data
-------------
Index: PGcommonFunctions.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGcommonFunctions.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -Lmacros/PGcommonFunctions.pl -Lmacros/PGcommonFunctions.pl -u -r1.6 -r1.7
--- macros/PGcommonFunctions.pl
+++ macros/PGcommonFunctions.pl
@@ -27,6 +27,7 @@
return Parser::Function->call($fn,@_)
if Parser::Context->current->{functions}{$fn};
}
+ return &{$CommonFunction::function{$fn}}(@_) if $CommonFunction::function{$fn};
return $self->$fn(@_);
}
Index: PGcomplexmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGcomplexmacros.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -Lmacros/PGcomplexmacros.pl -Lmacros/PGcomplexmacros.pl -u -r1.9 -r1.10
--- macros/PGcomplexmacros.pl
+++ macros/PGcomplexmacros.pl
@@ -35,17 +35,20 @@
foreach my $f (@Complex1::EXPORT) {
# #PG_restricted_eval("\*$f = \*Complex1::$f"); # this is too clever --
# the original subroutines are destroyed
- next if $f eq 'sqrt'; #exporting the square root caused conflicts with the standard version
- # You can still use Complex1::sqrt to take square root of complex numbers
- next if $f eq 'log'; #exporting loq caused conflicts with the standard version
- # You can still use Complex1::log to take square root of complex numbers
-
- my $string = qq{
- sub main::$f {
- &Complex1::$f;
- }
- };
+# next if $f eq 'sqrt'; #exporting the square root caused conflicts with the standard version
+# # You can still use Complex1::sqrt to take square root of complex numbers
+# next if $f eq 'log'; #exporting loq caused conflicts with the standard version
+# # You can still use Complex1::log to take square root of complex numbers
+
+ next if $f eq 'i' || $f eq 'pi';
+ my $code = PG_restricted_eval("\\&CommonFunction::$f");
+ if (defined($code) && defined(&{$code})) {
+ $CommonFunction::function{$f} = "Complex1::$f"; # PGcommonMacros now takes care of this.
+ } else {
+ my $string = qq{sub main::$f {&Complex1::$f}};
PG_restricted_eval($string);
+ }
+
}
@@ -137,15 +140,28 @@
$correct_num_answer = math_constants($correct_num_answer);
my $PGanswerMessage = '';
-
- my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
-
- if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
- ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
- } else { # case of a string answer
- $PG_eval_errors = ' ';
- $correctVal = $correctAnswer;
- }
+
+#
+# The following lines don't have any effect (other than to take time and produce errors
+# in the error log). The $correctVal is replaced on the line following the comments,
+# and the error values are never used. It LOOKS like this was supposed to perform a
+# check on the professor's answer, but that is not occurring. (There used to be some
+# error checking, but that was removed in version 1.9 and it had been commented out
+# prior to that because it was always producing errors. This is because $correct_num_answer
+# usually is somethine like "1+4i", which will produce a "missing operation before 'i'"
+# error, and "1-i" wil produce an "amiguous use of '-i' resolved as '-&i'" message.
+# You probably need a call to check_syntax and the other filters that are used on
+# the student answer first. (Unless the item is already a reference to a Complex,
+# in which canse you should just accept it.)
+#
+# my ($inVal,$correctVal,$PG_eval_errors,$PG_full_error_report);
+ my $correctVal;
+# if (defined($correct_num_answer) && $correct_num_answer =~ /\S/ && $corrAnswerIsString == 0 ) {
+# ($correctVal, $PG_eval_errors,$PG_full_error_report) = PG_answer_eval($correct_num_answer);
+# } else { # case of a string answer
+# $PG_eval_errors = ' ';
+# $correctVal = $correctAnswer;
+# }
########################################################################
$correctVal = $correct_num_answer;
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-09-06 18:54:34
|
Log Message:
-----------
transparent (lower case t) is not valid with dvipng 1.2. I changed the note
and went back to Transparent in the default.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Constants.pm
Revision Data
-------------
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.30 -r1.31
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -84,10 +84,11 @@
# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgtransparent -D120 -q -depth";
# Note: In 1.6 and later, bgTransparent gives alpha-channel transparency while
# bgtransparent gives single-bit transparency. If you use alpha-channel transparency,
-# the images will not be viewable with MSIE. bgtransparent works for versions lower
-# than 1.6, but does not give transparent backgrounds.
+# the images will not be viewable with MSIE. bgtransparent works for version 1.5,
+# but does not give transparent backgrounds. It does not work for version 1.2. It has not
+# been tested with other versions.
#
-$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgtransparent -D120 -q -depth";
+$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
# If true, don't delete temporary files
#
|
|
From: Sam H. v. a. <we...@ma...> - 2005-09-06 14:18:08
|
Log Message:
-----------
uh, hasPermissions() is a method, so it actually gets 3 arguments. print
the arguments received as part of the error message. TESTED THIS TIME!
Modified Files:
--------------
webwork2/lib:
WeBWorK.pm
webwork2/lib/WeBWorK:
Authz.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK.pm,v
retrieving revision 1.74
retrieving revision 1.75
diff -Llib/WeBWorK.pm -Llib/WeBWorK.pm -u -r1.74 -r1.75
--- lib/WeBWorK.pm
+++ lib/WeBWorK.pm
@@ -234,7 +234,10 @@
debug("Now we deal with the effective user:\n");
my $eUserID = $r->param("effectiveUser") || $userID;
debug("userID=$userID eUserID=$eUserID\n");
- my $su_authorized = $authz->hasPermissions($userID, "become_student", $eUserID);
+ # FIXME: hasPermissions does nothing with $eUserID, and lately we want it to
+ # only accept two arguments, so we're removing $eUserID from this call.
+ #my $su_authorized = $authz->hasPermissions($userID, "become_student", $eUserID);
+ my $su_authorized = $authz->hasPermissions($userID, "become_student");
if ($su_authorized) {
debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n");
} else {
Index: Authz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Authz.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -Llib/WeBWorK/Authz.pm -Llib/WeBWorK/Authz.pm -u -r1.21 -r1.22
--- lib/WeBWorK/Authz.pm
+++ lib/WeBWorK/Authz.pm
@@ -143,7 +143,11 @@
# This currently only uses two of it's arguments, but it accepts any number, in
# case in the future calculating certain permissions requires more information.
sub hasPermissions {
- die "hasPermissions called with != 2 arguments" unless @_ == 2;
+ if (@_ != 3) {
+ shift @_; # get rid of self
+ my $nargs = @_;
+ die "hasPermissions called with $nargs arguments instead of the expected 2: '@_'"
+ }
my ($self, $userID, $activity) = @_;
my $r = $self->{r};
|
|
From: Sam H. v. a. <we...@ma...> - 2005-09-05 23:43:23
|
Log Message:
-----------
fix for security aspect of bug #715 -- reject calls with @_ != 2.
Modified Files:
--------------
webwork2/lib/WeBWorK:
Authz.pm
Revision Data
-------------
Index: Authz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Authz.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Llib/WeBWorK/Authz.pm -Llib/WeBWorK/Authz.pm -u -r1.20 -r1.21
--- lib/WeBWorK/Authz.pm
+++ lib/WeBWorK/Authz.pm
@@ -143,6 +143,8 @@
# This currently only uses two of it's arguments, but it accepts any number, in
# case in the future calculating certain permissions requires more information.
sub hasPermissions {
+ die "hasPermissions called with != 2 arguments" unless @_ == 2;
+
my ($self, $userID, $activity) = @_;
my $r = $self->{r};
my $ce = $r->ce;
|
|
From: dpvc v. a. <we...@ma...> - 2005-09-02 22:29:11
|
Log Message:
-----------
Fixed error in atan2 where second argument was not promoted to a Real.
Modified Files:
--------------
pg/lib/Value:
Real.pm
Revision Data
-------------
Index: Real.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Real.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -Llib/Value/Real.pm -Llib/Value/Real.pm -u -r1.18 -r1.19
--- lib/Value/Real.pm
+++ lib/Value/Real.pm
@@ -192,6 +192,8 @@
sub atan2 {
my ($l,$r,$flag) = @_;
+ if ($l->promotePrecedence($r)) {return $r->atan2($l,!$flag)}
+ $r = promote($r);
if ($flag) {my $tmp = $l; $l = $r; $r = $l}
return $pkg->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
}
|
|
From: jj v. a. <we...@ma...> - 2005-09-02 00:05:31
|
Log Message:
-----------
Fixed bug in use of advanced display panel which prevented it from displaying
problems. Default values like "All Textbooks" needed to be cleared so it
wouldn't be mistaken for actual textbook names.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
SetMaker.pm
Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.56
retrieving revision 1.57
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.56 -r1.57
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -887,10 +887,9 @@
my $library_basic = $r->param('library_is_basic') || 1;
## Fix some parameters
- clear_default($r,'library_subjects', ALL_SUBJECTS);
- clear_default($r,'library_chapters', ALL_CHAPTERS);
- clear_default($r,'library_sections', ALL_SECTIONS);
- clear_default($r,'library_textbook', ALL_TEXTBOOKS);
+ for my $key (keys(%{ LIB2_DATA() })) {
+ clear_default($r, LIB2_DATA->{$key}->{name}, LIB2_DATA->{$key}->{all} );
+ }
## These directories will have individual buttons
%problib = %{$ce->{courseFiles}{problibs}} if $ce->{courseFiles}{problibs};
|
|
From: dpvc v. a. <we...@ma...> - 2005-09-01 01:09:37
|
Log Message:
-----------
Implemented Mike's suggestion of combining a directory upward only
when the directory contains one pg file and the name of the file is
the same as the name of the directory containing it. I have removed
the condition that there need to be other (non-pg) files in the
directory, as the check takes time, and is no longer necessary.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
SetMaker.pm
Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.55
retrieving revision 1.56
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.55 -r1.56
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -41,7 +41,7 @@
use constant SELECT_SET_STRING => 'Select a Set from this Course';
use constant SELECT_LOCAL_STRING => 'Select a Problem Collection';
use constant MY_PROBLEMS => ' My Problems ';
-use constant MAIN_PROBLEMS => ' Main Problems ';
+use constant MAIN_PROBLEMS => ' Unclassified Problems ';
use constant CREATE_SET_BUTTON => 'Create New Set';
use constant ALL_CHAPTERS => 'All Chapters';
use constant ALL_SUBJECTS => 'All Subjects';
@@ -67,7 +67,7 @@
## for additional problib buttons
my %problib; ## filled in in global.conf
my %ignoredir = (
- '.' => 1, '..' => 1, 'Library' => 1,
+ '.' => 1, '..' => 1, 'Library' => 1, 'CVS' => 1,
'headers' => 1, 'macros' => 1, 'email' => 1,
);
@@ -80,25 +80,25 @@
## This is for searching the disk for directories containing pg files.
## to make the recursion work, this returns an array where the first
-## item is the number of pg files in the directory. The second is a
+## item is the number of pg files in the directory. The second is a
## list of directories which contain pg files.
##
-## If a directory contains only one pg file and at least one other
-## file, the directory is considered to be part of the parent
-## directory (it is probably in a separate directory only because
-## it has auxiliarly files that want to be kept together with the
-## pg file).
+## If a directory contains only one pg file and the directory name
+## is the same as the file name, then the directory is considered
+## to be part of the parent directory (it is probably in a separate
+## directory only because it has auxiliary files that want to be
+## kept together with the pg file).
##
## If a directory has a file named "=library-ignore", it is never
-## included in the directory menu. If a directory contains a file
+## included in the directory menu. If a directory contains a file
## called "=library-combine-up", then its pg are included with those
## in the parent directory (and the directory does not appear in the
-## menu). If it has a file called "=library-no-combine" then it is
+## menu). If it has a file called "=library-no-combine" then it is
## always listed as a separate directory even if it contains only one
## pg file.
sub get_library_sets {
- my $top = shift; my $dir = shift;
+ my $top = shift; my $dir = shift;
# ignore directories that give us an error
my @lis = eval { readDirectory($dir) };
if ($@) {
@@ -107,12 +107,12 @@
}
return (0) if grep /^=library-ignore$/, @lis;
- my @pgdirs;
-
- my $pgcount = scalar(grep { m/\.pg$/ and (not m/(Header|-text)\.pg$/) and -f "$dir/$_"} @lis);
- my $others = scalar(grep { (!m/\.pg$/ || m/(Header|-text)\.pg$/) &&
- !m/(\.(tmp|bak)|~)$/ && -f "$dir/$_" } @lis);
+ my @pgfiles = grep { m/\.pg$/ and (not m/(Header|-text)\.pg$/) and -f "$dir/$_"} @lis;
+ my $pgcount = scalar(@pgfiles);
+ my $pgname = $dir; $pgname =~ s!.*/!!; $pgname .= '.pg';
+ my $combineUp = ($pgcount == 1 && $pgname eq $pgfiles[0] && !(grep /^=library-no-combine$/, @lis));
+ my @pgdirs;
my @dirs = grep {!$ignoredir{$_} and -d "$dir/$_"} @lis;
if ($top == 1) {@dirs = grep {!$problib{$_}} @dirs}
foreach my $subdir (@dirs) {
@@ -120,13 +120,12 @@
$pgcount += shift @results; push(@pgdirs,@results);
}
- return ($pgcount, @pgdirs) if $top || $pgcount == 0 || grep /^=library-combine-up$/, @lis;
- return (0,@pgdirs,$dir) if $pgcount > 1 || $others == 0 || grep /^=library-no-combine$/, @lis;
- return ($pgcount, @pgdirs);
+ return ($pgcount, @pgdirs) if $top || $combineUp || grep /^=library-combine-up$/, @lis;
+ return (0,@pgdirs,$dir);
}
sub get_library_pgs {
- my $top = shift; my $base = shift; my $dir = shift;
+ my $top = shift; my $base = shift; my $dir = shift;
my @lis = readDirectory("$base/$dir");
return () if grep /^=library-ignore$/, @lis;
return () if !$top && grep /^=library-no-combine$/, @lis;
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-08-30 16:35:19
|
Log Message:
-----------
Change arguments passed to dvipng
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Constants.pm
Revision Data
-------------
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.29 -r1.30
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -75,12 +75,19 @@
# Arguments to pass to dvipng. This is dependant on the version of dvipng.
#
-# For dvipng < 1.0
+# For dvipng versions 0.x
# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-x4000.5 -bgTransparent -Q6 -mode toshiba -D180";
-# For dvipng >= 1.0
+# For dvipng versions 1.0 to 1.5
# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
#
-$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
+# For dvipng versions 1.6 (and probably above)
+# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgtransparent -D120 -q -depth";
+# Note: In 1.6 and later, bgTransparent gives alpha-channel transparency while
+# bgtransparent gives single-bit transparency. If you use alpha-channel transparency,
+# the images will not be viewable with MSIE. bgtransparent works for versions lower
+# than 1.6, but does not give transparent backgrounds.
+#
+$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgtransparent -D120 -q -depth";
# If true, don't delete temporary files
#
|
|
From: Sam H. v. a. <we...@ma...> - 2005-08-30 13:10:53
|
Log Message:
-----------
fixed error message when answer log does not exist
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ShowAnswers.pm
Revision Data
-------------
Index: ShowAnswers.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm -Llib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm -u -r1.14 -r1.15
--- lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ShowAnswers.pm
@@ -98,24 +98,29 @@
my $pattern = "^[[^]]*]|$studentUser\\|$setName\\|$problemNumber\\|";
- if (open(LOG,"$answer_log")) {
- my $line;
- $self->{lastdate} = '';
- $self->{lasttime} = 0;
- $self->{lastID} = '';
- $self->{lastn} = 0;
-
- my @lines = grep(/$pattern/,<LOG>); close(LOG);
- chomp(@lines);
- foreach $line (@lines) {$line = substr($line,27)}; # remove datestamp
-
- print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"});
- print "No entries for $studentUser set $setName, problem $problemNumber" unless @lines;
- foreach $line (sort byData @lines) {$self->tableRow(split("\t",$line,-1))}
- print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))) if ($self->{lastn});
- print CGI::end_table();
+ if (-e $answer_log) {
+ if (open my $log, $answer_log) {
+ my $line;
+ $self->{lastdate} = '';
+ $self->{lasttime} = 0;
+ $self->{lastID} = '';
+ $self->{lastn} = 0;
+
+ my @lines = grep(/$pattern/,<LOG>); close(LOG);
+ chomp(@lines);
+ foreach $line (@lines) {$line = substr($line,27)}; # remove datestamp
+
+ print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3,align=>"center"});
+ print "No entries for $studentUser set $setName, problem $problemNumber" unless @lines;
+ foreach $line (sort byData @lines) {$self->tableRow(split("\t",$line,-1))}
+ print CGI::Tr(CGI::td({colspan=>$self->{lastn}},CGI::hr({size=>3}))) if ($self->{lastn});
+ print CGI::end_table();
+ } else {
+ $self->addbadmessage("Failed to open the answer log '$answer_log': $!");
+ }
} else {
- print "<B>Can't open the access log $answer_log</B>";
+ # no answer log exists yet -- this is probably not an error
+ print "No answers have been logged. (Answer log '$answer_log' does not exist.)";
}
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-30 12:20:38
|
Log Message:
-----------
The perl method for UOP and BOP now put spaces around the operator, to
prevent Perl from thinking that things like -e is a file test and
*Parser::Function->call is a name reference. (Some of these had been
done by hand earlier, but now the base BOP and UOP classes handle it,
so we should not have problems in the future). I removed the ad hoc
fixes from several other locations (Parser/Function.pm,
Parser/Context/Default.pm).
Also extended the operator definitions to allow operators to create
function-call syntax in perl mode (for when the operator doesn't
correspond to a perl operator).
Modified Files:
--------------
pg/lib/Parser:
BOP.pm
Function.pm
UOP.pm
pg/lib/Parser/Context:
Default.pm
pg/lib/Parser/UOP:
factorial.pm
Revision Data
-------------
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.14 -r1.15
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -320,12 +320,17 @@
#
sub perl {
my $self= shift; my $parens = shift;
- my $bop = $self->{def};
- my ($lparen,$rparen); if (!$bop->{isCommand}) {$lparen = 1; $rparen = 2}
- my $perl =
- $self->{lop}->perl($lparen).
- (defined($bop->{perl}) ? $bop->{perl} : $bop->{string}).
- $self->{rop}->perl($rparen);
+ my $bop = $self->{def}; my $perl;
+ if ($bop->{isCommand}) {
+ $perl =
+ ($bop->{perl} || ref($self).'->call').
+ '('.$self->{lop}->perl.','.$self->{rop}->perl.')';
+ } else {
+ $perl =
+ $self->{lop}->perl(1).
+ " ".($bop->{perl} || $bop->{string})." ".
+ $self->{rop}->perl(2);
+ }
$perl = '('.$perl.')' if $parens;
return $perl;
}
Index: Function.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Parser/Function.pm -Llib/Parser/Function.pm -u -r1.16 -r1.17
--- lib/Parser/Function.pm
+++ lib/Parser/Function.pm
@@ -284,7 +284,7 @@
my $fn = $self->{def}; my @p = (); my $perl;
foreach my $x (@{$self->{params}}) {push(@p,$x->perl)}
if ($fn->{perl}) {$perl = $fn->{perl}.'('.join(',',@p).')'}
- else {return('(Parser::Function->call('.join(',',"'$self->{name}'",@p).'))')}
+ else {$perl = 'Parser::Function->call('.join(',',"'$self->{name}'",@p).')'}
$perl = '('.$perl.')' if $parens == 1;
return $perl;
}
Index: UOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/UOP.pm -Llib/Parser/UOP.pm -u -r1.14 -r1.15
--- lib/Parser/UOP.pm
+++ lib/Parser/UOP.pm
@@ -214,8 +214,12 @@
#
sub perl {
my $self = shift; my $parens = shift;
- my $uop = $self->{def};
- my $perl = (defined($uop->{perl})? $uop->{perl}: $uop->{string}).$self->{op}->perl(1);
+ my $uop = $self->{def}; my $perl;
+ if ($uop->{isCommand}) {
+ $perl = ($uop->{perl} || ref($self).'->call').'('.$self->{op}->perl.')';
+ } else {
+ $perl = ($uop->{perl} || $uop->{string})." ".$self->{op}->perl(1);
+ }
$perl = '('.$perl.')' if $parens;
return $perl;
}
Index: Default.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Default.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -Llib/Parser/Context/Default.pm -Llib/Parser/Context/Default.pm -u -r1.31 -r1.32
--- lib/Parser/Context/Default.pm
+++ lib/Parser/Context/Default.pm
@@ -15,13 +15,13 @@
class => 'Parser::BOP::add'},
'-' => {precedence => 1, associativity => 'left', type => 'both', string => '-',
- perl => '- ', class => 'Parser::BOP::subtract', rightparens => 'same'},
+ class => 'Parser::BOP::subtract', rightparens => 'same'},
'U' => {precedence => 1.5, associativity => 'left', type => 'bin', isUnion => 1,
string => ' U ', TeX => '\cup ', class => 'Parser::BOP::union'},
'><'=> {precedence => 2, associativity => 'left', type => 'bin',
- string => ' >< ', TeX => '\times ', perl => ' x ', fullparens => 1,
+ string => ' >< ', TeX => '\times ', perl => 'x', fullparens => 1,
class => 'Parser::BOP::cross'},
'.' => {precedence => 2, associativity => 'left', type => 'bin',
@@ -57,7 +57,7 @@
'u+'=> {precedence => 6, associativity => 'left', type => 'unary', string => '+',
class => 'Parser::UOP::plus', hidden => 1, allowInfinite => 1, nofractionparens => 1},
- 'u-'=> {precedence => 6, associativity => 'left', type => 'unary', string => '-', perl => '- ',
+ 'u-'=> {precedence => 6, associativity => 'left', type => 'unary', string => '-',
class => 'Parser::UOP::minus', hidden => 1, allowInfinite => 1, nofractionparens => 1},
'^' => {precedence => 7, associativity => 'right', type => 'bin', string => '^', perl => '**',
@@ -67,7 +67,7 @@
class => 'Parser::BOP::power', leftf => 1, fullparens => 1, isInverse => 1},
'!' => {precedence => 8, associativity => 'right', type => 'unary', string => '!',
- class => 'Parser::UOP::factorial', perl => 'Factorial'},
+ class => 'Parser::UOP::factorial', isCommand => 1},
'_' => {precedence => 9, associativity => 'left', type => 'bin', string => '_',
class => 'Parser::BOP::underscore', leftparens => 'all'},
Index: factorial.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP/factorial.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/UOP/factorial.pm -Llib/Parser/UOP/factorial.pm -u -r1.4 -r1.5
--- lib/Parser/UOP/factorial.pm
+++ lib/Parser/UOP/factorial.pm
@@ -27,14 +27,6 @@
return $f;
}
-#
-# Perl version uses Factorial()
-#
-sub perl {
- my $self = shift;
- return 'Factorial('.$self->{op}->perl.')';
-}
-
#########################################################################
#
|
|
From: jj v. a. <we...@ma...> - 2005-08-30 05:48:57
|
Log Message:
-----------
Fixes bug in add where blank values were being turned into 0 by mysql for columns of type integer. The analogous change was previously made to put. This bug showed up when renumbering problems in ProblemSetDetail (e.g., renumbering) when a set was already assigned to users.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/DB/Schema:
SQL.pm
Revision Data
-------------
Index: SQL.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/DB/Schema/SQL.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -Llib/WeBWorK/DB/Schema/SQL.pm -Llib/WeBWorK/DB/Schema/SQL.pm -u -r1.28 -r1.29
--- lib/WeBWorK/DB/Schema/SQL.pm
+++ lib/WeBWorK/DB/Schema/SQL.pm
@@ -177,6 +177,7 @@
my @realFieldnames = $self->{record}->FIELDS();
my @fieldvalues = map { $Record->$_() } @realFieldnames;
+ @fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues;
my $stmt = "INSERT INTO `$sqlTable` ($fieldnames) VALUES ($marks)";
$self->debug("SQL-add: $stmt\n");
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-30 00:43:49
|
Log Message:
-----------
Added the ability to put class-specific answer-checker defaults into
the Context object. For example,
Context("Vector")->{cmpDefaults}{Vector}{promotePoints} = 1;
would make all Vector answer checkers include promotePoints=>1
automatically. (Note however that if a subclass of Vector is used, it
will not get this defaults, since its class name would be different.
Perhaps something more sophisticated will be needed in the future.)
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.60
retrieving revision 1.61
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.60 -r1.61
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -14,6 +14,12 @@
package Value;
#
+# Context can add default values to the answer checkers by class;
+#
+$Value::defaultContext->{cmpDefaults} = {};
+
+
+#
# Create an answer checker for the given type of object
#
@@ -30,16 +36,17 @@
my $ans = new AnswerEvaluator;
my $correct = protectHTML($self->{correct_ans});
$correct = $self->correct_ans unless defined($correct);
+ $self->{context} = $$Value::context unless defined($self->{context});
$ans->ans_hash(
type => "Value (".$self->class.")",
correct_ans => $correct,
correct_value => $self,
$self->cmp_defaults(@_),
+ %{$self->{context}{cmpDefaults}{$self->class} || {}}, # context-specified defaults
@_
);
$ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
$ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
- $self->{context} = $$Value::context unless defined($self->{context});
return $ans;
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-30 00:40:36
|
Log Message:
-----------
Added a parserCustomization.pl file that is loaded whenever the
Parser.pl file is. This can be used on a course-by-course basis to
customize features of the Parser. Some examples are listed in the
file.
You need to be VERY careful when doing this, as this will affect ALL
problems that use the Parser. Your changes may cause some .pg files
to fail if they rely on the default behavior that you are changing.
If you wish to override settings in one of the predefined contexts
(like "Vector"), then define $context{Vector} as a copy of
$Parser::Context::Default::context{Vector}, as in the commented out
examples. Then Context("Vector") will use your copy rather than the
original. If you were to change the version in
Parser::Context::Default, that would change the parser for ALL
courses, not just yours.
Modified Files:
--------------
pg/macros:
Parser.pl
Added Files:
-----------
pg/macros:
parserCustomization.pl
Revision Data
-------------
Index: Parser.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/Parser.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -Lmacros/Parser.pl -Lmacros/Parser.pl -u -r1.5 -r1.6
--- macros/Parser.pl
+++ macros/Parser.pl
@@ -157,6 +157,8 @@
sub _Parser_init {}; # don't let loadMacros load it again
+loadMacros("parserCustomization.pl");
+
###########################################################################
1;
--- /dev/null
+++ macros/parserCustomization.pl
@@ -0,0 +1,30 @@
+sub _parserCustomization_init {}
+
+#
+# Copy this file to your course templates directory and put any
+# customization for the Parser that you want for your course
+# here. For example, you can make vectors display using
+# ijk notation (and force students to use it for entering
+# vectors) by uncommenting:
+#
+# $context{Vector} = $Parser::Context::Default::context{Vector}->copy;
+# $context{Vector}->flags->set(ijk=>1);
+# $context{Vector}->parens->remove('<');
+#
+# To allow vectors to be entered with parens (and displayed with
+# parens) rather than angle-brakets, uncomment
+#
+# $context{Vector} = $Parser::Context::Default::context{Vector}->copy;
+# $context{Vector}->{cmpDefaults}{Vector} = {promotePoints => 1};
+# $context{Vector}->lists->set(Vector=>{open=>'(', close=>')'});
+#
+# (This actually just turns points into vectors in the answer checker
+# for vectors, and displays vectors using parens rather than angle
+# brakets. The student is really still entering what the Parser
+# thinks is a point, but since points get promoted automatically
+# in the Value package, that should work. But if a problem checks
+# if a student's value is actually a Vector, that will not be true.)
+#
+
+
+1;
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-30 00:36:00
|
Log Message:
-----------
Added a Point context that is a copy of the Vector context. This will
allow users to override some settings in Vector context (namely, how
they are entered and displayed) without preventing users from being
able to enter points (in Point context).
Modified Files:
--------------
pg/lib/Parser/Context:
Default.pm
Revision Data
-------------
Index: Default.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Default.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -Llib/Parser/Context/Default.pm -Llib/Parser/Context/Default.pm -u -r1.30 -r1.31
--- lib/Parser/Context/Default.pm
+++ lib/Parser/Context/Default.pm
@@ -205,7 +205,7 @@
#
use vars qw(%context);
-use vars qw($fullContext $numericContext $complexContext
+use vars qw($fullContext $numericContext $complexContext $pointContext
$vectorContext $matrixContext $intervalContext);
#
@@ -281,6 +281,11 @@
$vectorContext->constants->set(i=>{TeX=>'\boldsymbol{i}', perl=>'i'});
#
+# Point context (for symmetry)
+#
+$pointContext = $vectorContext->copy;
+
+#
# Matrix context (square brackets make matrices in preference to points or intervals)
#
$matrixContext = $vectorContext->copy;
@@ -310,6 +315,7 @@
Full => $fullContext,
Numeric => $numericContext,
Complex => $complexContext,
+ Point => $pointContext,
Vector => $vectorContext,
Matrix => $matrixContext,
Interval => $intervalContext,
|
|
From: Mike G. v. a. <we...@ma...> - 2005-08-29 22:57:10
|
Log Message:
-----------
Removed unused variable.
Fixed an incorrect error message.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator:
Hardcopy.pm
Revision Data
-------------
Index: Hardcopy.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Hardcopy.pm,v
retrieving revision 1.58
retrieving revision 1.59
diff -Llib/WeBWorK/ContentGenerator/Hardcopy.pm -Llib/WeBWorK/ContentGenerator/Hardcopy.pm -u -r1.58 -r1.59
--- lib/WeBWorK/ContentGenerator/Hardcopy.pm
+++ lib/WeBWorK/ContentGenerator/Hardcopy.pm
@@ -517,7 +517,7 @@
my $r = $self->r;
my $ce = $r->ce;
- my $finalFile = "$tempDir/$fileName";
+ #my $finalFile = "$tempDir/$fileName";
# Location for hardcopy file to be downloaded
# FIXME this should use surePathToTmpFile
@@ -607,7 +607,7 @@
}
- -e $hardcopyFilePath or die "Failed to create $finalFile for no apparent reason.\n";
+ -e $hardcopyFilePath or die "Failed to create $hardcopyFilePath for no apparent reason.\n";
# return hardcopyFilePath;
return $hardcopyFileURL;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-08-29 22:55:04
|
Log Message:
-----------
Corrected a mistake in a debugging message.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
Stats.pm
Revision Data
-------------
Index: Stats.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm,v
retrieving revision 1.56
retrieving revision 1.57
diff -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -u -r1.56 -r1.57
--- lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
@@ -302,7 +302,7 @@
my $max_num_problems = 0;
# get user records
- debug("Begin obtaining problem records for user $student set $setName");
+ debug("Begin obtaining problem records for set $setName");
my @userRecords = $db->getUsers(@studentList);
debug("End obtaining user records for set $setName");
debug("begin main loop");
|
|
From: jj v. a. <we...@ma...> - 2005-08-28 23:08:29
|
Log Message:
-----------
Fixed a bug where a set named "0" would not be sticky in the Target Set
list (because it looked kind of like an empty/undefined name).
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
SetMaker.pm
Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.54
retrieving revision 1.55
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.54 -r1.55
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -725,7 +725,8 @@
if($have_local_sets ==0) {
$list_of_local_sets = [NO_LOCAL_SET_STRING];
- } elsif (not $set_selected or $set_selected eq SELECT_SET_STRING) {
+ } elsif (not defined($set_selected) or $set_selected eq ""
+ or $set_selected eq SELECT_SET_STRING) {
unshift @{$list_of_local_sets}, SELECT_SET_STRING;
$set_selected = SELECT_SET_STRING;
}
|
|
From: jj v. a. <we...@ma...> - 2005-08-28 20:54:03
|
Log Message:
-----------
Allow use of an activity log which logs every click, stored on a
per-course basis. It is turned off by default. It can be turned
on/off for individual courses. The three pieces here:
global.conf.dist: adds a place to define the log file. Here an
empty value signals to not do this logging.
ContentGenerator.pm: check to see if the log file is defined (and
(non-trivial), and if so, write a log entry. We check if it is
defined at this point to both save some time, and because if we
get to writeCourseLog and the log isn't defined, we get a pink
screen.
The bulk of the text of the log entry is performed by a new method
prepare_activity_entry. By default, this gives the url, and a list
of all the cgi parameters (except for key and passwd). This method
can be overridden by individual modules. The default format may
change. It may take some fine tuning to see what is best.
Also, this is one of the first functions called by go. We may want
it to go after the action has taken place if we want instructor
modules to be able to report results of their work through this log.
SetMaker.pm: gives an example of overriding prepare_activity_entry.
SetMaker has lots (and lots and lots) of data stored in cgi
parameters. We probably don't want to log that. We might want to
log a little more in SetMaker than we do here (target set), but
this gives a start.
Modified Files:
--------------
webwork-modperl/conf:
global.conf.dist
webwork-modperl/lib/WeBWorK:
ContentGenerator.pm
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
SetMaker.pm
Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/conf/global.conf.dist,v
retrieving revision 1.133
retrieving revision 1.134
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.133 -r1.134
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -411,6 +411,12 @@
# Log logins.
$courseFiles{logs}{login_log} = "$courseDirs{logs}/login.log";
+# Log for almost every click. By default it is the empty string, which
+# turns this log off. If you want it turned on, we suggest
+# "$courseDirs{logs}/activity.log"
+# When turned on, this log can get quite large.
+$courseFiles{logs}{activity_log} = '';
+
################################################################################
# Site defaults (FIXME: what other things could be "site defaults"?)
################################################################################
Index: ContentGenerator.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v
retrieving revision 1.147
retrieving revision 1.148
diff -Llib/WeBWorK/ContentGenerator.pm -Llib/WeBWorK/ContentGenerator.pm -u -r1.147 -r1.148
--- lib/WeBWorK/ContentGenerator.pm
+++ lib/WeBWorK/ContentGenerator.pm
@@ -144,6 +144,14 @@
my $returnValue = OK;
+ # We only write to the activity log if it has been defined and if
+ # we are in a specific course. The latter check is to prevent attempts
+ # to write to a course log file when viewing the top-level list of
+ # courses page.
+ WeBWorK::Utils::writeCourseLog($ce, 'activity_log',
+ $self->prepare_activity_entry) if ( $r->urlpath->arg("courseID") and
+ $r->ce->{courseFiles}->{logs}->{activity_log});
+
$self->pre_header_initialize(@_) if $self->can("pre_header_initialize");
# send a file instead of a normal reply (reply_with_file() sets this field)
@@ -329,6 +337,23 @@
$self->addmessage(CGI::div({class=>"ResultsWithError"}, $message));
}
+=item prepare_activity_entry()
+
+Prepare a string to be sent to the activity log, if it is turned on.
+This can be overriden by different modules.
+
+=cut
+
+
+sub prepare_activity_entry {
+ my $self = shift;
+ my $r = $self->r;
+ my $string = $r->urlpath->path . " ---> ".
+ join("\t", (map { $_ eq 'key' || $_ eq 'passwd' ? '' : $_ ." => " . $r->param($_) } $r->param()));
+ $string =~ s/\t+/\t/g;
+ return($string);
+}
+
=back
=cut
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.53 -r1.54
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -71,6 +71,13 @@
'headers' => 1, 'macros' => 1, 'email' => 1,
);
+sub prepare_activity_entry {
+ my $self=shift;
+ my $r = $self->r;
+ my $user = $self->r->param('user') || 'NO_USER';
+ return("In SetMaker as user $user");
+}
+
## This is for searching the disk for directories containing pg files.
## to make the recursion work, this returns an array where the first
## item is the number of pg files in the directory. The second is a
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-08-27 21:33:43
|
Log Message:
-----------
comment out hack for peekaboo bug
Modified Files:
--------------
webwork-modperl/htdocs/css:
ur.css
Revision Data
-------------
Index: ur.css
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/htdocs/css/ur.css,v
retrieving revision 1.8
retrieving revision 1.9
diff -Lhtdocs/css/ur.css -Lhtdocs/css/ur.css -u -r1.8 -r1.9
--- htdocs/css/ur.css
+++ htdocs/css/ur.css
@@ -1,5 +1,6 @@
/* hack to get around MSIE peekaboo bug */
-* {zoom: 1;}
+/* this hack causes other problems and may no longer be needed for the peekaboo bug so we will comment it out */
+/* * {zoom: 1;} */
/********************/
/* template classes */
|
|
From: Sam H. v. a. <we...@ma...> - 2005-08-26 18:02:34
|
Log Message:
-----------
replaced $externalPrograms{netpbm} with lexical $netpbm_prefix. this
will prevent netpbm from going into the cource environment (where is it
not needed) and makes it clear that it is a prefix and not the path to a
program.
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.132
retrieving revision 1.133
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.132 -r1.133
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -61,12 +61,12 @@
# Basic image manipulation utilities
# Most sites only need to configure the first line
-$externalPrograms{netpbm} = "/usr/bin/"; # Really a prefix, rather than a program
-$externalPrograms{giftopnm} = $externalPrograms{netpbm}.'giftopnm';
-$externalPrograms{ppmtopgm} = $externalPrograms{netpbm}.'ppmtopgm';
-$externalPrograms{pnmtops} = $externalPrograms{netpbm}.'pnmtops';
-$externalPrograms{pnmtopng} = $externalPrograms{netpbm}.'pnmtopng';
-$externalPrograms{pngtopnm} = $externalPrograms{netpbm}.'pngtopnm';
+my $netpbm_prefix = "/usr/bin";
+$externalPrograms{giftopnm} = "$netpbm_prefix/giftopnm";
+$externalPrograms{ppmtopgm} = "$netpbm_prefix/ppmtopgm";
+$externalPrograms{pnmtops} = "$netpbm_prefix/pnmtops";
+$externalPrograms{pnmtopng} = "$netpbm_prefix/pnmtopng";
+$externalPrograms{pngtopnm} = "$netpbm_prefix/pngtopnm";
# The following lines are the external scripts gif2eps, etc.
# The source file is input with cat, and the output is redirected to
|
2 messages has been excluded from this view by a project administrator.
