Menu
▾
▴
[WWcvs] pg: refactored pretty_print so that it is only defined in PGcore removed some unused hash entries in PGcore
|
From: Mike G. v. a. <we...@ma...> - 2010-06-04 00:40:00
|
Log Message:
-----------
refactored pretty_print so that it is only defined in PGcore
removed some unused hash entries in PGcore
Modified Files:
--------------
pg/lib:
AnswerHash.pm
PGcore.pm
PGresponsegroup.pm
Revision Data
-------------
Index: AnswerHash.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/AnswerHash.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/AnswerHash.pm -Llib/AnswerHash.pm -u -r1.17 -r1.18
--- lib/AnswerHash.pm
+++ lib/AnswerHash.pm
@@ -120,6 +120,9 @@
}
package AnswerHash;
+use Exporter;
+use PGcore qw(not_null pretty_print);
+
# initialization fields
my %fields = ( 'score' => undef,
'correct_ans' => undef,
@@ -339,39 +342,38 @@
=cut
-
-sub pretty_print {
- my $r_input = shift;
- my $level = shift;
- $level = 4 unless defined($level);
- $level--;
- return '' unless $level > 0; # only print three levels of hashes (safety feature)
- my $out = '';
- if ( not ref($r_input) ) {
- $out = $r_input; # not a reference
- $out =~ s/</</g; # protect for HTML output
- } elsif (ref($r_input) =~/hash/i) {
- local($^W) = 0;
- $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
- foreach my $key (sort keys %$r_input ) {
- $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}, $level) . "</td></tr>";
- }
- $out .="</table>";
- } elsif (ref($r_input) eq 'ARRAY' ) {
- my @array = @$r_input;
- $out .= "( " ;
- while (@array) {
- $out .= pretty_print(shift @array, $level) . " , ";
- }
- $out .= " )";
- } elsif (ref($r_input) eq 'CODE') {
- $out = "$r_input";
- } else {
- $out = $r_input;
- $out =~ s/</</g; # protect for HTML output
- }
- $out;
-}
+# sub pretty_print {
+# my $r_input = shift;
+# my $level = shift;
+# $level = 4 unless defined($level);
+# $level--;
+# return '' unless $level > 0; # only print three levels of hashes (safety feature)
+# my $out = '';
+# if ( not ref($r_input) ) {
+# $out = $r_input; # not a reference
+# $out =~ s/</</g; # protect for HTML output
+# } elsif (ref($r_input) =~/hash/i) {
+# local($^W) = 0;
+# $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
+# foreach my $key (sort keys %$r_input ) {
+# $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}, $level) . "</td></tr>";
+# }
+# $out .="</table>";
+# } elsif (ref($r_input) eq 'ARRAY' ) {
+# my @array = @$r_input;
+# $out .= "( " ;
+# while (@array) {
+# $out .= pretty_print(shift @array, $level) . " , ";
+# }
+# $out .= " )";
+# } elsif (ref($r_input) eq 'CODE') {
+# $out = "$r_input";
+# } else {
+# $out = $r_input;
+# $out =~ s/</</g; # protect for HTML output
+# }
+# $out;
+# }
# action methods
@@ -448,7 +450,8 @@
package AnswerEvaluator;
-
+use Exporter;
+use PGcore qw(not_null pretty_print);
=head3 AnswerEvaluator Methods
Index: PGcore.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/PGcore.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/PGcore.pm -Llib/PGcore.pm -u -r1.7 -r1.8
--- lib/PGcore.pm
+++ lib/PGcore.pm
@@ -18,7 +18,7 @@
use strict;
BEGIN {
use Exporter 'import';
- our @EXPORT_OK = qw(not_null);
+ our @EXPORT_OK = qw(not_null pretty_print);
}
our $internal_debug_messages = [];
@@ -57,6 +57,41 @@
}
}
+sub pretty_print { # provides html output -- NOT a method
+ my $r_input = shift;
+ my $level = shift;
+ $level = 4 unless defined($level);
+ $level--;
+ return '' unless $level > 0; # only print three levels of hashes (safety feature)
+ my $out = '';
+ if ( not ref($r_input) ) {
+ $out = $r_input if defined $r_input; # not a reference
+ $out =~ s/</</g ; # protect for HTML output
+ } elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
+ local($^W) = 0;
+
+ $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
+
+
+ foreach my $key ( sort ( keys %$r_input )) {
+ $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>";
+ }
+ $out .="</table>";
+ } elsif (ref($r_input) eq 'ARRAY' ) {
+ my @array = @$r_input;
+ $out .= "( " ;
+ while (@array) {
+ $out .= pretty_print(shift @array, $level) . " , ";
+ }
+ $out .= " )";
+ } elsif (ref($r_input) eq 'CODE') {
+ $out = "$r_input";
+ } else {
+ $out = $r_input;
+ $out =~ s/</</g; # protect for HTML output
+ }
+ $out;
+}
##################################
# PGcore object
##################################
@@ -70,11 +105,10 @@
my $self = {
OUTPUT_ARRAY => [], # holds output body text
HEADER_ARRAY => [], # holds output for the header text
-# PG_ANSWERS => [], # holds answers with labels
-# PG_UNLABELED_ANSWERS => [], # holds
+# PG_ANSWERS => [], # holds answers with labels # deprecated
+# PG_UNLABELED_ANSWERS => [], # holds unlabeled ans. #deprecated -replaced by PG_ANSWERS_HASH
PG_ANSWERS_HASH => {}, # holds label=>answer pairs
PERSISTENCE_HASH => {}, # holds other data, besides answers, which persists during a session and beyond
-# PG_persistence_hash => {}, # stores information (other than answers) from one session to another
answer_eval_count => 0,
answer_blank_count => 0,
unlabeled_answer_blank_count =>0,
@@ -86,7 +120,7 @@
QUIZ_PREFIX => $envir->{QUIZ_PREFIX},
SECTION_PREFIX => '', # might be used for sequential (compound) questions?
- PG_ACTIVE => 1, # turn to zero to stop processing
+ PG_ACTIVE => 1, # toggle to zero to stop processing
submittedAnswers => 0, # have any answers been submitted? is this the first time this session?
PG_session_persistence_hash =>{}, # stores data from one invoction of the session to the next.
PG_original_problem_seed => 0,
@@ -404,7 +438,7 @@
my $self = shift;
my $label = shift;
my $value = shift;
- $self->internal_debug_message("record_ans_name $label $value");
+ #$self->internal_debug_message("PGcore::record_ans_name: $label $value");
my $response_group = new PGresponsegroup($label,$label,$value);
if (defined($self->{PG_ANSWERS_HASH}->{$label}) ) {
$self->{PG_ANSWERS_HASH}->{$label}->replace(ans_label => $label,
@@ -468,7 +502,7 @@
my $self = shift;
my $label = shift;
my @content = @_;
- $self->internal_debug_message("storing $label in PERSISTENCE_HASH");
+ $self->internal_debug_message("PGcore::store_persistent_data: storing $label in PERSISTENCE_HASH");
if (defined($self->{PERSISTENCE_HASH}->{$label}) ) {
warn "can' overwrite $label in persistent data";
} else {
@@ -512,15 +546,32 @@
# }
# }
-sub append_debug_message {
+
+
+sub debug_message {
my $self = shift;
my @str = @_;
- push @{$self->{DEBUG_messages}}, @str;
+ push @{$self->{flags}->{DEBUG_messages}}, @str;
}
sub get_debug_messages {
my $self = shift;
- $self->{DEBUG_messages};
+ $self->{flags}->{DEBUG_messages};
+}
+
+sub internal_debug_message {
+ my $self = shift;
+ my @str = @_;
+ push @{$internal_debug_messages}, @str;
+}
+sub get_internal_debug_messages {
+ my $self = shift;
+ $internal_debug_messages;
}
+sub clear_internal_debug_messages {
+ my $self = shift;
+ $internal_debug_messages=[];
+}
+
sub DESTROY {
# doing nothing about destruction, hope that isn't dangerous
}
@@ -713,18 +764,5 @@
return $path;
}
-sub internal_debug_message {
- my $self = shift;
- my @str = @_;
- push @{$internal_debug_messages}, @str;
-}
-sub get_internal_debug_messages {
- my $self = shift;
- $internal_debug_messages;
-}
-sub clear_internal_debug_messages {
- my $self = shift;
- $internal_debug_messages=[];
-}
1;
\ No newline at end of file
Index: PGresponsegroup.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/PGresponsegroup.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/PGresponsegroup.pm -Llib/PGresponsegroup.pm -u -r1.3 -r1.4
--- lib/PGresponsegroup.pm
+++ lib/PGresponsegroup.pm
@@ -73,10 +73,10 @@
push @{ $self->{response_order}} , $response_label;
$self->{responses}->{$response_label} = $response_value;
} else {
- $self->internal_debug_message( "PGresponsegroup error: there is already an answer labeled $response_label", caller(2),"\n");
+ $self->internal_debug_message( "PGresponsegroup::append_response error: there is already an answer labeled $response_label", caller(2),"\n");
}
} else {
- $self->internal_debug_message( "error undefined or empty response label");
+ $self->internal_debug_message( "PGresponsegroup::append_response error: undefined or empty response label");
}
#warn "\n content of responses is ",join(' ',%{$self->{responses}});
}
@@ -128,7 +128,7 @@
my $response_value = $self->{responses}->{$response_label};
!defined($response_value) && do{ $response_value = {} };
ref($response_value) !~/HASH/ && do{
- $self->internal_debug_message("error in storing hash ", ref($response_value),$response_value);
+ $self->internal_debug_message("PGresponsegroup::extend_response: error in storing hash ", ref($response_value),$response_value);
$response_value = {$response_value=>$selected};
};
#should not happen this means that a non-hash entry was made into this response label
@@ -139,7 +139,7 @@
# a hash of key/value pairs -- the key labels the radio button or checkbox,
# the value whether it is selected
} else {
- $self->internal_debug_message("response label |$response_label| not defined") ;
+ $self->internal_debug_message("PGresponsegroup::extend_response: response label |$response_label| not defined") ;
return undef;
}
|
