# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonchart.pm,v 1.43 2002/06/05 05:05:38 stredwic Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# Homework Performance Chart
#
# (Navigate Maps Handler
#
# (Page Handler
#
# (TeX Content Handler
# YEAR=2000
# 05/29/00,05/30 Gerd Kortemeyer)
# 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
# 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
# YEAR=2001
# 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
# 7/10/01 Behrouz Minaei
# 9/8 Gerd Kortemeyer
# 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
# YEAR=2002
# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
#
###

package Apache::lonchart;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet();
use Apache::loncommon();
use HTML::TokeParser;
use GDBM_File;

# -------------------------------------------------------------- Module Globals
my %hash;
my %CachData;
my @cols;
my $r;
my $c;
 
# ------------------------------------------------------------- Find out status

sub ExtractStudentData {
    my ($name,$coid)=@_;
    my ($sname,$sdom) = split(/\:/,$name);
    my $ResId;
    my $Code;
    my $Tries;
    my $Wrongs;
    my %TempHash;
    my $Version;
    my $problemsCorrect;
    my $problemsSolved;
    my $totalProblems;
    my $LatestVersion;
    my $Str;

    # Handle Student information ------------------------------------------
    # Handle errors
#    if($CachData{$name.':error'} =~ /environment/) {
#	my $errorMessage = $CachData{$name.':error'};
#	return '<td>'.$sname.'</td><td>'.$sdom.
#	    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
#    }

    # Handle user data
    $Str  = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;
    $Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};
    $Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};
    $Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};
    $Str .= '</pre></td>';

    if($CachData{$name.':error'} =~ /course/) {
	return $Str;
#	my $errorMessage = 'May have no course data or '.
#	                   $CachData{$name.':error'};
#	return '<td>'.$sname.'</td><td>'.$sdom.
#	    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
    }

    # Handle problem data ------------------------------------------------
    $Str .= '<td><pre>';
    $problemsCorrect = 0;
    $totalProblems = 0;
    $problemsSolved = 0;
    my $IterationNo = 0;
    foreach $ResId (@cols) {
	if ($IterationNo == 0) {
	    # Looks to be skipping start resource
	    $IterationNo++; 
	    next;
	}

	# ResId is 0 for sequences and pages, 
	# please check tracetable for changes
	if (!$ResId) {
	    my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
	    $Str .= '<font color="#007700">'.$outputProblemsCorrect.
		    '</font></pre></td>';
	    $Str .= '<td><pre>';
	    $problemsSolved += $problemsCorrect;
	    $problemsCorrect=0;
	    next; 
	}

	# Set $1 and $2
	$ResId=~/(\d+)\.(\d+)/;
	my $meta=$hash{'src_'.$ResId};
	my $numberOfParts = 0;
	undef %TempHash;
	foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
#----------- Overwrite $1 in next statement ---------------------------------
	    if ($_=~/^stores\_(\d+)\_tries$/) {
		my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
		if ( $TempHash{"$Part"} eq '' ) { 
		    $TempHash{"$Part"} = $Part;
		    $TempHash{$numberOfParts}=$Part;
		    $TempHash{"$Part.Code"} = ' ';  
		    $numberOfParts++;
		}
	    }
	}

#----------- Using $1 and $2 -----------------------------------------------
	my $Prob = &Apache::lonnet::symbclean(
		       &Apache::lonnet::declutter($hash{'map_id_'.$1} ).
                       '___'.$2.'___'.
                       &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));
	$Code=' ';
	$Tries = 0;
	$LatestVersion = $CachData{$name.":version:$Prob"};

	if ( $LatestVersion ) {
	    for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
		my $vkeys = $CachData{$name.":$Version:keys:$Prob"};
		my @keys = split(/\:/,$vkeys);		  

		foreach my $Key (@keys) {
#---------------------- Changing $1 -------------------------------------------
		    if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
#---------------------- Using $1 -----------------------------------------------
			my $Part = $1;
			$Tries = $CachData{$name.":$Version:$Prob".
					   ":resource.$Part.tries"};
			$TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
			my $Val = $CachData{$name.":$Version:$Prob".
					    ":resource.$Part.solved"};
			if    ($Val eq 'correct_by_student')   {$Code = '*';} 
			elsif ($Val eq 'correct_by_override')  {$Code = '+';}
			elsif ($Val eq 'incorrect_attempted')  {$Code = '.';} 
			elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
			elsif ($Val eq 'excused')              {$Code = 'x';}
			elsif ($Val eq 'ungraded_attempted')   {$Code = '#';}
			else                                   {$Code = ' ';}

			$TempHash{"$Part.Code"} = $Code;
		    }
		}
	    }
# Actually append problem to output (all parts)
	    $Str.='<a href="/adm/grades?symb='.
                &Apache::lonnet::escape($Prob).
                '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 
	    for(my $n = 0; $n < $numberOfParts; $n++) {		  
		my $part = $TempHash{$n};
		my $code2 = $TempHash{"$part.Code"};
		if($code2 eq '*') {
		    $problemsCorrect++;
# !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------
		    if (($TempHash{"$part.Tries"}<10) ||
			($TempHash{"$part.Tries"} eq '')) {
			$TempHash{"$part.Code"}=$TempHash{"$part.Tries"};
		    }
		} elsif($code2 eq '+') {
		    $problemsCorrect++;
		}

		$Str .= $TempHash{"$part.Code"};

		if($code2 ne 'x') {
		    $totalProblems++;
		}
	    }
	    $Str.='</a>';
	} else {
	    for(my $n=0; $n<$numberOfParts; $n++) {
		$Str.=' ';
		$totalProblems++;
	    }
	}
    }

    $Str .= '<td><pre><font color="#000088">'.$problemsSolved.
	    ' / '.$totalProblems.'</font></pre></td>';

    return $Str;
}

sub CreateForm {
    my $OpSel1='';
    my $OpSel2='';
    my $OpSel3='';
    my $Status = $ENV{'form.status'};
    if ( $Status eq 'Any' ) { $OpSel3='selected'; }
    elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
    else { $OpSel1 = 'selected'; }

    my $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n";
    $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type=submit name=sort value="User Name" />'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type=submit name=sort value="Section"/>'."\n";
    $Ptr .= '<br><br>';
    $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".
            '<select name="status">'. 
            '<option '.$OpSel1.' >Active</option>'."\n".
            '<option '.$OpSel2.' >Expired</option>'."\n".
	    '<option '.$OpSel3.' >Any</option> </select> '."\n";
    $Ptr .= '&nbsp;&nbsp;&nbsp;';
    $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";
    $Ptr .= '</form>'."\n";
    $r->print( $Ptr );
}

sub CreateTableHeadings {
    $r->print('<tr>');
    $r->print('<td>User Name</td>');
    $r->print('<td>Domain</td>');
    $r->print('<td>Section</td>');
    $r->print('<td>PID</td>');
    $r->print('<td>Full Name</td>');

    my $ResId;
    my $IterationNo = 0;
    foreach $ResId (@cols) {
	if ($IterationNo == 0) {$IterationNo++; next;}
	if (!$ResId) { 
#	    my $PrNo = sprintf( "%3d", $ProbNo );
#	    $Str .= '<td><font color="#007700">Chapter '.$PrNo.'</font></td>';
	    $r->print('<td><font color="#007700">Chapter '.'0'.'</font></td>');
	}
    }

    $r->print('</tr>');
    $r->rflush();

    return;
}

# ------------------------------------------------------------ Build page table

sub tracetable {
    my ($rid,$beenhere)=@_;
    unless ($beenhere=~/\&$rid\&/) {
       $beenhere.=$rid.'&';  
# new ... updating the map according to sequence and page
       if (defined($hash{'is_map_'.$rid})) {
	   my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};
           if ( $cmap eq 'sequence' || $cmap eq 'page' ) { 
               $cols[$#cols+1]=0; 
           }
           if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
               (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
              my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};

                &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
                '&'.$frid.'&');

              if ($hash{'src_'.$frid}) {
                 if ($hash{'src_'.$frid}=~
                                 /\.(problem|exam|quiz|assess|survey|form)$/) {
		     $cols[$#cols+1]=$frid;
                 }
	      }

	   }
       } else {
          if ($hash{'src_'.$rid}) {
             if ($hash{'src_'.$rid}=~
                                 /\.(problem|exam|quiz|assess|survey|form)$/) {
	         $cols[$#cols+1]=$rid;
             }
          }
       }
       if (defined($hash{'to_'.$rid})) {
          foreach (split(/\,/,$hash{'to_'.$rid})){
              &tracetable($hash{'goesto_'.$_},$beenhere);
          }
       }
    }
}

sub usection {
    my ($udom,$unam,$courseid,$ActiveFlag)=@_;
    $courseid=~s/\_/\//g;
    $courseid=~s/^(\w)/\/$1/;

    my %result=&Apache::lonnet::dump('roles',$udom,$unam);

    my($checkForError)=keys (%result);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
	return -1;
    }

    my $cursection='-1';
    my $oldsection='-1';
    my $status='Expired';
    foreach my $key (keys (%result)) {
	my $value = $result{$key};
        if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
            my $section=$1;
            if ($key eq $courseid.'_st') { $section=''; }
	    my ($dummy,$end,$start)=split(/\_/,$value);
	    my $now=time;
	    my $notactive=0;
	    if ($start) {
		if($now<$start) {
		    $notactive=1;
		}
	    }
	    if($end) {
		if ($now>$end) {
		    $notactive=1;
		}
	    }
	    if($notactive == 0) {
		$status='Active';
		$cursection=$section;
	    }
	    if($notactive == 1) {
		$oldsection=$section;
	    }
	}
    }
    if($status eq $ActiveFlag) {
	if($cursection eq '-1') {
	    return $oldsection;
	}
	return $cursection;
    }
    if($ActiveFlag eq 'Any') {
	if($cursection eq '-1') {
	    return $oldsection;
	}
	return $cursection;
    }
    return '-1';
}

sub ProcessFullName {
    my ($name)=@_;
    my $Str = '';

    if($CachData{$name.':lastname'} ne '') {
	$Str .= $CachData{$name.':lastname'}.' ';
	if($CachData{$name.':generation'} ne '') {
	    $Str .= $CachData{$name.':generation'};
	} else {
	    chop($Str);
	}
	$Str .= ', ';
	if($CachData{$name.':firstname'} ne '') {
	    $Str .= $CachData{$name.':firstname'}.' ';
	}
	if($CachData{$name.':middlename'} ne '') {
	    $Str .= $CachData{$name.':middlename'};
	} else {
	    chop($Str);
	    if($CachData{$name.'firstname'} eq '') {
		chop($Str);
	    }
	}
    } else {
	if($CachData{$name.':firstname'} ne '') {
	    $Str .= $CachData{$name.':firstname'}.' ';
	}
	if($CachData{$name.':middlename'} ne '') {
	    $Str .= $CachData{$name.':middlename'}.' ';
	}
	if($CachData{$name.':generation'} ne '') {
	    $Str .= $CachData{$name.':generation'};
	} else {
	    chop($Str);
	}
    }

    return $Str;
}

sub DownloadStudentInformation {
    my ($name,$courseID)=@_;
    my ($studentName,$studentDomain) = split(/\:/,$name);
    my $checkForError;
    my $key;
    my $Status=$CachData{$name.':Status'};

#-----------------------------------------------------------------
    # Download student environment data, specifically the full name and id.
    my %studentInformation=&Apache::lonnet::get('environment',
						['lastname','generation',
						 'firstname','middlename',
						 'id'],
						$studentDomain,$studentName);
    if($c->aborted()) {
	return;
    }
    ($checkForError)=keys (%studentInformation);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
	$CachData{$name.':error'}=
	    'Could not download student environment data.';
#	return;
	$CachData{$name.':lastname'}='';
	$CachData{$name.':generation'}='';
	$CachData{$name.':firstname'}='';
	$CachData{$name.':middlename'}='';
	$CachData{$name.':fullname'}='';
	$CachData{$name.':id'}='';
    } else {
	$CachData{$name.':lastname'}=$studentInformation{'lastname'};
	$CachData{$name.':generation'}=$studentInformation{'generation'};
	$CachData{$name.':firstname'}=$studentInformation{'firstname'};
	$CachData{$name.':middlename'}=$studentInformation{'middlename'};
	$CachData{$name.':fullname'}=&ProcessFullName($name);
	$CachData{$name.':id'}=$studentInformation{'id'};
    }

    # Download student course data
    my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
					 $studentName);
    if($c->aborted()) {
	return;
    }
    ($checkForError)=keys (%courseData);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
	$CachData{$name.':error'}='Could not download course data.';
#	return;
    } else {
	foreach $key (keys (%courseData)) {
	    $CachData{$name.':'.$key}=$courseData{$key};
	}
    }

    # Get student's section number
    my $sec=&usection($studentDomain, $studentName, $courseID, $Status);
    if($sec != -1) {
	$CachData{$name.':section'}=sprintf('%3s',$sec);
    } else {
	$CachData{$name.':section'}='';
    }

    return;
}

sub SortStudents {
# --------------------------------------------------------------- Sort Students
    my $Pos = $ENV{'form.sort'};
    my @students = split(/:::/,$CachData{'NamesOfStudents'});
    my %sortData;

    if($Pos eq 'Last Name') {
	for(my $index=0; $index<$#students+1; $index++) {
	    $sortData{$CachData{$students[$index].':fullname'}}=
		$students[$index];
	}
    } elsif($Pos eq 'Section') {
	for(my $index=0; $index<$#students+1; $index++) {
	    $sortData{$CachData{$students[$index].':section'}.
		      $students[$index]}=$students[$index];
	}
    } else {
	# Sort by user name
	for(my $index=0; $index<$#students+1; $index++) {
	    $sortData{$students[$index]}=$students[$index];
	}
    }

    my @order = ();
    foreach my $key (sort keys(%sortData)) {
	push (@order,$sortData{$key});
    }

    return @order;
}

sub CollectClasslist {
# -------------------------------------------------------------- Get class list
    my $cid=$ENV{'request.course.id'};
    my $chome=$ENV{'course.'.$cid.'.home'};
    my ($cdom,$cnum)=split(/\_/,$cid);
    my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
    my @names = ();

    my($checkForError)=keys (%classlist);
    if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
	$r->print('<h1>Could not access course data</h1>');
	push (@names, 'error');
	return @names;
    }

# ------------------------------------- Calculate Status and number of students
    my $now=time;
    foreach my $name (sort(keys(%classlist))) {
	my $value=$classlist{$name};
	my ($end,$start)=split(/\:/,$value);
	my $active=1;
	my $Status=$ENV{'form.status'};
	$Status = ($Status) ? $Status : 'Active';
	if((($end) && $now > $end) && (($Status eq 'Active'))) { 
	    $active=0; 
	}
	if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
	    $active=0;
	}
	if($active) {
	    push(@names,$name);
	    $CachData{$name.':Status'}=$Status;
	}
    }

    $CachData{'NamesOfStudents'}=join(":::",@names);

    return @names;
}

sub BuildChart {
# ----------------------- Get first and last resource, see if there is anything
    my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
    my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
    if (!($firstres) || !($lastres)) {
	$r->print('<h3>Undefined course sequence</h3>');
	return;
    }

# --------------- Find all assessments and put them into some linear-like order
    &tracetable($firstres,'&'.$lastres.'&');

# ----------------------------------------------------------------- Render page
    &CreateForm();

    my $cid=$ENV{'request.course.id'};
    my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                  "_$ENV{'user.domain'}_$cid\_chart.db";
    my $isCached = 0;
    my @students;
    if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
	if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) {
	    $isCached = 1;
	    @students=&SortStudents();
	} else {
	    $r->print("Unable to tie hash to db file");
	    $r->rflush();
	    return;
	}
    } else {
	if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640)) {
	    $isCached = 0;
	    @students=&CollectClasslist();
	    if($students[0] eq 'error') {
		return;
	    }
	} else {
	    $r->print("Unable to tie hash to db file");
	    return;
	}
    }

    $r->print('<h3>'.($#students+1).' students</h3>');
    $r->rflush();

# ----------------------------------------------------------------- Start table
    $r->print('<table><tbody>');
#    &CreateTableHeadings();
    my @updateStudentList = ();
    foreach my $student (@students) {
	if($c->aborted()) {
	    if($isCached == 0) {
		$CachData{'NamesOfStudents'}=join(":::",@updateStudentList);
	    }
	    last;
	}
	if($isCached == 0) {
	    &DownloadStudentInformation($student,$cid);
	    push (@updateStudentList, $student);
	}
	my $Str=&ExtractStudentData($student,$cid);
	$r->print('<tr>'.$Str.'</tr>');
    }
    $r->print('</tbody></table>');

    untie(%CachData);

    return;
}

sub Start {
    $r->print('<head><title>'.
              'LON-CAPA Assessment Chart</title></head>');
    $r->print('<body bgcolor="#FFFFFF">'.
              '<script>window.focus();</script>'.
              '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
              '<h1>Assessment Chart</h1>');
# ---------------------------------------------------------------- Course title
    $r->print('<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.
              '.description'}.'</h1><h3>'.localtime().
              "</h3><p><pre>1..9: correct by student in 1..9 tries\n".
              "   *: correct by student in more than 9 tries\n".
	      "   +: correct by override\n".
              "   -: incorrect by override\n".
	      "   .: incorrect attempted\n".
	      "   #: ungraded attempted\n".
              "    : not attempted\n".
	      "   x: excused</pre><p>"); 
# ------------------------------- This is going to take a while, produce output
    $r->rflush();

    &BuildChart();

    $r->print('</body>');

    return;
}

# ================================================================ Main Handler

sub handler {
    undef %hash;
    undef %CachData;
    undef @cols;

    $r=shift;
    $c = $r->connection;
    if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
# ------------------------------------------- Set document type for header only
	if ($r->header_only) {
	    if ($ENV{'browser.mathml'}) {
		$r->content_type('text/xml');
	    } else {
		$r->content_type('text/html');
	    }
	    &Apache::loncommon::no_cache($r);
	    $r->send_http_header;
	    return OK;
	}

	my $requrl=$r->uri;
# ----------------------------------------------------------------- Tie db file
	if ($ENV{'request.course.fn'}) {
	    my $fn=$ENV{'request.course.fn'};
	    if (-e "$fn.db") {
		if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
# ------------------------------------------------------------------- Hash tied
# ---------------------------------------------------------------- Send headers
		    $r->content_type('text/html');
		    $r->send_http_header;
		    $r->print('<html>');
		    &Start();
		    $r->print('</html>');
		    $r->rflush();
# ------------------------------------------------------------- End render page
		} else {
		    $r->content_type('text/html');
		    $r->send_http_header;
		    $r->print('<html><body>Coursemap undefined.</body></html>');
		}
# ------------------------------------------------------------------ Untie hash
		unless (untie(%hash)) {
		    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
			     "Could not untie coursemap $fn (browse).</font>"); 
		}

# -------------------------------------------------------------------- All done
		return OK;
# ----------------------------------------------- Errors, hash could no be tied
	    }
	} else {
	    $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
	    return HTTP_NOT_ACCEPTABLE; 
	}
    } else {
	$ENV{'user.error.msg'}=
        $r->uri.":vgr:0:0:Cannot view grades for complete course";
	return HTTP_NOT_ACCEPTABLE; 
    }
}
1;
__END__