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

Diff for /loncom/interface/domainprefs.pm between versions 1.137 and 1.138

version 1.137, 2010/07/17 20:02:07 version 1.138, 2010/07/20 02:42:40
Line 2270  sub print_usersessions { Line 2270  sub print_usersessions {
     } else {      } else {
         $prefix = 'remote';          $prefix = 'remote';
         @types = ('version','excludedomain','includedomain');          @types = ('version','excludedomain','includedomain');
     }       }
     my (%current,%checkedon,%checkedoff);      my (%current,%checkedon,%checkedoff);
     my @lcversions = &Apache::lonnet::all_loncaparevs();      my @lcversions = &Apache::lonnet::all_loncaparevs();
     my @alldoms = sort(&Apache::lonnet::all_domains());      my (%by_ip,%by_location,@intdoms);
       &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
       my @locations = sort(keys(%by_location));
     foreach my $type (@types) {      foreach my $type (@types) {
         $checkedon{$type} = '';          $checkedon{$type} = '';
         $checkedoff{$type} = ' checked="checked"';          $checkedoff{$type} = ' checked="checked"';
Line 2322  sub print_usersessions { Line 2324  sub print_usersessions {
                          "\n".                           "\n".
                          '</div><div><table>';                           '</div><div><table>';
             my $rem;              my $rem;
             for (my $i=0; $i<@alldoms; $i++) {              for (my $i=0; $i<@locations; $i++) {
                 next if ($alldoms[$i] eq $dom);                  my ($showloc,$value,$checkedtype);
                 my $checkedtype;                  if (ref($by_location{$locations[$i]}) eq 'ARRAY') {
                 if (ref($current{$type}) eq 'ARRAY') {                      my $ip = $by_location{$locations[$i]}->[0];
                     if (grep(/^\Q$alldoms[$i]\E$/,@{$current{$type}})) {                      if (ref($by_ip{$ip}) eq 'ARRAY') {
                         $checkedtype = ' checked="checked"';                          $value = join(':',@{$by_ip{$ip}});
                           $showloc = join(', ',@{$by_ip{$ip}});
                           if (ref($current{$type}) eq 'ARRAY') {
                               foreach my $loc (@{$by_ip{$ip}}) {  
                                   if (grep(/^\Q$loc\E$/,@{$current{$type}})) {
                                       $checkedtype = ' checked="checked"';
                                       last;
                                   }
                               }
                           }
                     }                      }
                 }                  }
                 $rem = $i%($numinrow);                  $rem = $i%($numinrow);
Line 2340  sub print_usersessions { Line 2351  sub print_usersessions {
                 $datatable .= '<td class="LC_left_item">'.                  $datatable .= '<td class="LC_left_item">'.
                               '<span class="LC_nobreak"><label>'.                                '<span class="LC_nobreak"><label>'.
                               '<input type="checkbox" name="'.$prefix.'_'.$type.                                '<input type="checkbox" name="'.$prefix.'_'.$type.
                               '" value="'.$alldoms[$i].'"'.$checkedtype.' />'.$alldoms[$i].                                '" value="'.$value.'"'.$checkedtype.' />'.$showloc.
                               '</label></span></td>';                                '</label></span></td>';
             }              }
             $rem = @alldoms%($numinrow);              $rem = @locations%($numinrow);
             my $colsleft = $numinrow - $rem;              my $colsleft = $numinrow - $rem;
             if ($colsleft > 1 ) {              if ($colsleft > 1 ) {
                 $datatable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.                  $datatable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
Line 2360  sub print_usersessions { Line 2371  sub print_usersessions {
     return $datatable;      return $datatable;
 }  }
   
   sub build_location_hashes {
       my ($intdoms,$by_ip,$by_location) = @_;
       return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') &&
                     (ref($by_location) eq 'HASH')); 
       my %iphost = &Apache::lonnet::get_iphost();
       my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary');
       my $primary_ip = &Apache::lonnet::get_host_ip($primary_id);
       if (ref($iphost{$primary_ip}) eq 'ARRAY') {
           foreach my $id (@{$iphost{$primary_ip}}) {
               my $intdom = &Apache::lonnet::internet_dom($id);
               unless(grep(/^\Q$intdom\E$/,@{$intdoms})) {
                   push(@{$intdoms},$intdom);
               }
           }
       }
       foreach my $ip (keys(%iphost)) {
           if (ref($iphost{$ip}) eq 'ARRAY') {
               foreach my $id (@{$iphost{$ip}}) {
                   my $location = &Apache::lonnet::internet_dom($id);
                   if ($location) {
                       next if (grep(/^\Q$location\E$/,@{$intdoms}));
                       if (ref($by_ip->{$ip}) eq 'ARRAY') {
                           unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) {
                               push(@{$by_ip->{$ip}},$location);
                           }
                       } else {
                           $by_ip->{$ip} = [$location];
                       }
                   }
               }
           }
       }
       foreach my $ip (sort(keys(%{$by_ip}))) {
           if (ref($by_ip->{$ip}) eq 'ARRAY') {
               @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}});
               my $first = $by_ip->{$ip}->[0];
               if (ref($by_location->{$first}) eq 'ARRAY') {
                   unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) {
                       push(@{$by_location->{$first}},$ip);
                   }
               } else {
                   $by_location->{$first} = [$ip];
               }
           }
       }
       return;
   }
   
 sub contact_titles {  sub contact_titles {
     my %titles = &Apache::lonlocal::texthash (      my %titles = &Apache::lonlocal::texthash (
                    'supportemail' => 'Support E-mail address',                     'supportemail' => 'Support E-mail address',
Line 6642  sub modify_usersessions { Line 6701  sub modify_usersessions {
     my @types = ('version','excludedomain','includedomain');      my @types = ('version','excludedomain','includedomain');
     my @prefixes = ('remote','hosted');      my @prefixes = ('remote','hosted');
     my @lcversions = &Apache::lonnet::all_loncaparevs();      my @lcversions = &Apache::lonnet::all_loncaparevs();
       my (%by_ip,%by_location,@intdoms);
       &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
       my @locations = sort(keys(%by_location));
     my (%defaultshash,%changes);      my (%defaultshash,%changes);
     foreach my $prefix (@prefixes) {      foreach my $prefix (@prefixes) {
         $defaultshash{'usersessions'}{$prefix} = {};          $defaultshash{'usersessions'}{$prefix} = {};
     }      }
     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);      my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
     my $resulttext;      my $resulttext;
       my %iphost = &Apache::lonnet::get_iphost();
     foreach my $prefix (@prefixes) {      foreach my $prefix (@prefixes) {
         foreach my $type (@types) {          foreach my $type (@types) {
             my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};              my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};
Line 6694  sub modify_usersessions { Line 6757  sub modify_usersessions {
                 my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);                  my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);
                 my @okvals;                  my @okvals;
                 foreach my $val (@vals) {                  foreach my $val (@vals) {
                     if (&Apache::lonnet::domain($val) ne '') {                      if ($val =~ /:/) {
                         push(@okvals,$val);                          my @items = split(/:/,$val);
                           foreach my $item (@items) {
                               if (ref($by_location{$item}) eq 'ARRAY') {
                                   push(@okvals,$item);
                               }
                           }
                       } else {
                           if (ref($by_location{$val}) eq 'ARRAY') {
                               push(@okvals,$val);
                           }
                     }                      }
                 }                  }
                 @okvals = sort(@okvals);                  @okvals = sort(@okvals);
Line 6942  sub usersession_titles { Line 7014  sub usersession_titles {
   
                remote => 'Hosting of sessions for users in this domain on servers in other domains',                 remote => 'Hosting of sessions for users in this domain on servers in other domains',
                version => 'LON-CAPA version requirement',                 version => 'LON-CAPA version requirement',
                excludedomain => 'Specific domains excluded',                 excludedomain => 'Allow all, but exclude specific domains',
                includedomain => 'Specific domains included',                 includedomain => 'Deny all, but include specific domains',
            );             );
 }  }
   
Removed from v.1.137  
changed lines
  Added in v.1.138

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