Diff for /loncom/interface/loncommon.pm between versions 1.508 and 1.534

version 1.508, 2007/02/28 16:30:40 version 1.534, 2007/05/13 06:34:42
Line 68  use Apache::lontexconvert(); Line 68  use Apache::lontexconvert();
 use Apache::lonclonecourse();  use Apache::lonclonecourse();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
   # ---------------------------------------------- Designs
   use vars qw(%defaultdesign);
   
 my $readit;  my $readit;
   
   
 ##  ##
 ## Global Variables  ## Global Variables
 ##  ##
Line 82  my %scprtag; Line 86  my %scprtag;
 my %fe; my %fd; my %fm;  my %fe; my %fd; my %fm;
 my %category_extensions;  my %category_extensions;
   
 # ---------------------------------------------- Designs  
   
 my %designhash;  
   
 # ---------------------------------------------- Thesaurus variables  # ---------------------------------------------- Thesaurus variables
 #  #
 # %Keywords:  # %Keywords:
Line 151  BEGIN { Line 151  BEGIN {
         }          }
     }      }
   
 # -------------------------------------------------------------- domain designs  # -------------------------------------------------------------- default domain designs
   
     my $filename;  
     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';      my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
     opendir(DIR,$designdir);      my $designfile = $designdir.'/default.tab';
     while ($filename=readdir(DIR)) {      if ( open (my $fh,"<$designfile") ) {
  if ($filename!~/\.tab$/) { next; }          while (my $line = <$fh>) {
  my ($domain)=($filename=~/^($match_domain)\./);              next if ($line =~ /^\#/);
  {              chomp($line);
     my $designfile = $designdir.'/'.$filename;              my ($key,$val)=(split(/\=/,$line));
     if ( open (my $fh,"<$designfile") ) {              if ($val) { $defaultdesign{$key}=$val; }
  while (my $line = <$fh>) {          }
     next if ($line =~ /^\#/);          close($fh);
     chomp($line);  
     my ($key,$val)=(split(/\=/,$line));  
     if ($val) { $designhash{$domain.'.'.$key}=$val; }  
  }  
  close($fh);  
     }  
  }  
   
     }      }
     closedir(DIR);  
   
   
 # ------------------------------------------------------------- file categories  # ------------------------------------------------------------- file categories
     {      {
Line 252  Inputs: formname, elementname Line 240  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 {
Line 1265  sub create_text_file { Line 1253  sub create_text_file {
 ##        Home server <option> list generating code          ##  ##        Home server <option> list generating code          ##
 ###############################################################  ###############################################################
   
 =pod  
   
 =head1 Home Server option list generating code  
   
 =over 4  
   
 =item * get_domains()  
   
 Returns an array containing each of the domains listed in the hosts.tab  
 file.  
   
 =cut  
   
 #-------------------------------------------  
 sub get_domains {  
     # The code below was stolen from "The Perl Cookbook", p 102, 1st ed.  
     my @domains;  
     my %seen;  
     foreach my $dom (sort(values(%Apache::lonnet::hostdom))) {  
  push(@domains,$dom) unless $seen{$dom}++;  
     }  
     return @domains;  
 }  
   
 # ------------------------------------------  # ------------------------------------------
   
 sub domain_select {  sub domain_select {
     my ($name,$value,$multiple)=@_;      my ($name,$value,$multiple)=@_;
     my %domains=map {       my %domains=map { 
  $_ => $_.' '.$Apache::lonnet::domaindescription{$_}    $_ => $_.' '. &Apache::lonnet::domain($_,'description') 
     } &get_domains;      } &Apache::lonnet::all_domains();
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  return &multiple_select_form($name,$value,4,\%domains);   return &multiple_select_form($name,$value,4,\%domains);
Line 1308  sub domain_select { Line 1272  sub domain_select {
   
 =pod  =pod
   
   =head1 Routines for form select boxes
   
   =over 4
   
   =cut
   
 =item * multiple_select_form($name,$value,$size,$hash,$order)  =item * multiple_select_form($name,$value,$size,$hash,$order)
   
 Returns a string containing a <select> element int multiple mode  Returns a string containing a <select> element int multiple mode
Line 1459  selected"); Line 1429  selected");
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name,$includeempty) = @_;      my ($defdom,$name,$includeempty) = @_;
     my @domains = get_domains();      my @domains = sort(&Apache::lonnet::all_domains());
     if ($includeempty) { @domains=('',@domains); }      if ($includeempty) { @domains=('',@domains); }
     my $selectdomain = "<select name=\"$name\" size=\"1\">\n";      my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
     foreach my $dom (@domains) {      foreach my $dom (@domains) {
Line 1475  sub select_dom_form { Line 1445  sub select_dom_form {
   
 =pod  =pod
   
 =item * get_library_servers($domain)  
   
 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  
 given $domain.  
   
 =cut  
   
 #-------------------------------------------  
 sub get_library_servers {  
     my $domain = shift;  
     my %library_servers;  
     foreach my $hostid (keys(%Apache::lonnet::libserv)) {  
         if ($Apache::lonnet::hostdom{$hostid} eq $domain) {  
             $library_servers{$hostid} = $Apache::lonnet::hostname{$hostid};  
         }  
     }  
     return %library_servers;  
 }  
   
 #-------------------------------------------  
   
 =pod  
   
 =item * home_server_option_list($domain)  =item * home_server_option_list($domain)
   
 returns a string which contains an <option> list to be used in a   returns a string which contains an <option> list to be used in a 
Line 1509  returns a string which contains an <opti Line 1455  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_library_servers($domain);      my %servers = &Apache::lonnet::get_servers($domain,'library');
     my $result = '';      my $result = '';
     foreach my $hostid (sort(keys(%servers))) {      foreach my $hostid (sort(keys(%servers))) {
         $result.=          $result.=
Line 1521  sub home_server_option_list { Line 1467  sub home_server_option_list {
   
 =pod  =pod
   
 =back  =back 
   
 =cut  =cut
   
Line 1911  If target_domain is not found in domain. Line 1857  If target_domain is not found in domain.
 #-------------------------------------------  #-------------------------------------------
 sub get_auth_defaults {  sub get_auth_defaults {
     my $domain=shift;      my $domain=shift;
     return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain});      return (&Apache::lonnet::domain($domain,'auth_def'),
       &Apache::lonnet::domain($domain,'auth_arg_def'));
       
 }  }
 ###############################################################  ###############################################################
 ##   End Get Authentication Defaults for Domain              ##  ##   End Get Authentication Defaults for Domain              ##
Line 2270  sub track_student_link { Line 2218  sub track_student_link {
 # ===================================================== Display a student photo  # ===================================================== Display a student photo
   
   
 sub studentimagetag {  sub student_image_tag {
     my ($domain,$user)=@_;      my ($domain,$user)=@_;
     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');      my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {      if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
Line 2495  sub preferred_languages { Line 2443  sub preferred_languages {
     if ($browser) {      if ($browser) {
  @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));   @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser));
     }      }
     if ($Apache::lonnet::domain_lang_def{$env{'user.domain'}}) {      if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$env{'user.domain'}});      &Apache::lonnet::domain($env{'user.domain'},
       'lang_def'));
     }      }
     if ($Apache::lonnet::domain_lang_def{$env{'request.role.domain'}}) {      if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{$env{'request.role.domain'}});      &Apache::lonnet::domain($env{'request.role.domain'},
       'lang_def'));
     }      }
     if ($Apache::lonnet::domain_lang_def{      if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
                           $Apache::lonnet::perlvar{'lonDefDomain'}}) {   'lang_def')) {
  @languages=(@languages,   @languages=(@languages,
  $Apache::lonnet::domain_lang_def{      &Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'},
                                   $Apache::lonnet::perlvar{'lonDefDomain'}});      'lang_def'));
     }      }
 # turn "en-ca" into "en-ca,en"  # turn "en-ca" into "en-ca,en"
     my @genlanguages;      my @genlanguages;
Line 2964  sub blockcheck { Line 2914  sub blockcheck {
         }          }
         my $no_ownblock = 0;          my $no_ownblock = 0;
         my $no_userblock = 0;          my $no_userblock = 0;
         if ($otheruser) {          if ($otheruser && $activity ne 'com') {
             # Check if current user has 'evb' priv for this              # Check if current user has 'evb' priv for this
             if (defined($own_courses{$course})) {              if (defined($own_courses{$course})) {
                 foreach my $sec (keys(%{$own_courses{$course}})) {                  foreach my $sec (keys(%{$own_courses{$course}})) {
Line 3217  Returns: Determines which domain should Line 3167  Returns: Determines which domain should
 ###############################################  ###############################################
 sub determinedomain {  sub determinedomain {
     my $domain=shift;      my $domain=shift;
    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 3228  sub determinedomain { Line 3178  sub determinedomain {
     return $domain;      return $domain;
 }  }
 ###############################################  ###############################################
   
   sub devalidate_domconfig_cache {
       my ($udom)=@_;
       &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
   }
   
   # ---------------------- Get domain configuration for a domain
   sub get_domainconf {
       my ($udom) = @_;
       my $cachetime=1800;
       my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
       if (defined($cached)) { return %{$result}; }
   
       my %domconfig = &Apache::lonnet::get_dom('configuration',
        ['login','rolecolors'],$udom);
       my %designhash;
       if (keys(%domconfig) > 0) {
           if (ref($domconfig{'login'}) eq 'HASH') {
               foreach my $key (keys(%{$domconfig{'login'}})) {
                   $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
               }
           }
           if (ref($domconfig{'rolecolors'}) eq 'HASH') {
               foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                       foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                           $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                       }
                   }
               }
           }
       } else {
           my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
           my $designfile =  $designdir.'/'.$udom.'.tab';
           if (-e $designfile) {
               if ( open (my $fh,"<$designfile") ) {
                   while (my $line = <$fh>) {
                       next if ($line =~ /^\#/);
                       chomp($line);
                       my ($key,$val)=(split(/\=/,$line));
                       if ($val) { $designhash{$udom.'.'.$key}=$val; }
                   }
                   close($fh);
               }
           }
           if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') {
               $designhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
           }
       }
       &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
     $cachetime);
       return %designhash;
   }
   
 =pod  =pod
   
 =item * &domainlogo()  =item * &domainlogo()
Line 3241  If the domain logo does not exist, a des Line 3245  If the domain logo does not exist, a des
   
 ###############################################  ###############################################
 sub domainlogo {  sub domainlogo {
     my $domain = &determinedomain(shift);          my $domain = &determinedomain(shift);
      # See if there is a logo      my %designhash = &get_domainconf($domain);    
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      # See if there is a logo
  my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");      if ($designhash{$domain.'.login.domlogo'} ne '') {
         return '<img src="'.$logo.'" alt="'.$domain.'" />';          my $imgsrc = $designhash{$domain.'.login.domlogo'};
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {          if ($imgsrc =~ /^\/(adm|res)/) {
         return $Apache::lonnet::domaindescription{$domain};              $imgsrc = &lonhttpdurl($imgsrc);
           } 
           return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
       } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
           return &Apache::lonnet::domain($domain,'description');
     } else {      } else {
         return '';          return '';
     }      }
Line 3283  sub designparm { Line 3291  sub designparm {
  return $env{'environment.color.'.$which};   return $env{'environment.color.'.$which};
     }      }
     $domain=&determinedomain($domain);      $domain=&determinedomain($domain);
     if (exists($designhash{$domain.'.'.$which})) {      my %domdesign = &get_domainconf($domain);
  return $designhash{$domain.'.'.$which};      my $output;
       if ($domdesign{$domain.'.'.$which} ne '') {
    $output = $domdesign{$domain.'.'.$which};
     } else {      } else {
         return $designhash{'default.'.$which};          $output = $defaultdesign{$which};
       }
       if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
           ($which =~ /login\.(img|logo|domlogo)/)) {
           if ($output =~ /^\/(adm|res)\//) {
               $output = &lonhttpdurl($output);
           }
     }      }
       return $output;
 }  }
   
 ###############################################  ###############################################
Line 3360  sub bodytag { Line 3377  sub bodytag {
     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);      my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
   
     my %design = ( 'style'   => 'margin-top: 0px',      my %design = ( 'style'   => 'margin-top: 0px',
    'bgcolor' => $pgbg,     'bgcolor' => '#ffffff',
    'text'    => $font,     'text'    => $font,
                    'alink'   => &designparm($function.'.alink',$domain),                     'alink'   => &designparm($function.'.alink',$domain),
    'vlink'   => &designparm($function.'.vlink',$domain),     'vlink'   => &designparm($function.'.vlink',$domain),
Line 3396  sub bodytag { Line 3413  sub bodytag {
     my $bodytag = "<body $extra_body_attr>".      my $bodytag = "<body $extra_body_attr>".
  &Apache::lontexconvert::init_math_support();   &Apache::lontexconvert::init_math_support();
   
     if ($bodyonly       if ($bodyonly) {
  || ($env{'request.state'} eq 'construct'   
     && $env{'environment.remote'} ne 'off' )) {  
         return $bodytag;          return $bodytag;
     } elsif ($env{'browser.interface'} eq 'textual') {      } elsif ($env{'browser.interface'} eq 'textual') {
 # Accessibility  # Accessibility
Line 3506  ENDROLE Line 3521  ENDROLE
 # Top frame rendering, Remote is up  # Top frame rendering, Remote is up
 #  #
   
     my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.      my $imgsrc = $img;
         $lonhttpdPort.$img.'" alt="'.$function.'" />';      if ($img =~ /^\/adm/) {
           $imgsrc = 'http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.$img;
       }
       my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
   
     # Explicit link to get inline menu      # Explicit link to get inline menu
     my $menu= ($no_inline_link?''      my $menu= ($no_inline_link?''
Line 3672  sub standard_css { Line 3690  sub standard_css {
     my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'      my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
                                               : '0px 3px 0px 4px';                                                : '0px 3px 0px 4px';
   
   
     return <<END;      return <<END;
 h1, h2, h3, th { font-family: $sans }  h1, h2, h3, th { font-family: $sans }
 a:focus { color: red; background: yellow }   a:focus { color: red; background: yellow } 
 table.thinborder { border-collapse: collapse; }  table.thinborder,
 table.thinborder tr th {  border-style: solid; border-width: 1px; background: $tabbg;}  
 table.thinborder tr td { border-style: solid; border-width: 1px}  table.thinborder tr th {
     border-style: solid;
     border-width: 1px;
     background: $tabbg;
   }
   table.thinborder tr td {
     border-style: solid;
     border-width: 1px
   }
   
 form, .inline { display: inline; }  form, .inline { display: inline; }
 .center { text-align: center; }  .center { text-align: center; }
Line 3690  form, .inline { display: inline; } Line 3717  form, .inline { display: inline; }
 .LC_diff_removed {  .LC_diff_removed {
   color: red;    color: red;
 }  }
   
   .LC_info,
 .LC_success,  .LC_success,
 .LC_diff_added {  .LC_diff_added {
   color: green;    color: green;
Line 3698  form, .inline { display: inline; } Line 3727  form, .inline { display: inline; }
   border: 0px;    border: 0px;
 }  }
   
   .LC_internal_info {
     color: #999;
   }
   
 table.LC_pastsubmission {  table.LC_pastsubmission {
   border: 1px solid black;    border: 1px solid black;
   margin: 2px;    margin: 2px;
Line 3759  table#LC_title_bar td.LC_title_bar_role_ Line 3792  table#LC_title_bar td.LC_title_bar_role_
 }  }
   
 table#LC_menubuttons_mainmenu {  table#LC_menubuttons_mainmenu {
   background: $pgbg;    width: 100%;
   border: 0px;    border: 0px;
   border-spacing: 1px;    border-spacing: 1px;
   padding: 0px 1px;    padding: 0px 1px;
Line 3814  td.LC_table_cell_checkbox { Line 3847  td.LC_table_cell_checkbox {
   text-align: center;    text-align: center;
 }  }
   
   table#LC_mainmenu td.LC_mainmenu_column {
       vertical-align: top;
   }
   
 .LC_menubuttons_inline_text {  .LC_menubuttons_inline_text {
   color: $font;    color: $font;
   font-family: $sans;    font-family: $sans;
   font-size: smaller;    font-size: smaller;
 }  }
   
   .LC_menubuttons_link {
     text-decoration: none;
   }
   
   .LC_menubuttons_category {
     color: $font;
     background: $pgbg;
     font-family: $sans;
     font-size: larger;
     font-weight: bold;
   }
   
 td.LC_menubuttons_text {  td.LC_menubuttons_text {
     width: 90%;
   color: $font;    color: $font;
   font-family: $sans;    font-family: $sans;
 }  }
   
 td.LC_menubuttons_img {  td.LC_menubuttons_img {
   background: $tabbg;  
 }  }
   
 .LC_current_location {  .LC_current_location {
   font-family: $sans;    font-family: $sans;
   background: $tabbg;    background: $tabbg;
Line 3836  td.LC_menubuttons_img { Line 3887  td.LC_menubuttons_img {
   font-weight: bold;    font-weight: bold;
 }  }
   
   .LC_rolesmenu_is {
     font-family: $sans;
   }
   
   .LC_rolesmenu_selected {
     font-family: $sans;
   }
   
   .LC_rolesmenu_future {
     font-family: $sans;
   }
   
   
   .LC_rolesmenu_will {
     font-family: $sans;
   }
   
   .LC_rolesmenu_will_not {
     font-family: $sans;
   }
   
   .LC_rolesmenu_expired {
     font-family: $sans;
   }
   
   .LC_rolesinfo {
     font-family: $sans;
   }
   
   .LC_dropadd_labeltext {
     font-family: $sans;
     text-align: right;
   }
   
   .LC_preferences_labeltext {
     font-family: $sans;
     text-align: right;
   }
   
 table.LC_aboutme_port {  table.LC_aboutme_port {
   border: 0px;    border: 0px;
   border-collapse: collapse;    border-collapse: collapse;
Line 3861  table.LC_nested { Line 3951  table.LC_nested {
   border-spacing: 0px;    border-spacing: 0px;
   width: 100%;    width: 100%;
 }  }
 table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th {  table.LC_data_table tr th, table.LC_calendar tr th, table.LC_mail_list tr th,
   table.LC_prior_tries tr th {
   font-weight: bold;    font-weight: bold;
   background-color: $data_table_head;    background-color: $data_table_head;
   font-size: smaller;    font-size: smaller;
Line 4238  span.LC_feedback_link { Line 4329  span.LC_feedback_link {
     font-size: larger;      font-size: larger;
 }  }
   
   table.LC_prior_tries {
     border: 1px solid #000000;
     border-collapse: separate;
     border-spacing: 1px;
   }
   
   table.LC_prior_tries td {
     padding: 2px;
   }
   
   .LC_answer_correct {
     background: #AAFFAA;
     color: black;
   }
   .LC_answer_charged_try {
     background: #FFAAAA ! important;
     color: black;
   }
   .LC_answer_not_charged_try, 
   .LC_answer_no_grade,
   .LC_answer_late {
     background: #FFFFAA;
     color: black;
   }
   .LC_answer_previous {
     background: #AAAAFF;
     color: black;
   }
   .LC_answer_no_message {
     background: #FFFFFF;
     color: black;
   }
   .LC_answer_unknown {
     background: orange;
     color: black;
   }
   
   
   span.LC_prior_numerical,
   span.LC_prior_string,
   span.LC_prior_custom,
   span.LC_prior_reaction,
   span.LC_prior_math {
     font-family: monospace;
     white-space: pre;
   }
   
   span.LC_prior_string {
     font-family: monospace;
     white-space: pre;
   }
   
   table.LC_prior_option {
     width: 100%;
     border-collapse: collapse;
   }
   table.LC_prior_rank, table.LC_prior_match {
     border-collapse: collapse;
   }
   table.LC_prior_option tr td,
   table.LC_prior_rank tr td,
   table.LC_prior_match tr td {
     border: 1px solid #000000;
   }
   
   span.LC_nobreak {
       white-space: nowrap;
   }
   
 END  END
 }  }
   

Removed from v.1.508  
changed lines
  Added in v.1.534


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