ACE/apps/JAWS/clients/WebSTONE/bin/WebStone-setup.pl

   1 #!/pkg/gnu/bin//perl5
   2 #
   3
   4 push(@INC, "$wd/bin");
   5 require('WebStone-common.pl');
   6
   7 @keylist = ();
   8
   9 html_begin("Setup");
  10
  11 show_model();
  12
  13 print CLIENT <<EOF
  14 <FORM METHOD="POST" ACTION="$wd/bin/write-testbed.pl">
  15 EOF
  16     ;
  17
  18 &gettestbed();
  19 &getconfig();
  20
  21 print CLIENT <<EOF
  22 </DL>
  23 <P><INPUT TYPE="SUBMIT" VALUE="Write Configuration">
  24 </FORM>
  25
  26 <HR>
  27 <FORM METHOD="POST" ACTION="$wd/bin/move-filelist.pl">
  28 <H3>Choose a Web site model:</H3>
  29 <DL>
  30 EOF
  31     ;
  32
  33 for $key (sort(keys %filelist)) {
  34     print CLIENT "<DD><INPUT TYPE=RADIO NAME=filelist ";
  35     if ($key eq "filelist") {
  36         print CLIENT " CHECKED ";
  37     }
  38     print CLIENT " VALUE=\"$wd/conf/$key\"> $key: $filelist{$key}";
  39 }
  40
  41 print CLIENT <<EOF
  42 </DL>
  43 <INPUT TYPE="SUBMIT" VALUE="Set Workload">
  44
  45 EOF
  46     ;
  47
  48 html_end();
  49
  50 # end of main program
  51
  52 sub gettestbed {
  53     open(TESTBED, "$wd/conf/testbed");
  54     while (<TESTBED>) {
  55         if (/^\#|^(\w)*$/) { # do nothing
  56         }
  57         else {
  58             ( $textvalue, $thevalue ) = split( '=', $_ );
  59             ( $thevalue ) = split( '#', $thevalue);
  60             $testbed{$textvalue} = $thevalue;
  61             push(@keylist, $textvalue);
  62         }
  63     }
  64     close(TESTBED);
  65
  66     open(HELPFILE, "$wd/doc/testbed.help");
  67     while (<HELPFILE>) {
  68         ( $key, $textvalue ) = split( ':', $_ );
  69         $helptext{$key} = $textvalue;
  70     }
  71     close(HELPFILE);
  72
  73     foreach $key (@keylist) {
  74         print CLIENT "<P><DT>$helptext{$key}";
  75         $thesize = length($testbed{$key}) + 5;
  76         print CLIENT "<DD>$key <INPUT TYPE=TEXT NAME=$key ";
  77         print CLIENT "SIZE=$thesize VALUE=$testbed{$key}>\n";
  78     }
  79 }
  80
  81 sub getconfig {
  82     opendir(CONF, "$wd/conf") || die "open $wd/conf: $!";
  83     %filelist = "";
  84     foreach $file (sort readdir(CONF)) {
  85         if ( $file =~ /^filelist.*/ ) {
  86             $headtext = `head -1 $wd/conf/$file`;
  87             $headtext =~ s/\#//;
  88             ( $headtext ) = split(':', $headtext);
  89             $filelist{$file} = $headtext;
  90         }
  91     }
  92     closedir(CONF);
  93 }
  94
  95 # end