[system] / trunk / xmlrpc / modules / Webwork_save.pm Repository:
ViewVC logotype

View of /trunk/xmlrpc/modules/Webwork_save.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (as text) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 3 months ago) by gage
File size: 15350 byte(s)
Experimental xmlrpc WeBWorK webservices

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9