Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-20 18:13:14
|
Log Message:
-----------
Changes to the reports of a problem status. This closes bug #631. It
also reports blank errors differently from incorrect answers to support
sequential problem graders. Finally it adds a "state_summary_msg" field
to the problem state which can be used to completely replace the
report on the current problem state usually printed at the bottom of a
problem page.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator:
Problem.pm
Revision Data
-------------
Index: Problem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v
retrieving revision 1.176
retrieving revision 1.177
diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGenerator/Problem.pm -u -r1.176 -r1.177
--- lib/WeBWorK/ContentGenerator/Problem.pm
+++ lib/WeBWorK/ContentGenerator/Problem.pm
@@ -224,6 +224,7 @@
my $fully = '';
my @tableRows = ( $header );
my $numCorrect = 0;
+ my $numBlanks =0;
my $tthPreambleCache;
foreach my $name (@answerNames) {
my $answerResult = $pg->{answers}->{$name};
@@ -236,6 +237,7 @@
my $answerMessage = $showMessages ? $answerResult->{ans_message} : "";
$answerMessage =~ s/\n/<BR>/g;
$numCorrect += $answerScore >= 1;
+ $numBlanks++ unless $studentAnswer =~/\S/; # unless student answer contains entry
my $resultString = $answerScore >= 1 ? "correct" :
$answerScore > 0 ? int($answerScore*100)."% correct" :
"incorrect";
@@ -264,20 +266,28 @@
# my $summary = "On this attempt, you answered $numCorrect out of "
# . scalar @answerNames . " $numIncorrectNoun correct, for a score of $scorePercent.";
my $summary = "";
- if (scalar @answerNames == 1) {
- if ($numCorrect == scalar @answerNames) {
- $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
- } else {
- $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT ${fully}correct.");
- }
+ unless (defined($problemResult->{summary}) and $problemResult->{summary} =~ /\S/) {
+ if (scalar @answerNames == 1) { #default messages
+ if ($numCorrect == scalar @answerNames) {
+ $summary .= CGI::div({class=>"ResultsWithoutError"},"The above answer is correct.");
+ } else {
+ $summary .= CGI::div({class=>"ResultsWithError"},"The above answer is NOT ${fully}correct.");
+ }
+ } else {
+ if ($numCorrect == scalar @answerNames) {
+ $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
+ }
+ unless ($numCorrect + $numBlanks == scalar( @answerNames)) {
+ $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT ${fully}correct.");
+ }
+ if ($numBlanks) {
+ my $s = ($numBlanks>1)?'':'s';
+ $summary .= CGI::div({class=>"ResultsAlert"},"$numBlanks of the questions remain$s unanswered.");
+ }
+ }
} else {
- if ($numCorrect == scalar @answerNames) {
- $summary .= CGI::div({class=>"ResultsWithoutError"},"All of the above answers are correct.");
- } else {
- $summary .= CGI::div({class=>"ResultsWithError"},"At least one of the above answers is NOT ${fully}correct.");
- }
+ $summary = $problemResult->{summary}; # summary has been defined by grader
}
-
return
CGI::table({-class=>"attemptResults"}, CGI::Tr(\@tableRows))
. ($showSummary ? CGI::p({class=>'emphasis'},$summary) : "");
@@ -1051,16 +1061,20 @@
# $setClosedMessage .= " Additional attempts will not be recorded.";
# }
#}
-
- my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)";
- print CGI::p(
- $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
- "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
- $problem->attempted
- ? "Your recorded score is $lastScore. $notCountedMessage" . CGI::br()
- : "",
- $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
- );
+ unless (defined( $pg->{state}->{state_summary_msg}) and $pg->{state}->{state_summary_msg}=~/\S/) {
+ my $notCountedMessage = ($problem->value) ? "" : "(This problem will not count towards your grade.)";
+ print CGI::p(
+ $submitAnswers ? $scoreRecordedMessage . CGI::br() : "",
+ "You have attempted this problem $attempts $attemptsNoun.", CGI::br(),
+ $submitAnswers ?"You received a score of ".sprintf("%.0f%%", $pg->{result}->{score} * 100)." for this attempt.".CGI::br():'',
+ $problem->attempted
+ ? "Your overall recorded score is $lastScore. $notCountedMessage" . CGI::br()
+ : "",
+ $setClosed ? $setClosedMessage : "You have $attemptsLeft $attemptsLeftNoun remaining."
+ );
+ }else {
+ print CGI::p($pg->{state}->{state_summary_msg});
+ }
print CGI::end_div();
# save state for viewOptions
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-20 18:10:52
|
Log Message:
-----------
Added a ResultsAlert style ot ResultsWithError and ResultsWithoutError.
I am using it to color yellow a message alerting a student to the
existence of unanswered questions within a problem.
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.3
retrieving revision 1.4
diff -Lhtdocs/css/ur.css -Lhtdocs/css/ur.css -u -r1.3 -r1.4
--- htdocs/css/ur.css
+++ htdocs/css/ur.css
@@ -51,6 +51,7 @@
/* background colors for success and failure messages */
div.ResultsWithoutError { background-color: #66ff99 } /* light green */
div.ResultsWithError { background-color: #ffcccc } /* light red */
+div.ResultsAlert { background-color: yellow } /* yellow */
div.NoFontMessage {padding: 10; border-style: solid; border-width:3;
border-color: #DD0000; background-color: #FFF8F8;
|
|
From: Sam H. v. a. <we...@ma...> - 2005-07-19 17:21:09
|
Log Message:
-----------
changed default paths from /usr/local to /usr as per old email:
On Aug 24, 2004, at 11:23 AM, Arnold Pizer wrote:
> In the tarball for WW 1.9 I reset all paths to /usr/bin/ (rather than
> /usr/local/bin which FreeBSD or at least Hoss uses). That way things
> work out of the box for most linux systems (all that I have played
> with). I think it would be a good thing to do with future releases on
> WW 2.
Sounds good to me.
-sam
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.123
retrieving revision 1.124
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.123 -r1.124
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -50,12 +50,12 @@
$externalPrograms{mkdir} = "/bin/mkdir";
$externalPrograms{mv} = "/bin/mv";
-$externalPrograms{mysql} = "/usr/local/bin/mysql";
+$externalPrograms{mysql} = "/usr/bin/mysql";
-$externalPrograms{latex} = "/usr/local/bin/latex";
-$externalPrograms{pdflatex} = "/usr/local/bin/pdflatex --shell-escape"; # allows pdflatex to handle .eps files
-$externalPrograms{dvipng} = "/usr/local/bin/dvipng";
-$externalPrograms{tth} = "/usr/local/bin/tth";
+$externalPrograms{latex} = "/usr/bin/latex";
+$externalPrograms{pdflatex} = "/usr/bin/pdflatex --shell-escape"; # allows pdflatex to handle .eps files
+$externalPrograms{dvipng} = "/usr/bin/dvipng";
+$externalPrograms{tth} = "/usr/bin/tth";
$externalPrograms{tar} = "/usr/bin/tar";
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-07-18 23:08:44
|
Log Message:
-----------
Add command-line utility to update sql and sql_single databases to includ=
e
gateway fields. Use: wwdb_addgw [-h] [sql|sql_single]
Adds fields to the set and set_user tables in the WeBWorK mysql databases=
=20
that are required for the gateway module. The script prompts for which=20
courses to modify. Adding gateway database fields to existing courses=20
should have no effect on those courses, even if they are running under a
non-gateway aware version of the WeBWorK system. (I haven't rigorously
tested this.)
If -h is supplied, the script hides the mysql password when it prompts fo=
r
it (this assumes that a Unix based stty -echo works). If sql or sql_sing=
le
are supplied, they become the default database format.
Note that this has been tested, but not rigorously. Please let me know
if you find that it does not perform as advertised. It might be wise to=20
back up the database tables before using, and to check that it does what
we expect (that is, adds columns to the set and set_user tables) after=20
running it.
Added Files:
-----------
webwork2/bin:
wwdb_addgw
Revision Data
-------------
--- /dev/null
+++ bin/wwdb_addgw
@@ -0,0 +1,391 @@
+#!/usr/bin/perl -w
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader: webwork2/bin/wwdb_addgw,v 1.1 2005/07/18 23:10:35 glarose =
Exp $
+#=20
+# This program is free software; you can redistribute it and/or modify i=
t under
+# the terms of either: (a) the GNU General Public License as published b=
y the
+# Free Software Foundation; either version 2, or (at your option) any la=
ter
+# version, or (b) the "Artistic License" which comes with this package.
+#=20
+# This program is distributed in the hope that it will be useful, but WI=
THOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License o=
r the
+# Artistic License for more details.
+########################################################################=
########
+#=20
+# wwdb_addgw
+# update webwork database tables to add fields for the gateway module
+#
+# by Gavin LaRose <gl...@um...>
+#
+=3Dhead1 NAME
+
+wwdb_addgw - convert SQL databases for WeBWorK 2 to add gateway fields.
+
+=3Dhead1 SYNOPSIS
+
+ wwdb_addgw [-h] [sql|sql_single]
+
+=3Dhead1 DESCRIPTION
+
+Adds fields to the set and set_user tables in the WeBWorK mysql database=
s=20
+that are required for the gateway module. The script prompts for which=20
+courses to modify. Adding gateway database fields to existing courses=20
+should have no effect on those courses, even if they are running under a
+non-gateway aware version of the WeBWorK system.
+
+If C<-h> is provided, the script hides the mysql admin password.
+
+C<sql> or C<sql_single> gives the default WeBWorK database format. If=20
+omitted, the script assumes sql_single and prompts to be sure.
+
+=3Dcut
+
+use strict;
+use DBI;
+
+# this is necessary on some systems
+system("stty erase =08");
+
+my $source =3D 'DBI:mysql';
+
+# fields to add to the set and set_user tables
+my %addFields =3D ( 'assignment_type' =3D> 'text',
+ 'attempts_per_version' =3D> 'integer',
+ 'time_interval' =3D> 'integer',
+ 'versions_per_interval' =3D> 'integer',
+ 'version_time_limit' =3D> 'integer',
+ 'version_creation_time' =3D> 'bigint',
+ 'problem_randorder' =3D> 'integer',
+ 'version_last_attempt_time' =3D> 'bigint', );
+
+# process input data
+my $hidepw =3D 0;
+my $dbtype =3D 'sql_single';
+while ( $_ =3D shift(@ARGV) ) {
+ if ( /^-h$/ ) {
+ $hidepw =3D 1;
+ } elsif ( /^-/ ) {
+ die("Unknown input flag $_.\nUsage: wwdb_addgw [-h] sql|sql_single\n");
+ } else {
+ if ( $_ eq 'sql' || $_ eq 'sql_single' ) {
+ $dbtype =3D $_;
+ } else {
+ die("Unknown argument $_.\nUsage: wwdb_addgw [-h] " .
+ "sql|sql_single\n");
+ }
+ }
+}
+
+printHdr( $dbtype );
+
+# get database information
+my ( $admin, $adminpw );
+( $admin, $adminpw, $dbtype ) =3D getDBInfo( $hidepw, $dbtype );
+
+# connect to database, if we're in sql_single mode; this lets us easily
+# get a list of courses to work with. in sql mode, it's harder b/c I ca=
n't
+# get DBI->data_sources('mysql') to work on my system, so we prompt for=20
+# those separately. if we're in sql single mode, $dbh is a place holder=
,
+# because we have to do the database connects in the subroutines to conn=
ect
+# to each different database
+my $dbh =3D '';
+if ( $dbtype eq 'sql_single' ) {
+ $dbh =3D DBI->connect("$source:webwork", $admin, $adminpw) or
+ die( $DBI::errstr );
+}
+
+# get courses list
+my @courses =3D getCourses( $dbtype, $dbh );
+
+# now $course{coursename} =3D format (sql or sql_single)
+
+# do update
+my ( $doneRef, $skipRef ) =3D updateCourses( $dbtype, $dbh, \@courses,=20
+ $admin, $adminpw );
+$dbh->disconnect() if ( $dbh );
+
+# all done
+confirmUpdate( $dbtype, $doneRef, $skipRef );
+
+# end of main
+#-----------------------------------------------------------------------=
--------
+# subroutines
+
+sub printHdr {=20
+ print <<eoh;
+------------------------------------------------------------------------=
---
+wwdb_addgw: update WeBWorK SQL databases to include fields required for =
a=20
+ Gateway aware WeBWorK installation.
+
+set default WeBWorK database type to $dbtype.
+------------------------------------------------------------------------=
---
+eoh
+ return 1;
+}
+
+sub getDBInfo {
+ my $hide =3D shift();
+ my $type =3D shift();
+
+ print "mySQL administrator login name [root] > ";
+ my $admin =3D <STDIN>;
+ chomp( $admin );
+ $admin =3D 'root' if ( ! $admin );
+
+ print "mySQL login password for $admin > ";
+ system("stty -echo") if ( $hide );
+ my $passwd =3D <STDIN>;
+ if ( $hide ) { system("stty echo"); print "\n"; }
+ chomp( $passwd );
+ die("Error: no password provided\n") if ( ! $passwd );
+
+ print "WeBWorK database type (sql or sql_single) [$type] > ";
+ my $dbtype =3D <STDIN>;
+ chomp( $dbtype );
+ $dbtype =3D $type if ( ! $dbtype );
+
+ return( $admin, $passwd, $dbtype );
+}
+
+sub getCourses {
+ my ( $dbtype, $dbh ) =3D @_;
+
+ my %courses =3D ();
+
+# get a course list
+ if ( $dbtype eq 'sql' ) {
+ print "courses to update (enter comma separated) > ";
+ my $crslist =3D <STDIN>;
+ chomp($crslist);
+ my @crslist =3D split(/,\s*/, $crslist);
+ die("Error: no courses specified\n") if ( ! @crslist );
+ foreach ( @crslist ) { $courses{$_} =3D 1; }
+
+ } else {
+ my $cmd =3D 'show tables';
+ my $st =3D $dbh->prepare( $cmd ) or die( $dbh->errstr() );
+ $st->execute() or die( $st->errstr() );
+ my $rowRef =3D $st->fetchall_arrayref();
+ foreach my $r ( @$rowRef ) {
+ $_ =3D $r->[0];
+ my ($crs, $tbl) =3D ( /^([^_]+)_(.*)$/ );
+ $courses{$crs} =3D 1 if ( defined( $crs ) );
+ }
+ die("Error: found now sql_single WeBWorK courses\n") if ( ! %courses );
+ }
+
+# confirm this is correct
+ print "\nList of courses to update:\n";
+ my %nummap =3D orderedList( %courses );
+ printclist( sort keys( %courses ) );
+ print "Enter # to edit name, d# to delete from update list, or [cr] =
to " .
+ "continue.\n > ";
+ my $resp =3D <STDIN>;
+ chomp($resp);
+ while ( $resp ) {
+ if ( $resp =3D~ /^\d+$/ ) {
+ print " old course name $nummap{$resp}; new > ";
+ delete( $courses{$nummap{$resp}} );
+ my $newname =3D <STDIN>;
+ chomp($newname);
+ $courses{ $newname } =3D 1;
+ } elsif ( $resp =3D~ /^d(\d+)$/ ) {
+ $resp =3D $1;
+ delete( $courses{$nummap{$resp}} );
+ } else {
+ print "unrecognized response: $resp.\n";
+ }
+ %nummap =3D orderedList( %courses );
+ print "Current list of courses to update:\n";
+ printclist( sort keys( %courses ) );
+ print "Enter #, d# or [cr] > "; =20
+ chomp( $resp =3D <STDIN> );
+ }
+
+ my @courses =3D sort( keys %courses );
+ if ( @courses ) {
+ return @courses;
+ } else {
+ die("Error: no courses left to update.\n");
+ }
+}
+
+sub orderedList {
+ my %hash =3D @_;
+ my $i=3D1;
+ my %nummap =3D ();
+ foreach ( sort( keys( %hash ) ) ) {
+ $nummap{ $i } =3D $_;
+ $i++;
+ }
+ return %nummap;
+}
+
+sub printclist {
+ my @list =3D @_;
+
+# assumes a 75 column screen
+
+ my $i =3D 1;
+ if ( @list <=3D 3 ) {
+ foreach ( @list ) { print " $i. $_\n"; $i++ }
+ } else {
+ while ( @list >=3D $i ) {
+ printf(" %2d. %-19s", $i, $list[$i-1]);
+ printf(" %2d. %-19s", ($i+1), $list[$i]) if ( @list >=3D ($i+1) );
+ printf(" %2d. %-19s", ($i+2), $list[$i+1]) if ( @list >=3D ($i+2) =
);
+ print "\n";
+ $i+=3D3;
+ }
+ }
+ return 1;
+}
+
+sub updateCourses {
+ my ( $dbtype, $dbh, $crsRef, $admin, $adminpw ) =3D @_;
+
+ my @done =3D ();
+ my @skipped =3D ();
+
+# give some sense of progress
+ select STDOUT; $| =3D 1; # unbuffer output
+ print "doing update.";
+
+# list of added fields to check for classes that don't need updating
+ my @newFields =3D keys( %addFields );
+
+ foreach my $crs ( @$crsRef ) {
+ print ".";
+ my $colRef;
+
+ if ( $dbtype eq 'sql' ) {
+ # we need to get a database handle first
+ $dbh =3D DBI->connect("$source:webwork_$crs", $admin, $adminpw) or
+ die( $DBI::errstr );
+
+ # now get a list of columns from the set table to check to see if=20
+ # we need an update
+ my $cmd =3D "show columns from set_not_a_keyword";
+ my $st =3D $dbh->prepare( $cmd ) or die( $dbh->errstr() );
+ $st->execute();
+ $colRef =3D $st->fetchall_arrayref();
+
+ } else {
+ # for sql_single we already have a database handle; get the set tabl=
e
+ # columns and proceed
+ my $cmd =3D "show columns from ${crs}_set";
+ my $st =3D $dbh->prepare( $cmd ) or die( $dbh->errstr() );
+ $st->execute();
+ $colRef =3D $st->fetchall_arrayref();
+ }
+
+ # now, do we have the columns we need already?
+ my $doneAlready =3D 0;
+ foreach my $cols ( @$colRef ) {
+ if ( inList( $cols->[0], @newFields ) ) {
+ $doneAlready =3D 1;
+ last;
+ }
+ }
+ if ( $doneAlready ) {
+ push( @skipped, $crs );
+ next;
+ } else {
+
+ # do update for course
+ my ( $cmd1, $cmd2 );
+ if ( $dbtype eq 'sql' ) {
+ $cmd1 =3D 'alter table set_not_a_keyword add column';
+ $cmd2 =3D 'alter table set_user add column';
+ } else {
+ $cmd1 =3D "alter table ${crs}_set add column";
+ $cmd2 =3D "alter table ${crs}_set_user add column";
+ }
+
+ foreach my $f ( keys %addFields ) {
+ my $st =3D $dbh->prepare( "$cmd1 $f $addFields{$f}" ) or=20
+ die( $dbh->errstr() );
+ $st->execute() or die( $st->errstr() );
+ }
+
+ foreach my $f ( keys %addFields ) {
+ my $st =3D $dbh->prepare( "$cmd2 $f $addFields{$f}" ) or=20
+ die( $dbh->errstr() );
+ $st->execute() or die( $st->errstr() );
+ }
+
+ push( @done, $crs );
+ }
+ # if we're doing sql databases, disconnect from this courses' databa=
se
+ $dbh->disconnect() if ( $dbtype eq 'sql' );
+
+ } # end loop through courses
+ print "\n";
+
+ return( \@done, \@skipped );
+}
+
+sub inList {
+ my $v =3D shift();
+ foreach ( @_ ) { return 1 if ( $v eq $_ ); }
+ return 0;
+}
+
+sub confirmUpdate {
+ my ( $dbtype, $doneRef, $skipRef ) =3D @_;
+
+ my $s1 =3D "updated $dbtype courses: ";
+ my $s2 =3D "courses not needing updates were skipped: ";
+ my $l1 =3D length($s1);
+ my $l2 =3D length($s2);
+
+ my $crsList=3D (@$doneRef) ? join(', ', @$doneRef) : '';
+ my $skpList=3D (@$skipRef) ? join(', ', @$skipRef) : '';
+ my $crsString =3D ( $crsList ) ?=20
+ $s1 . hangIndent( $l1, 75, $l1, "$crsList.") . "\n" : '';
+ my $skpString =3D ( $skpList ) ?=20
+ $s2 . hangIndent( $l1, 75, $l2, "$skpList." ) : '';
+
+ print <<eot;
+------------------------------------------------------------------------=
---
+done.
+$crsString$skpString
+
+eot
+}
+
+sub hangIndent {
+ my ( $hang, $width, $shorten, $text ) =3D @_;
+# pre: $hang and $width are numbers, $hang < $width; $text is a string
+# if $shorten, the first line is shortened by $shorten
+# post: $text is reformatted to have maximum width $width and a hanging
+# indent of $hang each line after the first; the reformatted text
+# is returned
+ my $htext =3D '';
+ my $line =3D '';
+ my $indent =3D ($shorten ? $shorten : 0);
+ my $ldr =3D ' 'x$hang;
+
+ if ( $indent + length($text) < $width ) {
+ $htext =3D $text;
+ } else {
+ foreach ( split(/\s+/, $text ) ) {
+ if ( $indent + length($line) + length($_) >=3D $width ) {
+ $htext .=3D $line . "\n$ldr";
+ $line =3D "$_ ";
+ $indent =3D $hang;
+ } else {
+ $line .=3D "$_ ";
+ }
+ }
+ $htext .=3D $line if ( $line );
+ }
+ $htext =3D~ s/\n$ldr$//;
+ return $htext;
+}
+
+# end of script
+#-----------------------------------------------------------------------=
--------
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-16 22:29:44
|
Log Message:
-----------
Added documentation for macros used in constructing
sequential problems.
Modified Files:
--------------
pg/macros:
PG.pl
PGsequentialmacros.pl
Revision Data
-------------
Index: PG.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PG.pl,v
retrieving revision 1.20
retrieving revision 1.21
diff -Lmacros/PG.pl -Lmacros/PG.pl -u -r1.20 -r1.21
--- macros/PG.pl
+++ macros/PG.pl
@@ -255,10 +255,30 @@
my @in = @_;
$STRINGforOUTPUT .= join(" ",@in);
}
+
+=head2 STOP_RENDERING()
+
+ STOP_RENDERING() unless all_answers_are_correct;
+
+No text is printed and no answer blanks or answer evaluators are stored or processed until
+RESUME_RENDERING() is executed.
+
+=cut
+
sub STOP_RENDERING {
$PG_STOP_FLAG=1;
"";
}
+
+=head2 RESUME_RENDERING()
+
+ RESUME_RENDERING();
+
+Resumes processing of text, answer blanks, and
+answer evaluators.
+
+=cut
+
sub RESUME_RENDERING {
$PG_STOP_FLAG=0;
"";
Index: PGsequentialmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGsequentialmacros.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/PGsequentialmacros.pl -Lmacros/PGsequentialmacros.pl -u -r1.1 -r1.2
--- macros/PGsequentialmacros.pl
+++ macros/PGsequentialmacros.pl
@@ -1,3 +1,66 @@
+
+=head1 NAME
+
+ PGsequentialmacros.pl
+
+Provides support for writing sequential problems, where certain parts
+of the problem are hidden until earlier questions are answered correctly.
+
+
+=head1 SYNPOSIS
+
+ The basic sequential problem structure:
+
+ DOCUMENT();
+ loadMacros(.....);
+ ## first segment ##
+ BEGIN_TEXT
+ The first question: Enter \(sin(0) = \) \{ans_rule\}.
+ END_TEXT
+ ANS(num_cmp(0));
+ if (@incorrect_answers = get_incorrect_answers( ) ) {
+ TEXT( "These answers are not correct ", join(" ",@incorrect_answers),$BR);
+ foreach my $label (@incorrect_answers) {
+ checkAnswer($label,debug=>1);
+ }
+ }
+ if (all_answers_are_correct() ) {
+ TEXT("$PAR Right! Now for the next part of the problem");
+ } else {
+ STOP_RENDERING();
+ }
+ ## second segment ##
+ ....
+ if (@incorrect_answers = get_incorrect_answers( ) ) {
+ TEXT( "These answers are not correct ", join(" ",@incorrect_answers),$BR);
+ foreach my $label (@incorrect_answers) {
+ checkAnswer($label,debug=>1);
+ }
+ }
+ if (all_answers_are_correct() ) {
+ TEXT("$PAR Right! Now for the next part of the problem");
+ } else {
+ STOP_RENDERING();
+ }
+ ## third segment ##
+ ENDDOCUMENT() # must be the last statement in the problem
+
+
+
+=head1 DESCRIPTION
+
+
+=cut
+
+
+=head2 listFormVariables
+
+ listFormVariables();
+
+Lists all variables submitted in the problem form. This is used for debugging.
+
+=cut
+
sub listFormVariables {
# Lists all of the variables filled out on the input form
# Useful for debugging
@@ -7,6 +70,19 @@
TEXT(pretty_print(\%envir));
TEXT($HR);
}
+
+=head2 checkAnswer
+
+
+ checkAnswer($label);
+
+Checks the answer to the question labeled C<$label>. The result is 1 if the answer is completely correct.
+0 if the answer is wrong or partially wrong and undefined if that question has not yet
+been answered. (Specifically if no answer hash is produced when the answer is evaluated
+by the corresponding answer evaluator.)
+
+=cut
+
sub checkAnswer {
# checks an answer on a given answer evaluator.
my $answerName = shift; # get the name of the answer
@@ -26,11 +102,34 @@
}
return $response; # response is (undef => no answer, 1=> correct answer, 0 => not completely correct
}
+
+=head2 listQueuedAnswers
+
+ listQueuedAnswers();
+
+Lists the labels of the answer blanks which have been printed so far.
+The return value is a string which can be printed. This is mainly
+used for debugging.
+
+=cut
+
+
sub listQueuedAnswers {
# lists the names of the answer blanks so far;
my %pg_answers_hash = get_PG_ANSWERS_HASH();
join(" ", keys %pg_answers_hash);
}
+
+=head2 checkQueuedAnswers
+
+ checkQueuedAnswers();
+
+Returns a hash whose key/value pairs are the labels of the questions
+have been printed so far and the scores obtained by evaluating the
+answers to these questions.
+
+=cut
+
sub checkQueuedAnswers {
# gather all of the answers submitted up to this time
my %options = @_;
@@ -42,6 +141,16 @@
}
%scores;
}
+
+=head2 all_answers_are_correct
+
+ all_answers_are_correct();
+
+Returns 1 if there is at least one answer and all of the questions
+printed so far have been answered correctly.
+
+=cut
+
sub all_answers_are_correct{
# return 1 if all scores are 1, else it returns 0;
# returns 0 if no answers have been checked yet
@@ -51,6 +160,18 @@
foreach my $label (keys %scores) { if (not defined($scores{$label}) or $scores{$label} <1) {$result=0; last;} };
$result;
}
+
+=head2 get_incorrect_answers
+
+ get_incorrect_answers();
+
+Returns a list of labels of questions which have been printed and have
+been answered incorrectly. This list does NOT include blank or undefined
+answers. It's possible for the returned list to be empty AND for all_answers_are_correct()
+to return false.
+
+=cut
+
sub get_incorrect_answers {
# returns only incorrect answers, not blank or undefined answers.
my %scores = checkQueuedAnswers();
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-16 21:59:13
|
Log Message:
-----------
Macros that aid the construction sequentialProblems. For these
problems certain sections of text are hidden until earlier
answers have been answered correctly.
-- Mike
Added Files:
-----------
pg/macros:
PGsequentialmacros.pl
Revision Data
-------------
--- /dev/null
+++ macros/PGsequentialmacros.pl
@@ -0,0 +1,66 @@
+sub listFormVariables {
+ # Lists all of the variables filled out on the input form
+ # Useful for debugging
+ TEXT($HR,"Form variables", );
+ TEXT(pretty_print($inputs_ref));
+ TEXT("Environment",$BR);
+ TEXT(pretty_print(\%envir));
+ TEXT($HR);
+}
+sub checkAnswer {
+ # checks an answer on a given answer evaluator.
+ my $answerName = shift; # get the name of the answer
+ my $ans_eval = get_PG_ANSWERS_HASH($answerName),; # get the answer evaluator
+ my %options = @_;
+ my $debug =($options{debug})?1:0; # give debug information
+
+ my $answer = $main::inputs_ref->{$answerName};
+ my $response = undef;
+ if (defined($answer) and defined($ans_eval) ) {
+ my $rh_ans_hash = $ans_eval->evaluate($answer);
+ $response = (defined($rh_ans_hash) and 1 == $rh_ans_hash->{score}) ? 1:0;
+ TEXT("result of evaluating $answerName",$BR, pretty_print($rh_ans_hash) ) if $debug;
+ } else {
+ warn "Answer evaluator for answer $answerName is not defined" unless defined($ans_eval);
+ # it's ok to have a blank answer.
+ }
+ return $response; # response is (undef => no answer, 1=> correct answer, 0 => not completely correct
+}
+sub listQueuedAnswers {
+ # lists the names of the answer blanks so far;
+ my %pg_answers_hash = get_PG_ANSWERS_HASH();
+ join(" ", keys %pg_answers_hash);
+}
+sub checkQueuedAnswers {
+ # gather all of the answers submitted up to this time
+ my %options = @_;
+ my $debug = ($options{debug}) ? 1 :0;
+ my (%pg_answers_hash) = get_PG_ANSWERS_HASH();
+ my %scores=();
+ foreach $label (keys %pg_answers_hash) {
+ $scores{$label}=checkAnswer($label, debug=>$debug);
+ }
+ %scores;
+}
+sub all_answers_are_correct{
+ # return 1 if all scores are 1, else it returns 0;
+ # returns 0 if no answers have been checked yet
+ my %scores = checkQueuedAnswers();
+ return 0 unless %scores;
+ my $result =1;
+ foreach my $label (keys %scores) { if (not defined($scores{$label}) or $scores{$label} <1) {$result=0; last;} };
+ $result;
+}
+sub get_incorrect_answers {
+ # returns only incorrect answers, not blank or undefined answers.
+ my %scores = checkQueuedAnswers();
+ my @incorrect = ();
+ foreach my $label (keys %scores) {push( @incorrect, $label)
+ unless (not defined($scores{$label}) or $scores{$label}==1 )
+ };
+ @incorrect;
+}
+
+1;
+
+
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-16 21:57:43
|
Log Message:
-----------
Added support for sequentialProblems.
Modified Files:
--------------
pg/macros:
PG.pl
Revision Data
-------------
Index: PG.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PG.pl,v
retrieving revision 1.19
retrieving revision 1.20
diff -Lmacros/PG.pl -Lmacros/PG.pl -u -r1.19 -r1.20
--- macros/PG.pl
+++ macros/PG.pl
@@ -74,8 +74,9 @@
my ($STRINGforOUTPUT, $STRINGforHEADER_TEXT, @PG_ANSWERS, @PG_UNLABELED_ANSWERS);
my %PG_ANSWERS_HASH ;
+our $PG_STOP_FLAG;
-# my variables are unreliable if two DOCUMENTS were to be called before and ENDDOCUMENT
+# my variables are unreliable if two DOCUMENTS were to be called before an ENDDOCUMENT
# there could be conflicts. As I understand the behavior of the Apache child
# this cannot occur -- a child finishes with one request before obtaining the next
@@ -113,7 +114,7 @@
$STRINGforOUTPUT ="";
$STRINGforHEADER_TEXT ="";
@PG_ANSWERS=();
-
+ $PG_STOP_FLAG=0;
@PG_UNLABELED_ANSWERS = ();
%PG_ANSWERS_HASH = ();
# FIXME: We are initializing these variables into both Safe::Root1 (the cached safe compartment)
@@ -250,11 +251,18 @@
=cut
sub TEXT {
+ return "" if $PG_STOP_FLAG;
my @in = @_;
$STRINGforOUTPUT .= join(" ",@in);
- }
-
-
+}
+sub STOP_RENDERING {
+ $PG_STOP_FLAG=1;
+ "";
+}
+sub RESUME_RENDERING {
+ $PG_STOP_FLAG=0;
+ "";
+}
=head2 ANS()
@@ -273,19 +281,21 @@
=cut
sub ANS{ # store answer evaluators which have not been explicitly labeled
+ return "" if $PG_STOP_FLAG;
my @in = @_;
while (@in ) {
warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to
subroutines<BR>")
unless ref($in[0]);
push(@PG_ANSWERS, shift @in );
- }
+ }
}
sub LABELED_ANS { #a better alias for NAMED_ANS
&NAMED_ANS;
}
sub NAMED_ANS{ # store answer evaluators which have been explicitly labeled (submitted in a hash)
+ return "" if $PG_STOP_FLAG;
my @in = @_;
while (@in ) {
my $label = shift @in;
@@ -298,6 +308,7 @@
}
}
sub RECORD_ANS_NAME { # this maintains the order in which the answer rules are printed.
+ return "" if $PG_STOP_FLAG;
my $label = shift;
eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
$label;
@@ -305,6 +316,7 @@
sub NEW_ANS_NAME { # this keeps track of the answers which are entered implicitly,
# rather than with a specific label
+ return "" if $PG_STOP_FLAG;
my $number=shift;
my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
my $label = $prefix.$number;
@@ -323,12 +335,14 @@
sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
# it's a bit of hack since we are storing these in the KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
+ return "" if $PG_STOP_FLAG;
my $label = shift; # the label of the input box or textarea
eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
$label;
}
sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers which are entered implicitly,
# rather than with a specific label
+ return "" if $PG_STOP_FLAG;
my $number=shift;
$vecnum = 0;
my $row = shift;
@@ -340,7 +354,8 @@
}
sub NEW_ANS_ARRAY_NAME_EXTENSION { # this keeps track of the answers which are entered implicitly,
- # rather than with a specific label
+ # rather than with a specific label
+ return "" if $PG_STOP_FLAG;
my $number=shift;
my $row = shift;
my $col = shift;
@@ -356,6 +371,33 @@
$label;
}
+
+sub get_PG_ANSWERS_HASH {
+ # update the PG_ANSWWERS_HASH, then report the result.
+ # This is used in writing sequential problems
+ # if there is an input, use that as a key into the answer hash
+ my $key = shift;
+ my (%pg_answers_hash, @pg_unlabeled_answers);
+ %pg_answers_hash= %PG_ANSWERS_HASH;
+ #warn "order ", eval(q!@main::PG_ANSWER_ENTRY_ORDER!);
+ #warn "pg answers", %PG_ANSWERS_HASH;
+ #warn "unlabeled", @PG_UNLABELED_ANSWERS;
+ my $index=0;
+ foreach my $label (@PG_UNLABELED_ANSWERS) {
+ if ( defined($PG_ANSWERS[$index]) ) {
+ $pg_answers_hash{"$label"}= $PG_ANSWERS[$index];
+ #warn "recording answer label = $label";
+ } else {
+ warn "No answer provided by instructor for answer $label";
+ }
+ $index++;
+ }
+ if ($key) {
+ return $pg_answers_hash{$key};
+ } else {
+ return %pg_answers_hash;
+ }
+}
# ENDDOCUMENT must come at the end of every .pg file.
# It exports the resulting text of the problem, the text to be used in HTML header material
# (for javaScript), the list of answer evaluators and any other flags. It can appear only once and
|
|
From: jj v. a. <we...@ma...> - 2005-07-16 19:22:41
|
Log Message:
-----------
Fixed typo related to useBaseTenLog.
Modified Files:
--------------
pg/lib/Value:
WeBWorK.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/WeBWorK.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Value/WeBWorK.pm -Llib/Value/WeBWorK.pm -u -r1.7 -r1.8
--- lib/Value/WeBWorK.pm
+++ lib/Value/WeBWorK.pm
@@ -77,7 +77,7 @@
numRelPercentTolDefault
numZeroLevelDefault
numZeroLevelTolDefault
- useBaseTenLogs
+ useBaseTenLog
);
sub Parser::Context::initCopy {
@@ -95,7 +95,7 @@
zeroLevelTol => $ww->{numZeroLevelTolDefault},
num_points => $ww->{functNumOfPoints} + 2,
max_adapt => $ww->{functMaxConstantOfIntegration},
- useBaseTenLogs => $ww->{useBaseTenLogs},
+ useBaseTenLog => $ww->{useBaseTenLog},
);
$context->{format}{number} = $ww->{numFormatDefault} if $ww->{$numFormatDefault} ne '';
$context;
|
|
From: jj v. a. <we...@ma...> - 2005-07-16 19:21:13
|
Log Message:
-----------
Fixed typo related to useBaseTenLog.
Modified Files:
--------------
pg/lib/Parser/Function:
numeric.pm
Revision Data
-------------
Index: numeric.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/numeric.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/Function/numeric.pm -Llib/Parser/Function/numeric.pm -u -r1.4 -r1.5
--- lib/Parser/Function/numeric.pm
+++ lib/Parser/Function/numeric.pm
@@ -49,7 +49,7 @@
my $self = shift; my $context;
$context = $self->{context} if ref($self);
$context = $$Value::context unless $context;
- return CORE::log($_[0])/CORE::log(10) if $context->flag('useBaseTenLogs');
+ return CORE::log($_[0])/CORE::log(10) if $context->flag('useBaseTenLog');
CORE::log($_[0]);
}
|
|
From: jj v. a. <we...@ma...> - 2005-07-15 03:00:30
|
Log Message:
-----------
Fixed typo.
Modified Files:
--------------
pg/macros:
contextLimitedPolynomial.pl
Revision Data
-------------
Index: contextLimitedPolynomial.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedPolynomial.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lmacros/contextLimitedPolynomial.pl -Lmacros/contextLimitedPolynomial.pl -u -r1.2 -r1.3
--- macros/contextLimitedPolynomial.pl
+++ macros/contextLimitedPolynomial.pl
@@ -177,7 +177,7 @@
my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
&{$super."::_check"}($self);
my $op = $self->{op};
- return if LimitedPolynomail::isConstant($op);
+ return if LimitedPolynomial::isConstant($op);
$self->Error("You can only use '%s' with monomials",$self->{def}{string})
if $op->{isPoly};
$self->{isPoly} = 2;
|
|
From: jj v. a. <we...@ma...> - 2005-07-14 20:41:01
|
Log Message:
-----------
In the login log, this will get the host's name if apache has been
configured to do that, otherwise it should get the ip number, and if
that somehow fails, we note it in the login log instead of to the user.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Authen.pm
Revision Data
-------------
Index: Authen.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Authen.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -Llib/WeBWorK/Authen.pm -Llib/WeBWorK/Authen.pm -u -r1.41 -r1.42
--- lib/WeBWorK/Authen.pm
+++ lib/WeBWorK/Authen.pm
@@ -238,7 +238,7 @@
my $ce = $r->ce;
my $timestamp = localtime;
($timestamp) = $timestamp =~ /^\w+\s(.*)\s/;
- my $remote_host = $r->connection->remote_host || "(cannot get host)";
+ my $remote_host = $r->get_remote_host || "(cannot get host)";
my $user_agent = $r->header_in("User-Agent");
writeCourseLog($ce, "login_log", "$userID on $remote_host ($user_agent)");
}
|
|
From: jj v. a. <we...@ma...> - 2005-07-14 20:23:46
|
Log Message:
-----------
When putting entries into the mysql database, put in "" as NULL. The
counterpart when retreiving values (that NULL is converted to "") is
already part of gets.
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.25
retrieving revision 1.26
diff -Llib/WeBWorK/DB/Schema/SQL.pm -Llib/WeBWorK/DB/Schema/SQL.pm -u -r1.25 -r1.26
--- lib/WeBWorK/DB/Schema/SQL.pm
+++ lib/WeBWorK/DB/Schema/SQL.pm
@@ -297,6 +297,7 @@
my @realFieldnames = $self->{record}->FIELDS();
my @fieldvalues = map { $Record->$_() } @realFieldnames;
+ @fieldvalues = map { $_ eq "" ? undef : $_ } @fieldvalues;
my ($where, @where_args) = $self->makeWhereClause(map { $Record->$_() } @realKeynames);
|
|
From: jj v. a. <we...@ma...> - 2005-07-14 18:21:33
|
Log Message:
-----------
If HostnameLookups is off in Apache's httpd.conf, then remote_host returns
an undefined value. Better than this fix would be to use get_remote_host,
but I couldn't get that to work on my system.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Authen.pm
Revision Data
-------------
Index: Authen.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Authen.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -Llib/WeBWorK/Authen.pm -Llib/WeBWorK/Authen.pm -u -r1.40 -r1.41
--- lib/WeBWorK/Authen.pm
+++ lib/WeBWorK/Authen.pm
@@ -238,7 +238,7 @@
my $ce = $r->ce;
my $timestamp = localtime;
($timestamp) = $timestamp =~ /^\w+\s(.*)\s/;
- my $remote_host = $r->connection->remote_host;
+ my $remote_host = $r->connection->remote_host || "(cannot get host)";
my $user_agent = $r->header_in("User-Agent");
writeCourseLog($ce, "login_log", "$userID on $remote_host ($user_agent)");
}
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-07-14 16:26:40
|
Log Message:
-----------
Correct commit of file with unresolved conflicts.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
SetMaker.pm
Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.36 -r1.37
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -47,7 +47,6 @@
use constant HIDDEN => (1 << 1);
use constant SUCCESS => (1 << 2);
-<<<<<<< SetMaker.pm
## for additional problib buttons
my %problib; ## filled in in global.conf
my %ignoredir = (
@@ -56,12 +55,6 @@
);
##
-=======
-## for additional problib buttons
-my %problib; ## filled in in global.conf
-my %ignoredir = ('.' => 1, '..' => 1, 'Library' => 1);
-
->>>>>>> 1.20.2.2
## 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
@@ -83,7 +76,6 @@
##
sub get_library_sets {
-<<<<<<< SetMaker.pm
my $top = shift; my $dir = shift;
# ignore directories that give us an error
my @lis = eval { readDirectory($dir) };
@@ -127,42 +119,13 @@
return () unless $top || (scalar(@pgs) == 1 && $others) || grep /^=library-combine-up$/, @lis;
return (map {"$dir/$_"} @pgs);
-=======
- my $amtop = shift;
- my $topdir = shift;
- my @lis = readDirectory($topdir);
- my @pgs = grep { m/\.pg$/ and (not m/(Header|-text)\.pg/) and -f "$topdir/$_"} @lis;
- my $havepg = scalar(@pgs)>0 ? 1 : 0;
- my @mdirs = grep {!defined($ignoredir{$_}) and -d "$topdir/$_"} @lis;
- if ($amtop) {@mdirs = grep {!defined($problib{$_})} @mdirs}
- my ($adir, @results, @thisresult);
- for $adir (@mdirs) {
- @results = get_library_sets(0, "$topdir/$adir");
- my $isadirok = shift @results;
- @thisresult = (@thisresult, @results);
- if ($isadirok) {
- @thisresult = ("$topdir/$adir", @thisresult);
- }
- }
- return(($havepg, @thisresult));
->>>>>>> 1.20.2.2
}
sub list_pg_files {
-<<<<<<< SetMaker.pm
my ($templates,$dir) = @_;
my $top = ($dir eq '.')? 1 : 2;
my @pgs = get_library_pgs($top,$templates,$dir);
return sortByName(undef,@pgs);
-=======
- my $templatedir = shift;
- my $topdir = shift;
-
- my @lis = readDirectory("$templatedir/$topdir");
- my @pgs = grep { m/\.pg$/ and (not m/(Header|-text)\.pg/) and -f "$templatedir/$topdir/$_"} @lis;
- @pgs = map { "$topdir/$_" } @pgs;
- return(@pgs);
->>>>>>> 1.20.2.2
}
## go through past page getting a list of identifiers for the problems
@@ -213,7 +176,6 @@
############# List of sets of problems in templates directory
sub get_problem_directories {
-<<<<<<< SetMaker.pm
my $ce = shift;
my $lib = shift;
my $source = $ce->{courseDirs}{templates};
@@ -228,22 +190,6 @@
@all_problem_directories = sortByName(undef, @all_problem_directories);
unshift @all_problem_directories, $main if($includetop);
return (\@all_problem_directories);
-=======
- my $ce = shift;
- my $lib = shift;
- my $source = $ce->{courseDirs}{templates};
- my $main = MY_PROBLEMS; my $isTop = 1;
- if ($lib) {$source .= "/$lib"; $main = MAIN_PROBLEMS; $isTop = 0}
- my @all_problem_directories = get_library_sets($isTop, $source);
- my $includetop = shift @all_problem_directories;
- my $j;
- for ($j=0; $j<scalar(@all_problem_directories); $j++) {
- $all_problem_directories[$j] =~ s|^$ce->{courseDirs}->{templates}/?||;
- }
- @all_problem_directories = sort @all_problem_directories;
- unshift @all_problem_directories, $main if($includetop);
- return (\@all_problem_directories);
->>>>>>> 1.20.2.2
}
############# Everyone has a view problems line. Abstract it
@@ -277,7 +223,6 @@
### The browsing panel has three versions
##### Version 1 is local problems
sub browse_local_panel {
-<<<<<<< SetMaker.pm
my $self = shift;
my $library_selected = shift;
my $lib = shift || ''; $lib =~ s/^browse_//;
@@ -302,32 +247,6 @@
CGI::br(),
$view_problem_line,
));
-=======
- my $self = shift;
- my $library_selected = shift;
- my $lib = shift || ''; $lib =~ s/^browse_//;
- my $name = ($lib eq '')? 'Local' : $problib{$lib};
-
- my $list_of_prob_dirs= get_problem_directories($self->r->ce,$lib);
- if(scalar(@$list_of_prob_dirs) == 0) {
- $library_selected = "Found no directories containing problems";
- unshift @{$list_of_prob_dirs}, $library_selected;
- } else {
- my $default_value = SELECT_LOCAL_STRING;
- if (not $library_selected or $library_selected eq $default_value) {
- unshift @{$list_of_prob_dirs}, $default_value;
- $library_selected = $default_value;
- }
- }
- my $view_problem_line = view_problems_line('view_local_set', 'View Problems', $self->r);
- print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, "$name Problems: ",
- CGI::popup_menu(-name=> 'library_sets',
- -values=>$list_of_prob_dirs,
- -default=> $library_selected),
- CGI::br(),
- $view_problem_line,
- ));
->>>>>>> 1.20.2.2
}
##### Version 2 is local problem sets
@@ -444,7 +363,6 @@
}
sub make_top_row {
-<<<<<<< SetMaker.pm
my $self = shift;
my $r = $self->r;
my $ce = $r->ce;
@@ -544,108 +462,6 @@
-value=>"Clear Problem Display")
)),
CGI::end_table()));
-=======
- my $self = shift;
- my $r = $self->r;
- my $ce = $r->ce;
- my %data = @_;
-
- my $list_of_local_sets = $data{all_set_defs};
- my $have_local_sets = scalar(@$list_of_local_sets);
- my $browse_which = $data{browse_which};
- my $library_selected = $r->param('library_sets');
- my $set_selected = $r->param('local_sets');
-
- my ($dis1, $dis2, $dis3) = ("","","");
- $dis1 = '-disabled' if($browse_which eq 'browse_library');
- $dis2 = '-disabled' if($browse_which eq 'browse_local');
- $dis3 = '-disabled' if($browse_which eq 'browse_mysets');
-
- ## Make buttons for additional problem libraries
- my $libs = '';
- foreach my $lib (sort(keys(%problib))) {
- $libs .= ' '. CGI::submit(-name=>"browse_$lib", -value=>$problib{$lib},
- ($browse_which eq "browse_$lib")? '-disabled': '')
- if (-d "$ce->{courseDirs}{templates}/$lib");
- }
- $libs = CGI::br()."or Problems from".$libs if $libs ne '';
-
- my $these_widths = "width: 20ex";
- print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
- "Browse ",
- CGI::submit(-name=>"browse_library", -value=>"Problem Library", -style=>$these_widths, $dis1),
- CGI::submit(-name=>"browse_local", -value=>"Local Problems", -style=>$these_widths, $dis2),
- CGI::submit(-name=>"browse_mysets", -value=>"From This Course", -style=>$these_widths, $dis3),
- $libs,
- ));
-
- print CGI::Tr(CGI::td({-bgcolor=>"black"}));
-
- if ($browse_which eq 'browse_local') {
- $self->browse_local_panel($library_selected);
- } elsif ($browse_which eq 'browse_mysets') {
- $self->browse_mysets_panel($library_selected, $list_of_local_sets);
- } elsif ($browse_which eq 'browse_library') {
- $self->browse_library_panel();
- } else { ## handle other problem libraries
- $self->browse_local_panel($library_selected,$browse_which);
- }
-
- print CGI::Tr(CGI::td({-bgcolor=>"black"}));
-
- if($have_local_sets ==0) {
- $list_of_local_sets = [NO_LOCAL_SET_STRING];
- } elsif (not $set_selected or $set_selected eq SELECT_SET_STRING) {
- if ($list_of_local_sets->[0] eq "Select a Problem Set") {
- shift @{$list_of_local_sets};
- }
- unshift @{$list_of_local_sets}, SELECT_SET_STRING;
- $set_selected = SELECT_SET_STRING;
- }
- my $myjs = 'document.mainform.selfassign.value=confirm("Should I assign the new set to you now?\nUse OK for yes and Cancel for no.");true;';
-
- print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, "Adding Problems to ",
- CGI::b("Target Set: "),
- CGI::popup_menu(-name=> 'local_sets',
- -values=>$list_of_local_sets,
- -default=> $set_selected),
- CGI::submit(-name=>"edit_local", -value=>"Edit Target Set"),
- CGI::hidden(-name=>"selfassign", -default=>[0]).
- CGI::br(),
- CGI::br(),
- CGI::submit(-name=>"new_local_set", -value=>"Create a New Set in This Course:",
- -onclick=>$myjs
- ),
- " ",
- CGI::textfield(-name=>"new_set_name",
- -default=>"Name for new set here",
- -override=>1, -size=>30),
- CGI::br(),
- ));
-
- print CGI::Tr(CGI::td({-bgcolor=>"black"}));
-
- print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
- CGI::start_table({-border=>"0"}),
- CGI::Tr( CGI::td({ -align=>"center"},
- CGI::submit(-name=>"select_all", -style=>$these_widths,
- -value=>"Mark All For Adding"),
- CGI::submit(-name=>"select_none", -style=>$these_widths,
- -value=>"Clear All Marks"),
- )),
- CGI::Tr( CGI::td(
- CGI::submit(-name=>"update", -style=>$these_widths. "; font-weight:bold",
- -value=>"Update"),
- CGI::submit(-name=>"rerandomize",
- -style=>$these_widths,
- -value=>"Rerandomize"),
- CGI::submit(-name=>"cleardisplay",
- -style=>$these_widths,
- -value=>"Clear Problem Display")
- )),
- CGI::end_table()));
->>>>>>> 1.20.2.2
-
}
sub make_data_row {
@@ -788,7 +604,6 @@
########### Start the logic through if elsif elsif ...
-<<<<<<< SetMaker.pm
##### Asked to browse certain problems
if ($browse_lib ne '') {
$browse_which = $browse_lib;
@@ -832,129 +647,6 @@
$set_to_display = '.' if $set_to_display eq MY_PROBLEMS;
$set_to_display = substr($browse_which,7) if $set_to_display eq MAIN_PROBLEMS;
@pg_files = list_pg_files($ce->{courseDirs}->{templates},
-=======
-sub pre_header_initialize {
- my ($self) = @_;
- my $r = $self->r;
- ## For all cases, lets set some things
- $self->{error}=0;
- my $ce = $r->ce;
- my $db = $r->db;
- my $maxShown = $r->param('max_shown') || MAX_SHOW_DEFAULT;
- $maxShown = 10000000 if($maxShown eq 'All'); # let's hope there aren't more
-
- ## These directories will have individual buttons
- %problib = %{$ce->{courseFiles}{problibs}} if $ce->{courseFiles}{problibs};
-
- my $userName = $r->param('user');
- my $user = $db->getUser($userName); # checked
- die "record for user $userName (real user) does not exist."
- unless defined $user;
- my $authz = $r->authz;
- unless ($authz->hasPermissions($userName, "modify_problem_sets")) {
- return(""); # Error message already produced in the body
- }
-
- ## Now one action we have to deal with here
- if ($r->param('edit_local')) {
- my $urlpath = $r->urlpath;
- my $db = $r->db;
- my $checkset = $db->getGlobalSet($r->param('local_sets'));
- if (not defined($checkset)) {
- $self->{error} = 1;
- $self->addbadmessage('You need to select a "Target Set" before you can edit it.');
- } else {
- my $page = $urlpath->newFromModule('WeBWorK::ContentGenerator::Instructor::ProblemSetEditor', setID=>$r->param('local_sets'), courseID=>$urlpath->arg("courseID"));
- my $url = $self->systemLink($page);
- $self->reply_with_redirect($url);
- }
- }
-
- ## Next, lots of set up so that errors can be reported with message()
-
- ############# List of problems we have already printed
-
- $self->{past_problems} = get_past_problem_files($r);
- # if we don't end up reusing problems, this will be wiped out
- # if we do redisplay the same problems, we must adjust this accordingly
- my @past_marks = map {$_->[1]} @{$self->{past_problems}};
- my $none_shown = scalar(@{$self->{past_problems}})==0;
- my @pg_files=();
- my $use_previous_problems = 1;
- my $first_shown = $r->param('first_shown') || 0;
- my $last_shown = $r->param('last_shown');
- if (not defined($last_shown)) {
- $last_shown = -1;
- }
- my @all_past_list = (); # these are include requested, but not shown
- my $j = 0;
- while (defined($r->param("all_past_list$j"))) {
- push @all_past_list, $r->param("all_past_list$j");
- $j++;
- }
-
- ############# Default of which problem selector to display
-
- my $browse_which = $r->param('browse_which') || 'browse_local';
-
- my $problem_seed = $r->param('problem_seed') || 0;
- $r->param('problem_seed', $problem_seed); # if it wasn't defined before
-
- ## check for problem lib buttons
- my $browse_lib = '';
- foreach my $lib (keys %problib) {
- if ($r->param("browse_$lib")) {
- $browse_lib = "browse_$lib";
- last;
- }
- }
-
- ########### Start the logic through if elsif elsif ...
-
- ##### Asked to browse certain problems
- if ($browse_lib ne '') {
- $browse_which = $browse_lib;
- $r->param('library_sets', "");
- $use_previous_problems = 0; @pg_files = (); ## clear old problems
- } elsif ($r->param('browse_library')) {
- $browse_which = 'browse_library';
- $r->param('library_sets', "");
- $use_previous_problems = 0; @pg_files = (); ## clear old problems
- } elsif ($r->param('browse_local')) {
- $browse_which = 'browse_local';
- $r->param('library_sets', "");
- $use_previous_problems = 0; @pg_files = (); ## clear old problems
- } elsif ($r->param('browse_mysets')) {
- $browse_which = 'browse_mysets';
- $r->param('library_sets', "");
- $use_previous_problems = 0; @pg_files = (); ## clear old problems
-
- ##### Change the seed value
-
- } elsif ($r->param('rerandomize')) {
- $problem_seed++;
- $r->param('problem_seed', $problem_seed);
- $self->addbadmessage('Changing the problem seed for display, but there are no problems showing.') if $none_shown;
-
- ##### Clear the display
-
- } elsif ($r->param('cleardisplay')) {
- @pg_files = ();
- $use_previous_problems=0;
- $self->addbadmessage('The display was already cleared.') if $none_shown;
-
- ##### View problems selected from the local list
-
- } elsif ($r->param('view_local_set')) {
-
- my $set_to_display = $r->param('library_sets');
- if (not defined($set_to_display) or $set_to_display eq SELECT_LOCAL_STRING or $set_to_display eq "Found no directories containing problems") {
- $self->addbadmessage('You need to select a set to view.');
- } else {
- $set_to_display = '.' if $set_to_display eq MY_PROBLEMS;
- $set_to_display = substr($browse_which,7) if $set_to_display eq MAIN_PROBLEMS;
- @pg_files = list_pg_files($ce->{courseDirs}->{templates},
->>>>>>> 1.20.2.2
"$set_to_display");
$use_previous_problems=0;
}
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-07-14 14:33:46
|
Log Message:
-----------
Add gateway template to templates hash.
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.122
retrieving revision 1.123
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.122 -r1.123
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -435,6 +435,7 @@
%templates = (
system => "$webworkDirs{conf}/templates/ur.template",
+ gateway => "$webworkDirs{conf}/templates/gw.template",
);
################################################################################
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-07-13 18:06:56
|
Log Message:
-----------
Test commit prior to initial full commit of files for addition of the
Gateway testing module. (CVS reports that Authz.pm has changed, but
unix diff shows no changes, so this is testing if CVS will actually
register a change to the file.)
Modified Files:
--------------
webwork2/lib/WeBWorK:
Authz.pm
Revision Data
-------------
|
|
From: dpvc v. a. <we...@ma...> - 2005-07-13 01:50:23
|
Log Message:
-----------
Wrong correction in the previous commit. Use CODE::push
Modified Files:
--------------
pg/lib:
Parser.pm
Revision Data
-------------
Index: Parser.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -Llib/Parser.pm -Llib/Parser.pm -u -r1.26 -r1.27
--- lib/Parser.pm
+++ lib/Parser.pm
@@ -644,7 +644,7 @@
$vars = [sort(keys %{$self->{variables}})] unless $vars;
my $n = scalar(@{$vars}); my $vnames = '';
if ($n > 0) {
- my @v = (); foreach my $x (@{$vars}) {&push(@v,'$'.$x)}
+ my @v = (); foreach my $x (@{$vars}) {CORE::push(@v,'$'.$x)}
$vnames = "my (".join(',',@v).") = \@_;";
}
my $fn = eval
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-13 01:27:01
|
Log Message:
-----------
Made modifications that allow use of complex numbers in matrices. You can
also LR decompose a non-square matrix. Documentation is still needed
and further testing.
Modified Files:
--------------
pg/lib:
Matrix.pm
Revision Data
-------------
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Matrix.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Matrix.pm -Llib/Matrix.pm -u -r1.8 -r1.9
--- lib/Matrix.pm
+++ lib/Matrix.pm
@@ -15,12 +15,12 @@
=cut
-
-
-BEGIN {
- be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
-
-}
+our $OPTION_ENTRY = $MatrixReal1::OPTION_ENTRY;
+use strict;
+# BEGIN {
+# be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
+#
+# }
package Matrix;
@Matrix::ISA = qw(MatrixReal1);
@@ -37,29 +37,87 @@
=cut
-sub _stringify
-{
- my($object,$argument,$flag) = @_;
-# my($name) = '""'; #&_trace($name,$object,$argument,$flag);
+sub _stringify {
+ my ($object,$argument,$flag) = @_;
+ return unless ref($object);
+ $argument = "" unless defined $argument;
+ $flag = "" unless defined $flag;
+ #warn " object ".ref($object);
+ #warn " args $argument";
+ #warn "flag $flag";
+# my($name) = '""'; &_trace($name,$object,$argument,$flag);
my($rows,$cols) = ($object->[1],$object->[2]);
my($i,$j,$s);
-
+
$s = '';
for ( $i = 0; $i < $rows; $i++ )
{
$s .= "[ ";
for ( $j = 0; $j < $cols; $j++ )
- {
+ { #warn " i $i j $j ",$object->rh_options;
my $format = (defined($object->rh_options->{display_format}))
- ? $object->[3]->{display_format} :
+ ? $object->rh_options->{display_format} :
$Matrix::DEFAULT_FORMAT;
- $s .= sprintf($Matrix::DEFAULT_FORMAT, $object->[0][$i][$j]);
+ $s .= (ref($object->[0][$i][$j]) =~/Complex/) ?
+ " ".$object->[0][$i][$j]->stringify_cartesian." " : #FIXME
+ sprintf($Matrix::DEFAULT_FORMAT, $object->[0][$i][$j]) ;
}
$s .= "]\n";
}
return($s);
}
+# obtain the Left Right matrices of the decomposition and the two pivot permutation matrices
+# the original is M = PL*L*R*PR
+sub L {
+ my $matrix = shift;
+ my $rows = $matrix->[1];
+ my $cols = $rows;
+ my $L_matrix = new Matrix($rows,$cols);
+ for (my $i=0; $i<$rows;$i++) {
+ for(my $j=0;$j<$i;$j++) {
+ $L_matrix->[0][$i][$j] = $matrix->[0][$i][$j];
+ }
+ $L_matrix->[0][$i][$i]= 1;
+ }
+ $L_matrix;
+}
+sub R {
+ my $matrix = shift;
+ my $rows = $matrix->[1];
+ my $cols = $matrix->[2];
+ my $R_matrix = new Matrix($rows,$cols);
+ for (my $i=0; $i<$rows;$i++) {
+ for(my $j=$i;$j<$cols;$j++) {
+ $R_matrix->[0][$i][$j] = $matrix->[0][$i][$j];
+ }
+ }
+ $R_matrix;
+}
+sub PL { # use this permuation on the left PL*L*R*PR =M
+ my $matrix = shift;
+ my $rows = $matrix->[1];
+ my $cols = $rows;
+ my $PL_matrix = new Matrix($rows,$cols); #rows=cols
+ for (my $j=0; $j<$cols;$j++) {
+ $PL_matrix->[0][$matrix->[4][$j]][$j]=1;
+ }
+ $PL_matrix;
+}
+
+sub PR { # use this permuation on the right PL*L*R*PR =M
+ my $matrix = shift;
+ my $cols = $matrix->[2];
+ my $rows = $cols;
+ my $PR_matrix = new Matrix($rows,$cols); #rows=cols
+ for (my $i=0; $i<$rows;$i++) {
+ $PR_matrix->[0][$i][$matrix->[5][$i]]=1;
+ }
+ $PR_matrix;
+
+}
+# obtain the Left Right matrices of the decomposition and the two pivot permutation matrices
+# the original is M = PL*L*R*PR
=head4
Method $matrix->rh_options
@@ -68,9 +126,9 @@
sub rh_options {
my $self = shift;
- my $last_element = $#$self;
- $self->[$last_element] = {} unless defined($self->[3]); # not sure why this needs to be done
- $self->[$last_element]; # provides a reference to the options hash MEG
+ my $rh_option = shift;
+ $self->[$MatrixReal1::OPTION_ENTRY] = $rh_option if defined $rh_option; # not sure why this needs to be done
+ $self->[$MatrixReal1::OPTION_ENTRY]; # provides a reference to the options hash MEG
}
=head4
@@ -414,36 +472,33 @@
my($rows,$cols) = ($matrix->[1],$matrix->[2]);
my($perm_row,$perm_col);
my($row,$col,$max);
-# my($i,$j,$k,$n); #MEG
my($i,$j,$k,);
my($sign) = 1;
my($swap);
my($temp);
+ my $rh_options = $matrix->[$MatrixReal1::OPTION_ENTRY];
# FIXEME Why won't this work on non-square matrices?
# croak "MatrixReal1::decompose_LR(): matrix is not quadratic"
# unless ($rows == $cols);
- croak "MatrixReal1::decompose_LR(): matrix has more rows than columns"
- unless ($rows <= $cols);
+# croak "MatrixReal1::decompose_LR(): matrix has more rows than columns"
+# unless ($rows <= $cols);
$temp = $matrix->new($rows,$cols);
$temp->copy($matrix);
# $n = $rows;
$perm_row = [ ];
$perm_col = [ ];
- for ( $i = 0; $i < $rows; $i++ ) #i is a row number
- {
- $perm_row->[$i] = $i;
- $perm_col->[$i] = $i;
- }
+ for ( my $i = 0; $i < $rows; $i++ ) { $perm_row->[$i] = $i;} #i is a row number
+ for (my $j=0;$j<$cols;$j++) { $perm_col->[$j] = $j; }
NONZERO:
for ( $k = 0; $k < $rows; $k++ ) # use Gauss's algorithm: #k is row number
{
# complete pivot-search:
$max = 0;
- for ( $i = $k; $i < $cols; $i++ ) # i is column number
+ for ( $i = $k; $i < $rows; $i++ ) # i is row number
{
- for ( $j = $k; $j < $cols; $j++ )
+ for ( $j = $k; $j < $cols; $j++ ) #j is a col number
{
if (($swap = abs($temp->[0][$i][$j])) > $max)
{
@@ -453,6 +508,7 @@
}
}
}
+ # warn "max is $max row is $row and col is $col and k is $k";
last NONZERO if ($max == 0); # (all remaining elements are zero)
if ($k != $row) # swap row $k and row $row:
{
@@ -470,7 +526,7 @@
}
}
if ($k != $col) # swap column $k and column $col:
- {
+ { my $swap; # localize variable MEG
$sign = -$sign;
$swap = $perm_col->[$k];
$perm_col->[$k] = $perm_col->[$col];
@@ -482,7 +538,7 @@
$temp->[0][$i][$col] = $swap;
}
}
- for ( $i = ($k + 1); $i < $cols; $i++ ) # i is column number
+ for (my $i = ($k + 1); $i < $rows; $i++ ) # i is row number
{
# scan the remaining rows, add multiples of row $k to row $i:
@@ -491,22 +547,21 @@
{
# calculate a row of matrix R:
- for ( $j = ($k + 1); $j < $cols; $j++ ) #j is also a column number
+ for (my $j = ($k + 1); $j < $cols; $j++ ) #j is a column number
{
$temp->[0][$i][$j] -= $temp->[0][$k][$j] * $swap;
}
# store matrix L in same matrix as R:
-
$temp->[0][$i][$k] = $swap;
}
}
}
- my $rh_options = $temp->[3];
+ #my $rh_options = $temp->[3];
$temp->[3] = $sign;
$temp->[4] = $perm_row;
$temp->[5] = $perm_col;
- $temp->[6] = $temp->[3];
+ $temp->[$MatrixReal1::OPTION_ENTRY] = $rh_options;
return($temp);
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-07-13 01:26:15
|
Log Message:
-----------
Made modifications that allow the use of complex numbers in matrices
Modified Files:
--------------
pg/lib:
MatrixReal1.pm
Revision Data
-------------
Index: MatrixReal1.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/MatrixReal1.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/MatrixReal1.pm -Llib/MatrixReal1.pm -u -r1.1 -r1.2
--- lib/MatrixReal1.pm
+++ lib/MatrixReal1.pm
@@ -25,6 +25,7 @@
%EXPORT_TAGS = (all => [@EXPORT_OK]);
$VERSION = '1.3a5';
+$MatrixReal1::OPTION_ENTRY=7;
use Carp;
@@ -75,8 +76,9 @@
if ($cols <= 0);
# $this = [ [ ], $rows, $cols ];
- $this = [ [ ], $rows, $cols,{} ]; # added a holder for options MEG
- # see also modifications to LR decomposition
+ $this = [ [ ], $rows, $cols ];
+ $this->[$MatrixReal1::OPTION_ENTRY] = {}; # added a holder for options MEG
+ # see also modifications to LR decomposition
# Creates first empty row
my $empty = [ ];
@@ -254,18 +256,18 @@
return($temp);
}
-sub _undo_LR
+sub _undo_LR # I don't think gives original matrix. LR is not the same as the original matrix
{
croak "Usage: \$matrix->_undo_LR();"
if (@_ != 1);
my($this) = @_;
- my $rh_options = $this->[6];
+ my $rh_options = $this->[$MatrixReal1::OPTION_ENTRY];
undef $this->[3];
undef $this->[4];
undef $this->[5];
undef $this->[6];
- $this->[3] = $rh_options;
+ $this->[$MatrixReal1::OPTION_ENTRY] = $rh_options;
}
sub zero
@@ -530,9 +532,9 @@
$matrix1->_undo_LR();
- for ( $i = 0; $i < $rows1; $i++ )
+ for ( my $i = 0; $i < $rows1; $i++ )
{
- for ( $j = 0; $j < $cols1; $j++ )
+ for ( my $j = 0; $j < $cols1; $j++ )
{
$matrix1->[0][$i][$j] = $matrix2->[0][$i][$j] * $scalar;
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-07-12 22:43:18
|
Log Message:
-----------
Make error messages potentially localizable (by making them use
sprintf-style strings rather than variable subtitution).
Modified Files:
--------------
pg/macros:
contextLimitedNumeric.pl
contextLimitedPoint.pl
contextLimitedPolynomial.pl
contextLimitedVector.pl
contextString.pl
parserImplicitPlane.pl
parserMultiPart.pl
parserParametricLine.pl
parserSolutionFor.pl
Revision Data
-------------
Index: parserParametricLine.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserParametricLine.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -Lmacros/parserParametricLine.pl -Lmacros/parserParametricLine.pl -u -r1.3 -r1.4
--- macros/parserParametricLine.pl
+++ macros/parserParametricLine.pl
@@ -80,7 +80,7 @@
Value::Error("A line can't be just a constant vector") unless $t;
$p = Value::Point->new($line->eval($t=>0));
$v = Value::Vector->new($line->eval($t=>1) - $p);
- Value::Error("Your formula isn't linear in the variable $t")
+ Value::Error("Your formula isn't linear in the variable %s",$t)
unless $line == $p + Value::Formula->new($t) * $v;
}
Value::Error("The direction vector for a parametric line can't be the zero vector")
Index: contextLimitedPoint.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedPoint.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextLimitedPoint.pl -Lmacros/contextLimitedPoint.pl -u -r1.1 -r1.2
--- macros/contextLimitedPoint.pl
+++ macros/contextLimitedPoint.pl
@@ -26,7 +26,7 @@
&{$super."::_check"}($self);
return if $self->checkNumbers;
my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("In this context, '$bop' can only be used with Numbers");
+ $self->Error("In this context, '%s' can only be used with Numbers",$bop);
}
##############################################
@@ -69,7 +69,7 @@
&{$super."::_check"}($self);
return if $self->checkNumber;
my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("In this context, '$uop' can only be used with Numbers");
+ $self->Error("In this context, '%s' can only be used with Numbers",$uop);
}
##############################################
Index: contextString.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextString.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextString.pl -Lmacros/contextString.pl -u -r1.1 -r1.2
--- macros/contextString.pl
+++ macros/contextString.pl
@@ -26,7 +26,7 @@
my @strings = grep {not defined($context->strings->get($_)->{alias})}
$context->strings->names;
my $strings = join(', ',@strings[0..$#strings-1]).' or '.$strings[-1];
- $equation->Error("Your answer should be one of $strings");
+ $equation->Error("Your answer should be one of %s",$strings);
}
package contextString::Formula;
Index: parserMultiPart.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserMultiPart.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/parserMultiPart.pl -Lmacros/parserMultiPart.pl -u -r1.1 -r1.2
--- macros/parserMultiPart.pl
+++ macros/parserMultiPart.pl
@@ -132,7 +132,7 @@
sub new {
my $self = shift; my $class = ref($self) || $self;
my @data = @_; my @cmp;
- Value::Error($class." lists can't be empty") if scalar(@data) == 0;
+ Value::Error("%s lists can't be empty",$class) if scalar(@data) == 0;
foreach my $x (@data) {
$x = Value::makeValue($x) unless Value::isValue($x);
push(@cmp,$x->cmp(@ans_defaults));
Index: contextLimitedNumeric.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedNumeric.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextLimitedNumeric.pl -Lmacros/contextLimitedNumeric.pl -u -r1.1 -r1.2
--- macros/contextLimitedNumeric.pl
+++ macros/contextLimitedNumeric.pl
@@ -22,7 +22,7 @@
my $self = shift;
$self->SUPER::_check;
my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("Can't use '$uop' in this context")
+ $self->Error("Can't use '%s' in this context",$uop)
unless $self->{op}->class eq 'Number';
}
Index: parserImplicitPlane.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserImplicitPlane.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -Lmacros/parserImplicitPlane.pl -Lmacros/parserImplicitPlane.pl -u -r1.5 -r1.6
--- macros/parserImplicitPlane.pl
+++ macros/parserImplicitPlane.pl
@@ -99,7 +99,7 @@
$vars = shift || [$$Value::context->variables->names];
$vars = [$vars] unless ref($vars) eq 'ARRAY';
$type = 'line' if scalar(@{$vars}) == 2;
- Value::Error("Your formula doesn't look like an implicit $type")
+ Value::Error("Your formula doesn't look like an implicit %s",$type)
unless $plane->type eq 'Equality';
#
# Find the coefficients of the formula
@@ -120,7 +120,7 @@
unless (Value::Formula->new($plane->{tree}{lop}) -
Value::Formula->new($plane->{tree}{rop})) == $f;
}
- Value::Error("The equation of a $type must be non-zero somewhere")
+ Value::Error("The equation of a %s must be non-zero somewhere",$type)
if ($N->norm == 0);
$plane->{d} = $d; $plane->{N} = $N; $plane->{implicit} = $type;
$plane->{isValue} = $plane->{isFormula} = 1;
Index: contextLimitedVector.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedVector.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextLimitedVector.pl -Lmacros/contextLimitedVector.pl -u -r1.1 -r1.2
--- macros/contextLimitedVector.pl
+++ macros/contextLimitedVector.pl
@@ -47,9 +47,9 @@
return if $self->checkVectors;
}
my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("In this context, '$bop' can only be used with Numbers")
+ $self->Error("In this context, '%s' can only be used with Numbers",$bop)
if $self->{equation}{context}{flags}{vector_format} eq 'coordinate';
- $self->Error("In this context, '$bop' can only be used with Numbers or i,j and k");
+ $self->Error("In this context, '%s' can only be used with Numbers or i,j and k",$bop);
}
#
@@ -74,7 +74,7 @@
$self->{ijk}{$x} = $self->{ijk}{$x} || $op->{ijk}{$x};
}
}
- Value::Error("The constant '$duplicate' may appear only once in your formula")
+ Value::Error("The constant '%s' may appear only once in your formula",$duplicate)
if $duplicate;
}
@@ -125,7 +125,7 @@
sub checkVectors {
my $self = shift;
my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("In this context, '$bop' can only be used with Numbers");
+ $self->Error("In this context, '%s' can only be used with Numbers",$bop);
}
##############################################
@@ -146,9 +146,9 @@
return if $self->checkVector;
}
my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("In this context, '$uop' can only be used with Numbers")
+ $self->Error("In this context, '%s' can only be used with Numbers",$uop)
if $self->{equation}{context}{flags}{vector_format} eq 'coordinate';
- $self->Error("In this context, '$uop' can only be used with Numbers or i,j and k");
+ $self->Error("In this context, '%s' can only be used with Numbers or i,j and k",$uop);
}
sub checkVector {return 0}
Index: contextLimitedPolynomial.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextLimitedPolynomial.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/contextLimitedPolynomial.pl -Lmacros/contextLimitedPolynomial.pl -u -r1.1 -r1.2
--- macros/contextLimitedPolynomial.pl
+++ macros/contextLimitedPolynomial.pl
@@ -178,7 +178,7 @@
&{$super."::_check"}($self);
my $op = $self->{op};
return if LimitedPolynomail::isConstant($op);
- $self->Error("You can only use '$self->{def}{string}' with monomials")
+ $self->Error("You can only use '%s' with monomials",$self->{def}{string})
if $op->{isPoly};
$self->{isPoly} = 2;
$self->{powers} = {%{$op->{powers}}} if $op->{powers};
@@ -226,7 +226,7 @@
&{$super."::_check"}($self);
my $arg = $self->{params}->[0];
return if LimitedPolynomial::isConstant($arg);
- $self->Error("Function '$self->{name}' can only be used with numbers");
+ $self->Error("Function '%s' can only be used with numbers",$self->{name});
}
Index: parserSolutionFor.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserSolutionFor.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/parserSolutionFor.pl -Lmacros/parserSolutionFor.pl -u -r1.1 -r1.2
--- macros/parserSolutionFor.pl
+++ macros/parserSolutionFor.pl
@@ -103,7 +103,7 @@
#
# Make sure professor's answer actually works
#
- Value::Error("Professor's answer of ".$p->string." does not satisfy the given equation")
+ Value::Error("Professor's answer of %s does not satisfy the given equation",$p->string)
unless $p->f($p);
#
|
|
From: dpvc v. a. <we...@ma...> - 2005-07-12 22:33:51
|
Log Message:
-----------
A first pass at making parser error messages localizable. The
Context()->{error}{msg} hash can be used to specify translations of
the standard messages. For example,
Context()->{error}{msg}{'Division by zero'} = "Don't divide by zero, dude!";
Context()->{error}{msg}{'Function '%s' has too many inputs'} =
"You passed too many arguments to '%s'";
(I didn't translate into another language, here, but you could do
that, too.)
The msg hash could also be used within answer checkers to make certain
answer messages more appropriate for the given type of expected answer.
Modified Files:
--------------
pg/lib:
Parser.pm
Value.pm
pg/lib/Parser:
BOP.pm
Context.pm
Differentiation.pm
Function.pm
Item.pm
List.pm
UOP.pm
Value.pm
Variable.pm
pg/lib/Parser/BOP:
equality.pm
undefined.pm
underscore.pm
union.pm
pg/lib/Parser/Context:
Variables.pm
pg/lib/Parser/Function:
complex.pm
hyperbolic.pm
numeric.pm
numeric2.pm
trig.pm
undefined.pm
vector.pm
pg/lib/Parser/Legacy:
LimitedNumeric.pm
NumberWithUnits.pm
pg/lib/Parser/List:
AbsoluteValue.pm
pg/lib/Parser/UOP:
undefined.pm
pg/lib/Value:
AnswerChecker.pm
Complex.pm
Context.pm
Formula.pm
Infinity.pm
Interval.pm
Matrix.pm
Point.pm
Real.pm
String.pm
Vector.pm
pg/lib/Value/Context:
Data.pm
Revision Data
-------------
Index: union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/union.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Parser/BOP/union.pm -Llib/Parser/BOP/union.pm -u -r1.5 -r1.6
--- lib/Parser/BOP/union.pm
+++ lib/Parser/BOP/union.pm
@@ -23,7 +23,7 @@
$self->{$op}->typeRef->{name} = $self->{equation}{context}{parens}{interval}{type};
}
}
- } else {$self->Error("Operands of '$self->{bop}' must be intervals")}
+ } else {$self->Error("Operands of '%s' must be intervals",$self->{bop})}
}
Index: undefined.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/undefined.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/BOP/undefined.pm -Llib/Parser/BOP/undefined.pm -u -r1.3 -r1.4
--- lib/Parser/BOP/undefined.pm
+++ lib/Parser/BOP/undefined.pm
@@ -13,7 +13,7 @@
sub _check {
my $self = shift;
my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("Can't use '$bop' in this context");
+ $self->Error("Can't use '%s' in this context",$bop);
}
#########################################################################
Index: underscore.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/underscore.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/BOP/underscore.pm -Llib/Parser/BOP/underscore.pm -u -r1.6 -r1.7
--- lib/Parser/BOP/underscore.pm
+++ lib/Parser/BOP/underscore.pm
@@ -59,7 +59,7 @@
$M,$parser->{Value}->new($equation,@index))
}
my $i = shift(@index); $i-- if $i > 0;
- $self->Error("Can't extract element number '$i' (index must be an integer)")
+ $self->Error("Can't extract element number '%s' (index must be an integer)",$i)
unless $i =~ m/^-?\d+$/;
$M = $M->{coords}[$i];
return $parser->{Value}->new($equation,Value::List->new()) unless $M;
Index: equality.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/equality.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/BOP/equality.pm -Llib/Parser/BOP/equality.pm -u -r1.4 -r1.5
--- lib/Parser/BOP/equality.pm
+++ lib/Parser/BOP/equality.pm
@@ -13,7 +13,7 @@
my $self = shift; my $name = $self->{def}{string} || $self->{bop};
$self->Error("Only one equality is allowed in an equation")
if ($self->{lop}->type eq 'Equality' || $self->{rop}->type eq 'Equality');
- $self->Error("Operands of '$name' must be Numbers") unless $self->checkNumbers();
+ $self->Error("Operands of '%s' must be Numbers",$name) unless $self->checkNumbers();
$self->{type} = Value::Type('Equality',1); # Make it not a number, to get errors with other operations.
}
Index: Variables.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Variables.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/Context/Variables.pm -Llib/Parser/Context/Variables.pm -u -r1.7 -r1.8
--- lib/Parser/Context/Variables.pm
+++ lib/Parser/Context/Variables.pm
@@ -57,7 +57,7 @@
} elsif ($value =~ m/$self->{context}{pattern}{signedNumber}/) {
$value = $type{'Real'};
} else {
- Value::Error("Unrecognized variable type '$value'");
+ Value::Error("Unrecognized variable type '%s'",$value);
}
return {type => $value, @extra};
}
Index: numeric.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/numeric.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/Function/numeric.pm -Llib/Parser/Function/numeric.pm -u -r1.3 -r1.4
--- lib/Parser/Function/numeric.pm
+++ lib/Parser/Function/numeric.pm
@@ -26,8 +26,8 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 1;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) == 0;
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 1;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) == 0;
my $n = $_[0];
return $self->$name($n) if Value::matchNumber($n);
(Value::Complex::promote($n))->$name;
Index: vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/vector.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Parser/Function/vector.pm -Llib/Parser/Function/vector.pm -u -r1.2 -r1.3
--- lib/Parser/Function/vector.pm
+++ lib/Parser/Function/vector.pm
@@ -28,8 +28,8 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 1;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) == 0;
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 1;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) == 0;
my $v = Value::Vector::promote($_[0]);
$v->$name;
}
Index: trig.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/trig.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Parser/Function/trig.pm -Llib/Parser/Function/trig.pm -u -r1.2 -r1.3
--- lib/Parser/Function/trig.pm
+++ lib/Parser/Function/trig.pm
@@ -26,8 +26,8 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 1;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) == 0;
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 1;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) == 0;
my $n = $_[0];
return $self->$name($n) if Value::matchNumber($n);
(Value::Complex::promote($n))->$name;
Index: hyperbolic.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/hyperbolic.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Parser/Function/hyperbolic.pm -Llib/Parser/Function/hyperbolic.pm -u -r1.2 -r1.3
--- lib/Parser/Function/hyperbolic.pm
+++ lib/Parser/Function/hyperbolic.pm
@@ -26,8 +26,8 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 1;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) == 0;
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 1;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) == 0;
my $n = $_[0];
return $self->$name($n) if Value::matchNumber($n);
(Value::Complex::promote($n))->$name;
Index: undefined.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/undefined.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/Function/undefined.pm -Llib/Parser/Function/undefined.pm -u -r1.4 -r1.5
--- lib/Parser/Function/undefined.pm
+++ lib/Parser/Function/undefined.pm
@@ -12,12 +12,12 @@
sub _check {
my $self = shift;
- $self->Error("Function '$self->{name}' is not allowed in this context");
+ $self->Error("Function '%s' is not allowed in this context",$self->{name});
}
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' is not allowed in this context");
+ Value::Error("Function '%s' is not allowed in this context",$name);
}
#########################################################################
Index: numeric2.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/numeric2.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Parser/Function/numeric2.pm -Llib/Parser/Function/numeric2.pm -u -r1.2 -r1.3
--- lib/Parser/Function/numeric2.pm
+++ lib/Parser/Function/numeric2.pm
@@ -16,7 +16,7 @@
!$self->{params}->[0]->isComplex && !$self->{params}->[1]->isComplex) {
$self->{type} = $Value::Type{number};
} else {
- $self->Error("Function '$self->{name}' has the wrong type of inputs");
+ $self->Error("Function '%s' has the wrong type of inputs",$self->{name});
}
}
@@ -25,9 +25,9 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 2;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) < 2;
- Value::Error("Function '$name' has the wrong type of inputs")
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 2;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) < 2;
+ Value::Error("Function '%s' has the wrong type of inputs",$name)
unless Value::matchNumber($_[0]) && Value::matchNumber($_[1]);
return $self->$name(@_);
}
Index: complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function/complex.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/Function/complex.pm -Llib/Parser/Function/complex.pm -u -r1.3 -r1.4
--- lib/Parser/Function/complex.pm
+++ lib/Parser/Function/complex.pm
@@ -32,8 +32,8 @@
#
sub _call {
my $self = shift; my $name = shift;
- Value::Error("Function '$name' has too many inputs") if scalar(@_) > 1;
- Value::Error("Function '$name' has too few inputs") if scalar(@_) == 0;
+ Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 1;
+ Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) == 0;
my $c = Value::Complex::promote($_[0]);
$c->$name;
}
Index: AbsoluteValue.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List/AbsoluteValue.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/List/AbsoluteValue.pm -Llib/Parser/List/AbsoluteValue.pm -u -r1.3 -r1.4
--- lib/Parser/List/AbsoluteValue.pm
+++ lib/Parser/List/AbsoluteValue.pm
@@ -16,7 +16,7 @@
$self->Error("Only one value allowed within absolute values")
if ($self->{type}{length} != 1);
my $arg = $self->{coords}[0];
- $self->Error("Absolute value can't be taken of ".$arg->type)
+ $self->Error("Absolute value can't be taken of %s",$arg->type)
unless ($arg->type =~ /Number|Point|Vector/);
$self->{type} = $Value::Type{number};
}
Index: undefined.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP/undefined.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/UOP/undefined.pm -Llib/Parser/UOP/undefined.pm -u -r1.3 -r1.4
--- lib/Parser/UOP/undefined.pm
+++ lib/Parser/UOP/undefined.pm
@@ -13,7 +13,7 @@
sub _check {
my $self = shift;
my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("Can't use '$uop' in this context");
+ $self->Error("Can't use '%s' in this context",$uop);
}
#########################################################################
Index: Real.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Real.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Value/Real.pm -Llib/Value/Real.pm -u -r1.16 -r1.17
--- lib/Value/Real.pm
+++ lib/Value/Real.pm
@@ -40,7 +40,7 @@
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
return $x if ref($x) eq $pkg;
$x = [$x] unless ref($x) eq 'ARRAY';
- Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to ".Value::showClass($class))
+ Value::Error("Can't convert ARRAY of length %d to %s",scalar(@{$x}),Value::showClass($class))
unless (scalar(@{$x}) == 1);
if (Value::isRealNumber($x->[0])) {
return $self->formula($x->[0]) if Value::isFormula($x->[0]);
@@ -48,7 +48,7 @@
}
$x = Value::makeValue($x->[0]);
return $x if Value::isRealNumber($x);
- Value::Error("Can't convert ".Value::showClass($x)." to ".Value::showClass($class));
+ Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($class));
}
#
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Complex.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Value/Complex.pm -Llib/Value/Complex.pm -u -r1.16 -r1.17
--- lib/Value/Complex.pm
+++ lib/Value/Complex.pm
@@ -42,13 +42,13 @@
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
$x = $x->data if ref($x) eq $pkg || Value::isReal($x);
$x = [$x] unless ref($x) eq 'ARRAY'; $x->[1] = 0 unless defined($x->[1]);
- Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to a Complex Number")
+ Value::Error("Can't convert ARRAY of length %d to a Complex Number",scalar(@{$x}))
unless (scalar(@{$x}) == 2);
$x->[0] = Value::makeValue($x->[0]); $x->[1] = Value::makeValue($x->[1]);
return $x->[0] if Value::isComplex($x->[0]) && scalar(@_) == 0;
- Value::Error("Real part can't be ".Value::showClass($x->[0]))
+ Value::Error("Real part can't be %s",Value::showClass($x->[0]))
unless (Value::isRealNumber($x->[0]));
- Value::Error("Imaginary part can't be ".Value::showClass($x->[1]))
+ Value::Error("Imaginary part can't be %s",Value::showClass($x->[1]))
unless (Value::isRealNumber($x->[1]));
return $self->formula($x) if Value::isFormula($x->[0]) || Value::isFormula($x->[1]);
bless {data => $x}, $class;
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Value/Context.pm -Llib/Value/Context.pm -u -r1.4 -r1.5
--- lib/Value/Context.pm
+++ lib/Value/Context.pm
@@ -26,6 +26,7 @@
pos => undef,
message => '',
flag => 0,
+ msg => {}, # for localization
},
data => {
hashes => ['lists'],
@@ -100,6 +101,7 @@
$error->{string} = '';
$error->{pos} = undef;
$error->{message} = '';
+ $error->{original} = '';
$error->{flag} = 0;
}
@@ -108,9 +110,17 @@
#
sub setError {
my $error = (shift)->{error};
- $error->{message} = shift;
- $error->{string} = shift;
- $error->{pos} = shift;
+ my ($message,$string,$pos,$more) = @_;
+ my @args = ();
+ ($message,@args) = @{$message} if ref($message) eq 'ARRAY';
+ $error->{original} = $message;
+ while ($message && $error->{msg}{$message}) {$message = $error->{msg}{$message}}
+ while ($more && $error->{msg}{$more}) {$more = $error->{msg}{$more}}
+ $message = sprintf($message,@args) if scalar(@args) > 0;
+ $message .= sprintf($more,$pos->[0]+1) if $more;
+ $error->{message} = $message;
+ $error->{string} = $string;
+ $error->{pos} = $string;
$error->{flag} = 1;
}
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/String.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/String.pm -Llib/Value/String.pm -u -r1.6 -r1.7
--- lib/Value/String.pm
+++ lib/Value/String.pm
@@ -25,7 +25,7 @@
my $strings = $$Value::context->{strings};
if (!$strings->{$x}) {
my $X = $strings->{uc($x)};
- Value::Error("String constant '$x' is not defined in this context")
+ Value::Error("String constant '%s' is not defined in this context",$x)
unless $X && !$X->{caseSensitive};
$x = uc($x); while ($strings->{$x}{alias}) {$x = $strings->{$x}{alias}}
}
Index: Infinity.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Infinity.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Value/Infinity.pm -Llib/Value/Infinity.pm -u -r1.7 -r1.8
--- lib/Value/Infinity.pm
+++ lib/Value/Infinity.pm
@@ -46,7 +46,7 @@
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
$x = Value::makeValue($x);
return $x if ref($x) eq $pkg || Value::isReal($x);
- Value::Error("Can't convert '$x' to Infinity");
+ Value::Error("Can't convert '%s' to Infinity",$x);
}
############################################
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Vector.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/Value/Vector.pm -Llib/Value/Vector.pm -u -r1.17 -r1.18
--- lib/Value/Vector.pm
+++ lib/Value/Vector.pm
@@ -48,7 +48,7 @@
foreach my $x (@{$p}) {
$x = Value::makeValue($x);
$isFormula = 1 if Value::isFormula($x);
- Value::Error("Coordinate of Vector can't be ".Value::showClass($x))
+ Value::Error("Coordinate of Vector can't be %s",Value::showClass($x))
unless Value::isNumber($x);
}
}
@@ -73,7 +73,7 @@
return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
return $x if ref($x) eq $pkg;
return $pkg->make(@{$x->data}) if Value::class($x) eq 'Point';
- Value::Error("Can't convert ".Value::showClass($x)." to a Vector");
+ Value::Error("Can't convert %s to a Vector",Value::showClass($x));
}
############################################
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.48
retrieving revision 1.49
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.48 -r1.49
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -162,8 +162,8 @@
return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
- $$Value::context->setError("<I>An error occurred while checking your answer:</I>\n".
- '<DIV STYLE="margin-left:1em">'.$@.'</DIV>','');
+ $$Value::context->setError(["<I>An error occurred while checking your answer:</I>\n".
+ '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'');
$$Value::context->{error}{flag} = $CMP_ERROR;
warn "Please inform your instructor that an error occurred while checking your answer";
}
@@ -742,7 +742,7 @@
my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
my @d = $self->dimensions;
- Value::Error("Can't create ans_array for ".scalar(@d)."-dimensional matrix")
+ Value::Error("Can't create ans_array for %d-dimensional matrix",scalar(@d))
if (scalar(@d) > 2);
@d = (1,@d) if (scalar(@d) == 1);
$self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.30 -r1.31
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -227,7 +227,7 @@
$v = eval {&$f(@{$p},@zeros)};
if (!defined($v) && !$checkUndef) {
return unless $showError;
- Value::Error("Can't evaluate formula on test point (".join(',',@{$p}).")");
+ Value::Error("Can't evaluate formula on test point (%s)",join(',',@{$p}));
}
push @{$values}, (defined($v)? Value::makeValue($v): $UNDEF);
}
@@ -255,8 +255,8 @@
$v = eval {&$f(@{$p},@adapt)};
if (!defined($v)) {
return unless $showError;
- Value::Error("Can't evaluate formula on test point (".join(',',@{$p}).") ".
- "with parameters (".join(',',@adapt).")");
+ Value::Error("Can't evaluate formula on test point (%s) with parameters (%s)",
+ join(',',@{$p}),join(',',@adapt));
}
push @{$values}, Value::makeValue($v);
}
@@ -423,10 +423,10 @@
my @a; my $i = 0; my $max = Value::Real->new($l->getFlag('max_adapt',1E8));
foreach my $row (@{$B->[0]}) {
if (abs($row->[0]) > $max) {
- $l->Error("Constant of integration is too large: ".$row->[0]->string."\n".
- "(maximum allowed is ".$max->string.")") if ($params[$i] eq 'C0');
- $l->Error("Adaptive constant is too large: $params[$i] = ".$row->[0]->string."\n".
- "(maximum allowed is ".$max->string.")");
+ $l->Error("Constant of integration is too large: %s\n(maximum allowed is %s)",
+ $row->[0]->string,$max->string) if ($params[$i] eq 'C0');
+ $l->Error("Adaptive constant is too large: %s = %s\n(maximum allowed is %s)",
+ $params[$i],$row->[0]->string,$max->string);
}
push @a, $row->[0]; $i++;
}
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.18 -r1.19
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -140,7 +140,7 @@
return $pkg->new($open,@{$x->data},$close)
if Value::class($x) =~ m/^(Point|List)$/ && $x->length == 2 &&
($open eq '(' || $open eq '[') && ($close eq ')' || $close eq ']');
- Value::Error("Can't convert ".Value::showClass($x)." to an Interval");
+ Value::Error("Can't convert %s to an Interval",Value::showClass($x));
}
############################################
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Matrix.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -Llib/Value/Matrix.pm -Llib/Value/Matrix.pm -u -r1.19 -r1.20
--- lib/Value/Matrix.pm
+++ lib/Value/Matrix.pm
@@ -170,7 +170,7 @@
return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
return $x if ref($x) eq $pkg;
return $pkg->make(@{$x->data}) if Value::class($x) =~ m/Point|Vector/;
- Value::Error("Can't convert ".Value::showClass($x)." to a Matrix");
+ Value::Error("Can't convert %s to a Matrix",Value::showClass($x));
}
############################################
@@ -223,7 +223,7 @@
if (scalar(@dl) == 1) {@dl = (1,@dl); $l = $pkg->make($l)}
if (scalar(@dr) == 1) {@dr = (@dr,1); $r = $pkg->make($r)->transpose}
Value::Error("Can only multiply 2-dimensional matrices") if scalar(@dl) > 2 || scalar(@dr) > 2;
- Value::Error("Matices of dimensions $dl[0]x$dl[1] and $dr[0]x$dr[1] can't be multiplied")
+ Value::Error("Matices of dimensions %dx%d and %dx%d can't be multiplied",@dl,@dr)
unless ($dl[1] == $dr[0]);
#
# Do matrix multiplication
@@ -297,7 +297,7 @@
my $self = shift;
my @d = $self->dimensions;
if (scalar(@d) == 1) {@d = (1,@d); $self = $pkg->make($self)}
- Value::Error("Can't transpose ".scalar(@d)."-dimensional matrices") unless scalar(@d) == 2;
+ Value::Error("Can't transpose %d-dimensional matrices",scalar(@d)) unless scalar(@d) == 2;
my @M = (); my $M = $self->data;
foreach my $j (0..$d[1]-1) {
my @row = ();
Index: Point.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Point.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Llib/Value/Point.pm -Llib/Value/Point.pm -u -r1.15 -r1.16
--- lib/Value/Point.pm
+++ lib/Value/Point.pm
@@ -49,7 +49,7 @@
foreach my $x (@{$p}) {
$x = Value::makeValue($x);
$isFormula = 1 if Value::isFormula($x);
- Value::Error("Coordinate of Point can't be ".Value::showClass($x))
+ Value::Error("Coordinate of Point can't be %s",Value::showClass($x))
unless Value::isNumber($x);
}
}
@@ -64,7 +64,7 @@
my $x = shift;
return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
return $x if ref($x) eq $pkg;
- Value::Error("Can't convert ".Value::showClass($x)." to a Point");
+ Value::Error("Can't convert %s to a Point",Value::showClass($x));
}
############################################
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -Llib/Value.pm -Llib/Value.pm -u -r1.38 -r1.39
--- lib/Value.pm
+++ lib/Value.pm
@@ -147,7 +147,7 @@
return Value::String->make($x)
if (!$Parser::installed || $$Value::context->{strings}{$x});
return $x if !$params{makeFormula};
- Value::Error("String constant '$x' is not defined in this context")
+ Value::Error("String constant '%s' is not defined in this context",$x)
if $params{showError};
$x = Value::Formula->new($x);
$x = $x->eval if $x->isConstant;
@@ -233,7 +233,7 @@
elsif ($type eq 'Infinity') {$type = $Value::Type{infinity}}
elsif ($type eq 'value' || $type eq 'Formula') {$type = $value->typeRef}
elsif ($type eq 'unknown') {
- $equation->Error("Can't convert ".Value::showClass($value)." to a constant");
+ $equation->Error("Can't convert %s to a constant",Value::showClass($value));
} else {
$type = 'Value::'.$type, $value = $type->new(@{$value});
$type = $value->typeRef;
@@ -354,7 +354,7 @@
@indices = $_[0]->value if scalar(@_) == 1 && Value::isValue($_[0]);
while (scalar(@indices) > 0) {
$i = shift @indices; $i-- if $i > 0; $i = $i->value if Value::isValue($i);
- Value::Error("Can't extract element number '$i' (index must be an integer)")
+ Value::Error("Can't extract element number '%s' (index must be an integer)",$i)
unless $i =~ m/^-?\d+$/;
$M = $M->data->[$i];
}
@@ -382,9 +382,9 @@
my ($l,$r,$flag,$op) = @_;
my $call = $$context->{method}{$op};
if (defined($call) && $l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
- my $error = "Can't use '$op' with ".$l->class."-valued operands";
+ my $error = "Can't use '%s' with %s-valued operands";
$error .= " (use '**' for exponentiation)" if $op eq '^';
- Value::Error($error);
+ Value::Error($error,$op,$l->class);
}
#
@@ -489,7 +489,7 @@
sub reduce {shift}
sub ijk {
- Value::Error("Can't use method 'ijk' with objects of type '".(shift)->class."'");
+ Value::Error("Can't use method 'ijk' with objects of type '%s'",(shift)->class);
}
#
@@ -497,7 +497,9 @@
#
sub Error {
my $message = shift;
+ $message = [$message,@_] if (scalar(@_));
$$context->setError($message,'');
+ $message = $$context->{error}{message};
die $message . traceback() if $$context->{debug};
die $message . getCaller();
}
Index: Parser.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -Llib/Parser.pm -Llib/Parser.pm -u -r1.25 -r1.26
--- lib/Parser.pm
+++ lib/Parser.pm
@@ -106,7 +106,7 @@
/var/ and do {$self->Var($ref->[1]); last};
/fn/ and do {$self->Fn($ref->[1]); last};
/str/ and do {$self->Str($ref->[1]); last};
- /error/ and do {$self->Error("Unexpected character '$ref->[1]'",$ref); last};
+ /error/ and do {$self->Error(["Unexpected character '%s'",$ref->[1]],$ref); last};
}
return if ($self->{error});
}
@@ -139,14 +139,15 @@
#
sub Error {
my $self = shift; my $context = $self->{context};
- my $message = shift; my $ref = shift; my $string;
+ my $message = shift; my $ref = shift;
+ my $string; my $more = "";
if ($ref) {
- $message .= "; see position ".($ref->[2]+1)." of formula";
+ $more = "; see position %d of formula";
$string = $self->{string};
$ref = [$ref->[2],$ref->[3]];
}
- $context->setError($message,$string,$ref);
- die $message . Value::getCaller();
+ $context->setError($message,$string,$ref,$more);
+ die $context->{error}{message} . Value::getCaller();
}
#
@@ -247,9 +248,9 @@
$self->pushOperator($name,$op->{precedence},1);
} else {
my $top = $self->top;
- $self->Error("Function '$top->{name}' is missing its input(s)",$top->{ref});
+ $self->Error(["Function '%s' is missing its input(s)",$top->{name}],$top->{ref});
}
- } else {$self->Error("Missing operand before '$name'",$ref)}
+ } else {$self->Error(["Missing operand before '%s'",$name],$ref)}
}
}
@@ -324,8 +325,8 @@
if ($paren->{emptyOK} && $paren->{close} eq $type) {
$self->pushOperand($parser->{List}->new($self,[],1,$paren))
}
- elsif ($type eq 'start') {$self->Error("Missing close parenthesis for '$top->{value}'",$top->{ref})}
- elsif ($top->{value} eq 'start') {$self->Error("Extra close parenthesis '$type'",$ref)}
+ elsif ($type eq 'start') {$self->Error(["Missing close parenthesis for '%s'",$top->{value}],$top->{ref})}
+ elsif ($top->{value} eq 'start') {$self->Error(["Extra close parenthesis '%s'",$type],$ref)}
else {$top->{ref}[3]=$ref->[3]; $self->Error("Empty parentheses",$top->{ref})}
last;
};
@@ -352,9 +353,9 @@
$paren,$top->entryType,$open,$type));
} else {
my $prev = $self->prev;
- if ($type eq "start") {$self->Error("Missing close parenthesis for '$prev->{value}'",$prev->{ref})}
- elsif ($prev->{value} eq "start") {$self->Error("Extra close parenthesis '$type'",$ref)}
- else {$self->Error("Mismatched parentheses: '$prev->{value}' and '$type'",$ref)}
+ if ($type eq "start") {$self->Error(["Missing close parenthesis for '%s'",$prev->{value}],$prev->{ref})}
+ elsif ($prev->{value} eq "start") {$self->Error(["Extra close parenthesis '%s'",$type],$ref)}
+ else {$self->Error(["Mismatched parentheses: '%s' and '%s'",$prev->{value},$type],$ref)}
return;
}
last;
@@ -362,13 +363,13 @@
/fn/ and do {
my $top = $self->top;
- $self->Error("Function '$top->{name}' is missing its input(s)",$top->{ref});
+ $self->Error(["Function '%s' is missing its input(s)",$top->{name}],$top->{ref});
return;
};
/operator/ and do {
my $top = $self->top(); my $name = $top->{name}; $name =~ s/^u//;
- $self->Error("Missing operand after '$name'",$top->{ref});
+ $self->Error(["Missing operand after '%s'",$name],$top->{ref});
return;
};
}
@@ -562,7 +563,7 @@
my $self = shift;
$self->setValues(@_);
foreach my $x (keys %{$self->{values}}) {
- $self->Error("The value of '$x' can't be a formula")
+ $self->Error(["The value of '%s' can't be a formula",$x])
if Value::isFormula($self->{values}{$x});
}
Value::makeValue($self->{tree}->eval);
@@ -667,11 +668,11 @@
my $variables = $self->{context}{variables};
$self->{values} = {@_};
foreach my $x (keys %{$self->{values}}) {
- $self->Error("Undeclared variable '$x'") unless defined $variables->{$x};
+ $self->Error(["Undeclared variable '%s'",$x]) unless defined $variables->{$x};
$value = Value::makeValue($self->{values}{$x});
$value = Value::Formula->new($value) unless Value::isValue($value);
($value,$type) = Value::getValueType($self,$value);
- $self->Error("Variable '$x' should be of type $variables->{$x}{type}{name}")
+ $self->Error(["Variable '%s' should be of type %s",$x,$variables->{$x}{type}{name}])
unless Parser::Item::typeMatch($type,$variables->{$x}{type});
$self->{values}{$x} = $value;
}
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.12 -r1.13
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -28,7 +28,7 @@
return $parser->{Number}->new($equation,$value,$ref) if ($type eq 'Number');
return $parser->{Number}->new($equation,$value->{data},$ref)
if ($type eq 'value' && $value->class eq 'Complex');
- $equation->Error("Can't convert ".Value::showClass($value)." to a constant",$ref)
+ $equation->Error(["Can't convert %s to a constant",Value::showClass($value)],$ref)
if ($type eq 'unknown');
$type = 'Value::'.$type, $value = $type->new(@{$value}) unless $type eq 'value';
$type = $value->typeRef;
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.13 -r1.14
--- lib/Parser/List.pm
+++ lib/Parser/List.pm
@@ -42,7 +42,7 @@
if ($paren->{formList}) {$type->{name} = 'List'}
elsif ($type->{name} eq 'Point') {
$equation->Error("Entries in a Matrix must be of the same type and length")}
- else {$equation->Error("Entries in a $type->{name} must be of the same type")}
+ else {$equation->Error(["Entries in a %s must be of the same type",$type->{name}])}
}
}
$list = bless {
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/Parser/Context.pm -Llib/Parser/Context.pm -u -r1.12 -r1.13
--- lib/Parser/Context.pm
+++ lib/Parser/Context.pm
@@ -100,7 +100,7 @@
if (!ref($context)) {
my $name = $context;
$context = Parser::Context->get($contextTable,$context);
- Value::Error("Unknown context '$name'") unless defined($context);
+ Value::Error("Unknown context '%s'",$name) unless defined($context);
}
$contextTable->{current} = $context;
$Value::context = \$contextTable->{current};
Index: Differentiation.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Differentiation.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Parser/Differentiation.pm -Llib/Parser/Differentiation.pm -u -r1.5 -r1.6
--- lib/Parser/Differentiation.pm
+++ lib/Parser/Differentiation.pm
@@ -31,7 +31,7 @@
sub Item::D {
my $self = shift;
my $type = ref($self); $type =~ s/.*:://;
- $self->Error("Differentiation for '$type' is not implemented");
+ $self->Error("Differentiation for '%s' is not implemented",$type);
}
@@ -154,7 +154,7 @@
sub Parser::Function::D {
my $self = shift;
- $self->Error("Differentiation of '$self->{name}' not implemented");
+ $self->Error("Differentiation of '%s' not implemented",$self->{name});
}
sub Parser::Function::D_chain {
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.11 -r1.12
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -117,12 +117,12 @@
my $ltype = $self->{lop}->typeRef; my $rtype = $self->{rop}->typeRef;
my $name = $self->{def}{string} || $self->{bop};
if ($ltype->{name} eq 'String') {
- $self->Error("Operands of '$name' can't be ".
+ $self->Error("Operands of '%s' can't be %s",$name,
($self->{lop}{isInfinite}? 'infinities': 'words'));
return 1;
}
if ($rtype->{name} eq 'String') {
- $self->Error("Operands of '$name' can't be ".
+ $self->Error("Operands of '%s' can't be %s",$name,
($self->{rop}{isInfinite}? 'infinities': 'words'));
return 1;
}
@@ -137,7 +137,7 @@
my $ltype = $self->{lop}->typeRef; my $rtype = $self->{rop}->typeRef;
return 0 if ($ltype->{name} ne 'List' and $rtype->{name} ne 'List');
my $name = $self->{def}{string} || $self->{bop};
- $self->Error("Operands of '$name' can't be lists");
+ $self->Error("Operands of '%s' can't be lists",$name);
return 1;
}
@@ -170,7 +170,7 @@
if ($lc == $rr) {
my $rowType = Value::Type('Matrix',$rc,$Value::Type{number},formMatrix=>1);
$self->{type} = Value::Type('Matrix',$lr,$rowType,formMatrix=>1);
- } else {$self->Error("Matrix of dimensions ${lr}x${lc} and ${rr}x${rc} can't be multiplied")}
+ } else {$self->Error("Matrices of dimensions %dx%d and %dx%d can't be multiplied",$lr,$lc,$rr,$rc)}
} else {$self->Error("Matrices are too deep to be multiplied")}
}
@@ -204,8 +204,8 @@
my ($ltype,$rtype) = @_;
my ($op,$ref) = ($self->{bop});
if ($ltype->{name} eq $rtype->{name})
- {$self->Error("Operands for '$op' must be of the same length")}
- else {$self->Error("Operands for '$op' must be of the same type")}
+ {$self->Error("Operands for '%s' must be of the same length",$op)}
+ else {$self->Error("Operands for '%s' must be of the same type",$op)}
}
##################################################
Index: Variable.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Variable.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/Variable.pm -Llib/Parser/Variable.pm -u -r1.7 -r1.8
--- lib/Parser/Variable.pm
+++ lib/Parser/Variable.pm
@@ -20,11 +20,11 @@
my $string = substr($equation->{string},$ref->[2]);
if ($string =~ m/^([a-z][a-z]+)/i) {
$ref->[3] = $ref->[2]+length($1);
- $equation->Error("'$1' is not defined in this context",$ref);
+ $equation->Error(["'%s' is not defined in this context",$1],$ref);
}
- $equation->Error("Variable '$name' is not defined in this context",$ref);
+ $equation->Error(["Variable '%s' is not defined in this context",$name],$ref);
}
- $equation->Error("Variable '$name' is not defined in this context",$ref)
+ $equation->Error(["Variable '%s' is not defined in this context",$name],$ref)
if $equation->{context}{variables}{$name}{parameter} &&
$equation->{context}{flags}{no_parameters};
$equation->{variables}{$name} = 1;
@@ -64,7 +64,7 @@
my $self = shift;
my $value = $self->{equation}{values}{$self->{name}};
return $value if defined($value);
- $self->Error("No value given for variable '$self->{name}'");
+ $self->Error("No value given for variable '%s'",$self->{name});
}
#
Index: Function.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/Parser/Function.pm -Llib/Parser/Function.pm -u -r1.12 -r1.13
--- lib/Parser/Function.pm
+++ lib/Parser/Function.pm
@@ -41,7 +41,7 @@
foreach my $x (@{$self->{params}}) {push(@params,$x->eval)}
my $result = eval {$self->_eval(@params)};
return $result unless $@;
- $self->Error("Can't take $self->{name} of ".join(',',@params));
+ $self->Error("Can't take %s of %s",$self->{name},join(',',@params));
}
#
# Stub for sub-classes
@@ -103,14 +103,14 @@
my $self = shift; my $name = shift;
my $context = Parser::Context->current;
my $fn = $context->{functions}{$name};
- Value::Error("No definition for function '$name'") unless defined($fn);
+ Value::Error("No definition for function '%s'",$name) unless defined($fn);
my $isFormula = 0;
foreach my $x (@_) {return $self->formula($name,@_) if Value::isFormula($x)}
my $class = $fn->{class};
my $result = eval {$class->_call($name,@_)};
return $result unless $@;
Value::Error($context->{error}{message}) if $context->{error}{message};
- Value::Error("Can't take $name of ".join(',',@_));
+ Value::Error("Can't take %s of %s",$name,join(',',@_));
}
#
# Stub for sub-classes.
@@ -145,10 +145,10 @@
my $arg = $self->{params}->[0];
if ($arg->isComplex) {
if (!($self->{def}{nocomplex})) {$self->{type} = $Value::Type{complex}}
- else {$self->Error("Function '$self->{name}' doesn't accept Complex inputs")}
+ else {$self->Error("Function '%s' doesn't accept Complex inputs",$self->{name})}
} elsif ($arg->isNumber) {
$self->{type} = $Value::Type{number};
- } else {$self->Error("The input for '$self->{name}' must be a number")}
+ } else {$self->Error("The input for '%s' must be a number",$self->{name})}
}
#
@@ -159,7 +159,7 @@
return if ($self->checkArgCount(1));
if ($self->{params}->[0]->type =~ m/Point|Vector/) {
$self->{type} = $Value::Type{number};
- } else {$self->Error("Function '$self->{name}' requires a Vector input")}
+ } else {$self->Error("Function '%s' requires a Vector input",$self->{name})}
}
#
@@ -171,7 +171,7 @@
return if ($self->checkArgCount(1));
if ($self->{params}->[0]->isNumber) {
$self->{type} = $Value::Type{number};
- } else {$self->Error("Function '$self->{name}' requires a Complex input")}
+ } else {$self->Error("Function '%s' requires a Complex input",$self->{name})}
}
#
@@ -183,7 +183,7 @@
return if ($self->checkArgCount(1));
if ($self->{params}->[0]->isNumber) {
$self->{type} = $Value::Type{complex};
- } else {$self->Error("Function '$self->{name}' requires a Complex input")}
+ } else {$self->Error("Function '%s' requires a Complex input",$self->{name})}
}
##################################################
@@ -211,11 +211,11 @@
my $args = scalar(@{$self->{params}});
if ($args == $count) {
return 0 if ($count == 0 || $self->{params}->[0]->length > 0);
- $self->Error("Function '$name' requires a non-empty input list");
+ $self->Error("Function '%s' requires a non-empty input list",$name);
} elsif ($args < $count) {
- $self->Error("Function '$name' has too few inputs");
+ $self->Error("Function '%s' has too few inputs",$name);
} else {
- $self->Error("Function '$name' has too many inputs");
+ $self->Error("Function '%s' has too many inputs",$name);
}
return 1;
}
Index: Item.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Item.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/Item.pm -Llib/Parser/Item.pm -u -r1.6 -r1.7
--- lib/Parser/Item.pm
+++ lib/Parser/Item.pm
@@ -84,7 +84,7 @@
sub ijk {
my $self = shift;
- $self->Error("Can't use method 'ijk' with objects of type '".$self->type."'");
+ $self->Error("Can't use method 'ijk' with objects of type '%s'",$self->type);
}
#
@@ -107,8 +107,9 @@
#
sub Error {
my $self = shift;
- $self->{equation}->Error(@_,$self->{ref}) if defined($self->{equation});
- Parser->Error(@_);
+ my $message = shift; $message = [$message,@_] if scalar(@_) > 0;
+ $self->{equation}->Error($message,$self->{ref}) if defined($self->{equation});
+ Parser->Error($message);
}
#########################################################################
Index: UOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/Parser/UOP.pm -Llib/Parser/UOP.pm -u -r1.12 -r1.13
--- lib/Parser/UOP.pm
+++ lib/Parser/UOP.pm
@@ -97,7 +97,7 @@
my $type = $self->{op}->typeRef;
return 0 if ($type->{name} ne 'String');
my $name = $self->{def}{string} || $self->{uop};
- $self->Error("Operand of '$name' can't be ".
+ $self->Error("Operand of '%s' can't be %s",$name,
($self->{op}{isInfinite}? 'an infinity': 'a word'));
return 1;
}
@@ -110,7 +110,7 @@
my $type = $self->{op}->typeRef;
return 0 if ($type->{name} ne 'List');
my $name = $self->{def}{string} || $self->{uop};
- $self->Error("Operand of '$name' can't be a list");
+ $self->Error("Operand of '%s' can't be a list",$name);
return 1;
}
Index: LimitedNumeric.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Legacy/LimitedNumeric.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/Parser/Legacy/LimitedNumeric.pm -Llib/Parser/Legacy/LimitedNumeric.pm -u -r1.1 -r1.2
--- lib/Parser/Legacy/LimitedNumeric.pm
+++ lib/Parser/Legacy/LimitedNumeric.pm
@@ -22,7 +22,7 @@
my $self = shift;
$self->SUPER::_check;
my $uop = $self->{def}{string} || $self->{uop};
- $self->Error("You can only use '$uop' with (non-negative) numbers")
+ $self->Error("You can only use '%s' with (non-negative) numbers",$uop)
unless $self->{op}->class =~ /Number|DIVIDE/;
}
@@ -40,7 +40,7 @@
my $self = shift;
$self->SUPER::_check;
my $bop = $self->{def}{string} || $self->{bop};
- $self->Error("You can only use '$bop' between (non-negative) numbers")
+ $self->Error("You can only use '%s' between (non-negative) numbers",$bop)
unless $self->{lop}->class =~ /Number|MINUS/ &&
$self->{rop}->class eq 'Number';
}
Index: NumberWithUnits.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Legacy/NumberWithUnits.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/Parser/Legacy/NumberWithUnits.pm -Llib/Parser/Legacy/NumberWithUnits.pm -u -r1.1 -r1.2
--- lib/Parser/Legacy/NumberWithUnits.pm
+++ lib/Parser/Legacy/NumberWithUnits.pm
@@ -16,7 +16,7 @@
Value::Error("You must provide units for your number")
unless $units;
$num = Value::makeValue($num);
- Value::Error("A number with units must be a constant, not ".lc(Value::showClass($num)))
+ Value::Error("A number with units must be a constant, not %s",lc(Value::showClass($num)))
unless Value::isReal($num);
my %Units = getUnits($units);
Value::Error($Units{ERROR}) if ($Units{ERROR});
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.5 -r1.6
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -89,7 +89,7 @@
my $self = shift; my %D = (@_); return if scalar(@_) == 0;
my $data = $self->{context}{$self->{dataName}};
foreach my $x (keys %D) {
- Value::Error("Illegal $self->{name} name '$x'") unless $x =~ m/^$self->{namePattern}$/;
+ Value::Error("Illegal %s name '%s'",$self->{name},$x) unless $x =~ m/^$self->{namePattern}$/;
warn "$self->{Name} '$x' already exists" if defined($data->{$x});
$data->{$x} = $self->create($D{$x});
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-07-12 21:09:04
|
Log Message:
-----------
Fixed various perl compiler warnings (due to extra "my", and so on).
Modified Files:
--------------
pg/lib:
Parser.pm
pg/lib/Parser:
BOP.pm
String.pm
Value.pm
pg/lib/Parser/BOP:
equality.pm
multiply.pm
power.pm
underscore.pm
pg/lib/Value:
Complex.pm
Formula.pm
Union.pm
WeBWorK.pm
Revision Data
-------------
Index: Parser.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/Parser.pm -Llib/Parser.pm -u -r1.24 -r1.25
--- lib/Parser.pm
+++ lib/Parser.pm
@@ -643,7 +643,7 @@
$vars = [sort(keys %{$self->{variables}})] unless $vars;
my $n = scalar(@{$vars}); my $vnames = '';
if ($n > 0) {
- my @v = (); foreach my $x (@{$vars}) {push(@v,'$'.$x)}
+ my @v = (); foreach my $x (@{$vars}) {&push(@v,'$'.$x)}
$vnames = "my (".join(',',@v).") = \@_;";
}
my $fn = eval
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.10 -r1.11
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -279,7 +279,7 @@
($showparens eq 'all' || (($showparens eq 'extra' || $bop->{fullparens}) && $extraParens) ||
$precedence > $bop->{precedence} || ($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
$string = $self->{lop}->string($bop->{precedence},$bop->{leftparens},'left',$outerRight).
$bop->{string}.
@@ -301,7 +301,7 @@
(($showparens eq 'all' && $extraParens) || $precedence > $bop->{precedence} ||
($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
$TeX = $self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight).
(defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string}) .
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.11 -r1.12
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -31,7 +31,7 @@
$equation->Error("Can't convert ".Value::showClass($value)." to a constant",$ref)
if ($type eq 'unknown');
$type = 'Value::'.$type, $value = $type->new(@{$value}) unless $type eq 'value';
- my $type = $value->typeRef;
+ $type = $value->typeRef;
my $c = bless {
value => $value, type => $type, isConstant => 1,
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/String.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Parser/String.pm -Llib/Parser/String.pm -u -r1.8 -r1.9
--- lib/Parser/String.pm
+++ lib/Parser/String.pm
@@ -70,7 +70,7 @@
sub TeX {
my $self = shift;
return $self->{def}{TeX} if defined($self->{def}{TeX});
- my $value = $self->eval; $value =~ s/([ _])/\\\1/g;
+ my $value = $self->eval; $value =~ s/([ _])/\\$1/g;
return '{\rm '.$value.'}' unless Value::isValue($value);
return $value->TeX($self->{equation});
}
Index: power.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/power.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Parser/BOP/power.pm -Llib/Parser/BOP/power.pm -u -r1.8 -r1.9
--- lib/Parser/BOP/power.pm
+++ lib/Parser/BOP/power.pm
@@ -71,7 +71,7 @@
(($showparens eq 'all' && $extraParens) || $precedence > $bop->{precedence} ||
($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
my $symbol = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
if ($self->{lop}->class eq 'Function' && $self->{rop}->class eq 'Number' &&
Index: multiply.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/multiply.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Parser/BOP/multiply.pm -Llib/Parser/BOP/multiply.pm -u -r1.5 -r1.6
--- lib/Parser/BOP/multiply.pm
+++ lib/Parser/BOP/multiply.pm
@@ -87,7 +87,7 @@
($showparens eq 'all' || $precedence > $bop->{precedence} ||
($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
my $left = $self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight);
my $right = $self->{rop}->TeX($bop->{precedence},$bop->{rightparens},'right');
Index: underscore.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/underscore.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Parser/BOP/underscore.pm -Llib/Parser/BOP/underscore.pm -u -r1.5 -r1.6
--- lib/Parser/BOP/underscore.pm
+++ lib/Parser/BOP/underscore.pm
@@ -80,7 +80,7 @@
($showparens eq 'all' || $precedence > $bop->{precedence} ||
($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
my $symbol = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
$TeX = $self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight).
Index: equality.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/equality.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/BOP/equality.pm -Llib/Parser/BOP/equality.pm -u -r1.3 -r1.4
--- lib/Parser/BOP/equality.pm
+++ lib/Parser/BOP/equality.pm
@@ -61,7 +61,7 @@
defined($precedence) &&
($precedence > $bop->{precedence} || ($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
$string = $self->{lop}->string($bop->{precedence}).
$bop->{string}.
@@ -79,7 +79,7 @@
defined($precedence) &&
($precedence > $bop->{precedence} || ($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
- my $outerRight = !$addparens && ($outerRight || $position eq 'right');
+ $outerRight = !$addparens && ($outerRight || $position eq 'right');
$TeX = $self->{lop}->TeX($bop->{precedence}).
(defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string}) .
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Complex.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Llib/Value/Complex.pm -Llib/Value/Complex.pm -u -r1.15 -r1.16
--- lib/Value/Complex.pm
+++ lib/Value/Complex.pm
@@ -350,7 +350,7 @@
$b = Value::Real->make($b) unless ref($b);
my $bi = 'i';
return $a->$method($equation) if $b == 0;
- $bi = abs($b)->$method($equation,1) . 'i' if abs($b) ne 1;
+ $bi = CORE::abs($b)->$method($equation,1) . 'i' if CORE::abs($b) ne 1;
$bi = '-' . $bi if $b < 0;
return $bi if $a == 0;
$bi = '+' . $bi if $b > 0;
@@ -362,7 +362,7 @@
# Values for i and pi
#
$i = $pkg->make(0,1);
-$pi = 4*atan2(1,1);
+$pi = 4*CORE::atan2(1,1);
#
# So that we can use 1+3*i rather than 1+3*$i, etc.
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/WeBWorK.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/WeBWorK.pm -Llib/Value/WeBWorK.pm -u -r1.6 -r1.7
--- lib/Value/WeBWorK.pm
+++ lib/Value/WeBWorK.pm
@@ -80,7 +80,7 @@
useBaseTenLogs
);
-sub Value::Context::initCopy {
+sub Parser::Context::initCopy {
my $self = shift;
my $context = $self->copy(@_);
return $context if $context->{WW} && scalar(keys %{$context->{WW}}) > 0;
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.29 -r1.30
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -332,7 +332,7 @@
}
$userlimits = [] unless $userlimits; my @limits;
my $default; $default = $userlimits->[0][0] if defined($userlimits->[0]);
- my $default = $default || $self->{context}{flags}{limits} || [-2,2];
+ $default = $default || $self->{context}{flags}{limits} || [-2,2];
my $granularity = $self->getFlag('granularity',1000);
my $resolution = $self->getFlag('resolution');
my $i = 0;
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.13 -r1.14
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -23,7 +23,7 @@
#
sub new {
my $self = shift; my $class = ref($self) || $self;
- @_ = split("U",@_[0]) if scalar(@_) == 1 && !ref($_[0]);
+ @_ = split("U",$_[0]) if scalar(@_) == 1 && !ref($_[0]);
Value::Error("Unions must be of at least two intervals") unless scalar(@_) > 1;
my @intervals = (); my $isFormula = 0;
foreach my $xx (@_) {
|
|
From: dpvc v. a. <we...@ma...> - 2005-07-12 02:06:08
|
Log Message:
-----------
Fixed problem with minus signs in formulas that are turned into perl
mode. Perl needs extra spaces to avoid problems with -e type operators.
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.26
retrieving revision 1.27
diff -Llib/Parser/Context/Default.pm -Llib/Parser/Context/Default.pm -u -r1.26 -r1.27
--- lib/Parser/Context/Default.pm
+++ lib/Parser/Context/Default.pm
@@ -18,7 +18,7 @@
class => 'Parser::BOP::add'},
'-' => {precedence => 1, associativity => 'left', type => 'both', string => '-',
- class => 'Parser::BOP::subtract', rightparens => 'same'},
+ perl => '- ', class => 'Parser::BOP::subtract', rightparens => 'same'},
'><'=> {precedence => 2, associativity => 'left', type => 'bin',
string => ' >< ', TeX => '\times ', perl => ' x ', fullparens => 1,
@@ -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 => '-',
+ 'u-'=> {precedence => 6, associativity => 'left', type => 'unary', string => '-', perl => '- ',
class => 'Parser::UOP::minus', hidden => 1, allowInfinite => 1, nofractionparens => 1},
'^' => {precedence => 7, associativity => 'right', type => 'bin', string => '^', perl => '**',
|
|
From: Sam H. v. a. <we...@ma...> - 2005-07-12 00:56:27
|
Log Message:
-----------
added login logging and site_checkPassword support. closes bug #729. see
that bug for more information.
Modified Files:
--------------
webwork2/conf:
global.conf.dist
webwork2/lib/WeBWorK:
Authen.pm
Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v
retrieving revision 1.120
retrieving revision 1.121
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.120 -r1.121
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -381,6 +381,9 @@
# The answer log stores a history of all users' submitted answers.
$courseFiles{logs}{answer_log} = "$courseDirs{logs}/answer_log";
+# Log logins.
+$courseFiles{logs}{login_log} = "$courseDirs{logs}/login.log";
+
################################################################################
# More paths to external programs
################################################################################
Index: Authen.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Authen.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -Llib/WeBWorK/Authen.pm -Llib/WeBWorK/Authen.pm -u -r1.38 -r1.39
--- lib/WeBWorK/Authen.pm
+++ lib/WeBWorK/Authen.pm
@@ -26,6 +26,7 @@
use warnings;
use Apache::Cookie;
use Date::Format;
+use WeBWorK::Utils qw(writeCourseLog);
use constant COOKIE_LIFESPAN => 60*60*24*30; # 30 days
@@ -46,8 +47,62 @@
my $Password = $db->getPassword($userID); # checked
return 0 unless defined $Password;
+ # check against WW password database
my $possibleCryptPassword = crypt($possibleClearPassword, $Password->password());
- return $possibleCryptPassword eq $Password->password();
+ return 1 if $possibleCryptPassword eq $Password->password;
+
+ # check site-specific verification method
+ return 1 if $self->site_checkPassword($userID, $possibleClearPassword);
+
+ # fail by default
+ return 0;
+}
+
+# Site-specific password checking
+#
+# The site_checkPassword routine can be used to provide a hook to your institution's
+# authentication system. If authentication against the course's password database, the
+# method $self->site_checkPassword($userID, $clearTextPassword) is called. If this
+# method returns a true value, authentication succeeds.
+#
+# Here is an example site_checkPassword which checks the password against the Ohio State
+# popmail server:
+# sub site_checkPassword($$) {
+# my ($self, $userID, $clearTextPassword) = @_;
+# use Net::POP3;
+# my $pop = Net::POP3->new('pop.service.ohio-state.edu', Timeout => 60);
+# if ($pop->login($userID, $clearTextPassword)) {
+# return 1;
+# }
+# return 0;
+# }
+#
+# Since you have access to the WeBWorK::Authen object, the possibilities are limitless!
+# This example checks the password against the system password database and updates the
+# user's password in the course database if it succeeds:
+# sub site_checkPassword {
+# my ($self, $userID, $clearTextPassword) = @_;
+# my $realCryptPassword = (getpwnam $userID)[1] or return 0;
+# my $possibleCryptPassword = crypt($possibleClearPassword, $realCryptPassword); # user real PW as salt
+# if ($possibleCryptPassword eq $realCryptPassword) {
+# # update WeBWorK password
+# use WeBWorK::Utils qw(cryptPassword);
+# my $db = $self->{r}->db;
+# my $Password = $db->getPassword($userID);
+# my $pass = cryptPassword($clearTextPassword);
+# $Password->password($pass);
+# $db->putPassword($Password);
+# return 1;
+# } else {
+# return 0;
+# }
+# }
+#
+#
+# The default site_checkPassword always fails:
+sub site_checkPassword {
+ my ($self, $userID, $clearTextPassword) = @_;
+ return 0;
}
sub generateKey($$) {
@@ -177,6 +232,17 @@
$r->headers_out->set("Set-Cookie" => $cookie->as_string);
}
+sub record_login($$) {
+ my ($self, $userID) = @_;
+ my $r = $self->{r};
+ my $ce = $r->ce;
+ my $timestamp = localtime;
+ ($timestamp) = $timestamp =~ /^\w+\s(.*)\s/;
+ my $remote_host = $r->connection->remote_host;
+ my $user_agent = $r->header_in("User-Agent");
+ writeCourseLog($ce, "login_log", "$userID on $remote_host ($user_agent)");
+}
+
# verify will return 1 if the person is who they say the are. If the
# verification failed because of of invalid authentication data, a note will be
# written in the request explaining why it failed. If the request failed because
@@ -223,6 +289,7 @@
$r->param("user", $userID);
$r->param("key", $Key->key);
$found = 1;
+ $self->record_login($userID);
last;
}
}
@@ -375,6 +442,7 @@
$r->param("key", $Key->key());
# also delete the password
$r->param("passwd", "");
+ $self->record_login($user);
last VERIFY;
} else {
# incorrect password. fail.
|
|
From: jj v. a. <we...@ma...> - 2005-07-08 21:48:31
|
Log Message:
-----------
Fixed typo in installation instructions.
Modified Files:
--------------
pg/lib/Parser/Legacy:
README
Revision Data
-------------
Index: README
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Legacy/README,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/Parser/Legacy/README -Llib/Parser/Legacy/README -u -r1.1 -r1.2
--- lib/Parser/Legacy/README
+++ lib/Parser/Legacy/README
@@ -12,7 +12,7 @@
replace the PGanswermacros.pl file that is in pg/macros with the new
one that is in pg/lib/Parser/Legacy (perhaps renaming the old one as
PGanswermacros.pl-orig in case you want to go back to it). Then edit
-the global.conf file and add [qw(Parser::Legacy)] to the $pg{macros}
+the global.conf file and add [qw(Parser::Legacy)] to the $pg{modules}
list (this forces the loading of a few items needed by the new
PGanswermacros but that aren't loaded by default). Finally, restart
the server. Youre WW server should now be using Parser-based answer
|
2 messages has been excluded from this view by a project administrator.
