[system] / trunk / xmlrpc / daemon / Webwork.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/Webwork.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 381 - (view) (download) (as text)

1 : gage 279 #!/usr/local/bin/perl -w
2 : gage 375
3 : gage 279 # Copyright (C) 2001 Michael Gage
4 :    
5 :     ###############################################################################
6 :     # The initial code simply initializes variables, defines addresses
7 :     # for directories, defines some simple subroutines responders used in debugging
8 :     # and makes sure that the appropriate CPAN library modules
9 :     # are available. The main code begins below that with the initialization
10 :     # of the PGtranslator5 module.
11 :     ###############################################################################
12 :     package Webwork;
13 :    
14 :     use strict;
15 :     use sigtrap;
16 :     use Carp;
17 : gage 320
18 : gage 279 #BEGIN {
19 :     # local $^W=0;
20 :     # require '/usr/local/lib/perl5/5.6.1/Benchmark.pm';
21 :     #}
22 : gage 328 print STDERR "using the perl version of MIME::Base64\n";
23 : gage 279 use MIME::Base64 qw( encode_base64 decode_base64);
24 :    
25 :    
26 :     # These libraries contain files which must at least be available, even though
27 :     # only Global.pm is actively used.
28 :    
29 : gage 375 use lib "/Users/gage/webwork/system/lib/", "/Users/gage/webwork/system/courseScripts/";
30 :     my $WEBWORKDIRECTORY = '/Users/gage/webwork/';
31 :     my $COURSESCRIPTSDIRECTORY = "/Users/gage/webwork/system/courseScripts/";
32 :     my $PGTRANSLATOR = "PGtranslator5.pm";
33 : gage 279
34 : gage 375 my $COURSETEMPDIRECTORY = '/Users/gage/Sites/demoCoursetmp/';
35 :     my $COURSETEMPURL = 'http://webwork-db.math.rochester.edu/~gage/demoCoursetmp';
36 :    
37 :    
38 :    
39 :     my $PASSWORD = 'geometry';
40 : gage 279 ###############################################################################
41 :    
42 :     BEGIN{
43 : gage 375 my $GLOBAL_INIT = "/Users/gage/webwork/system/lib/Global.pm";
44 :     print "Opening $GLOBAL_INIT\n";
45 : gage 279 require $GLOBAL_INIT or die $GLOBAL_INIT;
46 :     import Global;
47 :     }
48 :    
49 :    
50 : gage 375
51 : gage 279 require $PGTRANSLATOR or die "Can't open $PGTRANSLATOR";
52 :    
53 :     ###############################################################################
54 : gage 375 # List and address myof available problemlibraries
55 : gage 279 ###############################################################################
56 :    
57 :    
58 : gage 375 my $libraryPath = '${WEBWORKDIRECTORY}rochester_problib/';
59 : gage 279
60 : gage 375 my %AVAILABLE_PROBLEM_LIBRARIES = ( ww_prob_lib => "${WEBWORKDIRECTORY}rochester_problib/",
61 :     indiana_prob_lib => "${WEBWORKDIRECTORY}Indiana_prob_lib/",
62 : gage 279 capaOK_lib => '/ww/webwork/courses1/capaOK/templates/',
63 :     capa_lib => '/ww/webwork/courses/capa/templates/',
64 :     prob_lib_cvs => '/ww/webwork/courses/WW_Prob_Lib_CVS/templates/',
65 :     maa_100 => '/ww/webwork/courses/maa100/templates/',
66 :     teitel_physics121 => '/ww/webwork/courses/teitel-phy121/templates/',
67 :     );
68 :    
69 :     ###############################################################################
70 :     # Configure daemon:
71 :     ###############################################################################
72 : gage 375 my $courseScriptsDirectory = $COURSESCRIPTSDIRECTORY;
73 :     my $macroDirectory = "${courseScriptsDirectory}macros/";
74 :     my $scriptDirectory = "${WEBWORKDIRECTORY}system/scripts/";
75 :     my $templateDirectory = "${WEBWORKDIRECTORY}courseData/rochester_problib/";
76 : gage 279
77 : gage 375 $Global::courseTempDirectory = $COURSETEMPDIRECTORY;
78 :     $Global::courseTempURL = $COURSETEMPURL;
79 : gage 279
80 :    
81 : gage 375 $Global::groupID = "webadmin";
82 : gage 279 $Global::numericalGroupID = 1005;
83 :    
84 : gage 320 my $displayMode = 'HTML_tth';
85 : gage 279
86 :     my $PG_PL = "${courseScriptsDirectory}PG.pl";
87 :     my $DANGEROUS_MACROS_PL = "${courseScriptsDirectory}dangerousMacros.pl";
88 :     my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun",
89 :     "Circle", "Label", "PGrandom", "Units", "Hermite",
90 :     "List", "Match","Multiple", "Select", "AlgParser",
91 :     "AnswerHash", "Fraction", "VectorField", "Complex1",
92 :     "Complex", "MatrixReal1", "Matrix","Distributions",
93 :     "Regression"
94 :     );
95 : gage 375 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr",
96 : gage 279 "ExprWithImplicitExpand", "AnswerEvaluator",
97 : gage 375 "AnswerEvaluatorMaker"
98 :    
99 :     );
100 :    
101 :     my $INITIAL_MACRO_PACKAGES;
102 :     unless (defined ($main::do_not_preload_macros) && $main::do_not_preload_macros == 1) {
103 :     $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
104 :     DOCUMENT();
105 :     loadMacros(
106 : gage 328 "PGbasicmacros.pl",
107 :     "PGchoicemacros.pl",
108 :     "PGanswermacros.pl",
109 :     "PGnumericalmacros.pl",
110 :     "PGgraphmacros.pl",
111 :     "PGauxiliaryFunctions.pl",
112 :     "PGmatrixmacros.pl",
113 :     "PGcomplexmacros.pl",
114 : gage 375 "PGstatisticsmacros.pl"
115 :    
116 : gage 328 );
117 : gage 375
118 :     ENDDOCUMENT();
119 : gage 279
120 :     END_OF_TEXT
121 : gage 375 } else {
122 :     $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
123 :     DOCUMENT();
124 :     loadMacros(
125 :     # "PGbasicmacros.pl",
126 :     # "PGchoicemacros.pl",
127 :     # "PGanswermacros.pl",
128 :     # "PGnumericalmacros.pl",
129 :     # "PGgraphmacros.pl",
130 :     # "PGauxiliaryFunctions.pl",
131 :     # "PGmatrixmacros.pl",
132 :     # "PGcomplexmacros.pl",
133 :     # "PGstatisticsmacros.pl"
134 :    
135 :     );
136 :    
137 :     ENDDOCUMENT();
138 :    
139 :     END_OF_TEXT
140 : gage 279
141 : gage 375
142 :     }
143 :    
144 : gage 279 ###############################################################################
145 :     #
146 :     ###############################################################################
147 :    
148 :     ###############################################################################
149 :     ###############################################################################
150 :    
151 : gage 375 print STDERR "ok so far reading file ${WEBWORKDIRECTORY}xmlrpc/daemon/Webwork.pm\n";
152 : gage 279
153 :    
154 :    
155 :     ###############################################################################
156 : gage 375 #
157 :     # INITIALIZATION
158 :     #
159 : gage 279 # The following code initializes an instantiation of PGtranslator5 in the
160 :     # parent process. This initialized object is then share with each of the
161 :     # children forked from this parent process by the daemon.
162 :     #
163 :     # As far as I can tell, the child processes don't share any variable values even
164 :     # though their namespaces are the same.
165 :     ###############################################################################
166 :    
167 : gage 375 print STDERR "Begin intitalization\n";
168 : gage 279 my $dummy_envir = { courseScriptsDirectory => $courseScriptsDirectory,
169 :     displayMode => $displayMode,
170 :     macroDirectory => $macroDirectory};
171 :     my $pt = new PGtranslator5; #pt stands for problem translator;
172 :     $pt ->rh_directories( { courseScriptsDirectory => $courseScriptsDirectory,
173 :     macroDirectory => $macroDirectory,
174 :     scriptDirectory => $scriptDirectory ,
175 :     templateDirectory => $templateDirectory,
176 :     tempDirectory => $Global::courseTempDirectory,
177 :     }
178 :     );
179 :     $pt -> evaluate_modules( @MODULE_LIST);
180 :     $pt -> load_extra_packages( @EXTRA_PACKAGES );
181 :     $pt -> environment($dummy_envir);
182 :     $pt->initialize();
183 : gage 375 my $loadErrors = $pt -> unrestricted_load($PG_PL );
184 :     print STDERR "$loadErrors\n" if ($loadErrors);
185 :     $loadErrors = $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
186 :     print STDERR "$loadErrors\n" if ($loadErrors);
187 : gage 279 $pt-> set_mask();
188 :     #
189 : gage 375 # print STDERR "\nPG.pl: $PG_PL\n";
190 :     # print STDERR "DANGEROUS_MACROS_PL: $DANGEROUS_MACROS_PL\n";
191 :     # print STDERR "Print dummy environment\n";
192 :     # print STDERR pretty_print_rh($dummy_envir), "\n\n";
193 : gage 279
194 : gage 375 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; # change everything to unix line endings.
195 : gage 279 $pt->source_string( $INITIAL_MACRO_PACKAGES );
196 :     $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
197 :     $pt ->translate();
198 : gage 320
199 :     print STDERR "New PGtranslator object inititialization completed.\n";
200 : gage 279 ################################################################################
201 :     ## This ends the initialization of the PGtranslator object
202 :     ################################################################################
203 :    
204 :     ###############################################################################
205 :     # This subroutine is called by the child process. It reinitializes its copy of the
206 :     # PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5
207 :     # have been modified so that if &_PG_init is already defined then nothing
208 :     # is read in but the initialization subroutine is run instead.
209 :     ###############################################################################
210 :    
211 :     sub renderProblem {
212 :     my $rh = shift;
213 :     my $beginTime = new Benchmark;
214 :     $Global::WARNINGS = "";
215 :     $pt->environment($rh->{envir});
216 : gage 375
217 :     # print STDERR pretty_print_rh($rh->{envir}), "\n\n";
218 :    
219 : gage 279 $pt->initialize();
220 :     $pt -> unrestricted_load($PG_PL);
221 :     $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
222 :     $pt-> set_mask();
223 :    
224 :     my $string = decode_base64( $rh ->{source} );
225 :     $string =~ tr /\r/\n/;
226 :    
227 :     $pt->source_string( $string );
228 :     $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
229 :     $pt ->translate();
230 :    
231 :    
232 :     # Determine which problem grader to use
233 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default
234 :     my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
235 :    
236 :     if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty
237 :     if ($problem_grader_to_use eq 'std_problem_grader') {
238 :     # Reset problem grader to standard problem grader.
239 :     $pt->rf_problem_grader($pt->rf_std_problem_grader);
240 :     } elsif ($problem_grader_to_use eq 'avg_problem_grader') {
241 :     # Reset problem grader to average problem grader.
242 :     $pt->rf_problem_grader($pt->rf_avg_problem_grader);
243 :     } elsif (ref($problem_grader_to_use) eq 'CODE') {
244 :     # Set problem grader to instructor defined problem grader -- use cautiously.
245 :     $pt->rf_problem_grader($problem_grader_to_use)
246 :     } else {
247 :     warn "Error: Could not understand problem grader flag $problem_grader_to_use";
248 :     #this is the default set by the translator and used if the flag is not understood
249 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader);
250 :     }
251 :    
252 :     } else {#this is the default set by the translator and used if no flag is set.
253 :     $pt->rf_problem_grader($pt->rf_std_problem_grader);
254 :     }
255 :    
256 :     # creates and stores a hash of answer results: $rh_answer_results
257 :     $pt -> process_answers($rh->{envir}->{inputs_ref});
258 :    
259 :    
260 :     $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score},
261 :     num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} ,
262 :     num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans}
263 :     } );
264 :     my %PG_FLAGS = $pt->h_flags;
265 :     my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
266 :     $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
267 :     my $answers_submitted = 0;
268 :     $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
269 :    
270 :     my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
271 :     ANSWER_ENTRY_ORDER => $ra_answer_entry_order
272 :     ); # grades the problem.
273 :     # protect image data for delivery via XML-RPC.
274 :     # Don't send code data.
275 :     my %PG_flag=();
276 :     # foreach my $key (keys %PG_FLAGS) {
277 :     # if ($key eq 'dynamic_images' ) {
278 :     # foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} }) {
279 :     # $PG_flag{'dynamic_images'}->{$ikey} =
280 :     # encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey});
281 :     # }
282 :     # } elsif (ref($PG_FLAGS{$key}) eq '' or ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) {
283 :     # $PG_flag{$key} = $PG_FLAGS{$key} ;
284 :     # }
285 :     # }
286 :    
287 :    
288 :     my $out = {
289 :     text => encode_base64( ${$pt ->r_text()} ),
290 :     header_text => encode_base64( ${ $pt->r_header } ),
291 :     answers => $pt->rh_evaluated_answers,
292 :     errors => $pt-> errors(),
293 :     WARNINGS => encode_base64($Global::WARNINGS ),
294 :     problem_result => $rh_problem_result,
295 :     problem_state => $rh_problem_state,
296 :     PG_flag => \%PG_flag
297 :     };
298 :     my $endTime = new Benchmark;
299 :     $out->{compute_time} = logTimingInfo($beginTime, $endTime);
300 :     $out;
301 :    
302 :     }
303 :    
304 :     ###############################################################################
305 :     # This ends the main subroutine executed by the child process in responding to
306 :     # a request. The other subroutines are auxiliary.
307 :     ###############################################################################
308 :    
309 :    
310 :     sub safetyFilter {
311 :     my $answer = shift; # accepts one answer and checks it
312 :     my $submittedAnswer = $answer;
313 :     $answer = '' unless defined $answer;
314 :     my ($errorno, $answerIsCorrectQ);
315 :     $answer =~ tr/\000-\037/ /;
316 :     #### Return if answer field is empty ########
317 :     unless ($answer =~ /\S/) {
318 :     # $errorno = "<BR>No answer was submitted.";
319 :     $errorno = 0; ## don't report blank answer as error
320 :    
321 :     return ($answer,$errorno);
322 :     }
323 :     ######### replace ^ with ** (for exponentiation)
324 :     # $answer =~ s/\^/**/g;
325 :     ######### Return if forbidden characters are found
326 :     unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) {
327 :     $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
328 :     $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
329 :    
330 :     return ($answer,$errorno);
331 :     }
332 :    
333 :     $errorno = 0;
334 :     return($answer, $errorno);
335 :     }
336 :    
337 :    
338 :     sub logTimingInfo{
339 :     my ($beginTime,$endTime,) = @_;
340 :     my $out = "";
341 :     $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) );
342 :     $out;
343 :     }
344 :    
345 :     ###############
346 :    
347 :     sub echo {
348 :     my $in= shift;
349 : gage 375 print "data $in end data\n";
350 : gage 279 return(ref($in));
351 :     }
352 :     sub hello {
353 :     print "Receiving request for hello world\n";
354 :     return "Hello world";
355 :     }
356 :     sub pretty_print_rh {
357 :     my $rh = shift;
358 :     my $out = "";
359 :     my $type = ref($rh);
360 :     if ( ref($rh) =~/HASH/ ) {
361 :     foreach my $key (sort keys %{$rh}) {
362 :     $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
363 :     }
364 :     } elsif ( ref($rh) =~ /SCALAR/ ) {
365 :     $out = "scalar reference ". ${$rh};
366 :     } elsif ( ref($rh) =~/Base64/ ) {
367 :     $out .= "base64 reference " .$$rh;
368 :     } else {
369 :     $out = $rh;
370 :     }
371 :     if (defined($type) ) {
372 : gage 381 $out .= " (type = $type )\n";
373 : gage 279 }
374 :     return $out;
375 :     }
376 :    
377 :     #sub xmlquit {
378 :     # print "exiting daemon\n";
379 :     # return "";
380 :     #}
381 :    
382 :     ###############################################################################
383 :     #OTHER SERVICES
384 :     ###############################################################################
385 :    
386 :    
387 : gage 375
388 : gage 279 use File::stat;
389 :     sub readFile {
390 :     my $rh = shift;
391 :     local($|)=1;
392 :     my $out = {};
393 :     my $filePath = $rh->{filePath};
394 :     unless ($rh->{pw} eq $PASSWORD ) {
395 :     $out->{error}=404;
396 :     return($out);
397 :     }
398 :     if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) {
399 :     $filePath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} . $filePath;
400 :     } else {
401 :     $out->{error} = "Could not find library:".$rh->{library_name}.":";
402 :     return($out);
403 :     }
404 :    
405 :     if (-r $filePath) {
406 :     open IN, "<$filePath";
407 :     local($/)=undef;
408 :     my $text = <IN>;
409 :     $out->{text}= encode_base64($text);
410 :     my $sb=stat($filePath);
411 :     $out->{size}=$sb->size;
412 :     $out->{path}=$filePath;
413 :     $out->{permissions}=$sb->mode&07777;
414 :     $out->{modTime}=scalar localtime $sb->mtime;
415 :     close(IN);
416 :     } else {
417 :     $out->{error} = "Could not read file at |$filePath|";
418 :     }
419 :     return($out);
420 :     }
421 :    
422 :    
423 :    
424 :     use File::Find;
425 :     sub listLib {
426 :     my $rh = shift;
427 :     my $out = {};
428 :     my $dirPath;
429 :     unless ($rh->{pw} eq $PASSWORD ) {
430 :     $out->{error}=404;
431 :     return($out);
432 :     }
433 :    
434 :     if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) {
435 :     $dirPath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ;
436 :     } else {
437 :     $out->{error} = "Could not find library:".$rh->{library_name}.":";
438 :     return($out);
439 :     }
440 :    
441 :     my @outListLib;
442 :     my $wanted = sub {
443 :     my $name = $File::Find::name;
444 :     my @out=();
445 :     if ($name =~/\S/ ) {
446 :     $name =~ s|^$dirPath||o; # cut the first directory
447 :     push(@outListLib, "$name\n") if $name =~/\.pg/;
448 :     }
449 :     };
450 :     my $command = $rh->{command};
451 :     $command = 'all' unless defined($command);
452 :     $command eq 'all' && do {print "$dirPath\n\n";
453 :     find($wanted, $dirPath);
454 :     @outListLib = sort @outListLib;
455 :     $out->{ra_out} = \@outListLib;
456 :     $out->{text} = join("", sort @outListLib);
457 :     return($out);
458 :     };
459 :     $command eq 'setsOnly' && do {
460 :     if ( opendir(DIR, $dirPath) ) {
461 :     my @fileList=();
462 :     while (defined(my $file = readdir(DIR))) {
463 :     push(@fileList,$file) if -d "$dirPath/$file";
464 :    
465 :     }
466 :     $out->{text} = join("\n",sort @fileList);
467 :     closedir(DIR);
468 :     } else {
469 :     $out->{error}= "Can't open directory $dirPath";
470 :     }
471 :     return($out);
472 :     };
473 :     $command eq 'listSet' && do { my $dirPath2 = $dirPath . $rh->{set};
474 :    
475 :     if ( opendir(DIR, $dirPath2) ) {
476 :     my @fileList =();
477 :     while (defined(my $file = readdir(DIR))) {
478 :     if (-d "$dirPath2/$file") {
479 :     push(@fileList, "$file/${file}.pg");
480 :    
481 :     } elsif ($file =~ /.pg$/ ) { # file ends in .pg
482 :     push(@fileList, $file);
483 :    
484 :     }
485 :    
486 :    
487 :     }
488 :     $out->{text} = join("\n",sort @fileList);
489 :     closedir(DIR);
490 :     } else {
491 :     $out->{error}= "Can't open directory $dirPath2";
492 :     }
493 :    
494 :     return($out);
495 :     };
496 :     # else
497 :     $out->{error}="Unrecognized command $command";
498 :     $out;
499 :     }
500 :    

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9