View of /trunk/webwork/system/cgi/cgi-scripts/problemEditor.pl

    1 #!/usr/bin/perl
    2 
    3 
    4 ##this program creates a web page with an editor for a
    5 ##WeBWorK problem.  it is called by processProblem8.pl
    6 
    7 
    8 use strict;
    9 use lib '/ww/webwork/development/'; # mainWeBWorKDirectory;
   10 use CGI qw(:standard escapeHTML unescapeHTML);
   11 use MIME::Base64 qw( encode_base64 decode_base64) ;
   12 use Global;
   13 use Auth;
   14 use Safe;
   15 $main::safeCompartment = 0;
   16 $main::safeCompartment = new Safe;
   17 
   18 #Set to 1 to log timing data. Set to 0 to disable log.
   19 $main::logTimingData = 0;
   20 
   21 # begin Timing code
   22 if( $main::logTimingData == 1 ) {
   23   use Benchmark;
   24   $main::beginTime = new Benchmark;
   25 }
   26 # end Timing code
   27 
   28 my $cgi = new CGI;
   29 my %inputs = $cgi -> Vars();
   30 
   31 # get information from CGI inputs  (see also below for additional information)
   32 my $Course      = $inputs{'course'};
   33 my $User      = $inputs{'user'};
   34 my $Session_key   = $inputs{'key'};
   35 my $randpsvn    = 22222; #int rand(1111,9999);
   36 my $psvn      = $inputs{'probSetKey'};  #psvn stands for Problem Set Version Number
   37 my $probNum     = 1;
   38   $probNum    = $inputs{'probNum'}  if defined($inputs{'probNum'});
   39 my $nextProbNum   = $probNum + 1    if defined($probNum);
   40 my $previousProbNum = $probNum - 1    if defined($probNum);
   41 my $mode      = "HTML";
   42   $mode     = $inputs{'Mode'}   if defined( $inputs{'Mode'} );
   43 my $showEdit    = $inputs{'showEdit'};
   44 my $seed      = $inputs{'seed'}   if defined( $inputs{'seed'} );
   45 my $Rows      = $Global::editor_window_rows;
   46   $Rows     = $inputs{'Rows'}   if defined( $inputs{'Rows'} );
   47 my $Columns     = $Global::editor_window_columns;
   48 $Columns      = $inputs{'Columns'}  if defined( $inputs{'Columns'} );
   49 
   50 # verify that information has been received
   51 unless($Course && $User && $Session_key && $psvn) {
   52   &wwerror( "$0, missing data",
   53     "The script did not receive the proper input data.
   54     course is $Course, user is $User, session key is $Session_key, psvn is $psvn",'','',
   55   query_string() );
   56 }
   57 
   58 
   59 # establish environment for this script
   60 &Global::getCourseEnvironment($Course);
   61 my $macroDirectory      = getCourseMacroDirectory();
   62 my $databaseDirectory   = getCourseDatabaseDirectory();
   63 my $htmlDirectory     = getCourseHtmlDirectory();
   64 my $htmlURL         = getCourseHtmlURL();
   65 my $scriptDirectory     = getWebworkScriptDirectory();
   66 my $templateDirectory   = getCourseTemplateDirectory();
   67 my $courseScriptsDirectory  = getCourseScriptsDirectory();
   68 
   69 require "${courseScriptsDirectory}$Global::displayMacros_pl";
   70 require "${scriptDirectory}$Global::DBglue_pl";
   71 require "${scriptDirectory}$Global::HTMLglue_pl";
   72 require "${scriptDirectory}$Global::FILE_pl";
   73 #require "${scriptDirectory}qz2sub.pl";   #require this only if it actually used
   74 
   75 my $permissionsFile = &Global::getCoursePermissionsFile($Course);
   76 my $permissions   = &get_permissions($User,$permissionsFile);
   77 
   78 my $keyFile     = &Global::getCourseKeyFile($Course);
   79 
   80 
   81 # log access
   82 &Global::log_info('', query_string);
   83 
   84 unless ($User eq "practice666" ) {
   85   #verify session key
   86   &verify_key($User, $Session_key, "$keyFile", $Course);
   87 }
   88 
   89 &attachProbSetRecord($psvn);
   90 
   91 # get problem name
   92 my $probFileName  = &getProblemFileName($probNum,$psvn);
   93 $probFileName   = $inputs{'probFileName'} if defined($inputs{'probFileName'});
   94 
   95 # get the text source of the problem
   96 
   97 my $source  = '';
   98 my $comment = '';
   99 
  100 #print "content-type: text/html\n\ninputs of action is $inputs{action}<BR>" if defined($inputs{action});
  101 
  102 if ( ($inputs{'action'} eq 'Revert to original and Resize window') || !(defined($inputs{'source'}) ) )  {
  103   $comment = '<h2> Using source from disk</h2>';
  104 
  105   if (-e "${templateDirectory}$probFileName" ) {
  106     #print "|$probFileName|<BR>";
  107     unless (-r "${templateDirectory}$probFileName") {
  108       wwerror($0, "Can't read ${templateDirectory}$probFileName");
  109     }
  110 
  111     open(PROB,"<${templateDirectory}$probFileName");
  112     $source = join("",<PROB>);
  113       close(PROB);
  114   }
  115   else {
  116     wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
  117   }
  118 }
  119 else {      #source is coming from HTML hidden tag; should be decoded
  120   $source = decodeSource( $inputs{'source'}) ;
  121 
  122 #     if ( defined($inputs{'source_encoded_using'}) ) {  # the source has been encoded and we need to decode it first
  123 #     if ( $inputs{'source_encoded_using'} eq 'base64_encode' )  {
  124 #       $source = decode_base64($source);
  125 #     }
  126 #     elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
  127 #       $source = $cgi -> unescape($source);
  128 #     }
  129 #     elsif ( $inputs{'source_encoded_using'} eq 'none' ) {
  130 #       # no action required
  131 #     }
  132 #     elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns' ) {
  133 #       $source =~ s/&#010;/\n/g;       #makes iCab work properly
  134 #     }
  135 #     else {
  136 #       warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
  137 #     }
  138 #    }
  139         ##substitute carriage return with a newline
  140       ##otherwise EndOfText construction does not work
  141       ##browsers always have \r\n at the end of the line
  142     #    $source=~ s/\r\n/\n/g;
  143 
  144   #$source = unescapeHTML( $source );     #method in CGI.pm
  145 }
  146 
  147 #$source =~ s/&#010;/\n/g;        #makes iCab work properly
  148 #my $sourceAsHTML = escapeHTML( $source );
  149 my $display_source = $source;
  150 $display_source = $source;    # Hard to tell what the right method for displaying text in a textarea form is.
  151 
  152 # #check if we need to save the updated version of the text
  153 # my $save=0;
  154 # if ( ($inputs{'action'} eq 'Save updated version') && ($permissions == $Global::instructor_permissions)  ) {
  155 #   saveProblem($source, $probFileName);
  156 #   $save=1;
  157 # }
  158 
  159 #### Beginning of the Editor portion
  160 
  161   print   &processProblem_htmlTOP("Editor for problem $probNum");
  162   print $comment;
  163 
  164 #   #text in case the problem has been saved
  165 #   if ($save) {
  166 #     print "<H3>Current version of the problem ${templateDirectory}$probFileName has been saved.</H3>
  167 #     <b>The original version has been appended to the file ${templateDirectory}$probFileName.bak . </b><BR>";
  168 #   }
  169   print "<BR>\r\n",
  170       $cgi -> startform(-action=>"$Global::processProblem_CGI", -target=>"problem"),
  171       "<BR>\r\n",
  172     $cgi -> hidden(-name=>'probNum',  -value=>$probNum),
  173     $cgi -> hidden(-name=>'probSetKey',   -value=>$psvn),
  174 
  175 # get course, user, key
  176     &sessionKeyInputs(\%inputs),
  177     qq!
  178       <STRONG>Editing file:</STRONG> $probFileName<BR>
  179     !,
  180     "Seed: ",
  181     $cgi -> textfield(-name=>'seed',-value=>$seed),
  182 
  183     " Mode: ";
  184 
  185 # Mode button
  186   if ($mode eq 'HTML')  {
  187     print $cgi -> popup_menu(-name=>'Mode',
  188         -'values'=>['HTML','HTML_tth','Latex2HTML'],
  189         -default=>'HTML');
  190   } elsif ($mode eq 'HTML_tth') {
  191     print $cgi -> popup_menu(-name=>'Mode',
  192         -'values'=>['HTML','HTML_tth','Latex2HTML'],
  193         -default=>'HTML_tth');
  194   } elsif ($mode eq 'Latex2HTML') {
  195     print $cgi -> popup_menu(-name=>'Mode',
  196         -'values'=>['HTML','HTML_tth','Latex2HTML'],
  197         -default=>'Latex2HTML');
  198 
  199   } else {
  200     print qq! Error: unknown mode: $mode !;
  201   }
  202 
  203 # Available functions list
  204 print "<BR>Available functions: ";
  205 print $cgi -> popup_menu( -name => 'availableFunctions',
  206     -values => [ qw{  DOCUMENT
  207               ENDDOCUMENT
  208               loadMacros
  209               beginproblem
  210               --------------
  211               TEXT
  212               BEGIN_TEXT
  213               END_TEXT
  214               EV3
  215               EV2
  216               --------------
  217               ANS
  218               ans_rule
  219               --------------
  220               random
  221               non_zero_random
  222               --------------
  223               spf
  224               sspf
  225               --------------
  226               begintable
  227               endtable
  228               row
  229               imageRow
  230               image
  231               caption
  232               --------------
  233               new_match_list
  234               ADDMORELATER...
  235               --------------
  236               OL
  237               invert
  238               NchooseK
  239               shuffle
  240               uniq
  241               lex_sort
  242               num_sort
  243             } ]
  244         );
  245 
  246 print "<BR>Available Constants: ";
  247 print $cgi -> popup_menu( -name => 'availableConstants',
  248     -values => [ qw{  @ALPHABET
  249               $PAR
  250               $BR
  251               $LQ
  252               $RQ
  253               $BM
  254               $EM
  255               $BDM
  256               $EDM
  257               $LTS
  258               $GTS
  259               $LTE
  260               $GTE
  261               $BEGIN_ONE_COLUMN
  262               $END_ONE_COLUMN
  263               $SOL
  264               $HINT
  265               $US
  266               $SPACE
  267               $BBOLD
  268               $EBOLD
  269               $HR
  270               $LBRACE
  271               $LBRACE
  272               $LB
  273               $RB
  274               $PI
  275               $E
  276             } ]
  277         );
  278 
  279 print "<BR>Answer Evaluators: ";
  280 print $cgi -> popup_menu( -name => 'answerEvaluators',
  281     -values => [ qw{  std_num_cmp
  282               frac_num_cmp
  283               arith_num_cmp
  284               strict_num_cmp
  285               --------------------
  286               std_num_cmp_abs
  287               frac_num_cmp_abs
  288               arith_num_cmp_abs
  289               strict_num_cmp_abs
  290               --------------------
  291               std_num_cmp_list
  292               frac_num_cmp_list
  293               arith_num_cmp_list
  294               strict_num_cmp_list
  295               --------------------
  296               std_num_cmp_abs_list
  297               frac_num_cmp_abs_list
  298               arith_num_cmp_abs_list
  299               strict_num_cmp_abs_list
  300               --------------------
  301               numerical_compare_with_units
  302               -------------------------------
  303               std_str_cmp
  304               std_cs_str_cmp
  305               strict_str_cmp
  306               unordered_str_cmp
  307               unordered_cs_str_cmp
  308               ordered_str_cmp
  309               ordered_cs_str_cmp
  310               --------------------
  311               std_str_cmp_list
  312               std_cs_str_cmp_list
  313               strict_str_cmp_list
  314               unordered_str_cmp_list
  315               unordered_cs_str_cmp_list
  316               ordered_str_cmp_list
  317               ordered_cs_str_cmp_list
  318               --------------------
  319               std_num_str_cmp
  320               -------------------------------
  321               function_cmp
  322               function_cmp_up_to_constant
  323               function_cmp_abs
  324               function_cmp_up_to_constant_abs
  325               multivar_function_cmp
  326               -------------------------------
  327               radio_cmp
  328               checkbox_cmp
  329 
  330             } ]
  331         );
  332 
  333 # Print text area with the problem
  334 
  335 
  336   print   '<p>',
  337       $cgi -> textarea(-name=>'source',
  338         -default=>$display_source,
  339         -rows=>$Rows,
  340         -columns=>$Columns,
  341         -override =>1
  342         ),    #-wrap=>'virtual'
  343       '<p>',
  344     $cgi -> hidden(-name => 'refreshLatex2HTML', -value => 1),
  345     $cgi -> hidden(-name => 'readSourceFromHTMLQ', -value => 1 ),
  346     '<p>',
  347     $cgi -> submit(-name=>'action',  -value=>'Refresh problem');
  348   if ($permissions == $Global::instructor_permissions) {
  349     print ' ', $cgi -> submit(-name=>'action', -value=>'Save updated version');
  350     print ' ', $cgi -> submit(-name=>'action', -value=>'Save as'),
  351       $cgi -> textfield(-name=>'new file name', -size => 40, -value=> "$probFileName"),
  352       '<br>For &quot;Save as&quot;, choose a new file name.';
  353   }
  354   print "\r\n",$cgi -> endform(),"\r\n","\r\n",;
  355   print
  356       "\r\n",
  357     $cgi -> startform(-action=>"$Global::problemEditor_CGI"),
  358     "\r\n",
  359     $cgi -> hidden(-name=>'probNum', -value=>$probNum),
  360     $cgi -> hidden(-name=>'probSetKey', -value=>$psvn),
  361 # get course, user, key
  362     &sessionKeyInputs(\%inputs),
  363     $cgi -> hidden(-name=>'Mode', -value=>'HTML'),
  364     $cgi -> hidden(-name=>'seed', -value=>$seed),
  365     hidden(-name=>'source', -value=>$source),
  366     $cgi -> submit(-name=>'action', -value=>'Revert to original and Resize window'),
  367     '  Rows: ',
  368     $cgi -> textfield(-name=>'Rows', -default=>$Rows, -size => 3),
  369     '  Columns: ',
  370     $cgi -> textfield(-name=>'Columns', -default=>$Columns, -size => 3),
  371 
  372     "\r\n",,
  373     $cgi -> endform(),
  374 
  375     &htmlBOTTOM($0, \%inputs);
  376 
  377 
  378 # begin Timing code
  379 if( $main::logTimingData == 1 ) {
  380   my $endTime = new Benchmark;
  381   &Global::logTimingInfo($main::beginTime,$endTime,'problemEditor.pl',$Course,$User);
  382 }
  383 # end Timing code
  384 
  385 exit;
  386 
  387 ###############################
  388 ##subroutines
  389 
  390 ##this subroutine is from processProblem
  391 ##why is it called processProblem_htmlTOP?  is there a generic htmlTOP?
  392 sub processProblem_htmlTOP {
  393     my ($title, $bg_url) = @_;
  394     my $background_url = $bg_url || $Global::background_plain_url;
  395     #my $out =  header(-type=>'text/html');
  396     my $out = <<EOF;
  397 Content-type: text/html
  398 
  399 
  400 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN"  "http://www.w3.org/TR/REC-html40/strict.dtd">
  401 
  402 
  403 EOF
  404 
  405     $out .= start_html(-'title'=>$title,
  406         -background=>$background_url);
  407 
  408   $out;
  409 }
  410 sub decodeSource {
  411   my $source = shift;
  412   warn "Only source embedded in HTML needs to be decoded" unless defined($inputs{'source'});
  413   if ( defined($inputs{'source_encoded_using'}) ) {  # the source has been encoded and we need to decode it first
  414     if ( $inputs{'source_encoded_using'} eq 'base64_encode' )  {
  415       $source = decode_base64($source);
  416     }
  417     elsif ( $inputs{'source_encoded_using'} eq 'cgi_escape' ) {
  418       $source = $cgi -> unescape($source);
  419     }
  420     elsif ( $inputs{'source_encoded_using'} eq 'none'  )    {
  421       # no action needed
  422     }
  423     elsif ( $inputs{'source_encoded_using'} eq 'escaped_returns'  )    {
  424       $source =~s/&#010;/\n/g;  warn "uncoding escaped returns";
  425       $source =~s/\r\n/\n/g;
  426     }
  427     else {
  428       warn "Did not recognize the source encoding method $inputs{'source_encoded_using'}";
  429     }
  430    }
  431      $source;
  432 }
  433 
  434 ##Subroutine saveProblem takes the modified source of the problem and
  435 ##saves it to the file with the original problem name and appends the
  436 ##old version of the problem to the file problemname.pg.bak
  437 # sub saveProblem {
  438 #   my ($source, $probFileName)= @_;
  439 #   my $org_source;
  440 #   ##get original source of the problem
  441 #   if (-e "${templateDirectory}$probFileName" ) {
  442 #     unless (-r "${templateDirectory}$probFileName") {
  443 #       wwerror($0, "Can't read ${templateDirectory}$probFileName");
  444 #     }
  445 #     open(PROB,"<${templateDirectory}$probFileName");
  446 #     $org_source = join("",<PROB>);
  447 #       close(PROB);
  448 #   } else {
  449 #     wwerror($0, "<H4>Error: The problem ${templateDirectory}$probFileName could not be found!</H4>");
  450 #   }
  451 #   ##append old version to problemfilename.pg.bak:
  452 #   open BAKFILE, ">>${templateDirectory}${probFileName}.bak" or
  453 #     wwerror($0, "Could not open ${templateDirectory}${probFileName}.bak for appending.");
  454 #   my ($sec, $min, $hour, $mday, $mon, $year)=localtime(time);
  455 #   print BAKFILE "##################################################################\n",
  456 #     "##########Date:: $mday-$mon-$year, $hour:$min:$sec#########", "\n\n\n";
  457 #   print BAKFILE $org_source;
  458 #   close BAKFILE;
  459 #   chmod 0660, "${templateDirectory}${probFileName}.bak";
  460 #   ##copy new version to the file problemfilename.pg
  461 #   open PROBLEM, ">${templateDirectory}$probFileName" or die
  462 #     wwerror($0, "Could not open ${templateDirectory}$probFileName for writing.
  463 #     Check that the  permissions for this problem are 660 (-rw-rw----)");
  464 #   print PROBLEM $source;
  465 #   close PROBLEM;
  466 #   chmod 0660, "${templateDirectory}${probFileName}";
  467 #
  468 # }
  469