Parent Directory
| 
Revision Log
Revision 518 - (view) (download) (as text)
| 1 : | gage | 279 | #!/usr/local/bin/perl -w |
| 2 : | gage | 497 | use Safe; |
| 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 : | gage | 497 | |
| 13 : | gage | 279 | package Webwork; |
| 14 : | |||
| 15 : | use strict; | ||
| 16 : | use sigtrap; | ||
| 17 : | use Carp; | ||
| 18 : | gage | 497 | use WeBWorK::PG::Translator; |
| 19 : | gage | 279 | #BEGIN { |
| 20 : | # local $^W=0; | ||
| 21 : | # require '/usr/local/lib/perl5/5.6.1/Benchmark.pm'; | ||
| 22 : | #} | ||
| 23 : | gage | 328 | print STDERR "using the perl version of MIME::Base64\n"; |
| 24 : | gage | 279 | use MIME::Base64 qw( encode_base64 decode_base64); |
| 25 : | |||
| 26 : | |||
| 27 : | |||
| 28 : | gage | 386 | |
| 29 : | gage | 279 | |
| 30 : | gage | 375 | |
| 31 : | gage | 279 | ############################################################################### |
| 32 : | gage | 497 | # List and address of available problemlibraries |
| 33 : | gage | 279 | ############################################################################### |
| 34 : | |||
| 35 : | |||
| 36 : | gage | 497 | my $libraryPath = '/u/gage/webwork/ww_prob_lib/'; |
| 37 : | gage | 279 | |
| 38 : | gage | 497 | my %AVAILABLE_PROBLEM_LIBRARIES = ( ww_prob_lib => '/u/gage/webwork/rochester_problib/', |
| 39 : | indiana_prob_lib => '/u/gage/webwork/Indiana_prob_lib/', | ||
| 40 : | gage | 279 | capaOK_lib => '/ww/webwork/courses1/capaOK/templates/', |
| 41 : | capa_lib => '/ww/webwork/courses/capa/templates/', | ||
| 42 : | prob_lib_cvs => '/ww/webwork/courses/WW_Prob_Lib_CVS/templates/', | ||
| 43 : | maa_100 => '/ww/webwork/courses/maa100/templates/', | ||
| 44 : | teitel_physics121 => '/ww/webwork/courses/teitel-phy121/templates/', | ||
| 45 : | ); | ||
| 46 : | |||
| 47 : | ############################################################################### | ||
| 48 : | # Configure daemon: | ||
| 49 : | ############################################################################### | ||
| 50 : | gage | 497 | my $courseScriptsDirectory = '/u/gage/webwork/system/courseScripts/'; |
| 51 : | my $macroDirectory = '/ww/webwork/courses/gage_course/templates/macros/'; | ||
| 52 : | my $scriptDirectory = '/u/gage/webwork/system/scripts/'; | ||
| 53 : | my $templateDirectory = '/ww/webwork/courses/gage_course/templates/'; | ||
| 54 : | gage | 279 | |
| 55 : | gage | 497 | $Global::courseTempDirectory = '/ww/htdocs/tmp/gage_course/'; |
| 56 : | $Global::courseTempURL = 'http://webwork-db.math.rochester.edu/tmp/gage_course/'; | ||
| 57 : | gage | 279 | |
| 58 : | |||
| 59 : | gage | 497 | $Global::groupID = "webwork"; |
| 60 : | gage | 279 | $Global::numericalGroupID = 1005; |
| 61 : | |||
| 62 : | gage | 320 | my $displayMode = 'HTML_tth'; |
| 63 : | gage | 279 | |
| 64 : | my $PG_PL = "${courseScriptsDirectory}PG.pl"; | ||
| 65 : | my $DANGEROUS_MACROS_PL = "${courseScriptsDirectory}dangerousMacros.pl"; | ||
| 66 : | gage | 497 | my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", |
| 67 : | gage | 279 | "Circle", "Label", "PGrandom", "Units", "Hermite", |
| 68 : | "List", "Match","Multiple", "Select", "AlgParser", | ||
| 69 : | "AnswerHash", "Fraction", "VectorField", "Complex1", | ||
| 70 : | "Complex", "MatrixReal1", "Matrix","Distributions", | ||
| 71 : | "Regression" | ||
| 72 : | gage | 497 | ); |
| 73 : | gage | 386 | my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", |
| 74 : | gage | 279 | "ExprWithImplicitExpand", "AnswerEvaluator", |
| 75 : | gage | 497 | # "AnswerEvaluatorMaker" |
| 76 : | ); | ||
| 77 : | my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; | ||
| 78 : | DOCUMENT(); | ||
| 79 : | loadMacros( | ||
| 80 : | "PGbasicmacros.pl", | ||
| 81 : | "PGchoicemacros.pl", | ||
| 82 : | "PGanswermacros.pl", | ||
| 83 : | "PGnumericalmacros.pl", | ||
| 84 : | "PGgraphmacros.pl", | ||
| 85 : | "PGauxiliaryFunctions.pl", | ||
| 86 : | "PGmatrixmacros.pl", | ||
| 87 : | "PGstatisticsmacros.pl", | ||
| 88 : | "PGcomplexmacros.pl", | ||
| 89 : | gage | 328 | ); |
| 90 : | gage | 497 | |
| 91 : | ENDDOCUMENT(); | ||
| 92 : | gage | 386 | |
| 93 : | gage | 279 | END_OF_TEXT |
| 94 : | |||
| 95 : | ############################################################################### | ||
| 96 : | # | ||
| 97 : | ############################################################################### | ||
| 98 : | |||
| 99 : | ############################################################################### | ||
| 100 : | ############################################################################### | ||
| 101 : | |||
| 102 : | gage | 497 | #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; |
| 103 : | gage | 279 | |
| 104 : | |||
| 105 : | |||
| 106 : | ############################################################################### | ||
| 107 : | # The following code initializes an instantiation of PGtranslator5 in the | ||
| 108 : | # parent process. This initialized object is then share with each of the | ||
| 109 : | # children forked from this parent process by the daemon. | ||
| 110 : | # | ||
| 111 : | # As far as I can tell, the child processes don't share any variable values even | ||
| 112 : | # though their namespaces are the same. | ||
| 113 : | ############################################################################### | ||
| 114 : | |||
| 115 : | gage | 497 | |
| 116 : | gage | 279 | my $dummy_envir = { courseScriptsDirectory => $courseScriptsDirectory, |
| 117 : | displayMode => $displayMode, | ||
| 118 : | gage | 497 | macroDirectory => $macroDirectory}; |
| 119 : | my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator; | ||
| 120 : | gage | 279 | $pt ->rh_directories( { courseScriptsDirectory => $courseScriptsDirectory, |
| 121 : | macroDirectory => $macroDirectory, | ||
| 122 : | scriptDirectory => $scriptDirectory , | ||
| 123 : | templateDirectory => $templateDirectory, | ||
| 124 : | tempDirectory => $Global::courseTempDirectory, | ||
| 125 : | } | ||
| 126 : | ); | ||
| 127 : | $pt -> evaluate_modules( @MODULE_LIST); | ||
| 128 : | gage | 497 | #print STDERR "Completed loading of modules, now loading extra packages\n"; |
| 129 : | gage | 279 | $pt -> load_extra_packages( @EXTRA_PACKAGES ); |
| 130 : | gage | 497 | #print STDERR "Completed loading of packages, now loading environment\n"; |
| 131 : | gage | 279 | $pt -> environment($dummy_envir); |
| 132 : | gage | 497 | #print STDERR "Completed loading environment, next initialize\n"; |
| 133 : | gage | 279 | $pt->initialize(); |
| 134 : | gage | 497 | #print STDERR "Initialized. \n"; |
| 135 : | $pt -> unrestricted_load($PG_PL ); | ||
| 136 : | $pt -> unrestricted_load($DANGEROUS_MACROS_PL); | ||
| 137 : | gage | 279 | $pt-> set_mask(); |
| 138 : | # | ||
| 139 : | gage | 497 | #print STDERR "Unrestricted loads completed.\n"; |
| 140 : | gage | 279 | |
| 141 : | gage | 497 | $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; |
| 142 : | gage | 279 | $pt->source_string( $INITIAL_MACRO_PACKAGES ); |
| 143 : | gage | 497 | #print STDERR "source strings read in\n"; |
| 144 : | gage | 279 | $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter |
| 145 : | $pt ->translate(); | ||
| 146 : | gage | 320 | |
| 147 : | print STDERR "New PGtranslator object inititialization completed.\n"; | ||
| 148 : | gage | 279 | ################################################################################ |
| 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 : | gage | 497 | #$pt->{safe_cache} = $safe_cmpt_cache; |
| 165 : | gage | 279 | $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 : | |||
| 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 : | errors => $pt-> errors(), | ||
| 239 : | WARNINGS => encode_base64($Global::WARNINGS ), | ||
| 240 : | problem_result => $rh_problem_result, | ||
| 241 : | problem_state => $rh_problem_state, | ||
| 242 : | PG_flag => \%PG_flag | ||
| 243 : | }; | ||
| 244 : | my $endTime = new Benchmark; | ||
| 245 : | $out->{compute_time} = logTimingInfo($beginTime, $endTime); | ||
| 246 : | $out; | ||
| 247 : | |||
| 248 : | } | ||
| 249 : | |||
| 250 : | ############################################################################### | ||
| 251 : | # This ends the main subroutine executed by the child process in responding to | ||
| 252 : | # a request. The other subroutines are auxiliary. | ||
| 253 : | ############################################################################### | ||
| 254 : | |||
| 255 : | |||
| 256 : | sub safetyFilter { | ||
| 257 : | my $answer = shift; # accepts one answer and checks it | ||
| 258 : | my $submittedAnswer = $answer; | ||
| 259 : | $answer = '' unless defined $answer; | ||
| 260 : | my ($errorno, $answerIsCorrectQ); | ||
| 261 : | $answer =~ tr/\000-\037/ /; | ||
| 262 : | #### Return if answer field is empty ######## | ||
| 263 : | unless ($answer =~ /\S/) { | ||
| 264 : | # $errorno = "<BR>No answer was submitted."; | ||
| 265 : | $errorno = 0; ## don't report blank answer as error | ||
| 266 : | |||
| 267 : | return ($answer,$errorno); | ||
| 268 : | } | ||
| 269 : | ######### replace ^ with ** (for exponentiation) | ||
| 270 : | # $answer =~ s/\^/**/g; | ||
| 271 : | ######### Return if forbidden characters are found | ||
| 272 : | unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { | ||
| 273 : | $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; | ||
| 274 : | $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; | ||
| 275 : | |||
| 276 : | return ($answer,$errorno); | ||
| 277 : | } | ||
| 278 : | |||
| 279 : | $errorno = 0; | ||
| 280 : | return($answer, $errorno); | ||
| 281 : | } | ||
| 282 : | |||
| 283 : | |||
| 284 : | sub logTimingInfo{ | ||
| 285 : | my ($beginTime,$endTime,) = @_; | ||
| 286 : | my $out = ""; | ||
| 287 : | $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) ); | ||
| 288 : | $out; | ||
| 289 : | } | ||
| 290 : | |||
| 291 : | ############### | ||
| 292 : | |||
| 293 : | sub echo { | ||
| 294 : | my $in= shift; | ||
| 295 : | return(ref($in)); | ||
| 296 : | } | ||
| 297 : | sub hello { | ||
| 298 : | print "Receiving request for hello world\n"; | ||
| 299 : | return "Hello world"; | ||
| 300 : | } | ||
| 301 : | sub pretty_print_rh { | ||
| 302 : | my $rh = shift; | ||
| 303 : | my $out = ""; | ||
| 304 : | my $type = ref($rh); | ||
| 305 : | if ( ref($rh) =~/HASH/ ) { | ||
| 306 : | foreach my $key (sort keys %{$rh}) { | ||
| 307 : | $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; | ||
| 308 : | } | ||
| 309 : | } elsif ( ref($rh) =~ /SCALAR/ ) { | ||
| 310 : | $out = "scalar reference ". ${$rh}; | ||
| 311 : | } elsif ( ref($rh) =~/Base64/ ) { | ||
| 312 : | $out .= "base64 reference " .$$rh; | ||
| 313 : | } else { | ||
| 314 : | $out = $rh; | ||
| 315 : | } | ||
| 316 : | if (defined($type) ) { | ||
| 317 : | gage | 497 | $out .= "type = $type \n"; |
| 318 : | gage | 279 | } |
| 319 : | return $out; | ||
| 320 : | } | ||
| 321 : | |||
| 322 : | #sub xmlquit { | ||
| 323 : | # print "exiting daemon\n"; | ||
| 324 : | # return ""; | ||
| 325 : | #} | ||
| 326 : | |||
| 327 : | ############################################################################### | ||
| 328 : | #OTHER SERVICES | ||
| 329 : | ############################################################################### | ||
| 330 : | |||
| 331 : | gage | 497 | my $PASSWORD = 'geometry'; |
| 332 : | gage | 279 | |
| 333 : | use File::stat; | ||
| 334 : | sub readFile { | ||
| 335 : | my $rh = shift; | ||
| 336 : | local($|)=1; | ||
| 337 : | my $out = {}; | ||
| 338 : | my $filePath = $rh->{filePath}; | ||
| 339 : | unless ($rh->{pw} eq $PASSWORD ) { | ||
| 340 : | $out->{error}=404; | ||
| 341 : | return($out); | ||
| 342 : | } | ||
| 343 : | if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { | ||
| 344 : | $filePath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} . $filePath; | ||
| 345 : | } else { | ||
| 346 : | $out->{error} = "Could not find library:".$rh->{library_name}.":"; | ||
| 347 : | return($out); | ||
| 348 : | } | ||
| 349 : | |||
| 350 : | if (-r $filePath) { | ||
| 351 : | open IN, "<$filePath"; | ||
| 352 : | local($/)=undef; | ||
| 353 : | my $text = <IN>; | ||
| 354 : | $out->{text}= encode_base64($text); | ||
| 355 : | my $sb=stat($filePath); | ||
| 356 : | $out->{size}=$sb->size; | ||
| 357 : | $out->{path}=$filePath; | ||
| 358 : | $out->{permissions}=$sb->mode&07777; | ||
| 359 : | $out->{modTime}=scalar localtime $sb->mtime; | ||
| 360 : | close(IN); | ||
| 361 : | } else { | ||
| 362 : | $out->{error} = "Could not read file at |$filePath|"; | ||
| 363 : | } | ||
| 364 : | return($out); | ||
| 365 : | } | ||
| 366 : | |||
| 367 : | |||
| 368 : | |||
| 369 : | use File::Find; | ||
| 370 : | sub listLib { | ||
| 371 : | my $rh = shift; | ||
| 372 : | my $out = {}; | ||
| 373 : | my $dirPath; | ||
| 374 : | unless ($rh->{pw} eq $PASSWORD ) { | ||
| 375 : | $out->{error}=404; | ||
| 376 : | return($out); | ||
| 377 : | } | ||
| 378 : | |||
| 379 : | if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { | ||
| 380 : | $dirPath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ; | ||
| 381 : | } else { | ||
| 382 : | $out->{error} = "Could not find library:".$rh->{library_name}.":"; | ||
| 383 : | return($out); | ||
| 384 : | } | ||
| 385 : | |||
| 386 : | my @outListLib; | ||
| 387 : | my $wanted = sub { | ||
| 388 : | my $name = $File::Find::name; | ||
| 389 : | my @out=(); | ||
| 390 : | if ($name =~/\S/ ) { | ||
| 391 : | $name =~ s|^$dirPath||o; # cut the first directory | ||
| 392 : | push(@outListLib, "$name\n") if $name =~/\.pg/; | ||
| 393 : | } | ||
| 394 : | }; | ||
| 395 : | my $command = $rh->{command}; | ||
| 396 : | $command = 'all' unless defined($command); | ||
| 397 : | $command eq 'all' && do {print "$dirPath\n\n"; | ||
| 398 : | find($wanted, $dirPath); | ||
| 399 : | @outListLib = sort @outListLib; | ||
| 400 : | $out->{ra_out} = \@outListLib; | ||
| 401 : | $out->{text} = join("", sort @outListLib); | ||
| 402 : | return($out); | ||
| 403 : | }; | ||
| 404 : | $command eq 'setsOnly' && do { | ||
| 405 : | if ( opendir(DIR, $dirPath) ) { | ||
| 406 : | my @fileList=(); | ||
| 407 : | while (defined(my $file = readdir(DIR))) { | ||
| 408 : | push(@fileList,$file) if -d "$dirPath/$file"; | ||
| 409 : | |||
| 410 : | } | ||
| 411 : | $out->{text} = join("\n",sort @fileList); | ||
| 412 : | closedir(DIR); | ||
| 413 : | } else { | ||
| 414 : | $out->{error}= "Can't open directory $dirPath"; | ||
| 415 : | } | ||
| 416 : | return($out); | ||
| 417 : | }; | ||
| 418 : | $command eq 'listSet' && do { my $dirPath2 = $dirPath . $rh->{set}; | ||
| 419 : | |||
| 420 : | if ( opendir(DIR, $dirPath2) ) { | ||
| 421 : | my @fileList =(); | ||
| 422 : | while (defined(my $file = readdir(DIR))) { | ||
| 423 : | if (-d "$dirPath2/$file") { | ||
| 424 : | push(@fileList, "$file/${file}.pg"); | ||
| 425 : | |||
| 426 : | } elsif ($file =~ /.pg$/ ) { # file ends in .pg | ||
| 427 : | push(@fileList, $file); | ||
| 428 : | |||
| 429 : | } | ||
| 430 : | |||
| 431 : | |||
| 432 : | } | ||
| 433 : | $out->{text} = join("\n",sort @fileList); | ||
| 434 : | closedir(DIR); | ||
| 435 : | } else { | ||
| 436 : | $out->{error}= "Can't open directory $dirPath2"; | ||
| 437 : | } | ||
| 438 : | |||
| 439 : | return($out); | ||
| 440 : | }; | ||
| 441 : | # else | ||
| 442 : | $out->{error}="Unrecognized command $command"; | ||
| 443 : | $out; | ||
| 444 : | } | ||
| 445 : | |||
| 446 : | gage | 497 | my $TEMPDIRECTORY = '/ww/htdocs/tmp/daemon/'; |
| 447 : | my $TEMP_BASE_URL = 'http://webwork-db.math.rochester.edu/tmp/daemon/'; | ||
| 448 : | my $externalLatexPath = "/usr/local/bin/latex"; | ||
| 449 : | my $externalDvipsPath = "/usr/local/bin/dvips"; | ||
| 450 : | my $externalGsPath = "/usr/local/bin/gs"; | ||
| 451 : | |||
| 452 : | |||
| 453 : | sub tex2pdf { | ||
| 454 : | |||
| 455 : | my $rh = shift; | ||
| 456 : | local($|)=1; | ||
| 457 : | my $out = {}; | ||
| 458 : | my $filePath = $rh->{filePath}; | ||
| 459 : | unless ($rh->{pw} eq $PASSWORD ) { | ||
| 460 : | $out->{error}=404; | ||
| 461 : | return($out); | ||
| 462 : | } | ||
| 463 : | my $fileName = $rh->{fileName}; | ||
| 464 : | my $texString = decode_base64( $rh->{'texString'}); | ||
| 465 : | $fileName =~ s/\.pg$//; | ||
| 466 : | my $url = "${TEMP_BASE_URL}$fileName.pdf"; | ||
| 467 : | my $texFileBaseName = $TEMPDIRECTORY.$fileName; | ||
| 468 : | |||
| 469 : | surePathToTmpFile($texFileBaseName); | ||
| 470 : | local(*TEX); | ||
| 471 : | open(TEX,"> $texFileBaseName.tex") or die "Can't open $texFileBaseName.tex to store tex code"; | ||
| 472 : | local($/)=undef; | ||
| 473 : | print TEX $texString; | ||
| 474 : | close(TEX); | ||
| 475 : | my $dviCommandLine = "$externalLatexPath $texFileBaseName.tex >/dev/null 2>/dev/null"; | ||
| 476 : | my $psCommandLine = "$externalDvipsPath -o $texFileBaseName.ps $texFileBaseName.dvi >/dev/null 2>/dev/null"; | ||
| 477 : | my $pdfCommandLine = "$externalGsPath -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$texFileBaseName.pdf -c save pop -f $texFileBaseName.ps"; | ||
| 478 : | print "$dviCommandLine\n"; | ||
| 479 : | print "$psCommandLine\n"; | ||
| 480 : | print "$pdfCommandLine\n"; | ||
| 481 : | |||
| 482 : | system($dviCommandLine); -e "$texFileBaseName.dvi" or die "tex generation failed"; | ||
| 483 : | # system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; | ||
| 484 : | # system($pdfCommandLine); -e "$texFileBaseName.pdf" or die "pdf generation failed."; | ||
| 485 : | return({pdfURL => $url}); | ||
| 486 : | |||
| 487 : | |||
| 488 : | |||
| 489 : | |||
| 490 : | } | ||
| 491 : | |||
| 492 : | sub surePathToTmpFile { # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/ | ||
| 493 : | # the input path must be either the full path, or the path relative to this tmp sub directory | ||
| 494 : | my $path = shift; | ||
| 495 : | my $delim = getDirDelim(); | ||
| 496 : | my $tmpDirectory = $TEMPDIRECTORY; | ||
| 497 : | # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment | ||
| 498 : | print "Original path $path\n"; | ||
| 499 : | $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|; | ||
| 500 : | $path = convertPath($path); | ||
| 501 : | print "Creating path to $path using $delim\n"; | ||
| 502 : | # find the nodes on the given path | ||
| 503 : | my @nodes = split("$delim",$path); | ||
| 504 : | # create new path | ||
| 505 : | $path = convertPath("$tmpDirectory"); | ||
| 506 : | |||
| 507 : | while (@nodes>1 ) { | ||
| 508 : | print "Creating path: $path\n "; | ||
| 509 : | $path = convertPath($path . shift (@nodes) ."/"); | ||
| 510 : | unless (-e $path) { | ||
| 511 : | # system("mkdir $path"); | ||
| 512 : | createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) || | ||
| 513 : | die "Failed to create directory $path"; | ||
| 514 : | |||
| 515 : | } | ||
| 516 : | |||
| 517 : | } | ||
| 518 : | $path = convertPath($path . shift(@nodes)); | ||
| 519 : | |||
| 520 : | # system(qq!echo "" > $path! ); | ||
| 521 : | |||
| 522 : | $path; | ||
| 523 : | |||
| 524 : | } | ||
| 525 : | |||
| 526 : | |||
| 527 : | |||
| 528 : | |||
| 529 : | |||
| 530 : | |||
| 531 : | |||
| 532 : | |||
| 533 : | |||
| 534 : | |||
| 535 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |