Menu
▾
▴
[WWcvs] webwork-modperl: Cosmetic change to pretty_print_rh
|
From: Mike G. v. a. <we...@ma...> - 2005-06-15 22:20:26
|
Log Message:
-----------
Cosmetic change to pretty_print_rh
Modified Files:
--------------
webwork-modperl/lib:
MySOAP.pm
RQP.pm
WebworkWebservice.pm
webwork-modperl/lib/WeBWorK:
Constants.pm
webwork-modperl/lib/WebworkWebservice:
RenderProblem.pm
Revision Data
-------------
Index: MySOAP.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/MySOAP.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/MySOAP.pm -Llib/MySOAP.pm -u -r1.1 -r1.2
--- lib/MySOAP.pm
+++ lib/MySOAP.pm
@@ -33,9 +33,6 @@
################
my %args_hash = $r->args;
if (exists $args_hash{wsdl}) {
- my $wsdl = `cat /home/gage/rqp.wsdl`;
- $r->content_type('application/wsdl+xml');
- $r->send_http_header;
$r->print( $wsdl);
print DEBUGLOG "----------start-------------\n";
print DEBUGLOG "handle wsdl request\n";
Index: RQP.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/RQP.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/RQP.pm -Llib/RQP.pm -u -r1.1 -r1.2
--- lib/RQP.pm
+++ lib/RQP.pm
@@ -13,6 +13,20 @@
@ISA = (SOAP::Server::Parameters);
local(*MYLOG);
+use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
+use RQP::Render;
+
+our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY;
+our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY;
+our $COURSENAME = $WebworkWebservice::COURSENAME;
+our $HOST_NAME = $WebworkWebservice::HOST_NAME;
+our $HOSTURL ="http://$HOST_NAME:8002"; #FIXME
+our $ce =$WebworkWebservice::SeedCE;
+# create a local course environment for some course
+ $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
+#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
+our $db = WeBWorK::DB->new($ce->{dbLayout});
+
#print MYLOG "restarting server\n\n";
sub test {
open MYLOG, ">>/home/gage/debug_info.txt" ;
@@ -93,10 +107,12 @@
local(*DEBUGLOG);
open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file";
print DEBUGLOG "--RQP_SessionInformation\n";
- my $templateVars = [];
+ my $templatevars = $rh_params->{templatevars};
+ $templatevars->{seed}=4321;
my $correctResponses = [];
$rh_out = {
- 'templateVars' => $templateVars,
+ 'outcomevars' => {id=>45},
+ 'templatevars' => $templatevars,
'correctResponses' => $correctResponses,
input => '<hr>'.WebworkWebservice::pretty_print_rh($rh_params).'<hr>',
};
@@ -106,29 +122,7 @@
sub RQP_Render {
- my $class = shift;
- my $soap_som = pop;
- my $rh_params= $soap_som->method;
- local(*DEBUGLOG);
- open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file";
- print DEBUGLOG "--RQP_Render\n";
- #my $output = WebworkWebservice::pretty_print_rh(\%parameters);
- my $source = $rh_params->{source};
- $source =~s/</</g;
- $source =~s/>/>/g;
- my $output = "the first element is ". $self. " and the last ". ref($envelope)."\n\n";
- $output .= WebworkWebservice::pretty_print_rh($rh_params);
- my $rh_out = {
- templateVars => [],
- persistentData => '',
- outcomeVars => [],
- output => $output,
- source => $source,
- input => '<hr>'.WebworkWebservice::pretty_print_rh($rh_params).'<hr>',
-
- };
- close(DEBUGLOG);
- return $rh_out;
+ RQP::Render::RQP_Render(@_);
}
Index: WebworkWebservice.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WebworkWebservice.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/WebworkWebservice.pm -Llib/WebworkWebservice.pm -u -r1.3 -r1.4
--- lib/WebworkWebservice.pm
+++ lib/WebworkWebservice.pm
@@ -63,7 +63,7 @@
if (defined($type) and $type) {
$out .= " type = $type; ";
} elsif ($rh == undef) {
- $out .= " type = UNDEFINED; ";
+ $out .= " type = scalar; ";
}
if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) {
$out .= "{\n";
@@ -240,14 +240,6 @@
package Filter;
-
-
-
-
-
-
-
-
sub is_hash_ref {
my $in =shift;
my $save_SIG_die_trap = $SIG{__DIE__};
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.24 -r1.25
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -54,7 +54,7 @@
# If non-empty, timing data will be sent to the file named rather than STDERR.
#
-$WeBWorK::Timing::Logfile = "";
+$WeBWorK::Timing::Logfile = "/home/gage/webwork2/logs/timing.log";
################################################################################
# WeBWorK::ContentGenerator::Hardcopy
@@ -75,7 +75,7 @@
# For dvipng >= 1.0
# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
#
-$WeBWorK::PG::ImageGenerator::DvipngArgs = "-x4000.5 -bgTransparent -Q6 -mode toshiba -D180";
+$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
# If true, don't delete temporary files
#
Index: RenderProblem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WebworkWebservice/RenderProblem.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WebworkWebservice/RenderProblem.pm -Llib/WebworkWebservice/RenderProblem.pm -u -r1.4 -r1.5
--- lib/WebworkWebservice/RenderProblem.pm
+++ lib/WebworkWebservice/RenderProblem.pm
@@ -8,6 +8,8 @@
use WebworkWebservice;
use base qw(WebworkWebservice);
+my $debugXmlCode=1; # turns on the filter for debugging XMLRPC and SOAP code
+local(*DEBUGCODE);
BEGIN {
$main::VERSION = "2.1";
@@ -48,7 +50,7 @@
$ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
-print "webwork is really ready\n\n";
+
#other services
# File variables
#our $WARNINGS='';
@@ -100,6 +102,7 @@
my $rh = shift;
+
###########################################
# Grab the course name, if this request is going to depend on
# some course other than the default course
@@ -121,7 +124,8 @@
# Create database object for this course
$db = WeBWorK::DB->new($ce->{dbLayout});
};
- $ce->{pg}->{options}->{catchWarnings};
+ # $ce->{pg}->{options}->{catchWarnings}=1; #FIXME warnings aren't automatically caught
+ # when using xmlrpc -- turn this on in the daemon2_course.
#^FIXME need better way of determining whether the course actually exists.
if ($@) {
$ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
@@ -361,27 +365,68 @@
};
- # Hack to filter out CODE references
- foreach my $ans (keys %{$out2->{answers}}) {
- foreach my $item (keys %{$out2->{answers}->{$ans}}) {
- my $contents = $out2->{answers}->{$ans}->{$item};
- if (ref($contents) =~ /CODE/ ) {
- #warn "removing code at $ans $item ";
- $out2->{answers}->{$ans}->{$item} = undef;
- }
- }
-
+ # Filter out bad reference types
+ ###################
+ # DEBUGGING CODE
+ ###################
+ if ($debugXmlCode) {
+ my $logDirectory =$ce->{courseDirs}->{logs};
+ my $xmlDebugLog = "$logDirectory/xml_debug.txt";
+ warn "Opening debug log $xmlDebugLog\n" ;
+ open (DEBUGCODE, ">>$xmlDebugLog") || die "Can't open $xmlDebugLog";
+ print DEBUGCODE "\n\nStart xml encoding\n";
}
+ xml_filter($out2->{answers});
+
+ ##################
+ close(DEBUGCODE) if $debugXmlCode;
+ ###################
+
$out2->{PG_flag}->{PROBLEM_GRADER_TO_USE} = undef;
my $endTime = new Benchmark;
$out2->{compute_time} = logTimingInfo($beginTime, $endTime);
# warn "flags are" , WebworkWebservice::pretty_print_rh($pg->{flags});
+
$out2;
}
-
+sub xml_filter {
+ my $input = shift;
+ my $level = shift || 0;
+ my $space=" ";
+ # Hack to filter out CODE references
+ my $type = ref($input);
+ if (!defined($type) or !$type ) {
+ print DEBUGCODE $space x $level." : scalar -- not converted\n" if $debugXmlCode;
+ } elsif( $type =~/HASH/i or "$input"=~/HASH/i) {
+ print DEBUGCODE "HASH reference with ".%{$input}." elements will be investigated\n" if $debugXmlCode;
+ $level++;
+ foreach my $item (keys %{$input}) {
+ print DEBUGCODE " "x$level."$item is " if $debugXmlCode;
+ $input->{$item} = xml_filter($input->{$item},$level);
+ }
+ $level--;
+ print DEBUGCODE " "x$level."HASH reference completed \n" if $debugXmlCode;
+ } elsif( $type=~/ARRAY/i or "$input"=~/ARRAY/i) {
+ print DEBUGCODE " "x$level."ARRAY reference with ".@{$input}." elements will be investigated\n" if $debugXmlCode;
+ $level++;
+ foreach my $item (@{$input}) {
+ $item = xml_filter($item,$level);
+ }
+ $level--;
+ print DEBUGCODE " "x$level."ARRAY reference completed \n" if $debugXmlCode;
+ } elsif($type =~ /CODE/i or "$input" =~/CODE/i) {
+ $input = "CODE reference";
+ print DEBUGCODE " "x$level."CODE reference, converted $input\n" if $debugXmlCode;
+ } else {
+ print DEBUGCODE " "x$level." $type and was converted to string\n" if $debugXmlCode;
+ $input = "$type reference";
+ }
+ $input;
+
+}
sub logTimingInfo{
|
