Parent Directory
| 
Revision Log
Cosmetic change to pretty_print_rh
1 2 # FIXME need way to find the basic libraries and such. 3 4 5 BEGIN { 6 $main::VERSION = "2.1"; 7 my $webwork_directory = $ENV{WEBWORK_ROOT}; 8 9 eval "use lib '$webwork_directory/lib'"; die $@ if $@; 10 eval "use WeBWorK::CourseEnvironment"; die $@ if $@; 11 my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_directory }); 12 my $webwork_url = $ce->{webwork_url}; 13 my $pg_dir = $ce->{pg_dir}; 14 # my $webwork_htdocs_url = $ce->{webwork_htdocs_url}; 15 # my $webwork_htdocs_dir = $ce->{webwork_htdocs_dir}; 16 # my $webwork_courses_url = $ce->{webwork_courses_url}; 17 # my $webwork_courses_dir = $ce->{webwork_courses_dir}; 18 eval "use lib '$pg_dir/lib'"; die $@ if $@; 19 20 $WebworkWebservice::WW_DIRECTORY = $webwork_directory; 21 $WebworkWebservice::PG_DIRECTORY = $pg_dir; 22 $WebworkWebservice::SeedCE = $ce; 23 $WebworkWebservice::HOST_NAME = Apache->server->server_hostname; 24 $WebworkWebservice::HOST_PORT = Apache->server->port; 25 $WebworkWebservice::PASSWORD = 'geometry'; 26 $WebworkWebservice::COURSENAME = 'daemon2_course'; # default course 27 28 } 29 use Apache; 30 use WeBWorK::PG::Local; 31 32 #use lib '/home/gage/webwork/webwork-modperl/lib'; 33 #use lib '/home/gage/webwork/pg/lib'; 34 35 36 #$Webservice::HOST_PATH = "http://$Webservice::HOST_NAME"; 37 #$Webservice::HOST_PATH .= ":$Webservice::HOST_PORT" 38 # unless ($Webservice::HOST_PORT == 80 ); 39 40 # warn "webwork_directory = $WebworkWebservice::WW_DIRECTORY\n\t"; 41 # warn "pg_directory = $WebworkWebservice::PG_DIRECTORY\n\t"; 42 # warn "seedCE = $WebworkWebservice::SeedCE\n\t"; 43 # warn "host name = $WebworkWebservice::HOST_NAME\n\t"; 44 45 #FIXME port is not being set! 46 # warn "host port = $Webservice::HOST_PORT\n\t"; 47 48 # #warn "host path = $Webservice::HOST_PATH\n\t"; 49 # warn " password $WebworkWebservice::PASSWORD\n\t"; 50 51 use strict; 52 ############################################################################### 53 54 package WebworkWebservice; 55 56 sub pretty_print_rh { 57 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 58 my $rh = shift; 59 my $indent = shift || 0; 60 my $out = ""; 61 my $type = ref($rh); 62 63 if (defined($type) and $type) { 64 $out .= " type = $type; "; 65 } elsif ($rh == undef) { 66 $out .= " type = scalar; "; 67 } 68 if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) { 69 $out .= "{\n"; 70 $indent++; 71 foreach my $key (sort keys %{$rh}) { 72 $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n"; 73 } 74 $indent--; 75 $out .= "\n"." "x$indent."}\n"; 76 77 } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) { 78 $out .= " ( "; 79 foreach my $elem ( @{$rh} ) { 80 $out .= pretty_print_rh($elem, $indent); 81 82 } 83 $out .= " ) \n"; 84 } elsif ( ref($rh) =~ /SCALAR/ ) { 85 $out .= "scalar reference ". ${$rh}; 86 } elsif ( ref($rh) =~/Base64/ ) { 87 $out .= "base64 reference " .$$rh; 88 } else { 89 $out .= $rh; 90 } 91 92 return $out." "; 93 } 94 95 96 use WebworkWebservice::RenderProblem; 97 use WebworkWebservice::LibraryActions; 98 use WebworkWebservice::MathTranslators; 99 100 ############################################################################### 101 package WebworkXMLRPC; 102 use WebworkWebservice; 103 use base qw(WebworkWebservice); 104 105 106 107 # respond to xmlrpc requests 108 sub listLib { 109 my $self = shift; 110 my $in = shift; 111 return( WebworkWebservice::LibraryActions::listLib($in) ); 112 } 113 sub listLibraries { 114 my $self = shift; 115 my $in = shift; 116 return( WebworkWebservice::LibraryActions::listLibraries($in) ); 117 } 118 sub renderProblem { 119 my $self = shift; 120 my $in = shift; 121 return( WebworkWebservice::RenderProblem::renderProblem($in) ); 122 } 123 sub readFile { 124 my $self = shift; 125 my $in = shift; 126 return( WebworkWebservice::LibraryActions::readFile($in) ); 127 } 128 sub tex2pdf { 129 my $self = shift; 130 my $in = shift; 131 return( WebworkWebservice::MathTranslators::tex2pdf($in) ); 132 } 133 134 # -- SOAP::Lite -- guide.soaplite.com -- Copyright (C) 2001 Paul Kulchenko -- 135 # test responses 136 137 sub hi { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); # grabs class reference 138 return "hello, world"; 139 } 140 sub hello2 { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 141 #print "Receiving request for hello world\n"; 142 return "Hello world2"; 143 } 144 sub bye {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 145 return "goodbye, sad cruel world"; 146 } 147 148 sub languages {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 149 return ["Perl", "C", "sh"]; 150 } 151 152 sub echo_self { 153 my $self = shift; 154 } 155 156 sub echo { 157 return join("|",("begin ", WebworkWebservice::pretty_print_rh(\@_), " end") ); 158 } 159 160 sub pretty_print_rh { 161 WebworkWebservice::pretty_print_rh(@_); 162 } 163 164 165 sub tth {shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 166 my $in = shift; 167 my $tthpath = "/usr/local/bin/tth"; 168 # $tthpath -L -f5 -r 2>/dev/null " . $inputString; 169 return $in; 170 171 } 172 173 174 175 176 package WWd; 177 178 #use lib '/home/gage/webwork/xmlrpc/daemon'; 179 #use WebworkXMLRPC; 180 181 182 183 184 ############utilities 185 186 sub echo { 187 return "WWd package ".join("|",("begin ", WebworkWebservice::pretty_print_rh(\@_), " end") ); 188 } 189 190 sub listLib { 191 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 192 my $in = shift; 193 return( Webwork::listLib($in) ); 194 } 195 sub renderProblem { 196 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 197 my $in = shift; 198 return( Filter::filterObject( Webwork::renderProblem($in) ) ); 199 } 200 sub readFile { 201 shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 202 my $in = shift; 203 return( Webwork::readFile($in) ); 204 } 205 # sub hello { 206 # shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 207 # print "Receiving request for hello world\n"; 208 # return "Hello world?"; 209 # } 210 211 212 # sub tth { 213 # shift if UNIVERSAL::isa($_[0] => __PACKAGE__); 214 # my $in = shift; 215 # my $tthpath = "/usr/local/bin/tth"; 216 # my $out; 217 # $inputString = "<<END_OF_TTH_INPUT_STRING;\n\n\n" . $in . "\nEND_OF_TTH_INPUT_STRING\necho \"\" >/dev/null"; 218 # #it's not clear why another command is needed. 219 # 220 # if (-x $tthpath ) { 221 # my $tthcmd = "$tthpath -L -f5 -r 2>/dev/null " . $inputString; 222 # if (open(TTH, "$tthcmd |")) { 223 # local($/); 224 # $/ = undef; 225 # $out = <TTH>; 226 # $/ = "\n"; 227 # close(TTH); 228 # }else { 229 # $out = "<BR>there has been an error in executing $tthcmd<BR>"; 230 # } 231 # } else { 232 # $out = "<BR> Can't execute the program tth at |$tthpath|<BR>"; 233 # } 234 # 235 # #return "<!-- \r\n" . $in . "\r\n-->\r\n\r\n" . $out . "\r\n\r\n"; 236 # return $out; 237 # 238 # } 239 240 package Filter; 241 242 243 sub is_hash_ref { 244 my $in =shift; 245 my $save_SIG_die_trap = $SIG{__DIE__}; 246 $SIG{__DIE__} = sub {CORE::die(@_) }; 247 my $out = eval{ %{ $in } }; 248 $out = ($@ eq '') ? 1 : 0; 249 $@=''; 250 $SIG{__DIE__} = $save_SIG_die_trap; 251 $out; 252 } 253 sub is_array_ref { 254 my $in =shift; 255 my $save_SIG_die_trap = $SIG{__DIE__}; 256 $SIG{__DIE__} = sub {CORE::die(@_) }; 257 my $out = eval{ @{ $in } }; 258 $out = ($@ eq '') ? 1 : 0; 259 $@=''; 260 $SIG{__DIE__} = $save_SIG_die_trap; 261 $out; 262 } 263 sub filterObject { 264 265 my $is_hash = 0; 266 my $is_array =0; 267 my $obj = shift; 268 #print "Enter filterObject ", ref($obj), "\n"; 269 my $type = ref($obj); 270 unless ($type) { 271 #print "leave filterObject with nothing\n"; 272 return($obj); 273 } 274 275 276 if ( is_hash_ref($obj) ) { 277 #print "enter hash ", %{$obj},"\n"; 278 my %obj_container= %{$obj}; 279 foreach my $key (keys %obj_container) { 280 $obj_container{$key} = filterObject( $obj_container{$key} ); 281 #print $key, " ", ref($obj_container{$key})," ", $obj_container{$key}, "\n"; 282 } 283 #print "leave filterObject with HASH\n"; 284 return( bless(\%obj_container,'HASH')); 285 }; 286 287 288 289 if ( is_array_ref($obj) ) { 290 #print "enter array ( ", @{$obj}," )\n"; 291 my @obj_container= @{$obj}; 292 foreach my $i (0..$#obj_container) { 293 $obj_container[$i] = filterObject( $obj_container[$i] ); 294 #print "\[$i\] ", ref($obj_container[$i])," ", $obj_container[$i], "\n"; 295 } 296 #print "leave filterObject with ARRAY\n"; 297 return( bless(\@obj_container,'ARRAY')); 298 }; 299 300 } 301 302 303 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |