#!/usr/local/bin/perl -w package WWd; use lib '/u/gage/xmlrpc/daemon/'; use Webwork; ############utilities sub echo { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my $in = shift; return(ref($in). " $in "); } sub listLib { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my $in = shift; return( Webwork::listLib($in) ); } sub renderProblem { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my $in = shift; return( Filter::filterObject( Webwork::renderProblem($in) ) ); } sub readFile { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my $in = shift; return( Webwork::readFile($in) ); } sub hello { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); print "Receiving request for hello world\n"; return "Hello world?"; } sub pretty_print_rh { my $rh = shift; my $out = ""; my $type = ref($rh); if ( ref($rh) =~/HASH/ ) { foreach my $key (sort keys %{$rh}) { $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; } } elsif ( ref($rh) =~ /SCALAR/ ) { $out = "scalar reference ". ${$rh}; } elsif ( ref($rh) =~/Base64/ ) { $out .= "base64 reference " .$$rh; } else { $out = $rh; } if (defined($type) ) { $out .= " type = $type \n"; } return $out; } sub tth { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my $in = shift; my $tthpath = "/usr/local/bin/tth"; my $out; $inputString = "</dev/null"; #it's not clear why another command is needed. if (-x $tthpath ) { my $tthcmd = "$tthpath -L -f5 -r 2>/dev/null " . $inputString; if (open(TTH, "$tthcmd |")) { local($/); $/ = undef; $out = ; $/ = "\n"; close(TTH); }else { $out = "
there has been an error in executing $tthcmd
"; } } else { $out = "
Can't execute the program tth at |$tthpath|
"; } #return "\r\n\r\n" . $out . "\r\n\r\n"; return $out; } package Filter; sub is_hash_ref { my $in =shift; my $save_SIG_die_trap = $SIG{__DIE__}; $SIG{__DIE__} = sub {CORE::die(@_) }; my $out = eval{ %{ $in } }; $out = ($@ eq '') ? 1 : 0; $@=''; $SIG{__DIE__} = $save_SIG_die_trap; $out; } sub is_array_ref { my $in =shift; my $save_SIG_die_trap = $SIG{__DIE__}; $SIG{__DIE__} = sub {CORE::die(@_) }; my $out = eval{ @{ $in } }; $out = ($@ eq '') ? 1 : 0; $@=''; $SIG{__DIE__} = $save_SIG_die_trap; $out; } sub filterObject { my $is_hash = 0; my $is_array =0; $obj = shift; #print "Enter filterObject ", ref($obj), "\n"; my $type = ref($obj); unless ($type) { #print "leave filterObject with nothing\n"; return($obj); } if ( is_hash_ref($obj) ) { #print "enter hash ", %{$obj},"\n"; my %obj_container= %{$obj}; foreach my $key (keys %obj_container) { $obj_container{$key} = filterObject( $obj_container{$key} ); #print $key, " ", ref($obj_container{$key})," ", $obj_container{$key}, "\n"; } #print "leave filterObject with HASH\n"; return( bless(\%obj_container,'HASH')); }; if ( is_array_ref($obj) ) { #print "enter array ( ", @{$obj}," )\n"; my @obj_container= @{$obj}; foreach $i (0..$#obj_container) { $obj_container[$i] = filterObject( $obj_container[$i] ); #print "\[$i\] ", ref($obj_container[$i])," ", $obj_container[$i], "\n"; } #print "leave filterObject with ARRAY\n"; return( bless(\@obj_container,'ARRAY')); }; } 1;