Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1048.2.5 and 1.1049

version 1.1048.2.5, 2010/12/08 04:51:26 version 1.1049, 2010/01/16 13:46:05
Line 4069  sub role_status { Line 4069  sub role_status {
     }      }
 }  }
   
 sub curr_role_status {  
     my ($start,$end,$refresh,$then) = @_;  
     if (($start) && ($start<0)) { return 'deleted' };  
     my $status = 'active';  
     if (($end) && ($end<=$then)) {  
         $status = 'previous';  
     }  
     if (($start) && ($refresh<$start)) {  
         $status = 'future';  
     }  
     return $status;  
 }  
   
 sub gather_roleprivs {  
     my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend) = @_;  
     return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));  
     if (($area ne '') && ($role ne '')) {  
         my $spec = $role.'.'.$area;  
         my ($tdummy,$tdomain,$trest)=split(/\//,$area);  
         if ($role =~ /^cr\//) {  
             &custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);  
         } elsif ($role eq 'gr') {  
             my %rolehash = &get('roles',[$area.'_'.$role],$env{'user.domain'},  
                                 $env{'user.name'});  
             my $trole = split('_',$rolehash{$area.'_'.$role},1);  
             (undef,my $group_privs) = split(/\//,$trole);  
             $group_privs = &unescape($group_privs);  
             &group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);  
         } else {  
             &standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);  
         }  
     }  
     return;  
 }  
   
 sub check_adhoc_privs {  sub check_adhoc_privs {
     my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;      my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;      my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
Line 4848  sub usertools_access { Line 4813  sub usertools_access {
     }      }
 }  }
   
 sub is_course_owner {  
     my ($cdom,$cnum,$udom,$uname) = @_;  
     if (($udom eq '') || ($uname eq '')) {  
         $udom = $env{'user.domain'};  
         $uname = $env{'user.name'};  
     }  
     unless (($udom eq '') || ($uname eq '')) {  
         if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'})) {  
             if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {  
                 return 1;  
             } else {  
                 my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);  
                 if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {  
                     return 1;  
                 }  
             }  
         }  
     }  
     return;  
 }  
   
 sub is_advanced_user {  sub is_advanced_user {
     my ($udom,$uname) = @_;      my ($udom,$uname) = @_;
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);      my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
Line 6312  sub assignrole { Line 6256  sub assignrole {
                     }                      }
                 } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {                  } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
                     $refused = '';                      $refused = '';
                 } elsif (($selfenroll == 1) && ($role eq 'st') && ($cdom eq 'gci') && (($cnum eq '1H96711d710194bfegcil1') || ($cnum eq '5422913620b814c90gcil1'))) {  
                     if ($env{'request.role'} eq 'cc./gci/9615072b469884921gcil1') {  
                         $refused = '';  
                     }  
                 } elsif ($context eq 'requestcourses') {                  } elsif ($context eq 'requestcourses') {
                     my @possroles = ('st','ta','ep','in','cc','co');                      my @possroles = ('st','ta','ep','in','cc','co');
                     if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {                      if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
Line 9534  sub get_dns { Line 9474  sub get_dns {
     my %libserv;      my %libserv;
     my $loaded;      my $loaded;
     my %name_to_host;      my %name_to_host;
     my %internetdom;  
   
     sub parse_hosts_tab {      sub parse_hosts_tab {
  my ($file) = @_;   my ($file) = @_;
Line 9542  sub get_dns { Line 9481  sub get_dns {
     next if ($configline =~ /^(\#|\s*$ )/x);      next if ($configline =~ /^(\#|\s*$ )/x);
     next if ($configline =~ /^\^/);      next if ($configline =~ /^\^/);
     chomp($configline);      chomp($configline);
     my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);      my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     if ($id && $domain && $role && $name) {      if ($id && $domain && $role && $name) {
  $hostname{$id}=$name;   $hostname{$id}=$name;
Line 9558  sub get_dns { Line 9497  sub get_dns {
                 } else {                  } else {
                     $protocol{$id} = 'http';                      $protocol{$id} = 'http';
                 }                  }
                 if (defined($intdom)) {  
                     $internetdom{$id} = $intdom;  
                 }  
     }      }
  }   }
     }      }
Line 9659  sub get_dns { Line 9595  sub get_dns {
  my @uniq = grep(!$seen{$_}++, values(%hostdom));   my @uniq = grep(!$seen{$_}++, values(%hostdom));
  return @uniq;   return @uniq;
     }      }
   
     sub internet_dom {  
         &load_hosts_tab() if (!$loaded);  
   
         my ($lonid) = @_;  
         return $internetdom{$lonid};  
     }  
 }  }
   
 {   { 

Removed from v.1.1048.2.5  
changed lines
  Added in v.1.1049


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