--- loncom/homework/lonhomework.pm 2003/05/16 19:01:27 1.129 +++ loncom/homework/lonhomework.pm 2003/10/15 22:18:26 1.138.2.1 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.129 2003/05/16 19:01:27 albertel Exp $ +# $Id: lonhomework.pm,v 1.138.2.1 2003/10/15 22:18:26 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,7 +50,7 @@ use Apache::essayresponse(); use Apache::externalresponse(); use Apache::rankresponse(); use Apache::matchresponse(); -#use Apache::chemresponse(); +use Apache::chemresponse(); use Apache::Constants qw(:common); use HTML::Entities(); use Apache::loncommon(); @@ -72,7 +72,8 @@ sub get_target { } if ( defined($ENV{'form.submitted'}) && - ( !defined($ENV{'form.resetdata'}))) { + ( !defined($ENV{'form.resetdata'})) && + ( !defined($ENV{'form.newrandomization'}))) { return ('grade', 'web'); } else { return ('web'); @@ -91,7 +92,8 @@ sub get_target { if ( $ENV{'form.problemmode'} eq 'View' || $ENV{'form.problemmode'} eq 'Discard Edits and View') { if ( defined($ENV{'form.submitted'}) && - (!defined($ENV{'form.resetdata'})) ) { + (!defined($ENV{'form.resetdata'})) && + (!defined($ENV{'form.newrandomization'}))) { return ('grade', 'web','answer'); } else { return ('web','answer'); @@ -144,6 +146,51 @@ sub send_footer { $Apache::lonxml::browse=''; +sub check_ip_acc { + my ($acc)=@_; + if (!defined($acc) || $acc =~ /^\s*$/) { return 1; } + my $allowed=0; + my $ip=$ENV{'REMOTE_ADDR'}; + my $name; + foreach my $pattern (split(',',$acc)) { + if ($pattern =~ /\*$/) { + #35.8.* + $pattern=~s/\*//; + if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { + #35.8.3.[34-56] + my $low=$2; + my $high=$3; + $pattern=$1; + if ($ip =~ /^\Q$pattern\E/) { + my $last=(split(/\./,$ip))[3]; + if ($last <=$high && $last >=$low) { $allowed=1; } + } + } elsif ($pattern =~ /^\*/) { + #*.msu.edu + $pattern=~s/\*//; + if (!defined($name)) { + use Socket; + my $netaddr=inet_aton($ip); + ($name)=gethostbyaddr($netaddr,AF_INET); + } + if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { + #127.0.0.1 + if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } + } else { + #some.name.com + if (!defined($name)) { + use Socket; + my $netaddr=inet_aton($ip); + ($name)=gethostbyaddr($netaddr,AF_INET); + } + if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } + } + if ($allowed) { last; } + } + return $allowed; +} # JB, 9/24/2002: Any changes in this function may require a change # in lonnavmaps::resource::getDateStatus. sub check_access { @@ -165,6 +212,14 @@ sub check_access { &Apache::lonxml::debug("checking for part :$id:"); &Apache::lonxml::debug("time:".time); + + my $allowed=&check_ip_acc(&Apache::lonnet::EXT("resource.$id.acc")); + if (!$allowed) { + $status='INVALID_ACCESS'; + $date=&mt("can not be accessed from your location."); + return($status,$date); + } + foreach $temp ("opendate","duedate","answerdate") { $lastdate = $date; $date = &Apache::lonnet::EXT("resource.$id.$temp"); @@ -225,10 +280,10 @@ sub check_access { } } - if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') && - (!$Apache::lonhomework::history{"resource.0.outtoken"})) { - return ('UNCHECKEDOUT','needs to be checked out'); - } + #if (($status ne 'CLOSED') && ($Apache::lonhomework::type eq 'exam') && + # (!$Apache::lonhomework::history{"resource.0.outtoken"})) { + # return ('UNCHECKEDOUT','needs to be checked out'); + #} &Apache::lonxml::debug("sending back :$status:$datemsg:"); @@ -398,8 +453,7 @@ sub analyze { 'last problem'); my $subresult=&Apache::lonnet::ssi($request->uri, ('grade_target' => 'analyze'), - ('rndseed' => $i)); - &Apache::lonxml::debug(":$subresult:"); + ('rndseed' => $i+$rndseed)); (my $garbage,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); my @parts; @@ -418,19 +472,32 @@ sub analyze { } &Apache::lonhtmlcommon::Update_PrgWin($request,\%prog_state, 'Analyzing Results'); - foreach my $part (keys(%allparts)) { + foreach my $part (sort(keys(%allparts))) { if (defined(@{ $overall{$part.'.answer'} })) { - $request->print(''); + my $num_cols=scalar(@{ $overall{$part.'.answer'}->[0] }); + $request->print('
Part '.$part.'
'); + my %frequency; foreach my $answer (sort {$a->[0] <=> $b->[0]} (@{ $overall{$part.'.answer'} })) { - $request->print(''); + $frequency{join("\0",@{ $answer })}++; + } + $request->print(''); + foreach my $answer (sort {(split("\0",$a))[0] <=> (split("\0",$b))[0]} (keys(%frequency))) { + $request->print(''); } $request->print('
Part '.$part.'
'.join('',@{ $answer }). - '
AnswerFrequency
'. + join('',split("\0",$answer)). + '('.$frequency{$answer}. + ')
'); } else { $request->print('

Part '.$part. - ' is not analyzabale at this time

'); + ' is not analyzable at this time

'); } } + if (scalar(keys(%allparts)) == 0 ) { + $request->print('

Found no analyzable parts in this problem, + currently only Numerical, Formula and String response + styles are supported.

'); + } &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state); &analyze_footer($request); &Apache::lonhomework::showhash(%overall); @@ -457,15 +524,8 @@ sub editxmlmode { &renderpage($request,$file); } else { my ($rows,$cols) = &Apache::edit::textarea_sizes(\$problem); - my $xml_help = '
'. - &Apache::loncommon::help_open_topic("Problem_Editor_XML_Index",'Problem Editing Help') - .''. - &Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols', - undef,undef,600) - .''. - &Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols', - undef,undef,600) - .'
'; + my $xml_help = Apache::loncommon::helpLatexCheatsheet("Problem_Editor_XML_Index", + "Problem Editing Help"); if ($cols > 80) { $cols = 80; } if ($cols < 70) { $cols = 70; } if ($rows < 20) { $rows = 20; } @@ -561,6 +621,7 @@ sub newproblem { my $extension=$request->uri; $extension=~s:^.*\.([\w]+)$:$1:; &Apache::lonxml::debug("Looking for :$extension:"); + my $templatelist=&get_template_list('',$extension); if ($ENV{'form.template'} && $ENV{'form.template'} ne "Select a $extension template") { use File::Copy; @@ -568,8 +629,16 @@ sub newproblem { my $dest = &Apache::lonnet::filelocation("",$request->uri); copy($file,$dest); &renderpage($request,$dest); + } elsif($ENV{'form.newfile'} && !$templatelist) { + # I don't like hard-coded filenames but for now, this will work. + use File::Copy; + my $templatefilename = + $request->dir_config('lonIncludes').'/templates/blank.problem'; + &Apache::lonxml::debug("$templatefilename"); + my $dest = &Apache::lonnet::filelocation("",$request->uri); + copy($templatefilename,$dest); + &renderpage($request,$dest); } else { - my $templatelist=&get_template_list('',$extension); my $url=$request->uri; my $dest = &Apache::lonnet::filelocation("",$request->uri); my $errormsg; @@ -649,13 +718,17 @@ sub handler { &Apache::lonxml::debug('symb is '.$symb); if ($ENV{'request.state'} eq "construct" || $symb eq '') { if ($ENV{'form.resetdata'} eq 'Reset Submissions' || - $ENV{'form.resetdata'} eq 'New Problem Variation' ) { + $ENV{'form.resetdata'} eq 'New Problem Variation' || + $ENV{'form.newrandomization'} eq 'New Randomization') { my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); &Apache::lonnet::tmpreset($symb,'',$domain,$name); +&Apache::lonxml::debug("Attempt reset"); } } if ($ENV{'request.state'} eq "construct") { if ( -e $file ) { + &Apache::loncommon::get_unprocessed_cgi + ($ENV{'QUERY_STRING'},['problemmode']); if (!(defined $ENV{'form.problemmode'})) { #first visit to problem in construction space #&view_or_edit_menu($request); @@ -663,7 +736,7 @@ sub handler { &renderpage($request,$file); } elsif ($ENV{'form.problemmode'} eq 'EditXML') { &editxmlmode($request,$file); - } elsif ($ENV{'form.problemmode'} eq 'Answer Distribution') { + } elsif ($ENV{'form.problemmode'} eq 'Calculate answers') { &analyze($request,$file); } else { &renderpage($request,$file);