Skip to content

Commit b64c995

Browse files
dlglindlglin
authored
Merge pull request #1386 from drgrice1/remove-internal-debug
Remove the internal debug messages.
2 parents e53f566 + 110d9dd commit b64c995

5 files changed

Lines changed: 35 additions & 55 deletions

File tree

‎lib/PGUtil.pm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@ sub pretty_print_html { # provides html output -- NOT a method
8989
if (!$ref) {
9090
return $r_input =~ s/</&lt;/gr;
9191
} elsif (eval { %$r_input || 1 }) {
92-
return '<div style="display:table;border:1px solid black;background-color:#fff;">'
92+
return '<div style="display:table;border:1px solid black;background-color:#fff;color:#000;">'
9393
. ($ref eq 'HASH'
9494
? ''
9595
: '<div style="'

‎lib/PGanswergroup.pm‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,12 @@
11
package PGanswergroup;
2-
use Exporter;
2+
use parent qw(PGcore); # This is so that PGresponsegroup objects can call the PGcore warning_message method.
3+
4+
use strict;
5+
use warnings;
6+
37
use PGUtil qw(not_null);
48
use PGresponsegroup;
59

6-
our @ISA = qw(PGcore);
7-
810
#############################################
911
# An object which contains an answer label and
1012
# an answer evaluator
@@ -24,16 +26,14 @@ our @ISA = qw(PGcore);
2426
# use Tie: IxHash??? to create ordered hash? (see Perl Cookbook)
2527

2628
sub new {
27-
my $class = shift;
28-
my $label = shift;
29-
my $self = {
29+
my ($class, $label, %options) = @_;
30+
my $self = {
3031
ans_label => $label,
31-
ans_eval => undef, # usually an AnswerEvaluator, sometimes a CODE
32-
response => new PGresponsegroup($label), # A PGresponse object which holds the responses
33-
# which make up the answer
32+
ans_eval => undef, # usually an AnswerEvaluator, sometimes a CODE
33+
response => PGresponsegroup->new($label), # A PGresponse object which holds the responses
34+
# which make up the answer
3435
active => 1, # whether this answer group is currently active (for multistate problems)
35-
36-
@_,
36+
%options
3737
};
3838
bless $self, $class;
3939
return $self;

‎lib/PGcore.pm‎

Lines changed: 1 addition & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,6 @@ BEGIN {
1010
$ENV{PG_VERSION} = $PGcore::PG_VERSION || 'unknown';
1111
}
1212

13-
our $internal_debug_messages = [];
14-
1513
use PGanswergroup;
1614
use PGresponsegroup;
1715
use PGrandom;
@@ -418,7 +416,7 @@ sub new_ans_name {
418416
sub record_ans_name {
419417
my ($self, $label, $value) = @_;
420418

421-
my $response_group = new PGresponsegroup($label, $label, $value);
419+
my $response_group = PGresponsegroup->new($label, $label, $value);
422420

423421
if (ref($self->{PG_ANSWERS_HASH}{$label}) eq 'PGanswergroup') {
424422
# This should really never happen. Should this warn if it does?
@@ -732,15 +730,6 @@ To report the messages use:
732730
733731
These are used in Problem.pm for example to report any errors.
734732
735-
There is also
736-
737-
$PG->internal_debug_message()
738-
$PG->get_internal_debug_message
739-
$PG->clear_internal_debug_messages();
740-
741-
There were times when things were buggy enough that only the internal_debug_message which are not saved
742-
inside the PGcore object would report.
743-
744733
=cut
745734

746735
sub debug_message {
@@ -763,21 +752,6 @@ sub get_warning_messages {
763752
$self->{WARNING_messages};
764753
}
765754

766-
sub internal_debug_message {
767-
my ($self, @str) = @_;
768-
push @$internal_debug_messages, @str;
769-
}
770-
771-
sub get_internal_debug_messages {
772-
my $self = shift;
773-
$internal_debug_messages;
774-
}
775-
776-
sub clear_internal_debug_messages {
777-
my $self = shift;
778-
$internal_debug_messages = [];
779-
}
780-
781755
sub DESTROY {
782756
# doing nothing about destruction, hope that isn't dangerous
783757
}

‎lib/PGresponsegroup.pm‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -22,11 +22,13 @@ use PGUtil qw(not_null);
2222
# Optionally append label/response pairs.
2323
sub new {
2424
my ($class, $answergroup_label, @responses) = @_;
25+
my $pg = eval('$main::PG');
2526
my $self = bless {
2627
answergroup_label => $answergroup_label, # enclosing answergroup that created this responsegroup
2728
response_order => [], # response labels
2829
responses => {}, # response label/response value pair,
2930
# value could be an arrayref in the case of radio or checkbox groups
31+
WARNING_messages => $pg->{WARNING_messages}
3032
}, $class;
3133
$self->append_responses(@responses);
3234
return $self;
@@ -45,12 +47,11 @@ sub append_response {
4547
? [ map { [ $_ => $response_value->{$_} ] } keys %$response_value ]
4648
: $response_value;
4749
} else {
48-
$self->internal_debug_message(
49-
"PGresponsegroup::append_response error: there is already an answer labeled $response_label",
50-
caller(2), "\n");
50+
$self->warning_message(
51+
qq{PGresponsegroup::append_response error: There is already an answer labeled "$response_label".});
5152
}
5253
} else {
53-
$self->internal_debug_message('PGresponsegroup::append_response error: undefined or empty response label');
54+
$self->warning_message('PGresponsegroup::append_response error: Undefined or empty response label.');
5455
}
5556
return;
5657
}
@@ -82,13 +83,14 @@ sub replace_response {
8283
sub extend_response {
8384
my ($self, $response_label, $new_value_key, $selected) = @_;
8485

85-
if (defined $self->{responses}{$response_label}) {
86+
if (defined $response_label && defined $self->{responses}{$response_label}) {
8687
my $response_value = $self->{responses}{$response_label};
8788
$response_value //= [];
8889

8990
if (ref($response_value) !~ /^(HASH|ARRAY)$/) {
90-
$self->internal_debug_message("PGresponsegroup::extend_response: error in extending response ",
91-
ref($response_value), $response_value);
91+
$self->warning_message('PGresponsegroup::extend_response error: Invalid value type "'
92+
. (ref($response_value) || 'scalar')
93+
. qq{" for $response_label.});
9294
$response_value = [ [ $response_value => $selected ] ];
9395
}
9496

@@ -99,7 +101,12 @@ sub extend_response {
99101
$self->{responses}{$response_label} = $response_value;
100102
return $response_value;
101103
} else {
102-
$self->internal_debug_message("PGresponsegroup::extend_response: response label |$response_label| not defined");
104+
if (defined $response_label) {
105+
$self->warning_message(
106+
qq{PGresponsegroup::extend_response error: Response label "$response_label" not defined.});
107+
} else {
108+
$self->warning_message('PGresponsegroup::extend_response error: Response label not provided.');
109+
}
103110
return;
104111
}
105112
}

‎macros/PG.pl‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -111,14 +111,13 @@ =head2 DOCUMENT
111111

112112
sub DOCUMENT {
113113
# get environment
114-
$rh_envir = \%envir; #KLUDGE FIXME
115-
# warn "rh_envir is ",ref($rh_envir);
116-
$PG = new PGcore(
117-
$rh_envir, # can add key/value options to modify
114+
$rh_envir = \%envir; #KLUDGE FIXME
115+
116+
$PG = new PGcore(
117+
$rh_envir, # can add key/value options to modify
118118
);
119-
$PG->clear_internal_debug_messages;
120-
# initialize main:: variables
121119

120+
# initialize main:: variables
122121
$ANSWER_PREFIX = $PG->{ANSWER_PREFIX};
123122
$QUIZ_PREFIX = $PG->{QUIZ_PREFIX};
124123
$showPartialCorrectAnswers = $PG->{flags}->{showPartialCorrectAnswers};
@@ -620,7 +619,7 @@ sub NEW_ANS_ARRAY_NAME_EXTENSION {
620619
}
621620
my $ans_label = $PG->new_ans_name();
622621
my $element_ans_label = $PG->new_array_element_label($ans_label, $row_num, $col_num, vec_num => $vecnum);
623-
my $response = new PGresponsegroup($ans_label, $element_ans_label, undef);
622+
my $response = PGresponsegroup->new($ans_label, $element_ans_label, undef);
624623
$PG->extend_ans_group($ans_label, $response);
625624
return $element_ans_label;
626625
}
@@ -632,7 +631,7 @@ sub CLEAR_RESPONSES {
632631
if (ref($responsegroup)) {
633632
$responsegroup->clear;
634633
} else {
635-
$responsegroup = $PG->{PG_ANSWERS_HASH}{$ans_label}{response} = new PGresponsegroup($label);
634+
$responsegroup = $PG->{PG_ANSWERS_HASH}{$ans_label}{response} = PGresponsegroup->new($ans_label);
636635
}
637636
}
638637
return;

0 commit comments

Comments
 (0)