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

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