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

Diff for /loncom/interface/loncommon.pm between versions 1.143 and 1.247

version 1.143, 2003/11/04 21:21:35 version 1.247, 2005/01/25 00:27:59
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2001  
 # 2/13-12/7 Guy Albertelli  
 # 12/21 Gerd Kortemeyer  
 # 12/25,12/28 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/4 Gerd Kortemeyer  
 # 6/24,7/2 H. K. Ng  
   
 # Makes a table out of the previous attempts  # Makes a table out of the previous attempts
 # Inputs result_from_symbread, user, domain, course_id  # Inputs result_from_symbread, user, domain, course_id
Line 66  use Apache::lonnet(); Line 59  use Apache::lonnet();
 use GDBM_File;  use GDBM_File;
 use POSIX qw(strftime mktime);  use POSIX qw(strftime mktime);
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use Apache::lonmsg();  
 use Apache::lonmenu();  use Apache::lonmenu();
 use Apache::lonlocal;  use Apache::lonlocal;
 use HTML::Entities;  use HTML::Entities;
   
 my $readit;  my $readit;
   
 =pod   ##
   ## Global Variables
 =head1 Global Variables  ##
   
 =cut  
   
 # ----------------------------------------------- Filetypes/Languages/Copyright  # ----------------------------------------------- Filetypes/Languages/Copyright
 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 91  my %category_extensions; Line 82  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 142  BEGIN { Line 102  BEGIN {
     unless ($readit) {      unless ($readit) {
 # ------------------------------------------------------------------- languages  # ------------------------------------------------------------------- languages
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
  '/language.tab');                                     '/language.tab';
  if ($fh) {          if ( open(my $fh,"<$langtabfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));                  my ($key,$two,$country,$three,$enc,$val,$sup)=(split(/\t/,$_));
  $language{$key}=$val.' - '.$enc;                  $language{$key}=$val.' - '.$enc;
  if ($sup) {                  if ($sup) {
     $supported_language{$key}=$sup;                      $supported_language{$key}=$sup;
  }                  }
     }              }
  }              close($fh);
           }
     }      }
 # ------------------------------------------------------------------ copyrights  # ------------------------------------------------------------------ copyrights
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonIncludes'}.          my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
   '/copyright.tab');                                    '/copyright.tab';
  if ($fh) {          if ( open (my $fh,"<$copyrightfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$val)=(split(/\s+/,$_,2));                  my ($key,$val)=(split(/\s+/,$_,2));
  $cprtag{$key}=$val;                  $cprtag{$key}=$val;
     }              }
  }              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 178  BEGIN { Line 154  BEGIN {
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  my ($domain)=($filename=~/^(\w+)\./);   my ($domain)=($filename=~/^(\w+)\./);
     {      {
  my $fh=Apache::File->new($designdir.'/'.$filename);          my $designfile = $designdir.'/'.$filename;
  if ($fh) {          if ( open (my $fh,"<$designfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($key,$val)=(split(/\=/,$_));                  my ($key,$val)=(split(/\=/,$_));
  if ($val) { $designhash{$domain.'.'.$key}=$val; }                  if ($val) { $designhash{$domain.'.'.$key}=$val; }
     }              }
  }              close($fh);
           }
     }      }
   
     }      }
Line 195  BEGIN { Line 172  BEGIN {
   
 # ------------------------------------------------------------- file categories  # ------------------------------------------------------------- file categories
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
   '/filecategories.tab');                                    '/filecategories.tab';
  if ($fh) {          if ( open (my $fh,"<$categoryfile") ) {
     while (<$fh>) {              while (<$fh>) {
  next if /^\#/;                  next if /^\#/;
  chomp;                  chomp;
  my ($extension,$category)=(split(/\s+/,$_,2));                  my ($extension,$category)=(split(/\s+/,$_,2));
  push @{$category_extensions{lc($category)}},$extension;                  push @{$category_extensions{lc($category)}},$extension;
     }              }
  }              close($fh);
           }
   
     }      }
 # ------------------------------------------------------------------ file types  # ------------------------------------------------------------------ file types
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.          my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
        '/filetypes.tab');                 '/filetypes.tab';
  if ($fh) {          if ( open (my $fh,"<$typesfile") ) {
             while (<$fh>) {              while (<$fh>) {
  next if (/^\#/);                  next if (/^\#/);
  chomp;                  chomp;
  my ($ending,$emb,$descr)=split(/\s+/,$_,3);                  my ($ending,$emb,$descr)=split(/\s+/,$_,3);
  if ($descr ne '') {                   if ($descr ne '') {
     $fe{$ending}=lc($emb);                      $fe{$ending}=lc($emb);
     $fd{$ending}=$descr;                      $fd{$ending}=$descr;
  }                  }
     }              }
  }              close($fh);
           }
     }      }
     &Apache::lonnet::logthis(      &Apache::lonnet::logthis(
               "<font color=yellow>INFO: Read file types</font>");                "<font color=yellow>INFO: Read file types</font>");
Line 246  containing javascript with two functions Line 226  containing javascript with two functions
 C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>  C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
 tags.  tags.
   
 =over 4  
   
 =item * openbrowser(formname,elementname,only,omit) [javascript]  =item * openbrowser(formname,elementname,only,omit) [javascript]
   
 inputs: formname, elementname, only, omit  inputs: formname, elementname, only, omit
Line 256  formname and elementname indicate the na Line 234  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 268  Inputs: formname, elementname Line 246  Inputs: formname, elementname
 formname and elementname specify the name of the html form and the name  formname and elementname specify the name of the html form and the name
 of the element the selection from the search results will be placed in.  of the element the selection from the search results will be placed in.
   
 =back  
   
 =cut  =cut
   
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
       my ($mode)=@_;
       if (!defined($mode)) { $mode='edit'; }
       my $resurl=&lastresurl();
     return <<END;      return <<END;
   // <!-- BEGIN LON-CAPA Internal
     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&';
         }          }
         url += 'catalogmode=interactive&';          url += 'catalogmode=interactive&';
         url += 'mode=edit&';          url += 'mode=$mode&';
         url += 'form=' + formname + '&';          url += 'form=' + formname + '&';
         if (only != null) {          if (only != null) {
             url += 'only=' + only + '&';              url += 'only=' + only + '&';
         }           } else {
               url += 'only=&';
    }
         if (omit != null) {          if (omit != null) {
             url += 'omit=' + omit + '&';              url += 'omit=' + omit + '&';
         }          } else {
               url += 'omit=&';
    }
         if (titleelement != null) {          if (titleelement != null) {
             url += 'titleelement=' + titleelement + '&';              url += 'titleelement=' + titleelement + '&';
         }          } else {
       url += '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=1,location=1';
         options += ',width=700,height=600';          options += ',width=700,height=600';
         editbrowser = open(url,title,options,'1');          editbrowser = open(url,title,options,'1');
         editbrowser.focus();          editbrowser.focus();
Line 306  sub browser_and_searcher_javascript { Line 292  sub browser_and_searcher_javascript {
             url += 'launch=1&';              url += 'launch=1&';
         }          }
         url += 'catalogmode=interactive&';          url += 'catalogmode=interactive&';
         url += 'mode=edit&';          url += 'mode=$mode&';
         url += 'form=' + formname + '&';          url += 'form=' + formname + '&';
         if (titleelement != null) {          if (titleelement != null) {
             url += 'titleelement=' + titleelement + '&';              url += 'titleelement=' + titleelement + '&';
         }          } else {
       url += '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 318  sub browser_and_searcher_javascript { Line 306  sub browser_and_searcher_javascript {
         editsearcher = open(url,title,options,'1');          editsearcher = open(url,title,options,'1');
         editsearcher.focus();          editsearcher.focus();
     }      }
   // END LON-CAPA Internal -->
 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 373  sub coursebrowser_javascript { Line 379  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,extra_element) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 388  sub coursebrowser_javascript { Line 394  sub coursebrowser_javascript {
    }     }
         }          }
         url += 'form=' + formname + '&cnumelement='+uname+          url += 'form=' + formname + '&cnumelement='+uname+
                                     '&cdomelement='+udom;                              '&cdomelement='+udom+
                                       '&cnameelement='+desc;
           if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
               url += '&roleelement='+extra_element;
               if (domainfilter == null || domainfilter == '') {
                   url += '&domainfilter='+extra_element;
               }
           }
         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 400  ENDSTDBRW Line 413  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
 =pod  =pod
Line 485  sub linked_select_forms { Line 498  sub linked_select_forms {
     my $first = "document.$formname.$firstselectname";      my $first = "document.$formname.$firstselectname";
     # output the javascript to do the changing      # output the javascript to do the changing
     my $result = '';      my $result = '';
     $result.="<script>\n";      $result.="<script type=\"text/javascript\">\n";
     $result.="var select2data = new Object();\n";      $result.="var select2data = new Object();\n";
     $" = '","';      $" = '","';
     my $debug = '';      my $debug = '';
Line 592  sub help_open_topic { Line 605  sub help_open_topic {
     my $template = "";      my $template = "";
     my $link;      my $link;
   
       $topic=~s/\W/\_/g;
   
     if (!$stayOnPage)      if (!$stayOnPage)
     {      {
  $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";   $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
Line 610  sub help_open_topic { Line 625  sub help_open_topic {
     }      }
   
     # Add the graphic      # Add the graphic
       my $title = &mt('Online Help');
       my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
     $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"><img src="$helpicon" 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 638  sub helpLatexCheatsheet { Line 655  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('Get help');
       my $origurl = $ENV{'REQUEST_URI'};
       $origurl=~s|^/~|/priv/|;
       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='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
     "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
       }
       my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
       $template .= <<"ENDTEMPLATE";
    <script type="text/javascript">
   //<!-- BEGIN LON-CAPA Internal
   function helpMenu(target) {
       var caller = this;
       if (target == 'open') {
           var newWindow = null;
           try {
               newWindow =  window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
           }
           catch(error) {
               writeHelp(caller);
               return;
           }
           if (newWindow) {
               caller = newWindow;
           }
       }
       writeHelp(caller);
       return;
   }
   function writeHelp(caller) {
       caller.document.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
       caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
       caller.document.write("</html>")
       caller.document.close()
       caller.focus()
   }
   // END LON-CAPA Internal -->
    </script>
    <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
   ENDTEMPLATE
       if ($component_help) {
    if (!$text) {
       $template=&help_open_topic($component_help,undef,$stayOnPage,
          $width,$height).' '.$template;
    } else {
       my $help_text;
       $help_text=&Apache::lonnet::unescape($topic);
       $template='<table><tr><td>'.
    &help_open_topic($component_help,$help_text,$stayOnPage,
    $width,$height).'</td><td>'.$template.
    '</td></tr></table>';
    }
       }
       if ($text ne '') { $template.='</td></tr></table>' };
       return $template;
   }
   
   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');
       my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
       $template .= <<"ENDTEMPLATE";
    <a href="$link" title="$title"><img src="$bugicon" 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');
       my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
       $template .= <<"ENDTEMPLATE";
    <a href="$link" title="$title"><img src="$faqicon" 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;
     $text =~ s/\n//g;      $text =~ s/\n/ /g;
     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->{'i'}    = $workbook->add_format(italic=>1);
       $format->{'date'} = $workbook->add_format(num_format=>
                                               'mm/dd/yyyy hh:mm:ss');
       return $format;
   }
   
   ###############################################################
   ###############################################################
   
 =pod  =pod
   
 =item * change_content_javascript():  =item * change_content_javascript():
Line 762  sub get_domains { Line 1011  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,4,%domains);
       } else {
    return &select_form($name,$value,%domains);
       }
   }
   
   sub multiple_select_form {
       my ($name,$value,$size,%hash)=@_;
       my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
       my $output='';
       if (! defined($size)) {
           $size = 4;
           if (scalar(keys(%hash))<4) {
               $size = scalar(keys(%hash));
           }
       }
       $output.="\n<select name='$name' size='$size' multiple='1'>";
       foreach (sort(keys(%hash))) {
           $output.='<option value="'.$_.'" ';
           $output.='selected ' if ($selected{$_});
           $output.='>'.$hash{$_}."</option>\n";
       }
       $output.="</select>\n";
       return $output;
   }
   
 #-------------------------------------------  #-------------------------------------------
   
 =pod  =pod
Line 798  sub select_form { Line 1082  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 {
       my ($deflevel,$name)=@_;
       unless ($deflevel) { $deflevel=0; }
       my $selectform = "<select name=\"$name\" size=\"1\">\n";
       for (my $i=0; $i<=18; $i++) {
           $selectform.="<option value=\"$i\" ".
               ($i==$deflevel ? 'selected' : '').
                   ">".&gradeleveldescription($i)."</option>\n";
       }
       $selectform.="</select>";
       return $selectform;
   }
   
 #-------------------------------------------  #-------------------------------------------
   
Line 914  Outputs: Line 1234  Outputs:
   
 =back  =back
   
   =back 
   
 =cut  =cut
   
 ###############################################################  ###############################################################
 ###############################################################  ###############################################################
 sub decode_user_agent {  sub decode_user_agent {
       my ($r)=@_;
     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});      my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});      my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};      my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
       if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
     my $clientbrowser='unknown';      my $clientbrowser='unknown';
     my $clientversion='0';      my $clientversion='0';
     my $clientmathml='';      my $clientmathml='';
Line 952  sub decode_user_agent { Line 1276  sub decode_user_agent {
             $clientunicode,$clientos,);              $clientunicode,$clientos,);
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ###############################################################  ###############################################################
 ##    Authentication changing form generation subroutines    ##  ##    Authentication changing form generation subroutines    ##
 ###############################################################  ###############################################################
Line 998  See loncreateuser.pm for invocation and Line 1316  See loncreateuser.pm for invocation and
   
 =back  =back
   
   =back 
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
Line 1025  END Line 1345  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 1088  END Line 1428  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 1101  sub authform_nochange{ Line 1441  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 1117  sub authform_kerberos{ Line 1455  sub authform_kerberos{
               kerb_def_auth => 'krb4',                kerb_def_auth => 'krb4',
               @_,                @_,
               );                );
     my $result='';      my ($check4,$check5,$krbarg);
     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";      $krbarg = $in{'kerb_def_dom'};
 <input type="radio" name="login" value="krb"   
        onclick="javascript:changed_radio('krb',$in{'formname'});"      my $krbcheck = "";
        onchange="javascript:changed_radio('krb',$in{'formname'});" />      if ( grep/^curr_authtype$/,(keys %in) ) {
 Kerberos authenticated with domain          if ($in{'curr_authtype'} =~ m/^krb/) {
 <input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}"              $krbcheck = " checked=\"on\"";
        onchange="javascript:changed_text('krb',$in{'formname'});" />              if ( grep/^curr_autharg$/,(keys %in) ) {
 <input type="radio" name="krbver" value="4" $check4 />Version 4                  $krbarg = $in{'curr_autharg'};
 <input type="radio" name="krbver" value="5" $check5 />Version 5              }
 END          }
       }
   
       my $jscall = "javascript:changed_radio('krb',$in{'formname'});";
       my $result .= &mt
           ('[_1] Kerberos authenticated with domain [_2] '.
            '[_3] Version 4 [_4] Version 5',
            '<input type="radio" name="login" value="krb" '.
                'onclick="'.$jscall.'" onchange="'.$jscall.'"'.$krbcheck.' />',
            '<input type="text" size="10" name="krbarg" '.
                'value="'.$krbarg.'" '.
                'onchange="'.$jscall.'" />',
            '<input type="radio" name="krbver" value="4" '.$check4.' />',
            '<input type="radio" name="krbver" value="5" '.$check5.' />');
     return $result;      return $result;
 }  }
   
Line 1144  sub authform_internal{ Line 1493  sub authform_internal{
                 kerb_def_dom => 'MSU.EDU',                  kerb_def_dom => 'MSU.EDU',
                 @_,                  @_,
                 );                  );
     my $result='';  
     $result.=<<"END";      my $intcheck = "";
 <input type="radio" name="login" value="int"      my $intarg = 'value=""';
        onchange="javascript:changed_radio('int',$args{'formname'});"      if ( grep/^curr_authtype$/,(keys %args) ) {
        onclick="javascript:changed_radio('int',$args{'formname'});" />          if ($args{'curr_authtype'} eq 'int') {
 Internally authenticated (with initial password               $intcheck = " checked=\"on\"";
 <input type="text" size="10" name="intarg" value=""              if ( grep/^curr_autharg$/,(keys %args) ) {
        onchange="javascript:changed_text('int',$args{'formname'});" />)                  $intarg = "value=\"$args{'curr_autharg'}\"";
 END              }
           }
       }
   
       my $jscall = "javascript:changed_radio('int',$args{'formname'});";
       my $result.=&mt
           ('[_1] Internally authenticated (with initial password [_2])',
            '<input type="radio" name="login" value="int" '.$intcheck.
                ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
            '<input type="text" size="10" name="intarg" '.$intarg.
                ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1162  sub authform_local{ Line 1521  sub authform_local{
               kerb_def_dom => 'MSU.EDU',                kerb_def_dom => 'MSU.EDU',
               @_,                @_,
               );                );
     my $result='';  
     $result.=<<"END";      my $loccheck = "";
 <input type="radio" name="login" value="loc"      my $locarg = 'value=""';
        onchange="javascript:changed_radio('loc',$in{'formname'});"      if ( grep/^curr_authtype$/,(keys %in) ) {
        onclick="javascript:changed_radio('loc',$in{'formname'});" />          if ($in{'curr_authtype'} eq 'loc') {
 Local Authentication with argument              $loccheck = " checked=\"on\"";
 <input type="text" size="10" name="locarg" value=""              if ( grep/^curr_autharg$/,(keys %in) ) {
        onchange="javascript:changed_text('loc',$in{'formname'});" />                  $locarg = "value=\"$in{'curr_autharg'}\"";
 END              }
           }
       }
   
       my $jscall = "javascript:changed_radio('loc',$in{'formname'});";
       my $result.=&mt('[_1] Local Authentication with argument [_2]',
                       '<input type="radio" name="login" value="loc" '.$loccheck.
                           ' onchange="'.$jscall.'" onclick="'.$jscall.'" />',
                       '<input type="text" size="10" name="locarg" '.$locarg.
                           ' onchange="'.$jscall.'" />');
     return $result;      return $result;
 }  }
   
Line 1180  sub authform_filesystem{ Line 1548  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;
 }  }
   
 =pod  
   
 =back  
   
 =cut  
   
 ###############################################################  ###############################################################
 ##    Get Authentication Defaults for Domain                 ##  ##    Get Authentication Defaults for Domain                 ##
 ###############################################################  ###############################################################
Line 1352  sub keyword { Line 1712  sub keyword {
   
 =item * get_related_words  =item * get_related_words
   
 Look up a word in the thesaurus.  Takes a scalar arguement and returns  Look up a word in the thesaurus.  Takes a scalar argument and returns
 an array of words.  If the keyword is not in the thesaurus, an empty array  an array of words.  If the keyword is not in the thesaurus, an empty array
 will be returned.  The order of the words returned is determined by the  will be returned.  The order of the words returned is determined by the
 database which holds them.  database which holds them.
Line 1400  sub get_related_words { Line 1760  sub get_related_words {
   
 =over 4  =over 4
   
 =item * plainname($uname,$udom)  =item * plainname($uname,$udom,$first)
   
 Takes a users logon name and returns it as a string in  Takes a users logon name and returns it as a string in
 "first middle last generation" form  "first middle last generation" form 
   if $first is set to 'lastname' then it returns it as
   'lastname generation, firstname middlename' if their is a lastname
   
 =cut  =cut
   
 ###############################################################  ###############################################################
 sub plainname {  sub plainname {
     my ($uname,$udom)=@_;      my ($uname,$udom,$first)=@_;
     my %names=&Apache::lonnet::get('environment',      my %names=&Apache::lonnet::get('environment',
                     ['firstname','middlename','lastname','generation'],                      ['firstname','middlename','lastname','generation'],
  $udom,$uname);   $udom,$uname);
     my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.      my $name=&Apache::lonnet::format_name($names{'firstname'},
  $names{'lastname'}.' '.$names{'generation'};    $names{'middlename'},
     $names{'lastname'},
     $names{'generation'},$first);
       $name=~s/^\s+//;
     $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 1439  if the user does not Line 1805  if the user does not
   
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=&Apache::lonnet::get('environment',      my %names;
   ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);      if ($uname eq $ENV{'user.name'} &&
    $udom eq $ENV{'user.domain'}) {
    %names=('nickname'   => $ENV{'environment.nickname'}  ,
    'firstname'  => $ENV{'environment.firstname'} ,
    'middlename' => $ENV{'environment.middlename'},
    'lastname'   => $ENV{'environment.lastname'}  ,
    'generation' => $ENV{'environment.generation'});
       } else {
    %names=&Apache::lonnet::get('environment',
       ['nickname','firstname','middlename',
        'lastname','generation'],$udom,$uname);
       }
     my $name=$names{'nickname'};      my $name=$names{'nickname'};
     if ($name) {      if ($name) {
        $name='&quot;'.$name.'&quot;';          $name='&quot;'.$name.'&quot;'; 
Line 1466  Gets a users screenname and returns it a Line 1843  Gets a users screenname and returns it a
   
 sub screenname {  sub screenname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=      if ($uname eq $ENV{'user.name'} &&
  &Apache::lonnet::get('environment',['screenname'],$udom,$uname);   $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}
       my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
     return $names{'screenname'};      return $names{'screenname'};
 }  }
   
   
 # ------------------------------------------------------------- Message Wrapper  # ------------------------------------------------------------- Message Wrapper
   
 sub messagewrapper {  sub messagewrapper {
     my ($link,$un,$do)=@_;      my ($link,$username,$domain)=@_;
     return       return 
 "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";          '<a href="/adm/email?compose=individual&'.
           'recname='.$username.'&recdom='.$domain.'" '.
           'title="'.&mt('Send message').'">'.$link.'</a>';
 }  }
 # --------------------------------------------------------------- Notes Wrapper  # --------------------------------------------------------------- Notes Wrapper
   
Line 1488  sub noteswrapper { Line 1869  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"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
 }  }
   
 # ------------------------------------------------------------ Syllabus Wrapper  # ------------------------------------------------------------ Syllabus Wrapper
Line 1500  sub syllabuswrapper { Line 1882  sub syllabuswrapper {
     if ($fontcolor) {       if ($fontcolor) { 
         $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';           $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>'; 
     }      }
     return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";      return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
   }
   
   sub track_student_link {
       my ($linktext,$sname,$sdom,$target) = @_;
       my $link ="/adm/trackstudent";
       my $title = 'View recent activity';
       if (defined($sname) && $sname !~ /^\s*$/ &&
           defined($sdom)  && $sdom  !~ /^\s*$/) {
           $link .= "?selected_student=$sname:$sdom";
           $title .= ' of this student';
       }
       if (defined($target) && $target !~ /^\s*$/) {
           $target = qq{target="$target"};
       } else {
           $target = '';
       }
       return qq{<a href="$link" title="$title" $target>$linktext</a>};
 }  }
   
   
   
 =pod  =pod
   
 =back  =back
Line 1536  sub languagedescription { Line 1937  sub languagedescription {
     ($supported_language{$code}?' ('.&mt('interface available').')':'');      ($supported_language{$code}?' ('.&mt('interface available').')':'');
 }  }
   
   sub plainlanguagedescription {
       my $code=shift;
       return $language{$code};
   }
   
   sub supportedlanguagecode {
       my $code=shift;
       return $supported_language{$code};
   }
   
 =pod  =pod
   
 =item * copyrightids()   =item * copyrightids() 
Line 1557  returns description of a specified copyr Line 1968  returns description of a specified copyr
 =cut  =cut
   
 sub copyrightdescription {  sub copyrightdescription {
     return $cprtag{shift(@_)};      return &mt($cprtag{shift(@_)});
   }
   
   =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  =pod
Line 1597  sub fileembstyle { Line 2032  sub fileembstyle {
     return $fe{lc(shift(@_))};      return $fe{lc(shift(@_))};
 }  }
   
   
   sub filecategoryselect {
       my ($name,$value)=@_;
       return &select_form($value,$name,
    '' => &mt('Any category'),
    map { $_,$_ } sort(keys(%category_extensions)));
   }
   
 =pod  =pod
   
 =item * filedescription()   =item * filedescription() 
Line 1606  returns description for a specified file Line 2049  returns description for a specified file
 =cut  =cut
   
 sub filedescription {  sub filedescription {
     return $fd{lc(shift(@_))};      my $file_description = $fd{lc(shift())};
       $file_description =~ s:([\[\]]):~$1:g;
       return &mt($file_description);
 }  }
   
 =pod  =pod
Line 1620  extra formatting Line 2065  extra formatting
   
 sub filedescriptionex {  sub filedescriptionex {
     my $ex=shift;      my $ex=shift;
     return '.'.$ex.' '.$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 1655  sub display_languages { Line 2102  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 1841  show a snapshot of what student was look Line 2288  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 (defined($target)) { $form{'grade_target'} = $target; }
     $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 1879  show a snapshot of how student was answe Line 2323  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 1899  sub get_student_answers { Line 2338  sub get_student_answers {
   
 =item * &submlink()  =item * &submlink()
   
 Inputs: $text $uname $udom $symb  Inputs: $text $uname $udom $symb $target
   
 Returns: A link to grades.pm such as to see the SUBM view of a student  Returns: A link to grades.pm such as to see the SUBM view of a student
   
Line 1907  Returns: A link to grades.pm such as to Line 2346  Returns: A link to grades.pm such as to
   
 ###############################################  ###############################################
 sub submlink {  sub submlink {
     my ($text,$uname,$udom,$symb)=@_;      my ($text,$uname,$udom,$symb,$target)=@_;
     if (!($uname && $udom)) {      if (!($uname && $udom)) {
  (my $cursymb, my $courseid,$udom,$uname)=   (my $cursymb, my $courseid,$udom,$uname)=
     &Apache::lonxml::whichuser($symb);      &Apache::lonxml::whichuser($symb);
  if (!$symb) { $symb=$cursymb; }   if (!$symb) { $symb=$cursymb; }
     }      }
     if (!$symb) { $symb=&symbread(); }      if (!$symb) { $symb=&symbread(); }
     return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.      $symb=&Apache::lonnet::escape($symb);
  '&userdom='.$udom.'&command=submission">'.$text.'</a>';      if ($target) { $target="target=\"$target\""; }
       return '<a href="/adm/grades?&command=submission&'.
    'symb='.$symb.'&student='.$uname.
    '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
   }
   ##############################################
   
   =pod
   
   =item * &pgrdlink()
   
   Inputs: $text $uname $udom $symb $target
   
   Returns: A link to grades.pm such as to see the PGRD view of a student
   
   =cut
   
   ###############################################
   sub pgrdlink {
       my $link=&submlink(@_);
       $link=~s/(&command=submission)/$1&showgrading=yes/;
       return $link;
   }
   ##############################################
   
   =pod
   
   =item * &pprmlink()
   
   Inputs: $text $uname $udom $symb $target
   
   Returns: A link to parmset.pm such as to see the PPRM view of a
   student andn resource
   
   =cut
   
   ###############################################
   sub pprmlink {
       my ($text,$uname,$udom,$symb,$target)=@_;
       if (!($uname && $udom)) {
    (my $cursymb, my $courseid,$udom,$uname)=
       &Apache::lonxml::whichuser($symb);
    if (!$symb) { $symb=$cursymb; }
       }
       if (!$symb) { $symb=&symbread(); }
       $symb=&Apache::lonnet::escape($symb);
       if ($target) { $target="target=\"$target\""; }
       return '<a href="/adm/parmset?&command=set&'.
    'symb='.$symb.'&uname='.$uname.
    '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
 }  }
 ##############################################  ##############################################
   
Line 1945  sub maketime { Line 2433  sub maketime {
     my %th=@_;      my %th=@_;
     return POSIX::mktime(      return POSIX::mktime(
         ($th{'seconds'},$th{'minutes'},$th{'hours'},          ($th{'seconds'},$th{'minutes'},$th{'hours'},
          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));           $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
 }  
   
   
 #########################################  
 #  
 # Retro-fixing of un-backward-compatible time format  
   
 sub unsqltime {  
     my $timestamp=shift;  
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {  
        $timestamp=&maketime(  
    'year'=>$1,'month'=>$2,'day'=>$3,  
            'hours'=>$4,'minutes'=>$5,'seconds'=>$6);  
     }  
     return $timestamp;  
 }  }
   
 #########################################  #########################################
Line 2031  sub domainlogo { Line 2504  sub domainlogo {
     my $domain = &determinedomain(shift);          my $domain = &determinedomain(shift);    
      # See if there is a logo       # See if there is a logo
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
  my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};   my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
  if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }          return '<img src="'.$logo.'" alt="'.$domain.'" />';
         return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.  
     '/adm/lonDomLogos/'.$domain.'.gif" />';  
     } 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 2120  other decorations will be returned. Line 2591  other decorations will be returned.
 =cut  =cut
   
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_;      my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_;
     $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 2145  sub bodytag { Line 2604  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 2164  sub bodytag { Line 2624  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 type="text/css">
   h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
   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') {
 # Accessibility  # Accessibility
             
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',          return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                       $forcereg).                                                        $forcereg).
                '<h1>LON-CAPA: '.$title.'</h1>';                 '<h1>LON-CAPA: '.$title.'</h1>';
     } elsif ($ENV{'environment.remote'} eq 'off') {      } elsif ($ENV{'environment.remote'} eq 'off') {
 # No Remote  # No Remote
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',   my $roleinfo=(<<ENDROLE);
                                                       $forcereg).  <td bgcolor="$tabbg" align="right">
                '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font size="+3" color="'.$font.'"><b>'.$title.  <font size="2" face="Arial, Helvetica, sans-serif">
 '</b></font></td></tr></table>';      $ENV{'environment.firstname'}
       $ENV{'environment.middlename'}
       $ENV{'environment.lastname'}
       $ENV{'environment.generation'}
       </font>&nbsp;
   <br />
   <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
   <br />
   <font size="2" face="Arial, Helvetica, sans-serif">$realm</font>&nbsp;
   </td>
   ENDROLE
           my $titleinfo = '<font face="Arial, Helvetica, sans-serif" size="+3" color="'.
    $font.'"><b>'.$title.'</b></font>';
           if ($customtitle) {
               $titleinfo = $customtitle;
           }
   
    if ($ENV{'request.state'} eq 'construct') {
       my ($uname,$thisdisfn)=
    ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
       my $formaction='/priv/'.$uname.'/'.$thisdisfn;
       $formaction=~s/\/+/\//g;
               unless ($customtitle) {  #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm  
                   my $parentpath = '';
                   my $lastitem = '';
                   if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                       $parentpath = $1;
                       $lastitem = $2;
                   } else {
                       $lastitem = $thisdisfn;
                   }
           $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
                         '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font>&nbsp;'. 
                         '<form name="dirs" method="post" action="'.$formaction
       .'" target="_top"><tt><b>'
       .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
       .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
       .'</form>'
       .&Apache::lonmenu::constspaceform();
   
               }
       $forcereg=1;
           }
           my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
                            'cellspacing="3" cellpadding="3">'.
                            '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.
                            $titleinfo.'</td>'.$roleinfo.'</tr></table>';
           if ($ENV{'request.state'} eq 'construct') {
               $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
    } else {
               $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
                           $titletable;
           }
           return $bodytag;
     }      }
   
 #  #
 # Top frame rendering, Remote is up  # Top frame rendering, Remote is up
 #  #
       my $titleinfo = '&nbsp;<font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
       if ($customtitle) {
           $titleinfo = $customtitle;
       }
       #
       # Extra info if you are the DC
       my $dc_info = '';
       if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'.
                           $ENV{'course.'.$ENV{'request.course.id'}.
                                    '.domain'}.'/'})) {
           my $cid = $ENV{'request.course.id'};
           $dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'};
           $dc_info = '('.$dc_info.')';
       }
       #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
Line 2196  $upperleft</td> Line 2729  $upperleft</td>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
 &nbsp;<font size="5"><b>$title</b></font>  $titleinfo $dc_info
 <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 2207  $upperleft</td> Line 2740  $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
 }  }
   
 ###############################################  ###############################################
   
   =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;
   }
   
   ###############################################
   
   =pod
   
   =item get_sections
   
   Determines all the sections for a course including
   sections with students and sections containing other roles.
   Incoming parameters: domain, course number, reference to 
   section hash (keys to be section/group IDs), reference to 
   array containing roles for which sections should be gathered
   (optional). If the fourth argument is undefined, sections
   are gathered for any role.
    
   Returns number of sections.
   
   =cut
   
   ###############################################
   sub get_sections {
       my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
       if (!($cdom && $cnum)) { return 0; }
       my $cid = $cdom.'_'.$cnum;
       my $numsections = 0;
   
       if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {
    my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);
    my $sec_index = &Apache::loncoursedata::CL_SECTION();
    my $status_index = &Apache::loncoursedata::CL_STATUS();
    while (my ($student,$data) = each %$classlist) {
       my ($section,$status) = ($data->[$sec_index],
        $data->[$status_index]);
       unless ($section eq '-1' || $section =~ /^\s*$/) {
    if (!defined($$sectioncount{$section})) { $numsections++; }
    $$sectioncount{$section}++;
       }
    }
       }
       my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
       foreach my $user (sort(keys(%courseroles))) {
    if ($user !~ /^(\w{2})/) { next; }
    my ($role) = ($user =~ /^(\w{2})/);
    if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
    my $section;
    if ($role eq 'cr' &&
       $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
       $section=$1;
    }
    if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
    if (!defined($section) || $section eq '-1') { next; }
    if (!defined($$sectioncount{$section})) { $numsections++; } 
    $$sectioncount{$section}++;
       }
       return $numsections;
   }
   
   
 sub get_posted_cgi {  sub get_posted_cgi {
     my $r=shift;      my $r=shift;
   
Line 2325  returns cache-controlling header code Line 2940  returns cache-controlling header code
 =cut  =cut
   
 sub cacheheader {  sub cacheheader {
   unless ($ENV{'request.method'} eq 'GET') { return ''; }      unless ($ENV{'request.method'} eq 'GET') { return ''; }
   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />      my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />                  <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';                  <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
   return $output;      return $output;
 }  }
   
 =pod  =pod
Line 2342  specifies header code to not have cache Line 2957  specifies header code to not have cache
 =cut  =cut
   
 sub no_cache {  sub no_cache {
   my ($r) = @_;      my ($r) = @_;
   unless ($ENV{'request.method'} eq 'GET') { return ''; }      if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);   $ENV{'request.method'} ne 'GET') { return ''; }
   $r->no_cache(1);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
   $r->header_out("Pragma" => "no-cache");      $r->no_cache(1);
   #$r->header_out("Expires" => $date);      $r->header_out("Expires" => $date);
       $r->header_out("Pragma" => "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 2387  sub add_to_env { Line 3008  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 2411  sub upfile_store { Line 3058  sub upfile_store {
     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.      my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
  '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;   '_enroll_'.$ENV{'request.course.id'}.'_'.time.'_'.$$;
     {      {
  my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').          my $datafile = $r->dir_config('lonDaemons').
  '/tmp/'.$datatoken.'.tmp');                             '/tmp/'.$datatoken.'.tmp';
  print $fh $ENV{'form.upfile'};          if ( open(my $fh,">$datafile") ) {
               print $fh $ENV{'form.upfile'};
               close($fh);
           }
     }      }
     return $datatoken;      return $datatoken;
 }  }
Line 2432  sub load_tmp_file { Line 3082  sub load_tmp_file {
     my $r=shift;      my $r=shift;
     my @studentdata=();      my @studentdata=();
     {      {
  my $fh;          my $studentfile = $r->dir_config('lonDaemons').
  if ($fh=Apache::File->new($r->dir_config('lonDaemons').                                '/tmp/'.$ENV{'form.datatoken'}.'.tmp';
   '/tmp/'.$ENV{'form.datatoken'}.'.tmp')) {          if ( open(my $fh,"<$studentfile") ) {
     @studentdata=<$fh>;              @studentdata=<$fh>;
  }              close($fh);
           }
     }      }
     $ENV{'form.upfile'}=join('',@studentdata);      $ENV{'form.upfile'}=join('',@studentdata);
 }  }
Line 2481  sub record_sep { Line 3132  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 2510  sub record_sep { Line 3161  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 2540  Apache Request ref, $records is an array Line 3204  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 2562  sub csv_print_samples { Line 3229  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,defaultcol)
   
 =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,$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 2596  sub csv_print_select_table { Line 3273  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 2608  $d is an array of 2 element arrays (inte Line 3288  $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,$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 2636  sub csv_samples_select_table { Line 3321  sub csv_samples_select_table {
     return($i);      return($i);
 }  }
   
   ######################################################
   ######################################################
   
 =pod  =pod
   
 =item clean_excel_name($name)  =item clean_excel_name($name)
Line 2644  Returns a replacement for $name which do Line 3332  Returns a replacement for $name which do
   
 =cut  =cut
   
   ######################################################
   ######################################################
 sub clean_excel_name {  sub clean_excel_name {
     my ($name) = @_;      my ($name) = @_;
     $name =~ s/[:\*\?\/\\]//g;      $name =~ s/[:\*\?\/\\]//g;
Line 2690  sub check_if_partid_hidden { Line 3380  sub check_if_partid_hidden {
   
 =pod  =pod
   
   =back 
   
 =head1 cgi-bin script and graphing routines  =head1 cgi-bin script and graphing routines
   
   =over 4
   
 =item get_cgi_id  =item get_cgi_id
   
 Inputs: none  Inputs: none
Line 2705  the routine &Apache::lonnet::transfer_pr Line 3399  the routine &Apache::lonnet::transfer_pr
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   my $uniq=0;
 sub get_cgi_id {  sub get_cgi_id {
     return (time.'_'.int(rand(1000)));      $uniq=($uniq+1)%100000;
       return (time.'_'.$uniq);
 }  }
   
 ############################################################  ############################################################
Line 2738  If $Max is < any data point, the graph w Line 3433  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.
   
   =item If the final element of @Values is a hash reference the key/value
   pairs will be added to the graph definition.
   
 =back  =back
   
 Returns:  Returns:
Line 2753  information for the plot. Line 3453  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 2761  sub DrawBarGraph { Line 3461  sub DrawBarGraph {
                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',                    '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   ];                     ]; 
     }      }
       my $extra_settings = {};
       if (ref($Values[-1]) eq 'HASH') {
           $extra_settings = pop(@Values);
       }
     #      #
     my $identifier = &get_cgi_id();      my $identifier = &get_cgi_id();
     my $id = 'cgi.'.$identifier;              my $id = 'cgi.'.$identifier;        
     if (! @Values || ref($Values[0]) ne 'ARRAY') {      if (! @Values || ref($Values[0]) ne 'ARRAY') {
         return '';          return '';
     }      }
       #
       my @Labels;
       if (defined($labels)) {
           @Labels = @$labels;
       } else {
           for (my $i=0;$i<@{$Values[0]};$i++) {
               push (@Labels,$i+1);
           }
       }
       #
     my $NumBars = scalar(@{$Values[0]});      my $NumBars = scalar(@{$Values[0]});
       if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
     my %ValuesHash;      my %ValuesHash;
     my $NumSets=1;      my $NumSets=1;
     foreach my $array (@Values) {      foreach my $array (@Values) {
Line 2777  sub DrawBarGraph { Line 3492  sub DrawBarGraph {
     }      }
     #      #
     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);      my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
     if ($NumBars < 10) {      if ($NumBars < 3) {
           $width = 120+$NumBars*32;
           $xskip = 1;
           $bar_width = 30;
       } elsif ($NumBars < 5) {
           $width = 120+$NumBars*20;
           $xskip = 1;
           $bar_width = 20;
       } elsif ($NumBars < 10) {
         $width = 120+$NumBars*15;          $width = 120+$NumBars*15;
         $xskip = 1;          $xskip = 1;
         $bar_width = 15;          $bar_width = 15;
Line 2795  sub DrawBarGraph { Line 3518  sub DrawBarGraph {
         $bar_width = 4;          $bar_width = 4;
     }      }
     #      #
     my @Labels;  
     for (my $i=0;$i<@{$Values[0]};$i++) {  
         push (@Labels,$i+1);  
     }  
     #  
     $Max = 1 if ($Max < 1);      $Max = 1 if ($Max < 1);
     if ( int($Max) < $Max ) {      if ( int($Max) < $Max ) {
         $Max++;          $Max++;
Line 2822  sub DrawBarGraph { Line 3540  sub DrawBarGraph {
     $ValuesHash{$id.'.bar_width'} = $bar_width;      $ValuesHash{$id.'.bar_width'} = $bar_width;
     $ValuesHash{$id.'.labels'} = join(',',@Labels);      $ValuesHash{$id.'.labels'} = join(',',@Labels);
     #      #
       # Deal with other parameters
       while (my ($key,$value) = each(%$extra_settings)) {
           $ValuesHash{$id.'.'.$key} = $value;
       }
       #
     &Apache::lonnet::appenv(%ValuesHash);      &Apache::lonnet::appenv(%ValuesHash);
     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';      return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
 }  }
Line 2856  plotted in.  If undefined, default value Line 3579  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 3023  sub DrawXYYGraph { Line 3746  sub DrawXYYGraph {
   
 =pod  =pod
   
   =back 
   
 =head1 Statistics helper routines?    =head1 Statistics helper routines?  
   
 Bad place for them but what the hell.  Bad place for them but what the hell.
   
   =over 4
   
 =item &chartlink  =item &chartlink
   
 Returns a link to the chart for a specific student.    Returns a link to the chart for a specific student.  
Line 3043  Inputs: Line 3770  Inputs:
   
 =back  =back
   
   =back
   
 =cut  =cut
   
 ############################################################  ############################################################
Line 3050  Inputs: Line 3779  Inputs:
 sub chartlink {  sub chartlink {
     my ($linktext, $sname, $sdomain) = @_;      my ($linktext, $sname, $sdomain) = @_;
     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.      my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
         '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).          '&amp;SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
         '&chartoutputmode='.HTML::Entities::encode('html, with all links').          '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
        '">'.$linktext.'</a>';         '">'.$linktext.'</a>';
 }  }
   
   #######################################################
   #######################################################
   
   =pod
   
   =head1 Course Environment Routines
   
   =over 4
   
   =item &restore_course_settings 
   
   =item &store_course_settings
   
   Restores/Store indicated form parameters from the course environment.
   Will not overwrite existing values of the form parameters.
   
   Inputs: 
   a scalar describing the data (e.g. 'chart', 'problem_analysis')
   
   a hash ref describing the data to be stored.  For example:
      
   %Save_Parameters = ('Status' => 'scalar',
       'chartoutputmode' => 'scalar',
       'chartoutputdata' => 'scalar',
       'Section' => 'array',
       'StudentData' => 'array',
       'Maps' => 'array');
   
   Returns: both routines return nothing
   
   =cut
   
   #######################################################
   #######################################################
   sub store_course_settings {
       # save to the environment
       # appenv the same items, just to be safe
       my $courseid = $ENV{'request.course.id'};
       my $coursedom = $ENV{'course.'.$courseid.'.domain'};
       my ($prefix,$Settings) = @_;
       my %SaveHash;
       my %AppHash;
       while (my ($setting,$type) = each(%$Settings)) {
           my $basename = 'internal.'.$prefix.'.'.$setting;
           my $envname = 'course.'.$courseid.'.'.$basename;
           if (exists($ENV{'form.'.$setting})) {
               # Save this value away
               if ($type eq 'scalar' &&
                   (! exists($ENV{$envname}) || 
                    $ENV{$envname} ne $ENV{'form.'.$setting})) {
                   $SaveHash{$basename} = $ENV{'form.'.$setting};
                   $AppHash{$envname}   = $ENV{'form.'.$setting};
               } elsif ($type eq 'array') {
                   my $stored_form;
                   if (ref($ENV{'form.'.$setting})) {
                       $stored_form = join(',',
                                           map {
                                               &Apache::lonnet::escape($_);
                                           } sort(@{$ENV{'form.'.$setting}}));
                   } else {
                       $stored_form = 
                           &Apache::lonnet::escape($ENV{'form.'.$setting});
                   }
                   # Determine if the array contents are the same.
                   if ($stored_form ne $ENV{$envname}) {
                       $SaveHash{$basename} = $stored_form;
                       $AppHash{$envname}   = $stored_form;
                   }
               }
           }
       }
       my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
                                             $coursedom,
                                             $ENV{'course.'.$courseid.'.num'});
       if ($put_result !~ /^(ok|delayed)/) {
           &Apache::lonnet::logthis('unable to save form parameters, '.
                                    'got error:'.$put_result);
       }
       # Make sure these settings stick around in this session, too
       &Apache::lonnet::appenv(%AppHash);
       return;
   }
   
   sub restore_course_settings {
       my $courseid = $ENV{'request.course.id'};
       my ($prefix,$Settings) = @_;
       while (my ($setting,$type) = each(%$Settings)) {
           next if (exists($ENV{'form.'.$setting}));
           my $envname = 'course.'.$courseid.'.internal.'.$prefix.
               '.'.$setting;
           if (exists($ENV{$envname})) {
               if ($type eq 'scalar') {
                   $ENV{'form.'.$setting} = $ENV{$envname};
               } elsif ($type eq 'array') {
                   $ENV{'form.'.$setting} = [ 
                                              map { 
                                                  &Apache::lonnet::unescape($_); 
                                              } split(',',$ENV{$envname})
                                              ];
               }
           }
       }
   }
   
 ############################################################  ############################################################
 ############################################################  ############################################################
   
   sub propath {
       my ($udom,$uname)=@_;
       $udom=~s/\W//g;
       $uname=~s/\W//g;
       my $subdir=$uname.'__';
       $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
       my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
       return $proname;
   } 
   
   sub icon {
       my ($file)=@_;
       my $curfext = (split(/\./,$file))[-1];
       my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
       my $embstyle = &Apache::loncommon::fileembstyle($curfext);
       if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
    if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
             $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
               $curfext.".gif") {
       $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
    $curfext.".gif";
    }
       }
       return $iconname;
   } 
   
   sub lonhttpdurl {
       my ($url)=@_;
       my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
       if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
       return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
   }
   
   sub connection_aborted {
       my ($r)=@_;
       $r->print(" ");$r->rflush();
       my $c = $r->connection;
       return $c->aborted();
   }
   
   #    Escapes strings that may have embedded 's that will be put into
   #    strings as 'strings'.
   sub escape_single {
       my ($input) = @_;
       $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
       $input =~ s/\'/\\\'/g; # Esacpe the 's....
       return $input;
   }
   
   #  Same as escape_single, but escape's "'s  This 
   #  can be used for  "strings"
   sub escape_double {
       my ($input) = @_;
       $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
       $input =~ s/\"/\\\"/g; # Esacpe the "s....
       return $input;
   }
    
   #   Escapes the last element of a full URL.
   sub escape_url {
       my ($url)   = @_;
       my @urlslices = split(/\//, $url,-1);
       my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
       return join('/',@urlslices).'/'.$lastitem;
   }
 =pod  =pod
   
 =back  =back
Removed from v.1.143  
changed lines
  Added in v.1.247

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