[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.137 and 1.149

version 1.137, 2003/10/29 15:21:10 version 1.149, 2003/11/10 16:33:57
Line 69  use Apache::Constants qw(:common :http : Line 69  use Apache::Constants qw(:common :http :
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::lonmenu();  use Apache::lonmenu();
 use Apache::lonlocal;  use Apache::lonlocal;
   use HTML::Entities;
   
 my $readit;  my $readit;
   
Line 90  my %category_extensions; Line 91  my %category_extensions;
 my %designhash;  my %designhash;
   
 # ---------------------------------------------- Thesaurus variables  # ---------------------------------------------- Thesaurus variables
   #
 # FIXME: I don't think it's necessary to document these things;  # %Keywords:
 # they're privately used - Jeremy  #      A hash used by &keyword to determine if a word is considered a keyword.
   # $thesaurus_db_file 
 =pod  #      Scalar containing the full path to the thesaurus database.
   
 =over 4  
   
 =item * %Keywords    
   
 A hash used by &keyword to determine if a word is considered a keyword.  
   
 =item * $thesaurus_db_file  
   
 Scalar containing the full path to the thesaurus database.                   
   
 =back  
   
 =cut  
   
 my %Keywords;  my %Keywords;
 my $thesaurus_db_file;  my $thesaurus_db_file;
   
 # ----------------------------------------------------------------------- BEGIN  #
   # Initialize values from language.tab, copyright.tab, filetypes.tab,
 # FIXME: I don't think this needs to be documented, it prepares  # thesaurus.tab, and filecategories.tab.
 # private data structures - Jeremy  #
 =pod  
   
 =head1 General Subroutines  
   
 =over 4  
   
 =item * BEGIN()   
   
 Initialize values from language.tab, copyright.tab, filetypes.tab,  
 thesaurus.tab, and filecategories.tab.  
   
 =back  
   
 =cut  
   
 # ----------------------------------------------------------------------- BEGIN  
   
 BEGIN {  BEGIN {
     # Variable initialization      # Variable initialization
     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";      $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
Line 234  BEGIN { Line 204  BEGIN {
   
 =pod   =pod 
   
   =head1 General Subroutines
   
   =over 4
   
 =head1 HTML and Javascript Functions  =head1 HTML and Javascript Functions
   
 =over 4  =over 4
Line 520  function select1_changed() { Line 494  function select1_changed() {
     // in with the nuclear      // in with the nuclear
     for (i=0;i<values.length; i++) {      for (i=0;i<values.length; i++) {
         $second.options[i] = new Option(values[i]);          $second.options[i] = new Option(values[i]);
           $second.options[i].value = values[i];
         $second.options[i].text = texts[i];          $second.options[i].text = texts[i];
         if (values[i] == select2def) {          if (values[i] == select2def) {
             $second.options[i].selected = true;              $second.options[i].selected = true;
Line 1086  END Line 1061  END
   
 sub authform_authorwarning{  sub authform_authorwarning{
     my $result='';      my $result='';
     $result=<<"END";      $result='<i>'.
 <i>As a general rule, only authors or co-authors should be filesystem          &mt('As a general rule, only authors or co-authors should be '.
 authenticated (which allows access to the server filesystem).</i>              'filesystem authenticated '.
 END              '(which allows access to the server filesystem).')."</i>\n";
     return $result;      return $result;
 }  }
   
Line 1099  sub authform_nochange{ Line 1074  sub authform_nochange{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
           );            );
     my $result='';      my $result = &mt('[_1] Do not change login data',
     $result.=<<"END";                       '<input type="radio" name="login" value="nochange" '.
 <input type="radio" name="login" value="nochange" checked="checked"                       'checked="checked" onclick="'.
        onclick="javascript:changed_radio('nochange',$in{'formname'});" />              "javascript:changed_radio('nochange',$in{'formname'});".'" />');
 Do not change login data  
 END  
     return $result;      return $result;
 }  }
   
Line 1115  sub authform_kerberos{ Line 1088  sub authform_kerberos{
               kerb_def_auth => 'krb4',                kerb_def_auth => 'krb4',
               @_,                @_,
               );                );
     my $result='';      my ($check4,$check5);
     my $check4;  
     my $check5;  
     if ($in{'kerb_def_auth'} eq 'krb5') {      if ($in{'kerb_def_auth'} eq 'krb5') {
        $check5 = " checked=\"on\"";         $check5 = " checked=\"on\"";
     } else {      } else {
        $check4 = " checked=\"on\"";         $check4 = " checked=\"on\"";
     }      }
     $result.=<<"END";      my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
 <input type="radio" name="login" value="krb"       my $result .= &mt
        onclick="javascript:changed_radio('krb',$in{'formname'});"          ('[_1] Kerberos authenticated with domain [_2] '.
        onchange="javascript:changed_radio('krb',$in{'formname'});" />           '[_3] Version 4 [_4] Version 5',
 Kerberos authenticated with domain           '<input type="radio" name="login" value="krb" '.
 <input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"               'onclick="'.$jscall.'" onchange="'.$jscall.'" />',
        onchange="javascript:changed_text('krb',$in{'formname'});" />           '<input type="text" size="10" name="krbarg" '.
 <input type="radio" name="krbver" value="4" $check4 />Version 4               'value="'.$in{'kerb_def_dom'}.'" '.
 <input type="radio" name="krbver" value="5" $check5 />Version 5               'onchange="'.$jscall.'" />',
 END           '<input type="radio" name="krbver" value="4" '.$check4.' />',
            '<input type="radio" name="krbver" value="5" '.$check5.' />');
     return $result;      return $result;
 }  }
   
Line 1142  sub authform_internal{ Line 1114  sub authform_internal{
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
     my $result='';      my $jscall = "javascript:changed_radio('int',$args{'formname'});";
     $result.=<<"END";      my $result.=&mt
 <input type="radio" name="login" value="int"          ('[_1] Internally authenticated (with initial password [_2])',
        onchange="javascript:changed_radio('int',$args{'formname'});"           '<input type="radio" name="login" value="int" '.
        onclick="javascript:changed_radio('int',$args{'formname'});" />               'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
 Internally authenticated (with initial password            '<input type="text" size="10" name="intarg" value="" '.
 <input type="text" size="10" name="intarg" value=""               'onchange="'.$jscall.'" />');
        onchange="javascript:changed_text('int',$args{'formname'});" />)  
 END  
     return $result;      return $result;
 }  }
   
Line 1160  sub authform_local{ Line 1130  sub authform_local{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my $result='';      my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
     $result.=<<"END";      my $result.=&mt('[_1] Local Authentication with arguement [_2]',
 <input type="radio" name="login" value="loc"                      '<input type="radio" name="login" value="loc" '.
        onchange="javascript:changed_radio('loc',$in{'formname'});"                          'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
        onclick="javascript:changed_radio('loc',$in{'formname'});" />                      '<input type="text" size="10" name="locarg" value="" '.
 Local Authentication with argument                          'onchange="'.$jscall.'" />');
 <input type="text" size="10" name="locarg" value=""  
        onchange="javascript:changed_text('loc',$in{'formname'});" />  
 END  
     return $result;      return $result;
 }  }
   
Line 1178  sub authform_filesystem{ Line 1145  sub authform_filesystem{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my $result='';      my $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
     $result.=<<"END";      my $result.= &mt
 <input type="radio" name="login" value="fsys"           ('[_1] Filesystem Authenticated (with initial password [_2])',
        onchange="javascript:changed_radio('fsys',$in{'formname'});"           '<input type="radio" name="login" value="fsys" '.
        onclick="javascript:changed_radio('fsys',$in{'formname'});" />           'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
 Filesystem authenticated (with initial password            '<input type="text" size="10" name="fsysarg" value="" '.
 <input type="text" size="10" name="fsysarg" value=""                    'onchange="'.$jscall.'" />');
        onchange="javascript:changed_text('fsys',$in{'formname'});">)  
 END  
     return $result;      return $result;
 }  }
   
Line 1534  sub languagedescription { Line 1499  sub languagedescription {
     ($supported_language{$code}?' ('.&mt('interface available').')':'');      ($supported_language{$code}?' ('.&mt('interface available').')':'');
 }  }
   
   sub plainlanguagedescription {
       my $code=shift;
       return $language{$code};
   }
   
   sub supportedlanguagecode {
       my $code=shift;
       return $supported_language{$code};
   }
   
 =pod  =pod
   
 =item * copyrightids()   =item * copyrightids() 
Line 1770  sub get_previous_attempt { Line 1745  sub get_previous_attempt {
        } else {         } else {
   $value=$returnhash{$version.':'.$_};    $value=$returnhash{$version.':'.$_};
        }         }
        $prevattempts.='<td>'.$value.'&nbsp;</td>';            $prevattempts.='<td>'.&Apache::lonnet::unescape($value).'&nbsp;</td>';   
     }      }
  }   }
       }        }
Line 1782  sub get_previous_attempt { Line 1757  sub get_previous_attempt {
  } else {   } else {
   $value=$lasthash{$_};    $value=$lasthash{$_};
  }   }
    $value=&Apache::lonnet::unescape($value);
  if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}   if ($_ =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
  $prevattempts.='<td>'.$value.'&nbsp;</td>';   $prevattempts.='<td>'.$value.'&nbsp;</td>';
       }        }
Line 2142  sub bodytag { Line 2118  sub bodytag {
     my $sidebg=&designparm($function.'.sidebg',$domain);      my $sidebg=&designparm($function.'.sidebg',$domain);
 # Accessibility font enhance  # Accessibility font enhance
     unless ($addentries) { $addentries=''; }      unless ($addentries) { $addentries=''; }
       my $addstyle='';
     if ($ENV{'browser.fontenhance'} eq 'on') {      if ($ENV{'browser.fontenhance'} eq 'on') {
  $addentries.=' style="font-size: x-large"';   $addstyle=' font-size: x-large;';
     }      }
  # role and realm   # role and realm
     my ($role,$realm)      my ($role,$realm)
Line 2161  sub bodytag { Line 2138  sub bodytag {
     if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }      if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
 # construct main body tag  # construct main body tag
     my $bodytag = <<END;      my $bodytag = <<END;
   <style>
   h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
   a:hover { color: black; background: yellow }
   a:focus { color: red; background: yellow } 
   </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 $addentries>  style="border-color: $tabbg; border-width: 4px; border-style: solid; padding: 4px;$addstyle" $addentries>
 END  END
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                    $lonhttpdPort.$img.'" />';                     $lonhttpdPort.$img.'" />';
Line 2193  $upperleft</td> Line 2175  $upperleft</td>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 &nbsp;<font size="5"><b>$title</b></font>  &nbsp;<font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
 <td bgcolor="$tabbg"  align="right">  <td bgcolor="$tabbg" align="right">
 <font size="2">  <font size="2" face="Arial, Helvetica, sans-serif">
     $ENV{'environment.firstname'}      $ENV{'environment.firstname'}
     $ENV{'environment.middlename'}      $ENV{'environment.middlename'}
     $ENV{'environment.lastname'}      $ENV{'environment.lastname'}
Line 2204  $upperleft</td> Line 2186  $upperleft</td>
 </td>  </td>
 </tr>  </tr>
 <tr><td bgcolor="$tabbg" align="right">  <tr><td bgcolor="$tabbg" align="right">
 <font size="2">$role</font>&nbsp;  <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
 </td></tr>  </td></tr>
 <tr>  <tr>
 <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>  <td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font>&nbsp;</td></tr>
 </table><br>  </table><br>
 ENDBODY  ENDBODY
 }  }
Line 2384  sub add_to_env { Line 2366  sub add_to_env {
   
 =pod  =pod
   
   =item * get_env_multiple($name) 
   
   gets $name from the %ENV hash, it seemlessly handles the cases where multiple
   values may be defined and end up as an array ref.
   
   returns an array of values
   
   =cut
   
   sub get_env_multiple {
       my ($name) = @_;
       my @values;
       if (defined($ENV{$name})) {
           # exists is it an array
           if (ref($ENV{$name})) {
               @values=@{ $ENV{$name} };
           } else {
               $values[0]=$ENV{$name};
           }
       }
       return(@values);
   }
   
   
   =pod
   
 =back   =back 
   
 =head1 CSV Upload/Handling functions  =head1 CSV Upload/Handling functions
Line 2507  sub record_sep { Line 2515  sub record_sep {
     return %components;      return %components;
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item * upfile_select_html()  =item * upfile_select_html()
   
 return HTML code to select file and specify its type  Return HTML code to select a file from the users machine and specify 
   the file type.
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub upfile_select_html {  sub upfile_select_html {
     return (<<'ENDUPFORM');      my %Types = (
 <input type="file" name="upfile" size="50" />                   csv   => &mt('CSV (comma separated values, spreadsheet)'),
 <br />Type: <select name="upfiletype">                   space => &mt('Space separated'),
 <option value="csv">CSV (comma separated values, spreadsheet)</option>                   tab   => &mt('Tabulator separated'),
 <option value="space">Space separated</option>  #                 xml   => &mt('HTML/XML'),
 <option value="tab">Tabulator separated</option>                   );
 <option value="xml">HTML/XML</option>      my $Str = '<input type="file" name="upfile" size="50" />'.
 </select>          '<br />Type: <select name="upfiletype">';
 ENDUPFORM      foreach my $type (sort(keys(%Types))) {
           $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
       }
       $Str .= "</select>\n";
       return $Str;
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item * csv_print_samples($r,$records)  =item * csv_print_samples($r,$records)
Line 2537  Apache Request ref, $records is an array Line 2558  Apache Request ref, $records is an array
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub csv_print_samples {  sub csv_print_samples {
     my ($r,$records) = @_;      my ($r,$records) = @_;
     my (%sone,%stwo,%sthree);      my (%sone,%stwo,%sthree);
     %sone=&record_sep($$records[0]);      %sone=&record_sep($$records[0]);
     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}      if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}      if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
       #
     $r->print('Samples<br /><table border="2"><tr>');      $r->print(&mt('Samples').'<br /><table border="2"><tr>');
     foreach (sort({$a <=> $b} keys(%sone))) { $r->print('<th>Column&nbsp;'.($_+1).'</th>'); }      foreach (sort({$a <=> $b} keys(%sone))) { 
           $r->print('<th>'.&mt('Column&nbsp;[_1]',($_+1)).'</th>'); }
     $r->print('</tr>');      $r->print('</tr>');
     foreach my $hash (\%sone,\%stwo,\%sthree) {      foreach my $hash (\%sone,\%stwo,\%sthree) {
  $r->print('<tr>');   $r->print('<tr>');
Line 2559  sub csv_print_samples { Line 2583  sub csv_print_samples {
     $r->print('</tr></table><br />'."\n");      $r->print('</tr></table><br />'."\n");
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item * csv_print_select_table($r,$records,$d)  =item * csv_print_select_table($r,$records,$d)
   
 Prints a table to create associations between values and table columns.  Prints a table to create associations between values and table columns.
   
 $r is an Apache Request ref,  $r is an Apache Request ref,
 $records is an arrayref from &Apache::loncommon::upfile_record_sep,  $records is an arrayref from &Apache::loncommon::upfile_record_sep,
 $d is an array of 2 element arrays (internal name, displayed name)  $d is an array of 2 element arrays (internal name, displayed name)
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub csv_print_select_table {  sub csv_print_select_table {
     my ($r,$records,$d) = @_;      my ($r,$records,$d) = @_;
     my $i=0;my %sone;      my $i=0;my %sone;
     %sone=&record_sep($$records[0]);      %sone=&record_sep($$records[0]);
     $r->print('Associate columns with student attributes.'."\n".      $r->print(&mt('Associate columns with student attributes.')."\n".
      '<table border="2"><tr><th>Attribute</th><th>Column</th></tr>'."\n");       '<table border="2"><tr>'.
                 '<th>'.&mt('Attribute').'</th>'.
                 '<th>'.&mt('Column').'</th></tr>'."\n");
     foreach (@$d) {      foreach (@$d) {
  my ($value,$display)=@{ $_ };   my ($value,$display)=@{ $_ };
  $r->print('<tr><td>'.$display.'</td>');   $r->print('<tr><td>'.$display.'</td>');
Line 2593  sub csv_print_select_table { Line 2625  sub csv_print_select_table {
     return $i;      return $i;
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item * csv_samples_select_table($r,$records,$d)  =item * csv_samples_select_table($r,$records,$d)
Line 2605  $d is an array of 2 element arrays (inte Line 2640  $d is an array of 2 element arrays (inte
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub csv_samples_select_table {  sub csv_samples_select_table {
     my ($r,$records,$d) = @_;      my ($r,$records,$d) = @_;
     my %sone; my %stwo; my %sthree;      my %sone; my %stwo; my %sthree;
     my $i=0;      my $i=0;
       #
     $r->print('<table border=2><tr><th>Field</th><th>Samples</th></tr>');      $r->print('<table border=2><tr><th>'.
                 &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
     %sone=&record_sep($$records[0]);      %sone=&record_sep($$records[0]);
     if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}      if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
     if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}      if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
       #
     foreach (sort keys %sone) {      foreach (sort keys %sone) {
  $r->print('<tr><td><select name=f'.$i.   $r->print('<tr><td><select name="f'.$i.'"'.
   ' onchange="javascript:flip(this.form,'.$i.');">');    ' onchange="javascript:flip(this.form,'.$i.');">');
  foreach (@$d) {   foreach (@$d) {
     my ($value,$display)=@{ $_ };      my ($value,$display)=@{ $_ };
     $r->print('<option value='.$value.'>'.$display.'</option>');      $r->print('<option value="'.$value.'">'.$display.'</option>');
  }   }
  $r->print('</select></td><td>');   $r->print('</select></td><td>');
  if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }   if (defined($sone{$_})) { $r->print($sone{$_}."</br>\n"); }
Line 2633  sub csv_samples_select_table { Line 2671  sub csv_samples_select_table {
     return($i);      return($i);
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item clean_excel_name($name)  =item clean_excel_name($name)
Line 2641  Returns a replacement for $name which do Line 2682  Returns a replacement for $name which do
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub clean_excel_name {  sub clean_excel_name {
     my ($name) = @_;      my ($name) = @_;
     $name =~ s/[:\*\?\/\\]//g;      $name =~ s/[:\*\?\/\\]//g;
Line 2671  sub check_if_partid_hidden { Line 2714  sub check_if_partid_hidden {
     my ($id,$symb,$udom,$uname) = @_;      my ($id,$symb,$udom,$uname) = @_;
     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',      my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
  $symb,$udom,$uname);   $symb,$udom,$uname);
       my $truth=1;
       #if the string starts with !, then the list is the list to show not hide
       if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
     my @hiddenlist=split(/,/,$hiddenparts);      my @hiddenlist=split(/,/,$hiddenparts);
     foreach my $checkid (@hiddenlist) {      foreach my $checkid (@hiddenlist) {
  if ($checkid =~ /^\s*\Q$id\E\s*$/) { return 1; }   if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
     }      }
     return undef;      return !$truth;
 }  }
   
   
   ############################################################
   ############################################################
   
   =pod
   
   =head1 cgi-bin script and graphing routines
   
   =item get_cgi_id
   
   Inputs: none
   
   Returns an id which can be used to pass environment variables
   to various cgi-bin scripts.  These environment variables will
   be removed from the users environment after a given time by
   the routine &Apache::lonnet::transfer_profile_to_env.
   
   =cut
   
   ############################################################
   ############################################################
   
 sub get_cgi_id {  sub get_cgi_id {
     return (time.'_'.int(rand(1000)));      return (time.'_'.int(rand(1000)));
 }  }
Line 2689  sub get_cgi_id { Line 2757  sub get_cgi_id {
   
 =item DrawBarGraph  =item DrawBarGraph
   
   Facilitates the plotting of data in a (stacked) bar graph.
   Puts plot definition data into the users environment in order for 
   graph.png to plot it.  Returns an <img> tag for the plot.
   The bars on the plot are labeled '1','2',...,'n'.
   
   Inputs:
   
   =over 4
   
   =item $Title: string, the title of the plot
   
   =item $xlabel: string, text describing the X-axis of the plot
   
   =item $ylabel: string, text describing the Y-axis of the plot
   
   =item $Max: scalar, the maximum Y value to use in the plot
   If $Max is < any data point, the graph will not be rendered.
   
   =item $colors: array ref holding the colors to be used for the data sets when
   they are plotted.  If undefined, default values will be used.
   
   =item @Values: An array of array references.  Each array reference holds data
   to be plotted in a stacked bar chart.
   
   =back
   
   Returns:
   
   An <img> tag which references graph.png and the appropriate identifying
   information for the plot.
   
 =cut  =cut
   
 ############################################################  ############################################################
Line 2774  sub DrawBarGraph { Line 2873  sub DrawBarGraph {
   
 =item DrawXYGraph  =item DrawXYGraph
   
   Facilitates the plotting of data in an XY graph.
   Puts plot definition data into the users environment in order for 
   graph.png to plot it.  Returns an <img> tag for the plot.
   
   Inputs:
   
   =over 4
   
   =item $Title: string, the title of the plot
   
   =item $xlabel: string, text describing the X-axis of the plot
   
   =item $ylabel: string, text describing the Y-axis of the plot
   
   =item $Max: scalar, the maximum Y value to use in the plot
   If $Max is < any data point, the graph will not be rendered.
   
   =item $colors: Array ref containing the hex color codes for the data to be 
   plotted in.  If undefined, default values will be used.
   
   =item $Xlabels: Array ref containing the labels to be used for the X-axis.
   
   =item $Ydata: Array ref containing Array refs.  
   Each of the contained arrays will be plotted as a seperate curve.
   
   =item %Values: hash indicating or overriding any default values which are 
   passed to graph.png.  
   Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
   
   =back
   
   Returns:
   
   An <img> tag which references graph.png and the appropriate identifying
   information for the plot.
   
 =cut  =cut
   
 ############################################################  ############################################################
Line 2796  sub DrawXYGraph { Line 2931  sub DrawXYGraph {
          $id.'.y_max_value'=> $Max,           $id.'.y_max_value'=> $Max,
          $id.'.labels'     => join(',',@$Xlabels),           $id.'.labels'     => join(',',@$Xlabels),
          $id.'.PlotType'   => 'XY',           $id.'.PlotType'   => 'XY',
          $id.'.NumSets'    => 1,  
          );           );
     #      #
     if (defined($colors) && ref($colors) eq 'ARRAY') {      if (defined($colors) && ref($colors) eq 'ARRAY') {
Line 2807  sub DrawXYGraph { Line 2941  sub DrawXYGraph {
         return '';          return '';
     }      }
     my $NumSets=1;      my $NumSets=1;
     foreach my $array ($Ydata){      foreach my $array (@{$Ydata}){
         next if (! ref($array));          next if (! ref($array));
         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);          $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
     }      }
       $ValuesHash{$id.'.NumSets'} = $NumSets-1;
     #      #
     # Deal with other parameters      # Deal with other parameters
     while (my ($key,$value) = each(%Values)) {      while (my ($key,$value) = each(%Values)) {
Line 2821  sub DrawXYGraph { Line 2956  sub DrawXYGraph {
     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';      return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
   
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
 =pod  =pod
   
 =item DrawXYGraph  =item DrawXYYGraph
   
   Facilitates the plotting of data in an XY graph with two Y axes.
   Puts plot definition data into the users environment in order for 
   graph.png to plot it.  Returns an <img> tag for the plot.
   
   Inputs:
   
   =over 4
   
   =item $Title: string, the title of the plot
   
   =item $xlabel: string, text describing the X-axis of the plot
   
   =item $ylabel: string, text describing the Y-axis of the plot
   
   =item $colors: Array ref containing the hex color codes for the data to be 
   plotted in.  If undefined, default values will be used.
   
   =item $Xlabels: Array ref containing the labels to be used for the X-axis.
   
   =item $Ydata1: The first data set
   
   =item $Min1: The minimum value of the left Y-axis
   
   =item $Max1: The maximum value of the left Y-axis
   
   =item $Ydata2: The second data set
   
   =item $Min2: The minimum value of the right Y-axis
   
   =item $Max2: The maximum value of the left Y-axis
   
   =item %Values: hash indicating or overriding any default values which are 
   passed to graph.png.  
   Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
   
   =back
   
   Returns:
   
   An <img> tag which references graph.png and the appropriate identifying
   information for the plot.
   
 =cut  =cut
   
Line 2883  sub DrawXYYGraph { Line 3059  sub DrawXYYGraph {
 }  }
   
 ############################################################  ############################################################
   ############################################################
   
   =pod
   
   =head1 Statistics helper routines?  
   
   Bad place for them but what the hell.
   
   =item &chartlink
   
   Returns a link to the chart for a specific student.  
   
   Inputs:
   
   =over 4
   
   =item $linktext: The text of the link
   
   =item $sname: The students username
   
   =item $sdomain: The students domain
   
   =back
   
   =cut
   
   ############################################################
   ############################################################
   sub chartlink {
       my ($linktext, $sname, $sdomain) = @_;
       my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
           '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
           '&chartoutputmode='.HTML::Entities::encode('html, with all links').
          '">'.$linktext.'</a>';
   }
   
   ############################################################
 ############################################################  ############################################################
   
 =pod  =pod
Removed from v.1.137  
changed lines
  Added in v.1.149

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