Return to imagechoice.pm CVS log

Up to [LON-CAPA] / loncom / homework

Change arguments accepted by lonnet::appenv() to:
1. reference to hash
2. (optional) reference to array.

Change all instances where lonnet::appenv() is called to replace first argument passed (originally a hash) to a reference to the hash.

- Modify lonnet.pm rev 1.35 code intended to prevent "dangerous" modifications of the environment, so it will actually do this.
- Allow these modifications to be made in certain instances:
   DC switching to adhoc role
   CC switching to a different course role in the current course.
   user self-enrolling as a student

    1: # $Id: imagechoice.pm,v 1.14 2008/03/12 02:46:53 raeburn Exp $
    2: #
    3: # Copyright Michigan State University Board of Trustees
    4: #
    5: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    6: #
    7: # LON-CAPA is free software; you can redistribute it and/or modify
    8: # it under the terms of the GNU General Public License as published by
    9: # the Free Software Foundation; either version 2 of the License, or
   10: # (at your option) any later version.
   11: #
   12: # LON-CAPA is distributed in the hope that it will be useful,
   13: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: # GNU General Public License for more details.
   16: #
   17: # You should have received a copy of the GNU General Public License
   18: # along with LON-CAPA; if not, write to the Free Software
   19: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   20: #
   21: # /home/httpd/cgi-bin/plot.gif
   22: #
   23: # http://www.lon-capa.org/
   24: #
   25: package Apache::imagechoice;
   26: use strict;
   27: use Apache::Constants qw(:common :http);
   28: use Apache::lonnet;
   29: use LONCAPA;
   30:  
   31: 
   32: sub deletedata {
   33:     my ($id)=@_;
   34:     &Apache::lonnet::delenv("imagechoice\\.$id\\.coords");
   35: }
   36: 
   37: sub closewindow {
   38:     my ($r,$output,$filename,$needimage,$display)=@_;
   39:     if ($needimage) {
   40: 	$needimage="<img name=\"pickimg\" src=\"$filename\" />";
   41:     }
   42:     my $js=<<"ENDSUBM";
   43: <script type="text/javascript">
   44:     function submitthis() {
   45: 	$output
   46: 	self.close();
   47:     }
   48: </script>
   49: ENDSUBM
   50: 
   51:     my $start_page =
   52:         &Apache::loncommon::start_page('Close Window',$js,
   53: 				       {'bgcolor'     => '#FFFFFF',
   54: 					'only_body'   => 1,
   55: 					'add_entries' => {
   56: 					    onload => 'submitthis();'},});
   57: 
   58:     my $end_page =
   59:         &Apache::loncommon::end_page();
   60: 
   61:     $r->print(<<"ENDSUBM");
   62: $start_page
   63: <h3>Position Selected</h3>
   64: $display
   65: $needimage
   66: $end_page
   67: ENDSUBM
   68: }
   69: 
   70: sub storedata {
   71:     my ($r,$type,$filename,$id)=@_;
   72: 
   73:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
   74: 
   75:     my ($output,$needimage);
   76: 
   77:     if ($env{"imagechoice.$id.formwidth"}) {
   78: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formwidth"}.'.value=document.pickimg.width;';
   79: 	$needimage=1;
   80:     }
   81:     if ($env{"imagechoice.$id.formheight"}) {
   82: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formheight"}.'.value=document.pickimg.height;';
   83: 	$needimage=1;
   84:     }
   85: 
   86:     my $display;
   87:     if ($type eq 'point') {
   88: 	my (undef,$x,$y)=split(':',$env{"imagechoice.$id.coords"});
   89: 	if ($env{"imagechoice.$id.formx"}) {
   90: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formx"}.'.value='.$x.';';
   91: 	    $display.="<p>The X coordinate is $x</p>\n";
   92: 	}
   93: 	if ($env{"imagechoice.$id.formy"}) {
   94: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formy"}.'.value='.$y.';';
   95: 	    $display.="<p>The Y coordinate is $y</p>\n";
   96: 	}
   97:     } elsif ($type eq 'polygon' or $type eq 'box') {
   98: 	my $coordstr;
   99: 	while (@coords) {
  100: 	    $coordstr.='('.shift(@coords).','.shift(@coords).')-';
  101: 	}
  102: 	chop($coordstr);
  103: 	$display.="<p>The selected coordinates are <tt>$coordstr</tt></p>\n";
  104: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formcoord"}.'.value="'.$coordstr.'";';
  105:     }
  106:     if ($display) {
  107: 	$display.="<p>If this window fails to close you may need to manually replace the old coordinates with the above value.</p>\n";
  108:     }
  109:     &deletedata($id);
  110:     &closewindow($r,$output,$filename,$needimage,$display);
  111: }
  112: 
  113: sub getcoord {
  114:     my ($r,$type,$filename,$id)=@_;
  115:     my $heading='Select Position on Image';
  116:     my $nextstage='';
  117:     if ($type eq 'box') {
  118: 	my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  119: 	my $step=scalar(@coords)/2;
  120: 	if ($step == 0) { 
  121: 	    $heading='Select First Coordinate on Image';
  122: 	    #$nextstage='<input type="hidden" name="type" value="pairtwo" />';
  123: 	} elsif ($step == 1) {
  124: 	    $heading='Select Second Coordinate on Image';
  125: 	    #$nextstage='<input type="hidden" name="type" value="pairthree" />';
  126: 	} else {
  127: 	    $heading='Select Finish to save selection.';
  128: 	    $nextstage='<input type="submit" name="finish" value="Finish" />';
  129: 	}
  130:     } elsif ($type eq 'polygon') {
  131: 	$heading='Enter Coordinate or click finish to close Polygon';
  132: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
  133:     } elsif ($type eq 'point') {
  134: 	$heading='Click to select a Coordinate or click Finish to save current selection.';
  135: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
  136:     }
  137: 
  138:     my $start_page =
  139:         &Apache::loncommon::start_page('Get Coordinates',undef,
  140: 				       {'bgcolor'     => '#FFFFFF',
  141: 					'only_body'   => 1,});
  142: 
  143:     my $end_page =
  144:         &Apache::loncommon::end_page();
  145:     $r->print(<<"END");
  146: $start_page
  147: <h3>$heading</h3>
  148: <form method="POST" action="/adm/imagechoice?token=$id">
  149: $nextstage
  150: <input type="submit" name="cancel" value="Cancel" />
  151: <br />
  152: <input name="image" type="image" src="$filename" />
  153: </form>
  154: $end_page
  155: END
  156: }
  157: 
  158: sub savecoord {
  159:     my ($id,$type)=@_;
  160:     if (defined($env{"form.image.x"}) && defined($env{"form.image.y"})) {
  161: 	my $data;
  162: 	if ($type eq 'point') {
  163: 	    $data=join(':',(undef,$env{"form.image.x"},$env{"form.image.y"}));
  164: 	} else {
  165: 	    $data=join(':',($env{"imagechoice.$id.coords"},
  166: 			    $env{"form.image.x"},$env{"form.image.y"}));
  167: 	}
  168: 	&Apache::lonnet::appenv({"imagechoice.$id.coords"=>$data});
  169:     }
  170:     return int(scalar(split(':',$env{"imagechoice.$id.coords"}))/2);
  171: }
  172: 
  173: sub add_obj {
  174:     my ($x,$id,$type,$args,$extra)=@_;
  175: 
  176:     $$x{"cgi.$id.OBJTYPE"}.=$type.':';
  177:     my $i=$$x{"cgi.$id.OBJCOUNT"}++;
  178:     $$x{"cgi.$id.OBJ$i"}=$args;
  179:     if (defined($extra)) { $$x{"cgi.$id.OBJEXTRA$i"}=$extra; }
  180: }
  181: 
  182: sub drawX {
  183:     my ($data,$imid,$x,$y)=@_;
  184:     my $length = 6;
  185:     my $width = 1;
  186:     my $extrawidth = 2;
  187:     &add_obj($data,$imid,'LINE',
  188: 	     join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
  189: 		       "FFFFFF",($width+$extrawidth))));
  190:     &add_obj($data,$imid,'LINE',
  191: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
  192: 		  "FFFFFF",($width+$extrawidth))));
  193:     &add_obj($data,$imid,'LINE',
  194: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
  195: 		  "FF0000",($width))));
  196:     &add_obj($data,$imid,'LINE',
  197: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
  198: 		  "FF0000",($width))));
  199: }
  200: 
  201: sub drawPolygon {
  202:     my ($data,$id,$imid)=@_;
  203:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  204:     my $coordstr;
  205:     while (@coords) {
  206: 	$coordstr.='('.shift(@coords).','.shift(@coords).')-';
  207:     }
  208:     chop($coordstr);
  209:     my $width = 1;
  210:     my $extrawidth = 2;
  211:     &add_obj($data,$imid,'POLYGON',
  212: 	     join(':',("FFFFFF",($width+$extrawidth)),'1'),$coordstr);
  213:     &add_obj($data,$imid,'POLYGON',
  214: 	     join(':',("00FF00",($width)),'1'),$coordstr);
  215: }
  216: 
  217: sub drawBox {
  218:     my ($data,$id,$imid)=@_;
  219:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  220:     if (scalar(@coords) < 4) { return ''; }
  221:     my $width = 1;
  222:     my $extrawidth = 2;
  223:     &add_obj($data,$imid,'RECTANGLE',
  224: 	     join(':',(@coords,"FFFFFF",($width+$extrawidth))));
  225:     &add_obj($data,$imid,'RECTANGLE',join(':',(@coords,"00FF00",$width)));
  226: }
  227: 
  228: sub drawimage {
  229:     my ($r,$type,$filename,$id)=@_;
  230:     my $imid=&Apache::loncommon::get_cgi_id();
  231:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  232:     if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
  233:     my %data;
  234:     $data{"cgi.$imid.BGIMG"}=$filename;
  235:     my $x=$coords[-2];
  236:     my $y=$coords[-1];
  237:     &drawX(\%data,$imid,$x,$y);
  238:     if ($type eq "polygon") { &drawPolygon(\%data,$id,$imid); }
  239:     if ($type eq "box") { &drawBox(\%data,$id,$imid); }
  240:     &Apache::lonnet::appenv(\%data);
  241:     return "/adm/randomlabel.png?token=$imid"
  242: }
  243: 
  244: sub handler {
  245:     my ($r)=@_;
  246:     &Apache::loncommon::content_type($r,'text/html');
  247:     $r->send_http_header;
  248:     my %data;
  249:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
  250:     my $filename = &unescape($env{"imagechoice.$id.file"});
  251:     my $formname = $env{"imagechoice.$id.formname"};
  252:     if ($env{'form.cancel'} eq 'Cancel') {
  253: 	&deletedata($id);
  254: 	&closewindow($r,'',$filename);
  255: 	return OK;
  256:     }
  257:     my $type=$env{"imagechoice.$id.type"};
  258:     if (defined($env{'form.type'})) { $type=$env{'form.type'}; }
  259:     my $numcoords=&savecoord($id,$type);
  260:     my $imurl=&drawimage($r,$type,$filename,$id);
  261:     if (($env{'form.finish'} eq 'Finish')) {
  262: 	&storedata($r,$type,$imurl,$id);
  263:     } else {
  264: 	&getcoord($r,$type,$imurl,$id);
  265:     }
  266:     return OK;
  267: }
  268: 
  269: 1;
  270: 
  271: __END__
  272: 
  273: