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

Diff for /loncom/interface/loncommon.pm between versions 1.60 and 1.71

version 1.60, 2002/08/26 14:32:29 version 1.71, 2002/10/29 20:57:31
Line 98  my %cprtag; Line 98  my %cprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %category_extensions;
   
   # ---------------------------------------------- Designs
   
   my %designhash;
   
 # ---------------------------------------------- Thesaurus variables  # ---------------------------------------------- Thesaurus variables
   
 =pod  =pod
Line 166  BEGIN { Line 170  BEGIN {
     }      }
  }   }
     }      }
   
   # -------------------------------------------------------------- domain designs
   
       my $filename;
       my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
       opendir(DIR,$designdir);
       while ($filename=readdir(DIR)) {
    my ($domain)=($filename=~/^(\w+)\./);
       {
    my $fh=Apache::File->new($designdir.'/'.$filename);
    if ($fh) {
       while (<$fh>) {
    next if /^\#/;
    chomp;
    my ($key,$val)=(split(/\=/,$_));
    if ($val) { $designhash{$domain.'.'.$key}=$val; }
       }
    }
       }
   
       }
       closedir(DIR);
   
   
 # ------------------------------------------------------------- file categories  # ------------------------------------------------------------- file categories
     {      {
  my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.   my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
Line 932  sub get_related_words { Line 960  sub get_related_words {
 ##              End Thesaurus Functions                      ##  ##              End Thesaurus Functions                      ##
 ###############################################################  ###############################################################
   
   # -------------------------------------------------------------- Plaintext name
   
   sub plainname {
       my ($uname,$udom)=@_;
       my %names=&Apache::lonnet::get('environment',
                       ['firstname','middlename','lastname','generation'],
    $udom,$uname);
       my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
    $names{'lastname'}.' '.$names{'generation'};
       $name=~s/\s+$//;
       $name=~s/\s+/ /g;
       return $name;
   }
   
   # -------------------------------------------------------------------- Nickname
   
   
   sub nickname {
       my ($uname,$udom)=@_;
       my %names=&Apache::lonnet::get('environment',
     ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);
       my $name=$names{'nickname'};
       if ($name) {
          $name='&quot;'.$name.'&quot;'; 
       } else {
          $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
        $names{'lastname'}.' '.$names{'generation'};
          $name=~s/\s+$//;
          $name=~s/\s+/ /g;
       }
       return $name;
   }
   
   
   # ------------------------------------------------------------------ Screenname
   
   sub screenname {
       my ($uname,$udom)=@_;
       my %names=
    &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
       return $names{'screenname'};
   }
   
   # ------------------------------------------------------------- Message Wrapper
   
   sub messagewrapper {
       my ($link,$un,$do)=@_;
       return 
   "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
   }
   # ------------------------------------------------------------- Aboutme Wrapper
   
   sub aboutmewrapper {
       my ($link,$username,$domain)=@_;
       return "<a href='/adm/$domain/$username/aboutme'>$link</a>";
   }
   
   # ------------------------------------------------------------ Syllabus Wrapper
   
   
   sub syllabuswrapper {
       my ($link,$un,$do)=@_;
       return "<a href='/public/$do/$un/syllabus'>$link</a>";
   }
   
 # ---------------------------------------------------------------- Language IDs  # ---------------------------------------------------------------- Language IDs
 sub languageids {  sub languageids {
     return sort(keys(%language));      return sort(keys(%language));
Line 1061  sub get_previous_attempt { Line 1154  sub get_previous_attempt {
 }  }
   
 sub get_student_view {  sub get_student_view {
   my ($symb,$username,$domain,$courseid) = @_;    my ($symb,$username,$domain,$courseid,$target) = @_;
   my ($map,$id,$feedurl) = split(/___/,$symb);    my ($map,$id,$feedurl) = split(/___/,$symb);
   my (%old,%moreenv);    my (%old,%moreenv);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
Line 1069  sub get_student_view { Line 1162  sub get_student_view {
     $old{$element}=$ENV{'form.grade_'.$element};      $old{$element}=$ENV{'form.grade_'.$element};
     $moreenv{'form.grade_'.$element}=eval '$'.$element #'      $moreenv{'form.grade_'.$element}=eval '$'.$element #'
   }    }
     if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
   &Apache::lonnet::appenv(%moreenv);    &Apache::lonnet::appenv(%moreenv);
   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);    my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
   &Apache::lonnet::delenv('form.grade_');    &Apache::lonnet::delenv('form.grade_');
Line 1128  sub maketime { Line 1222  sub maketime {
 }  }
   
   
   #########################################
   #
   # 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;
   }
   
   #########################################
   
 sub findallcourses {  sub findallcourses {
     my %courses=();      my %courses=();
     my $now=time;      my $now=time;
Line 1152  sub findallcourses { Line 1262  sub findallcourses {
   
 =pod  =pod
   
 =item &domainlogo()  =item &determinedomain()
   
 Inputs: $domain (usually will be undef)  Inputs: $domain (usually will be undef)
   
 Returns: A link to a domain logo, if the domain logo exists.  Returns: Determines which domain should be used for designs
 If the domain logo does not exist, a description of the domain.  
   
 =cut  =cut
   
 ###############################################  ###############################################
 ###############################################  sub determinedomain {
 sub domainlogo {      my $domain=shift;
     my ($domain) = @_;         if (! $domain) {
     if (! $domain) {  
         # Determine domain if we have not been given one          # Determine domain if we have not been given one
         $domain = $Apache::lonnet::perlvar{'lonDefDomain'};          $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
         if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }          if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
Line 1173  sub domainlogo { Line 1281  sub domainlogo {
             $domain=$ENV{'request.role.domain'};               $domain=$ENV{'request.role.domain'}; 
         }          }
     }      }
     # See if there is a logo      return $domain;
   }
   ###############################################
   =pod
   
   =item &domainlogo()
   
   Inputs: $domain (usually will be undef)
   
   Returns: A link to a domain logo, if the domain logo exists.
   If the domain logo does not exist, a description of the domain.
   
   =cut
   ###############################################
   sub domainlogo {
       my $domain = &determinedomain(shift);    
        # See if there is a logo
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
         return '<img src="/adm/lonDomLogos/'.$domain.'.gif" />';          return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/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 {
         return '';          return '';
     }      }
 }  }
   ##############################################
   
   =pod
   
   =item &designparm()
   
   Inputs: $which parameter; $domain (usually will be undef)
   
   Returns: value of designparamter $which
   
   =cut
   ##############################################
   sub designparm {
       my ($which,$domain)=@_;
       $domain=&determinedomain($domain);
       if ($designhash{$domain.'.'.$which}) {
    return $designhash{$domain.'.'.$which};
       } else {
           return $designhash{'default.'.$which};
       }
   }
   
 ###############################################  ###############################################
 ###############################################  ###############################################
Line 1208  other decorations will be returned. Line 1354  other decorations will be returned.
 =cut  =cut
   
 ###############################################  ###############################################
   
   
 ###############################################  ###############################################
 sub bodytag {  sub bodytag {
     my ($title,$function,$addentries,$bodyonly,$domain)=@_;      my ($title,$function,$addentries,$bodyonly,$domain)=@_;
Line 1224  sub bodytag { Line 1372  sub bodytag {
             $function='author';              $function='author';
         }          }
     }      }
     my $img='';      my $img=&designparm($function.'.img',$domain);
     my $pgbg='';      my $pgbg=&designparm($function.'.pgbg',$domain);
     my $tabbg='';      my $tabbg=&designparm($function.'.tabbg',$domain);
     my $font='';      my $font=&designparm($function.'.font',$domain);
     my $link='';      my $link=&designparm($function.'.link',$domain);
     my $alink='#CC0000';      my $alink=&designparm($function.'.alink',$domain);
     my $vlink='';      my $vlink=&designparm($function.'.vlink',$domain);
     if ($function eq 'admin') {      my $sidebg=&designparm($function.'.sidebg',$domain);
         $img='admin';  
         $pgbg='#FFFFCC';   # role and realm
         $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)      my ($role,$realm)
        =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);         =&Apache::lonnet::plaintext((split(/\./,$ENV{'request.role'}))[0]);
 # realm  # realm
Line 1283  END Line 1404  END
 $bodytag  $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">  <table width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td bgcolor="$font">  <tr><td bgcolor="$font">
 <img src="/adm/lonInterFace/$img.jpg" /></td>  <img src="http://$ENV{'HTTP_HOST'}:8080/$img" /></td>
 <td bgcolor="$font"><font color='$pgbg'>$messages</font></td>  <td bgcolor="$font"><font color='$sidebg'>$messages</font></td>
 </tr>  </tr>
 <tr>  <tr>
 <td rowspan="3" bgcolor="$tabbg">  <td rowspan="3" bgcolor="$tabbg">
Line 1697  will result in $ENV{'form.uname'} and $E Line 1818  will result in $ENV{'form.uname'} and $E
   
 returns cache-controlling header code  returns cache-controlling header code
   
 =item nocache()   =item no_cache($r) 
   
 specifies header code to not have cache  specifies header code to not have cache
   
Removed from v.1.60  
changed lines
  Added in v.1.71

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