Annotation of loncom/homework/lonr.pm, revision 1.1
1.1 ! www 1: # The LearningOnline Network with CAPA
! 2: # Interface routines to R CAS
! 3: #
! 4: # $Id: Exp $
! 5: #
! 6: # Copyright Michigan State University Board of Trustees
! 7: #
! 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 9: #
! 10: # LON-CAPA is free software; you can redistribute it and/or modify
! 11: # it under the terms of the GNU General Public License as published by
! 12: # the Free Software Foundation; either version 2 of the License, or
! 13: # (at your option) any later version.
! 14: #
! 15: # LON-CAPA is distributed in the hope that it will be useful,
! 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 18: # GNU General Public License for more details.
! 19: #
! 20: # You should have received a copy of the GNU General Public License
! 21: # along with LON-CAPA; if not, write to the Free Software
! 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 23: #
! 24: # /home/httpd/html/adm/gpl.txt
! 25: #
! 26: # http://www.lon-capa.org/
! 27: #
! 28:
! 29: package Apache::lonr;
! 30:
! 31: use strict;
! 32: use IO::Socket;
! 33: use Apache::lonnet;
! 34: use Apache::response();
! 35: use LONCAPA;
! 36:
! 37: sub connect {
! 38: return IO::Socket::UNIX->new(Peer => $Apache::lonnet::perlvar{'lonSockDir'}.'/rsock',
! 39: Type => SOCK_STREAM,
! 40: Timeout => 10);
! 41: }
! 42:
! 43: sub disconnect {
! 44: my ($socket)=@_;
! 45: if ($socket) { close($socket); }
! 46: }
! 47:
! 48: sub rreply {
! 49: my ($socket,$cmd)=@_;
! 50: if ($socket) {
! 51: print $socket &escape($cmd)."\n";
! 52: my $reply=<$socket>;
! 53: chomp($reply);
! 54: if ($reply=~/^Incorrect/) { $reply='Error: '.$reply; }
! 55: return &unescape($reply);
! 56: } else {
! 57: return 'Error: no connection.';
! 58: }
! 59: }
! 60:
! 61: sub blacklisted {
! 62: my ($cmd)=@_;
! 63: foreach my $forbidden (
! 64: '\? ','\?','%i\d+','%o','batch','block'
! 65: ,'compil','concat','describe','display2d','file','inchar'
! 66: ,'includ','lisp','load','outchar','plot','quit'
! 67: ,'read','reset','save','stin','stout','stringout'
! 68: ,'system','translat','ttyoff','with_stdout','writefile'
! 69: ) {
! 70: if ($cmd=~/$forbidden/s) { return 1; }
! 71: }
! 72: return 0;
! 73: }
! 74:
! 75: sub r_allowed_libraries {
! 76: return (
! 77: "absimp","affine","atensor","atrig1","augmented_lagrangian","contrib_ode","ctensor","descriptive","diag",
! 78: "eigen","facexp","fft","fourie","functs","ggf","grobner","impdiff","ineq","interpol","itensor","lapack",
! 79: "lbfgs","lindstedt","linearalgebra","lsquares","makeOrders","mnewton","mchrpl","ntrig","orthopoly",
! 80: "quadpack","rducon","romberg","scifac","simplex","solve_rec","sqdnst","stats","sterling","sym","units",
! 81: "vect","zeilberger");
! 82: }
! 83:
! 84: sub r_is_allowed_library {
! 85: my ($library)=@_;
! 86: foreach my $allowed_library (&r_allowed_libraries()) {
! 87: if ($library eq $allowed_library) { return 1; }
! 88: }
! 89: return 0;
! 90: }
! 91:
! 92: sub runscript {
! 93: my ($socket,$fullscript,$libraries)=@_;
! 94: if (&blacklisted($fullscript)) { return 'Error: blacklisted'; }
! 95: my $reply;
! 96: $fullscript=~s/[\n\r\l]//gs;
! 97: if ($libraries) {
! 98: foreach my $library (split(/\s*\,\s*/,$libraries)) {
! 99: unless ($library=~/\w/) { next; }
! 100: if (&r_is_allowed_library($library)) {
! 101: $reply=&rreply($socket,'library('.$library.');'."\n");
! 102: if ($reply=~/^Error\:/) { return $reply; }
! 103: } else {
! 104: return 'Error: blacklisted';
! 105: }
! 106: }
! 107: }
! 108: foreach my $line (split(/\;/s,$fullscript)) {
! 109: if ($line=~/\w/) { $reply=&rreply($socket,$line.";\n"); }
! 110: if ($reply=~/^Error\:/) { return $reply; }
! 111: }
! 112: $reply=~s/^\s*//gs;
! 113: $reply=~s/\s*$//gs;
! 114: &Apache::lonxml::debug("r $fullscript \n reply $reply");
! 115: return $reply;
! 116: }
! 117:
! 118: sub r_cas_formula_fix {
! 119: my ($expression)=@_;
! 120: return &Apache::response::implicit_multiplication($expression);
! 121: }
! 122:
! 123: sub r_run {
! 124: my ($script,$submission,$argument,$libraries) = @_;
! 125: my $socket=&connect();
! 126: my @submissionarray=split(/\s*\,\s*/,$submission);
! 127: for (my $i=0;$i<=$#submissionarray;$i++) {
! 128: my $n=$i+1;
! 129: my $fixedsubmission=&r_cas_formula_fix($submissionarray[$i]);
! 130: $script=~s/RESPONSE\[$n\]/$fixedsubmission/gs;
! 131: }
! 132: my @argumentarray=@{$argument};
! 133: for (my $i=0;$i<=$#argumentarray;$i++) {
! 134: my $n=$i+1;
! 135: my $fixedargument=&r_cas_formula_fix($argumentarray[$i]);
! 136: $script=~s/LONCAPALIST\[$n\]/$fixedargument/gs;
! 137: }
! 138: my $reply=&runscript($socket,$script,$libraries);
! 139: &disconnect($socket);
! 140: if ($reply=~/^\s*true\s*$/i) { return 'EXACT_ANS'; }
! 141: if ($reply=~/^\s*false\s*$/i) { return 'INCORRECT'; }
! 142: return 'BAD_FORMULA';
! 143: }
! 144:
! 145: sub r_eval {
! 146: my ($script,$libraries) = @_;
! 147: my $socket=&connect();
! 148: my $reply=&runscript($socket,$script,$libraries);
! 149: &disconnect($socket);
! 150: return $reply;
! 151: }
! 152:
! 153:
! 154: sub compareterms {
! 155: my ($socket,$terma,$termb)=@_;
! 156: my $difference=$terma.'-('.$termb.')';
! 157: if (&blacklisted($difference)) { return 'Error: blacklisted'; }
! 158: my $reply=&rreply($socket,$difference.';');
! 159: if ($reply=~/^\s*0\s*$/) { return 'true'; }
! 160: if ($reply=~/^Error\:/) { return $reply; }
! 161: return 'false';
! 162: }
! 163:
! 164: sub r_check {
! 165: my ($response,$answer,$reterror) = @_;
! 166: my $socket=&connect();
! 167: my $reply=&compareterms($socket,$response,$answer);
! 168: &disconnect($socket);
! 169: # integer to string mappings come from capaParser.h
! 170: # 1 maps to 'EXACT_ANS'
! 171: if ($reply eq 'true') { return 1; }
! 172: # 11 maps to 'BAD_FORMULA'
! 173: if ($reply=~/^Error\:/) { return 11; }
! 174: # 7 maps to 'INCORRECT'
! 175: return 7;
! 176: }
! 177:
! 178: 1;
! 179: __END__;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonr.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework