fly: examples/perl/fly-tester.pl

"Fossies" - the Fresh Open Source Software Archive

Member "fly-2.0.1/examples/perl/fly-tester.pl" (25 Nov 2001, 6286 Bytes) of package /linux/www/old/fly-2.0.1.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

1 #!/usr/local/web/bin/perl 2 ### ---------------------------------------------------------------------- ### 3 # 4 # Fly tester 5 # 6 # *Requires* perl 5.001 or greater and the CGI module. 7 # 8 # (c) Copyright 1998, Martin Gleeson <gleeson@unimelb.edu.au> 9 # <URL:http://www.unimelb.edu.au/%7Egleeson/> 10 # 11 # You may use and/or modify this script freely, but not redistribute it 12 # without my permission. 13 # 14 # Version 1.1, 11 June 1999 15 # 16 # - added mode to show diagnostic output 17 # - disallowed 'copy' and 'copyresized' due to security risk. 18 # 19 # Version 1.0, 25 September 1998 20 # 21 use strict; 22 ### ---------------------------------------------------------------------- ### 23 # User configurable settings 24 ### ---------------------------------------------------------------------- ### 25 26 # Where the temporary images will be stored 27 my $output_area = "/home/usr/its/gleeson/public_html/fly/graphs"; 28 29 # URL path to same 30 my $graphs_url = "/%7Egleeson/fly/graphs"; 31 32 # location of the fly program 33 my $flyprog = "/home/usr/its/gleeson/bin/fly"; 34 35 ### ---------------------------------------------------------------------- ### 36 # End of configurable settings - no editing required below this line. 37 ### ---------------------------------------------------------------------- ### 38 39 use CGI; 40 my $q = new CGI; 41 42 my ($testcode, $version, $helpscreen, $diags); 43 44 &my_setup(); 45 46 if($q->path_info =~ /quickref/) { 47 print $q->header(), 48 $q->start_html(-title=>'Fly Tester: Fly Quick Reference', -bgcolor=>"#FFFFFF"), 49 $q->h1('Fly Quick Reference'), 50 $q->hr(), 51 $q->pre($helpscreen), 52 $q->hr(), 53 $q->end_html(); 54 } elsif($q->request_method() eq "GET") { 55 my $cw = 40; 56 my $ch = 30; 57 my $cell = $q->startform("POST",$q->url(),$CGI::URL_ENCODED) . 58 $q->textarea(-rows=>$ch, -columns=>$cw, -name=>"code", -default=>$testcode) . 59 $q->br() . 60 $q->div({-align=>"right"}, 61 "Command window width: ", 62 $q->textfield(-name=>'cw', -default=>$cw, -size=>2, -maxlength=>3), 63 " height: ", 64 $q->textfield(-name=>'ch', -default=>$ch, -size=>3, -maxlength=>4), 65 $q->br, 66 "Show diagnostic output? ", 67 $q->checkbox(-name=>'do',-label=>''), 68 $q->br, 69 $q->submit(-name=>'Submit', -value=>'Generate Image')); 70 71 print $q->header(), 72 $q->start_html(-title=>'Fly Tester', 73 -bgcolor=>"#FFFFFF"), 74 $q->h1('Fly Test Page'), 75 $q->hr(), 76 $q->p("Here you can test ", $q->a({-href=>"http://www.unimelb.edu.au/fly/"},"fly"), 77 " commands and see the results instantly."), 78 $q->table({-border=>"0"},$q->Tr($q->td($cell))), 79 $q->hr(), 80 $q->p({-align=>"center"}, "This is part of the ", 81 $q->a({-href=>"http://www.unimelb.edu.au/fly/"},"fly"), " package."), 82 $q->hr(), 83 $q->endform(), 84 $q->end_html(); 85 86 } elsif($q->request_method() eq "POST") { 87 my $code = $q->param('code'); 88 $diags = $q->param('do'); 89 my ($cell1, $cell2); 90 91 print $q->header(), 92 $q->start_html(-title=>'Fly Tester', 93 -bgcolor=>"#FFFFFF"), 94 $q->h1('Fly Test Page'), 95 $q->hr(); 96 97 my $inputfile = "/tmp/fly.$$.input"; 98 my $outputfile = "/tmp/fly.$$.output"; 99 $code =~ s/ 100 //g; 101 if($code =~ /^copy/m) { 102 print $q->h2("Error"), 103 $q->p("The copy and copyresized commands cannot be used from within this program."), 104 $q->hr(), 105 $q->p({-align=>"center"}, "This is part of the ", 106 $q->a({-href=>"http://www.unimelb.edu.au/fly/"},"fly"), " package."), 107 $q->hr(), 108 $q->end_html(); 109 exit 0; 110 } 111 open INPUT, ">$inputfile" or die "Couldn't open $inputfile for writing: $!\n"; print INPUT $code; close INPUT; 112 my $return_code = system("$flyprog -i $inputfile -o $output_area/fly.$$.gif > $outputfile 2>&1"); 113 if($return_code == 0) { 114 $cell1 = $q->p({-align=>'center'}, $q->img({-src=>"${graphs_url}/fly.$$.gif", 115 -alt=>"[Generated Graph]", -border=>"2"})); 116 my $url = $q->url(); 117 if($diags) { 118 open OUTPUT, "$outputfile" or die "Couldn't open $outputfile for reading: $!\n"; 119 my @lines = <OUTPUT>; my $text = join('',@lines); close OUTPUT; 120 $cell1 .= $q->table($q->Tr($q->td($q->pre($text)))); 121 } 122 $cell1 .= $q->p({-align=>"center"}, "fly version $version.", $q->br(), 123 $q->a({-href=>"$url/quickref"},"Quick Reference.")), 124 } else { 125 open ERR, $outputfile or die "Couln't open $outputfile for reading: $!"; my $output = join '', <ERR>; close ERR; 126 $cell1 = $q->p("Error producing image: $output"), 127 } 128 unlink $inputfile; 129 unlink $outputfile; 130 $cell2 = $q->startform("POST",$q->url(),$CGI::URL_ENCODED) . 131 $q->textarea(-rows=>$q->param('ch'), -columns=>$q->param('cw'), -name=>"code", -default=>$q->param('code')) . 132 $q->br() . 133 $q->div({-align=>"right"}, 134 "Command window width: ", 135 $q->textfield(-name=>'cw', -default=>$q->param('cw'), -size=>2, -maxlength=>3), 136 " height: ", 137 $q->textfield(-name=>'ch', -default=>$q->param('ch'), -size=>3, -maxlength=>4), 138 $q->br, 139 "Show diagnostic output? ", 140 $q->checkbox(-name=>'do',-label=>''), 141 $q->br, 142 $q->submit(-name=>'Submit', -value=>'Generate Image')) . 143 $q->endform(); 144 145 print $q->table({-border=>"0", -width=>"100%"},$q->Tr($q->td({-valign=>"top"},$cell2), 146 $q->td({-valign=>"top", -valign=>"top", -align=>'center'},$cell1))), 147 $q->hr(), 148 $q->p({-align=>"center"}, "This is part of the ", 149 $q->a({-href=>"http://www.unimelb.edu.au/fly/"},"fly"), " package."), 150 $q->hr(), 151 $q->end_html(); 152 } 153 exit 0; 154 155 sub my_setup { 156 $testcode = <<EOF; 157 # sample fly commands 158 # this is the smiley face example 159 160 # new image 161 new 162 size 256,256 163 164 # fill with white 165 fill 1,1,255,255,255 166 167 # create a circle 168 circle 128,128,180,0,0,0 169 170 # fill it with yellow 171 fill 128,128,255,255,0 172 173 # create a smile 174 arc 128,128,120,120,0,180,0,0,0 175 176 # or even a frown 177 # arc 128,188,90,120,180,0,0,0,0 178 179 # create the eyes 180 circle 96,96,10,0,0,0 181 circle 160,96,10,0,0,0 182 fill 96,96,0,0,0 183 fill 160,96,0,0,0 184 EOF 185 186 open FLY, "$flyprog -v |" or die "Couldn't run $flyprog -v: $!\n"; 187 while(<FLY>) { 188 if (/version/) { 189 ($version) = /([\d\.]+)/; 190 } 191 next if/directives/i or /documentation/i or /version/i; 192 s/&/&/g; 193 s/</</g; 194 s/>/>/g; 195 $helpscreen .= $_; 196 } 197 $helpscreen =~ s/\n\n\n/\n/; 198 close FLY; 199 } 200