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

Diff for /loncom/interface/loncommon.pm between versions 1.502 and 1.514

version 1.502, 2007/01/20 22:04:57 version 1.514, 2007/03/08 01:58:44
Line 1265  sub create_text_file { Line 1265  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 1315  Returns a string containing a <select> e Line 1291  Returns a string containing a <select> e
   
 Args:  Args:
   $name - name of the <select> element    $name - name of the <select> element
   $value - sclara or array ref of values that should already be selected    $value - scalar or array ref of values that should already be selected
   $size - number of rows long the select element is    $size - number of rows long the select element is
   $hash - the elements should be 'option' => 'shown text'    $hash - the elements should be 'option' => 'shown text'
           (shown text should already have been &mt())            (shown text should already have been &mt())
   $order - (optional) array ref of the order to show the elments in    $order - (optional) array ref of the order to show the elements in
   
 =cut  =cut
   
Line 1336  sub multiple_select_form { Line 1312  sub multiple_select_form {
     }      }
     $output.="\n<select name='$name' size='$size' multiple='1'>";      $output.="\n<select name='$name' size='$size' multiple='1'>";
     my @order;      my @order;
     if ($order) {      if (ref($order) eq 'ARRAY')  {
         @order = ref($order) ? @$order          @order = @{$order};
                              : sort(keys(%$hash));      } else {
           @order = sort(keys(%$hash));
     }      }
     if (exists($$hash{'select_form_order'})) {      if (exists($$hash{'select_form_order'})) {
         @order = @{$$hash{'select_form_order'}};          @order = @{$$hash{'select_form_order'}};
Line 1458  selected"); Line 1435  selected");
 #-------------------------------------------  #-------------------------------------------
 sub select_dom_form {  sub select_dom_form {
     my ($defdom,$name,$includeempty) = @_;      my ($defdom,$name,$includeempty) = @_;
     my @domains = get_domains();      my @domains = &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 1474  sub select_dom_form { Line 1451  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 1508  returns a string which contains an <opti Line 1461  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 1910  If target_domain is not found in domain. Line 1863  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 2266  sub track_student_link { Line 2221  sub track_student_link {
  &help_open_topic('View_recent_activity');   &help_open_topic('View_recent_activity');
 }  }
   
   # ===================================================== Display a student photo
   
   
   sub student_image_tag {
       my ($domain,$user)=@_;
       my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
       if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
    return '<img src="'.$imgsrc.'" align="right" />';
       } else {
    return '';
       }
   }
   
 =pod  =pod
   
 =back  =back
Line 2481  sub preferred_languages { Line 2449  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 3232  sub domainlogo { Line 3202  sub domainlogo {
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
  my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");   my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
         return '<img src="'.$logo.'" alt="'.$domain.'" />';          return '<img src="'.$logo.'" alt="'.$domain.'" />';
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {      } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
         return $Apache::lonnet::domaindescription{$domain};          return &Apache::lonnet::domain($domain,'description');
     } else {      } else {
         return '';          return '';
     }      }
Line 3661  sub standard_css { Line 3631  sub standard_css {
     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.LC_optres_prior {
 table.thinborder tr td { border-style: solid; border-width: 1px}    border-collapse: collapse;
   }
   table.thinborder tr th {
     border-style: solid;
     border-width: 1px;
     background: $tabbg;
   }
   table.thinborder tr td, 
   table.LC_optres_prior 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 3835  table.LC_data_table, table.LC_mail_list Line 3816  table.LC_data_table, table.LC_mail_list
 .LC_data_table_dense {  .LC_data_table_dense {
   font-size: small;    font-size: small;
 }  }
   table.LC_nested_outer {
     border: 1px solid #000000;
     border-collapse: separate;
     border-spacing: 0px;
     width: 100%;
   }
   table.LC_nested {
     border: 0px;
     border-collapse: separate;
     border-spacing: 0px;
     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 {
   font-weight: bold;    font-weight: bold;
   background-color: $data_table_head;    background-color: $data_table_head;
Line 3853  table.LC_data_table tr.LC_data_table_hig Line 3846  table.LC_data_table tr.LC_data_table_hig
   background-color: $data_table_darker;    background-color: $data_table_darker;
 }  }
 table.LC_data_table tr.LC_empty_row td,  table.LC_data_table tr.LC_empty_row td,
 table.LC_whatsnew tr.LC_empty_row td {  table.LC_nested tr.LC_empty_row td {
   background-color: #FFFFFF;    background-color: #FFFFFF;
   font-weight: bold;    font-weight: bold;
   font-style: italic;    font-style: italic;
   text-align: center;    text-align: center;
   padding: 8px;    padding: 8px;
 }  }
 table.LC_whatsnew tr.LC_empty_row td {  table.LC_nested tr.LC_empty_row td {
   padding: 4ex    padding: 4ex
 }  }
 table.LC_whatsnew {  table.LC_nested_outer tr th {
     font-weight: bold;
     background-color: $data_table_head;
     font-size: smaller;
     border-bottom: 1px solid #000000;
 }  }
   table.LC_nested_outer tr td.LC_subheader {
 table.LC_whatsnew tr th,    background-color: $data_table_head;
 table.LC_whatsnew tr.LC_info_row td {  
   background-color: #CCC;  
   font-weight: bold;    font-weight: bold;
   font-size: small;    font-size: small;
     border-bottom: 1px solid #000000;
   text-align: right;    text-align: right;
 }  }
 table.LC_whatsnew tr td {  table.LC_nested tr.LC_info_row td {
   background-color: #FFF;    background-color: #CCC;
     font-weight: bold;
   font-size: small;    font-size: small;
   text-align: right;    text-align: center;
 }  }
 table.LC_whatsnew tr td.LC_first_item {  table.LC_nested tr.LC_info_row td.LC_left_item {
   text-align: left;    text-align: left;
 }  }
   table.LC_nested td {
     background-color: #FFF;
     font-size: small;
   }
   table.LC_nested_outer tr th.LC_right_item,
   table.LC_nested tr.LC_info_row td.LC_right_item,
   table.LC_nested tr.LC_odd_row td.LC_right_item,
   table.LC_nested tr td.LC_right_item {
     text-align: right;
   }
   
 table.LC_whatsnew tr.LC_odd_row td {  table.LC_nested tr.LC_odd_row td {
   background-color: #EEE;    background-color: #EEE;
 }  }
   
Line 4952  sub get_course_users { Line 4959  sub get_course_users {
                     $usec = 'none';                      $usec = 'none';
                 }                  }
                 if ($uname ne '' && $udom ne '') {                  if ($uname ne '' && $udom ne '') {
                     if ($end < $now) {                      if ($end > 0 && $end < $now) {
                         $status = 'previous';                          $status = 'previous';
                     } elsif ($start > $now) {                      } elsif ($start > $now) {
                         $status = 'future';                          $status = 'future';
Line 5394  sub record_sep { Line 5401  sub record_sep {
     } else {      } else {
         my @allfields;          my @allfields;
         if ($env{'form.upfiletype'} eq 'semisv') {          if ($env{'form.upfiletype'} eq 'semisv') {
             @allfields=split(/;/,$record);              @allfields=split(/;/,$record,-1);
         } else {          } else {
             @allfields=split(/\,/,$record);              @allfields=split(/\,/,$record,-1);
         }          }
         my $i=0;          my $i=0;
         my $j;          my $j;
Line 6564  sub group_term { Line 6571  sub group_term {
   
 sub icon {  sub icon {
     my ($file)=@_;      my ($file)=@_;
     my $curfext = (split(/\./,$file))[-1];      my $curfext = lc((split(/\./,$file))[-1]);
     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';      my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
     my $embstyle = &Apache::loncommon::fileembstyle($curfext);      my $embstyle = &Apache::loncommon::fileembstyle($curfext);
     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {      if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
Removed from v.1.502  
changed lines
  Added in v.1.514

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