Diff for /loncom/cgi/graph.png between versions 1.22 and 1.34

version 1.22, 2003/10/08 15:44:49 version 1.34, 2005/04/07 06:56:21
Line 38  graph.png Line 38  graph.png
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 produces plots based on input  produces plots from data stored in users environment.
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 graph.png is a cgi-bin script which produces plots based on input data.  graph.png is a cgi-bin script which produces plots based on data stored
   in the users environment.  The users cookie is checked prior to producing
 The query string is expected to be as follows (without whitespace):  a plot.  The query string is expected to be an identifier, $id.  
   The parameters defining the plot must be stored in the environment as 
 escape(Plot title) & escape(X label)& escape(Y label) & Maximum Y value &  $ENV{'cgi.'.$id.'.'.$dataname}.  Two types of plots can be produced, 'bar'
 Number of bars & $data1 & $data2  and 'xy'.  The 'xy' graph can will 1 or 2 y-axes if the parameter
   'two_axes' is set to false or true respectively.  See perldoc GD::Graph and
 $data1 and $data2 are expected to be comma seperated lists of numbers.  loncommon::DrawBarGraph, loncommon::DrawXYGraph, and loncommon::DrawXYYGraph.
 escape( value ) means the values must be run through lonnet::escape.  
   
 =cut  =cut
   
 use strict;  use strict;
   use lib '/home/httpd/lib/perl';
 use GD::Graph::bars;  use GD::Graph::bars;
   use GD::Graph::lines;
 use GD::Graph::colour;  use GD::Graph::colour;
 use GD::Graph::Data;  use GD::Graph::Data;
   use LONCAPA::loncgi;
   
 sub unescape {  sub unescape {
     my $str=shift;      my $str=shift;
Line 65  sub unescape { Line 67  sub unescape {
     return $str;      return $str;
 }  }
   
   sub error {
       my ($error) = @_;
       my $Str = <<"END";
   Content-type: text/html
   
   <html>
   <head><title>Bad Graph</title></head>
   <body>
   <p>
   There was an error producing the graph you requested.
   </p><p>
   $error
   </p>
   </body>
   </html>
   END
       return $Str;
   }
   
   my $id = $ENV{'QUERY_STRING'};
   
   #
   # usage: &get_env($name,$default)
   sub get_env {
       my $key = 'cgi.'.$id.'.'.(shift());
       return shift if (! exists($env{$key}));
       return $env{$key};
   }
   
   if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
       print <<END;
   Content-type: text/html
   
   <html>
   <head><title>Bad Cookie</title></head>
   <body>
   Your cookie information is incorrect.
   </body>
   </html>
   END
       exit;
   }
   
 $|=1;   # Autoflush after each print/write  $|=1;   # Autoflush after each print/write
 my ($Titr,$xlab,$ylab,$Max,$PNo,$data1,$data2)=split(/&/,$ENV{'QUERY_STRING'});  
 $Titr = &unescape($Titr);  ##
 $xlab = &unescape($xlab);  ## Set up the plot
 $ylab = &unescape($ylab);  ##
   my $colordefaults = join(',',
 my @data11=split(/\,/,$data1);                           ('#33ff00', 
 my @data12=split(/\,/,$data2);                            '#0033cc','#990000','#aaaa66','#663399','#ff9933',
 my $skip_x = 1;                            '#66ccff','#ff9999','#cccc33','#660000','#33cc66',
 my $bar_space=10;                            ));
   
 my @xlabels;  my $height   = &get_env('height',300);
   my $width    = &get_env('width', 400);
 if ($Titr =~ /^Percentage$/){  my $PlotType = &get_env('PlotType','bar');
     for (my $nIdx=0; $nIdx<$PNo; $nIdx++ ) {  
         $xlabels[$nIdx]=$nIdx;  my %GraphSettings = (
     }                       title           => &unescape(&get_env('title','')),
     @data11=();                       x_label         => &unescape(&get_env('xlabel','')),
     @data11=split(/\,/,$data2);                       y_label         => &unescape(&get_env('ylabel','')),
     @data12=();                       x_label_position => 0.5,
     $Titr = '';                       dclrs           => [split(',',&get_env('Colors',
                                                               $colordefaults))],
                        fgclr           => 'black',
                        boxclr          => 'white',
                        accentclr       => 'dblue',
                        valuesclr       => '#ffff77',
                        l_margin        => 10,
                        b_margin        => 10,
                        r_margin        => 10,
                        t_margin        => 10,
                        transparent     => 0,
                        );
   
   $GraphSettings{'x_label_skip'}  = &get_env('xskip',1);
   $GraphSettings{'x_tick_offset'} = &get_env('x_tick_offset',0);
   $GraphSettings{'y_max_value'}   = &get_env('y_max_value',1);
   
   my $MyGraph;
   if ($PlotType eq 'bar') {
       # Pick up bar graph settings
       $GraphSettings{'bar_width'}     = &get_env('bar_width',undef);
       $GraphSettings{'long_ticks'}    = 1;
       $GraphSettings{'tick_length'}   = 0;
       $GraphSettings{'x_ticks'}       = 0;
       $GraphSettings{'cumulate'}      = 2;
       $GraphSettings{'zero_axis'}     = 1;
 } else {  } else {
      for (my $nIdx=0; $nIdx<$PNo; $nIdx++ ) {      #
          $xlabels[$nIdx]=$nIdx+1;      # X label skip setup
      }      my $skip_x = &get_env('xskip',1);
 }       my $x_tick_offset = &get_env('x_tick_offset',$skip_x-1);
       my $zero_axis = &get_env('zero_axis',1);
 my @data =(\@xlabels,\@data11,\@data12);      #
       # Fill up %GraphSettings
 my $width;      $GraphSettings{'long_ticks'}    = 1;
 my $height = 200;      $GraphSettings{'tick_length'}   = 0;
       $GraphSettings{'x_ticks'}       = &get_env('x_ticks',0),;
 if ($xlab=~/^Concepts$/){      $GraphSettings{'x_label_skip'}  = $skip_x;
     $width=270;      $GraphSettings{'x_tick_offset'} = $x_tick_offset;
 } elsif ($xlab=~/^Problem\snumber$/){      $GraphSettings{'zero_axis'}     = 1;
     $width=450;      if (&get_env('two_axes',0)) {
           $GraphSettings{'two_axes'}     = 1;
           $GraphSettings{'y1_label'}     = &get_env('y1_label',
                                                     $GraphSettings{'y_label'});
           $GraphSettings{'y2_label'}     = &get_env('y2_label','');
           $GraphSettings{'y1_max_value'} = &get_env('y1_max_value',0);
           $GraphSettings{'y1_min_value'} = &get_env('y1_min_value',1);
           $GraphSettings{'y2_max_value'} = &get_env('y2_max_value',1);
           $GraphSettings{'y2_min_value'} = &get_env('y2_min_value',1);
       }
   }
   #
   # Pick up miscellanious values passed in by the user
   #
   # Create the plot and check it out
   if ($PlotType eq 'bar') {
       $MyGraph = GD::Graph::bars->new($width,$height);
 } else {  } else {
     $width=($PNo==100) ? 800 : (120+$PNo*10);       $MyGraph = GD::Graph::lines->new($width,$height);
     $skip_x=5;  }
     $bar_space=1;  if (! defined($MyGraph)) {
 }      print &error('Unable to create initial graph');
       return;
 my $x_tick_offset = 0;  }
 if ($skip_x > 1) {  
     $x_tick_offset = $skip_x - 1;  
 }  
   
 my $MyGraph = GD::Graph::bars->new($width,$height);  
   
 $MyGraph->set(   
     x_label         => $xlab,  
     y_label         => $ylab,  
     x_label_position => 0.5,  
     long_ticks      => 1,  
     tick_length     => 0,  
     x_ticks         => 0,  
     title           => $Titr,  
     y_max_value     => $Max,  
 #    y_tick_number   => $ytic,  
     y_label_skip    => 5,  
     x_label_skip    => $skip_x,     
     x_tick_offset   => $x_tick_offset,  
   
     dclrs           => [ qw( lgreen dgreen lyellow lpurple cyan lorange)],  
       
     bar_spacing     => $bar_space,  
     cumulate        => 2,  
     zero_axis        => 1,  
   
 #    legend_placement    => 'RT',  
   
     fgclr               => 'black',  
     boxclr              => 'white',  
     accentclr           => 'dblue',  
     valuesclr           => '#ffff77',  
     l_margin            => 10,  
     b_margin            => 10,  
     r_margin            => 10,  
     t_margin            => 10,  
   
     transparent     => 0,  ##
 ) or warn $MyGraph->error;   ## Build the @Data array
   my $NumSets = &get_env('NumSets');
   my @Data;        # stores the data for the graph
   my @Legend;      # one entry per data set
   my @xlabels  = split(',',&get_env('labels'));
   push(@Data,\@xlabels);
   for (my $i=1;$i<=$NumSets;$i++) {
       push(@Data,[split(',',&get_env('data.'.$i))]);
       push(@Legend,&get_env('data.'.$i.'.label',undef));
   }
   
   my $error = '';
   if (! $MyGraph->set(%GraphSettings)) {
       print &error($MyGraph->error);
       return;
   }
   
   if (join('',@Legend) ne '') {
       $MyGraph->set_legend(@Legend);
   }
   
   
   my $plot = $MyGraph->plot(\@Data);
   if (! defined($plot)) {
       my $error = 'Unable to plot the data provided.';
   # Debugging code:    
   #    $error .= '<pre>'.join(',',@{$Data[0]}).'</pre>';
   #    $error .= '<pre>'.join(',',@{$Data[1]}).'</pre>';
   #    $error .= '<pre>'.join(',',@{$Data[2]}).'</pre>' if (ref($Data[2]));
   #    $error .= '<pre>'.join(',',@{$Data[3]}).'</pre>' if (ref($Data[3]));
       print &error($error);
       exit;
   }
   
   my $BinaryData=$plot->png;
   undef($MyGraph);
   undef($plot);
   
   if (! defined($BinaryData)) {
       print &error('Unable to render graph as image');
       exit;
   }
   
 # Tell the server we are sending a png graphic  # Tell the server we are sending a png graphic
 print <<END;  print <<END;
Line 155  Content-type: image/png Line 245  Content-type: image/png
   
 END  END
   
 my $BinaryData=$MyGraph->plot(\@data)->png;  
 undef $MyGraph;  
 binmode(STDOUT);  binmode(STDOUT);
 #open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image  #open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
 #print IMG $BinaryData; # output image  #print IMG $BinaryData; # output image

Removed from v.1.22  
changed lines
  Added in v.1.34


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>