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

Diff for /loncom/interface/loncommon.pm between versions 1.51 and 1.55

version 1.51, 2002/08/08 13:43:04 version 1.55, 2002/08/21 17:18:08
Line 558  sub select_dom_form { Line 558  sub select_dom_form {
   
 =pod  =pod
   
 =item get_home_servers($domain)  =item get_library_servers($domain)
   
 Returns a hash which contains keys like '103l3' and values like   Returns a hash which contains keys like '103l3' and values like 
 'kirk.lite.msu.edu'.  All of the keys will be for machines in the  'kirk.lite.msu.edu'.  All of the keys will be for machines in the
Line 567  given $domain. Line 567  given $domain.
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub get_home_servers {  sub get_library_servers {
     my $domain = shift;      my $domain = shift;
     my %home_servers;      my %library_servers;
     foreach (keys(%Apache::lonnet::libserv)) {      foreach (keys(%Apache::lonnet::libserv)) {
         if ($Apache::lonnet::hostdom{$_} eq $domain) {          if ($Apache::lonnet::hostdom{$_} eq $domain) {
             $home_servers{$_} = $Apache::lonnet::hostname{$_};              $library_servers{$_} = $Apache::lonnet::hostname{$_};
         }          }
     }      }
     return %home_servers;      return %library_servers;
 }  }
   
 #-------------------------------------------  #-------------------------------------------
Line 592  returns a string which contains an <opti Line 592  returns a string which contains an <opti
 #-------------------------------------------  #-------------------------------------------
 sub home_server_option_list {  sub home_server_option_list {
     my $domain = shift;      my $domain = shift;
     my %servers = &get_home_servers($domain);      my %servers = &get_library_servers($domain);
     my $result = '';      my $result = '';
     foreach (sort keys(%servers)) {      foreach (sort keys(%servers)) {
         $result.=          $result.=
Line 844  sub initialize_keywords { Line 844  sub initialize_keywords {
     #   Set up the hash as a database      #   Set up the hash as a database
     my %thesaurus_db;      my %thesaurus_db;
     if (! tie(%thesaurus_db,'GDBM_File',      if (! tie(%thesaurus_db,'GDBM_File',
               $thesaurus_db_file,&GDBM_READER,0640)){                $thesaurus_db_file,&GDBM_READER(),0640)){
         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".          &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                                  $thesaurus_db_file);                                   $thesaurus_db_file);
         return 0;          return 0;
Line 957  sub get_related_words { Line 957  sub get_related_words {
         return ();          return ();
     }      }
     if (! tie(%thesaurus_db,'GDBM_File',      if (! tie(%thesaurus_db,'GDBM_File',
               $thesaurus_db_file,&GDBM_READER,0640)){                $thesaurus_db_file,&GDBM_READER(),0640)){
         return ();          return ();
     }       } 
     my @Words=();      my @Words=();
Line 1194  sub findallcourses { Line 1194  sub findallcourses {
   
 ###############################################  ###############################################
   
   sub bodytag {
       my ($title,$function,$addentries)=@_;
       unless ($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='';
       my $pgbg='';
       my $tabbg='';
       my $font='';
       my $link='';
       my $alink='#CC0000';
       my $vlink='';
       if ($function eq 'admin') {
           $img='admin';
           $pgbg='#FFFFCC';
           $tabbg='#CCCC99';
           $font='#772200';
           $link='#663300';
           $vlink='#666600';
       } elsif ($function eq 'coordinator') {
           $img='coordinator';
           $pgbg='#CCFFFF';
           $tabbg='#CCCCFF';
           $font='#000044';
           $link='#003333';
           $vlink='#006633';
      } elsif ($function eq 'author') {
           $img='author';
           $pgbg='#CCFFFF';
           $tabbg='#CCFFCC';
           $font='#004400';
           $link='#003333';
           $vlink='#006666';
       } else {
           $img='student';
           $pgbg='#FFFFAA';
           $tabbg='#FF9900';
           $font='#991100';
           $link='#993300';
           $vlink='#996600';
       }
   # role and realm
       my ($role,$realm)
          =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
   # realm
       if ($ENV{'request.course.id'}) {
    $realm=
            $ENV{'course.'.$ENV{'request.course.id'}.'.description'};
       }
       unless ($realm) { $realm='&nbsp;'; }
   # Set messages
       my $messages=localtime();
   # Output
       return(<<ENDBODY);
   <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
   $addentries>
   <table width="100%" cellspacing="0" border="0" cellpadding="0">
   <tr><td bgcolor="$font">
   <img src="/adm/lonInterFace/$img.jpg" /></td>
   <td bgcolor="$font"><font color='$pgbg'>$messages</font></td>
   </tr>
   <tr>
   <td rowspan="3" bgcolor="$tabbg">
   &nbsp;<font size="5"><b>$title</b></font>
   <td bgcolor="$tabbg"  align="right">
   <font size="2">
       $ENV{'environment.firstname'}
       $ENV{'environment.middlename'}
       $ENV{'environment.lastname'}
       $ENV{'environment.generation'}
       </font>&nbsp;
   </td>
   </tr>
   <tr><td bgcolor="$tabbg" align="right">
   <font size="2">$role</font>&nbsp;
   </td></tr>
   <tr>
   <td bgcolor="$tabbg" align="right"><font size="2">$realm</font>&nbsp;</td></tr>
   </table><br>
   ENDBODY
   }
   ###############################################
   
 sub get_unprocessed_cgi {  sub get_unprocessed_cgi {
   my ($query,$possible_names)= @_;    my ($query,$possible_names)= @_;
   # $Apache::lonxml::debug=1;    # $Apache::lonxml::debug=1;
Removed from v.1.51  
changed lines
  Added in v.1.55

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