Diff for /loncom/interface/loncommon.pm between versions 1.164 and 1.187

version 1.164, 2003/12/26 21:17:37 version 1.187, 2004/03/19 03:47:09
Line 220  formname and elementname indicate the na Line 220  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 235  of the element the selection from the se Line 235  of the element the selection from the se
 =cut  =cut
   
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
       my $resurl=&lastresurl();
     return <<END;      return <<END;
     var editbrowser = null;      var editbrowser = null;
     function openbrowser(formname,elementname,only,omit,titleelement) {      function openbrowser(formname,elementname,only,omit,titleelement) {
         var url = '/res/?';          var url = '$resurl/?';
         if (editbrowser == null) {          if (editbrowser == null) {
             url += 'launch=1&';              url += 'launch=1&';
         }          }
Line 283  sub browser_and_searcher_javascript { Line 284  sub browser_and_searcher_javascript {
 END  END
 }  }
   
   sub lastresurl {
       if ($ENV{'environment.lastresurl'}) {
    return $ENV{'environment.lastresurl'}
       } else {
    return '/res';
       }
   }
   
   sub storeresurl {
       my $resurl=&Apache::lonnet::clutter(shift);
       unless ($resurl=~/^\/res/) { return 0; }
       $resurl=~s/\/$//;
       &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
       &Apache::lonnet::appenv('environment.lastresurl' => $resurl);
       return 1;
   }
   
 sub studentbrowser_javascript {  sub studentbrowser_javascript {
    unless (     unless (
             (($ENV{'request.course.id'}) &&               (($ENV{'request.course.id'}) && 
Line 335  sub coursebrowser_javascript { Line 353  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 350  sub coursebrowser_javascript { Line 368  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 362  ENDSTDBRW Line 381  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 574  sub help_open_topic { Line 593  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 602  sub helpLatexCheatsheet { Line 622  sub helpLatexCheatsheet {
  .'</td></tr></table>';   .'</td></tr></table>';
 }  }
   
   sub help_open_bug {
       my ($topic, $text, $stayOnPage, $width, $height) = @_;
       unless ($ENV{'user.adv'}) { return ''; }
       unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
       $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 = 600 if (not defined $width);
       $height = 600 if (not defined $height);
   
       $topic=~s/\W+/\+/g;
       my $link='';
       my $template='';
       my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
    &Apache::lonnet::escape($ENV{'REQUEST_URI'}).'&component='.$topic;
       if (!$stayOnPage)
       {
    $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
       }
       else
       {
    $link = $url;
       }
       # Add the text
       if ($text ne "")
       {
    $template .= 
     "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
     "<td bgcolor='#FF5555'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
       }
   
       # Add the graphic
       my $title = &mt('Report a Bug');
       $template .= <<"ENDTEMPLATE";
    <a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>
   ENDTEMPLATE
       if ($text ne '') { $template.='</td></tr></table>' };
       return $template;
   
   }
   
   sub help_open_faq {
       my ($topic, $text, $stayOnPage, $width, $height) = @_;
       unless ($ENV{'user.adv'}) { return ''; }
       unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
       $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 = 350 if (not defined $width);
       $height = 400 if (not defined $height);
   
       $topic=~s/\W+/\+/g;
       my $link='';
       my $template='';
       my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
       if (!$stayOnPage)
       {
    $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
       }
       else
       {
    $link = $url;
       }
   
       # Add the text
       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>";
       }
   
       # Add the graphic
       my $title = &mt('View the FAQ');
       $template .= <<"ENDTEMPLATE";
    <a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>
   ENDTEMPLATE
       if ($text ne '') { $template.='</td></tr></table>' };
       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 618  sub csv_translate { Line 731  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 726  sub get_domains { Line 893  sub get_domains {
     my @domains;      my @domains;
     my %seen;      my %seen;
     foreach (sort values(%Apache::lonnet::hostdom)) {      foreach (sort values(%Apache::lonnet::hostdom)) {
         push (@domains,$_) unless $seen{$_}++;   push (@domains,$_) unless $seen{$_}++;
     }      }
     return @domains;      return @domains;
 }  }
   
   # ------------------------------------------
   
   sub domain_select {
       my ($name,$value,$multiple)=@_;
       my %domains=map { 
    $_ => $_.' '.$Apache::lonnet::domaindescription{$_} 
       } &get_domains;
       if ($multiple) {
    $domains{''}=&mt('Any domain');
    return &multiple_select_form($name,$value,%domains);
       } else {
    return &select_form($name,$value,%domains);
       }
   }
   
   sub multiple_select_form {
       my ($name,$value,%hash)=@_;
       my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
       my $output='';
       my $size =(scalar keys %hash<4?scalar keys %hash:4);
       $output.="\n<select name='$name' size='$size' multiple='1'>";
       foreach (sort keys %hash) {
           $output.="<option name='$_'".
               ($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";
       }
       $output.="</select>\n";
       return $output;
   }
   
 #-------------------------------------------  #-------------------------------------------
   
 =pod  =pod
Line 762  sub select_form { Line 958  sub select_form {
     return $selectform;      return $selectform;
 }  }
   
   sub gradeleveldescription {
       my $gradelevel=shift;
       my %gradelevels=(0 => 'Not specified',
        1 => 'Grade 1',
        2 => 'Grade 2',
        3 => 'Grade 3',
        4 => 'Grade 4',
        5 => 'Grade 5',
        6 => 'Grade 6',
        7 => 'Grade 7',
        8 => 'Grade 8',
        9 => 'Grade 9',
        10 => 'Grade 10',
        11 => 'Grade 11',
        12 => 'Grade 12',
        13 => 'Grade 13',
        14 => '100 Level',
        15 => '200 Level',
        16 => '300 Level',
        17 => '400 Level',
        18 => 'Graduate Level');
       return &mt($gradelevels{$gradelevel});
   }
   
 sub select_level_form {  sub select_level_form {
     my ($deflevel,$name)=@_;      my ($deflevel,$name)=@_;
     unless ($deflevel) { $deflevel=0; }      unless ($deflevel) { $deflevel=0; }
     return &select_form($deflevel,$name,(      my $selectform = "<select name=\"$name\" size=\"1\">\n";
  0 => 'Not specified',      for (my $i=0; $i<=18; $i++) {
  1 => 'Grade 1',          $selectform.="<option value=\"$i\" ".
  2 => 'Grade 2',              ($i==$deflevel ? 'selected' : '').
  3 => 'Grade 3',                  ">".&gradeleveldescription($i)."</option>\n";
  4 => 'Grade 4',      }
  5 => 'Grade 5',      $selectform.="</select>";
  6 => 'Grade 6',      return $selectform;
  7 => 'Grade 7',  
  8 => 'Grade 8',  
  9 => 'Grade 9',  
  10 => 'Grade 10',  
  11 => 'Grade 11',  
  12 => 'Grade 12',  
  13 => 'Grade 13',  
  14 => '100 Level',  
  15 => '200 Level',  
  16 => '300 Level',  
  17 => '400 Level',  
  18 => 'Graduate Level'));  
 }  }
   
 #-------------------------------------------  #-------------------------------------------
   
 =pod  =pod
Line 1010  END Line 1219  END
         $Javascript_toUpperCase = "";          $Javascript_toUpperCase = "";
     }      }
   
       my $radioval = "'nochange'";
       if (exists($in{'curr_authtype'}) &&
           defined($in{'curr_authtype'}) &&
           $in{'curr_authtype'} ne '') {
           $radioval = "'$in{'curr_authtype'}arg'";
       }
       my $argfield = 'null';
       if ( grep/^mode$/,(keys %in) ) {
           if ($in{'mode'} eq 'modifycourse')  {
               if ( grep/^curr_authtype$/,(keys %in) ) {
                   $radioval = "'$in{'curr_authtype'}'";
               }
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   unless ($in{'curr_autharg'} eq '') {
                       $argfield = "'$in{'curr_autharg'}'";
                   }
               }
           }
       }
   
     $result.=<<"END";      $result.=<<"END";
 var current = new Object();  var current = new Object();
 current.radiovalue = 'nochange';  current.radiovalue = $radioval;
 current.argfield = null;  current.argfield = $argfield;
   
 function changed_radio(choice,currentform) {  function changed_radio(choice,currentform) {
     var choicearg = choice + 'arg';      var choicearg = choice + 'arg';
Line 1100  sub authform_kerberos{ Line 1329  sub authform_kerberos{
               kerb_def_auth => 'krb4',                kerb_def_auth => 'krb4',
               @_,                @_,
               );                );
     my ($check4,$check5);      my ($check4,$check5,$krbarg);
     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\"";
     }      }
       $krbarg = $in{'kerb_def_dom'};
   
       my $krbcheck = "";
       if ( grep/^curr_authtype$/,(keys %in) ) {
           if ($in{'curr_authtype'} =~ m/^krb/) {
               $krbcheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   $krbarg = $in{'curr_autharg'};
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('krb',$in{'formname'});";      my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
     my $result .= &mt      my $result .= &mt
         ('[_1] Kerberos authenticated with domain [_2] '.          ('[_1] Kerberos authenticated with domain [_2] '.
          '[_3] Version 4 [_4] Version 5',           '[_3] Version 4 [_4] Version 5',
          '<input type="radio" name="login" value="krb" '.           '<input type="radio" name="login" value="krb" '.
              'onclick="'.$jscall.'" onchange="'.$jscall.'" />',               'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
          '<input type="text" size="10" name="krbarg" '.           '<input type="text" size="10" name="krbarg" '.
              'value="'.$in{'kerb_def_dom'}.'" '.               'value="'.$krbarg.'" '.
              'onchange="'.$jscall.'" />',               'onchange="'.$jscall.'" />',
          '<input type="radio" name="krbver" value="4" '.$check4.' />',           '<input type="radio" name="krbver" value="4" '.$check4.' />',
          '<input type="radio" name="krbver" value="5" '.$check5.' />');           '<input type="radio" name="krbver" value="5" '.$check5.' />');
Line 1126  sub authform_internal{ Line 1367  sub authform_internal{
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
   
       my $intcheck = "";
       my $intarg = 'value=""';
       if ( grep/^curr_authtype$/,(keys %args) ) {
           if ($args{'curr_authtype'} eq 'int') {
               $intcheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %args) ) {
                   $intarg = "value=\"$args{'curr_autharg'}\"";
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('int',$args{'formname'});";      my $jscall = "javascript:changed_radio('int',$args{'formname'});";
     my $result.=&mt      my $result.=&mt
         ('[_1] Internally authenticated (with initial password [_2])',          ('[_1] Internally authenticated (with initial password [_2])',
          '<input type="radio" name="login" value="int" '.           '<input type="radio" name="login" value="int" '.$intcheck.
              'onchange="'.$jscall.'" onclick="'.$jscall.'" />',               ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
          '<input type="text" size="10" name="intarg" value="" '.           '<input type="text" size="10" name="intarg" '.$intarg.
              'onchange="'.$jscall.'" />');               ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1142  sub authform_local{ Line 1395  sub authform_local{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
   
       my $loccheck = "";
       my $locarg = 'value=""';
       if ( grep/^curr_authtype$/,(keys %in) ) {
           if ($in{'curr_authtype'} eq 'loc') {
               $loccheck = " checked=\"on\"";
               if ( grep/^curr_autharg$/,(keys %in) ) {
                   $locarg = "value=\"$in{'curr_autharg'}\"";
               }
           }
       }
   
     my $jscall = "javascript:changed_radio('loc',$in{'formname'});";      my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
     my $result.=&mt('[_1] Local Authentication with argument [_2]',      my $result.=&mt('[_1] Local Authentication with argument [_2]',
                     '<input type="radio" name="login" value="loc" '.                      '<input type="radio" name="login" value="loc" '.$loccheck.
                         'onchange="'.$jscall.'" onclick="'.$jscall.'" />',                          ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
                     '<input type="text" size="10" name="locarg" value="" '.                      '<input type="text" size="10" name="locarg" '.$locarg.
                         'onchange="'.$jscall.'" />');                          ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1457  sub noteswrapper { Line 1722  sub noteswrapper {
 # ------------------------------------------------------------- Aboutme Wrapper  # ------------------------------------------------------------- Aboutme Wrapper
   
 sub aboutmewrapper {  sub aboutmewrapper {
     my ($link,$username,$domain)=@_;      my ($link,$username,$domain,$target)=@_;
     return "<a href='/adm/$domain/$username/aboutme'>$link</a>";      return "<a href='/adm/$domain/$username/aboutme'".
    ($target?" target='$target'":'').">$link</a>";
 }  }
   
 # ------------------------------------------------------------ Syllabus Wrapper  # ------------------------------------------------------------ Syllabus Wrapper
Line 1536  returns description of a specified copyr Line 1802  returns description of a specified copyr
 =cut  =cut
   
 sub copyrightdescription {  sub copyrightdescription {
     return $cprtag{shift(@_)};      return &mt($cprtag{shift(@_)});
 }  }
   
 =pod  =pod
Line 1576  sub fileembstyle { Line 1842  sub fileembstyle {
     return $fe{lc(shift(@_))};      return $fe{lc(shift(@_))};
 }  }
   
   
   sub filecategoryselect {
       my ($name,$value)=@_;
       return &select_form($name,$value,
    '' => &mt('Any category'),
    map { $_,$_ } sort(keys(%category_extensions)));
   }
   
 =pod  =pod
   
 =item * filedescription()   =item * filedescription() 
Line 1585  returns description for a specified file Line 1859  returns description for a specified file
 =cut  =cut
   
 sub filedescription {  sub filedescription {
     return $fd{lc(shift(@_))};      return &mt($fd{lc(shift(@_))});
 }  }
   
 =pod  =pod
Line 1599  extra formatting Line 1873  extra formatting
   
 sub filedescriptionex {  sub filedescriptionex {
     my $ex=shift;      my $ex=shift;
     return '.'.$ex.' '.$fd{lc($ex)};      return '.'.$ex.' '.&mt($fd{lc($ex)});
 }  }
   
 # End of .tab access  # End of .tab access
Line 1634  sub display_languages { Line 1908  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 1820  show a snapshot of what student was look Line 2094  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 1858  show a snapshot of how student was answe Line 2129  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 2086  other decorations will be returned. Line 2352  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 2186  ENDBODY Line 2440  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 2320  sub no_cache { Line 2601  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 2480  sub record_sep { Line 2766  sub record_sep {
         }          }
     } elsif ($ENV{'form.upfiletype'} eq 'tab') {      } elsif ($ENV{'form.upfiletype'} eq 'tab') {
         my $i=0;          my $i=0;
         foreach (split(/\t+/,$record)) {          foreach (split(/\t/,$record)) {
             my $field=$_;              my $field=$_;
             $field=~s/^(\"|\')//;              $field=~s/^(\"|\')//;
             $field=~s/(\"|\')$//;              $field=~s/(\"|\')$//;
Line 2588  Prints a table to create associations be Line 2874  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 2603  sub csv_print_select_table { Line 2889  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 2651  sub csv_samples_select_table { Line 2939  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 2777  If $Max is < any data point, the graph w Line 3067  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 2792  information for the plot. Line 3084  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 2835  sub DrawBarGraph { Line 3127  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 2895  plotted in.  If undefined, default value Line 3191  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 3143  sub store_course_settings { Line 3439  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 3188  sub restore_course_settings { Line 3484  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') {
Line 3219  sub propath { Line 3515  sub propath {
   
 sub icon {  sub icon {
     my ($file)=@_;      my ($file)=@_;
     my @file_ext = split(/\./,$file);      my $curfext = (split(/\./,$file))[-1];
     my $curfext = $file_ext[-1];      my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
     my $iconname="unknown.gif";  
     my $embstyle = &Apache::loncommon::fileembstyle($curfext);      my $embstyle = &Apache::loncommon::fileembstyle($curfext);
     # The unless conditional that follows is a bit of overkill      if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
     $iconname = $curfext.".gif" unless   if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
  (!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn');            $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
     return $Apache::lonnet::perlvar{'lonIconsURL'}."/$iconname";              $curfext.".gif") {
       $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
    $curfext.".gif";
    }
       }
       return $iconname;
 }   } 
   
 =pod  =pod

Removed from v.1.164  
changed lines
  Added in v.1.187


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