View of /trunk/xmlrpc/modules/WWd.pm

    1 #!/usr/local/bin/perl  -w
    2 package WWd;
    3 
    4 use lib '/u/gage/xmlrpc/daemon/';
    5 use Webwork;
    6 
    7 
    8 
    9 
   10 ############utilities
   11 
   12 sub echo {
   13     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   14     my $in = shift;
   15     return(ref($in). "  $in ");
   16 }
   17 
   18 sub listLib {
   19     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   20     my $in = shift;
   21     return( Webwork::listLib($in) );
   22 }
   23 sub renderProblem {
   24     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   25     my $in = shift;
   26     return( Filter::filterObject( Webwork::renderProblem($in) ) );
   27 }
   28 sub readFile {
   29     shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   30     my $in = shift;
   31     return( Webwork::readFile($in) );
   32 }
   33 sub hello {
   34   shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   35   print "Receiving request for hello world\n";
   36   return "Hello world?";
   37 }
   38 
   39 sub pretty_print_rh {
   40   my $rh = shift;
   41   my $out = "";
   42   my $type = ref($rh);
   43   if ( ref($rh) =~/HASH/ ) {
   44     foreach my $key (sort keys %{$rh})  {
   45       $out .= "  $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
   46     }
   47   } elsif ( ref($rh) =~ /SCALAR/ ) {
   48     $out = "scalar reference ". ${$rh};
   49   } elsif ( ref($rh) =~/Base64/ ) {
   50     $out .= "base64 reference " .$$rh;
   51   } else {
   52     $out =  $rh;
   53   }
   54   if (defined($type) ) {
   55     $out .= " type = $type \n";
   56   }
   57   return $out;
   58 }
   59 
   60 sub tth {
   61   shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
   62   my $in = shift;
   63   my $tthpath = "/usr/local/bin/tth";
   64     my $out;
   65     $inputString    = "<<END_OF_TTH_INPUT_STRING;\n\n\n" . $in . "\nEND_OF_TTH_INPUT_STRING\necho \"\" >/dev/null";
   66     #it's not clear why another command is needed.
   67 
   68     if (-x $tthpath ) {
   69       my $tthcmd      = "$tthpath -L -f5 -r 2>/dev/null " . $inputString;
   70       if (open(TTH, "$tthcmd   |")) {
   71           local($/);
   72       $/ = undef;
   73       $out = <TTH>;
   74       $/ = "\n";
   75       close(TTH);
   76       }else {
   77           $out = "<BR>there has been an error in executing $tthcmd<BR>";
   78       }
   79   } else {
   80     $out = "<BR> Can't execute the program tth at |$tthpath|<BR>";
   81     }
   82 
   83     #return "<!-- \r\n" . $in . "\r\n-->\r\n\r\n" . $out . "\r\n\r\n";
   84     return $out;
   85 
   86 }
   87 
   88 package Filter;
   89 
   90 
   91 
   92 
   93 
   94 
   95 
   96 
   97 
   98 
   99 sub is_hash_ref {
  100   my $in =shift;
  101   my $save_SIG_die_trap = $SIG{__DIE__};
  102     $SIG{__DIE__} = sub {CORE::die(@_) };
  103   my $out = eval{  %{   $in  }  };
  104   $out = ($@ eq '') ? 1 : 0;
  105   $@='';
  106   $SIG{__DIE__} = $save_SIG_die_trap;
  107   $out;
  108 }
  109 sub is_array_ref {
  110   my $in =shift;
  111   my $save_SIG_die_trap = $SIG{__DIE__};
  112     $SIG{__DIE__} = sub {CORE::die(@_) };
  113   my $out = eval{  @{   $in  }  };
  114   $out = ($@ eq '') ? 1 : 0;
  115   $@='';
  116   $SIG{__DIE__} = $save_SIG_die_trap;
  117   $out;
  118 }
  119 sub filterObject {
  120 
  121     my $is_hash = 0;
  122     my $is_array =0;
  123   $obj = shift;
  124   #print "Enter filterObject ", ref($obj), "\n";
  125   my $type = ref($obj);
  126   unless ($type) {
  127     #print "leave filterObject with nothing\n";
  128     return($obj);
  129   }
  130 
  131 
  132   if ( is_hash_ref($obj)  ) {
  133       #print "enter hash ", %{$obj},"\n";
  134       my %obj_container= %{$obj};
  135     foreach my $key (keys %obj_container) {
  136       $obj_container{$key} = filterObject( $obj_container{$key} );
  137       #print $key, "  ",  ref($obj_container{$key}),"   ", $obj_container{$key}, "\n";
  138     }
  139     #print "leave filterObject with HASH\n";
  140     return( bless(\%obj_container,'HASH'));
  141   };
  142 
  143 
  144 
  145   if ( is_array_ref($obj)  ) {
  146     #print "enter array ( ", @{$obj}," )\n";
  147     my @obj_container= @{$obj};
  148     foreach $i (0..$#obj_container) {
  149       $obj_container[$i] = filterObject( $obj_container[$i] );
  150       #print "\[$i\]  ",  ref($obj_container[$i]),"   ", $obj_container[$i], "\n";
  151     }
  152     #print "leave filterObject with ARRAY\n";
  153     return( bless(\@obj_container,'ARRAY'));
  154   };
  155 
  156 }
  157 
  158 
  159 1;
  160 
  161 
  162 
  163 
  164 
  165 
  166 
  167