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

Diff for /loncom/interface/loncommon.pm between versions 1.112 and 1.152

version 1.112, 2003/08/20 18:18:45 version 1.152, 2003/11/10 23:25:52
Line 68  use POSIX qw(strftime mktime); Line 68  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use Apache::lonmsg();  use Apache::lonmsg();
 use Apache::lonmenu();  use Apache::lonmenu();
   use Apache::lonlocal;
   use HTML::Entities;
   
 my $readit;  my $readit;
   
 =pod   =pod 
Line 78  my $readit; Line 81  my $readit;
   
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 my %language;  my %language;
   my %supported_language;
 my %cprtag;  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %category_extensions;
Line 87  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 144  BEGIN { Line 117  BEGIN {
     while (<$fh>) {      while (<$fh>) {
  next if /^\#/;   next if /^\#/;
  chomp;   chomp;
  my ($key,$two,$country,$three,$enc,$val)=(split(/\t/,$_));   my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
  $language{$key}=$val.' - '.$enc;   $language{$key}=$val.' - '.$enc;
    if ($sup) {
       $supported_language{$key}=$sup;
    }
     }      }
  }   }
     }      }
Line 228  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 268  of the element the selection from the se Line 248  of the element the selection from the se
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
     return <<END;      return <<END;
     var editbrowser = null;      var editbrowser = null;
     function openbrowser(formname,elementname,only,omit) {      function openbrowser(formname,elementname,only,omit,titleelement) {
         var url = '/res/?';          var url = '/res/?';
         if (editbrowser == null) {          if (editbrowser == null) {
             url += 'launch=1&';              url += 'launch=1&';
Line 282  sub browser_and_searcher_javascript { Line 262  sub browser_and_searcher_javascript {
         if (omit != null) {          if (omit != null) {
             url += 'omit=' + omit + '&';              url += 'omit=' + omit + '&';
         }          }
           if (titleelement != null) {
               url += 'titleelement=' + titleelement + '&';
           }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Browser';          var title = 'Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
Line 290  sub browser_and_searcher_javascript { Line 273  sub browser_and_searcher_javascript {
         editbrowser.focus();          editbrowser.focus();
     }      }
     var editsearcher;      var editsearcher;
     function opensearcher(formname,elementname) {      function opensearcher(formname,elementname,titleelement) {
         var url = '/adm/searchcat?';          var url = '/adm/searchcat?';
         if (editsearcher == null) {          if (editsearcher == null) {
             url += 'launch=1&';              url += 'launch=1&';
Line 298  sub browser_and_searcher_javascript { Line 281  sub browser_and_searcher_javascript {
         url += 'catalogmode=interactive&';          url += 'catalogmode=interactive&';
         url += 'mode=edit&';          url += 'mode=edit&';
         url += 'form=' + formname + '&';          url += 'form=' + formname + '&';
           if (titleelement != null) {
               url += 'titleelement=' + titleelement + '&';
           }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Search';          var title = 'Search';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
Line 346  sub selectstudent_link { Line 332  sub selectstudent_link {
    return '';     return '';
        }         }
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>Select User</a>";          '","'.$udomele.'");'."'>".&mt('Select User')."</a>";
    }     }
    if ($ENV{'request.role'}=~/^(au|dc|su)/) {     if ($ENV{'request.role'}=~/^(au|dc|su)/) {
        return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.         return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'",1);'."'>Select User</a>";          '","'.$udomele.'",1);'."'>".&mt('Select User')."</a>";
    }     }
    return '';     return '';
 }  }
   
 sub coursebrowser_javascript {  sub coursebrowser_javascript {
    return (<<'ENDSTDBRW');      my ($domainfilter)=@_;
      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) {
Line 367  sub coursebrowser_javascript { Line 354  sub coursebrowser_javascript {
                url += 'filter='+filter+'&';                 url += 'filter='+filter+'&';
    }     }
         }          }
           var domainfilter='$domainfilter';
           if (domainfilter != null) {
              if (domainfilter != '') {
                  url += 'domainfilter='+domainfilter+'&';
      }
           }
         url += 'form=' + formname + '&cnumelement='+uname+          url += 'form=' + formname + '&cnumelement='+uname+
                                     '&cdomelement='+udom;                                      '&cdomelement='+udom;
         var title = 'Course_Browser';          var title = 'Course_Browser';
Line 382  ENDSTDBRW Line 375  ENDSTDBRW
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>Select Course</a>";          '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
 =pod  =pod
Line 501  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 514  END Line 508  END
     foreach my $value (sort(keys(%$hashref))) {      foreach my $value (sort(keys(%$hashref))) {
         $result.="    <option value=\"$value\" ";          $result.="    <option value=\"$value\" ";
         $result.=" selected=\"true\" " if ($value eq $firstdefault);          $result.=" selected=\"true\" " if ($value eq $firstdefault);
         $result.=">$hashref->{$value}->{'text'}</option>\n";          $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
     }      }
     $result .= "</select>\n";      $result .= "</select>\n";
     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};      my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
Line 524  END Line 518  END
     foreach my $value (sort(keys(%select2))) {      foreach my $value (sort(keys(%select2))) {
         $result.="    <option value=\"$value\" ";                  $result.="    <option value=\"$value\" ";        
         $result.=" selected=\"true\" " if ($value eq $seconddefault);          $result.=" selected=\"true\" " if ($value eq $seconddefault);
         $result.=">$select2{$value}</option>\n";          $result.=">".&mt($select2{$value})."</option>\n";
     }      }
     $result .= "</select>\n";      $result .= "</select>\n";
     #    return $debug;      #    return $debug;
Line 624  sub helpLatexCheatsheet { Line 618  sub helpLatexCheatsheet {
 Translate $text to allow it to be output as a 'comma seperated values'   Translate $text to allow it to be output as a 'comma seperated values' 
 format.  format.
   
 =back  
   
 =cut  =cut
   
 sub csv_translate {  sub csv_translate {
Line 635  sub csv_translate { Line 627  sub csv_translate {
     return $text;      return $text;
 }  }
   
   =pod
   
   =item * change_content_javascript():
   
   This and the next function allow you to create small sections of an
   otherwise static HTML page that you can update on the fly with
   Javascript, even in Netscape 4.
   
   The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
   must be written to the HTML page once. It will prove the Javascript
   function "change(name, content)". Calling the change function with the
   name of the section 
   you want to update, matching the name passed to C<changable_area>, and
   the new content you want to put in there, will put the content into
   that area.
   
   B<Note>: Netscape 4 only reserves enough space for the changable area
   to contain room for the original contents. You need to "make space"
   for whatever changes you wish to make, and be B<sure> to check your
   code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
   it's adequate for updating a one-line status display, but little more.
   This script will set the space to 100% width, so you only need to
   worry about height in Netscape 4.
   
   Modern browsers are much less limiting, and if you can commit to the
   user not using Netscape 4, this feature may be used freely with
   pretty much any HTML.
   
   =cut
   
   sub change_content_javascript {
       # If we're on Netscape 4, we need to use Layer-based code
       if ($ENV{'browser.type'} eq 'netscape' &&
    $ENV{'browser.version'} =~ /^4\./) {
    return (<<NETSCAPE4);
    function change(name, content) {
       doc = document.layers[name+"___escape"].layers[0].document;
       doc.open();
       doc.write(content);
       doc.close();
    }
   NETSCAPE4
       } else {
    # Otherwise, we need to use semi-standards-compliant code
    # (technically, "innerHTML" isn't standard but the equivalent
    # is really scary, and every useful browser supports it
    return (<<DOMBASED);
    function change(name, content) {
       element = document.getElementById(name);
       element.innerHTML = content;
    }
   DOMBASED
       }
   }
   
   =pod
   
   =item * changable_area($name, $origContent):
   
   This provides a "changable area" that can be modified on the fly via
   the Javascript code provided in C<change_content_javascript>. $name is
   the name you will use to reference the area later; do not repeat the
   same name on a given HTML page more then once. $origContent is what
   the area will originally contain, which can be left blank.
   
   =cut
   
   sub changable_area {
       my ($name, $origContent) = @_;
   
       if ($ENV{'browser.type'} eq 'netscape' &&
    $ENV{'browser.version'} =~ /^4\./) {
    # If this is netscape 4, we need to use the Layer tag
    return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
       } else {
    return "<span id='$name'>$origContent</span>";
       }
   }
   
   =pod
   
   =back
   
   =cut
   
 ###############################################################  ###############################################################
 ##        Home server <option> list generating code          ##  ##        Home server <option> list generating code          ##
 ###############################################################  ###############################################################
Line 679  See lonrights.pm for an example invocati Line 756  See lonrights.pm for an example invocati
 sub select_form {  sub select_form {
     my ($def,$name,%hash) = @_;      my ($def,$name,%hash) = @_;
     my $selectform = "<select name=\"$name\" size=\"1\">\n";      my $selectform = "<select name=\"$name\" size=\"1\">\n";
     foreach (sort keys %hash) {      my @keys;
       if (exists($hash{'select_form_order'})) {
    @keys=@{$hash{'select_form_order'}};
       } else {
    @keys=sort(keys(%hash));
       }
       foreach (@keys) {
         $selectform.="<option value=\"$_\" ".          $selectform.="<option value=\"$_\" ".
             ($_ eq $def ? 'selected' : '').              ($_ eq $def ? 'selected' : '').
                 ">".$hash{$_}."</option>\n";                  ">".&mt($hash{$_})."</option>\n";
     }      }
     $selectform.="</select>";      $selectform.="</select>";
     return $selectform;      return $selectform;
Line 978  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 991  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 1007  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 1034  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 1052  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 1070  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 1420  returns description of a specified langu Line 1493  returns description of a specified langu
 =cut  =cut
   
 sub languagedescription {  sub languagedescription {
     return $language{shift(@_)};      my $code=shift;
       return  ($supported_language{$code}?'* ':'').
               $language{$code}.
       ($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
Line 1528  sub fileextensions { Line 1614  sub fileextensions {
   
 sub display_languages {  sub display_languages {
     my %languages=();      my %languages=();
     if ($ENV{'environment.languages'}) {      foreach (&preferred_languages()) {
  foreach (split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'})) {   $languages{$_}=1;
     $languages{$_}=1;  
         }  
     }  
     if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {  
  foreach (split(/\s*(\,|\;|\:)\s*/,  
  $ENV{'course.'.$ENV{'request.course.id'}.'.languages'})) {  
     $languages{$_}=1;  
         }  
     }      }
     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);      &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
     if ($ENV{'form.displaylanguage'}) {      if ($ENV{'form.displaylanguage'}) {
Line 1548  sub display_languages { Line 1626  sub display_languages {
     return %languages;      return %languages;
 }  }
   
   sub preferred_languages {
       my @languages=();
       if ($ENV{'environment.languages'}) {
    @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'});
       }
       if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) {
    @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,
            $ENV{'course.'.$ENV{'request.course.id'}.'.languages'}));
       }
       my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0];
       if ($browser) {
    @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
       }
       if ($Apache::lonnet::domain_lang_def{$ENV{'user.domain'}}) {
    @languages=(@languages,
    $Apache::lonnet::domain_lang_def{$ENV{'user.domain'}});
       }
       if ($Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}}) {
    @languages=(@languages,
    $Apache::lonnet::domain_lang_def{$ENV{'request.role.domain'}});
       }
       if ($Apache::lonnet::domain_lang_def{
                             $Apache::lonnet::perlvar{'lonDefDomain'}}) {
    @languages=(@languages,
    $Apache::lonnet::domain_lang_def{
                                     $Apache::lonnet::perlvar{'lonDefDomain'}});
       }
   # turn "en-ca" into "en-ca,en"
       my @genlanguages;
       foreach (@languages) {
    unless ($_=~/\w/) { next; }
    push (@genlanguages,$_);
    if ($_=~/(\-|\_)/) {
       push (@genlanguages,(split(/(\-|\_)/,$_))[0]);
    }
       }
       return @genlanguages;
   }
   
 ###############################################################  ###############################################################
 ##               Student Answer Attempts                     ##  ##               Student Answer Attempts                     ##
 ###############################################################  ###############################################################
Line 1628  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 1640  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 1697  show a snapshot of what student was look Line 1815  show a snapshot of what student was look
   
 sub get_student_view {  sub get_student_view {
   my ($symb,$username,$domain,$courseid,$target) = @_;    my ($symb,$username,$domain,$courseid,$target) = @_;
   my ($map,$id,$feedurl) = split(/___/,$symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%old,%moreenv);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
Line 1733  show a snapshot of how student was answe Line 1851  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) = split(/___/,$symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%old,%moreenv);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
Line 1752  sub get_student_answers { Line 1870  sub get_student_answers {
   
 =pod  =pod
   
   =item * &submlink()
   
   Inputs: $text $uname $udom $symb
   
   Returns: A link to grades.pm such as to see the SUBM view of a student
   
   =cut
   
   ###############################################
   sub submlink {
       my ($text,$uname,$udom,$symb)=@_;
       if (!($uname && $udom)) {
    (my $cursymb, my $courseid,$udom,$uname)=
       &Apache::lonxml::whichuser($symb);
    if (!$symb) { $symb=$cursymb; }
       }
       if (!$symb) { $symb=&symbread(); }
       return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.
    '&userdom='.$udom.'&command=submission">'.$text.'</a>';
   }
   ##############################################
   
   =pod
   
 =back  =back
   
 =cut  =cut
Line 1865  sub domainlogo { Line 2007  sub domainlogo {
  my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};   my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
  if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }   if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
         return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.          return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
     '/adm/lonDomLogos/'.$domain.'.gif" />';      '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {      } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
         return $Apache::lonnet::domaindescription{$domain};          return $Apache::lonnet::domaindescription{$domain};
     } else {      } else {
Line 1952  other decorations will be returned. Line 2094  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);
     unless ($function) {      unless ($function) {
  $function='student';   $function='student';
         if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {          if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
Line 1975  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 1994  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="margin-top: 0px;$addstyle" $addentries>
 END  END
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
                    $lonhttpdPort.$img.'" />';                     $lonhttpdPort.$img.'" alt="'.$function.'" />';
     if ($bodyonly) {      if ($bodyonly) {
         return $bodytag;          return $bodytag;
     } elsif ($ENV{'browser.interface'} eq 'textual') {      } elsif ($ENV{'browser.interface'} eq 'textual') {
Line 2010  END Line 2159  END
 # No Remote  # No Remote
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',          return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                       $forcereg).                                                        $forcereg).
                '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.        '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
 '</b></font></td></tr></table>';  '</b></font></td></tr></table>';
     }      }
   
Line 2026  $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 2037  $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 2180  sub no_cache { Line 2329  sub no_cache {
   #$r->header_out("Expires" => $date);    #$r->header_out("Expires" => $date);
 }  }
   
   sub content_type {
     my ($r,$type,$charset) = @_;
     unless ($charset) {
         $charset=&Apache::lonlocal::current_encoding;
     }
     $r->content_type($type.($charset?'; charset='.$charset:''));
   }
   
 =pod  =pod
   
 =item * add_to_env($name,$value)   =item * add_to_env($name,$value) 
Line 2209  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 2332  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 2362  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 2384  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 2418  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 2430  $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 2458  sub csv_samples_select_table { Line 2671  sub csv_samples_select_table {
     return($i);      return($i);
 }  }
   
   ######################################################
   ######################################################
   
   =pod
   
   =item clean_excel_name($name)
   
   Returns a replacement for $name which does not contain any illegal characters.
   
   =cut
   
   ######################################################
   ######################################################
   sub clean_excel_name {
       my ($name) = @_;
       $name =~ s/[:\*\?\/\\]//g;
       if (length($name) > 31) {
           $name = substr($name,0,31);
       }
       return $name;
   }
   
 =pod  =pod
   
 =item * check_if_partid_hidden($id,$symb,$udom,$uname)  =item * check_if_partid_hidden($id,$symb,$udom,$uname)
Line 2477  $uname, optional the username of the use Line 2712  $uname, optional the username of the use
   
 sub check_if_partid_hidden {  sub check_if_partid_hidden {
     my ($id,$symb,$udom,$uname) = @_;      my ($id,$symb,$udom,$uname) = @_;
     my $hiddenparts=&Apache::lonnet::EXT('resource.0.parameter_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 !$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
   
   ############################################################
   ############################################################
   my $uniq=0;
   sub get_cgi_id {
       $uniq=($uniq++)%100000;
       return (time.'_'.$uniq);
   }
   
   ############################################################
   ############################################################
   
   =pod
   
   =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
   
   ############################################################
   ############################################################
   sub DrawBarGraph {
       my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_;
       #
       if (! defined($colors)) {
           $colors = ['#33ff00', 
                     '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                     '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                     ]; 
       }
       #
       my $identifier = &get_cgi_id();
       my $id = 'cgi.'.$identifier;        
       if (! @Values || ref($Values[0]) ne 'ARRAY') {
           return '';
       }
       my $NumBars = scalar(@{$Values[0]});
       my %ValuesHash;
       my $NumSets=1;
       foreach my $array (@Values) {
           next if (! ref($array));
           $ValuesHash{$id.'.data.'.$NumSets++} = 
               join(',',@$array);
       }
       #
       my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
       if ($NumBars < 10) {
           $width = 120+$NumBars*15;
           $xskip = 1;
           $bar_width = 15;
       } elsif ($NumBars <= 25) {
           $width = 120+$NumBars*11;
           $xskip = 5;
           $bar_width = 8;
       } elsif ($NumBars <= 50) {
           $width = 120+$NumBars*8;
           $xskip = 5;
           $bar_width = 4;
       } else {
           $width = 120+$NumBars*8;
           $xskip = 5;
           $bar_width = 4;
       }
       #
       my @Labels;
       for (my $i=0;$i<@{$Values[0]};$i++) {
           push (@Labels,$i+1);
       }
       #
       $Max = 1 if ($Max < 1);
       if ( int($Max) < $Max ) {
           $Max++;
           $Max = int($Max);
       }
       $Title  = '' if (! defined($Title));
       $xlabel = '' if (! defined($xlabel));
       $ylabel = '' if (! defined($ylabel));
       $ValuesHash{$id.'.title'}    = &Apache::lonnet::escape($Title);
       $ValuesHash{$id.'.xlabel'}   = &Apache::lonnet::escape($xlabel);
       $ValuesHash{$id.'.ylabel'}   = &Apache::lonnet::escape($ylabel);
       $ValuesHash{$id.'.y_max_value'} = $Max;
       $ValuesHash{$id.'.NumBars'}  = $NumBars;
       $ValuesHash{$id.'.NumSets'}  = $NumSets;
       $ValuesHash{$id.'.PlotType'} = 'bar';
       $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
       $ValuesHash{$id.'.height'}   = $height;
       $ValuesHash{$id.'.width'}    = $width;
       $ValuesHash{$id.'.xskip'}    = $xskip;
       $ValuesHash{$id.'.bar_width'} = $bar_width;
       $ValuesHash{$id.'.labels'} = join(',',@Labels);
       #
       &Apache::lonnet::appenv(%ValuesHash);
       return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
   }
   
   ############################################################
   ############################################################
   
   =pod
   
   =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
   
   ############################################################
   ############################################################
   sub DrawXYGraph {
       my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
       #
       # Create the identifier for the graph
       my $identifier = &get_cgi_id();
       my $id = 'cgi.'.$identifier;
       #
       $Title  = '' if (! defined($Title));
       $xlabel = '' if (! defined($xlabel));
       $ylabel = '' if (! defined($ylabel));
       my %ValuesHash = 
           (
            $id.'.title'  => &Apache::lonnet::escape($Title),
            $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
            $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
            $id.'.y_max_value'=> $Max,
            $id.'.labels'     => join(',',@$Xlabels),
            $id.'.PlotType'   => 'XY',
            );
       #
       if (defined($colors) && ref($colors) eq 'ARRAY') {
           $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
     }      }
     return undef;      #
       if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
           return '';
       }
       my $NumSets=1;
       foreach my $array (@{$Ydata}){
           next if (! ref($array));
           $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
       }
       $ValuesHash{$id.'.NumSets'} = $NumSets-1;
       #
       # Deal with other parameters
       while (my ($key,$value) = each(%Values)) {
           $ValuesHash{$id.'.'.$key} = $value;
       }
       #
       &Apache::lonnet::appenv(%ValuesHash);
       return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
   
   ############################################################
   ############################################################
   
   =pod
   
   =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
   
   ############################################################
   ############################################################
   sub DrawXYYGraph {
       my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                                           $Ydata2,$Min2,$Max2,%Values)=@_;
       #
       # Create the identifier for the graph
       my $identifier = &get_cgi_id();
       my $id = 'cgi.'.$identifier;
       #
       $Title  = '' if (! defined($Title));
       $xlabel = '' if (! defined($xlabel));
       $ylabel = '' if (! defined($ylabel));
       my %ValuesHash = 
           (
            $id.'.title'  => &Apache::lonnet::escape($Title),
            $id.'.xlabel' => &Apache::lonnet::escape($xlabel),
            $id.'.ylabel' => &Apache::lonnet::escape($ylabel),
            $id.'.labels' => join(',',@$Xlabels),
            $id.'.PlotType' => 'XY',
            $id.'.NumSets' => 2,
            $id.'.two_axes' => 1,
            $id.'.y1_max_value' => $Max1,
            $id.'.y1_min_value' => $Min1,
            $id.'.y2_max_value' => $Max2,
            $id.'.y2_min_value' => $Min2,
            );
       #
       if (defined($colors) && ref($colors) eq 'ARRAY') {
           $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
       }
       #
       if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
           ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
           return '';
       }
       my $NumSets=1;
       foreach my $array ($Ydata1,$Ydata2){
           next if (! ref($array));
           $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
       }
       #
       # Deal with other parameters
       while (my ($key,$value) = each(%Values)) {
           $ValuesHash{$id.'.'.$key} = $value;
       }
       #
       &Apache::lonnet::appenv(%ValuesHash);
       return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
   }
   
   ############################################################
   ############################################################
   
   =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
   
 =back  =back
Removed from v.1.112  
changed lines
  Added in v.1.152

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