Diff for /loncom/interface/loncommon.pm between versions 1.173 and 1.198

version 1.173, 2004/01/15 18:12:59 version 1.198, 2004/07/12 17:02:07
Line 74  my $readit; Line 74  my $readit;
 my %language;  my %language;
 my %supported_language;  my %supported_language;
 my %cprtag;  my %cprtag;
   my %scprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %category_extensions;
   
Line 131  BEGIN { Line 132  BEGIN {
             close($fh);              close($fh);
         }          }
     }      }
   # ------------------------------------------------------------------ source copyrights
       {
           my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                     '/source_copyright.tab';
           if ( open (my $fh,"<$sourcecopyrightfile") ) {
               while (<$fh>) {
                   next if /^\#/;
                   chomp;
                   my ($key,$val)=(split(/\s+/,$_,2));
                   $scprtag{$key}=$val;
               }
               close($fh);
           }
       }
   
 # -------------------------------------------------------------- domain designs  # -------------------------------------------------------------- domain designs
   
Line 220  formname and elementname indicate the na Line 235  formname and elementname indicate the na
 the element that the results of the browsing selection are to be placed in.   the element that the results of the browsing selection are to be placed in. 
   
 Specifying 'only' will restrict the browser to displaying only files  Specifying 'only' will restrict the browser to displaying only files
 with the given extension.  Can be a comma seperated list.  with the given extension.  Can be a comma separated list.
   
 Specifying 'omit' will restrict the browser to NOT displaying files  Specifying 'omit' will restrict the browser to NOT displaying files
 with the given extension.  Can be a comma seperated list.  with the given extension.  Can be a comma separated list.
   
 =item * opensearcher(formname, elementname) [javascript]  =item * opensearcher(formname, elementname) [javascript]
   
Line 353  sub coursebrowser_javascript { Line 368  sub coursebrowser_javascript {
    return (<<ENDSTDBRW);     return (<<ENDSTDBRW);
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
     var stdeditbrowser;      var stdeditbrowser;
     function opencrsbrowser(formname,uname,udom) {      function opencrsbrowser(formname,uname,udom,desc) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 368  sub coursebrowser_javascript { Line 383  sub coursebrowser_javascript {
    }     }
         }          }
         url += 'form=' + formname + '&cnumelement='+uname+          url += 'form=' + formname + '&cnumelement='+uname+
                                     '&cdomelement='+udom;                              '&cdomelement='+udom+
                                       '&cnameelement='+desc;
         var title = 'Course_Browser';          var title = 'Course_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 380  ENDSTDBRW Line 396  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele,$desc)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
 =pod  =pod
Line 592  sub help_open_topic { Line 608  sub help_open_topic {
     }      }
   
     # Add the graphic      # Add the graphic
       my $title = &mt('Online Help');
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>   <a href="$link" title="$title"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 620  sub helpLatexCheatsheet { Line 637  sub helpLatexCheatsheet {
  .'</td></tr></table>';   .'</td></tr></table>';
 }  }
   
   sub help_open_menu {
       my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
       $text = "" if (not defined $text);
       $stayOnPage = 0 if (not defined $stayOnPage);
       if ($ENV{'browser.interface'} eq 'textual' ||
           $ENV{'environment.remote'} eq 'off' ) {
           $stayOnPage=1;
       }
       $width = 620 if (not defined $width);
       $height = 600 if (not defined $height);
       my $link='';
       my $title = &mt('Choose your help');
       my $origurl = $ENV{'REQUEST_URI'};
       my $timestamp = time;
       foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
           $$_ = &Apache::lonnet::escape($$_);
       }
   
       if (!$stayOnPage) {
            $link = "javascript:helpMenu('open')";
       } else {
           $link = "javascript:helpMenu('display')";
       }
       my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
       my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp";
       my $template;
       if ($text ne "") {
    $template .= 
     "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
     "<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
       }
       $template .= <<"ENDTEMPLATE";
    <script>
   function helpMenu(caller) {
       if (caller == 'open') {
           newWindow =  window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )
           caller = newWindow.document
       } else {
           caller = this.document
       }
       caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
       caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
       caller.write("</html>")
       caller.close()
       if (caller == newWindow.document) {
           caller.focus()
       }
   }
    </script>
    <a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(Help Menu)" /></a>
   ENDTEMPLATE
       if ($text ne '') { $template.='</td></tr></table>' };
       return $template;
   }
   
 sub help_open_bug {  sub help_open_bug {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($ENV{'user.adv'}) { return ''; }
Line 630  sub help_open_bug { Line 702  sub help_open_bug {
  $ENV{'environment.remote'} eq 'off' ) {   $ENV{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 600 if (not defined $width);
     $height = 400 if (not defined $height);      $height = 600 if (not defined $height);
   
     $topic=~s/\W+/\+/g;      $topic=~s/\W+/\+/g;
     my $link='';      my $link='';
Line 646  sub help_open_bug { Line 718  sub help_open_bug {
     {      {
  $link = $url;   $link = $url;
     }      }
   
     # Add the text      # Add the text
     if ($text ne "")      if ($text ne "")
     {      {
Line 656  sub help_open_bug { Line 727  sub help_open_bug {
     }      }
   
     # Add the graphic      # Add the graphic
       my $title = &mt('Report a Bug');
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>   <a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 699  sub help_open_faq { Line 771  sub help_open_faq {
     }      }
   
     # Add the graphic      # Add the graphic
       my $title = &mt('View the FAQ');
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>   <a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
   
 }  }
   
   ###############################################################
   ###############################################################
   
 =pod  =pod
   
 =item * csv_translate($text)   =item * csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma seperated values'   Translate $text to allow it to be output as a 'comma separated values' 
 format.  format.
   
 =cut  =cut
   
   ###############################################################
   ###############################################################
 sub csv_translate {  sub csv_translate {
     my $text = shift;      my $text = shift;
     $text =~ s/\"/\"\"/g;      $text =~ s/\"/\"\"/g;
Line 723  sub csv_translate { Line 801  sub csv_translate {
     return $text;      return $text;
 }  }
   
   
   ###############################################################
   ###############################################################
   
   =pod
   
   =item * define_excel_formats
   
   Define some commonly used Excel cell formats.
   
   Currently supported formats:
   
   =over 4
   
   =item header
   
   =item bold
   
   =item h1
   
   =item h2
   
   =item h3
   
   =item date
   
   =back
   
   Inputs: $workbook
   
   Returns: $format, a hash reference.
   
   =cut
   
   ###############################################################
   ###############################################################
   sub define_excel_formats {
       my ($workbook) = @_;
       my $format;
       $format->{'header'} = $workbook->add_format(bold      => 1, 
                                                   bottom    => 1,
                                                   align     => 'center');
       $format->{'bold'} = $workbook->add_format(bold=>1);
       $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
       $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
       $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
       $format->{'date'} = $workbook->add_format(num_format=>
                                               'mmm d yyyy hh:mm AM/PM');
       return $format;
   }
   
   ###############################################################
   ###############################################################
   
 =pod  =pod
   
 =item * change_content_javascript():  =item * change_content_javascript():
Line 845  sub domain_select { Line 977  sub domain_select {
     } &get_domains;      } &get_domains;
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  return &multiple_select_form($name,$value,%domains);   return &multiple_select_form($name,$value,4,%domains);
     } else {      } else {
  return &select_form($name,$value,%domains);   return &select_form($name,$value,%domains);
     }      }
 }  }
   
 sub multiple_select_form {  sub multiple_select_form {
     my ($name,$value,%hash)=@_;      my ($name,$value,$size,%hash)=@_;
     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);      my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
     my $output='';      my $output='';
     my $size =(scalar keys %hash<4?scalar keys %hash:4);      if (! defined($size)) {
           $size = 4;
           if (scalar(keys(%hash))<4) {
               $size = scalar(keys(%hash));
           }
       }
     $output.="\n<select name='$name' size='$size' multiple='1'>";      $output.="\n<select name='$name' size='$size' multiple='1'>";
     foreach (sort keys %hash) {      foreach (sort(keys(%hash))) {
         $output.="<option name='$_'".          $output.='<option value="'.$_.'" ';
             ($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";          $output.='selected ' if ($selected{$_});
           $output.='>'.$hash{$_}."</option>\n";
     }      }
     $output.="</select>\n";      $output.="</select>\n";
     return $output;      return $output;
Line 1158  END Line 1296  END
     }      }
   
     my $radioval = "'nochange'";      my $radioval = "'nochange'";
       if (exists($in{'curr_authtype'}) &&
           defined($in{'curr_authtype'}) &&
           $in{'curr_authtype'} ne '') {
           $radioval = "'$in{'curr_authtype'}arg'";
       }
     my $argfield = 'null';      my $argfield = 'null';
     if ( grep/^mode$/,(keys %in) ) {      if ( grep/^mode$/,(keys %in) ) {
         if ($in{'mode'} eq 'modifycourse')  {          if ($in{'mode'} eq 'modifycourse')  {
Line 1584  sub plainname { Line 1727  sub plainname {
  $names{'lastname'}.' '.$names{'generation'};   $names{'lastname'}.' '.$names{'generation'};
     $name=~s/\s+$//;      $name=~s/\s+$//;
     $name=~s/\s+/ /g;      $name=~s/\s+/ /g;
       if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
     return $name;      return $name;
 }  }
   
Line 1740  sub copyrightdescription { Line 1884  sub copyrightdescription {
   
 =pod  =pod
   
   =item * source_copyrightids() 
   
   returns list of all source copyrights
   
   =cut
   
   sub source_copyrightids {
       return sort(keys(%scprtag));
   }
   
   =pod
   
   =item * source_copyrightdescription() 
   
   returns description of a specified source copyright id
   
   =cut
   
   sub source_copyrightdescription {
       return &mt($scprtag{shift(@_)});
   }
   
   =pod
   
 =item * filecategories()   =item * filecategories() 
   
 returns list of all file categories  returns list of all file categories
Line 1778  sub fileembstyle { Line 1946  sub fileembstyle {
   
 sub filecategoryselect {  sub filecategoryselect {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     return &select_form($name,$value,      return &select_form($value,$name,
  '' => &mt('Any category'),   '' => &mt('Any category'),
  map { $_,$_ } sort(keys(%category_extensions)));   map { $_,$_ } sort(keys(%category_extensions)));
 }  }
Line 1792  returns description for a specified file Line 1960  returns description for a specified file
 =cut  =cut
   
 sub filedescription {  sub filedescription {
     return &mt($fd{lc(shift(@_))});      my $file_description = $fd{lc(shift())};
       $file_description =~ s:([\[\]]):~$1:g;
       return &mt($file_description);
 }  }
   
 =pod  =pod
Line 1806  extra formatting Line 1976  extra formatting
   
 sub filedescriptionex {  sub filedescriptionex {
     my $ex=shift;      my $ex=shift;
     return '.'.$ex.' '.&mt($fd{lc($ex)});      my $file_description = $fd{lc($ex)};
       $file_description =~ s:([\[\]]):~$1:g;
       return '.'.$ex.' '.&mt($file_description);
 }  }
   
 # End of .tab access  # End of .tab access
Line 1841  sub display_languages { Line 2013  sub display_languages {
   
 sub preferred_languages {  sub preferred_languages {
     my @languages=();      my @languages=();
     if ($ENV{'environment.languages'}) {  
  @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});  
     }  
     if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {      if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
          $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));           $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));
     }      }
       if ($ENV{'environment.languages'}) {
    @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});
       }
     my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];      my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
     if ($browser) {      if ($browser) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
Line 2027  show a snapshot of what student was look Line 2199  show a snapshot of what student was look
 =cut  =cut
   
 sub get_student_view {  sub get_student_view {
   my ($symb,$username,$domain,$courseid,$target) = @_;    my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%form);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
     $old{$element}=$ENV{'form.grade_'.$element};        $form{'grade_'.$element}=eval '$'.$element #'
     $moreenv{'form.grade_'.$element}=eval '$'.$element #'  
   }    }
   if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}    if (defined($moreenv)) {
   &Apache::lonnet::appenv(%moreenv);        %form=(%form,%{$moreenv});
   $feedurl=&Apache::lonnet::clutter($feedurl);  
   my $userview=&Apache::lonnet::ssi_body($feedurl);  
   &Apache::lonnet::delenv('form.grade_');  
   foreach my $element (@elements) {  
     $ENV{'form.grade_'.$element}=$old{$element};  
   }    }
     if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
     $feedurl=&Apache::lonnet::clutter($feedurl);
     my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;    $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;    $userview=~s/\<\/body\>//gi;
   $userview=~s/\<html\>//gi;    $userview=~s/\<html\>//gi;
Line 2065  show a snapshot of how student was answe Line 2234  show a snapshot of how student was answe
 sub get_student_answers {  sub get_student_answers {
   my ($symb,$username,$domain,$courseid,%form) = @_;    my ($symb,$username,$domain,$courseid,%form) = @_;
   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%moreenv);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
     $old{$element}=$ENV{'form.grade_'.$element};      $moreenv{'grade_'.$element}=eval '$'.$element #'
     $moreenv{'form.grade_'.$element}=eval '$'.$element #'  
   }  
   $moreenv{'form.grade_target'}='answer';  
   &Apache::lonnet::appenv(%moreenv);  
   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);  
   &Apache::lonnet::delenv('form.grade_');  
   foreach my $element (@elements) {  
     $ENV{'form.grade_'.$element}=$old{$element};  
   }    }
     $moreenv{'grade_target'}='answer';
     %moreenv=(%form,%moreenv);
     my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
   return $userview;    return $userview;
 }  }
   
Line 2293  other decorations will be returned. Line 2457  other decorations will be returned.
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;
     $title=&mt($title);      $title=&mt($title);
     unless ($function) {      $function = &get_users_function() if (!$function);
  $function='student';  
         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {  
     $function='coordinator';  
         }  
  if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {  
             $function='admin';  
         }  
         if (($ENV{'request.role'}=~/^(au|ca)/) ||  
             ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {  
             $function='author';  
         }  
     }  
     my $img=&designparm($function.'.img',$domain);      my $img=&designparm($function.'.img',$domain);
     my $pgbg=&designparm($function.'.pgbg',$domain);      my $pgbg=&designparm($function.'.pgbg',$domain);
     my $tabbg=&designparm($function.'.tabbg',$domain);      my $tabbg=&designparm($function.'.tabbg',$domain);
Line 2393  ENDBODY Line 2545  ENDBODY
   
 ###############################################  ###############################################
   
   =pod
   
   =item get_users_function
   
   Used by &bodytag to determine the current users primary role.
   Returns either 'student','coordinator','admin', or 'author'.
   
   =cut
   
   ###############################################
   sub get_users_function {
       my $function = 'student';
       if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
           $function='coordinator';
       }
       if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
           $function='admin';
       }
       if (($ENV{'request.role'}=~/^(au|ca)/) ||
           ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
           $function='author';
       }
       return $function;
   }
   
   ###############################################
   
 sub get_posted_cgi {  sub get_posted_cgi {
     my $r=shift;      my $r=shift;
   
Line 2527  sub no_cache { Line 2706  sub no_cache {
 }  }
   
 sub content_type {  sub content_type {
   my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
   unless ($charset) {      unless ($charset) {
       $charset=&Apache::lonlocal::current_encoding;   $charset=&Apache::lonlocal::current_encoding;
   }      }
   $r->content_type($type.($charset?'; charset='.$charset:''));      if ($charset) { $type.='; charset='.$charset; }
       if ($r) {
    $r->content_type($type);
       } else {
    print("Content-type: $type\n\n");
       }
 }  }
   
 =pod  =pod
Line 2795  Prints a table to create associations be Line 2979  Prints a table to create associations be
   
 $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,defaultcol)
   
 =cut  =cut
   
Line 2810  sub csv_print_select_table { Line 2994  sub csv_print_select_table {
               '<th>'.&mt('Attribute').'</th>'.                '<th>'.&mt('Attribute').'</th>'.
               '<th>'.&mt('Column').'</th></tr>'."\n");                '<th>'.&mt('Column').'</th></tr>'."\n");
     foreach (@$d) {      foreach (@$d) {
  my ($value,$display)=@{ $_ };   my ($value,$display,$defaultcol)=@{ $_ };
  $r->print('<tr><td>'.$display.'</td>');   $r->print('<tr><td>'.$display.'</td>');
   
  $r->print('<td><select name=f'.$i.   $r->print('<td><select name=f'.$i.
   ' onchange="javascript:flip(this.form,'.$i.');">');    ' onchange="javascript:flip(this.form,'.$i.');">');
  $r->print('<option value="none"></option>');   $r->print('<option value="none"></option>');
  foreach (sort({$a <=> $b} keys(%sone))) {   foreach (sort({$a <=> $b} keys(%sone))) {
     $r->print('<option value="'.$_.'">Column '.($_+1).'</option>');      $r->print('<option value="'.$_.'"'.
                         ($_ eq $defaultcol ? ' selected ' : '').
                         '>Column '.($_+1).'</option>');
  }   }
  $r->print('</select></td></tr>'."\n");   $r->print('</select></td></tr>'."\n");
  $i++;   $i++;
Line 2858  sub csv_samples_select_table { Line 3044  sub csv_samples_select_table {
  $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,$defaultcol)=@{ $_ };
     $r->print('<option value="'.$value.'">'.$display.'</option>');      $r->print('<option value="'.$value.'"'.
                         ($i eq $defaultcol ? ' selected ':'').'>'.
                         $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 2984  If $Max is < any data point, the graph w Line 3172  If $Max is < any data point, the graph w
 =item $colors: array ref holding the colors to be used for the data sets when  =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.  they are plotted.  If undefined, default values will be used.
   
   =item $labels: array ref holding the labels to use on the x-axis for the bars.
   
 =item @Values: An array of array references.  Each array reference holds data  =item @Values: An array of array references.  Each array reference holds data
 to be plotted in a stacked bar chart.  to be plotted in a stacked bar chart.
   
Line 2999  information for the plot. Line 3189  information for the plot.
 ############################################################  ############################################################
 ############################################################  ############################################################
 sub DrawBarGraph {  sub DrawBarGraph {
     my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;      my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
     #      #
     if (! defined($colors)) {      if (! defined($colors)) {
         $colors = ['#33ff00',           $colors = ['#33ff00', 
Line 3042  sub DrawBarGraph { Line 3232  sub DrawBarGraph {
     }      }
     #      #
     my @Labels;      my @Labels;
     for (my $i=0;$i<@{$Values[0]};$i++) {      if (defined($labels)) {
         push (@Labels,$i+1);          @Labels = @$labels;
       } else {
           for (my $i=0;$i<@{$Values[0]};$i++) {
               push (@Labels,$i+1);
           }
     }      }
     #      #
     $Max = 1 if ($Max < 1);      $Max = 1 if ($Max < 1);
Line 3102  plotted in.  If undefined, default value Line 3296  plotted in.  If undefined, default value
 =item $Xlabels: Array ref containing the labels to be used for the X-axis.  =item $Xlabels: Array ref containing the labels to be used for the X-axis.
   
 =item $Ydata: Array ref containing Array refs.    =item $Ydata: Array ref containing Array refs.  
 Each of the contained arrays will be plotted as a seperate curve.  Each of the contained arrays will be plotted as a separate curve.
   
 =item %Values: hash indicating or overriding any default values which are   =item %Values: hash indicating or overriding any default values which are 
 passed to graph.png.    passed to graph.png.  
Line 3350  sub store_course_settings { Line 3544  sub store_course_settings {
     my %SaveHash;      my %SaveHash;
     my %AppHash;      my %AppHash;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         my $basename = 'env.internal.'.$prefix.'.'.$setting;          my $basename = 'internal.'.$prefix.'.'.$setting;
         my $envname = 'course.'.$courseid.'.'.$basename;          my $envname = 'course.'.$courseid.'.'.$basename;
         if (exists($ENV{'form.'.$setting})) {          if (exists($ENV{'form.'.$setting})) {
             # Save this value away              # Save this value away
Line 3395  sub restore_course_settings { Line 3589  sub restore_course_settings {
     my ($prefix,$Settings) = @_;      my ($prefix,$Settings) = @_;
     while (my ($setting,$type) = each(%$Settings)) {      while (my ($setting,$type) = each(%$Settings)) {
         next if (exists($ENV{'form.'.$setting}));          next if (exists($ENV{'form.'.$setting}));
         my $envname = 'course.'.$courseid.'.env.internal.'.$prefix.          my $envname = 'course.'.$courseid.'.internal.'.$prefix.
             '.'.$setting;              '.'.$setting;
         if (exists($ENV{$envname})) {          if (exists($ENV{$envname})) {
             if ($type eq 'scalar') {              if ($type eq 'scalar') {

Removed from v.1.173  
changed lines
  Added in v.1.198


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