");
- my @colcont=split(/\&/,$rows[$i]);
- my $avespan=$lcm/($#colcont+1);
-
- # for each item I wish to print on this row...
- for ($j=0;$j<=$#colcont;$j++) {
- my $indent;my $indentstr;
- my $linkid;
- my $rid=$colcont[$j];
- $rid=~/(\d+)\.(\d+)$/;
- my $src=
- &Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
- my $symb=
- &Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.$src;
- my $add='';
- my $adde=' | ';
- my $hwk='';
- my $hwke='';
- if ($rid=~/^l(\d+\.\d+),(.+)/) { $linkid=$1; $rid=$2; }
- if ($rid=~/^i(\d+),(.+)/) { $indent=$1; $rid=$2; }
- if ($rid=~/^h(.+)/) {
- $rid=$1;
- $add='';
- $adde=' | ';
- if (($ENV{'user.adv'}) &&
- ($parmhash{$symb.'.0.parameter_randompick'})) {
- $adde=' (randomly select '.
- $parmhash{$symb.'.0.parameter_randompick'}.
- ')';
- }
- }
- if ($rid=~/^j(.+)/) { $rid=$1; }
- if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) {
- # sub astatus describes what code/tcode mean
- my $code=$1;
- my $tcode=$2;
- my $ctext=$3;
- $rid=$4;
-
- # will open later
- if ($tcode eq '1') {
- $add='';
- }
-
- # solved/correct
- if ($code eq '3') {
- $add=' | ';
- } elsif ($code eq '4') { # partially correct
- $add=' | ';
- } else {
- # not attempted
-
- # we end up here on network failure, so pick a neutral
- # color if the network failed instead of bright red.
- if ( $networkFailedFlag )
- {
- $add = ' | ';
- }
- else
- {
- $add=' | ';
- }
-
- if ($tcode eq '2') { # open, not past due
- $add=' | ';
- }
-
- if ($tcode eq '4') { # due in next 24 hours
- $add=' | ';
- $adde=' | ';
- }
- }
- $hwk='';
- $hwke='';
- if ($code eq '1') {
- $hwke=' ('.$ctext.')';
- }
- if ($code eq '2' || $code eq '4') {
- $hwk='';
- $hwke=' ('.$ctext.')';
- }
- if ($code eq '3') {
- $hwk='';
- $hwke=' ('.$ctext.')';
- }
- if ($networkFailedFlag)
- {
- $hwke=' (status unavailable)';
- }
- }
- if ($rid && $hash{'src_'.$rid} eq $currenturl) {
- $add=$add.''.
- '> ';
- $adde=
- ' <'.$adde;
- }
- if ($discussiontimes{$symb}>$lastcheck) {
- $adde=
- ''.
- $adde;
- }
- if ($error{$src}) {
- foreach (split(/\,/,$error{$src})) {
- if ($_) {
- $adde=
- ' '
- .$adde;
- }
- }
- }
- if ($feedback{$src}) {
- foreach (split(/\,/,$feedback{$src})) {
- if ($_) {
- $adde=
- ' '
- .$adde;
- }
- }
- }
- if ($indent) {
- my $is=" ";
- for(my $i=-1;$i<$indent;$i++) { $indentstr.=$is; }
- }
- if (!$linkid) { $linkid=$rid; }
- if ($hash{'randomout_'.$rid}) {
- $adde=' (hidden)'.$adde;
- }
- $r->print($add.$indentstr);
- if ($rid) {
- $r->print(''.
- $hwk.$hash{'title_'.$rid}.$hwke.'');
+ my @sortedParts = sort keys %parts;
+ $self->{PARTS} = \@sortedParts;
+ }
+
+
+ # These hashes probably do not need names that end with "Hash"....
+ my %responseIdHash;
+ my %responseTypeHash;
+
+
+ # Init the responseIdHash
+ foreach (@{$self->{PARTS}}) {
+ $responseIdHash{$_} = [];
+ }
+
+ # Now, the unfortunate thing about this is that parts, part name, and
+ # response id are delimited by underscores, but both the part
+ # name and response id can themselves have underscores in them.
+ # So we have to use our knowlege of part names to figure out
+ # where the part names begin and end, and even then, it is possible
+ # to construct ambiguous situations.
+ foreach my $data (split /,/, $metadata) {
+ if ($data =~ /^([a-zA-Z]+)response_(.*)/
+ || $data =~ /^(Task)_(.*)/) {
+ my $responseType = $1;
+ my $partStuff = $2;
+ my $partIdSoFar = '';
+ my @partChunks = split /_/, $partStuff;
+ my $i = 0;
+ for ($i = 0; $i < scalar(@partChunks); $i++) {
+ if ($partIdSoFar) { $partIdSoFar .= '_'; }
+ $partIdSoFar .= $partChunks[$i];
+ if ($parts{$partIdSoFar}) {
+ my @otherChunks = @partChunks[$i+1..$#partChunks];
+ my $responseId = join('_', @otherChunks);
+ if ($self->is_task()) {
+ push(@{$responseIdHash{$partIdSoFar}},
+ $partIdSoFar);
+ } else {
+ push(@{$responseIdHash{$partIdSoFar}},
+ $responseId);
}
- $r->print($adde);
+ push(@{$responseTypeHash{$partIdSoFar}},
+ $responseType);
+ }
+ }
+ }
+ }
+ my $resorder = &Apache::lonnet::metadata($self->src(),'responseorder');
+ #
+ # Reorder the arrays in the %responseIdHash and %responseTypeHash
+ if ($resorder) {
+ my @resorder=split(/,/,$resorder);
+ foreach my $part (keys(%responseIdHash)) {
+ my $i=0;
+ my %resids = map { ($_,$i++) } @{ $responseIdHash{$part} };
+ my @neworder;
+ foreach my $possibleid (@resorder) {
+ if (exists($resids{$possibleid})) {
+ push(@neworder,$resids{$possibleid});
}
- $r->print('
');
}
+ my @ids;
+ my @type;
+ foreach my $element (@neworder) {
+ push (@ids,$responseIdHash{$part}->[$element]);
+ push (@type,$responseTypeHash{$part}->[$element]);
+ }
+ $responseIdHash{$part}=\@ids;
+ $responseTypeHash{$part}=\@type;
}
- $r->print("\n