Parent Directory
| 
Revision Log
reorder problems, show problems in sets, jquery is now local.
1 #!/user/bin/perl -w 2 3 4 5 6 BEGIN { 7 $main::VERSION = "2.4.9"; 8 use Cwd; 9 use WeBWorK::PG::Local; 10 11 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 12 13 ############################################################################### 14 # Configuration -- set to top webwork directory (webwork2) (set in webwork.apache2-config) 15 # Configuration -- set server name 16 ############################################################################### 17 18 our $webwork_directory = $WeBWorK::Constants::WEBWORK_DIRECTORY; #'/opt/webwork/webwork2'; 19 print "WebworkWebservice: webwork_directory set to ", $WeBWorK::Constants::WEBWORK_DIRECTORY, 20 " via \$WeBWorK::Constants::WEBWORK_DIRECTORY set in webwork.apache2-config\n"; 21 22 $WebworkWebservice::HOST_NAME = 'localhost'; # Apache->server->server_hostname; 23 $WebworkWebservice::HOST_PORT = '80'; # Apache->server->port; 24 25 ############################################################################### 26 27 eval "use lib '$webwork_directory/lib'"; die $@ if $@; 28 eval "use WeBWorK::CourseEnvironment"; die $@ if $@; 29 my $seed_ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_directory }); 30 my $webwork_url = $seed_ce->{webwork_url}; 31 my $pg_dir = $seed_ce->{pg_dir}; 32 eval "use lib '$pg_dir/lib'"; die $@ if $@; 33 34 $WebworkWebservice::WW_DIRECTORY = $webwork_directory; 35 $WebworkWebservice::PG_DIRECTORY = $pg_dir; 36 $WebworkWebservice::SeedCE = $seed_ce; 37 38 ############################################################################### 39 40 $WebworkWebservice::PASSWORD = 'xmluser'; # default password 41 $WebworkWebservice::COURSENAME = 'admin'; # default course 42 } 43 44 45 use strict; 46 use warnings; 47 48 49 50 51 52 ############################################################################### 53 ############################################################################### 54 55 package WebworkWebservice; 56 57 58 59 sub pretty_print_rh { 60 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 61 my $rh = shift; 62 my $indent = shift || 0; 63 64 my $out = ""; 65 return $out if $indent>10; 66 my $type = ref($rh); 67 68 if (defined($type) and $type) { 69 $out .= " type = $type; "; 70 } elsif ($rh == undef) { 71 $out .= " type = scalar; "; 72 } 73 if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) { 74 $out .= "{\n"; 75 $indent++; 76 foreach my $key (sort keys %{$rh}) { 77 $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n"; 78 } 79 $indent--; 80 $out .= "\n"." "x$indent."}\n"; 81 82 } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { 83 $out .= " ( "; 84 foreach my $elem ( @{$rh} ) { 85 $out .= pretty_print_rh($elem, $indent); 86 87 } 88 $out .= " ) \n"; 89 } elsif ( ref($rh) =~ /SCALAR/ ) { 90 $out .= "scalar reference ". ${$rh}; 91 } elsif ( ref($rh) =~/Base64/ ) { 92 $out .= "base64 reference " .$$rh; 93 } else { 94 $out .= $rh; 95 } 96 97 return $out." "; 98 } 99 100 101 use WebworkWebservice::RenderProblem; 102 use WebworkWebservice::LibraryActions; 103 use WebworkWebservice::MathTranslators; 104 use WebworkWebservice::SetActions; 105 106 ############################################################################### 107 package WebworkXMLRPC; 108 use base qw(WebworkWebservice); 109 use WeBWorK::Utils qw(runtime_use writeTimingLogEntry); 110 111 112 113 ########################################################################### 114 # authentication 115 ########################################################################### 116 117 sub initiate_session { 118 my ($invocant, @args) = @_; 119 my $class = ref $invocant || $invocant; 120 my $rh_input = $args[0]; 121 my $user_id = $rh_input->{userID}; 122 my $password = $rh_input->{password}; 123 my $courseName = $rh_input ->{courseID}; 124 my $ce = $class->create_course_environment($courseName); 125 my $db = new WeBWorK::DB($ce->{dbLayout}); 126 127 my $language= $ce->{language} || "en"; 128 my $language_handle = WeBWorK::Localize->get_handle($language) ; 129 130 my $user_authen_module = WeBWorK::Authen::class($ce, "user_module"); 131 runtime_use $user_authen_module; 132 133 my $self = { 134 courseName => $courseName, 135 user_id => $user_id, 136 password => $password, 137 ce => $ce, 138 db => $db, 139 language_handle => $language_handle, 140 }; 141 $self = bless $self, $class; 142 # need to bless self before it can be used as an argument for the authentication module 143 # The authentication module is expecting a WeBWorK::Request object 144 # But its only actual requirement is that the method maketext() is defined. 145 146 my $authen = $user_authen_module->new($self); 147 my $authz = WeBWorK::Authz->new($self); 148 149 $self->{authen} = $authen; 150 $self->{authz} = $authz; 151 # we need to trick some of the methods within the webwork framework 152 # since we are not coming in with a standard apache request 153 # FIXME: can/should we change this???? 154 # 155 # We are borrowing tricks from the AuthenWeBWorK.pm module 156 # 157 # 158 159 160 # now, here's the problem... WeBWorK::Authen looks at $r->params directly, whereas we 161 # need to look at $user and $sent_pw. this is a perfect opportunity for a mixin, i think. 162 my $authenOK; 163 { 164 no warnings 'redefine'; 165 local *WeBWorK::Authen::get_credentials = \&WebworkXMLRPC::get_credentials; 166 local *WeBWorK::Authen::maybe_send_cookie = \&WebworkXMLRPC::noop; 167 local *WeBWorK::Authen::maybe_kill_cookie = \&WebworkXMLRPC::noop; 168 local *WeBWorK::Authen::set_params = \&WebworkXMLRPC::noop; 169 local *WeBWorK::Authen::write_log_entry = \&WebworkXMLRPC::noop; # maybe fix this to log interactions FIXME 170 $authenOK = $authen->verify; 171 } 172 173 $self->{authenOK} = $authenOK; 174 $self->{authzOK} = $authz->hasPermissions($user_id, "access_instructor_tools"); 175 return $self; 176 } 177 178 179 180 181 182 ########################################################################### 183 # identify course 184 ########################################################################### 185 186 sub create_course_environment { 187 my $self = shift; 188 my $courseName = shift; 189 my $ce = WeBWorK::CourseEnvironment->new( 190 {webwork_dir => $WebworkWebservice::WW_DIRECTORY, 191 courseName => $courseName 192 }); 193 # error messages 194 return ($ce); 195 } 196 197 ########################################################################### 198 # security check -- check that the user is in fact a professor in the course 199 ########################################################################### 200 sub ce { 201 my $self = shift; 202 $self->{ce}; 203 } 204 sub db { 205 my $self = shift; 206 $self->{db}; 207 } 208 sub authz { 209 my $self = shift; 210 $self->{authz}; 211 } 212 sub maketext { 213 my $self = shift; 214 $self->{language_handle}->maketext(@_); 215 } 216 217 218 sub get_credentials { 219 my $self = shift; 220 # self is an Authen object it contains an object r which is the WebworkXMLRPC object 221 # confusing isn't it? 222 $self->{user_id} = $self->{r}->{user_id}; 223 $self->{session_key} = ""; 224 $self->{password} = $self->{r}->{password}; 225 $self->{login_type} = "normal"; 226 $self->{credential_source} = "params"; 227 return 1; 228 } 229 230 sub noop { 231 232 } 233 sub check_authorization { 234 235 236 237 } 238 239 # respond to xmlrpc requests 240 sub listLib { 241 my $class = shift; 242 my $in = shift; 243 my $self = $class->initiate_session($in); 244 warn "incomiing request to listLib: class is ",ref($self); 245 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 246 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 247 return( WebworkWebservice::LibraryActions::listLib($in) ); 248 } 249 sub listLibraries { # returns a list of libraries for the default course 250 my $self = shift; 251 my $in = shift; 252 return( WebworkWebservice::LibraryActions::listLibraries($in) ); 253 } 254 sub listSets { 255 my $class = shift; 256 my $in = shift; 257 my $self = $class->initiate_session($in); 258 warn "incomiing request to listLib: class is ",ref($self); 259 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 260 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 261 return(WebworkWebservice::SetActions::listLocalSets($self)); 262 } 263 sub listSetProblems { 264 my $class = shift; 265 my $in = shift; 266 my $self = $class->initiate_session($in); 267 warn "incomiing request to listLib: class is ",ref($self); 268 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 269 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 270 return(WebworkWebservice::SetActions::listLocalSetProblems($self, $in)); 271 } 272 273 sub createNewSet{ 274 my $class = shift; 275 my $in = shift; 276 my $self = $class->initiate_session($in); 277 warn "incomiing request to listLib: class is ",ref($self); 278 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 279 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 280 return(WebworkWebservice::SetActions::createNewSet($self, $in)); 281 } 282 283 sub reorderProblems{ 284 my $class = shift; 285 my $in = shift; 286 my $self = $class->initiate_session($in); 287 warn "incomiing request to listLib: class is ",ref($self); 288 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 289 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 290 return(WebworkWebservice::SetActions::reorderProblems($self, $in)); 291 } 292 293 sub addProblem { 294 my $class = shift; 295 my $in = shift; 296 my $self = $class->initiate_session($in); 297 warn "incomiing request to listLib: class is ",ref($self); 298 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 299 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 300 return(WebworkWebservice::SetActions::addProblem($self, $in)); 301 } 302 303 sub deleteProblem{ 304 my $class = shift; 305 my $in = shift; 306 my $self = $class->initiate_session($in); 307 warn "incomiing request to listLib: class is ",ref($self); 308 warn "authentication for ",$self->{user_id}, " in course ", $self->{courseName}, " is = ", $self->{authenOK}; 309 warn "authorization as instructor for ", $self->{user_id}, " is ", $self->{authzOK}; 310 return(WebworkWebservice::SetActions::deleteProblem($self, $in)); 311 } 312 sub renderProblem { 313 my $self = shift; 314 my $in = shift; 315 return( WebworkWebservice::RenderProblem::renderProblem($in) ); 316 } 317 sub readFile { 318 my $self = shift; 319 my $in = shift; 320 return( WebworkWebservice::LibraryActions::readFile($in) ); 321 } 322 sub tex2pdf { 323 my $self = shift; 324 my $in = shift; 325 return( WebworkWebservice::MathTranslators::tex2pdf($in) ); 326 } 327 328 # -- SOAP::Lite -- guide.soaplite.com -- Copyright (C) 2001 Paul Kulchenko -- 329 # test responses 330 331 sub hi { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); # grabs class reference 332 return "hello, world"; 333 } 334 sub hello2 { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 335 #print "Receiving request for hello world\n"; 336 return "Hello world2"; 337 } 338 sub bye {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 339 return "goodbye, sad cruel world"; 340 } 341 342 sub languages {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 343 return ["Perl", "C", "sh"]; 344 } 345 346 sub echo_self { 347 my $self = shift; 348 } 349 350 sub echo { 351 return join("|",("begin ", WebworkWebservice::pretty_print_rh(\@_), " end") ); 352 } 353 354 sub pretty_print_rh { 355 WebworkWebservice::pretty_print_rh(@_); 356 } 357 358 359 sub tth {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 360 my $in = shift; 361 my $tthpath = "/usr/local/bin/tth"; 362 # $tthpath -L -f5 -r 2>/dev/null " . $inputString; 363 return $in; 364 365 } 366 367 368 369 370 package WWd; 371 372 #use lib '/home/gage/webwork/xmlrpc/daemon'; 373 #use WebworkXMLRPC; 374 375 376 377 378 ############utilities 379 380 sub echo { 381 return "WWd package ".join("|",("begin ", WebworkWebservice::pretty_print_rh(\@_), " end") ); 382 } 383 384 sub listLib { 385 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 386 my $in = shift; 387 return( Webwork::listLib($in) ); 388 } 389 sub renderProblem { 390 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 391 my $in = shift; 392 return( Filter::filterObject( Webwork::renderProblem($in) ) ); 393 } 394 sub readFile { 395 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 396 my $in = shift; 397 return( Webwork::readFile($in) ); 398 } 399 # sub hello { 400 # shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 401 # print "Receiving request for hello world\n"; 402 # return "Hello world?"; 403 # } 404 405 406 # sub tth { 407 # shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 408 # my $in = shift; 409 # my $tthpath = "/usr/local/bin/tth"; 410 # my $out; 411 # $inputString = "<<END_OF_TTH_INPUT_STRING;\n\n\n" . $in . "\nEND_OF_TTH_INPUT_STRING\necho \"\" >/dev/null"; 412 # #it's not clear why another command is needed. 413 # 414 # if (-x $tthpath ) { 415 # my $tthcmd = "$tthpath -L -f5 -r 2>/dev/null " . $inputString; 416 # if (open(TTH, "$tthcmd |")) { 417 # local($/); 418 # $/ = undef; 419 # $out = <TTH>; 420 # $/ = "\n"; 421 # close(TTH); 422 # }else { 423 # $out = "<BR>there has been an error in executing $tthcmd<BR>"; 424 # } 425 # } else { 426 # $out = "<BR> Can't execute the program tth at |$tthpath|<BR>"; 427 # } 428 # 429 # #return "<!-- \r\n" . $in . "\r\n-->\r\n\r\n" . $out . "\r\n\r\n"; 430 # return $out; 431 # 432 # } 433 434 package Filter; 435 436 437 sub is_hash_ref { 438 my $in =shift; 439 my $save_SIG_die_trap = $SIG{__DIE__}; 440 $SIG{__DIE__} = sub {CORE::die(@_) }; 441 my $out = eval{ %{ $in } }; 442 $out = ($@ eq '') ? 1 : 0; 443 $@=''; 444 $SIG{__DIE__} = $save_SIG_die_trap; 445 $out; 446 } 447 sub is_array_ref { 448 my $in =shift; 449 my $save_SIG_die_trap = $SIG{__DIE__}; 450 $SIG{__DIE__} = sub {CORE::die(@_) }; 451 my $out = eval{ @{ $in } }; 452 $out = ($@ eq '') ? 1 : 0; 453 $@=''; 454 $SIG{__DIE__} = $save_SIG_die_trap; 455 $out; 456 } 457 sub filterObject { 458 459 my $is_hash = 0; 460 my $is_array =0; 461 my $obj = shift; 462 #print "Enter filterObject ", ref($obj), "\n"; 463 my $type = ref($obj); 464 unless ($type) { 465 #print "leave filterObject with nothing\n"; 466 return($obj); 467 } 468 469 470 if ( is_hash_ref($obj) ) { 471 #print "enter hash ", %{$obj},"\n"; 472 my %obj_container= %{$obj}; 473 foreach my $key (keys %obj_container) { 474 $obj_container{$key} = filterObject( $obj_container{$key} ); 475 #print $key, " ", ref($obj_container{$key})," ", $obj_container{$key}, "\n"; 476 } 477 #print "leave filterObject with HASH\n"; 478 return( bless(\%obj_container,'HASH')); 479 }; 480 481 482 483 if ( is_array_ref($obj) ) { 484 #print "enter array ( ", @{$obj}," )\n"; 485 my @obj_container= @{$obj}; 486 foreach my $i (0..$#obj_container) { 487 $obj_container[$i] = filterObject( $obj_container[$i] ); 488 #print "\[$i\] ", ref($obj_container[$i])," ", $obj_container[$i], "\n"; 489 } 490 #print "leave filterObject with ARRAY\n"; 491 return( bless(\@obj_container,'ARRAY')); 492 }; 493 494 } 495 496 497 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |